by Brian Cidern (4 Submissions)
Category: Windows API Call/Explanation
Compatability: Visual Basic 3.0
Difficulty: Advanced
Date Added: Wed 3rd February 2021
Rating: 
(11 Votes)
Shells an app, then waits for that app to close before it continues processing.
Inputs
None --
Assumes
Pseudo code:
Uses API to get the OS dir (for 95/98/NT4/2000 compatability) and appends result with Notepad.exe. Shells Notepad, returning process id. fWait gets the app hdl and issues a Do Events until the exit code of the app <> STILL_ACTIVE&. When app is closed, a cheezy MsgBox displays.
Create a Std EXE. Add a command button, and use the default name (Command1).
Code Returns
Shelled app exit code
Side Effects
None --
API DeclarationsConst PROCESS_ALL_ACCESS& = &H1F0FFF
Const STILL_ACTIVE& = &H103&
Const INFINITE& = &HFFFF
Private Declare Function GetWindowsDirectory _
Lib "kernel32" _
Alias "GetWindowsDirectoryA" ( _
ByVal lpBuffer As String, _
ByVal nSize 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 GetExitCodeProcess _
Lib "kernel32" ( _
ByVal hProcess As Long, _
lpExitCode As Long _
) As Long
Private Declare Function CloseHandle _
Lib "kernel32" ( _
ByVal hObject As Long _
) As Long
VBcodersPrivate Sub Command1_Click()
Dim sCmdLine As String
Dim idProg As Long, iExit As Long
sCmdLine = fGetWinDir & "\notepad.exe"
idProg = Shell(sCmdLine)
iExit = fWait(idProg)
If iExit Then
MsgBox "Something very, very bad just happened."
Else
MsgBox "Finished processing Notepad."
End If
End Sub
Function fWait(ByVal lProgID As Long) As Long
' Wait until proggie exit code <> STILL_ACTIVE&
Dim lExitCode As Long, hdlProg As Long
' Get proggie handle
hdlProg = OpenProcess(PROCESS_ALL_ACCESS, False, lProgID)
' Get current proggie exit code
GetExitCodeProcess hdlProg, lExitCode
Do While lExitCode = STILL_ACTIVE&
DoEvents
GetExitCodeProcess hdlProg, lExitCode
Loop
CloseHandle hdlProg
fWait = lExitCode
End Function
Private Function fGetWinDir() As String
' Wrapper to return OS Path
Dim lRet As Long, lSize As Long, sBuf As String * 512
lSize = 512
lRet = GetWindowsDirectory(sBuf, lSize)
fGetWinDir = Left(sBuf, InStr(1, sBuf, Chr(0)) - 1)
End Function
