Připojení uživatelé k databázi MS Access

Postup:
Každému uživateli, který si otevře sdílenou databázi, vytvoří JET záznam v souboru .ldb. Tento soubor si stačí přečíst a víme, kdo je připojen. Samozřejmě, že pokud uživatel nekorektním způsobem pak ukončí práci s databází, tak v tomto souboru zůstane jeho záznam viset. V ldb souboru JET ukládá dva údaje - jméno uživatele a jakési jeho bezpečností jméno.

Option Explicit

Private Type tDBUser
   UserName As String * 32
   SecurityName As String * 32
End Type

Function DatabaseUsers(ByRef asUsers() As String, _
   sLDBFilePath As String) As Long

   Const clMaxUsers As Long = 255
   Dim iFileNum As Integer
   Dim tThisUser As tDBUser

   On Error GoTo ErrFailed
   If Len(Dir$(sLDBFilePath)) > 0 And Len(sLDBFilePath) > 0 Then
      iFileNum = FreeFile
      Open sLDBFilePath For Random As #iFileNum Len = Len(tThisUser)
      ReDim asUsers(1 To 2, 1 To clMaxUsers)
      Get iFileNum, 1, tThisUser
      Do While Not EOF(iFileNum)
         DatabaseUsers = DatabaseUsers + 1
         asUsers(1, DatabaseUsers) = Left$(tThisUser.UserName, _
             InStr(1, tThisUser.UserName, vbNullChar) - 1)
         asUsers(2, DatabaseUsers) = Left$(tThisUser.SecurityName, _
             InStr(1, tThisUser.SecurityName, vbNullChar) - 1)
         Get iFileNum, DatabaseUsers + 1, tThisUser
      Loop
      Close #iFileNum
      ReDim Preserve asUsers(1 To 2, 1 To DatabaseUsers)
   Else
      Erase asUsers
   End If

Exit Function

ErrFailed:
   DatabaseUsers = -1
   Erase asUsers

End Function

Příklad použití
Sub Test()

   Dim asUsers() As String, lNumUsers As Long, lThisUser As Long

   lNumUsers = DatabaseUsers(asUsers, "C:\bozena.ldb")
   For lThisUser = 1 To lNumUsers
      Debug.Print "User Name: " & asUsers(1, lThisUser)
      Debug.Print "Security: " & asUsers(2, lThisUser)
   Next

End Sub

Zpět