[VB6] - Class for waiting asynchronous kernel objects.
Hello everyone! Developed a class for asynchronous waiting kernel objects. The class generates an event when setting the object to the signaled state or timeout. Works with any objects.* The class has 3 methods: vbWaitForSingleObject, vbWaitForMultipleObjects, IsActive, Abort. The first two are similar to call API functions of the same name without the prefix "vb" and start waiting for the object in the new thread. Methods terminated immediately. Upon completion of the functions in the new thread is generated event OnWait, the parameters of which contains a handle of the object and the returned value. If successful, the method returns True, otherwise False, and throws an exception. IsActive - returns True, if there is the expectation, otherwise False. Abort - aborts expectation on success returns True.* The instance can handle only one call at a time.* In the example I have prepared 3 cases of the use of this class: tracking teak waiting timer, tracking the completion of the application, tracking file operations in a folder.
Module clsTrickWait.cls:
Re: [VB6] - Class for waiting asynchronous kernel objects.
How does this work.
Creates a window to receive notifications in the main thread. When you call the expectations created a new thread with the same name API function. When the function fulfills (for signal state, timeout or error), it sends a message to our window, which is treating it generates an event for the current object instance. All manipulations are done in assembly language, allowing to manage one class (without modules), to the same for all instances of the same code is used. Also made a small test in the IDE (in compiled form is not present), so you can stop with the "environment", press pause, without consequences (events simply will not be called). The only way to "crash" can occur if you start waiting, stop it using the Stop button (do not call the destructor). Then again start the IDE - if at this point will work an event from the past run - will crash because the object no longer exists.
Code in assembler (NASM):
Code:
[BITS 32]
WAITFORSINGLEOBJECT:
mov ecx, [esp+4]
push ecx
push dword [ecx+4] ; dwTime
push dword [ecx] ; hHandle
call 0x12345678 ; WaitForSingleObject
pop ecx
mov dword [ecx+32], eax ; Long -> Variant
lea eax, [ecx+12]
push eax ; Параметры в RAISE (lParam)
push eax ; --- (wParam)
push 0x400 ; WM_ONWAIT (uMsg)
push dword [ecx+8] ; hWnd
call 0x12345678 ; PostMessage
ret 0x4
WAITFORMULTIPLEOBJECTS:
mov ecx, [esp+4]
push ecx
push dword [ecx+4] ; dwTime
push dword [ecx+8] ; WaitAll
push dword [ecx] ; lpHandles
push dword [ecx+12] ; nCount
call 0x12345678 ; WaitForMultipleObjects
pop ecx
mov dword [ecx+40], eax ; Long -> Variant
lea eax, [ecx+20]
push eax ; Параметры в RAISE (lParam)
push eax ; --- (wParam)
push 0x400 ; WM_ONWAIT (uMsg)
push dword [ecx+16] ; hWnd
call 0x12345678 ; PostMessage
ret 0x4
WINDOWPROC:
cmp word [esp+8], 0x400 ; If Msg = WM_ONWAIT
jz WM_ONWAIT
jmp 0x12345678 ; DefWindowProc
WM_ONWAIT:
; Процедура для исключения падения в IDE
call 0x12345678 ; call EbMode
test al,al ; Если остановлен
jz CLEAR
cmp al,1 ; Если запущен
jz RAISE
jmp 0x12345678 ; DefWindowProc
CLEAR: ; Очистка
push dword [esp+4] ; hwnd
call 0x12345678 ; DestroyWindow
jmp 0x12345678 ; DefWindowProc
; Конец заглушки
RAISE: ; Возбуждение события
mov esi, dword [esp+0xc] ; Указатель на источник
sub esp, 44 ; 44 байт параметров
mov edi, esp ; Указатель на стек
cld ; df = 0 (увеличение счетчиков)
xor ecx,ecx
mov cl,11 ; 44 Байт (параметры _vbaRaiseEvent и аргументы
rep movsd
call 0x12345678 ; __vbaRaiseEvent
add esp, 44
ret 0x10
Re: [VB6] - Class for waiting asynchronous kernel objects.
Originally Posted by Nanni
Hi
in your class i see a function
Code:
Function vbWaitForMultipleObjects
When you use this function?
This function is the analog of WinAPI function WaitForMultipleObjects. This function waits for the multiple instances of kernel objects. You can control the behavior of function in order to wait for any object from the list or wait for all objects from the list.
Originally Posted by Nanni
For WaitableTimer: you need to create multiple instances of the same class for handle multiple timer events?
Not necessary. You can either create the multiple instances for each event or create the single instance and wait them by vbWaitForMultipleObjects. Just create the array of the handles and pass it (more precisely the address of the first element) to the second parameter of the method.
Last edited by The trick; Oct 10th, 2015 at 01:40 PM.
Re: [VB6] - Class for waiting asynchronous kernel objects.
Hi
I tweaked in this way:
Code:
Dim hTimer() As Long
Dim EventCount As Long
Private Sub Form_Load()
Set tmr = New clsTrickWait
EventCount = -1
txtTimeClock = Now
End Sub
Private Sub cmdSetTimer_Click()
On Error GoTo Cancel
Dim Dat As Date
Dim st(8) As Integer
Dim ft As Currency
Dim lt As Currency
' // To system time
Dat = CDate(txtTimeClock)
VariantTimeToSystemTime Dat, st(0)
SystemTimeToFileTime st(0), lt
LocalFileTimeToFileTime lt, ft
EventCount = EventCount + 1
ReDim Preserve hTimer(EventCount)
' // Create the waitable timer
hTimer(EventCount) = CreateWaitableTimer(ByVal 0&, False, 0)
' // Set the waitable timer
SetWaitableTimer hTimer(EventCount), VarPtr(ft), 0, 0, 0, 0
Exit Sub
Cancel:
MsgBox "Error", vbExclamation
End Sub
Private Sub cmdArm_Click()
tmr.vbWaitForMultipleObjects EventCount, hTimer(0), 0&, INFINITE
End Sub
Re: [VB6] - Class for waiting asynchronous kernel objects.
Your error is:
Code:
Private Sub cmdArm_Click()
tmr.vbWaitForMultipleObjects EventCount + 1, VarPtr(hTimer(0)), 0&, INFINITE
End Sub
I guess you don't understand the meaning of the WaitForMultipleObjects function.
Look the small example:
Code:
Dim timersCount As Long
Private Sub Form_Load()
Dim i As Long
Dim d As Date
Set tmr = New clsTrickWait
' // Add 10 timers with the difference at 5 seconds
d = Now
For i = 0 To 9
d = DateAdd("s", 5, d)
AddTimer d
Next
' // Launch the waiting
tmr.vbWaitForMultipleObjects timersCount, VarPtr(hTimer(0)), 0, INFINITE
End Sub
' // This procedure add the timer to the array
Private Sub AddTimer(datTime As Date)
Dim st(8) As Integer
Dim ft As Currency
Dim lt As Currency
timersCount = timersCount + 1
ReDim Preserve hTimer(timersCount - 1)
hTimer(timersCount - 1) = CreateWaitableTimer(ByVal 0&, False, 0)
VariantTimeToSystemTime datTime, st(0)
SystemTimeToFileTime st(0), lt
LocalFileTimeToFileTime lt, ft
SetWaitableTimer hTimer(timersCount - 1), VarPtr(ft), 0, 0, 0, 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim i As Long
For i = 0 To UBound(hTimer)
CloseHandle hTimer(i)
Next i
End Sub
' // Event occurs after the tick of the waitable timer
Private Sub tmr_OnWait(ByVal Handle As Long, ByVal Result As Long)
If Result < timersCount And Result >= 0 Then
' // Remove timer from array, just send it to the end of the array and decrement number of timers
Dim i As Long
Dim t As Long
timersCount = timersCount - 1
t = hTimer(Result)
For i = Result To timersCount - 1
hTimer(i) = hTimer(i + 1)
Next
hTimer(timersCount) = t
End If
' // Run wait again
tmr.Abort
tmr.vbWaitForMultipleObjects timersCount, VarPtr(hTimer(0)), 0, INFINITE
MsgBox "Timer event." & vbNewLine & "Handle = " & t
End Sub
Re: [VB6] - Class for waiting asynchronous kernel objects.
Originally Posted by The trick
Your error is:
Code:
Private Sub cmdArm_Click()
tmr.vbWaitForMultipleObjects EventCount + 1, VarPtr(hTimer(0)), 0&, INFINITE
End Sub
I guess you don't understand the meaning of the WaitForMultipleObjects function.
Look the small example:
Code:
Dim timersCount As Long
Private Sub Form_Load()
Dim i As Long
Dim d As Date
Set tmr = New clsTrickWait
' // Add 10 timers with the difference at 5 seconds
d = Now
For i = 0 To 9
d = DateAdd("s", 5, d)
AddTimer d
Next
' // Launch the waiting
tmr.vbWaitForMultipleObjects timersCount, VarPtr(hTimer(0)), 0, INFINITE
End Sub
' // This procedure add the timer to the array
Private Sub AddTimer(datTime As Date)
Dim st(8) As Integer
Dim ft As Currency
Dim lt As Currency
timersCount = timersCount + 1
ReDim Preserve hTimer(timersCount - 1)
hTimer(timersCount - 1) = CreateWaitableTimer(ByVal 0&, False, 0)
VariantTimeToSystemTime datTime, st(0)
SystemTimeToFileTime st(0), lt
LocalFileTimeToFileTime lt, ft
SetWaitableTimer hTimer(timersCount - 1), VarPtr(ft), 0, 0, 0, 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim i As Long
For i = 0 To UBound(hTimer)
CloseHandle hTimer(i)
Next i
End Sub
' // Event occurs after the tick of the waitable timer
Private Sub tmr_OnWait(ByVal Handle As Long, ByVal Result As Long)
If Result < timersCount And Result >= 0 Then
' // Remove timer from array, just send it to the end of the array and decrement number of timers
Dim i As Long
Dim t As Long
timersCount = timersCount - 1
t = hTimer(Result)
For i = Result To timersCount - 1
hTimer(i) = hTimer(i + 1)
Next
hTimer(timersCount) = t
End If
' // Run wait again
tmr.Abort
tmr.vbWaitForMultipleObjects timersCount, VarPtr(hTimer(0)), 0, INFINITE
MsgBox "Timer event." & vbNewLine & "Handle = " & t
End Sub
have some questions
“If Result < timersCount And Result >= 0 Then”
result always > timersCount?
how error?
Private Sub Form_Unload(Cancel As Integer)
Dim i As Long
For i = 0 To UBound(hTimer)
CloseHandle hTimer(i)
Next i
End Sub
' // Event occurs after the tick of the waitable timer
Private Sub tmr_OnWait(ByVal Handle As Long, ByVal Result As Long)
If Result < timersCount And Result >= 0 Then
' // Remove timer from array, just send it to the end of the array and decrement number of timers
Dim i As Long
Dim t As Long
timersCount = timersCount - 1
t = hTimer(Result)
For i = Result To timersCount - 1
hTimer(i) = hTimer(i + 1)
Next
hTimer(timersCount) = t
End If
' // Run wait again
tmr.Abort
tmr.vbWaitForMultipleObjects timersCount, VarPtr(hTimer(0)), 0, INFINITE
Re: [VB6] - Class for waiting asynchronous kernel objects.
I use clsTrickWait.cls to monitoring the file operation in a folder but i have a problem.....
1. Start folder monitor
2. Start Copy a very large file to folder
3. Event FILE_ACTION_ADDED appear when file start to write on disk.
4. After a time finish copying file (write on disk finish) 5. .......HOW CAN I DETECT MOMENT WHEN FILE FINISHING COPY (WRITE DO DISK).....?
→ The Comprehensive Guide to Cloud Computing
A complete overview of Cloud Computing focused on what you need to know, from selecting a platform to choosing a cloud vendor.
A Developer.com Site
Reply With Quote
Originally Posted by Nanni
