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


unit WebBrowserUtils;
 
{$Include 'FastPHP.inc'}
 
interface
 
uses
 
  Windows, ShDocVw{$IFDEF USE_SHDOCVW_TLB}_TLB{$ENDIF}, SysUtils, Forms;
 
procedure WaitForBrowser(AWebBrowser: TWebbrowser);
 
function WebBrowserLoadHTML(AWebBrowser: TWebBrowser; const AHTML: string;
                            const AFakeURL: string=''): boolean;
 
type
  TWebBrowserEx = class helper for TWebBrowser
  public
    procedure Clear;
    procedure Wait;
    function LoadHTML(const HTML: string; const AFakeURL: string=''): boolean;
  end;
 
implementation
 
uses
  ActiveX, urlmon;
 
type
  (*
  ILoadHTMLMoniker = interface(IMoniker)
    ['{DCAE3F41-9B38-40EB-B7D0-4AF0FBFBE5AB}']
    procedure InitLoader(sContent, sBaseUrl: string);
  end;
  *)
  TLoadHTMLMoniker = class (TInterfacedObject, IMoniker{, ILoadHTMLMoniker})
  private
    m_stream: IStream;
    m_sBaseName: string;
  public
    procedure InitLoader(sContent, sBaseUrl: string);
    {$REGION 'IMoniker members'}
    function BindToObject(const bc: IBindCtx; const mkToLeft: IMoniker;
      const iidResult: TIID; out vResult): HResult; stdcall;
    function BindToStorage(const bc: IBindCtx; const mkToLeft: IMoniker;
      const iid: TIID; out vObj): HResult; stdcall;
    function Reduce(const bc: IBindCtx; dwReduceHowFar: Longint;
      mkToLeft: PIMoniker; out mkReduced: IMoniker): HResult; stdcall;
    function ComposeWith(const mkRight: IMoniker; fOnlyIfNotGeneric: BOOL;
      out mkComposite: IMoniker): HResult; stdcall;
    function Enum(fForward: BOOL; out enumMoniker: IEnumMoniker): HResult;
      stdcall;
    function IsEqual(const mkOtherMoniker: IMoniker): HResult; stdcall;
    function Hash(out dwHash: Longint): HResult; stdcall;
    function IsRunning(const bc: IBindCtx; const mkToLeft: IMoniker;
      const mkNewlyRunning: IMoniker): HResult; stdcall;
    function GetTimeOfLastChange(const bc: IBindCtx; const mkToLeft: IMoniker;
      out filetime: TFileTime): HResult; stdcall;
    function Inverse(out mk: IMoniker): HResult; stdcall;
    function CommonPrefixWith(const mkOther: IMoniker;
      out mkPrefix: IMoniker): HResult; stdcall;
    function RelativePathTo(const mkOther: IMoniker;
      out mkRelPath: IMoniker): HResult; stdcall;
    function GetDisplayName(const bc: IBindCtx; const mkToLeft: IMoniker;
      out pszDisplayName: POleStr): HResult; stdcall;
    function ParseDisplayName(const bc: IBindCtx; const mkToLeft: IMoniker;
      pszDisplayName: POleStr; out chEaten: Longint;
      out mkOut: IMoniker): HResult; stdcall;
    function IsSystemMoniker(out dwMksys: Longint): HResult; stdcall;
    {$ENDREGION}
 
    {$REGION 'IPersistStream members'}
    function IsDirty: HResult; stdcall;
    function Load(const stm: IStream): HResult; stdcall;
    function Save(const stm: IStream; fClearDirty: BOOL): HResult; stdcall;
    function GetSizeMax(out cbSize: Largeint): HResult; stdcall;
    {$ENDREGION}
 
    {$REGION 'IPersist members'}
    function GetClassID(out classID: TCLSID): HResult; stdcall;
    {$ENDREGION}
  end;
 
 
// http://stackoverflow.com/questions/12605323/globalalloc-causes-my-delphi-app-hang
function StrToGlobalHandle(const aText: string): HGLOBAL;
var
  ptr: PChar;
begin
  Result := 0;
  if aText <> '' then
  begin
    Result := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT, (length(aText) + 1) * SizeOf(Char));
    if Result <> 0 then
    begin
      ptr := GlobalLock(Result);
      if Assigned(ptr) then
      begin
        StrCopy(ptr, PChar(aText));
        GlobalUnlock(Result);
      end
    end;
  end;
end;
 
procedure WaitForBrowser(AWebBrowser: TWebbrowser);
begin
  while (AWebBrowser.ReadyState <> READYSTATE_COMPLETE) and
        (not Assigned(Application) or not Application.Terminated) do
  begin
    if Assigned(Application) then Application.ProcessMessages;
    Sleep(50);
  end;
end;
 
function WebBrowserLoadHTML(AWebBrowser: TWebBrowser; const AHTML: string;
                            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
    loader := TLoadHTMLMoniker.Create;
    loader.InitLoader(AHTML, url);
  except
    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
// Resources:
// - http://stackoverflow.com/questions/40927080/relative-urls-in-a-twebbrowser-containing-custom-html-code
// - https://github.com/kuza55/csexwb2/blob/master/General_Classes/LoadHTMLMoniker.cs
// - https://github.com/kuza55/csexwb2/blob/master/cEXWB.cs#L1769
 
procedure TLoadHTMLMoniker.InitLoader(sContent, sBaseUrl: string);
resourcestring
  SCannotAllocMemory = 'Cannot create IStream.';
var
  hr: integer;
begin
  m_sBaseName := sBaseUrl;
  hr := CreateStreamOnHGlobal(StrToGlobalHandle(sContent), true, m_stream);
  if ((hr <> S_OK) or (m_stream = nil)) then raise Exception.Create(SCannotAllocMemory);
end;
 
function TLoadHTMLMoniker.GetDisplayName(const bc: IBindCtx;
  const mkToLeft: IMoniker; out pszDisplayName: POleStr): HResult;
var
  bufSize: integer;
  wTest: WideString;
begin
//  pszDisplayName := PWideChar(WideString(m_sBaseName));
 
  // I am not sure if that is correct......
  bufSize := (Length(m_sBaseName)+1) * SizeOf(WideChar);
  pszDisplayName := CoTaskMemAlloc(bufSize);
  wTest := m_sBaseName;
  CopyMemory(pszDisplayName, PWideChar(wTest), bufSize);
 
  result := S_OK;
end;
 
function TLoadHTMLMoniker.BindToStorage(const bc: IBindCtx;
  const mkToLeft: IMoniker; const iid: TIID; out vObj): HResult;
const
  IID_IStream: TGUID = '{0000000C-0000-0000-C000-000000000046}';
begin
  if IsEqualIID(iid, IID_IStream) then
  begin
    IStream(vObj) := m_stream;
    result := S_OK;
  end
  else
  begin
    IStream(vObj) := nil;
    result := E_NOINTERFACE;
  end;
end;
 
{$REGION 'Not implemented'}
function TLoadHTMLMoniker.BindToObject(const bc: IBindCtx;
  const mkToLeft: IMoniker; const iidResult: TIID; out vResult): HResult;
begin
  result := E_NOTIMPL;
end;
 
function TLoadHTMLMoniker.CommonPrefixWith(const mkOther: IMoniker;
  out mkPrefix: IMoniker): HResult;
begin
  result := E_NOTIMPL;
end;
 
function TLoadHTMLMoniker.ComposeWith(const mkRight: IMoniker;
  fOnlyIfNotGeneric: BOOL; out mkComposite: IMoniker): HResult;
begin
  result := E_NOTIMPL;
end;
 
function TLoadHTMLMoniker.Enum(fForward: BOOL;
  out enumMoniker: IEnumMoniker): HResult;
begin
  result := E_NOTIMPL;
end;
 
function TLoadHTMLMoniker.GetClassID(out classID: TCLSID): HResult;
begin
  result := E_NOTIMPL;
end;
 
function TLoadHTMLMoniker.GetSizeMax(out cbSize: Largeint): HResult;
begin
  result := E_NOTIMPL;
end;
 
function TLoadHTMLMoniker.GetTimeOfLastChange(const bc: IBindCtx;
  const mkToLeft: IMoniker; out filetime: TFileTime): HResult;
begin
  result := E_NOTIMPL;
end;
 
function TLoadHTMLMoniker.Hash(out dwHash: Integer): HResult;
begin
  result := E_NOTIMPL;
end;
 
function TLoadHTMLMoniker.Inverse(out mk: IMoniker): HResult;
begin
  result := E_NOTIMPL;
end;
 
function TLoadHTMLMoniker.IsDirty: HResult;
begin
  result := E_NOTIMPL;
end;
 
function TLoadHTMLMoniker.IsEqual(const mkOtherMoniker: IMoniker): HResult;
begin
  result := E_NOTIMPL;
end;
 
function TLoadHTMLMoniker.IsRunning(const bc: IBindCtx; const mkToLeft,
  mkNewlyRunning: IMoniker): HResult;
begin
  result := E_NOTIMPL;
end;
 
function TLoadHTMLMoniker.IsSystemMoniker(out dwMksys: Integer): HResult;
begin
  result := E_NOTIMPL;
end;
 
function TLoadHTMLMoniker.Load(const stm: IStream): HResult;
begin
  result := E_NOTIMPL;
end;
 
function TLoadHTMLMoniker.ParseDisplayName(const bc: IBindCtx;
  const mkToLeft: IMoniker; pszDisplayName: POleStr; out chEaten: Integer;
  out mkOut: IMoniker): HResult;
begin
  result := E_NOTIMPL;
end;
 
function TLoadHTMLMoniker.Reduce(const bc: IBindCtx; dwReduceHowFar: Integer;
  mkToLeft: PIMoniker; out mkReduced: IMoniker): HResult;
begin
  result := E_NOTIMPL;
end;
 
function TLoadHTMLMoniker.RelativePathTo(const mkOther: IMoniker;
  out mkRelPath: IMoniker): HResult;
begin
  result := E_NOTIMPL;
end;
 
function TLoadHTMLMoniker.Save(const stm: IStream; fClearDirty: BOOL): HResult;
begin
  result := E_NOTIMPL;
end;
{$ENDREGION}
 
{ TWebBrowserEx }
 
procedure TWebBrowserEx.Wait;
begin
  WaitForBrowser(Self);
end;
 
function TWebBrowserEx.LoadHTML(const HTML: string; const AFakeURL: string=''): boolean;
begin
  result := WebBrowserLoadHTML(Self, HTML, AFakeURL);
  Self.Wait;
end;
 
procedure TWebBrowserEx.Clear;
begin
  Self.LoadHTML('', 'about:blank');
end;
 
end.
 

Rev 8	Rev 25
1	unit WebBrowserUtils;	1	unit WebBrowserUtils;
2		2
-		3	{$Include 'FastPHP.inc'}
-		4
3	interface	5	interface
4		6
5	uses	7	uses
6	// In case ShDocVw_TLB can't be found, use ShDocVw	-
7	Windows, ShDocVw_TLB, SysUtils, Forms;	8	Windows, ShDocVw{$IFDEF USE_SHDOCVW_TLB}_TLB{$ENDIF}, SysUtils, Forms;
8		9
9	procedure WaitForBrowser(AWebBrowser: TWebbrowser);	10	procedure WaitForBrowser(AWebBrowser: TWebbrowser);
10		11
11	function WebBrowserLoadHTML(AWebBrowser: TWebBrowser; const AHTML: string;	12	function WebBrowserLoadHTML(AWebBrowser: TWebBrowser; const AHTML: string;
12	const AFakeURL: string=''): boolean;	13	const AFakeURL: string=''): boolean;
13		14
14	type	15	type
15	TWebBrowserEx = class helper for TWebBrowser	16	TWebBrowserEx = class helper for TWebBrowser
16	public	17	public
17	procedure Clear;	18	procedure Clear;
18	procedure Wait;	19	procedure Wait;
19	function LoadHTML(const HTML: string; const AFakeURL: string=''): boolean;	20	function LoadHTML(const HTML: string; const AFakeURL: string=''): boolean;
20	end;	21	end;
21		22
22	implementation	23	implementation
23		24
24	uses	25	uses
25	ActiveX, urlmon;	26	ActiveX, urlmon;
26		27
27	type	28	type
28	(*	29	(*
29	ILoadHTMLMoniker = interface(IMoniker)	30	ILoadHTMLMoniker = interface(IMoniker)
30	['{DCAE3F41-9B38-40EB-B7D0-4AF0FBFBE5AB}']	31	['{DCAE3F41-9B38-40EB-B7D0-4AF0FBFBE5AB}']
31	procedure InitLoader(sContent, sBaseUrl: string);	32	procedure InitLoader(sContent, sBaseUrl: string);
32	end;	33	end;
33	*)	34	*)
34	TLoadHTMLMoniker = class (TInterfacedObject, IMoniker{, ILoadHTMLMoniker})	35	TLoadHTMLMoniker = class (TInterfacedObject, IMoniker{, ILoadHTMLMoniker})
35	private	36	private
36	m_stream: IStream;	37	m_stream: IStream;
37	m_sBaseName: string;	38	m_sBaseName: string;
38	public	39	public
39	procedure InitLoader(sContent, sBaseUrl: string);	40	procedure InitLoader(sContent, sBaseUrl: string);
40	{$REGION 'IMoniker members'}	41	{$REGION 'IMoniker members'}
41	function BindToObject(const bc: IBindCtx; const mkToLeft: IMoniker;	42	function BindToObject(const bc: IBindCtx; const mkToLeft: IMoniker;
42	const iidResult: TIID; out vResult): HResult; stdcall;	43	const iidResult: TIID; out vResult): HResult; stdcall;
43	function BindToStorage(const bc: IBindCtx; const mkToLeft: IMoniker;	44	function BindToStorage(const bc: IBindCtx; const mkToLeft: IMoniker;
44	const iid: TIID; out vObj): HResult; stdcall;	45	const iid: TIID; out vObj): HResult; stdcall;
45	function Reduce(const bc: IBindCtx; dwReduceHowFar: Longint;	46	function Reduce(const bc: IBindCtx; dwReduceHowFar: Longint;
46	mkToLeft: PIMoniker; out mkReduced: IMoniker): HResult; stdcall;	47	mkToLeft: PIMoniker; out mkReduced: IMoniker): HResult; stdcall;
47	function ComposeWith(const mkRight: IMoniker; fOnlyIfNotGeneric: BOOL;	48	function ComposeWith(const mkRight: IMoniker; fOnlyIfNotGeneric: BOOL;
48	out mkComposite: IMoniker): HResult; stdcall;	49	out mkComposite: IMoniker): HResult; stdcall;
49	function Enum(fForward: BOOL; out enumMoniker: IEnumMoniker): HResult;	50	function Enum(fForward: BOOL; out enumMoniker: IEnumMoniker): HResult;
50	stdcall;	51	stdcall;
51	function IsEqual(const mkOtherMoniker: IMoniker): HResult; stdcall;	52	function IsEqual(const mkOtherMoniker: IMoniker): HResult; stdcall;
52	function Hash(out dwHash: Longint): HResult; stdcall;	53	function Hash(out dwHash: Longint): HResult; stdcall;
53	function IsRunning(const bc: IBindCtx; const mkToLeft: IMoniker;	54	function IsRunning(const bc: IBindCtx; const mkToLeft: IMoniker;
54	const mkNewlyRunning: IMoniker): HResult; stdcall;	55	const mkNewlyRunning: IMoniker): HResult; stdcall;
55	function GetTimeOfLastChange(const bc: IBindCtx; const mkToLeft: IMoniker;	56	function GetTimeOfLastChange(const bc: IBindCtx; const mkToLeft: IMoniker;
56	out filetime: TFileTime): HResult; stdcall;	57	out filetime: TFileTime): HResult; stdcall;
57	function Inverse(out mk: IMoniker): HResult; stdcall;	58	function Inverse(out mk: IMoniker): HResult; stdcall;
58	function CommonPrefixWith(const mkOther: IMoniker;	59	function CommonPrefixWith(const mkOther: IMoniker;
59	out mkPrefix: IMoniker): HResult; stdcall;	60	out mkPrefix: IMoniker): HResult; stdcall;
60	function RelativePathTo(const mkOther: IMoniker;	61	function RelativePathTo(const mkOther: IMoniker;
61	out mkRelPath: IMoniker): HResult; stdcall;	62	out mkRelPath: IMoniker): HResult; stdcall;
62	function GetDisplayName(const bc: IBindCtx; const mkToLeft: IMoniker;	63	function GetDisplayName(const bc: IBindCtx; const mkToLeft: IMoniker;
63	out pszDisplayName: POleStr): HResult; stdcall;	64	out pszDisplayName: POleStr): HResult; stdcall;
64	function ParseDisplayName(const bc: IBindCtx; const mkToLeft: IMoniker;	65	function ParseDisplayName(const bc: IBindCtx; const mkToLeft: IMoniker;
65	pszDisplayName: POleStr; out chEaten: Longint;	66	pszDisplayName: POleStr; out chEaten: Longint;
66	out mkOut: IMoniker): HResult; stdcall;	67	out mkOut: IMoniker): HResult; stdcall;
67	function IsSystemMoniker(out dwMksys: Longint): HResult; stdcall;	68	function IsSystemMoniker(out dwMksys: Longint): HResult; stdcall;
68	{$ENDREGION}	69	{$ENDREGION}
69		70
70	{$REGION 'IPersistStream members'}	71	{$REGION 'IPersistStream members'}
71	function IsDirty: HResult; stdcall;	72	function IsDirty: HResult; stdcall;
72	function Load(const stm: IStream): HResult; stdcall;	73	function Load(const stm: IStream): HResult; stdcall;
73	function Save(const stm: IStream; fClearDirty: BOOL): HResult; stdcall;	74	function Save(const stm: IStream; fClearDirty: BOOL): HResult; stdcall;
74	function GetSizeMax(out cbSize: Largeint): HResult; stdcall;	75	function GetSizeMax(out cbSize: Largeint): HResult; stdcall;
75	{$ENDREGION}	76	{$ENDREGION}
76		77
77	{$REGION 'IPersist members'}	78	{$REGION 'IPersist members'}
78	function GetClassID(out classID: TCLSID): HResult; stdcall;	79	function GetClassID(out classID: TCLSID): HResult; stdcall;
79	{$ENDREGION}	80	{$ENDREGION}
80	end;	81	end;
81		82
82		83
83	// http://stackoverflow.com/questions/12605323/globalalloc-causes-my-delphi-app-hang	84	// http://stackoverflow.com/questions/12605323/globalalloc-causes-my-delphi-app-hang
84	function StrToGlobalHandle(const aText: string): HGLOBAL;	85	function StrToGlobalHandle(const aText: string): HGLOBAL;
85	var	86	var
86	ptr: PChar;	87	ptr: PChar;
87	begin	88	begin
88	Result := 0;	89	Result := 0;
89	if aText <> '' then	90	if aText <> '' then
90	begin	91	begin
91	Result := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT, (length(aText) + 1) * SizeOf(Char));	92	Result := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT, (length(aText) + 1) * SizeOf(Char));
92	if Result <> 0 then	93	if Result <> 0 then
93	begin	94	begin
94	ptr := GlobalLock(Result);	95	ptr := GlobalLock(Result);
95	if Assigned(ptr) then	96	if Assigned(ptr) then
96	begin	97	begin
97	StrCopy(ptr, PChar(aText));	98	StrCopy(ptr, PChar(aText));
98	GlobalUnlock(Result);	99	GlobalUnlock(Result);
99	end	100	end
100	end;	101	end;
101	end;	102	end;
102	end;	103	end;
103		104
104	procedure WaitForBrowser(AWebBrowser: TWebbrowser);	105	procedure WaitForBrowser(AWebBrowser: TWebbrowser);
105	begin	106	begin
106	while (AWebBrowser.ReadyState <> READYSTATE_COMPLETE) and	107	while (AWebBrowser.ReadyState <> READYSTATE_COMPLETE) and
107	(not Assigned(Application) or not Application.Terminated) do	108	(not Assigned(Application) or not Application.Terminated) do
108	begin	109	begin
109	if Assigned(Application) then Application.ProcessMessages;	110	if Assigned(Application) then Application.ProcessMessages;
110	Sleep(50);	111	Sleep(50);
111	end;	112	end;
112	end;	113	end;
113		114
114	function WebBrowserLoadHTML(AWebBrowser: TWebBrowser; const AHTML: string;	115	function WebBrowserLoadHTML(AWebBrowser: TWebBrowser; const AHTML: string;
115	const AFakeURL: string=''): boolean;	116	const AFakeURL: string=''): boolean;
116	var	117	var
117	bindctx: IBindCtx;	118	bindctx: IBindCtx;
118	pPM: IPersistMoniker;	119	pPM: IPersistMoniker;
119	loader: TLoadHTMLMoniker;	120	loader: TLoadHTMLMoniker;
120	url: string;	121	url: string;
121	begin	122	begin
122	if AFakeURL <> '' then	123	if AFakeURL <> '' then
123	url := AFakeURL	124	url := AFakeURL
124	else if AWebBrowser.LocationURL <> '' then	125	else if AWebBrowser.LocationURL <> '' then
125	url := AWebBrowser.LocationURL	126	url := AWebBrowser.LocationURL
126	else	127	else
127	url := 'about:blank';	128	url := 'about:blank';
128		129
129	if AWebBrowser.Document = nil then	130	if AWebBrowser.Document = nil then
130	begin	131	begin
131	AWebBrowser.Navigate('about:blank');	132	AWebBrowser.Navigate('about:blank');
132	WaitForBrowser(AWebBrowser);	133	WaitForBrowser(AWebBrowser);
133	end;	134	end;
134		135
135	pPM := AWebBrowser.Document as IPersistMoniker;	136	pPM := AWebBrowser.Document as IPersistMoniker;
136	if (pPM = nil) then Exit(false);	137	if (pPM = nil) then
-		138	begin
-		139	result := false;
-		140	exit;
-		141	end;
137		142
138	bindctx := nil;	143	bindctx := nil;
139	CreateBindCtx(0, bindctx);	144	CreateBindCtx(0, bindctx);
140	if (bindctx = nil) then Exit(false);	145	if (bindctx = nil) then
-		146	begin
-		147	result := false;
-		148	exit;
-		149	end;
141		150
142	try	151	try
143	loader := TLoadHTMLMoniker.Create;	152	loader := TLoadHTMLMoniker.Create;
144	loader.InitLoader(AHTML, url);	153	loader.InitLoader(AHTML, url);
145	except	154	except
146	Exit(false);	155	result := false;
-		156	exit;
147	end;	157	end;
148		158
149	result := pPM.Load(true, loader, bindctx, STGM_READ) = S_OK;	159	result := pPM.Load(true, loader, bindctx, STGM_READ) = S_OK;
150		160
151	if not result and Assigned(loader) then FreeAndNil(loader);	161	if not result and Assigned(loader) then FreeAndNil(loader);
152	end;	162	end;
153		163
154	{ TLoadHTMLMoniker }	164	{ TLoadHTMLMoniker }
155		165
156	// TLoadHTMLMoniker. Translated from C# to Delphi by Daniel Marschall	166	// TLoadHTMLMoniker. Translated from C# to Delphi by Daniel Marschall
157	// Resources:	167	// Resources:
158	// - http://stackoverflow.com/questions/40927080/relative-urls-in-a-twebbrowser-containing-custom-html-code	168	// - http://stackoverflow.com/questions/40927080/relative-urls-in-a-twebbrowser-containing-custom-html-code
159	// - https://github.com/kuza55/csexwb2/blob/master/General_Classes/LoadHTMLMoniker.cs	169	// - https://github.com/kuza55/csexwb2/blob/master/General_Classes/LoadHTMLMoniker.cs
160	// - https://github.com/kuza55/csexwb2/blob/master/cEXWB.cs#L1769	170	// - https://github.com/kuza55/csexwb2/blob/master/cEXWB.cs#L1769
161		171
162	procedure TLoadHTMLMoniker.InitLoader(sContent, sBaseUrl: string);	172	procedure TLoadHTMLMoniker.InitLoader(sContent, sBaseUrl: string);
163	resourcestring	173	resourcestring
164	SCannotAllocMemory = 'Cannot create IStream.';	174	SCannotAllocMemory = 'Cannot create IStream.';
165	var	175	var
166	hr: integer;	176	hr: integer;
167	begin	177	begin
168	m_sBaseName := sBaseUrl;	178	m_sBaseName := sBaseUrl;
169	hr := CreateStreamOnHGlobal(StrToGlobalHandle(sContent), true, m_stream);	179	hr := CreateStreamOnHGlobal(StrToGlobalHandle(sContent), true, m_stream);
170	if ((hr <> S_OK) or (m_stream = nil)) then raise Exception.Create(SCannotAllocMemory);	180	if ((hr <> S_OK) or (m_stream = nil)) then raise Exception.Create(SCannotAllocMemory);
171	end;	181	end;
172		182
173	function TLoadHTMLMoniker.GetDisplayName(const bc: IBindCtx;	183	function TLoadHTMLMoniker.GetDisplayName(const bc: IBindCtx;
174	const mkToLeft: IMoniker; out pszDisplayName: POleStr): HResult;	184	const mkToLeft: IMoniker; out pszDisplayName: POleStr): HResult;
175	var	185	var
176	bufSize: integer;	186	bufSize: integer;
177	wTest: WideString;	187	wTest: WideString;
178	begin	188	begin
179	// pszDisplayName := PWideChar(WideString(m_sBaseName));	189	// pszDisplayName := PWideChar(WideString(m_sBaseName));
180		190
181	// I am not sure if that is correct......	191	// I am not sure if that is correct......
182	bufSize := (Length(m_sBaseName)+1) * SizeOf(WideChar);	192	bufSize := (Length(m_sBaseName)+1) * SizeOf(WideChar);
183	pszDisplayName := CoTaskMemAlloc(bufSize);	193	pszDisplayName := CoTaskMemAlloc(bufSize);
184	wTest := m_sBaseName;	194	wTest := m_sBaseName;
185	CopyMemory(pszDisplayName, PWideChar(wTest), bufSize);	195	CopyMemory(pszDisplayName, PWideChar(wTest), bufSize);
186		196
187	result := S_OK;	197	result := S_OK;
188	end;	198	end;
189		199
190	function TLoadHTMLMoniker.BindToStorage(const bc: IBindCtx;	200	function TLoadHTMLMoniker.BindToStorage(const bc: IBindCtx;
191	const mkToLeft: IMoniker; const iid: TIID; out vObj): HResult;	201	const mkToLeft: IMoniker; const iid: TIID; out vObj): HResult;
192	const	202	const
193	IID_IStream: TGUID = '{0000000C-0000-0000-C000-000000000046}';	203	IID_IStream: TGUID = '{0000000C-0000-0000-C000-000000000046}';
194	begin	204	begin
195	if IsEqualIID(iid, IID_IStream) then	205	if IsEqualIID(iid, IID_IStream) then
196	begin	206	begin
197	IStream(vObj) := m_stream;	207	IStream(vObj) := m_stream;
198	result := S_OK;	208	result := S_OK;
199	end	209	end
200	else	210	else
201	begin	211	begin
202	IStream(vObj) := nil;	212	IStream(vObj) := nil;
203	result := E_NOINTERFACE;	213	result := E_NOINTERFACE;
204	end;	214	end;
205	end;	215	end;
206		216
207	{$REGION 'Not implemented'}	217	{$REGION 'Not implemented'}
208	function TLoadHTMLMoniker.BindToObject(const bc: IBindCtx;	218	function TLoadHTMLMoniker.BindToObject(const bc: IBindCtx;
209	const mkToLeft: IMoniker; const iidResult: TIID; out vResult): HResult;	219	const mkToLeft: IMoniker; const iidResult: TIID; out vResult): HResult;
210	begin	220	begin
211	result := E_NOTIMPL;	221	result := E_NOTIMPL;
212	end;	222	end;
213		223
214	function TLoadHTMLMoniker.CommonPrefixWith(const mkOther: IMoniker;	224	function TLoadHTMLMoniker.CommonPrefixWith(const mkOther: IMoniker;
215	out mkPrefix: IMoniker): HResult;	225	out mkPrefix: IMoniker): HResult;
216	begin	226	begin
217	result := E_NOTIMPL;	227	result := E_NOTIMPL;
218	end;	228	end;
219		229
220	function TLoadHTMLMoniker.ComposeWith(const mkRight: IMoniker;	230	function TLoadHTMLMoniker.ComposeWith(const mkRight: IMoniker;
221	fOnlyIfNotGeneric: BOOL; out mkComposite: IMoniker): HResult;	231	fOnlyIfNotGeneric: BOOL; out mkComposite: IMoniker): HResult;
222	begin	232	begin
223	result := E_NOTIMPL;	233	result := E_NOTIMPL;
224	end;	234	end;
225		235
226	function TLoadHTMLMoniker.Enum(fForward: BOOL;	236	function TLoadHTMLMoniker.Enum(fForward: BOOL;
227	out enumMoniker: IEnumMoniker): HResult;	237	out enumMoniker: IEnumMoniker): HResult;
228	begin	238	begin
229	result := E_NOTIMPL;	239	result := E_NOTIMPL;
230	end;	240	end;
231		241
232	function TLoadHTMLMoniker.GetClassID(out classID: TCLSID): HResult;	242	function TLoadHTMLMoniker.GetClassID(out classID: TCLSID): HResult;
233	begin	243	begin
234	result := E_NOTIMPL;	244	result := E_NOTIMPL;
235	end;	245	end;
236		246
237	function TLoadHTMLMoniker.GetSizeMax(out cbSize: Largeint): HResult;	247	function TLoadHTMLMoniker.GetSizeMax(out cbSize: Largeint): HResult;
238	begin	248	begin
239	result := E_NOTIMPL;	249	result := E_NOTIMPL;
240	end;	250	end;
241		251
242	function TLoadHTMLMoniker.GetTimeOfLastChange(const bc: IBindCtx;	252	function TLoadHTMLMoniker.GetTimeOfLastChange(const bc: IBindCtx;
243	const mkToLeft: IMoniker; out filetime: TFileTime): HResult;	253	const mkToLeft: IMoniker; out filetime: TFileTime): HResult;
244	begin	254	begin
245	result := E_NOTIMPL;	255	result := E_NOTIMPL;
246	end;	256	end;
247		257
248	function TLoadHTMLMoniker.Hash(out dwHash: Integer): HResult;	258	function TLoadHTMLMoniker.Hash(out dwHash: Integer): HResult;
249	begin	259	begin
250	result := E_NOTIMPL;	260	result := E_NOTIMPL;
251	end;	261	end;
252		262
253	function TLoadHTMLMoniker.Inverse(out mk: IMoniker): HResult;	263	function TLoadHTMLMoniker.Inverse(out mk: IMoniker): HResult;
254	begin	264	begin
255	result := E_NOTIMPL;	265	result := E_NOTIMPL;
256	end;	266	end;
257		267
258	function TLoadHTMLMoniker.IsDirty: HResult;	268	function TLoadHTMLMoniker.IsDirty: HResult;
259	begin	269	begin
260	result := E_NOTIMPL;	270	result := E_NOTIMPL;
261	end;	271	end;
262		272
263	function TLoadHTMLMoniker.IsEqual(const mkOtherMoniker: IMoniker): HResult;	273	function TLoadHTMLMoniker.IsEqual(const mkOtherMoniker: IMoniker): HResult;
264	begin	274	begin
265	result := E_NOTIMPL;	275	result := E_NOTIMPL;
266	end;	276	end;
267		277
268	function TLoadHTMLMoniker.IsRunning(const bc: IBindCtx; const mkToLeft,	278	function TLoadHTMLMoniker.IsRunning(const bc: IBindCtx; const mkToLeft,
269	mkNewlyRunning: IMoniker): HResult;	279	mkNewlyRunning: IMoniker): HResult;
270	begin	280	begin
271	result := E_NOTIMPL;	281	result := E_NOTIMPL;
272	end;	282	end;
273		283
274	function TLoadHTMLMoniker.IsSystemMoniker(out dwMksys: Integer): HResult;	284	function TLoadHTMLMoniker.IsSystemMoniker(out dwMksys: Integer): HResult;
275	begin	285	begin
276	result := E_NOTIMPL;	286	result := E_NOTIMPL;
277	end;	287	end;
278		288
279	function TLoadHTMLMoniker.Load(const stm: IStream): HResult;	289	function TLoadHTMLMoniker.Load(const stm: IStream): HResult;
280	begin	290	begin
281	result := E_NOTIMPL;	291	result := E_NOTIMPL;
282	end;	292	end;
283		293
284	function TLoadHTMLMoniker.ParseDisplayName(const bc: IBindCtx;	294	function TLoadHTMLMoniker.ParseDisplayName(const bc: IBindCtx;
285	const mkToLeft: IMoniker; pszDisplayName: POleStr; out chEaten: Integer;	295	const mkToLeft: IMoniker; pszDisplayName: POleStr; out chEaten: Integer;
286	out mkOut: IMoniker): HResult;	296	out mkOut: IMoniker): HResult;
287	begin	297	begin
288	result := E_NOTIMPL;	298	result := E_NOTIMPL;
289	end;	299	end;
290		300
291	function TLoadHTMLMoniker.Reduce(const bc: IBindCtx; dwReduceHowFar: Integer;	301	function TLoadHTMLMoniker.Reduce(const bc: IBindCtx; dwReduceHowFar: Integer;
292	mkToLeft: PIMoniker; out mkReduced: IMoniker): HResult;	302	mkToLeft: PIMoniker; out mkReduced: IMoniker): HResult;
293	begin	303	begin
294	result := E_NOTIMPL;	304	result := E_NOTIMPL;
295	end;	305	end;
296		306
297	function TLoadHTMLMoniker.RelativePathTo(const mkOther: IMoniker;	307	function TLoadHTMLMoniker.RelativePathTo(const mkOther: IMoniker;
298	out mkRelPath: IMoniker): HResult;	308	out mkRelPath: IMoniker): HResult;
299	begin	309	begin
300	result := E_NOTIMPL;	310	result := E_NOTIMPL;
301	end;	311	end;
302		312
303	function TLoadHTMLMoniker.Save(const stm: IStream; fClearDirty: BOOL): HResult;	313	function TLoadHTMLMoniker.Save(const stm: IStream; fClearDirty: BOOL): HResult;
304	begin	314	begin
305	result := E_NOTIMPL;	315	result := E_NOTIMPL;
306	end;	316	end;
307	{$ENDREGION}	317	{$ENDREGION}
308		318
309	{ TWebBrowserEx }	319	{ TWebBrowserEx }
310		320
311	procedure TWebBrowserEx.Wait;	321	procedure TWebBrowserEx.Wait;
312	begin	322	begin
313	WaitForBrowser(Self);	323	WaitForBrowser(Self);
314	end;	324	end;
315		325
316	function TWebBrowserEx.LoadHTML(const HTML: string; const AFakeURL: string=''): boolean;	326	function TWebBrowserEx.LoadHTML(const HTML: string; const AFakeURL: string=''): boolean;
317	begin	327	begin
318	result := WebBrowserLoadHTML(Self, HTML, AFakeURL);	328	result := WebBrowserLoadHTML(Self, HTML, AFakeURL);
319	Self.Wait;	329	Self.Wait;
320	end;	330	end;
321		331
322	procedure TWebBrowserEx.Clear;	332	procedure TWebBrowserEx.Clear;
323	begin	333	begin
324	Self.LoadHTML('', 'about:blank');	334	Self.LoadHTML('', 'about:blank');
325	end;	335	end;
326		336
327	end.	337	end.
328		338

Subversion Repositories fastphp

fastphp/trunk/WebBrowserUtils.pas – Rev 8 → 25