unit BrowserMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.OleCtrls, SHDocVw_TLB, Vcl.ExtCtrls, StrUtils,
Vcl.StdCtrls, activex, UrlMon;
type
TForm2 = class(TForm)
WebBrowser1: TWebBrowser;
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure WebBrowser1BeforeNavigate2(ASender: TObject;
const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
Headers: OleVariant; var Cancel: WordBool);
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
uses
WebBrowserUtils, FastPHPUtils, Functions, ShellAPI;
// TODO: Add a lot of nice stuff to let the PHP script communicate with this host application
// For example, allow window resizing etc. (See Microsoft HTA for inspiration)
// TODO: Ajax gives Access Denied error... Create own security manager?
// TODO: History doesn't work?
// (All these ToDos: Also fix in the Editor)
// TODO: kann man eventuell auch php dateien aus einer DLL rausziehen? das wäre TOLL!!!!
// TODO: headers... cookies...
// TODO: WebBrowser1BeforeNavigate2 mit einem DLL-callback, sodass entwickler ihre eigenen fastphp:// links machen können!
procedure TForm2.Timer1Timer(Sender: TObject);
var
phpScript: string;
begin
Timer1.Enabled := false;
phpScript := ParamStr(1);
WebBrowser1.LoadHTML('<h1>FastPHP</h1>Running script... please wait...');
// TODO: nice HTML error/intro pages (as resource?)
if phpScript = '' then
begin
WebBrowser1.LoadHTML('<h1>FastPHP</h1>Please enter a PHP file to execute.');
Abort;
end;
if not FileExists(phpScript) then
begin
WebBrowser1.LoadHTML(Format('<h1>FastPHP</h1>File %s does not exist.', [phpScript]));
Abort;
end;
WebBrowser1.LoadHTML(RunPHPScript(phpScript), phpScript);
end;
procedure TForm2.WebBrowser1BeforeNavigate2(ASender: TObject;
const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
Headers: OleVariant; var Cancel: WordBool);
var
myURL, getData: string;
p: integer;
background: boolean;
ArgGet, ArgPost, ArgHeader: string;
begin
background := Pos('background|', URL) >= 1;
{$REGION 'Line number references (PHP errors and warnings)'}
if Copy(URL, 1, length(FASTPHP_GOTO_URI_PREFIX)) = FASTPHP_GOTO_URI_PREFIX then
begin
// TODO: maybe we could even open that file in the editor!
ShowMessage('This action only works in FastPHP editor.');
Cancel := true;
Exit;
end;
{$ENDREGION}
{$REGION 'Intelligent browser (executes PHP scripts)'}
if URL <> 'about:blank' then
begin
myUrl := URL;
myurl := StringReplace(myurl, 'background|', '', []);
p := Pos('?', myUrl);
if p >= 1 then
begin
getData := copy(myURL, p+1, Length(myURL)-p);
myURL := copy(myURL, 1, p-1);
end
else
begin
getData := '';
end;
myURL := StringReplace(myURL, 'file:///', '', []);
myURL := StringReplace(myURL, '/', '\', [rfReplaceAll]);
// TODO: real myURL urldecode
myURL := StringReplace(myURL, '+', ' ', []);
myURL := StringReplace(myURL, '%20', ' ', []);
myURL := StringReplace(myURL, '%%', '%', []);
ArgHeader := '';
ArgHeader := MyVarToStr(Headers);
ArgHeader := StringReplace(ArgHeader, #13, '|CR|', [rfReplaceAll]);
ArgHeader := StringReplace(ArgHeader, #10, '|LF|', [rfReplaceAll]);
if FileExists(myURL) and (EndsText('.php', myURL) or EndsText('.php3', myURL) or EndsText('.php4', myURL) or EndsText('.php5', myURL) or EndsText('.phps', myURL)) then
begin
if background then
begin
// TODO: how to detach the process?
ShellExecute(0, 'open', PChar(GetPHPExe), PChar('"'+myURL+'" "'+ArgGet+'" "'+ArgPost+'" "'+ArgHeader+'"'), PChar(ExtractFileDir(Application.ExeName)), SW_HIDE);
end
else
begin
// TODO: somehow prepend fastphp_server.inc.php (populates the $_GET and $_POST arrays)
// TODO: is there a maximal length for the command line?
ArgGet := MyVarToStr(getData);
ArgPost := MyVarToStr(PostData);
WebBrowser1.LoadHTML(GetDosOutput('"'+GetPHPExe+'" "'+myURL+'" "'+ArgGet+'" "'+ArgPost+'" "'+ArgHeader+'"', ExtractFileDir(Application.ExeName)), myUrl);
end;
Cancel := true;
end;
end;
{$ENDREGION}
end;
end.