VB and VBA Users Source Code: Synchronizing access to a system wide resource (using a mutex)
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Synchronizing access to a system wide resource (using a mutex)
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Friday, April 15, 2005
Hits:
2226
Category:
Windows API
Article:
It is often desireable to only allow a single thread (or process) to gain access to a named resource at any given point in time. The example code below shows you how to synchronised access to a file using a named mutex. Option Explicit Private Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (ByVal lpMutexAttributes As Long, ByVal bInitialOwner As Long, ByVal lpName As String) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function ReleaseMutex Lib "kernel32" (ByVal hMutex As Long) As Long Private Declare Function OpenMutex Lib "kernel32.dll" Alias "OpenMutexA" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal lpName As String) As Long Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'Purpose : Removes invalid characters from a mutex name. 'Inputs : sMutexName The name of the mutex to validate. 'Outputs : Returns a valid mutex name. 'Author : Andrew Baker 'Date : 01/11/2000 13:17 'Notes : 'Revisions : 'Assumptions : Public Function GetValidMutexName(sMutexName As String) As String Dim result As String result = sMutexName result = Replace(result, "\", "|") result = Replace(result, "/", "|") GetValidMutexName = result End Function 'Purpose : Releases the named mutex. 'Inputs : sMutexName The name of the mutex to release. 'Outputs : N/A 'Author : Andrew Baker 'Date : 01/11/2000 13:17 'Notes : Called after a successful call to GetNamedMutex. 'Revisions : 'Assumptions : Public Sub ReleaseNamedMutex(sMutexName As String) Dim lMutexHwnd As Long Dim sValidMutexName As String Dim lRet As Long Const ERROR_ALREADY_EXISTS = 183&, MUTEX_ALL_ACCESS = &H1F0001 'Attempt to create a Mutex object sValidMutexName = GetValidMutexName(sMutexName) lMutexHwnd = OpenMutex(MUTEX_ALL_ACCESS, 0, sValidMutexName) If (lMutexHwnd = 0) Then 'Failed to create Mutex object, the mutex is already open Debug.Print "The mutex '" & sMutexName & "' does not exist." Debug.Assert False Else 'Release the Mutex object. lRet = ReleaseMutex(lMutexHwnd) If lRet = 0 Then Debug.Assert "Failed to release mutex (check this process owns the mutex)" End If lRet = CloseHandle(lMutexHwnd) End If End Sub 'Purpose : Attempts to acquire the named mutex. 'Inputs : sMutexName The name of the mutex to acquire. 'Outputs : Returns true if the mutex was acquired, else returns false. 'Author : Andrew Baker 'Date : 01/11/2000 13:17 'Notes : Design to provide machine wide synchronization to a named resource. 'Revisions : 'Assumptions : Public Function AcquireNamedMutex(sMutexName As String, lWaitTimeout As Long) As Boolean Const ERROR_ALREADY_EXISTS = 183&, MUTEX_ALL_ACCESS = &H1F0001 Const WAIT_FAILED = -1& 'Error on call Const WAIT_OBJECT_0 = 0 'Normal completion Const WAIT_TIMEOUT = &H102& 'Timeout period elapsed Dim lMutexHwnd As Long, lWaitResult As Long Dim sValidMutexName As String 'Attempt to create a Mutex object sValidMutexName = GetValidMutexName(sMutexName) lMutexHwnd = OpenMutex(MUTEX_ALL_ACCESS, 0, sValidMutexName) If lMutexHwnd = 0 Then 'The mutex has not been created, grab it lMutexHwnd = CreateMutex(ByVal 0, 1, sValidMutexName) If lMutexHwnd <> 0 Then 'Mutex acquired AcquireNamedMutex = True Else 'Error occurred Debug.Print "Failed to create mutex '" & sMutexName & "'." Debug.Assert False AcquireNamedMutex = False End If Else 'The mutex is locked, try to wait for it lWaitResult = WaitForSingleObject(lMutexHwnd, lWaitTimeout) Select Case lWaitResult Case WAIT_TIMEOUT 'Mutex is still open (didn't acquire it before timeout). AcquireNamedMutex = False Case WAIT_OBJECT_0 'Process owning the mutex has closed. AcquireNamedMutex = True Case Else 'Error AcquireNamedMutex = False End Select Call CloseHandle(lMutexHwnd) End If End Function 'To properly test this you need to start either two threads, or two process (eg. Two VB or Excel applications) 'and try to get access to the same name mutex simulatenously. You will see 'that only one of the threads/processes can acquire the mutex at a given time. Sub Test() 'Example using a file name If AcquireNamedMutex("C:\MyFile.dat", 1000) Then Call MsgBox("Acquired file mutex") 'Simulate doing some work Sleep 2000 'Now release the mutex Call ReleaseNamedMutex("C:\MyFile.dat") Else Call MsgBox("Didn't acquired file mutex, the mutex must already be owned by another thread/process") End If End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder