Option Explicit
Private Const SYNCHRONIZE As Long = &H100000
Private Const PROCESS_TERMINATE As Long = &H1&
Private Const PROCESS_QUERY_INFORMATION As Long = &H400&
Private Const WAIT_OBJECT_0 As Long = 0
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" ( _
ByVal hProcess As Long, _
lpExitCode As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" ( _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" ( _
ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" ( _
ByVal hProcess As Long, _
ByVal uExitCode As Long) As Long
Private Const MagicNumber As Long = &H7BADBAD7
Private hChildProcess As Long
Private T0 As Single
Private Sub cmdKillChild_Click()
cmdKillChild.Enabled = False
If TerminateProcess(hChildProcess, MagicNumber) = 0 Then
lblStatus.Caption = "TerminateProcess failed, err " _
& CStr(Err.LastDllError)
End If
End Sub
Private Sub cmdStartChild_Click()
Dim ProcessId As Long
'Run a WSH script hidden.
ProcessId = Shell("wscript msgbox.vbs", vbHide)
If ProcessId = 0 Then
lblStatus.Caption = "Shell failed"
Else
hChildProcess = OpenProcess(SYNCHRONIZE _
Or PROCESS_QUERY_INFORMATION _
Or PROCESS_TERMINATE, _
0, _
ProcessId)
If hChildProcess = 0 Then
'Ouch, bad. Child running but we have no handle!
lblStatus.Caption = "OpenProcess failed, err " _
& CStr(Err.LastDllError)
Else
lblStatus.Caption = "Running"
T0 = Timer()
cmdStartChild.Enabled = False
cmdKillChild.Enabled = True
tmrMonitor.Enabled = True
End If
End If
End Sub
Private Sub tmrMonitor_Timer()
Dim ExitCode As Long
Dim T1 As Single
If WaitForSingleObject(hChildProcess, 0) = WAIT_OBJECT_0 Then
tmrMonitor.Enabled = False
cmdKillChild.Enabled = False
cmdStartChild.Enabled = True
If GetExitCodeProcess(hChildProcess, ExitCode) = 0 Then
CloseHandle hChildProcess
lblStatus.Caption = "Done, GetExitCodeProcess failed, err " _
& CStr(Err.LastDllError)
Else
CloseHandle hChildProcess
If ExitCode = MagicNumber Then
lblStatus.Caption = "Terminated"
Else
lblStatus.Caption = "Done, return code " _
& CStr(ExitCode)
End If
End If
Else
T1 = Timer() - T0
If T1 < 0 Then T1 = T1 + 86400
lblStatus.Caption = "Running " & Format$(T1, "0") & " secs"
End If
End Sub