I use CreateProcess to start a process, with the command line, say to open my doc
in word. After waiting till it's open, I then store the handle from the
PROCESS_INFORMATION. I then fire a sub every second (using a timer) to
GetExitCodeProcess with this handle to obtain the ExitCode to see if its
STILL_ACTIVE.
This works ok some times, but other times GetExitCodeProcess succeeds, but the
ExitCode doesn’t return STILL_ACTIVE, when the program is still active!
Am I missing something? Or is there a better way to determine when a program has
finished?
Many Thanks
Ian
--
............................................
Björn Holmgren
Concept / Development
Integration AB
Olof Asklunds gata 10
SE-421 30 Västra Frölunda, Sweden
Office +46 31 709 50 00
Mobile +46 706 84 01 29
Fax +46 31 709 50 99
mailto:bjorn.h...@guide.se
............................................
"Ian Singlehurst" <Ian.Sin...@pershing.co.uk> wrote in message
news:b92701c0c35f$145de0a0$19ef2ecf@tkmsftngxa01...
Try these gems. They are CPU friendly.
Monte Hansen
KillerVB.com
Public Function ShellWait(ByVal PathName As String, _
Optional ByVal WindowStyle As VbAppWinStyle =
vbNormalFocus, _
Optional ByVal TimeoutValue As Long = 0, _
Optional TimedOut As Boolean) As Long
'===============================================================================
' ShellWait - Shells the supplied program and waits until the process
' is completed.
'
' Parameters Identical in name and functionality to that of the
' VBA.Shell function, except for:
' TimeOutValue Input. Number of milliseconds to time out the wait process.
' TimedOut Output. Set to True if the wait timed out.
'
' RETURNS A long value that defines how the shell application
' exited [ignored]. The SDK says:
'
' ERRORS Reflected back and thrown to caller.
'
' If the process has terminated, the termination status returned may be
' one of the following:
' * The exit value specified in the ExitProcess or TerminateProcess
' function.
' * The return value from the main or WinMain function of the process.
' * The exception value for an unhandled exception that caused the
' process to terminate.
'
'===============================================================================
Dim hInstance As Long ' hInstance of shelled application
Dim hProcess As Long ' hProcess of shelled application
Dim nRetVal As Long ' generic return value; debugging only
Dim nErr As Long ' saved error number
Dim sErr As Long ' saved error description
Dim Flags As Long ' OpenProces flags
On Error GoTo ErrHandler ' trap all errors for open process
' Shell the command; an error raises if fails
hInstance = Shell(PathName, WindowStyle)
' clear the LastDLLError [system error] value
Err.Clear
' open the process of the just shelled application
' TODO: Or in SYNCHRONIZE for NT so we don't have to
' loop with a DoEvents, which is much better on the CPU.
Flags = PROCESS_QUERY_INFORMATION
If IsWinNt() Then
Flags = Flags Or SYNCHRONIZE
End If
hProcess = OpenProcess(Flags, 1&, hInstance)
Select Case hProcess
Case 0, INVALID_HANDLE_VALUE
' Failure is most likely access denied to the process
Select Case Err.LastDllError
Case ERROR_ACCESS_DENIED
Err.Raise 70 ' VB's version of "Access Denied"
' Or: Err.Raise -ERROR_ACCESS_DENIED, , LastDllErrorMsg
Case Else
Err.Raise 5, Description:="There was an unknown error opening the
shelled process. " & _
"System error #" & Err.LastDllError & "."
End Select
'Case Else: Is a valid handle to a process
End Select
' If IsWinNt() Then
'
' ' Under NT we "wait" on the process handle for better CPU utilization,
' ' and only execute a DoEvents when there are message to be processed.
' ShellWait = WaitOnEvent(hProcess, TimeoutValue, QS_ALLINPUT)
'
' Else
'
' loop until we get an exit code for the process
Do
nRetVal = GetExitCodeProcess(hProcess, ShellWait)
' We should never stop here
Debug.Assert CBool(nRetVal)
' NOTE: You could also use WaitForSingleObjectEx
' if on NT.
Pause 50
Loop While ShellWait = STILL_ACTIVE
' End If
ExitLabel:
' Close open process, if any
nRetVal = CloseHandle(hProcess)
Exit Function
Resume
ErrHandler:
Debug.Assert 0
' Save error info
nErr = Err.Number: sErr = Err.Description
' Close open process, if any
nRetVal = CloseHandle(hProcess)
' prepare to throw error back
On Error GoTo 0
' Throw it back
Err.Raise nErr, , sErr
End Function
Public Sub Pause(ByVal Milliseconds As Long, _
Optional ByVal WakeMask As QueueStatusFlags = QS_ALLINPUT, _
Optional lpAbort As Long)
Dim hEvent As Long
' Sanity check.
If Milliseconds <= 0 Then Exit Sub
' Create a bogus event to wait on. It will never be siganaled.
hEvent = CreateEvent(ByVal 0, 1, 0, vbNullString)
If IsValidHandle(hEvent) Then
' Wait until timeout expires
WaitOnEvent hEvent, Milliseconds, WakeMask, lpAbort:=lpAbort
' Destroy the event
CloseHandle hEvent
Else
ApiRaise Err.LastDllError, Module, "Could not create event."
End If
End Sub
Public Function WaitOnEvent(ByVal hEvent As Long, _
Optional ByVal TimeoutValue As Long = 15000, _
Optional ByVal WakeMask As QueueStatusFlags =
QS_ALLINPUT, _
Optional WaitValue As Long, _
Optional ByVal lpAbort As Long) As Long
' Wait on the single event
WaitOnEvent = WaitOnEvents(1, _
VarPtr(hEvent), _
False, _
TimeoutValue, _
WakeMask, _
WaitValue, _
lpAbort)
End Function
Public Function WaitOnEvents(ByVal nEvents As Long, _
ByVal lpEvents As Long, _
Optional ByVal WaitOnAll As Boolean = False, _
Optional ByVal TimeoutValue As Long = 15000, _
Optional ByVal WakeMask As QueueStatusFlags =
QS_ALLINPUT, _
Optional WaitValue As Long, _
Optional ByVal lpAbort As Long) As Long
Const INFINITE = &HFFFFFFFF ' Infinite timeout
Const WAIT_FAILED = -1&
Const WAIT_TIMEOUT = 258& ' Wait timed out
Const WAIT_ABANDONED_0 = &H80&
Const WAIT_OBJECT_0 = 0
'onst WAIT_IO_COMPLETION = &HC0& ' MsgWaitForMultipleObjectsEx
Dim StartTime As Long
Dim EndTime As Long
Dim TimeoutTicks As Long
Dim AbortVal As Long
' Calculate time out value, if any supplied
If TimeoutValue > 0 Then
EndTime = timeGetTime() + TimeoutValue
Else
TimeoutTicks = INFINITE
End If
Do
' If an abort variable supplied...
If lpAbort <> 0 Then
' Copy contents of abort variable to local variable
CopyMemory ByVal VarPtr(AbortVal), ByVal lpAbort, 2
' Exit if the abort variable is set.
If AbortVal <> 0 Then Exit Do
End If
' Calculate # of milliseconds left before we must time out.
If TimeoutValue > 0 Then
StartTime = timeGetTime()
If StartTime < EndTime Then
' So TickDiff doesn't attempt an overflow
TimeoutTicks = TickDiff(StartTime, EndTime)
Else
' So we timeout on the next tick
TimeoutTicks = 1
End If
End If
' Wait on the supplied event
WaitValue = MsgWaitForMultipleObjects _
(nEvents, ByVal lpEvents, Abs(WaitOnAll), TimeoutTicks, WakeMask)
' Process the result
Select Case WaitValue
Case WAIT_OBJECT_0 To (WAIT_OBJECT_0 + nEvents - 1), _
WAIT_ABANDONED_0 To (WAIT_ABANDONED_0 + nEvents - 1)
' Return a one-based index identifying the event that signaled
WaitOnEvents = WaitValue + 1
Exit Do
Case (WAIT_OBJECT_0 + nEvents)
' We need to process the msg queue. Refer to the SDK for more info.
'WaitOnEvents = nEvents
'Exit Do
Case WAIT_TIMEOUT
' We've timed out. Exit function.
Exit Do
Case WAIT_FAILED
' There was an error. Handle probably invalid.
ApiRaise Err.LastDllError, , "Wait event(s) failed."
Case Else
Debug.Assert 0
End Select
DoEvents
Loop
End Function
-----Original Message-----
If you're not interested in the exit code you could use the
WaitForSingleObject API, passing the hProcess of the PROCESS_INFORMATION
structure returned by CreateProcess.
--
.............................................
Björn Holmgren
Concept / Development
Integration AB
Olof Asklunds gata 10
SE-421 30 Västra Frölunda, Sweden
Office +46 31 709 50 00
Mobile +46 706 84 01 29
Fax +46 31 709 50 99
mailto:bjorn.h...@guide.se
.............................................
"Ian Singlehurst" <Ian.Sin...@pershing.co.uk> wrote in message
news:b92701c0c35f$145de0a0$19ef2ecf@tkmsftngxa01...
Hi, I'm trying to determine when a program has finished such as a word
document
on Windows 2000 pro.
I use CreateProcess to start a process, with the command line, say to open
my doc
in word. After waiting till it's open, I then store the handle from the
PROCESS_INFORMATION. I then fire a sub every second (using a timer) to
GetExitCodeProcess with this handle to obtain the ExitCode to see if its
STILL_ACTIVE.
This works ok some times, but other times GetExitCodeProcess succeeds, but
the
ExitCode doesn’t return STILL_ACTIVE, when the program is still
active!
Am I missing something? Or is there a better way to determine when a program
has
finished?
Many Thanks
Ian
.
I think your code contains some bugs. See below.
For more information about using wait functions in Visual Basic
see here: http://smsoft.chat.ru/en/vbwait.htm
You can add SYNCHRONIZE on any platform, it will be simple ignored if
non-NT.
> End If
> hProcess = OpenProcess(Flags, 1&, hInstance)
Using Shell + OpenProcess don't allow to use it for Win16-applications.
Using CreateProcess instead can solve the problem.
>
> Select Case hProcess
> Case 0, INVALID_HANDLE_VALUE
>
> ' Failure is most likely access denied to the process
> Select Case Err.LastDllError
> Case ERROR_ACCESS_DENIED
> Err.Raise 70 ' VB's version of "Access Denied"
> ' Or: Err.Raise -ERROR_ACCESS_DENIED, , LastDllErrorMsg
> Case Else
> Err.Raise 5, Description:="There was an unknown error
> opening the shelled process. " & _
> "System error #" & Err.LastDllError &
"."
> End Select
> 'Case Else: Is a valid handle to a process
> End Select
>
> ' If IsWinNt() Then
> '
> ' ' Under NT we "wait" on the process handle for better CPU
utilization,
> ' ' and only execute a DoEvents when there are message to be
processed.
> ' ShellWait = WaitOnEvent(hProcess, TimeoutValue, QS_ALLINPUT)
Why is it commented? This approach can be implemented always, not only on NT
platform.
What is lpAbort for?
>
> Dim hEvent As Long
>
> ' Sanity check.
> If Milliseconds <= 0 Then Exit Sub
>
> ' Create a bogus event to wait on. It will never be siganaled.
> hEvent = CreateEvent(ByVal 0, 1, 0, vbNullString)
You can omit bogus event creation, because the events count can be zero.
You can get overflow here
> Else
> TimeoutTicks = INFINITE
> End If
>
> Do
>
> ' If an abort variable supplied...
> If lpAbort <> 0 Then
> ' Copy contents of abort variable to local variable
> CopyMemory ByVal VarPtr(AbortVal), ByVal lpAbort, 2
The abort variable is four bytes long, isn't it?
Why not to pass it itself, not a reference to it?
If you want to pass the reference, why not to pass abort variable by
reference?
> ' Exit if the abort variable is set.
> If AbortVal <> 0 Then Exit Do
> End If
>
> ' Calculate # of milliseconds left before we must time out.
> If TimeoutValue > 0 Then
> StartTime = timeGetTime()
> If StartTime < EndTime Then
> ' So TickDiff doesn't attempt an overflow
You still can overflow here if StartTime is negative (when the system ticks
counter exceeds &H7FFFFFF, it becames negative for VB)
> TimeoutTicks = TickDiff(StartTime, EndTime)
Where is TickDiff function?
> Else
> ' So we timeout on the next tick
You already timeouted here, you can omit MsgWaitForMultipleObjects call.
> TimeoutTicks = 1
> End If
> End If
>
> ' Wait on the supplied event
> WaitValue = MsgWaitForMultipleObjects _
> (nEvents, ByVal lpEvents, Abs(WaitOnAll), TimeoutTicks,
> WakeMask)
Why not pass lpEvents by reference? You can get rid of using VarPtr in this
case.
>
--
Sergey Merzlikin
http://smsoft.chat.ru
sms...@chat.ru