Monday, July 19, 2010

ShellandWait VB6 used in KrzYoptimizer

Shell and wait used in KrzYoptimizer looks like this (v1.11):


Private Declare Function OpenProcess Lib "Kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function GetExitCodeProcess Lib "Kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "Kernel32" (ByVal hObject As Long) As Long
Private PROCESS_HANDLE As Long


Public Function shellAndWait(ByVal PROGRAM_NAME As String, Optional ByVal WINDOW_STYLE As VbAppWinStyle = vbNormalFocus, Optional ByVal MAX_WAIT_SECONDS As Long = 0, Optional ByVal DO_I_CHECK As Byte = 0) As Integer

Dim PROCESS_ID As Long
Dim ERRORLEVEL_CODE As Long
Dim TIME_STARTED As Date

Const PROCESS_QUERY_INFORMATION As Long = &H400
Const STILL_ACTIVE As Long = &H103
Const PROCESS_TERMINATE As Long = &H1

' Start the program.
On Error GoTo ShellError
PROCESS_ID = Shell(PROGRAM_NAME, WINDOW_STYLE)
On Error GoTo 0

DoEvents

' Wait for the program to finish.
' Get the process handle.
PROCESS_HANDLE = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_TERMINATE, 0, PROCESS_ID) ' Or PROCESS_TERMINATE
If PROCESS_HANDLE <> 0 Then
TIME_STARTED = Now

Do
GetExitCodeProcess PROCESS_HANDLE, ERRORLEVEL_CODE
DoEvents
Sleep DELAY_ERRORCODE_CHECK
Loop While ERRORLEVEL_CODE = STILL_ACTIVE

CloseHandle PROCESS_HANDLE
PROCESS_ID = 0
shellAndWait = ERRORLEVEL_CODE
ElseIf DO_I_CHECK = 1 Then
Sleep DELAY_ERRORCODE_CHECK
shellAndWait = shellAndWait(PROGRAM_NAME, WINDOW_STYLE, MAX_WAIT_SECONDS, 1)
End If
Exit Function

ShellError:
stbStatus.Panels(1).text = "ERROR: " + PROGRAM_NAME + " won't run!"
End Function

Private Sub Form_QueryUnload(cancel As Integer, unloadmode As Integer)

If PROCESS_HANDLE <> 0 Then
Dim cool As Integer
Do While TerminateProcess(PROCESS_HANDLE, 0&) <> 0
cool = cool + 1
DoEvents
stbStatus.Panels(1).text = "Terminating process... " + CStr(cool)
Loop
End If
End
End Sub




Please note that it's only a part of program code.
There is still MAX_WAIT_SECONDS variable in shellandwait function. It was used to prevent program from getting stuck but it seems like those programs don't get stuck. At least as far as i tested.

This shell and wait is based on GetExitCodeProcess to check if program is still running and just incase allow program to Terminate process if user closes program when BIIIG file is being recompressed. When user interacts with GUI too much (like menu or listview scrolling) and this function is in DO_I_CHECK mode (1) - means that WE NEED error code [variable or if in other sub] - then program will be restarted as long as proper error code is returned.

No comments: