Subversion Repositories fastphp

Compare Revisions

Regard whitespace Rev 60 → Rev 61

/trunk/BrowserMain.pas
128,6 → 128,7
procedure TForm2.Timer1Timer(Sender: TObject);
var
phpScript: string;
sl: TStringList;
begin
Timer1.Enabled := false;
phpScript := ParamStr(1);
151,7 → 152,22
end;
 
WebBrowser1.LoadHTML(RunPHPScript(phpScript), phpScript);
 
Application.ProcessMessages; // This is important, otherwise the metatags can't be read...
 
sl := TStringList.Create;
try
WebBrowser1.ReadMetaTags(sl);
// TODO: case insensitive
if sl.Values['fastphp_title'] <> '' then Caption := sl.Values['fastphp_title'];
if sl.Values['fastphp_width'] <> '' then ClientWidth := StrToInt(sl.Values['fastphp_width']);
if sl.Values['fastphp_height'] <> '' then ClientHeight := StrToInt(sl.Values['fastphp_height']);
// TODO: Add more attributes, like HTA applications had
// TODO: Additionally implement "HTA:APPLICATION" element, see https://docs.microsoft.com/en-us/previous-versions//ms536495%28v%3dvs.85%29
finally
FreeAndNil(sl);
end;
end;
 
procedure TForm2.WebBrowser1BeforeNavigate2(ASender: TObject;
const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
/trunk/FastPHPUtils.pas
3,13 → 3,13
interface
 
uses
Windows, SysUtils, StrUtils, Dialogs, IniFiles, Classes, Forms, ShellAPI;
Windows, SysUtils, StrUtils, Dialogs, IniFiles, Classes, Forms, ShellAPI, Functions;
 
const
FASTPHP_GOTO_URI_PREFIX = 'fastphp://editor/gotoline/';
 
function GetPHPExe: string;
function RunPHPScript(APHPFileName: string; lint: boolean=false; inConsole: boolean=False): string;
function RunPHPScript(APHPFileName: string; lint: boolean=false; inConsole: boolean=False; ContentCallBack: TContentCallBack=nil): string;
function ParseCHM(const chmFile: TFileName): boolean;
function IsValidPHPExe(const exeFile: TFileName): boolean;
 
16,7 → 16,7
implementation
 
uses
Functions, FastPHPConfig;
FastPHPConfig;
 
function GetPHPExe: string;
var
50,7 → 50,7
end;
end;
 
function RunPHPScript(APHPFileName: string; lint: boolean=false; inConsole: boolean=False): string;
function RunPHPScript(APHPFileName: string; lint: boolean=false; inConsole: boolean=False; ContentCallBack: TContentCallBack=nil): string;
var
phpExe, args, batFile, workdir: string;
slBat: TStringList;
88,7 → 88,7
end
else
begin
result := GetDosOutput('"'+phpExe+'" ' + args, workdir);
result := GetDosOutput('"'+phpExe+'" ' + args, workdir, ContentCallBack);
end;
end;
 
/trunk/Functions.pas
6,7 → 6,10
Windows, Messages, SysUtils, StrUtils, IniFiles, Classes, Forms, Variants, MsHTML,
StdCtrls, SynEdit, ActiveX;
 
function GetDosOutput(CommandLine: string; Work: string = ''): string;
type
TContentCallBack = procedure(Content: string) of object;
 
function GetDosOutput(CommandLine: string; Work: string = ''; ContentCallBack: TContentCallBack=nil): string;
function StrIPos(const SubStr, S: string): Integer;
function LoadFileToStr(const FileName: TFileName): AnsiString;
function LastPos(const SubStr, S: string): integer;
25,7 → 28,7
uses
ShlObj; // Needed for the CSIDL constants
 
function GetDosOutput(CommandLine: string; Work: string = ''): string;
function GetDosOutput(CommandLine: string; Work: string = ''; ContentCallBack: TContentCallBack=nil): string;
var
SA: TSecurityAttributes;
SI: TStartupInfo;
70,6 → 73,7
begin
Buffer[BytesRead] := #0;
Result := Result + Buffer;
if Assigned(ContentCallBack) then ContentCallBack(Buffer);
end;
until not WasOK or (BytesRead = 0);
WaitForSingleObject(PI.hProcess, INFINITE);
/trunk/WebBrowserUtils.pas
6,12 → 6,14
 
uses
// TODO: "{$IFDEF USE_SHDOCVW_TLB}ShDocVw_TLB{$ELSE}ShDocVw{$ENDIF}" does not work with Delphi 10.2
Windows, ShDocVw, SysUtils, Forms;
Windows, ShDocVw, SysUtils, Forms, Classes;
 
procedure WaitForBrowser(AWebBrowser: TWebbrowser);
 
function WebBrowserLoadHTML(AWebBrowser: TWebBrowser; const AHTML: string;
const AFakeURL: string=''): boolean;
function WebBrowserLoadStream(AWebBrowser: TWebBrowser; const AStream: TStream;
const AFakeURL: string=''): boolean;
 
type
TWebBrowserEx = class helper for TWebBrowser
19,6 → 21,8
procedure Clear;
procedure Wait;
function LoadHTML(const HTML: string; const AFakeURL: string=''): boolean;
function LoadStream(const Stream: TStream; const AFakeURL: string=''): boolean;
procedure ReadMetaTags(outSL: TStringList);
end;
 
implementation
39,6 → 43,7
m_sBaseName: string;
public
procedure InitLoader(sContent, sBaseUrl: string);
procedure InitLoaderStream(sStream: TStream; sBaseUrl: string);
{$REGION 'IMoniker members'}
function BindToObject(const bc: IBindCtx; const mkToLeft: IMoniker;
const iidResult: TIID; out vResult): HResult; stdcall;
152,7 → 157,6
try
// TODO: Delphi2007 and FastMM4 say that here we have a memory leak
loader := TLoadHTMLMoniker.Create;
 
loader.InitLoader(AHTML, url);
except
if Assigned(loader) then FreeAndNil(loader);
165,6 → 169,57
if not result and Assigned(loader) then FreeAndNil(loader);
end;
 
function WebBrowserLoadStream(AWebBrowser: TWebBrowser; const AStream: TStream;
const AFakeURL: string=''): boolean;
var
bindctx: IBindCtx;
pPM: IPersistMoniker;
loader: TLoadHTMLMoniker;
url: string;
begin
if AFakeURL <> '' then
url := AFakeURL
else if AWebBrowser.LocationURL <> '' then
url := AWebBrowser.LocationURL
else
url := 'about:blank';
 
if AWebBrowser.Document = nil then
begin
AWebBrowser.Navigate('about:blank');
WaitForBrowser(AWebBrowser);
end;
 
pPM := AWebBrowser.Document as IPersistMoniker;
if (pPM = nil) then
begin
result := false;
exit;
end;
 
bindctx := nil;
CreateBindCtx(0, bindctx);
if (bindctx = nil) then
begin
result := false;
exit;
end;
 
try
// TODO: Delphi2007 and FastMM4 say that here we have a memory leak
loader := TLoadHTMLMoniker.Create;
loader.InitLoaderStream(AStream, url);
except
if Assigned(loader) then FreeAndNil(loader);
result := false;
exit;
end;
 
result := pPM.Load(true, loader, bindctx, STGM_READ) = S_OK;
 
if not result and Assigned(loader) then FreeAndNil(loader);
end;
 
{ TLoadHTMLMoniker }
 
// TLoadHTMLMoniker. Translated from C# to Delphi by Daniel Marschall
184,6 → 239,15
if ((hr <> S_OK) or (m_stream = nil)) then raise Exception.Create(SCannotAllocMemory);
end;
 
procedure TLoadHTMLMoniker.InitLoaderStream(sStream: TStream; sBaseUrl: string);
resourcestring
SCannotAllocMemory = 'Cannot create IStream.';
begin
m_sBaseName := sBaseUrl;
m_stream := TStreamAdapter.Create(sStream, soReference) as IStream;
if (m_stream = nil) then raise Exception.Create(SCannotAllocMemory);
end;
 
function TLoadHTMLMoniker.GetDisplayName(const bc: IBindCtx;
const mkToLeft: IMoniker; out pszDisplayName: POleStr): HResult;
var
333,6 → 397,31
Self.Wait;
end;
 
function TWebBrowserEx.LoadStream(const Stream: TStream; const AFakeURL: string=''): boolean;
begin
result := WebBrowserLoadStream(Self, Stream, AFakeURL);
Self.Wait;
end;
 
procedure TWebBrowserEx.ReadMetaTags(outSL: TStringList);
var
vDocument: OleVariant;
vMetas: OleVariant;
vMetaItem: OleVariant;
i: Integer;
begin
vDocument := Self.Document;
vMetas := vDocument.GetElementsByTagName('meta');
for i := 0 to vMetas.Length-1 do
begin
vMetaItem := vMetas.Item(i);
if string(vMetaItem.httpequiv) = '' then
outSL.Values[vMetaItem.Name] := vMetaItem.Content
else
outSL.Values[vMetaItem.httpequiv] := vMetaItem.Content;
end;
end;
 
procedure TWebBrowserEx.Clear;
begin
Self.LoadHTML('', 'about:blank');