Visual Basic > Database SQL Stuff

Retrieve a list of the users logged on to an Access-Jet Database

Retrieve a list of the users logged on to an Access-Jet Database

Below is a routine which determines the users logged into an access database.
A sample routine showing how to call the code is at the bottom of this post.

Option Explicit

'----------Type to hold results------------
'For each person who opens a shared database, the Jet database engine writes an entry
'in the database's .ldb file. The size of each .ldb entry is 64 bytes. The first 32
'bytes contains the computer name. The second 32 bytes contains the
'security name (such as Admin).
Private Type tDBUser
    UserName As String * 32
    SecurityName As String * 32
End Type


'Purpose     :  Retreives a list of users attached to an Access Database by parsing the ldb file
'Inputs      :  asUsers                         See outputs
'               sLDBFilePath                    The path and file name of the ldb file
'Outputs     :  asUsers                         A 2d string array 1 to 2, 1 to Number of users
'                                               Where   asUsers(1,1)      =       First user name
'                                                       asUsers(2,1)      =       User's security access
'               Returns 0 if their are no users or the lock file doesn't exist.
'               Returns -1 on error.


Function DatabaseUsers(ByRef asUsers() As String, sLDBFilePath As String) As Long
    Const clMaxUsers As Long = 255      'The maximum number of concurrent users that the Jet database engine supports is 255
    Dim iFileNum As Integer
    Dim tThisUser As tDBUser
    
    On Error GoTo ErrFailed
    If Len(Dir$(sLDBFilePath)) > 0 And Len(sLDBFilePath) > 0 Then
        'Lock file exists, open file.
        iFileNum = FreeFile
        Open sLDBFilePath For Random As #iFileNum Len = Len(tThisUser)
        'Create buffer to store results
        ReDim asUsers(1 To 2, 1 To clMaxUsers)
        'Read data into fixed length type
        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)
            'Read next record
            Get iFileNum, DatabaseUsers + 1, tThisUser
        Loop
        'Close file
        Close #iFileNum
        'Resize results
        ReDim Preserve asUsers(1 To 2, 1 To DatabaseUsers)
    Else
        'No users attached
        Erase asUsers
    End If
    Exit Function
ErrFailed:
    DatabaseUsers = -1
    Erase asUsers
End Function

'Demonstration routine
Sub Test()
    Dim asUsers() As String, lNumUsers As Long, lThisUser As Long

    lNumUsers = DatabaseUsers(asUsers, "D:\Work\Visual Basic\Net Send\NetSend.ldb")
    For lThisUser = 1 To lNumUsers
        Debug.Print "User Name: " & asUsers(1, lThisUser)
        Debug.Print "Security : " & asUsers(2, lThisUser)
    Next
End Sub