WebSVN – fastphp – Blame – /trunk/RunPHP.pas

Rev	Author	Line No.	Line
27	daniel-mar	1	unit RunPHP;
		2
		3	interface
		4
		5	uses
		6	SysUtils, Forms, Classes, Windows;
		7
		8	type
31	daniel-mar	9	TInputRequestCallback = function: AnsiString of object;
		10	TOutputNotifyCallback = procedure(const output: AnsiString) of object;
27	daniel-mar	11	TRunCodeExplorer = class(TThread)
		12	private
		13	FInputRequestCallback: TInputRequestCallback;
		14	FOutputNotifyCallback: TOutputNotifyCallback;
31	daniel-mar	15	FInputWaiting: AnsiString;
		16	FOutputWaiting: AnsiString;
27	daniel-mar	17	protected
		18	procedure CallInputRequestCallback;
		19	procedure CallOutputNotifyCallback;
		20	public
		21	PhpExe: string;
		22	PhpFile: string;
		23	WorkDir: string;
		24	property InputRequestCallback: TInputRequestCallback read FInputRequestCallback write FInputRequestCallback;
		25	property OutputNotifyCallback: TOutputNotifyCallback read FOutputNotifyCallback write FOutputNotifyCallback;
		26	procedure Execute; override;
		27	end;
		28
		29	implementation
		30
36	daniel-mar	31	uses
		32	CRC32;
		33
27	daniel-mar	34	procedure TRunCodeExplorer.Execute;
		35
		36	function ProcessRunning(PI: TProcessInformation): boolean; inline;
		37	var
		38	exitcode: Cardinal;
		39	begin
		40	result := GetExitCodeProcess(PI.hProcess, exitcode) and (exitcode = STILL_ACTIVE);
		41	end;
		42
		43	var
		44	SA: TSecurityAttributes;
		45	SI: TStartupInfo;
		46	PI: TProcessInformation;
		47	StdOutPipeRead, StdOutPipeWrite: THandle;
		48	StdInPipeRead, StdInPipeWrite: THandle;
		49	WasOK: Boolean;
		50	Buffer: array[0..255] of AnsiChar;
		51	BytesRead, BytesWritten: Cardinal;
		52	WorkDir: string;
		53	Handle: Boolean;
		54	testString: AnsiString;
		55	CommandLine: string;
		56	result: string;
		57	begin
		58	if Self.WorkDir = '' then
		59	WorkDir := ExtractFilePath(ParamStr(0))
		60	else
		61	WorkDir := Self.WorkDir;
		62
		63	if not FileExists(Self.PhpExe) then exit;
		64	if not FileExists(Self.PhpFile) then exit;
		65
		66	CommandLine := '"'+Self.PhpExe+'" "'+Self.PhpFile+'"';
		67
		68	Result := '';
		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('cmd.exe /C "' + CommandLine + '"'),
		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	// Attention: This call will block if the process exited
		104	WriteFile(StdInPipeWrite, FInputWaiting[1], Length(FInputWaiting), BytesWritten, nil);
		105	end;
		106	{$ENDREGION}
		107
		108	{$REGION 'Terminate input sequence'}
		109	testString := #13#10#1#2#3#4#5#6#7#8#13#10;
		110	WriteFile(StdInPipeWrite, testString[1], Length(testString), BytesWritten, nil);
		111	{$ENDREGION}
		112
		113	{$REGION 'Gather output'}
		114	result := '';
		115	repeat
		116	WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
		117	if BytesRead > 0 then
		118	begin
		119	Buffer[BytesRead] := #0;
		120	Result := Result + Buffer;
		121	if Pos(#1#2#3#4#5#6#7#8, result) >= 1 then
		122	begin
		123	result := StringReplace(result, #1#2#3#4#5#6#7#8, '', []);
		124	break;
		125	end;
		126	end;
		127	until not WasOK or (BytesRead = 0) or Self.Terminated or not ProcessRunning(PI);
		128	{$ENDREGION}
		129
		130	{$REGION 'Notify main thread about output'}
		131	if Assigned(FOutputNotifyCallback) and not Self.Terminated and ProcessRunning(PI) then
		132	begin
36	daniel-mar	133	FOutputWaiting := IntToHex(CalculateCRC32String(result), 8) + result;
27	daniel-mar	134	Synchronize(CallOutputNotifyCallback);
		135	end;
		136	{$ENDREGION}
		137	end;
		138
		139	CloseHandle(StdInPipeWrite);
		140	TerminateProcess(pi.hProcess, 0); // TODO: for some reason, after closing the editor, php.exe keeps running in the task list
		141	WaitForSingleObject(PI.hProcess, INFINITE);
		142	finally
		143	CloseHandle(PI.hThread);
		144	CloseHandle(PI.hProcess);
		145	end;
		146	finally
		147	CloseHandle(StdOutPipeRead);
		148	CloseHandle(StdInPipeRead);
		149	end;
		150	end;
		151
		152	procedure TRunCodeExplorer.CallInputRequestCallback;
		153	begin
		154	FInputWaiting := FInputRequestCallback;
		155	end;
		156
		157	procedure TRunCodeExplorer.CallOutputNotifyCallback;
		158	begin
		159	FOutputNotifyCallback(FOutputWaiting);
		160	end;
		161
		162	end.

Subversion Repositories fastphp

fastphp/trunk/RunPHP.pas – Rev 36