После перехода на ADP обнаружил странное поведение проекта при запуске.
Клиентская часть работает одновременно на 3-х компах. Что бы не бегать с обновками, сделан "клиент" который проверяет версию в специальной таблице на сервере, перезаписывает клиент на компе и запускает его.
В модуле autoexec запускается процедура, создающая класс с данными текущего пользователя, который выбирается в зависимости от МАС-адреса компа. При запуске самого клиента на компе, пользователь определяеться правильно и без проблем.
Но стоит запустить "обновлялку" для копирования клиента с сервера, как пользователь определяеться как мой, потому как я редактирую клиента и выкладываю измененный на сервер.
Иду другим путем, после удачного запуска клиента на другом компе, закрываю его, выкладываю с этого компа на сервер. Теперь при запуске на другом компе "обновлялки" и получении клиента с сервера, пользователь начинает определяться на всех компах как с того компа, с которого его скопировали на сервер.
Запуск autoexec вручную ничего не дает. Пользователь определяеться неверно, до момента пока не запущу непосредственно клиента с локального компа.
Эта же конструкция отлично работала на DAO, а на ADODB отказывается.
Код класса пользователя примерно такой:
Dim cidworker As Integer
Private Sub Class_Initialize()
On Error GoTo Class_Initialize_Error
сidworker = 0
SpecificationsNet
On Error GoTo 0
Exit Sub
Class_Initialize_Error:
MsgBox "Error " & err.Number & " (" & err.Description & ") in procedure Class_Initialize of Class Module worker"
End Sub
Public Property Get idworker() As Long
Dim id As Variant
Dim rs As ADODB.Recordset
On Error GoTo idworker_Error
If Nz(cidworker, 0) <= 0 Then
Set rs = New ADODB.Recordset
rs.Open "SELECT dbo.idworker()", db, adOpenStatic, adLockReadOnly
If rs.RecordCount > 0 Then
id = rs.fields(0)
If IsNumeric(id) Then
cidworker = CLng(id)
Else
cidworker = 0
End If
Else
cidworker = 0
End If
Set rs = nothing
End If
If cidworker = 0 Then
MsgBox "Такого компьютера нет в базе!", vbCritical, "Ошибка доступа."
Quit acQuitSaveAll
Else
idworker = cidworker
End If
On Error GoTo 0
Exit Property
idworker_Error:
MsgBox "Error " & err.Number & " (" & err.Description & ") in get property idworker of Class Module worker"
End Property
Private Sub SpecificationsNet()
'http://www.sql.ru/forum/actualthread.aspx?tid=276571
Dim strComputer As String
Dim objWMIService As Object, colBIOS As Object, objBIOS As Object
Dim rs As ADODB.Recordset
Dim sqlworker As String
On Error GoTo SpecificationsNet_Error
If Not CurrentProject.IsConnected Then
ChangeADPConnection "COMP-1\SQLEXPRESS", "restartf"
End If
If CurrentProject.IsConnected Then
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colBIOS = objWMIService.ExecQuery("SELECT Name, MACAddress FROM Win32_NetworkAdapter WHERE (MACAddress is not null)")
For Each objBIOS In colBIOS
Set rs = New ADODB.Recordset
rs.Open "SELECT SQLName FROM workers WHERE (MACaddress = '" & Replace(objBIOS.MACAddress, ":", "") & "')", db, adOpenStatic, adLockReadOnly
If rs.RecordCount > 0 Then
sqlworker = rs.fields(0)
End If
rs.Close
Set rs = Nothing
Next
If sqlworker <> "" Then
ChangeADPConnection "COMP-1\SQLEXPRESS", "restartf", sqlworker, sqlworker
End If
'cworker.idworker = 0
Set objWMIService = Nothing
End If
On Error GoTo 0
Exit Sub
SpecificationsNet_Error:
MsgBox "Error " & err.Number & " (" & err.Description & ") in procedure SpecificationsNet of Class Module worker"
End Sub
Function ChangeADPConnection(strServerName As String, strDBName As _
String, Optional strUN As String, Optional strPW As String) As Boolean
Dim strConnect As String
On Error GoTo EH:
Application.CurrentProject.CloseConnection
'The Provider, Data Source, and Initial Catalog arguments are required.
strConnect = "Provider=SQLOLEDB.1" & _
";Data Source=" & strServerName & _
";Initial Catalog=" & strDBName
If strUN <> "" Then
strConnect = strConnect & ";user id=" & strUN
If strPW <> "" Then
strConnect = strConnect & ";password=" & strPW
End If
Else 'Try to use integrated security if no username is supplied.
strConnect = strConnect & ";integrated security=SSPI"
End If
Application.CurrentProject.OpenConnection strConnect
ChangeADPConnection = True
Exit Function
EH:
MsgBox err.Number & ": " & err.Description, vbCritical, "Connection Error"
ChangeADPConnection = False
End Function
Вот момент его создания:
Private wworker As worker
Private cdb As ADODB.Connection
Public Property Get db() As ADODB.Connection
On Error GoTo db_Error
If cdb Is Nothing Then
Set cdb = New ADODB.Connection
cdb.ConnectionString = CurrentProject.Connection.ConnectionString
End If
If cdb.State = 0 Then cdb.Open
Set db = cdb
On Error GoTo 0
Exit Property
db_Error:
MsgBox "Error " & err.Number & " (" & err.Description & ") in procedure db of Module pubvar"
End Property
Public Property Get cworker() As worker
On Error GoTo cworker_Error
If wworker Is Nothing Then
Set wworker = New worker
End If
Set cworker = wworker
On Error GoTo 0
Exit Property
cworker_Error:
MsgBox "Error " & err.Number & " (" & err.Description & ") in procedure cworker of Module pubvar"
End Property
Public Function autostart()
On Error GoTo autostart_Error
Set wworker = Nothing
Set wworker = New worker
Debug.Print cworker.idworker & " - " & cworker.wtype
If cworker.idworker > 0 Then
If cworker.idworker >= 1 And cworker.idworker <= 3 Then
If cworker.idworker <= 2 Then SendKeys "{F11}"
DoCmd.OpenForm "Вводкурса", , , , , acDialog
ElseIf cworker.idworker > 3 Then
SendKeys "{F11}"
DoCmd.OpenForm "БоссАналитика"
Else
MsgBox "Проблема определения типа пользователя!", vbCritical
End If
If cworker.idworker = 3 Then Application.SetOption "Show Hidden Objects", True Else Application.SetOption "Show Hidden Objects", False
Else
MsgBox "Проблема определения пользователя!", vbCritical
End If
On Error GoTo 0
Exit Function
autostart_Error:
MsgBox "Error " & err.Number & " (" & err.Description & ") in procedure autostart of Module pubvar"
End Function
Так вот при запуске через "обновлялку" уже сразу в момент создания экземпляра класса worker в
Set wworker = New worker, его свойство idworker и ее локальная копия cidworker оказываются не нулевыми, а равными "старым" значениям с компа, с корого скопировали клиента. Серверная функция idworker() всегда отдает
правильного пользователя. Т.е. пользователь по маку определился, а вот откуда он берет "заполненную" локальную переменную cidworker?
Обновлялка запускает базу так:
Dim aspath As String
Dim pathcur As String
pathcur = CurrentProject.Path
aspath = SysCmd(acSysCmdAccessDir)
Shell """" & aspath & "msaccess.exe""" & " " & """" & pathcur & "\Склад Клиент-ver" & ver & ".adp""", vbMaximizedFocus
Предварительно взяв все нужные пути для запуска.
http://www.sql.ru/forum/1087763/strannoe-povedenie-access-adp
