]、。·ˉˇ¨〃々—～‖…’”〕〉》」』〗】∶！＂＇），．：；？］｀ 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.