ShellExecuteWait

Posted: 2002-06-01
By: ArchiveBot
Viewed: 105

Filed Under:

VB6 Code Cache

No attachments for this post

This code uses simple API to launch a program or a document but this code also awaits until the process has ended so you can force the user to do something before proceeding (as setup wizards does). The procedure supports command line parameters, a working folder and showing options.
It's so simple and I couldn't find it on this site so I posted it.

Original Author: BioHazardMX

Returns

The code returns the hInstance of the new process if sucessfull or the error code if something gone wrong.

API Declarations

Private Const INFINITE As Long = &HFFFFFFFF
Private Const SEE_MASK_FLAG_NO_UI As Long = &H400
Private Const SEE_MASK_NOCLOSEPROCESS As Long = &H40
Private Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hWnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As Long
hProcess As Long
End Type
Private Declare Function WaitForSingleObject Lib "Kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function GetLastError Lib "Kernel32.dll" () As Long
Private Declare Function ShellExecuteEx Lib "Shell32.dll" (ByRef lpExecInfo As SHELLEXECUTEINFO) As Long

Code

'With this code you'll be able to a launch a program or open a document as if you were using the "ShellExecute" function, but your program will await until the opened process has ended (as installers does)
'Code by BioHazardMX
'Add the following code to a module
Private Const INFINITE As Long = &HFFFFFFFF
Private Const SEE_MASK_FLAG_NO_UI As Long = &H400
Private Const SEE_MASK_NOCLOSEPROCESS As Long = &H40
Private Type SHELLEXECUTEINFO
  cbSize As Long
  fMask As Long
  hWnd As Long
  lpVerb As String
  lpFile As String
  lpParameters As String
  lpDirectory As String
  nShow As Long
  hInstApp As Long
  lpIDList As Long
  lpClass As String
  hkeyClass As Long
  dwHotKey As Long
  hIcon As Long
  hProcess As Long
End Type
Private Declare Function WaitForSingleObject Lib "Kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function GetLastError Lib "Kernel32.dll" () As Long
Private Declare Function ShellExecuteEx Lib "Shell32.dll" (ByRef lpExecInfo As SHELLEXECUTEINFO) As Long
Private Function ShellExecuteWait(ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long)
Dim lReturn As Long, lResult As Long
Dim tExecuteInfo As SHELLEXECUTEINFO
  'Fill the SHELLEXECUTEINFO structure
  tExecuteInfo.cbSize = Len(tExecuteInfo)
  tExecuteInfo.fMask = SEE_MASK_NOCLOSEPROCESS
  tExecuteInfo.hWnd = hWnd
  tExecuteInfo.lpVerb = lpOperation
  tExecuteInfo.lpFile = lpFile
  tExecuteInfo.lpParameters = lpParameters
  tExecuteInfo.lpDirectory = lpDirectory
  tExecuteInfo.nShow = nShowCmd
  'Call the API with the specified parameters
  lReturn = ShellExecuteEx(tExecuteInfo)
  If lReturn = 0 Then lReturn = GetLastError Else lReturn = tExecuteInfo.hInstApp
  'If there's a new process wait while it terminates
  If tExecuteInfo.hProcess <> 0 Then
   lResult = WaitForSingleObject(tExecuteInfo.hProcess, INFINITE)
  End If
  'Return the ShellExecuteEx return value
  ShellExecuteWait = lReturn
End Function
'And the following code to a form. Also, you must add a CommandButton named "Command1"
Private Sub Command1_Click()
  'Hide the window
  WindowState = vbMinimized
  'Execute the Notepad and wait for termination
  Call ShellExecuteWait(hWnd, "open", "C:WindowsNotepad.exe", "", "", vbNormalFocus)
  'Show the window
  WindowState = vbNormal
End Sub

Comments on this post

No comments have been added for this post.

You must be logged in to make a comment.