Get Active Users List

Legend

Somebody sent me the incorrect code to get the list of active users of an mdb. I did corrections and it works OK now. Please send me a reference to the source of this code if you know it.
Corrected Code

Option Compare Database
Option Explicit

Type SECURITY_ATTRIBUTES
   nLength As Long
   lpSecurityDescriptor As Long
   bInheritHandle As Long
End Type

Type OVERLAPPED
   Internal As Long
   InternalHigh As Long
   offset As Long
   OffsetHigh As Long
   hEvent As Long
End Type

Type SecInfo
    bMachine(1 To 32) As Byte
    bSecurity(1 To 32) As Byte
End Type

Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

Type BY_HANDLE_FILE_INFORMATION
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        dwVolumeSerialNumber As Long
        nFileSizeHigh As Long
        nFileSizeLow As Long
        nNumberOfLinks As Long
        nFileIndexHigh As Long
        nFileIndexLow As Long
End Type

Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
                           (ByVal lpFileName As String, _
                            ByVal dwDesiredAccess As Long, _
                            ByVal dwShareMode As Long, _
                            lpSecurityAttributes As SECURITY_ATTRIBUTES, _
                            ByVal dwCreationDisposition As Long, _
                            ByVal dwFlagsAndAttributes As Long, _
                            ByVal hTemplateFile As Long) As Long

Declare Function CloseHandle Lib "kernel32" _
                            (ByVal hObject As Long) As Long

Declare Function LockFile Lib "kernel32" _
                            (ByVal hFile As Long, _
                             ByVal dwFileOffsetLow As Long, _
                             ByVal dwFileOffsetHigh As Long, _
                             ByVal nNumberOfBytesToLockLow As Long, _
                             ByVal nNumberOfBytesToLockHigh As Long) As Long
                             
Declare Function UnlockFile Lib "kernel32" _
                           (ByVal hFile As Long, _
                            ByVal dwFileOffsetLow As Long, _
                            ByVal dwFileOffsetHigh As Long, _
                            ByVal nNumberOfBytesToUnlockLow As Long, _
                            ByVal nNumberOfBytesToUnlockHigh As Long) As Long
                            
Declare Function SetFilePointer Lib "kernel32" _
                           (ByVal hFile As Long, _
                           ByVal lDistanceToMove As Long, _
                           lpDistanceToMoveHigh As Long, _
                           ByVal dwMoveMethod As Long) As Long
                           
Declare Function ReadFile Lib "kernel32" _
                           (ByVal hFile As Long, _
                           lpBuffer As Any, _
                           ByVal nNumberOfBytesToRead As Long, _
                           lpNumberOfBytesRead As Long, _
                           lpOverlapped As Any) As Long

Declare Function lread Lib "kernel32" Alias "_lread" (ByVal hFile As Long, _
                           lpBuffer As Any, ByVal wBytes As Long) As Long

Declare Function GetFileInformationByHandle Lib "kernel32" _
                           (ByVal hFile As Long, lpFileInformation As BY_HANDLE_FILE_INFORMATION) As Long
Declare Function GetFileType Lib "kernel32" (ByVal hFile As Long) As Long
Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long

Dim mSecurity As SECURITY_ATTRIBUTES
Dim mFileHandle As Long
Dim mFileInfo As BY_HANDLE_FILE_INFORMATION

Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const FILE_SHARE_READ = &H1
Public Const FILE_SHARE_WRITE = &H2
Public Const FILE_FLAG_RANDOM_ACCESS = &H10000000
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const OPEN_EXISTING = 3

Public Const FILE_BEGIN = 0
Public Const FILE_CURRENT = 1
Public Const FILE_END = 2

Public Function a_test()
    Dim strPath As String
    Dim strActiveUserList As String
    
    strPath = CodeDb().Name
    strPath = Mid(strPath, 1, InStr(1, strPath, ".") - 1) & ".ldb"
    strActiveUserList = ReadLocks(strPath)
    MsgBox strActiveUserList
End Function

Public Function ReadLocks(ByVal vstrDBPath As String) As String
                          
    Dim USecInfo As SecInfo
    Dim aszTempUserList(0 To 254, 0 To 2) As String
    Dim aszUserList() As String
    Dim iaCnt As Integer
    Dim iCnt As Integer
    Dim iOffset As Integer
    Dim lBytesRead As Long
    Dim myoverlap As OVERLAPPED
    Dim dwPos As Long
    Dim lLock As Long
    Dim lByte As Long
    Dim strValueList As String
    Dim lngRet As Long

    With mSecurity
        .nLength = Len(mSecurity)
        .lpSecurityDescriptor = 0
        .bInheritHandle = True
    End With

    mFileHandle = CreateFile( _
                  vstrDBPath, _
                  GENERIC_READ Or GENERIC_WRITE, _
                  FILE_SHARE_READ Or FILE_SHARE_WRITE, _
                  mSecurity, _
                  OPEN_EXISTING, _
                  FILE_FLAG_RANDOM_ACCESS Or FILE_ATTRIBUTE_NORMAL, _
                  0)

    If mFileHandle = 0 Then
        MsgBox "Cannot open ldb"
        ReadLocks = ""
        Exit Function
    End If
    
    'lngRet = GetFileInformationByHandle(mFileHandle, mFileInfo)
    
    SetFilePointer mFileHandle, 0, 0, FILE_BEGIN
    iOffset = 0
    iaCnt = 0

    Do
        'If ReadFile(mFileHandle, USecInfo, 64, lBytesRead, 0) = 0 Then
        lBytesRead = lread(mFileHandle, USecInfo, 64)
        If lBytesRead = 0 Then Exit Do
        If lBytesRead <> 64 Then
            MsgBox "error reading ldb"
            ReadLocks = ""
            Exit Function
        End If
        
        With USecInfo
            aszTempUserList(iaCnt, 0) = szBytesToString(.bSecurity)
            aszTempUserList(iaCnt, 1) = szBytesToString(.bMachine)
            aszTempUserList(iaCnt, 2) = iOffset
        End With
        iaCnt = iaCnt + 1
        iOffset = iOffset + 64
    Loop

    iaCnt = 0
    dwPos = &H10000001
    strValueList = "User name;Machine;"
    Do Until dwPos = &H100000FF
        lLock = LockFile(mFileHandle, dwPos, 0, 1, 0)
        If lLock = 0 Then
            lByte = lHexToLong(Right$(Hex(dwPos), 2))
            iOffset = lByte * 64 - 64
            For iaCnt = 0 To 254
                If aszTempUserList(iaCnt, 2) = "" Then Exit For
                If aszTempUserList(iaCnt, 2) = iOffset Then
                    strValueList = strValueList & _
                                   aszTempUserList(iaCnt, 0) & ";" & _
                                   aszTempUserList(iaCnt, 1) & ";"
                End If
            Next iaCnt
        Else
            lLock = UnlockFile(mFileHandle, dwPos, 0, 1, 0)
        End If
        dwPos = dwPos + 1
    Loop

    CloseHandle (mFileHandle)
    ReadLocks = strValueList
End Function

Public Function szBytesToString(pbytArray() As Byte) As String
    Dim szTemp As String
    
    szTemp = StrConv(pbytArray(), vbUnicode)
    szBytesToString = Left$(szTemp, (InStr(1, szTemp, Chr(0))) - 1)
End Function

Public Function lHexToLong(ByVal szHex As String) As Long
    lHexToLong = Val("&H " & szHex & "&")
End Function