[VB6] - Class for waiting asynchronous kernel objects.

Hello everyone.

This class allows to wait for Windows kernel objects and generate an event when an object switches to the signaled state or a timeout has elapsed.

The class has 3 methods: vbWaitForSingleObject, vbWaitForMultipleObjects and Abort. The first two methods are the analogs of the corresponding WINAPI functions WaitForSingleObject and WaitForMultipleObjects.

As soon as an object (or all the objects) changes the state to signaled the event OnWait is fired. The arguments of the events contains the event handle (or the pointer to the handles) and the returned value. Abort method allows to break any pending waiting operation. It can either returns immediately or wait until the request will be processed.

The class also contains property IsActive which shows if there is an active waiting operation.

Github repository.

[not relevant]

[not relevant]

[not relevant]

[not relevant]

Hi
in your class i see a function

Code:

---

Function vbWaitForMultipleObjects

---

When you use this function?

For WaitableTimer: you need to create multiple instances of the same class for handle multiple timer events?

Quote:

---

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.

Quote:

---

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.

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

---

..but crash when I click cmdArm button

I'm doing something wrong?

You must pass VarPtr(hTimer(0)) instead hTimer(0)

Hi
I made change in code

Code:

---

tmr.vbWaitForMultipleObjects NumEvent, VarPtr(hTimer(0)), 0&, INFINITE

---

but always crash.
Also looking at your class in

Code:

---

Public Function Abort

---

I see only reference to

Code:

---

WaitForSingleObject

---

If you want check, I have enclosed my test project.

Thanks

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

---

Hi
Thanks for example.
Now I have learned how to use WaitForMultipleObjects

Quote:

---

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?Attachment 131365
how error?

258 - wait_timeout.

Quote:

---

Originally Posted by msdn

the time-out interval elapsed and the conditions specified by the bwaitall parameter are not satisfied.

---

because 258,can not changed,how can load if~end if function code

Attachment 131465

I don't understand. Send the project to me that causes the problems.

the code is you
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

if i used this code in IDE,have no error ,but if i make the code tO exe,the error can happen
d = DateAdd("s", 5, d)
AddTimer d
Next

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).....?

Also you should use the FILE_NOTIFY_CHANGE_LAST_WRITE flag in ReadDirectoryChangesW. You get a notification as soon as a file will be copied.

Quote:

---

Originally Posted by The trick

Also you should use the FILE_NOTIFY_CHANGE_LAST_WRITE flag in ReadDirectoryChangesW.

---

... Thanks and i found this...
https://www.desaware.com/tech/filemonitoring.aspx

New version 2.0

1. More stable;
2. Memory leaking fixed;
3. Optimized code;
4. Project is moved to Github.

See the first post to download the latest version.