Option Explicit
 
Private Declare Function CreatePipe Lib "kernel32" (phReadPipe _
        As Long, phWritePipe As Long, lpPipeAttributes As Any, _
        ByVal nSize As Long) As Long
 
Private 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
 
Private 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
 
Private Declare Function CloseHandle Lib "kernel32" (ByVal _
        hObject As Long) As Long
 
Private 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
 
Private Declare Function WaitForSingleObject Lib "kernel32" ( _
        ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
 
Private Type SECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Long
End Type
 
Private 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
 
Private Type PROCESS_INFORMATION
  hProcess As Long
  hThread As Long
  dwProcessID As Long
  dwThreadID As Long
End Type
 
Const NORMAL_PRIORITY_CLASS = &H20&
Const STARTF_USESTDHANDLES = &H100&
 
Private Sub Command1_Click()
    Dim OutText As String
    Dim WithUml As String
 
    'Hier den Pfad einer Batchdatei oder einer Konsolenanwendung
    'die eine Ausgabe hat eintragen
Text1.Text = ExecCmd("F:\Marco\ratiodata\Putty Fernwartung\plink.exe -ssh" & _
  "10.20.100.80 -P 22 -l test -pw test")
 
End Sub
 
Private Function ExecCmd(cmdline$) As String
    Dim proc As PROCESS_INFORMATION
    Dim start As STARTUPINFO
    Dim sa As SECURITY_ATTRIBUTES
    Dim hReadPipe As Long, hWritePipe As Long
    Dim L As Long, Result As Long, bSuccess As Long
    Dim Buffer As String
 
    Dim retText As String
 
    sa.nLength = Len(sa)
    sa.bInheritHandle = 1&
    sa.lpSecurityDescriptor = 0&
    Result = CreatePipe(hReadPipe, hWritePipe, sa, 0)
 
    If Result = 0 Then
        MsgBox "CreatePipe failed Error!"
        Exit Function
    End If
 
    start.cb = Len(start)
    start.dwFlags = STARTF_USESTDHANDLES
    start.hStdOutput = hWritePipe
 
oben:
 
    Result = CreateProcessA(0&, cmdline$, sa, sa, 1&, _
        NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
 
    If Result <> 0 Then
        '*** Anfang der Verbesserung Achim Neubauer***
 
        Dim lPeekData As Long
 
        Do
            Call PeekNamedPipe(hReadPipe, ByVal 0&, 0&, ByVal 0&, _
                lPeekData, ByVal 0&)
 
            If lPeekData > 0 Then
                Buffer = Space$(lPeekData)
                bSuccess = ReadFile(hReadPipe, Buffer, Len(Buffer), L, 0&)
 
                If bSuccess = 1 Then
                    retText = retText & Left(Buffer, L)
                    MsgBox retText
                    GoTo oben
                Else
                    MsgBox "ReadFile failed!"
                End If
            Else
                bSuccess = WaitForSingleObject(proc.hProcess, 0&)
 
                If bSuccess = 0 Then
                    Exit Do
                End If
            End If
 
            DoEvents
        Loop
 
        '*** Ende der Verbesserung Achim Neubauer ***
    Else
        MsgBox "Error while starting process!"
    End If
 
    Call CloseHandle(proc.hProcess)
    Call CloseHandle(proc.hThread)
    Call CloseHandle(hReadPipe)
    Call CloseHandle(hWritePipe)
 
    ExecCmd = retText
End Function
 
Private Sub Form_Load()
    Command1.Caption = "Start"
End Sub