WebSVN – fastphp – Diff – /trunk/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.
 

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

Subversion Repositories fastphp

fastphp/trunk/RunPHP.pas – Rev 70 → 91