Subversion Repositories fastphp

Rev

Rev 70 | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. unit RunPHP;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, Forms, Classes, Windows;
  7.  
  8. type
  9.   TInputRequestCallback = function(var data: AnsiString): boolean of object;
  10.   TOutputNotifyCallback = function(const output: AnsiString): boolean of object;
  11.   TRunCodeExplorer = class(TThread)
  12.   private
  13.     FInputRequestCallback: TInputRequestCallback;
  14.     FOutputNotifyCallback: TOutputNotifyCallback;
  15.     FInputWaiting: AnsiString;
  16.     FInputWasSuccessful: boolean;
  17.     FOutputWaiting: AnsiString;
  18.     FOutputWasSuccessful: boolean;
  19.   protected
  20.     procedure CallInputRequestCallback;
  21.     procedure CallOutputNotifyCallback;
  22.   public
  23.     PhpExe: string;
  24.     PhpFile: string;
  25.     WorkDir: string;
  26.     property InputRequestCallback: TInputRequestCallback read FInputRequestCallback write FInputRequestCallback;
  27.     property OutputNotifyCallback: TOutputNotifyCallback read FOutputNotifyCallback write FOutputNotifyCallback;
  28.     procedure Execute; override;
  29.   end;
  30.  
  31. implementation
  32.  
  33. procedure TRunCodeExplorer.Execute;
  34.  
  35.   function ProcessRunning(PI: TProcessInformation): boolean; inline;
  36.   var
  37.     exitcode: Cardinal;
  38.   begin
  39.     result := GetExitCodeProcess(PI.hProcess, exitcode) and (exitcode = STILL_ACTIVE);
  40.   end;
  41.  
  42. var
  43.   SA: TSecurityAttributes;
  44.   SI: TStartupInfo;
  45.   PI: TProcessInformation;
  46.   StdOutPipeRead, StdOutPipeWrite: THandle;
  47.   StdInPipeRead, StdInPipeWrite: THandle;
  48.   WasOK: Boolean;
  49.   Buffer: array[0..255] of AnsiChar;
  50.   BytesRead, BytesWritten: Cardinal;
  51.   WorkDir: string;
  52.   Handle: Boolean;
  53.   testString: AnsiString;
  54.   Output, OutputLastCache: string;
  55. const
  56.   SIGNAL_END_OF_TRANSMISSION = #1#2#3#4#5#6#7#8;
  57.   SIGNAL_TERMINATE           = #8#7#6#5#4#3#2#1;
  58. begin
  59.   if Self.WorkDir = '' then
  60.     WorkDir := ExtractFilePath(ParamStr(0))
  61.   else
  62.     WorkDir := Self.WorkDir;
  63.  
  64.   if not FileExists(Self.PhpExe) then exit;
  65.   if not FileExists(Self.PhpFile) then exit;
  66.  
  67.   Output := '';
  68.   OutputLastCache := '';
  69.   with SA do begin
  70.     nLength := SizeOf(SA);
  71.     bInheritHandle := True;
  72.     lpSecurityDescriptor := nil;
  73.   end;
  74.   CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
  75.   CreatePipe(StdInPipeRead, StdInPipeWrite, @SA, 0);
  76.   try
  77.     with SI do
  78.     begin
  79.       FillChar(SI, SizeOf(SI), 0);
  80.       cb := SizeOf(SI);
  81.       dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  82.       wShowWindow := SW_HIDE;
  83.       hStdInput := StdInPipeRead;
  84.       hStdOutput := StdOutPipeWrite;
  85.       hStdError := StdOutPipeWrite;
  86.     end;
  87.  
  88.     Handle := CreateProcess(nil, PChar('"'+Self.PhpExe+'" -f "'+Self.PhpFile+'"'),
  89.                             nil, nil, True, 0, nil, PChar(WorkDir), SI, PI);
  90.     CloseHandle(StdOutPipeWrite);
  91.  
  92.     sleep(100);
  93.  
  94.     if Handle then
  95.       try
  96.         while not Self.Terminated and ProcessRunning(PI) do
  97.         begin
  98.           {$REGION 'Get input from mainthread'}
  99.           if Assigned(FInputRequestCallback) then
  100.           begin
  101.             Synchronize(CallInputRequestCallback);
  102.  
  103.             if not FInputWasSuccessful then
  104.             begin
  105.               Sleep(100);
  106.               continue;
  107.             end;
  108.  
  109.             // Attention: This call will block if the process exited
  110.             WriteFile(StdInPipeWrite, FInputWaiting[1], Length(FInputWaiting), BytesWritten, nil);
  111.           end;
  112.           {$ENDREGION}
  113.  
  114.           {$REGION 'Terminate input sequence'}
  115.           testString := #13#10+SIGNAL_END_OF_TRANSMISSION+#13#10;
  116.           WriteFile(StdInPipeWrite, testString[1], Length(testString), BytesWritten, nil);
  117.           {$ENDREGION}
  118.  
  119.           {$REGION 'Gather output'}
  120.           Output := '';
  121.           repeat
  122.             WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
  123.             if BytesRead > 0 then
  124.             begin
  125.               Buffer[BytesRead] := #0;
  126.               Output := Output + string(Buffer);
  127.               if Pos(SIGNAL_END_OF_TRANSMISSION, Output) >= 1 then
  128.               begin
  129.                 Output := StringReplace(Output, SIGNAL_END_OF_TRANSMISSION, '', []);
  130.                 break;
  131.               end;
  132.             end;
  133.           until not WasOK or (BytesRead = 0) or Self.Terminated or not ProcessRunning(PI);
  134.           {$ENDREGION}
  135.  
  136.           {$REGION 'Notify main thread about output'}
  137.           if Assigned(FOutputNotifyCallback) and (OutputLastCache <> Output) and not Self.Terminated and ProcessRunning(PI) then
  138.           begin
  139.             FOutputWaiting := Output;
  140.             Synchronize(CallOutputNotifyCallback);
  141.             if FOutputWasSuccessful then
  142.             begin
  143.               OutputLastCache := Output;
  144.             end;
  145.           end;
  146.           {$ENDREGION}
  147.         end;
  148.  
  149.         // Signal the code explorer to terminate
  150.         (*
  151.         testString := #13#10+SIGNAL_TERMINATE+#13#10;
  152.         WriteFile(StdInPipeWrite, testString[1], Length(testString), BytesWritten, nil);
  153.         WaitForSingleObject(PI.hProcess, INFINITE);
  154.         *)
  155.         TerminateProcess(Pi.hProcess, 0);
  156.  
  157.         CloseHandle(StdInPipeWrite);
  158.       finally
  159.         CloseHandle(PI.hThread);
  160.         CloseHandle(PI.hProcess);
  161.       end;
  162.   finally
  163.     CloseHandle(StdOutPipeRead);
  164.     CloseHandle(StdInPipeRead);
  165.   end;
  166. end;
  167.  
  168. {synchron} procedure TRunCodeExplorer.CallInputRequestCallback;
  169. begin
  170.   FInputWasSuccessful := FInputRequestCallback(FInputWaiting);
  171. end;
  172.  
  173. {synchron} procedure TRunCodeExplorer.CallOutputNotifyCallback;
  174. begin
  175.   FOutputWasSuccessful := FOutputNotifyCallback(FOutputWaiting);
  176. end;
  177.  
  178. end.
  179.