Tech-Ecke / Delphi Inhalt / DOS Befehl starten und Pipen

 

     DOS Befehl ausführen, Bildschirmausgabe Umleiten und in Delphi verwenden

 

   Zunächst mal Quick & Dirty

Möchte man aus Delphi heraus eine DOS- bzw. Konsolen-Anwendung starten und deren Ausgabe im eigenen Programm ausgeben, so gibt es hierfür mehr oder weniger komplizierte Prozeduren. Es gibt aber auch ne simple Qick&Dirty-Lösung. Man führt den DOS-Befehl aus und leitet die Bildschirmausgabe in eine Datei um. Nun kann man die erzeugte Datei z.B. in ein TMemo laden. Allerdings muss man noch etwas beachten. Denn nachdem die DOS-Anwendung gestartet wurde, wird das eigene Programm munter fortgefahren und nicht warten bis die Anwendung abgeschlossen und die Textdatei erstellt wurde. Also wird das eigene Programm versuchen die Textdatei zu laden, bevor diese erstellt bzw. deren Erstellung abgeschlossen wurde. Es wird hier wohl in fast allen Fällen zu einer Fehlermeldung kommen die in etwa so aussieht: "Die Datei XYZ kann nicht geöffnet werden. Das System kann die angegebene Datei nicht finden". Die Frage ist nun, wie kann man Delphi dazu bewegen solange mit dem Fortfahren des Programms zu warten, bis die externe Anwendung beendet ist. Und jetzt kommt der Dirty-Teil: Man versucht einfach immer und immer wieder die Textdatei zu laden, bis sie sich letztlich läst. Das ganze könnte wie folgt aussehen:

Hinweis!: Solange man unter Delphi (Interpreter mode) seine Anwendung testet, kommt es weiterhin zu der Fehlermeldung, die aber in der fertig kompilierten EXE nicht mehr aufpopt, da sie durch die Try-Except Routine unterdrückt wird.

Beispiel: - ShellExecute erfordert ShellAPI in uses!

  var warten: Integer;

ShellExecute(Handle, 'open',PChar('CMD'),PansiChar(' /c C:\Dosanwendung.exe > C:\test.txt'),nil,SW_SHOW);  // --- für NT/2k/XP
// ShellExecute(Handle,'open', PChar('C:\Dosanwendung.exe'),PChar(' > C:\test.txt'),nil,SW_HIDE); --- für Win95/98

repeat
warten := 0;
   try
       Memo1.Lines.Loadfromfile('C:\Datei.txt');
    except
       begin
          
sleep(250); // CPU-Entlastung
          
application.ProcessMessages; // halte das Fenster aktuell
           warten := 1;
       end;

    end;
until warten = 0;

 

Zugegeben, diese Lösung ist nicht gerade ressourcenfreundlich und nervt die Festplatte bestimmt ganz schön ab und birgt zudem eine böse Falle. Kann aus irgendeinem Grund die Datei.txt nicht erstellt, geschlossen oder geladen werden, so wird das Programm für immer und ewig in der Repeat-Until-Schleife gefangen sein. Aber hier lässt sich für solch einen Fall einen Zähler einbauen, der nach einer gewissen Zeit, mit einer passenden Fehlermeldung aus der Schleife aussteigt.

 

   Und jetzt was genaueres

Da die oben erwähnte Methode eine böse Falle bereit hält, hier mal was präziseres. Die Funktion startet die übergebene Anwendung, wartet auf deren Ende und liest dann die Ausgabe und den Fehlerkanal in eine TStringlist.

  function GetConsoleOutput(const Command: AnsiString; Output,
  Errors: TStringList): Boolean;
var
  StartupInfo: TStartupInfoA;
  ProcessInfo: TProcessInformation;
  SecurityAttr: TSecurityAttributes;
  PipeOutputRead: THandle;
  PipeOutputWrite: THandle;
  PipeErrorsRead: THandle;
  PipeErrorsWrite: THandle;
  Succeed: Boolean;
  Buffer: array [0..255] of AnsiChar;
  NumberOfBytesRead: DWORD;
  Stream: TMemoryStream;
begin
  
//Initialisierung ProcessInfo
  FillChar(ProcessInfo, SizeOf(TProcessInformation), 0);

  
//Initialisierung SecurityAttr
  FillChar(SecurityAttr, SizeOf(TSecurityAttributes), 0);
  SecurityAttr.nLength := SizeOf(SecurityAttr);
  SecurityAttr.bInheritHandle := true;
  SecurityAttr.lpSecurityDescriptor := nil;

  
//Pipes erzeugen
  CreatePipe(PipeOutputRead, PipeOutputWrite, @SecurityAttr, 0);
  CreatePipe(PipeErrorsRead, PipeErrorsWrite, @SecurityAttr, 0);

  
//Initialisierung StartupInfo
  FillChar(StartupInfo, SizeOf(StartupInfo), 0);
  StartupInfo.cb:=SizeOf(StartupInfo);
  StartupInfo.hStdInput := 0;
  StartupInfo.hStdOutput := PipeOutputWrite;
  StartupInfo.hStdError := PipeErrorsWrite;
  StartupInfo.wShowWindow := sw_Hide;
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;

  if CreateProcessA(nil, PAnsiChar(command), nil, nil, true,
  CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil,
  StartupInfo, ProcessInfo) then begin
    result := true;
    
//Write-Pipes schließen
    CloseHandle(PipeOutputWrite);
    CloseHandle(PipeErrorsWrite);

    
//Ausgabe Read-Pipe auslesen
    Stream := TMemoryStream.Create;
    try
      while true do begin
        succeed := ReadFile(PipeOutputRead, Buffer, 255, NumberOfBytesRead, nil);
        if not succeed then break;
        Stream.Write(Buffer, NumberOfBytesRead);
      end;
      Stream.Position := 0;
      Output.LoadFromStream(Stream);
    finally
      Stream.Free;
    end;
    CloseHandle(PipeOutputRead);

    
//Fehler Read-Pipe auslesen
    Stream := TMemoryStream.Create;
    try
      while true do begin
        succeed := ReadFile(PipeErrorsRead, Buffer, 255, NumberOfBytesRead, nil);
        if not succeed then break;
        Stream.Write(Buffer, NumberOfBytesRead);
      end;
      Stream.Position := 0;
      Errors.LoadFromStream(Stream);
    finally
      Stream.Free;
    end;
    CloseHandle(PipeErrorsRead);

    WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
    CloseHandle(ProcessInfo.hProcess);
  end
  else begin
    result := false;
    CloseHandle(PipeOutputRead);
    CloseHandle(PipeOutputWrite);
    CloseHandle(PipeErrorsRead);
    CloseHandle(PipeErrorsWrite);
  end;
end;

Quelle: Delphi-Treff.de.

Der Aufruf dieser Funktion könnte dann wie folgt aussehen:

  var
     OutPutList, ErrorList: TStringList;

...

   OutPutList := TStringList.Create;
   ErrorList := TStringList.Create;
   GetConsoleOutput('cmd /c dir c:\',OutPutList,ErrorList);   // liest Inhaltsverzeichnis von Laufwerk C:\

... mach was mit dem Inhalt der beiden Stringlists

OutPutList.Free;
ErrorList.Free;
 

Die Option Drucken funktioniert erst ab Netscape V4.0 bzw. I-Explorer 5.0 !

[letzte Aktualisierung 25.08.2008]