Subversion Repositories fastphp

Compare Revisions

Regard whitespace Rev 56 → Rev 61

/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');