Subversion Repositories fastphp

Rev

Rev 8 | Rev 11 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. unit BrowserMain;
  2.  
  3. interface
  4.  
  5. uses
  6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.OleCtrls, SHDocVw_TLB, Vcl.ExtCtrls, StrUtils,
  8.   Vcl.StdCtrls, activex, UrlMon;
  9.  
  10. type
  11.   TForm2 = class(TForm)
  12.     WebBrowser1: TWebBrowser;
  13.     Timer1: TTimer;
  14.     procedure Timer1Timer(Sender: TObject);
  15.     procedure WebBrowser1BeforeNavigate2(ASender: TObject;
  16.       const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
  17.       Headers: OleVariant; var Cancel: WordBool);
  18.   end;
  19.  
  20. var
  21.   Form2: TForm2;
  22.  
  23. implementation
  24.  
  25. {$R *.dfm}
  26.  
  27. uses
  28.   WebBrowserUtils, FastPHPUtils, Functions, ShellAPI;
  29.  
  30. // TODO: Add a lot of nice stuff to let the PHP script communicate with this host application
  31. //       For example, allow window resizing etc.  (See Microsoft HTA for inspiration)
  32. // TODO: Ajax gives Access Denied error... Create own security manager?
  33. // TODO: History doesn't work?
  34. // (All these ToDos: Also fix in the Editor)
  35. // TODO: kann man eventuell auch php dateien aus einer DLL rausziehen? das wäre TOLL!!!!
  36. // TODO: headers... cookies...
  37. // TODO: WebBrowser1BeforeNavigate2 mit einem DLL-callback, sodass entwickler ihre eigenen fastphp:// links machen können!
  38.  
  39. procedure TForm2.Timer1Timer(Sender: TObject);
  40. var
  41.   phpScript: string;
  42. begin
  43.   Timer1.Enabled := false;
  44.   phpScript := ParamStr(1);
  45.  
  46.   WebBrowser1.LoadHTML('<h1>FastPHP</h1>Running script... please wait...');
  47.  
  48.   // TODO: nice HTML error/intro pages (as resource?)
  49.   if phpScript = '' then
  50.   begin
  51.     WebBrowser1.LoadHTML('<h1>FastPHP</h1>Please enter a PHP file to execute.');
  52.     Abort;
  53.   end;
  54.  
  55.   if not FileExists(phpScript) then
  56.   begin
  57.     WebBrowser1.LoadHTML(Format('<h1>FastPHP</h1>File %s does not exist.', [phpScript]));
  58.     Abort;
  59.   end;
  60.  
  61.   WebBrowser1.LoadHTML(RunPHPScript(phpScript), phpScript);
  62. end;
  63.  
  64. procedure TForm2.WebBrowser1BeforeNavigate2(ASender: TObject;
  65.   const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
  66.   Headers: OleVariant; var Cancel: WordBool);
  67. var
  68.   myURL, getData: string;
  69.   p: integer;
  70.   background: boolean;
  71.   ArgGet, ArgPost, ArgHeader: string;
  72. begin
  73.   background := Pos('background|', URL) >= 1;
  74.  
  75.   {$REGION 'Line number references (PHP errors and warnings)'}
  76.   if Copy(URL, 1, length(FASTPHP_GOTO_URI_PREFIX)) = FASTPHP_GOTO_URI_PREFIX then
  77.   begin
  78.     // TODO: maybe we could even open that file in the editor!
  79.     ShowMessage('This action only works in FastPHP editor.');
  80.     Cancel := true;
  81.     Exit;
  82.   end;
  83.   {$ENDREGION}
  84.  
  85.   {$REGION 'Intelligent browser (executes PHP scripts)'}
  86.   if URL <> 'about:blank' then
  87.   begin
  88.     myUrl := URL;
  89.  
  90.     myurl := StringReplace(myurl, 'background|', '', []);
  91.  
  92.     p := Pos('?', myUrl);
  93.     if p >= 1 then
  94.     begin
  95.       getData := copy(myURL, p+1, Length(myURL)-p);
  96.       myURL := copy(myURL, 1, p-1);
  97.     end
  98.     else
  99.     begin
  100.       getData := '';
  101.     end;
  102.  
  103.     myURL := StringReplace(myURL, 'file:///', '', []);
  104.     myURL := StringReplace(myURL, '/', '\', [rfReplaceAll]);
  105.  
  106.     // TODO: real myURL urldecode
  107.     myURL := StringReplace(myURL, '+', ' ', []);
  108.     myURL := StringReplace(myURL, '%20', ' ', []);
  109.     myURL := StringReplace(myURL, '%%', '%', []);
  110.  
  111.     ArgHeader := '';
  112.     ArgHeader := MyVarToStr(Headers);
  113.     ArgHeader := StringReplace(ArgHeader, #13, '|CR|', [rfReplaceAll]);
  114.     ArgHeader := StringReplace(ArgHeader, #10, '|LF|', [rfReplaceAll]);
  115.  
  116.     if FileExists(myURL) and (EndsText('.php', myURL) or EndsText('.php3', myURL) or EndsText('.php4', myURL) or EndsText('.php5', myURL) or EndsText('.phps', myURL)) then
  117.     begin
  118.       if background then
  119.       begin
  120.         // TODO: how to detach the process?
  121.         ShellExecute(0, 'open', PChar(GetPHPExe), PChar('"'+myURL+'" "'+ArgGet+'" "'+ArgPost+'" "'+ArgHeader+'"'), PChar(ExtractFileDir(Application.ExeName)), SW_HIDE);
  122.       end
  123.       else
  124.       begin
  125.         // TODO: somehow prepend fastphp_server.inc.php (populates the $_GET and $_POST arrays)
  126.         // TODO: is there a maximal length for the command line?
  127.         ArgGet := MyVarToStr(getData);
  128.         ArgPost := MyVarToStr(PostData);
  129.         WebBrowser1.LoadHTML(GetDosOutput('"'+GetPHPExe+'" "'+myURL+'" "'+ArgGet+'" "'+ArgPost+'" "'+ArgHeader+'"', ExtractFileDir(Application.ExeName)), myUrl);
  130.       end;
  131.       Cancel := true;
  132.     end;
  133.   end;
  134.   {$ENDREGION}
  135. end;
  136.  
  137. end.
  138.