Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Delphi Probleme eine DOS- Anwendung zu steuern mittels CreateProces (https://www.delphipraxis.net/130227-probleme-eine-dos-anwendung-zu-steuern-mittels-createproces.html)

sveni2211 5. Mär 2009 09:17


Probleme eine DOS- Anwendung zu steuern mittels CreateProces
 
Hallo.

Ich habe ein kleines Problem eine DOS- Anwendung mittels eines Delphi- Programms zu steuern.
Es gibt ein Konsolenprogramm, welches rein Textbasiert (keine Menü- Masken) arbeitet. Also so wie man die ersten Pascal- Programme kennt. In der Art:
Wählen Sie die 1 um dies zu tun, Wählen Sie die 2 um dies zu tun.
Sie haben die 2 gewählt, geben Sie den Wert für xyz an.
usw.

Im Rahmen eines größeren bestehenden Delphi- Projektes soll nun dieses Programm angesteuert werden.
Die Grundidee war nun, mittels CreateProcess dieses zu öffnen und die Standardein- und -ausgaben umzuleiten, um diese zu lesen und darauf zu reagieren.
Dazu habe ich einiges ausprobiert, aber irgendwie will das nicht richtig laufen. Vielleicht hat jemand ein passendes Beispiel oder Tipps, was ich falsch mache.

Der Rumpf der Ansteuerung steckt in einer Klasse. Der betreffende Teil sieht so aus:

Delphi-Quellcode:
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  Buffer: array[0..255] of char;
  bRead: DWord;
  hRead, hWrite: THandle;
  saAttr: TSECURITYATTRIBUTES;
  Output: TMemoryStream;
  CommandArgument: string;
  Log:TextFile;
begin
  saAttr.nLength := sizeof(TSECURITYATTRIBUTES);
  saAttr.bInheritHandle := true;
  saAttr.lpSecurityDescriptor := nil;
  if not CreatePipe(hRead, hWrite, @saAttr, 0) then
    begin
      ShowMessage('Pipe konnte nicht erstellt werden.');
      Exit;
    end;
  try
    FillChar(StartupInfo, Sizeof(StartupInfo), #0);
    StartupInfo.cb := Sizeof(StartupInfo);
    StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
    StartupInfo.wShowWindow := SW_HIDE and SW_SHOWMINNOACTIVE;
    StartupInfo.hStdInput := hRead;
    StartupInfo.hStdOutput := hWrite;
    StartupInfo.hStdError := hRead;
    AssignFile(Log,'H:\DOS_TEST.log.txt');
    if FileExists('H:\DOS_TEST.log.txt') then Append(Log)
    else Rewrite(Log);
    CommandArgument:='H:\DosPrg.exe ' + FCreateArguments;
    Writeln(Log, 'Aufruf: '+CommandArgument);
    if not CreateProcess(nil, PChar(CommandArgument), nil, nil, True, 0, nil, PChar('H:\'), StartupInfo, ProcessInfo) then
      begin
         ShowMessage('Fehler beim Erstellen des Prozesses');
      end
    else
      begin
        while WaitforSingleObject(ProcessInfo.hProcess, 0) <> WAIT_OBJECT_0 do;
        Output := TMemoryStream.Create;
        Output.Clear;
        repeat
          Buffer := #0;
          if ReadFile(hRead, Buffer, 80, bRead, nil) then
            begin
              Output.WriteBuffer(Buffer, bRead);
              Write(Log, Buffer);
              Output.Position := bRead;
            end
          else
            break;
        until bRead <> 80;
        Output.Position := 0;
        Buffer := #0;
        output.Read(Buffer, output.Size);
        Writeln(Log, Buffer);
        FreeAndNil(Output);
      end;
  finally
    CloseHandle(hRead);
    CloseHandle(hWrite);
    CloseFile(Log);
    ShowMessage('Ende');
  end;
Mit dieser Variante kamen aber nur ein paar Fetzen der Ausgaben des Consolen Programms an. Die Umleitung scheint zu funktionieren, aber eben nicht richtig.
Ebenfalls seltsam war, dass das Consolenprogrammen gleich dannach geschlossen wurde, obwohl es normalerweise die Eingabe eines großen Q (also die Tastenkombination Umschalt+Q) braucht.

Jetzt war meine Idee, dass das andere Programm durch das Delphi- Programm wieder geschlossen wird und die Ausgabe nur zeitweise umgeleitet wird. Also habe ich versucht den Buffer der Umleitung ständig zu überwachen in einem eigenen Thread.

Dazu habe ich eine zweite Klasse geschrieben:
Delphi-Quellcode:
const
  cBufferSize = 4096;

type

  tBuffer = ARRAY[1..cBufferSize] of Byte;

  tReadPipe = class(TThread)
    private
      FPipe : THandle;
      FThreadExit : boolean;
      FCritical : TCriticalSection;
      FTestLog : TextFile;
      function BufferToString(Buffer:tBuffer):string;
    protected
    public
      constructor Create(ReadPipe : THandle);
      destructor Destroy;override;
      procedure Execute;override;
      procedure Start;
      procedure Stop;
    published
  end;

constructor tReadPipe.Create(ReadPipe : THandle);
var
  LogFileName:string;
begin
  inherited Create(true);
  FThreadExit:=false;
  Self.Priority:=tpNormal;
  Self.FreeOnTerminate:=true;
  FCritical:=TCriticalSection.Create;
  FPipe:=ReadPipe;

  LogFileName:='H:\'+IntToStr(Self.Handle)+'.log.txt';
  AssignFile(FTestLog, LogFileName);
  if FileExists(LogFileName) then Append(FTestLog) else ReWrite(FTestLog);
end;

destructor tReadPipe.Destroy;
begin
  CloseFile(FTestLog);
  FCritical.Free;
  inherited;
end;

function tReadPipe.BufferToString(Buffer:tBuffer):string;
var
  Zeile : string;
  i:integer;
  NullFound : boolean;
begin
  Zeile := '';
  i:=1;
  NullFound:=false;
  repeat
    if Buffer[i]<>0 then
      begin
        Zeile:=Zeile+Chr(Buffer[i]);
      end
    else
      begin
        NullFound:=true;
      end;
    INC(i);
  until NullFound or (i>cBufferSize);
  Result:=Zeile;
end;

procedure tReadPipe.Execute;
var
  Buffer:tBuffer;
  Readed:LongWord;
begin
  while not FThreadExit do
    begin
      repeat
        ReadFile(FPipe,Buffer,cBufferSize,Readed,NIL);
        if Readed>0 then
          begin
            Writeln(FTestLog, BufferToString(Buffer));
          end;
      until FThreadExit xor (Readed=0);
      Sleep(30);
    end;
end;

procedure tReadPipe.Start;
begin
  Self.Resume;
end;

procedure tReadPipe.Stop;
begin
  FCritical.Enter;
  FThreadExit:=true;
  FCritical.Leave;
end;
anschließend habe ich die Steuer- Routine wie folgt geändert:
Delphi-Quellcode:
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  Buffer: array[0..255] of char;
  bRead: DWord;
  hRead, hWrite: THandle;
  saAttr: TSECURITYATTRIBUTES;
  Output: TMemoryStream;
  CommandArgument: string;
  Log:TextFile;
  OutputThread : tReadPipe;
begin
  saAttr.nLength := sizeof(TSECURITYATTRIBUTES);
  saAttr.bInheritHandle := true;
  saAttr.lpSecurityDescriptor := nil;
  if not CreatePipe(hRead, hWrite, @saAttr, 0) then
    begin
      ShowMessage('Fehler beim Erstellen der Pipe.');
      Exit;
    end;
  try
    FillChar(StartupInfo, Sizeof(StartupInfo), #0);
    StartupInfo.cb := Sizeof(StartupInfo);
    StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
    StartupInfo.wShowWindow := SW_HIDE and SW_SHOWMINNOACTIVE;
    StartupInfo.hStdInput := hRead;
    StartupInfo.hStdOutput := hWrite;
    StartupInfo.hStdError := hRead;
    AssignFile(Log,'H:\DOS_TEST.log.txt');
    if FileExists('H:\DOS_TEST.log.txt') then Append(Log)
    else Rewrite(Log);
    CommandArgument:='H:\DosPrg.exe ' + FCreateArguments;
    Writeln(Log, 'Aufruf: '+CommandArgument);
    if not CreateProcess(nil, PChar(CommandArgument), nil, nil, True, 0, nil, PChar('H:\'), StartupInfo, ProcessInfo) then
      begin
         ShowMessage('Prozess konnte nicht erstellt werden.');
      end
    else
      begin
        OutputThread:=tReadPipe.Create(hRead);
        OutputThread.Start;
        WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
        OutputThread.Stop;
      end;
  finally
    CloseHandle(hRead);
    CloseHandle(hWrite);
    CloseFile(Log);
    ShowMessage('Ende');
  end;
end;
Das Verhalten ist nun folgendes:

Starte ich das Programm über die IDE normal, reagiert es nicht. Die Log- Dateien werden zwar erstellt, aber sind 0 Bytes. Das Consolen Programm bleibt nun aber im Task- Manager sichtbar, scheint also geöffnet zu bleiben. Nur wird scheinbar nichts eingelesen.

Setze ich einen BreakPoint auf die Ausführung, werden wieder Teile der Ausgaben gelesen/geschrieben, aber das Consolen Programm schließt sich wieder direkt nach dem Start.

Ich sitze da nun schon über eine Woche dran, komme nun aber nicht mehr weiter. Hat also eventuell jemand ein funktionierendes Beispiel oder eine Idee, woran das liegen kann?

Entwicklungsumgebung ist Delphi 7 pro. In was das darunter liegende Programm geschrieben ist, weiß ich nicht. Es ist von extern. Umgebung wo es läuft ist Windows XP.

Bernhard Geyer 5. Mär 2009 09:22

Re: Probleme eine DOS- Anwendung zu steuern mittels CreatePr
 
Ist es nun eine DOS-Anwendung oder eine Consolen-Anwendung :gruebel:
Ich könnte mir Vorstellen das es hier einige Unterschiede gibt wie man diese einbinden könnte.

SirThornberry 5. Mär 2009 09:22

Re: Probleme eine DOS- Anwendung zu steuern mittels CreatePr
 
Hast du das problem nur bei dieser Dosanwendung? Oder hast du generell Probleme die Standardausgabe von Programmen zu lesen?

sveni2211 5. Mär 2009 11:32

Re: Probleme eine DOS- Anwendung zu steuern mittels CreatePr
 
Zitat:

Zitat von Bernhard Geyer
Ist es nun eine DOS-Anwendung oder eine Consolen-Anwendung.

Es ist einer Konsolen- Anwendung. Aber das dürfte keinen Unterschied machen. Die Ausgabe ist ja die selbe bei DOS (über die Concolenanwendung CMD) und einer "normalen" Consolenanwendung.

angefügt:
Zitat:

Zitat von SirThornberry
Hast du das problem nur bei dieser Dosanwendung? Oder hast du generell Probleme die Standardausgabe von Programmen zu lesen?

Ich habe sowas bisher noch nie gebraucht und von daher kein funktionierendes Beispiel. Sondern versuche mir das nun zu erarbeiten - was einfach nicht klappen will.

[edit=SirThornberry]2 Beiträge zusammen gefügt - nächstes mal bitte die Edit-Funktion verwenden :-) - Mfg, SirThornberry[/edit]

Apollonius 5. Mär 2009 16:37

Re: Probleme eine DOS- Anwendung zu steuern mittels CreatePr
 
Du brauchst zwei unabhängige Pipes, sonst liest das Programm seine eigene Ausgabe.

Zitat:

Delphi-Quellcode:
while WaitforSingleObject(ProcessInfo.hProcess, 0) <> WAIT_OBJECT_0 do;

Das solltest du noch einmal überdenken.


Alle Zeitangaben in WEZ +1. Es ist jetzt 05:58 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz