Option Explicit
'***************************
'* Win32 Declarations . . .
'***************************
Private Declare Function OpenEventW Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal lpName As Long) As Long
Private Declare Function CreateEventW Lib "kernel32" (lpEventAttriutes As Long, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As Long) As Long
Private Declare Function ResetEvent Lib "kernel32" (ByVal hEvent As Long) As Long
Private Declare Function SetEvent Lib "kernel32" (ByVal hEvent As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'************************
'* Win32 Constants . . .
'************************
Private Const WAIT_ABANDONED As Long = &H80
Private Const WAIT_OBJECT_0 As Long = &H0
Private Const WAIT_TIMEOUT As Long = &H102
'**************************
'* Local state stuff . . .
'**************************
Private mFile As String
Private mhEvent As Long
Private mTimeout As Long
Private mRetry As Long
Private Sub Class_Initialize()
mTimeout = 100
mRetry = 3
End Sub
Private Sub Class_Terminate()
CloseHandle mhEvent
End Sub
Public Property Let File(Name As String)
mFile = Name
End Property
Public Property Get File() As String
File = mFile
End Property
Public Property Let Timeout(Milliseconds As Long)
mTimeout = Milliseconds
End Property
Public Property Get Timeout() As Long
Timeout = mTimeout
End Property
Public Property Let Retry(Num As Long)
mRetry = Num
End Property
Public Property Get Retry() As Long
Retry = mRetry
End Property
Public Function LockFile() As Boolean
On Error GoTo ERR_Lockfile
Dim lWait As Long
Dim i As Long
'**********************************************************************
'* Try to get a handle to the event. If we can't then create one . . .
'**********************************************************************
mhEvent = OpenEventW(0&, False, StrPtr(mFile))
If Not mhEvent Then
mhEvent = CreateEventW(0&, True, True, StrPtr(mFile))
End If
'**********************************************
'* Wait for the event to become signalled . . .
'**********************************************
For i = 1 To mRetry
'**********************************************
'* Wait for the event to become signalled . . .
'**********************************************
lWait = WaitForSingleObject(mhEvent, mTimeout)
'****************************************************************
'* The event has become signalled. We need to now set it to be
'* non signalled so we have a lock on the event . . .
'****************************************************************
If lWait = WAIT_OBJECT_0 Then
ResetEvent mhEvent
LockFile = True
Exit For
End If
Next
Exit Function
ERR_Lockfile:
CloseHandle mhEvent
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Function
Public Sub ReleaseFile()
On Error GoTo ERR_ReleaseFile
'******************************************************************
'* Set the event to be signalled so other processes wait functions
'* return immediately . . .
'******************************************************************
SetEvent mhEvent
CloseHandle mhEvent
Exit Sub
ERR_ReleaseFile:
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Sub