-Поиск по дневнику

Поиск сообщений в rss_sql_ru_access_programming

 -Подписка по e-mail

 

 -Постоянные читатели

 -Статистика

Статистика LiveInternet.ru: показано количество хитов и посетителей
Создан: 16.03.2006
Записей:
Комментариев:
Написано: 4


Странное поведение Access ADP

Вторник, 08 Апреля 2014 г. 17:17 + в цитатник
После перехода на 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


 

Добавить комментарий:
Текст комментария: смайлики

Проверка орфографии: (найти ошибки)

Прикрепить картинку:

 Переводить URL в ссылку
 Подписаться на комментарии
 Подписать картинку