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