SnippetWare.com » Shell & Applications

Launch Application (using CreateProcessA API function)

Zaur — Sun, 11 Oct 2009 12:18:38 +0000

Public Function StartProcess(CommandLine As String, Optional Hide As Boolean = False) As Long
    Const STARTF_USESHOWWINDOW As Long = &H1
    Const SW_HIDE As Long = 0

    Dim proc As PROCESS_INFORMATION
    Dim Start As STARTUPINFO

    'Initialize the STARTUPINFO structure:
    Start.cb = Len(Start)
    If Hide Then
        Start.dwFlags = STARTF_USESHOWWINDOW
        Start.wShowWindow = SW_HIDE
    End If

    'Start the shelled application:
    CreateProcessA 0&, CommandLine, 0&, 0&, 1&, _
        NORMAL_PRIORITY_CLASS, 0&, 0&, Start, proc

    StartProcess = proc.hProcess
End Function

Launch Application (with advanced parameters)

Zaur — Sun, 11 Oct 2009 12:18:07 +0000

Public Function SyncShell(CommandLine As String, Optional Timeout As Long, _
    Optional WaitForInputIdle As Boolean, Optional Hide As Boolean = False) As Boolean

    Dim hProcess As Long

    Const STARTF_USESHOWWINDOW As Long = &H1
    Const SW_HIDE As Long = 0

    Dim ret As Long
    Dim nMilliseconds As Long

    If Timeout > 0 Then
        nMilliseconds = Timeout
    Else
        nMilliseconds = INFINITE
    End If

    hProcess = StartProcess(CommandLine, Hide)

    If WaitForInputIdle Then
        'Wait for the shelled application to finish setting up its UI:
        ret = InputIdle(hProcess, nMilliseconds)
    Else
        'Wait for the shelled application to terminate:
        ret = WaitForSingleObject(hProcess, nMilliseconds)
    End If

    CloseHandle hProcess

    'Return True if the application finished. Otherwise it timed out or erred.
    SyncShell = (ret = WAIT_OBJECT_0)
End Function

Shell out to a 32-bit application and wait until task completes

Zaur — Sun, 11 Oct 2009 12:16:56 +0000

' Declarations

'*** Monitoring a DOS Shell
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 Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
Const STILL_ACTIVE = &H103
Const PROCESS_QUERY_INFORMATION = &H400

' Code

Sub Shell32Bit(ByVal JobToDo As String)

         Dim hProcess As Long
         Dim RetVal As Long
         'The next line launches JobToDo as icon,

         'captures process ID
         hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, Shell(JobToDo, 1))

         Do

             'Get the status of the process
             GetExitCodeProcess hProcess, RetVal

             'Sleep command recommended as well as DoEvents
             DoEvents: Sleep 100

         'Loop while the process is active
         Loop While RetVal = STILL_ACTIVE

End Sub

Lauches an application based on file extension

Zaur — Sun, 11 Oct 2009 12:16:19 +0000

' ----------------------------
' Constants & API Declarations
' ----------------------------

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" Alias "GetDesktopWindow" () As Long

' ----------
' Function
' ----------

Function StartDoc (DocName As String) as long
    Dim Scr_hDC as long

    Scr_hDC = GetDesktopWindow()

    ' Change "Open" to "Explore" to bring up file explorer
    StartDoc = ShellExecute(Scr_hDC, "Open", DocName, "", "C:\", 1)
End Function