LANCER UN EXECUTABLE ET ATTENDRE SA FIN

Public Const INFINITE = &HFFFF
Public Const STARTF_USESHOWWINDOW = &H1

Public Enum enSW
    SW_HIDE = 0
    SW_NORMAL = 1
    SW_MAXIMIZE = 3
    SW_MINIMIZE = 6
End Enum

Public Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadId As Long
End Type

Public Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Byte
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Public Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

Public Enum enPriority_Class
    NORMAL_PRIORITY_CLASS = &H20
    IDLE_PRIORITY_CLASS = &H40
    HIGH_PRIORITY_CLASS = &H80
End Enum

Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) 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


Public Function LanceApp(Appli As String, Arg As String, Timeout As Long, ByVal StartSize As enSW, ByVal Priority_Class As enPriority_Class) As Long
    LanceApp = 259
    Dim pclass As Long
    Dim Ret As Long
    Dim cmdline As String
    Dim sinfo As STARTUPINFO
    Dim pinfo As PROCESS_INFORMATION
    Dim sec1 As SECURITY_ATTRIBUTES
    Dim sec2 As SECURITY_ATTRIBUTES
    Dim hMutex As Long
    
    sec1.nLength = Len(sec1)
    sec2.nLength = Len(sec2)
    sinfo.cb = Len(sinfo)
    sinfo.dwFlags = STARTF_USESHOWWINDOW
    sinfo.wShowWindow = StartSize
    pclass = Priority_Class
    
    cmdline = Appli
    If (Len(Trim$(Arg)) > 0) Then
        cmdline = cmdline & " " & Arg
    End If
        
    Debug.Print " cmdLine : " & cmdline

    If CreateProcess(vbNullString, cmdline, sec1, sec2, False, pclass, 0&, CurDir$(), sinfo, pinfo) Then
        Debug.Print " CreateProcess OK"
        Ret = 259
        While (Ret = 259)
            WaitForSingleObject pinfo.hProcess, Timeout
            DoEvents
            If (GetExitCodeProcess(pinfo.hProcess, Ret) = 1) Then
                Debug.Print " GetExitCodeProcess OK"
                LanceApp = Ret
            Else
                Debug.Print " GetExitCodeProcess KO"
            End If
        Wend
    Else
        Debug.Print " CreateProcess KO : " & Err.LastDllError
    End If


End Function