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