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.

Api-AufrufeVerwendete 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