martedì 27 settembre 2011

Visual basic 6: lanciare un processo esterno con CreateProcess


Breve snippet di codice per aprire un processo esterno ed aspettare che finisca il lavoro in Visual Basic 6 utilizzando l'API CreateProcess e WaitForSingleObject

Private 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 Long
        hStdInput As Long
        hStdOutput As Long
        hStdError As Long
End Type

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

Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, byVal lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As LongPrivate Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const NORMAL_PRIORITY_CLASS = &H20
dwMilliseconds As Long) As Long
Private Const INFINITE = &HFFFF      '  Timeout infinito
Private Const STARTF_USESHOWWINDOW = &H1

Private Const SW_SHOW = 5

Private Sub LaunchAndWait(ByVal ppath As String, ByVal cmdLine, ByVal swWnd As Long)
On Error GoTo errLW
Dim p As Long
Dim workDir As String
Dim SI As STARTUPINFO
Dim PI As PROCESS_INFORMATION

workDir = Left$(ppath, Len(ppath) - (Len(ppath) - InStrRev(ppath, "\")))

SI.cb = Len(SI)
SI.dwFlags = STARTF_USESHOWWINDOW
SI.wShowWindow = swWnd

If Len(cmdLine) > 0 Then
    If Left$(cmdLine, 1) <> " " Then
        cmdLine = " " & cmdLine
    End If
    Debug.Print ppath & cmdLine
    p = CreateProcess(ppath, cmdLine, 0&, 0&, 0&, NORMAL_PRIORITY_CLASS, 0&, workDir, SI, PI)
Else
    Debug.Print ppath
    p = CreateProcess(vbNullString, ppath$, 0&, 0&, 0&, NORMAL_PRIORITY_CLASS, 0&, workDir, SI, PI)
End If

If p <> 0 Then
    WaitForSingleObject PI.hProcess, INFINITE
    CloseHandle PI.hProcess
    CloseHandle PI.hThread
Else
    MsgBox "Error LaunchAndWait code = " & GetLastError()
End If

Exit Sub
errLW:
Debug.Print Err.Description
End Sub

Nessun commento:

Posta un commento

Mi raccomando, non costringermi a censurare il tuo commento, perciò sii educato!