This code reads and display the .LDB file generated by MS Access where informations about connected users are logged.
The use :
Debug.Print Global_ReadAccessLockFile("D:\YourDatabase.ldb")
and will return
MY_LAPTOP;Admin;YES
Computer Name;User Name;Locking user
The use :
Debug.Print Global_ReadAccessLockFile("D:\YourDatabase.ldb")
and will return
MY_LAPTOP;Admin;YES
Computer Name;User Name;Locking user
Code:
' #VBIDEUtils#************************************************************
' * Author :
' * Web Site :
' * E-Mail :
' * Date : 10/11/2008
' * Module Name : Module1
' * Module Filename : LDB.bas
' * Purpose :
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
Option Explicit
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private 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
Private 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
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const OPEN_EXISTING = 3
Private Const START_LOCK = &H10000001 ' *** Start of locks
Public Function Global_ReadAccessLockFile(Optional sFile As String = vbNullString) As String
' #VBIDEUtils#***********************************************************
' * Author :
' * Web Site :
' * E-Mail :
' * Date : 10/11/2008
' * Module Name : LDB_Module
' * Module Filename : ldb.bas
' * Procedure Name : Global_ReadAccessLockFile
' * Purpose :
' * Parameters :
' * Optional sFile As String = vbNullString
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
' #VBIDEUtilsERROR#
On Error GoTo ERROR_Handler
Dim hFile As Long
Dim nReturn As Long
Dim nBytesRead As Long
Dim sComputer As String
Dim sUser As String
Dim nUsers As Long
Dim sUsersLock As String
sUsersLock = vbNullString
If LenB(sFile) = 0 Then GoTo Exit_Handler
' *** Open file in protected mode
hFile = CreateFile(ByVal sFile, ByVal GENERIC_READ Or GENERIC_WRITE, ByVal FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, ByVal OPEN_EXISTING, ByVal 0&, ByVal 0&)
If hFile <> -1 Then
Do
nUsers = nUsers + 1
' *** Retrieve the computer name
sComputer = Space(32)
nReturn = ReadFile(hFile, ByVal sComputer, 32, nBytesRead, ByVal 0&)
sComputer = Left$(sComputer, InStr(sComputer, Chr(0)) - 1)
If (nReturn = 0) Or (nBytesRead = 0) Then Exit Do
' *** Retrieve the user name
sUser = Space(32)
nReturn = ReadFile(hFile, ByVal sUser, 32, nBytesRead, ByVal 0&)
sUser = Left$(sUser, InStr(sUser, Chr(0)) - 1)
If nReturn = 0 Or nBytesRead = 0 Then Exit Do
' *** Check if the user is still connected by lock the file, and log with computer name, IP adress and User name
If LockFile(hFile, START_LOCK + nUsers - 1, 0, 1, 0) = 0 Then
' *** An error occured, so it is still locked by the user
sUsersLock = sUsersLock & sComputer & ";" & sUser & ";YES" & vbCrLf
Else
' *** Nothing special, the user isn't locking
sUsersLock = sUsersLock & sComputer & ";" & sUser & ";NO" & vbCrLf
Call UnlockFile(hFile, START_LOCK + nUsers - 1, 0, 1, 1)
End If
Loop
CloseHandle hFile
End If
Exit_Handler:
On Error Resume Next
Global_ReadAccessLockFile = sUsersLock
Exit Function
' #VBIDEUtilsERROR#
ERROR_Handler:
Resume Exit_Handler
Resume
End Function