|
Lösung:
Auch für dieses Beispiel werden einige Windows API - Funktionen benötigt. Es soll ein Ersatz für die VB - Anweisung "Shell" erstellt werden. Die neue Funktion wird den Namen ShellSynchron erhalten. Das folgende Beispiel geht davon aus, daß der Code für die neue Funktion in einem eigenen Standardmodul erstellt wird, so daß von außerhalb lediglich die globale (Public) Funktion ShellSynchron zugänglich wird.
Option Explicit 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 CreateProcessA Lib "kernel32" _ (ByVal lpApplicationName As Long, _ ByVal lpCommandLine As String, _ ByVal lpProcessAttributes As Long, _ ByVal lpThreadAttributes As Long, _ ByVal bInheritHandles As Long, _ ByVal dwCreationFlags As Long, _ ByVal lpEnvironment As Long, _ ByVal lpCurrentDirectory As Long, _ 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 Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Public Function ShellSynchron(CmdLine As String) As Long Const NORMAL_PRIORITY_CLASS = &H20& Const INFINITE = -1& Dim proc As PROCESS_INFORMATION Dim start As STARTUPINFO Dim ret As Long ' ' Type STARTUPINFO initialisieren: ' start.cb = Len(start) ' ' Externes Programm aufrufen: ' ret = CreateProcessA(0&, CmdLine$, 0&, 0&, 1&, _ NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc) ' ' Testen, ob der Aufruf erfolgreich war: ' ShellSynchron = ret If ret = 0 Then Debug.Print "Fail: " & CmdLine$ Exit Function Else Debug.Print "Process Created: " & CmdLine$ Debug.Print "dwProcessID: " & proc.dwProcessID Debug.Print "dwThreadID: " & proc.dwThreadID Debug.Print "hProcess: " & proc.hProcess Debug.Print "hThread: " & proc.hThread End If ' ' Warten, bis die aufgerufenen Applikation beendet wird: ' ret = WaitForSingleObject(proc.hProcess, INFINITE) ' ' Process - Handle freigeben (Wichtig): ' ret = CloseHandle(proc.hProcess) End Function
Sub Main() Dim RetVal as Long Dim KomandoZeile as String Kommandozeile = "C:\Windows\Notepad.exe" Msgbox "Gleich wird " & Kommandozeile & " gestartet." ' ' Error Handler ausschalten: ' On Error Resume Next RetVal = ShellSynchron(Kommandozeile) If RetVal = 0 Or Err Then UserReply = MsgBox("Fehler beim Ausführen der Anweisung:" & vbCrLf & _ Kommandozeile & vbCrLf & Error$, _ vbExclamation + vbOKOnly) Err.Clear Else MsgBox Kommandozeile & " wurde erfolgreich ausgeführt." End If End Sub
|