Sleep/Delay/Pause an application w/o Do loop or Sleep API

[enigmaos]

Is there a way to pause/delay a process without using a DO loop or Sleep API call?

I'm trying to do it with a timer but haven't had any success.

Let me know if there's anything that can be used for this example, Thanks!!!!

Pros/Cons of using a DO loop:
-makes CPU Usage go up to 100% when waiting/pausing since it's running constantly in the background, but it lets user edit information on the form while it's waiting/pausing.

Pros/Cons of using a Sleep API call:
-stops the application completely when waiting/sleeping, and user cannot edit any information since the application is stopped/frozen. But, it doesn't take up the CPU usage.

Sleep function:
[vbcode]
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
[\vbcode]

Do loop 1:
[vbcode]
Do
If Current >= TargetTime Then
Exit Do
End If
' allow other processes to run
DoEvents
DoEvents
Loop
[\vbcod]

Do loop 2:
[vbcode]
Do
If StrComp(CurrentTime, TargetTime) = 1 Then
Exit Do
End If

DoEvents
DoEvents
Loop
[\vbcode]

[Iouri]

Use this simple technique to access time down to the resolution of the
PC timer interrupt. It relies on the fact that Microsoft's internal
time format is stored as a Double-precision number representing the
number of years since 1900.


This code will pause for the requested fraction of a second:

Public Sub Pause(dblHowLong As Double)

Dim dblPauseUntil As Double

dblPauseUntil = CDbl(Now) + dblHowLong
While cDbl(Now) < dblPauseUntil
DoEvents
Wend



Iouri Boutchkine
[email protected]

[enigmaos]

I forgot to mention that I'm trying to stay away from using the CPU as much as possible. I tried the code listed below.
Anyway, the code works very well except it caused the CPU usage to jump to 100%.

Is there a way to pause/delay an application without taking up the CPU's power (The application is running on Windows NT 4.0)




public Sub Pause_Delay(dblHowLong as Double)
Dim dblPauseUntil as Double

dblPauseUntil = CDbl(Now) + dblHowLong

While CDbl(Now) < dblPauseUntil
DoEvents
Wend
End Sub

[John G Duffy]

You need to use the WAITABLE TIMER API. A sample of this is at
http://www.planetsourcecode.com/xq/A...s/ShowCode.htm
and the demo has been given 5 bullets (Max possible).

John G

[Krysia]

What are you waiting for?
May be instead of waiting implicit amount of time you can wait for someting to occurred.
Try:
MsgWaitForMultipleObjects
This function returns when one of the specified objects is in the signaled state, or when the time-out interval elapses: Event, Mutex, Semaphore, Process, Thread, Critical section.
OR
WaitForSingleObject
This function returns when the specified object is in the signaled state or when the time-out interval elapses.

[enigmaos]

I tried an example (WaitForSingleObject) from this site:
http://www.vbapi.com/ref/w/waitforsingleobject.html

it still has a loop in there. Do you have a different/better example?

THANKS!!


Do
DoEvents
retval = WaitForSingleObject(sei.hProcess, 0)
Loop While retval = WAIT_TIMEOUT

[Cimperiali]

retval = WaitForSingleObject(sei.hProcess, -1)

Special thanks to Lothar "the Great" Haensler, Tom Archer, Chris Eastwood, TCartwright, Bruno Paris
and all the other wonderful people who made and make Codeguru a great place.
Come back soon, you Gurus.

The Rater

[Martin Smith]

John Duffy was right. You should use the CreateWaitableTimer API. This is an example from MSDN. It looks like a lot of code but just paste the stuff between the *********s and forget about it!



'********************************************
private Type FILETIME
dwLowDateTime as Long
dwHighDateTime as Long
End Type

private Const WAIT_ABANDONED& = &H80&
private Const WAIT_ABANDONED_0& = &H80&
private Const WAIT_FAILED& = -1&
private Const WAIT_IO_COMPLETION& = &HC0&
private Const WAIT_OBJECT_0& = 0
private Const WAIT_OBJECT_1& = 1
private Const WAIT_TIMEOUT& = &H102&

private Const INFINITE = &HFFFF
private Const ERROR_ALREADY_EXISTS = 183&

private Const QS_HOTKEY& = &H80
private Const QS_KEY& = &H1
private Const QS_MOUSEBUTTON& = &H4
private Const QS_MOUSEMOVE& = &H2
private Const QS_PAINT& = &H20
private Const QS_POSTMESSAGE& = &H8
private Const QS_SENDMESSAGE& = &H40
private Const QS_TIMER& = &H10
private Const QS_MOUSE& = (QS_MOUSEMOVE _
Or QS_MOUSEBUTTON)
private Const QS_INPUT& = (QS_MOUSE _
Or QS_KEY)
private Const QS_ALLEVENTS& = (QS_INPUT _
Or QS_POSTMESSAGE _
Or QS_TIMER _
Or QS_PAINT _
Or QS_HOTKEY)
private Const QS_ALLINPUT& = (QS_SENDMESSAGE _
Or QS_PAINT _
Or QS_TIMER _
Or QS_POSTMESSAGE _
Or QS_MOUSEBUTTON _
Or QS_MOUSEMOVE _
Or QS_HOTKEY _
Or QS_KEY)

private Declare Function CreateWaitableTimer Lib "kernel32" _
Alias "CreateWaitableTimerA" ( _
byval lpSemaphoreAttributes as Long, _
byval bManualReset as Long, _
byval lpName as string) as Long

private Declare Function OpenWaitableTimer Lib "kernel32" _
Alias "OpenWaitableTimerA" ( _
byval dwDesiredAccess as Long, _
byval bInheritHandle as Long, _
byval lpName as string) as Long

private Declare Function SetWaitableTimer Lib "kernel32" ( _
byval hTimer as Long, _
lpDueTime as FILETIME, _
byval lPeriod as Long, _
byval pfnCompletionRoutine as Long, _
byval lpArgToCompletionRoutine as Long, _
byval fResume as Long) as Long

private Declare Function CancelWaitableTimer Lib "kernel32" ( _
byval hTimer as Long)

private Declare Function CloseHandle Lib "kernel32" ( _
byval hObject as Long) as Long

private Declare Function WaitForSingleObject Lib "kernel32" ( _
byval hHandle as Long, _
byval dwMilliseconds as Long) as Long

private Declare Function MsgWaitForMultipleObjects Lib "user32" ( _
byval nCount as Long, _
pHandles as Long, _
byval fWaitAll as Long, _
byval dwMilliseconds as Long, _
byval dwWakeMask as Long) as Long

public Sub Wait(lNumberOfSeconds as Long)
Dim ft as FILETIME
Dim lBusy as Long
Dim lRet as Long
Dim dblDelay as Double
Dim dblDelayLow as Double
Dim dblUnits as Double
Dim hTimer as Long

hTimer = CreateWaitableTimer(0, true, "olMacro" & "Timer")

If Err.LastDllError = ERROR_ALREADY_EXISTS then
' If the timer already exists, it does not hurt to open it
' as long as the person who is trying to open it has the
' proper access rights.
else
ft.dwLowDateTime = -1
ft.dwHighDateTime = -1
lRet = SetWaitableTimer(hTimer, ft, 0, 0, 0, 0)
End If

' Convert the Units to nanoseconds.
dblUnits = CDbl(&H10000) * CDbl(&H10000)
dblDelay = CDbl(lNumberOfSeconds) * 1000 * 10000

' By setting the high/low time to a negative number, it tells
' the Wait (in SetWaitableTimer) to use an offset time as
' opposed to a hardcoded time. If it were positive, it would
' try to convert the value to GMT.
ft.dwHighDateTime = -CLng(dblDelay / dblUnits) - 1
dblDelayLow = -dblUnits * (dblDelay / dblUnits - _
Fix(dblDelay / dblUnits))

If dblDelayLow < CDbl(&H80000000) then
' &H80000000 is MAX_LONG, so you are just making sure
' that you don't overflow when you try to stick it into
' the FILETIME structure.
dblDelayLow = dblUnits + dblDelayLow
End If

ft.dwLowDateTime = CLng(dblDelayLow)
lRet = SetWaitableTimer(hTimer, ft, 0, 0, 0, false)

Do
' QS_ALLINPUT means that MsgWaitForMultipleObjects will
' return every time the thread in which it is running gets
' a message. If you wanted to handle messages in here you could,
' but by calling Doevents you are letting DefWindowProc
' do its normal windows message handling---Like DDE, etc.
lBusy = MsgWaitForMultipleObjects(1, hTimer, false, _
INFINITE, QS_ALLINPUT&)
DoEvents
Loop Until lBusy = WAIT_OBJECT_0

' Close the handles when you are done with them.
CloseHandle hTimer
End Sub
'********************************************

private Sub Main()
'Some Code
Wait 60 'Wait 60 Seconds
'Some More Code
End Sub