WebSVN – fastphp – Diff – /trunk/BrowserMain.pas


unit BrowserMain;
 
{$Include 'FastPHP.inc'}
 
interface
 
uses
  // TODO: "{$IFDEF USE_SHDOCVW_TLB}_TLB{$ENDIF}" does not work with Delphi 10.2
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, OleCtrls, SHDocVw_TLB, ExtCtrls, StrUtils,
  StdCtrls, activex, UrlMon;
 
type
  TForm2 = class(TForm)
    WebBrowser1: TWebBrowser;
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure WebBrowser1BeforeNavigate2(ASender: TObject;
      const pDisp: IDispatch; {$IFDEF USE_SHDOCVW_TLB}const{$ELSE}var{$ENDIF} URL, Flags, TargetFrameName, PostData,
      Headers: OleVariant; var Cancel: WordBool);
  strict private
    function EmbeddedWBQueryService(const rsid, iid: TGUID; out Obj{: IInterface}): HRESULT;
  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, z.B. um DLL-Funktionen aufzurufen! (auch in JavaScript ansteuerbar?)
// TODO: let the website decide if the window is maximized etc, as well as it's caption, size and icon
// TODO: Pass parameters (argv) to PHP
 
type
  TEmbeddedSecurityManager = class(TInterfacedObject, IInternetSecurityManager)
  public
    function GetSecuritySite(out ppSite: IInternetSecurityMgrSite): HResult; stdcall;
    function MapUrlToZone(pwszUrl: LPCWSTR; out dwZone: DWORD; dwFlags: DWORD): HResult; stdcall;
    function GetSecurityId(pwszUrl: LPCWSTR; pbSecurityId: Pointer; var cbSecurityId: DWORD; dwReserved: DWORD): HResult; stdcall;
    function ProcessUrlAction(pwszUrl: LPCWSTR; dwAction: DWORD; pPolicy: Pointer; cbPolicy: DWORD; pContext: Pointer; cbContext: DWORD; dwFlags, dwReserved: DWORD): HResult; stdcall;
    function QueryCustomPolicy(pwszUrl: LPCWSTR; const guidKey: TGUID; out pPolicy: Pointer; out cbPolicy: DWORD; pContext: Pointer; cbContext: DWORD; dwReserved: DWORD): HResult; stdcall;
    function SetZoneMapping(dwZone: DWORD; lpszPattern: PWideChar; dwFlags: DWORD): HResult; stdcall;
    function GetZoneMappings(dwZone: DWORD;out ppenumString: IEnumString; dwFlags: DWORD): HResult; stdcall;
    function SetSecuritySite(pSite: IInternetSecurityMgrSite): HResult; stdcall;
  end;
 
function TEmbeddedSecurityManager.SetSecuritySite(pSite: IInternetSecurityMgrSite): HResult; stdcall;
begin
  Result := INET_E_DEFAULT_ACTION;
end;
function TEmbeddedSecurityManager.GetSecuritySite(
  out ppSite: IInternetSecurityMgrSite): HResult; stdcall;
begin
  Result := INET_E_DEFAULT_ACTION;
end;
function TEmbeddedSecurityManager.GetSecurityId(pwszUrl: LPCWSTR; pbSecurityId: Pointer;
  var cbSecurityId: DWORD; dwReserved: DWORD): HResult; stdcall;
begin
  Result := INET_E_DEFAULT_ACTION;
end;
function TEmbeddedSecurityManager.ProcessUrlAction(pwszUrl: LPCWSTR; dwAction: DWORD;
  pPolicy: Pointer; cbPolicy: DWORD; pContext: Pointer; cbContext: DWORD;
  dwFlags, dwReserved: DWORD): HResult; stdcall;
begin
  // Result := INET_E_DEFAULT_ACTION;
 
  // TODO: Doesn't work... Cross-Domain is still not allowed.
  PDWORD(pPolicy)^ := URLPOLICY_ALLOW;
  Result := S_OK;
end;
function TEmbeddedSecurityManager.QueryCustomPolicy(pwszUrl: LPCWSTR; const guidKey: TGUID;
  out pPolicy: Pointer; out cbPolicy: DWORD; pContext: Pointer; cbContext: DWORD;
  dwReserved: DWORD): HResult; stdcall;
begin
  // Result := INET_E_DEFAULT_ACTION;
 
  // TODO: Doesn't work... Cross-Domain is still not allowed.
  PDWORD(pPolicy)^ := URLPOLICY_ALLOW;
  Result := S_OK;
end;
function TEmbeddedSecurityManager.SetZoneMapping(dwZone: DWORD; lpszPattern: PWideChar;
  dwFlags: DWORD): HResult; stdcall;
begin
  Result := INET_E_DEFAULT_ACTION;
end;
function TEmbeddedSecurityManager.GetZoneMappings(dwZone: DWORD;out ppenumString: IEnumString;
  dwFlags: DWORD): HResult; stdcall;
begin
  Result := INET_E_DEFAULT_ACTION;
end;
function TEmbeddedSecurityManager.MapUrlToZone(pwszUrl: LPCWSTR; out dwZone: DWORD; dwFlags: DWORD): HResult;
begin
  dwZone := URLZONE_TRUSTED;
  Result := S_OK;
end;
 
function TForm2.EmbeddedWBQueryService(const rsid, iid: TGUID; out Obj{: IInterface}): HRESULT;
var
    sam: IInternetSecurityManager;
begin
    Result := E_NOINTERFACE;
 
    //rsid ==> Service Identifier
    //iid ==> Interface identifier
    if IsEqualGUID(rsid, IInternetSecurityManager) and IsEqualGUID(iid, IInternetSecurityManager) then
    begin
        sam := TEmbeddedSecurityManager.Create;
        IInterface(Obj) := sam;
        Result := S_OK;
    end;
end;
 
procedure TForm2.Timer1Timer(Sender: TObject);
var
  phpScript: string;
begin
  Timer1.Enabled := false;
  phpScript := ParamStr(1);
 
  // Remove Security
  WebBrowser1.ServiceQuery := EmbeddedWBQueryService;
 
  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; {$IFDEF USE_SHDOCVW_TLB}const{$ELSE}var{$ENDIF} URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
var
  myURL, myUrl2, 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, 'http://wa.viathinksoft.de', '', []);
 
    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]);
 
    // *.xphp is ViaThinkSoft's extension associated to FastPHPBrowser
    // This allows the "executable PHP scripts" to be executed via double click.--
    if FileExists(myURL) and (EndsText('.xphp', myURL) or 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);
 
        myUrl2 := myUrl;
        myUrl2 := StringReplace(myUrl2, '\', '/', [rfReplaceAll]);
        // TODO: real myURL urlencode
        myUrl2 := StringReplace(myUrl2, '%', '%%', []);
        //myUrl2 := StringReplace(myUrl2, ' ', '%20', []);
        myUrl2 := StringReplace(myUrl2, ' ', '+', []);
        myUrl2 := 'http://wa.viathinksoft.de/' + myUrl2;
 
        // showmessage(myUrl2);
        WebBrowser1.LoadHTML(GetDosOutput('"'+GetPHPExe+'" -f "'+myURL+'" -- "'+ArgGet+'" "'+ArgPost+'" "'+ArgHeader+'"', ExtractFileDir(Application.ExeName)), myUrl2);
      end;
      Cancel := true;
    end;
  end;
  {$ENDREGION}
end;
 
end.
 

Subversion Repositories fastphp

fastphp/trunk/BrowserMain.pas – Rev 27 → 42

Rev 27		Rev 42
1	unit BrowserMain;	1	unit BrowserMain;
2		2
3	{$Include 'FastPHP.inc'}	3	{$Include 'FastPHP.inc'}
4		4
5	interface	5	interface
6		6
7	uses	7	uses
8	// TODO: "{$IFDEF USE_SHDOCVW_TLB}_TLB{$ENDIF}" does not work with Delphi 10.2	8	// TODO: "{$IFDEF USE_SHDOCVW_TLB}_TLB{$ENDIF}" does not work with Delphi 10.2
9	Windows, Messages, SysUtils, Variants, Classes, Graphics,	9	Windows, Messages, SysUtils, Variants, Classes, Graphics,
10	Controls, Forms, Dialogs, OleCtrls, SHDocVw_TLB, ExtCtrls, StrUtils,	10	Controls, Forms, Dialogs, OleCtrls, SHDocVw_TLB, ExtCtrls, StrUtils,
11	StdCtrls, activex, UrlMon;	11	StdCtrls, activex, UrlMon;
12		12
13	type	13	type
14	TForm2 = class(TForm)	14	TForm2 = class(TForm)
15	WebBrowser1: TWebBrowser;	15	WebBrowser1: TWebBrowser;
16	Timer1: TTimer;	16	Timer1: TTimer;
17	procedure Timer1Timer(Sender: TObject);	17	procedure Timer1Timer(Sender: TObject);
18	procedure WebBrowser1BeforeNavigate2(ASender: TObject;	18	procedure WebBrowser1BeforeNavigate2(ASender: TObject;
19	const pDisp: IDispatch; {$IFDEF USE_SHDOCVW_TLB}const{$ELSE}var{$ENDIF} URL, Flags, TargetFrameName, PostData,	19	const pDisp: IDispatch; {$IFDEF USE_SHDOCVW_TLB}const{$ELSE}var{$ENDIF} URL, Flags, TargetFrameName, PostData,
20	Headers: OleVariant; var Cancel: WordBool);	20	Headers: OleVariant; var Cancel: WordBool);
21	strict private	21	strict private
22	function EmbeddedWBQueryService(const rsid, iid: TGUID; out Obj{: IInterface}): HRESULT;	22	function EmbeddedWBQueryService(const rsid, iid: TGUID; out Obj{: IInterface}): HRESULT;
23	end;	23	end;
24		24
25	var	25	var
26	Form2: TForm2;	26	Form2: TForm2;
27		27
28	implementation	28	implementation
29		29
30	{$R *.dfm}	30	{$R *.dfm}
31		31
32	uses	32	uses
33	WebBrowserUtils, FastPHPUtils, Functions, ShellAPI;	33	WebBrowserUtils, FastPHPUtils, Functions, ShellAPI;
34		34
35	// TODO: Add a lot of nice stuff to let the PHP script communicate with this host application	35	// TODO: Add a lot of nice stuff to let the PHP script communicate with this host application
36	// For example, allow window resizing etc. (See Microsoft HTA for inspiration)	36	// For example, allow window resizing etc. (See Microsoft HTA for inspiration)
37	// TODO: Ajax gives Access Denied error... Create own security manager?	37	// TODO: Ajax gives Access Denied error... Create own security manager?
38	// TODO: History doesn't work?	38	// TODO: History doesn't work?
39	// (All these ToDos: Also fix in the Editor)	39	// (All these ToDos: Also fix in the Editor)
40	// TODO: kann man eventuell auch php dateien aus einer DLL rausziehen? das wäre TOLL!!!!	40	// TODO: kann man eventuell auch php dateien aus einer DLL rausziehen? das wäre TOLL!!!!
41	// TODO: headers... cookies...	41	// TODO: headers... cookies...
42	// TODO: WebBrowser1BeforeNavigate2 mit einem DLL-callback, sodass entwickler ihre eigenen fastphp:// links machen können, z.B. um DLL-Funktionen aufzurufen! (auch in JavaScript ansteuerbar?)	42	// TODO: WebBrowser1BeforeNavigate2 mit einem DLL-callback, sodass entwickler ihre eigenen fastphp:// links machen können, z.B. um DLL-Funktionen aufzurufen! (auch in JavaScript ansteuerbar?)
43	// TODO: let the website decide if the window is maximized etc, as well as it's caption, size and icon	43	// TODO: let the website decide if the window is maximized etc, as well as it's caption, size and icon
44	// TODO: Pass parameters (argv) to PHP	44	// TODO: Pass parameters (argv) to PHP
45		45
46	type	46	type
47	TEmbeddedSecurityManager = class(TInterfacedObject, IInternetSecurityManager)	47	TEmbeddedSecurityManager = class(TInterfacedObject, IInternetSecurityManager)
48	public	48	public
49	function GetSecuritySite(out ppSite: IInternetSecurityMgrSite): HResult; stdcall;	49	function GetSecuritySite(out ppSite: IInternetSecurityMgrSite): HResult; stdcall;
50	function MapUrlToZone(pwszUrl: LPCWSTR; out dwZone: DWORD; dwFlags: DWORD): HResult; stdcall;	50	function MapUrlToZone(pwszUrl: LPCWSTR; out dwZone: DWORD; dwFlags: DWORD): HResult; stdcall;
51	function GetSecurityId(pwszUrl: LPCWSTR; pbSecurityId: Pointer; var cbSecurityId: DWORD; dwReserved: DWORD): HResult; stdcall;	51	function GetSecurityId(pwszUrl: LPCWSTR; pbSecurityId: Pointer; var cbSecurityId: DWORD; dwReserved: DWORD): HResult; stdcall;
52	function ProcessUrlAction(pwszUrl: LPCWSTR; dwAction: DWORD; pPolicy: Pointer; cbPolicy: DWORD; pContext: Pointer; cbContext: DWORD; dwFlags, dwReserved: DWORD): HResult; stdcall;	52	function ProcessUrlAction(pwszUrl: LPCWSTR; dwAction: DWORD; pPolicy: Pointer; cbPolicy: DWORD; pContext: Pointer; cbContext: DWORD; dwFlags, dwReserved: DWORD): HResult; stdcall;
53	function QueryCustomPolicy(pwszUrl: LPCWSTR; const guidKey: TGUID; out pPolicy: Pointer; out cbPolicy: DWORD; pContext: Pointer; cbContext: DWORD; dwReserved: DWORD): HResult; stdcall;	53	function QueryCustomPolicy(pwszUrl: LPCWSTR; const guidKey: TGUID; out pPolicy: Pointer; out cbPolicy: DWORD; pContext: Pointer; cbContext: DWORD; dwReserved: DWORD): HResult; stdcall;
54	function SetZoneMapping(dwZone: DWORD; lpszPattern: PWideChar; dwFlags: DWORD): HResult; stdcall;	54	function SetZoneMapping(dwZone: DWORD; lpszPattern: PWideChar; dwFlags: DWORD): HResult; stdcall;
55	function GetZoneMappings(dwZone: DWORD;out ppenumString: IEnumString; dwFlags: DWORD): HResult; stdcall;	55	function GetZoneMappings(dwZone: DWORD;out ppenumString: IEnumString; dwFlags: DWORD): HResult; stdcall;
56	function SetSecuritySite(pSite: IInternetSecurityMgrSite): HResult; stdcall;	56	function SetSecuritySite(pSite: IInternetSecurityMgrSite): HResult; stdcall;
57	end;	57	end;
58		58
59	function TEmbeddedSecurityManager.SetSecuritySite(pSite: IInternetSecurityMgrSite): HResult; stdcall;	59	function TEmbeddedSecurityManager.SetSecuritySite(pSite: IInternetSecurityMgrSite): HResult; stdcall;
60	begin	60	begin
61	Result := INET_E_DEFAULT_ACTION;	61	Result := INET_E_DEFAULT_ACTION;
62	end;	62	end;
63	function TEmbeddedSecurityManager.GetSecuritySite(	63	function TEmbeddedSecurityManager.GetSecuritySite(
64	out ppSite: IInternetSecurityMgrSite): HResult; stdcall;	64	out ppSite: IInternetSecurityMgrSite): HResult; stdcall;
65	begin	65	begin
66	Result := INET_E_DEFAULT_ACTION;	66	Result := INET_E_DEFAULT_ACTION;
67	end;	67	end;
68	function TEmbeddedSecurityManager.GetSecurityId(pwszUrl: LPCWSTR; pbSecurityId: Pointer;	68	function TEmbeddedSecurityManager.GetSecurityId(pwszUrl: LPCWSTR; pbSecurityId: Pointer;
69	var cbSecurityId: DWORD; dwReserved: DWORD): HResult; stdcall;	69	var cbSecurityId: DWORD; dwReserved: DWORD): HResult; stdcall;
70	begin	70	begin
71	Result := INET_E_DEFAULT_ACTION;	71	Result := INET_E_DEFAULT_ACTION;
72	end;	72	end;
73	function TEmbeddedSecurityManager.ProcessUrlAction(pwszUrl: LPCWSTR; dwAction: DWORD;	73	function TEmbeddedSecurityManager.ProcessUrlAction(pwszUrl: LPCWSTR; dwAction: DWORD;
74	pPolicy: Pointer; cbPolicy: DWORD; pContext: Pointer; cbContext: DWORD;	74	pPolicy: Pointer; cbPolicy: DWORD; pContext: Pointer; cbContext: DWORD;
75	dwFlags, dwReserved: DWORD): HResult; stdcall;	75	dwFlags, dwReserved: DWORD): HResult; stdcall;
76	begin	76	begin
77	// Result := INET_E_DEFAULT_ACTION;	77	// Result := INET_E_DEFAULT_ACTION;
78		78
79	// TODO: Doesn't work... Cross-Domain is still not allowed.	79	// TODO: Doesn't work... Cross-Domain is still not allowed.
80	PDWORD(pPolicy)^ := URLPOLICY_ALLOW;	80	PDWORD(pPolicy)^ := URLPOLICY_ALLOW;
81	Result := S_OK;	81	Result := S_OK;
82	end;	82	end;
83	function TEmbeddedSecurityManager.QueryCustomPolicy(pwszUrl: LPCWSTR; const guidKey: TGUID;	83	function TEmbeddedSecurityManager.QueryCustomPolicy(pwszUrl: LPCWSTR; const guidKey: TGUID;
84	out pPolicy: Pointer; out cbPolicy: DWORD; pContext: Pointer; cbContext: DWORD;	84	out pPolicy: Pointer; out cbPolicy: DWORD; pContext: Pointer; cbContext: DWORD;
85	dwReserved: DWORD): HResult; stdcall;	85	dwReserved: DWORD): HResult; stdcall;
86	begin	86	begin
87	// Result := INET_E_DEFAULT_ACTION;	87	// Result := INET_E_DEFAULT_ACTION;
88		88
89	// TODO: Doesn't work... Cross-Domain is still not allowed.	89	// TODO: Doesn't work... Cross-Domain is still not allowed.
90	PDWORD(pPolicy)^ := URLPOLICY_ALLOW;	90	PDWORD(pPolicy)^ := URLPOLICY_ALLOW;
91	Result := S_OK;	91	Result := S_OK;
92	end;	92	end;
93	function TEmbeddedSecurityManager.SetZoneMapping(dwZone: DWORD; lpszPattern: PWideChar;	93	function TEmbeddedSecurityManager.SetZoneMapping(dwZone: DWORD; lpszPattern: PWideChar;
94	dwFlags: DWORD): HResult; stdcall;	94	dwFlags: DWORD): HResult; stdcall;
95	begin	95	begin
96	Result := INET_E_DEFAULT_ACTION;	96	Result := INET_E_DEFAULT_ACTION;
97	end;	97	end;
98	function TEmbeddedSecurityManager.GetZoneMappings(dwZone: DWORD;out ppenumString: IEnumString;	98	function TEmbeddedSecurityManager.GetZoneMappings(dwZone: DWORD;out ppenumString: IEnumString;
99	dwFlags: DWORD): HResult; stdcall;	99	dwFlags: DWORD): HResult; stdcall;
100	begin	100	begin
101	Result := INET_E_DEFAULT_ACTION;	101	Result := INET_E_DEFAULT_ACTION;
102	end;	102	end;
103	function TEmbeddedSecurityManager.MapUrlToZone(pwszUrl: LPCWSTR; out dwZone: DWORD; dwFlags: DWORD): HResult;	103	function TEmbeddedSecurityManager.MapUrlToZone(pwszUrl: LPCWSTR; out dwZone: DWORD; dwFlags: DWORD): HResult;
104	begin	104	begin
105	dwZone := URLZONE_TRUSTED;	105	dwZone := URLZONE_TRUSTED;
106	Result := S_OK;	106	Result := S_OK;
107	end;	107	end;
108		108
109	function TForm2.EmbeddedWBQueryService(const rsid, iid: TGUID; out Obj{: IInterface}): HRESULT;	109	function TForm2.EmbeddedWBQueryService(const rsid, iid: TGUID; out Obj{: IInterface}): HRESULT;
110	var	110	var
111	sam: IInternetSecurityManager;	111	sam: IInternetSecurityManager;
112	begin	112	begin
113	Result := E_NOINTERFACE;	113	Result := E_NOINTERFACE;
114		114
115	//rsid ==> Service Identifier	115	//rsid ==> Service Identifier
116	//iid ==> Interface identifier	116	//iid ==> Interface identifier
117	if IsEqualGUID(rsid, IInternetSecurityManager) and IsEqualGUID(iid, IInternetSecurityManager) then	117	if IsEqualGUID(rsid, IInternetSecurityManager) and IsEqualGUID(iid, IInternetSecurityManager) then
118	begin	118	begin
119	sam := TEmbeddedSecurityManager.Create;	119	sam := TEmbeddedSecurityManager.Create;
120	IInterface(Obj) := sam;	120	IInterface(Obj) := sam;
121	Result := S_OK;	121	Result := S_OK;
122	end;	122	end;
123	end;	123	end;
124		124
125	procedure TForm2.Timer1Timer(Sender: TObject);	125	procedure TForm2.Timer1Timer(Sender: TObject);
126	var	126	var
127	phpScript: string;	127	phpScript: string;
128	begin	128	begin
129	Timer1.Enabled := false;	129	Timer1.Enabled := false;
130	phpScript := ParamStr(1);	130	phpScript := ParamStr(1);
131		131
132	// Remove Security	132	// Remove Security
133	WebBrowser1.ServiceQuery := EmbeddedWBQueryService;	133	WebBrowser1.ServiceQuery := EmbeddedWBQueryService;
134		134
135	WebBrowser1.LoadHTML('<h1>FastPHP</h1>Running script... please wait...');	135	WebBrowser1.LoadHTML('<h1>FastPHP</h1>Running script... please wait...');
136		136
137	// TODO: nice HTML error/intro pages (as resource?)	137	// TODO: nice HTML error/intro pages (as resource?)
138	if phpScript = '' then	138	if phpScript = '' then
139	begin	139	begin
140	WebBrowser1.LoadHTML('<h1>FastPHP</h1>Please enter a PHP file to execute.');	140	WebBrowser1.LoadHTML('<h1>FastPHP</h1>Please enter a PHP file to execute.');
141	Abort;	141	Abort;
142	end;	142	end;
143		143
144	if not FileExists(phpScript) then	144	if not FileExists(phpScript) then
145	begin	145	begin
146	WebBrowser1.LoadHTML(Format('<h1>FastPHP</h1>File %s does not exist.', [phpScript]));	146	WebBrowser1.LoadHTML(Format('<h1>FastPHP</h1>File %s does not exist.', [phpScript]));
147	Abort;	147	Abort;
148	end;	148	end;
149		149
150	WebBrowser1.LoadHTML(RunPHPScript(phpScript), phpScript);	150	WebBrowser1.LoadHTML(RunPHPScript(phpScript), phpScript);
151	end;	151	end;
152		152
153	procedure TForm2.WebBrowser1BeforeNavigate2(ASender: TObject;	153	procedure TForm2.WebBrowser1BeforeNavigate2(ASender: TObject;
154	const pDisp: IDispatch; {$IFDEF USE_SHDOCVW_TLB}const{$ELSE}var{$ENDIF} URL, Flags, TargetFrameName, PostData,	154	const pDisp: IDispatch; {$IFDEF USE_SHDOCVW_TLB}const{$ELSE}var{$ENDIF} URL, Flags, TargetFrameName, PostData,
155	Headers: OleVariant; var Cancel: WordBool);	155	Headers: OleVariant; var Cancel: WordBool);
156	var	156	var
157	myURL, myUrl2, getData: string;	157	myURL, myUrl2, getData: string;
158	p: integer;	158	p: integer;
159	background: boolean;	159	background: boolean;
160	ArgGet, ArgPost, ArgHeader: string;	160	ArgGet, ArgPost, ArgHeader: string;
161	begin	161	begin
162	background := Pos('background\|', URL) >= 1;	162	background := Pos('background\|', URL) >= 1;
163		163
164	{$REGION 'Line number references (PHP errors and warnings)'}	164	{$REGION 'Line number references (PHP errors and warnings)'}
165	if Copy(URL, 1, length(FASTPHP_GOTO_URI_PREFIX)) = FASTPHP_GOTO_URI_PREFIX then	165	if Copy(URL, 1, length(FASTPHP_GOTO_URI_PREFIX)) = FASTPHP_GOTO_URI_PREFIX then
166	begin	166	begin
167	// TODO: maybe we could even open that file in the editor!	167	// TODO: maybe we could even open that file in the editor!
168	ShowMessage('This action only works in FastPHP editor.');	168	ShowMessage('This action only works in FastPHP editor.');
169	Cancel := true;	169	Cancel := true;
170	Exit;	170	Exit;
171	end;	171	end;
172	{$ENDREGION}	172	{$ENDREGION}
173		173
174	{$REGION 'Intelligent browser (executes PHP scripts)'}	174	{$REGION 'Intelligent browser (executes PHP scripts)'}
175	if URL <> 'about:blank' then	175	if URL <> 'about:blank' then
176	begin	176	begin
177	myUrl := URL;	177	myUrl := URL;
178		178
179	myurl := StringReplace(myurl, 'background\|', '', []);	179	myurl := StringReplace(myurl, 'background\|', '', []);
180		180
181	p := Pos('?', myUrl);	181	p := Pos('?', myUrl);
182	if p >= 1 then	182	if p >= 1 then
183	begin	183	begin
184	getData := copy(myURL, p+1, Length(myURL)-p);	184	getData := copy(myURL, p+1, Length(myURL)-p);
185	myURL := copy(myURL, 1, p-1);	185	myURL := copy(myURL, 1, p-1);
186	end	186	end
187	else	187	else
188	begin	188	begin
189	getData := '';	189	getData := '';
190	end;	190	end;
191		191
192	myURL := StringReplace(myURL, 'http://wa.viathinksoft.de', '', []);	192	myURL := StringReplace(myURL, 'http://wa.viathinksoft.de', '', []);
193		193
194	myURL := StringReplace(myURL, 'file:///', '', []);	194	myURL := StringReplace(myURL, 'file:///', '', []);
195	myURL := StringReplace(myURL, '/', '\', [rfReplaceAll]);	195	myURL := StringReplace(myURL, '/', '\', [rfReplaceAll]);
196		196
197	// TODO: real myURL urldecode	197	// TODO: real myURL urldecode
198	myURL := StringReplace(myURL, '+', ' ', []);	198	myURL := StringReplace(myURL, '+', ' ', []);
199	myURL := StringReplace(myURL, '%20', ' ', []);	199	myURL := StringReplace(myURL, '%20', ' ', []);
200	myURL := StringReplace(myURL, '%%', '%', []);	200	myURL := StringReplace(myURL, '%%', '%', []);
201		201
202	ArgHeader := '';	202	ArgHeader := '';
203	ArgHeader := MyVarToStr(Headers);	203	ArgHeader := MyVarToStr(Headers);
204	ArgHeader := StringReplace(ArgHeader, #13, '\|CR\|', [rfReplaceAll]);	204	ArgHeader := StringReplace(ArgHeader, #13, '\|CR\|', [rfReplaceAll]);
205	ArgHeader := StringReplace(ArgHeader, #10, '\|LF\|', [rfReplaceAll]);	205	ArgHeader := StringReplace(ArgHeader, #10, '\|LF\|', [rfReplaceAll]);
206		206
207	// *.xphp is ViaThinkSoft's extension associated to FastPHPBrowser	207	// *.xphp is ViaThinkSoft's extension associated to FastPHPBrowser
208	// This allows the "executable PHP scripts" to be executed via double click.--	208	// This allows the "executable PHP scripts" to be executed via double click.--
209	if FileExists(myURL) and (EndsText('.xphp', myURL) or EndsText('.php', myURL) or EndsText('.php3', myURL) or EndsText('.php4', myURL) or EndsText('.php5', myURL) or EndsText('.phps', myURL)) then	209	if FileExists(myURL) and (EndsText('.xphp', myURL) or EndsText('.php', myURL) or EndsText('.php3', myURL) or EndsText('.php4', myURL) or EndsText('.php5', myURL) or EndsText('.phps', myURL)) then
210	begin	210	begin
211	if background then	211	if background then
212	begin	212	begin
213	// TODO: how to detach the process?	213	// TODO: how to detach the process?
214	ShellExecute(0, 'open', PChar(GetPHPExe), PChar('"'+myURL+'" "'+ArgGet+'" "'+ArgPost+'" "'+ArgHeader+'"'), PChar(ExtractFileDir(Application.ExeName)), SW_HIDE);	214	ShellExecute(0, 'open', PChar(GetPHPExe), PChar('"'+myURL+'" "'+ArgGet+'" "'+ArgPost+'" "'+ArgHeader+'"'), PChar(ExtractFileDir(Application.ExeName)), SW_HIDE);
215	end	215	end
216	else	216	else
217	begin	217	begin
218	// TODO: somehow prepend fastphp_server.inc.php (populates the $_GET and $_POST arrays)	218	// TODO: somehow prepend fastphp_server.inc.php (populates the $_GET and $_POST arrays)
219	// TODO: is there a maximal length for the command line?	219	// TODO: is there a maximal length for the command line?
220	ArgGet := MyVarToStr(getData);	220	ArgGet := MyVarToStr(getData);
221	ArgPost := MyVarToStr(PostData);	221	ArgPost := MyVarToStr(PostData);
222		222
223	myUrl2 := myUrl;	223	myUrl2 := myUrl;
224	myUrl2 := StringReplace(myUrl2, '\', '/', [rfReplaceAll]);	224	myUrl2 := StringReplace(myUrl2, '\', '/', [rfReplaceAll]);
225	// TODO: real myURL urlencode	225	// TODO: real myURL urlencode
226	myUrl2 := StringReplace(myUrl2, '%', '%%', []);	226	myUrl2 := StringReplace(myUrl2, '%', '%%', []);
227	//myUrl2 := StringReplace(myUrl2, ' ', '%20', []);	227	//myUrl2 := StringReplace(myUrl2, ' ', '%20', []);
228	myUrl2 := StringReplace(myUrl2, ' ', '+', []);	228	myUrl2 := StringReplace(myUrl2, ' ', '+', []);
229	myUrl2 := 'http://wa.viathinksoft.de/' + myUrl2;	229	myUrl2 := 'http://wa.viathinksoft.de/' + myUrl2;
230		230
231	showmessage(myUrl2);	231	// showmessage(myUrl2);
232	WebBrowser1.LoadHTML(GetDosOutput('"'+GetPHPExe+'" "'+myURL+'" "'+ArgGet+'" "'+ArgPost+'" "'+ArgHeader+'"', ExtractFileDir(Application.ExeName)), myUrl2);	232	WebBrowser1.LoadHTML(GetDosOutput('"'+GetPHPExe+'" -f "'+myURL+'" -- "'+ArgGet+'" "'+ArgPost+'" "'+ArgHeader+'"', ExtractFileDir(Application.ExeName)), myUrl2);
233	end;	233	end;
234	Cancel := true;	234	Cancel := true;
235	end;	235	end;
236	end;	236	end;
237	{$ENDREGION}	237	{$ENDREGION}
238	end;	238	end;
239		239
240	end.	240	end.
241		241