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
		31	procedure TRunCodeExplorer.Execute;
		32
		33	function ProcessRunning(PI: TProcessInformation): boolean; inline;
		34	var
		35	exitcode: Cardinal;
		36	begin
		37	result := GetExitCodeProcess(PI.hProcess, exitcode) and (exitcode = STILL_ACTIVE);
		38	end;
		39
		40	var
		41	SA: TSecurityAttributes;
		42	SI: TStartupInfo;
		43	PI: TProcessInformation;
		44	StdOutPipeRead, StdOutPipeWrite: THandle;
		45	StdInPipeRead, StdInPipeWrite: THandle;
		46	WasOK: Boolean;
		47	Buffer: array[0..255] of AnsiChar;
		48	BytesRead, BytesWritten: Cardinal;
		49	WorkDir: string;
		50	Handle: Boolean;
		51	testString: AnsiString;
		52	CommandLine: string;
		53	result: string;
		54	begin
		55	if Self.WorkDir = '' then
		56	WorkDir := ExtractFilePath(ParamStr(0))
		57	else
		58	WorkDir := Self.WorkDir;
		59
		60	if not FileExists(Self.PhpExe) then exit;
		61	if not FileExists(Self.PhpFile) then exit;
		62
		63	CommandLine := '"'+Self.PhpExe+'" "'+Self.PhpFile+'"';
		64
		65	Result := '';
		66	with SA do begin
		67	nLength := SizeOf(SA);
		68	bInheritHandle := True;
		69	lpSecurityDescriptor := nil;
		70	end;
		71	CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
		72	CreatePipe(StdInPipeRead, StdInPipeWrite, @SA, 0);
		73	try
		74	with SI do
		75	begin
		76	FillChar(SI, SizeOf(SI), 0);
		77	cb := SizeOf(SI);
		78	dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
		79	wShowWindow := SW_HIDE;
		80	hStdInput := StdInPipeRead;
		81	hStdOutput := StdOutPipeWrite;
		82	hStdError := StdOutPipeWrite;
		83	end;
		84
		85	Handle := CreateProcess(nil, PChar('cmd.exe /C "' + CommandLine + '"'),
		86	nil, nil, True, 0, nil, PChar(WorkDir), SI, PI);
		87	CloseHandle(StdOutPipeWrite);
		88
		89	sleep(100);
		90
		91	if Handle then
		92	try
		93	while not Self.Terminated and ProcessRunning(PI) do
		94	begin
		95	{$REGION 'Get input from mainthread'}
		96	if Assigned(FInputRequestCallback) then
		97	begin
		98	Synchronize(CallInputRequestCallback);
		99
		100	// Attention: This call will block if the process exited
		101	WriteFile(StdInPipeWrite, FInputWaiting[1], Length(FInputWaiting), BytesWritten, nil);
		102	end;
		103	{$ENDREGION}
		104
		105	{$REGION 'Terminate input sequence'}
		106	testString := #13#10#1#2#3#4#5#6#7#8#13#10;
		107	WriteFile(StdInPipeWrite, testString[1], Length(testString), BytesWritten, nil);
		108	{$ENDREGION}
		109
		110	{$REGION 'Gather output'}
		111	result := '';
		112	repeat
		113	WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
		114	if BytesRead > 0 then
		115	begin
		116	Buffer[BytesRead] := #0;
		117	Result := Result + Buffer;
		118	if Pos(#1#2#3#4#5#6#7#8, result) >= 1 then
		119	begin
		120	result := StringReplace(result, #1#2#3#4#5#6#7#8, '', []);
		121	break;
		122	end;
		123	end;
		124	until not WasOK or (BytesRead = 0) or Self.Terminated or not ProcessRunning(PI);
		125	{$ENDREGION}
		126
		127	{$REGION 'Notify main thread about output'}
		128	if Assigned(FOutputNotifyCallback) and not Self.Terminated and ProcessRunning(PI) then
		129	begin
		130	FOutputWaiting := result;
		131	Synchronize(CallOutputNotifyCallback);
		132	end;
		133	{$ENDREGION}
		134	end;
		135
		136	CloseHandle(StdInPipeWrite);
		137	TerminateProcess(pi.hProcess, 0); // TODO: for some reason, after closing the editor, php.exe keeps running in the task list
		138	WaitForSingleObject(PI.hProcess, INFINITE);
		139	finally
		140	CloseHandle(PI.hThread);
		141	CloseHandle(PI.hProcess);
		142	end;
		143	finally
		144	CloseHandle(StdOutPipeRead);
		145	CloseHandle(StdInPipeRead);
		146	end;
		147	end;
		148
		149	procedure TRunCodeExplorer.CallInputRequestCallback;
		150	begin
		151	FInputWaiting := FInputRequestCallback;
		152	end;
		153
		154	procedure TRunCodeExplorer.CallOutputNotifyCallback;
		155	begin
		156	FOutputNotifyCallback(FOutputWaiting);
		157	end;
		158
		159	end.

Subversion Repositories fastphp

fastphp/trunk/RunPHP.pas @ 91 – Rev 31