RunPHP.pas

unit RunPHP;

interface

uses
  SysUtils, Forms, Classes, Windows;

type
  TInputRequestCallback = function(var data: AnsiString): boolean of object;
  TOutputNotifyCallback = function(const output: AnsiString): boolean of object;
  TRunCodeExplorer = class(TThread)
  private
    FInputRequestCallback: TInputRequestCallback;
    FOutputNotifyCallback: TOutputNotifyCallback;
    FInputWaiting: AnsiString;
    FInputWasSuccessful: boolean;
    FOutputWaiting: AnsiString;
    FOutputWasSuccessful: boolean;
  protected
    procedure CallInputRequestCallback;
    procedure CallOutputNotifyCallback;
  public
    PhpExe: string;
    PhpFile: string;
    WorkDir: string;
    property InputRequestCallback: TInputRequestCallback read FInputRequestCallback write FInputRequestCallback;
    property OutputNotifyCallback: TOutputNotifyCallback read FOutputNotifyCallback write FOutputNotifyCallback;
    procedure Execute; override;
  end;

implementation

procedure TRunCodeExplorer.Execute;

  function ProcessRunning(PI: TProcessInformation): boolean; inline;
  var
    exitcode: Cardinal;
  begin
    result := GetExitCodeProcess(PI.hProcess, exitcode) and (exitcode = STILL_ACTIVE);
  end;

var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  StdInPipeRead, StdInPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of AnsiChar;
  BytesRead, BytesWritten: Cardinal;
  WorkDir: string;
  Handle: Boolean;
  testString: AnsiString;
  Output, OutputLastCache: string;
const
  SIGNAL_END_OF_TRANSMISSION = #1#2#3#4#5#6#7#8;
  SIGNAL_TERMINATE           = #8#7#6#5#4#3#2#1;
begin
  if Self.WorkDir = '' then
    WorkDir := ExtractFilePath(ParamStr(0))
  else
    WorkDir := Self.WorkDir;

  if not FileExists(Self.PhpExe) then exit;
  if not FileExists(Self.PhpFile) then exit;

  Output := '';
  OutputLastCache := '';
  with SA do begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;
  CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
  CreatePipe(StdInPipeRead, StdInPipeWrite, @SA, 0);
  try
    with SI do
    begin
      FillChar(SI, SizeOf(SI), 0);
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow := SW_HIDE;
      hStdInput := StdInPipeRead;
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;

    Handle := CreateProcess(nil, PChar('"'+Self.PhpExe+'" -f "'+Self.PhpFile+'"'),
                            nil, nil, True, 0, nil, PChar(WorkDir), SI, PI);
    CloseHandle(StdOutPipeWrite);

    sleep(100);

    if Handle then
      try
        while not Self.Terminated and ProcessRunning(PI) do
        begin
          {$REGION 'Get input from mainthread'}
          if Assigned(FInputRequestCallback) then
          begin
            Synchronize(CallInputRequestCallback);

            if not FInputWasSuccessful then
            begin
              Sleep(100);
              continue;
            end;

            // Attention: This call will block if the process exited
            WriteFile(StdInPipeWrite, FInputWaiting[1], Length(FInputWaiting), BytesWritten, nil);
          end;
          {$ENDREGION}

          {$REGION 'Terminate input sequence'}
          testString := #13#10+SIGNAL_END_OF_TRANSMISSION+#13#10;
          WriteFile(StdInPipeWrite, testString[1], Length(testString), BytesWritten, nil);
          {$ENDREGION}

          {$REGION 'Gather output'}
          Output := '';
          repeat
            WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
            if BytesRead > 0 then
            begin
              Buffer[BytesRead] := #0;
              Output := Output + string(Buffer);
              if Pos(SIGNAL_END_OF_TRANSMISSION, Output) >= 1 then
              begin
                Output := StringReplace(Output, SIGNAL_END_OF_TRANSMISSION, '', []);
                break;
              end;
            end;
          until not WasOK or (BytesRead = 0) or Self.Terminated or not ProcessRunning(PI);
          {$ENDREGION}

          {$REGION 'Notify main thread about output'}
          if Assigned(FOutputNotifyCallback) and (OutputLastCache <> Output) and not Self.Terminated and ProcessRunning(PI) then
          begin
            FOutputWaiting := Output;
            Synchronize(CallOutputNotifyCallback);
            if FOutputWasSuccessful then
            begin
              OutputLastCache := Output;
            end;
          end;
          {$ENDREGION}
        end;

        // Signal the code explorer to terminate
        (*
        testString := #13#10+SIGNAL_TERMINATE+#13#10;
        WriteFile(StdInPipeWrite, testString[1], Length(testString), BytesWritten, nil);
        WaitForSingleObject(PI.hProcess, INFINITE);
        *)
        TerminateProcess(Pi.hProcess, 0);

        CloseHandle(StdInPipeWrite);
      finally
        CloseHandle(PI.hThread);
        CloseHandle(PI.hProcess);
      end;
  finally
    CloseHandle(StdOutPipeRead);
    CloseHandle(StdInPipeRead);
  end;
end;

{synchron} procedure TRunCodeExplorer.CallInputRequestCallback;
begin
  FInputWasSuccessful := FInputRequestCallback(FInputWaiting);
end;

{synchron} procedure TRunCodeExplorer.CallOutputNotifyCallback;
begin
  FOutputWasSuccessful := FOutputNotifyCallback(FOutputWaiting);
end;

end.