Mit Delphi ein anderes Delphiprogramm ansprechen

[Der schöne Günther]

Zitat von Back2Code:

Gibts hier im Board bzw im Netz eine gute Erklärung zu den Begriffen "Pipe & stdOut? Höre ich jetzt zum ersten Mal

Das MSDN-Tutorial hier ist eigentlich genau das, was wir wollen. Ich habe es in Kürze einmal versucht, nachzubauen, hat auch halbwegs funktioniert. In meiner VCL-Memo konnte ich sehen, was der (unsichtbare) Kindprozess einfach mittels WriteLn() rausgeworfen hat. Das hat auf die Schnelle auch geklappt, nur müsste ich noch eine Lösung finden, nicht bis in alle Unendlichkeit zu warten, bis jemand etwas in die Pipe schreibt.

Ich werfe es hier einfach mal hinein:

Delphi-Quellcode:

unit Unit13;

interface

uses
   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
   System.Classes, Vcl.Graphics,
   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
   TMainForm = class(TForm)
      gridpanel: TGridPanel;
      startButton: TButton;
      stopButton: TButton;
      stdOutMemo: TMemo;
      Timer1: TTimer;

      procedure Timer1Timer(Sender: TObject);
      procedure startButtonClick(Sender: TObject);
      procedure stopButtonClick(Sender: TObject);

      private const
         // relativer Pfad ausgehend vom Arbeitsverzeichnis
         childProcessApplicationName: String = '.\..\ChildProcess\Win32\Debug\ChildProcessProject.exe';


      private var
         myProcess: TProcessorNumber;

         readHandle: THandle;
         writeHandle: THandle;

      private
         procedure startProcess();
         procedure stopProcess();

         procedure tryStartProcess();
         procedure tryStopProcess();

         procedure createMeAPipe(
            var readHandle: THandle;
            var writeHandle: THandle
         );

         /// <exception cref="EFileNotFoundException" />
         procedure checkChildPossible();

         procedure tryReadFromPipe();
         function isValidReadHandle(): Boolean;

   end;

var
   MainForm: TMainForm;

implementation

{$R *.dfm}

{ TMainForm }

procedure TMainForm.startButtonClick(Sender: TObject);
begin
   startProcess();
end;

procedure TMainForm.startProcess();
begin
   startButton.Enabled := False;
   try
      tryStartProcess();
      stopButton.Enabled := True;
   except
      startButton.Enabled := True; raise;
    end;
end;

procedure TMainForm.stopButtonClick(Sender: TObject);
begin
   stopProcess();
end;

procedure TMainForm.stopProcess();
begin
   stopButton.Enabled := False;
   try
      tryStopProcess();
      startButton.Enabled := True;
   except
      stopButton.Enabled := True; raise;
   end;


end;

procedure TMainForm.Timer1Timer(Sender: TObject);
begin
   if isValidReadHandle() then
      tryReadFromPipe();
end;

procedure TMainForm.tryReadFromPipe();
const
   readBufferLength = 2400;
var
   buffer: Array[0..readBufferLength] of AnsiChar;
   bytesRead: DWORD;
begin

   ReadFile(readHandle, buffer, readBufferLength, bytesRead, nil);
   buffer[bytesRead] := #0;

   stdOutMemo.Lines.Append(buffer);

end;

function TMainForm.isValidReadHandle(): Boolean;
begin
   Result :=
      not (readHandle = 0)
   and
      not (readHandle = INVALID_HANDLE_VALUE)
   ;

end;

procedure TMainForm.tryStartProcess();
var
   startInfo: TStartupInfo;
   processInfo: TProcessInformation;

   errorCode: Cardinal;
   errorMsg: String;

   dwCreationFlags: DWORD;
   cmdLine: String;

   applicationName: String;
begin

   checkChildPossible();
   createMeAPipe(readHandle, writeHandle);

   startInfo := Default(TStartupInfo);
   startInfo.cb := SizeOf(startInfo);

   startInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
   startInfo.wShowWindow := SW_SHOW;

   // Wegen STARTF_USESTDHANDLES in den dwFlags explizit alle drei Handles setzen
   startInfo.hStdOutput := writeHandle;
   startInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
   startInfo.hStdError := GetStdHandle(STD_ERROR_HANDLE);

   processInfo := Default(TProcessInformation);

   applicationName :=
      GetCurrentDir()+PathDelim+
      childProcessApplicationName;

   if not CreateProcess(
      PWideChar(applicationName),
      nil,
      nil,    // Standard-Sicherheit, Handle wird nicht vererbt
      nil,    // Standard-Sicherheit, Handle wird nicht vererbt
      True,    // Handles (Schreibepipe!) vererben
      0,     // Keine besonderen dwCreationFlags
      nil,
      nil,
      startInfo,
      processInfo
   ) then raise Exception.Create(
      'TMainForm.tryStartProcess: Errorcode '+
      GetLastError().ToString()+
      ' bei CreateProcess'
      )
   ;


end;

procedure TMainForm.checkChildPossible();
begin
   if not FileExists(
      GetCurrentDir()+childProcessApplicationName
   ) then raise EFileNotFoundException.Create(
      'TMainForm.checkChildPossible: '
      +'Datei '
      +childProcessApplicationName.QuotedString()
      +' nicht gefunden. Aktuelles Arbeitsverzeichnis ist '
      +GetCurrentDir().QuotedString()
   );
end;


procedure TMainForm.createMeAPipe(
   var readHandle: THandle;
   var writeHandle: THandle
);
var
   saSecurity: TSecurityAttributes;
begin

   saSecurity.nLength := SizeOf(TSecurityAttributes);
   saSecurity.bInheritHandle := True;
   saSecurity.lpSecurityDescriptor := nil;

   if not CreatePipe(readHandle, writeHandle, @saSecurity, 0) then
      raise Exception.Create('TMainForm.createMeAPipe: Konnte keine Pipe erstellen');


end;

procedure TMainForm.tryStopProcess;
begin
   raise EProgrammerNotFound.Create('derp');
end;

end.