VB6 Mutex? Need to Eliminate Race Conditions

[JohnPitchko]

Hello,

I have to seperate VB6 applications that are trying to perform the same operation on the same target process. That is, each VB6 application is trying to save an Excel spreadsheet at the same time. I believe this is causing our most recent errors with our application, resulting in one application being killed by the other.

Is it possible to create mutexes in VB6? If not, can anyone any other advice as to how to eliminate this race condition?

[I_Love_My_Vans]

Um, a computer can, believe it or not only do one thing at a time, so one has saved the excel spreadsheet, and the other has to be dissapointed. I think that is how it works

Can you not try and work around the problem by overwriting or checking to see if the file exists, and declining access if it does exist.

ILMV

[pnish]

There is an API called CreateMutex which would suggest that you can create a mutex from VB6. Don't ask me how though! Any API gurus out there listening?

Private Declare Function CreateMutex Lib "kernel32.dll" Alias "CreateMutexA" _
    (lpMutexAttributes As SECURITY_ATTRIBUTES, ByVal bInitialOwner As Long, ByVal lpName As String) As Long

[MartinLiss]

Here is an example from the API Guide which calls this code an "Advanced PrevInstance".

'Code by Adam Verwijs
Const ERROR_ALREADY_EXISTS = 183&
Private Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (lpMutexAttributes As Any, ByVal bInitialOwner As Long, ByVal lpName As String) As Long
Private Declare Function ReleaseMutex Lib "kernel32" (ByVal hMutex As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Sub Form_Load()
    Dim hMutex As Long
    'Try to create a new Mutex
    hMutex = CreateMutex(ByVal 0&, 1, App.Title)
    'Did the mutex already exist?
    If (Err.LastDllError = ERROR_ALREADY_EXISTS) Then
        'Clean up
        ReleaseMutex hMutex
        CloseHandle hMutex
        'More than one instance detected
        MsgBox "More than one instance"
        End
    Else
        'form load code
    End If
End Sub

[anotherVBnewbie]

I believe you might resolve this by only allowing a single user to gain write access to the document at any time - others could open the document, if that is something to be desired, but only for reading. Perhaps the OpenFile API will help you resolve the problem....

Declare Function OpenFile Lib "kernel32" Alias "OpenFile" ( _
    ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, _
    ByVal wStyle As Long) As Long
 
' some wStyle options
Const OF_READ As Long = &H0 'Opens the file for reading only.
Const OF_READWRITE As Long = &H2 'Opens the file for reading and writing.
Const OF_SHARE_DENY_WRITE As Long = &H20 'denies write access to others
Const OF_SHARE_EXCLUSIVE As Long = &H10 'denies any access to others
Const OF_VERIFY As Long = &H400 'Verifies that the date and time of the file
Const OF_WRITE As Long = &H1 'Opens the file for writing only
 
' info for lpReOpenBuff 
Const OFS_MAXPATHNAME As Long = 128
 
Type OFSTRUCT
    cBytes As Byte 
    fFixedDisk As Byte 
    nErrCode As Integer 
    Reserved1 As Integer 
    Reserved2 As Integer 
    szPathName(OFS_MAXPATHNAME) As Byte 
End Type

[yrwyddfa]

Mutexes are kinda heavy system objects - although the code Marty posted should work fine

Lighter (more efficient?) things to look out for are Semaphores, and Events.

[JohnPitchko]

Um, a computer can, believe it or not only do one thing at a time, so one has saved the excel spreadsheet, and the other has to be dissapointed. I think that is how it works

Can you not try and work around the problem by overwriting or checking to see if the file exists, and declining access if it does exist.

ILMV

This is just flamebait... Moving on.

To the other people who actually understand my problem and provide meaningful solutions, thank you very much. I will look into the API and sample code for mutexes. I will also check out semaphores (its been a while since I was in OS class, so I completely forgot about these).

Also I should clarify; the two VB apps are trying to save different spreadsheets that are open in one Excel process. That is, there is a single Excel process which contains all open spreadsheets.

[yrwyddfa]

Yeah a semaphore or event should be able to handle this quite nicely.

[JohnPitchko]

Ok so my question now is, where can I find information about how to create and use a semaphore in VB6?

[yrwyddfa]

If you can wait until tomorrow then I'll post some code. It's a bank holiday here at the moment so I'm sitting in the sun drinking beer.

What the hell I'm doing with my laptop on reading this forum is anybodies guess . . .

[JohnPitchko]

You just love VB6 I guess....

[BrianHawley]

We often use a plain text flag file for this sort of thing. i.e. a situation with no inbuilt locking protocols.

Try to create/open the flag file for read/write. If it opens, put the current user name in the file, do the task, then close/delete the file.

If it fails, optionally open as read only and see which user has the lock. Feed back to the application user if required.

This has the advantage of using a file lock, which will clear automatically (eventually) if somebody locks the file then crashes off the network without unlocking it.

Sorry no code as I'm away from the office, but can post tomorrow if you need it.

[JohnPitchko]

Thanks, I've tried implementing the following code:

    hMutex = CreateMutex(ByVal 0&, True, "BDP")
    'Did the mutex already exist?
    While (Err.LastDllError = ERROR_ALREADY_EXISTS)
        Call out.Display("Waiting for the mutex...", True, True)
        Sleep (10000)
        hMutex = OpenMutex(ByVal 0&, True, "BDP")
       
    Wend
    ...
    ...
    ...
    ReleaseMutex hMutex

I put a spinlock so one process should wait until another one has released the mutex. However, I believe the OpenMutex line is throwing me off. Any ideas?

[JohnPitchko]

Thanks, I've tried implementing the following code:

    hMutex = CreateMutex(ByVal 0&, True, "BDP")
    'Did the mutex already exist?
    While (Err.LastDllError = ERROR_ALREADY_EXISTS)
        Call out.Display("Waiting for the mutex...", True, True)
        Sleep (10000)
        hMutex = OpenMutex(ByVal 0&, True, "BDP")
       
    Wend
    ...
    ...
    ...
    ReleaseMutex hMutex

I put a spinlock so one process should wait until another one has released the mutex. However, I believe the OpenMutex line is throwing me off. Any ideas?

[yrwyddfa]

I changed my mind and now believe that an 'event' is probably the best way forward for this particular task.

Please find attached a class 'CFilelock'

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

[yrwyddfa]

One little caveat: only for Win2k or later machines (unless the Unicode platform is installed)

[JohnPitchko]

Thanks yrwyddfa,

I stuck with the mutexes, but I used your code as inspiration. Everything works great and our 3 VB apps now seem to play nice with each other.