VB6: Sleep, DoEvent, Loop, looking for best way of...

Private Const INFINITE = -1& 
Private Const PROCESS_ALL_ACCESS = &H1F0FFF

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function WaitForInputIdle Lib "user32" (ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long 
 
...  
    Dim FileName As String
    Dim params As String
    FileName = "C:\program.exe"
    params = "some params here"

    Dim pid As Long
    Dim lngProcess As Long
    pid = Shell(Chr(34) & FileName & Chr(34) & " " & params, vbNormalFocus)
    lngProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, CLng(pid))
    If lngProcess <> 0 Then
        WaitForInputIdle lngProcess, INFINITE
        TerminateProcess lngProcess, 0&
    End If

Select all Open in new window

'code for Form1
Private Sub cmdCheck_Click()
'check if application is running
If IsTaskRunning(sAppName) Then
MsgBox "Application '" & sAppName & "' is running!"
Else
MsgBox "Application '" & sAppName & "' is not running!"
End If

End Sub

Private Sub cmdClose_Click()
'close application
Call EndTask(sAppName)

End Sub

Private Sub cmdStart_Click()
'start an application
Shell sAppPath, vbNormalFocus

End Sub

Private Sub Form_Load()

  sAppName = "Microsoft Access"
  sAppPath = "C:\Program Files\access97\Office\MSACCESS.EXE"

End Sub


'Code for Module1


Option Explicit
 'API's Function Declarations
 Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
 Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
 Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As String) As Long
 'API Constants
 Public Const GWL_STYLE = -16
 Public Const WS_DISABLED = &H8000000
 Public Const WM_CANCELMODE = &H1F
 Public Const WM_CLOSE = &H10
 Public sAppName As String, sAppPath As String

 Public Function IsTaskRunning(sWindowName As String) As Boolean
Dim hwnd As Long, hWndOffline As Long
   On Error GoTo IsTaskRunning_Eh
'get handle of the application
'if handle is 0 the application is currently not running
hwnd = FindWindow(0&, sWindowName)
If hwnd = 0 Then

IsTaskRunning = False

Exit Function
Else

IsTaskRunning = True
End If
IsTaskRunning_Exit:

Exit Function
IsTaskRunning_Eh:
Call ShowError(sWindowName, "IsTaskRunning")
 End Function
 Public Function EndTask(sWindowName As String) As Integer
Dim X As Long, ReturnVal As Long, TargetHwnd As Long
   'find handle of the application
TargetHwnd = FindWindow(0&, sWindowName)
If TargetHwnd = 0 Then Exit Function
   If IsWindow(TargetHwnd) = False Then

GoTo EndTaskFail
Else
'close application

If Not (GetWindowLong(TargetHwnd, GWL_STYLE) And WS_DISABLED) Then


X = PostMessage(TargetHwnd, WM_CLOSE, 0, 0&)


DoEvents

End If
End If
   GoTo EndTaskSucceed
EndTaskFail:
ReturnVal = False
MsgBox "EndTask: cannot terminate " & sWindowName & " task"
GoTo EndTaskEndSub
EndTaskSucceed:
ReturnVal = True
EndTaskEndSub:
EndTask% = ReturnVal
 End Function
 Public Function ShowError(sText As String, sProcName As String)   'this function displays an error that occurred
   Dim sMsg As String
sMsg = "Error # " & Str(Err.Number) & " was generated by " & Err.Source & vbCrLf & Err.Description
MsgBox sMsg, vbCritical, sText & Space(1) & sProcName
Exit Function
 End Function

Select all Open in new window