Subversion Repositories fastphp

Rev

Rev 9 | 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.  
  9. type
  10.   TForm2 = class(TForm)
  11.     WebBrowser1: TWebBrowser;
  12.     Timer1: TTimer;
  13.     procedure Timer1Timer(Sender: TObject);
  14.     procedure WebBrowser1BeforeNavigate2(ASender: TObject;
  15.       const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
  16.       Headers: OleVariant; var Cancel: WordBool);
  17.   end;
  18.  
  19. var
  20.   Form2: TForm2;
  21.  
  22. implementation
  23.  
  24. {$R *.dfm}
  25.  
  26. uses
  27.   WebBrowserUtils, FastPHPUtils, Functions;
  28.  
  29. // TODO: Add a lot of nice stuff to let the PHP script communicate with this host application
  30. //       For example, allow window resizing etc.  (See Microsoft HTA for inspiration)
  31. // TODO: Ajax gives Access Denied error... Create own security manager?
  32. // TODO: History doesn't work?
  33. // TODO: Pass HTTP parameters to php executable
  34. // (All these ToDos: Also fix in the Editor)
  35.  
  36. procedure TForm2.Timer1Timer(Sender: TObject);
  37. var
  38.   phpScript: string;
  39. begin
  40.   Timer1.Enabled := false;
  41.   phpScript := ParamStr(1);
  42.  
  43.   WebBrowser1.LoadHTML('<h1>FastPHP</h1>Running script... please wait...');
  44.  
  45.   // TODO: nice HTML error/intro pages (as resource?)
  46.   if phpScript = '' then
  47.   begin
  48.     WebBrowser1.LoadHTML('<h1>FastPHP</h1>Please enter a PHP file to execute.');
  49.     Abort;
  50.   end;
  51.  
  52.   if not FileExists(phpScript) then
  53.   begin
  54.     WebBrowser1.LoadHTML(Format('<h1>FastPHP</h1>File %s does not exist.', [phpScript]));
  55.     Abort;
  56.   end;
  57.  
  58.   WebBrowser1.LoadHTML(RunPHPScript(phpScript), phpScript);
  59. end;
  60.  
  61. procedure TForm2.WebBrowser1BeforeNavigate2(ASender: TObject;
  62.   const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
  63.   Headers: OleVariant; var Cancel: WordBool);
  64. var
  65.   s, myURL: string;
  66.   lineno: integer;
  67.   p: integer;
  68. begin
  69.   {$REGION 'Line number references (PHP errors and warnings)'}
  70.   if Copy(URL, 1, length(FASTPHP_GOTO_URI_PREFIX)) = FASTPHP_GOTO_URI_PREFIX then
  71.   begin
  72.     ShowMessage('This action only works in FastPHP editor.');
  73.     Cancel := true;
  74.     Exit;
  75.   end;
  76.   {$ENDREGION}
  77.  
  78.   {$REGION 'Intelligent browser (executes PHP scripts)'}
  79.   if URL <> 'about:blank' then
  80.   begin
  81.     myUrl := URL;
  82.  
  83.     p := Pos('?', myUrl);
  84.     if p >= 1 then myURL := copy(myURL, 1, p-1);
  85.  
  86.     // TODO: myURL urldecode
  87.     // TODO: maybe we could even open that file in the editor!
  88.  
  89.     if FileExists(myURL) and (EndsText('.php', myURL) or EndsText('.php3', myURL) or EndsText('.php4', myURL) or EndsText('.php5', myURL) or EndsText('.phps', myURL)) then
  90.     begin
  91.       WebBrowser1.LoadHTML(GetDosOutput('"'+GetPHPExe+'" "'+myURL+'"', ExtractFileDir(Application.ExeName)), myUrl);
  92.       Cancel := true;
  93.     end;
  94.   end;
  95.   {$ENDREGION}
  96. end;
  97.  
  98. end.
  99.