自己摘
unit MA;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
OleCtrls, SHDocVw, StdCtrls, Psock, ComObj;
type
TForm1 = class(TForm)
WB1: TWebBrowser;
b1: TButton;
urltext: TEdit;
listurl: TEdit;
Memo1: TMemo;
procedure b1Click(Sender: TObject);
procedure WB1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
private
{ Private declarations }
public
{ Public declarations }
end;
{ IPersistStream interface }
{$EXTERNALSYM IPersistStream}
IPersistStream = interface(IPersist)
['{00000109-0000-0000-C000-000000000046}']
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; // 取得保存所需空间大小
end;
{ IPersistStreamInit interface }
{$EXTERNALSYM IPersistStreamInit}
IPersistStreamInit = interface(IPersistStream)
['{7FD52380-4E07-101B-AE2D-08002B2EC713}']
function InitNew: HResult; stdcall; // 初始化
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function GetHtml(const WebBrowser:
TWebBrowser): string;
const
BufSize = $10000;
var
Size: Int64;
Stream: IStream;
hHTMLText: HGLOBAL;
psi: IPersistStreamInit;
begin
if not Assigned(WebBrowser.Document) then Exit;
OleCheck(WebBrowser.Document.QueryInterface
(IPersistStreamInit, psi));
try
//OleCheck(psi.GetSizeMax(Size));
hHTMLText := GlobalAlloc(GPTR, BufSize);
if 0 = hHTMLText then RaiseLastWin32Error;
OleCheck(CreateStreamOnHGlobal(hHTMLText,
True, Stream));
try
OleCheck(psi.Save(Stream, False));
Size := StrLen(PChar(hHTMLText));
SetLength(Result, Size);
CopyMemory(PChar(Result), Pointer(hHTMLText),
Size);
finally
Stream := nil;
end;
finally
psi := nil;
end;
end;
procedure TForm1.b1Click(Sender: TObject);
begin
WB1.Navigate(urltext.text);
end;
procedure TForm1.WB1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
p:Ansistring;
begin
p:=WB1.LocationURL;
listurl.text:=p;
Memo1.text:=GetHtml(Wb1);
end;
end.
