1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:

function GetDosOutput(const CommandLine:string): string;
var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of Char;
  BytesRead: Cardinal;
  WorkDir, Line, RootDir: String;
begin
  Application.ProcessMessages;
  with SA do
  begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;
  // create pipe for standard output redirection
  CreatePipe(StdOutPipeRead,  // read handle
             StdOutPipeWrite, // write handle
             @SA,             // security attributes
             0                // number of bytes reserved for pipe - 0 default
);

  try
    // Make child process use StdOutPipeWrite as standard out,
    // and make sure it does not show on screen.
    with SI do
    begin
      FillChar(SI, SizeOf(SI), 0);
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow := SW_HIDE;
      hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect std input
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;

    // launch the command line compiler
    //WorkDir := ExtractFilePath(CommandLine);
    // Initialize dirs 
    RootDir:=ExtractFilePath(ParamStr(0));
    WorkDir:=ExtractFilePath(CommandLine);

    // Check WorkDir
    if not (FileSearch(ExtractFileName(CommandLine),WorkDir)<>'') then WorkDir:=RootDir; 



    WasOK := CreateProcess(nil, PChar(CommandLine), nil, nil, True, 0, nil, PChar(WorkDir), SI, PI);

    // Now that the handle has been inherited, close write to be safe. 
    // We don't want to read or write to it accidentally.
    CloseHandle(StdOutPipeWrite); 
    // if process could be created then handle its output 
    if not WasOK then raise Exception.Create('Could not execute command line!')
    else 
      try
        // get all output until dos app finishes 
        Line := ''; 
        repeat
          // read block of characters (might contain carriage returns and line feeds)
          WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil); 

          // has anything been read? 
          if BytesRead > 0 then 
          begin 
            // finish buffer to PChar
            Buffer[BytesRead] := #0;
            // combine the buffer with the rest of the last run 
            Line := Line + Buffer; 
          end; 
        until not WasOK or (BytesRead = 0); 
        // wait for console app to finish (should be already at this point)
        WaitForSingleObject(PI.hProcess, INFINITE); 
      finally 
        // Close all remaining handles 
        CloseHandle(PI.hThread); 
        CloseHandle(PI.hProcess); 
      end; 
  finally 
      result:=Line; 
      CloseHandle(StdOutPipeRead); 
  end; 
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:

procedure TMain.CaptureDosCmd(command:String;OutputMemo:TMemo);
const
  CaptureBufferSize = 2500;
var  
  SecAttrib         : TSecurityAttributes;
  ReadPipe,writePipe   : THandle;
  Startup               : TStartUpInfo;
  ProcessInfo         : TProcessInformation;
  CaptureBuffer              : Pchar;
  BytesRead           : DWord;
  WaitHandle          : DWord;

begin  
  OutPutMemo.Lines.clear;
  //OutputMemo.lines.add('executing "' + command + '"');
  With SecAttrib do  
  begin    
    nlength              := SizeOf(TSecurityAttributes);
    binherithandle       := true;
    lpsecuritydescriptor := nil;
  end;
  
  if Createpipe (ReadPipe, writePipe, @SecAttrib, 0) then  
  begin    
    CaptureBuffer  := AllocMem(CaptureBufferSize + 1);
    FillChar(Startup,Sizeof(Startup),#0);
    Startup.cb          := SizeOf(Startup);
    Startup.hStdOutput  := writePipe;
    Startup.hStdInput   := ReadPipe;
    Startup.dwFlags     := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
    Startup.wShowWindow := SW_HIDE;
    if CreateProcess(nil, PChar(command), @SecAttrib, @SecAttrib, true, NORMAL_PRIORITY_CLASS, nil, nil, Startup, ProcessInfo) then    
    begin      
      repeat 
        WaitHandle := WaitForSingleObject( ProcessInfo.hProcess,100);
        Application.ProcessMessages;
      until (WaitHandle <> WAIT_TIMEOUT) or application.terminated;

      if not application.terminated then 
      Repeat 
        BytesRead := 0;
        ReadFile(ReadPipe,CaptureBuffer[0],CaptureBufferSize,BytesRead,nil);        
        CaptureBuffer[BytesRead]:= #0;        
        OemToAnsi(CaptureBuffer,CaptureBuffer);
        OutputMemo.Text := OutputMemo.Text+String(CaptureBuffer);
      until (BytesRead < CaptureBufferSize);      
    end 
    else OutPutMemo.lines.add('Operation wurde abgebrochen!');    
    
    FreeMem(CaptureBuffer);    
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ReadPipe);
    CloseHandle(writePipe);  
  end 
  else OutPutMemo.lines.add('Konnte Kommando nicht starten, Fehler: #'+  inttostr(getlasterror));
end;