Tipp 10.17 - Cmd-Programmausgabe ermitteln
Wie kann ich die Cmd-Programmausgabe ermitteln?
Mit dieser Funktion können Sie die Cmd-Programmausgabe ermitteln. Kopieren Sie einfach nachfolgenden Quellcode in die Zwischenablage und fügen Sie anschließend den Inhalt der Zwischenablage in ein neues Modul ein. Die Aufrufparameter finden Sie im Quellcode beschrieben.
Verwendete Win32-Api-Aufrufe und Typen: CreatePipe, ReadFile, CreateProcessA, CloseHandle, PeekNamedPipe, WaitForSingleObject - PROCESS_INFORMATION, SECURITY_ATTRIBUTES, STARTUPINFO
Beispiel:
Option Explicit Const NORMAL_PRIORITY_CLASS As Long = &H20& Const STARTF_USESTDHANDLES As Long = &H100& Type PROCESS_INFORMATION hProcess As Long hThread As Long dwProcessID As Long dwThreadID As Long End Type Type SECURITY_ATTRIBUTES nLength As Long lpSecurityDescriptor As Long bInheritHandle As Long End Type Type STARTUPINFO cb As Long lpReserved As Long lpDesktop As Long lpTitle As Long 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 Declare Function CreatePipe Lib "kernel32" _ (phReadPipe As Long, _ phWritePipe As Long, _ lpPipeAttributes As Any, _ ByVal nSize As Long) As Long Declare Function ReadFile Lib "kernel32" _ (ByVal hFile As Long, _ ByVal lpBuffer As String, _ ByVal nNumberOfBytesToRead As Long, _ lpNumberOfBytesRead As Long, _ ByVal lpOverlapped As Any) As Long Declare Function CreateProcessA Lib "kernel32" _ (ByVal lpApplicationName As Long, _ ByVal lpCommandLine As String, _ lpProcessAttributes As Any, _ lpThreadAttributes As Any, _ ByVal bInheritHandles As Long, _ ByVal dwCreationFlags As Long, _ ByVal lpEnvironment As Long, _ ByVal lpCurrentDirectory As Long, _ lpStartupInfo As Any, _ lpProcessInformation As Any) As Long Declare Function CloseHandle Lib "kernel32" _ (ByVal hObject As Long) As Long Declare Function PeekNamedPipe Lib "kernel32" _ (ByVal hNamedPipe As Long, _ lpBuffer As Any, _ ByVal nBufferSize As Long, _ lpBytesRead As Long, _ lpTotalBytesAvail As Long, _ lpBytesLeftThisMessage As Long) As Long Declare Function WaitForSingleObject Lib "kernel32" _ (ByVal hHandle As Long, _ ByVal dwMilliseconds As Long) As Long Function DoCmdExecute(sCommandLine As String) As String '// ----------------------------------------------------- '// Methode: | Ausgabe eines Cmd-Programms ermitteln '// ----------------------------------------------------- '// Parameter: | sCommandLine - Cmd-Befehlszeile '// ----------------------------------------------------- '// Rückgabe: | Ermittelte Ausgabe des Programms '// ----------------------------------------------------- '// Autor: | Stefan Kulpa '// | EDV Innovation & Consulting - Dormagen '// ----------------------------------------------------- Dim uSA As SECURITY_ATTRIBUTES Dim uPI As PROCESS_INFORMATION Dim uSI As STARTUPINFO Dim bSuccess As Boolean Dim lTotalBytes As Long Dim lPipeOut As Long Dim lPipeIn As Long Dim lLength As Long Dim lResult As Long Dim sBuffer As String Dim sResult As String uSA.nLength = Len(uSA) uSA.bInheritHandle = 1& uSA.lpSecurityDescriptor = 0& lResult = CreatePipe(lPipeIn, lPipeOut, uSA, 0) If lResult = 0 Then MsgBox "Anonymous pipe could not be created!", vbExclamation Exit Function End If uSI.cb = Len(uSI) uSI.dwFlags = STARTF_USESTDHANDLES uSI.hStdOutput = lPipeOut lResult = CreateProcessA(0&, _ sCommandLine, _ uSA, _ uSA, _ 1&, _ NORMAL_PRIORITY_CLASS, _ 0&, _ 0&, _ uSI, _ uPI) If lResult <> 0 Then Do Call PeekNamedPipe(lPipeIn, _ ByVal 0&, _ 0&, _ ByVal 0&, _ lTotalBytes, _ ByVal 0&) If lTotalBytes > 0 Then sBuffer = Space$(lTotalBytes) bSuccess = _ CBool(ReadFile(lPipeIn, _ sBuffer, _ Len(sBuffer), _ lLength, _ 0&)) If bSuccess Then sResult = _ sResult & Left(sBuffer, lLength) Else: MsgBox "Reading data from file failed!", _ vbExclamation End If Else bSuccess = _ CBool(WaitForSingleObject(uPI.hProcess, 0&)) If Not bSuccess Then Exit Do End If DoEvents Loop Else MsgBox "New process could not be created!", vbExclamation End If lResult = CloseHandle(uPI.hProcess) lResult = CloseHandle(uPI.hThread) lResult = CloseHandle(lPipeIn) lResult = CloseHandle(lPipeOut) DoCmdExecute = sResult End Function Sub CmdTest() Debug.Print DoCmdExecute("ipconfig.exe /all") End Sub