Wednesday, 27 November 2019

VBA, WinAPI - Simpler IPC synchronisation Events

In this post I give simple VBA code to create an Event object for Windows synchronization. In the last post I gave some C++ code which was complicated by some extra lines for security descriptors, it turns out one can pass NULL instead of creating a security descriptor meaning I could written simpler C++ code. Instead of rewriting the C++ I will write the new code as VBA.

You'll need a instance of Microsoft Excel and a instance of Microsoft Word (or two VBA devlopment environments, Excel, Word, Access etc.); one instance will create the event and the other will wait upon the event.

VBA code to create a Windows Synchronization Event object

This code requires the GetSystemErrorMessageText module from Chip Pearson to give nice error messages for any errors encountered using the WinAPI, I recommend!

Copy the code below into a module in one your two VBA development environments. For me, I am running this in Excel.

Option Explicit

Private Declare Function CreateEventWithoutSec Lib "kernel32" Alias "CreateEventA" (ByVal lpEventAttributes As Long, ByVal bManualReset As Long, _
      ByVal bInitialState As Long, ByVal lpName As String) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function SetEvent Lib "kernel32.dll" (ByVal hEvent As Long) As Long
Private Declare Function ResetEvent Lib "kernel32.dll" (ByVal hEvent As Long) As Long

Private Sub CreateEventWithoutSecurity()

    Dim hEvent As Long

    hEvent = CreateEventWithoutSec(0, 1, 0, "ExcelWordIPC1")
    If hEvent = 0 Then
        Debug.Print GetSystemErrorMessageText(Err.LastDllError)
        GoTo SingleExit
    Else
        Stop
        Call SetEvent(hEvent)
    
        Stop
        Call ResetEvent(hEvent)
    
    End If
    
SingleExit:
    If hEvent <> 0 Then
        Call CloseHandle(hEvent)
        hEvent = 0
    End If
End Sub

VBA code to wait upon a Windows Synchronization Event object

This code also requires the GetSystemErrorMessageText module from Chip Pearson to give nice error messages for any errors encountered using the WinAPI, I recommend!

Copy the code below into a module in the other of your two VBA development environments. For me, I am running this in Word.

Option Explicit

Private Const SYNCHRONIZE As Long = &H100000

Private Declare Function OpenEvent Lib "kernel32.dll" Alias "OpenEventA" (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 Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Enum eWaitResult
    WAIT_ABANDONED = &H80       'The specified object is a mutex object that was not released by the thread that owned the mutex
    WAIT_OBJECT_0 = &H0         'The state of the specified object is signaled.
    WAIT_TIMEOUT = &H102        'The time-out interval elapsed, and the object's state is nonsignaled.
    WAIT_FAILED = &HFFFFFFFF    'The function has failed. To get extended error information, call GetLastError.
End Enum

Sub OpenEventAndSet()

    Dim hEvent As Long
    hEvent = OpenEvent(SYNCHRONIZE, 0, "ExcelWordIPC1")
    If hEvent = 0 Then
        Debug.Print "Failed in call to OpenEvent."
        Debug.Print GetSystemErrorMessageText(Err.LastDllError)
    Else
        Dim dwWaitResult As eWaitResult
        dwWaitResult = WaitForSingleObject(hEvent, -1)
        
        Stop
        Select Case dwWaitResult
        
        Case eWaitResult.WAIT_OBJECT_0
            Debug.Print "The state of the specified object is signalled."
        Case eWaitResult.WAIT_TIMEOUT
            Debug.Print "wait timeout"
            
        Case eWaitResult.WAIT_FAILED
            Debug.Print "wait failed"
            Debug.Print GetSystemErrorMessageText(Err.LastDllError)
        Case eWaitResult.WAIT_ABANDONED
            Debug.Print "wait abandoned"
        End Select
        'Stop
        Call CloseHandle(hEvent)
    End If
    
    'Stop
End Sub

So if you run the first block of code until it reaches the Stop statement just above SetEvent and then switch to the other block and run that then the latter will wait in the call to WaitForSingleObject(); switch back to the former code and then press F5 to allow the code to run the SetEvent() line of code then you should find that in the latter code environment the code has exited WaitForSingleObject() and is waiting at the Stop statement.

Congratulations if you got this far as you have stepped through an IPC signal code sample. If you are more interested I suggest the previous post as there are many documentation links in the text.

Epilogue

So there is a trick to the above simplification where we skip security attributes, and it involves rewriting the Declare Function CreateEvent statement. A fuller, more correct declaration of CreateEvent would look like this ...

Private Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (lpEventAttributes As SECURITY_ATTRIBUTES, _ 
    ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As String) As Long

So in the above declaration we can see the first argument is of type SECURITY_ATTRIBUTES but the API allows a NULL (zero) to be passed to this argument, this is not possible in VBA with the above Declare Function signature. If you try passing zero as the first argument then you get a type mismatch. Instead it needs rewriting so that the first argument is of type Long so we can pass a zero (which is what NULL actually is in C++). So the new Declare Function statement becomes (as found in above listing) ...

Private Declare Function CreateEventWithoutSec Lib "kernel32" Alias "CreateEventA" (ByVal lpEventAttributes As Long, ByVal bManualReset As Long, _
    ByVal bInitialState As Long, ByVal lpName As String) As Long

And I have renamed the function declaration CreateEventWithoutSec to signify what I am doing here. This is a useful trick in calling a Windows API function precisely for our use case and worth remembering as this may arise in other contexts.

No comments:

Post a Comment