Sorry,时间久忘了，开始说成另一封装组件 UIWebBrowser了。
下面是WebBrowser的读写完整代码，应该可以满足你的要求：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,ActiveX,
Dialogs, OleCtrls,SHDocVw,MSHTML, StdCtrls,ComCtrls, Buttons,ShlObj,ComObj, ShellAPI;
type
TForm1 = class(TForm)
wbtest: TWebBrowser;
btntest: TBitBtn;
Edit1: TEdit;
procedure FormCreate(Sender: TObject);
procedure IEMessageHandler(var Msg: TMsg;
var Handled: Boolean);
procedure SetHtml(const WebBrowser:TWebBrowser;
const Html: string);
function GetHtml(const WebBrowser:TWebBrowser): string;
procedure btntestClick(Sender: TObject);
function LoadFromStream(const AStream: TStream): HRESULT;
function LoadFromStrings(const AStrings: TStrings): HRESULT;
procedure InitDocument;
private
{ Private declarations }
public
{ Public declarations }
end;
type
{ 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;
type
{ IPersistStreamInit interface }
{$EXTERNALSYM IPersistStreamInit}
IPersistStreamInit = interface(IPersistStream)
['{7FD52380-4E07-101B-AE2D-08002B2EC713}']
function InitNew: HResult;
stdcall;
// 初始化
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
URL: OleVariant;
begin
URL := 'about:blank';
wbtest.Navigate2(URL);
while wbtest.busydo
Application.ProcessMessages;
(wbtest.Document as IHTMLDocument2).designMode := 'On';
Application.OnMessage := IEMessageHandler;
end;
procedure TForm1.IEMessageHandler(var Msg: TMsg;
var Handled: Boolean);
const
StdKeys = [VK_TAB, VK_RETURN];
{ 标准键 }
ExtKeys = [VK_DELETE, VK_BACK, VK_LEFT, VK_RIGHT];
{ 扩展键 }
fExtended = $01000000;
{ 扩展键标志 }
begin
Handled := False;
with Msgdo
if ((Message >= WM_KEYFIRST) and (Message <= WM_KEYLAST)) and
((wParam in StdKeys) or (GetKeyState(VK_CONTROL) < 0) or
(wParam in ExtKeys) and ((lParam and fExtended) = fExtended)) then
try
if IsChild(wbtest.Handle, hWnd) then
{ 处理所有的浏览器相关消息 }
begin
with wbtest.Application as IOleInPlaceActiveObjectdo
Handled := TranslateAccelerator(Msg) = S_OK;
if not Handled then
begin
Handled := True;
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
except
end;
end;
// IEMessageHandler
procedure TForm1.SetHtml(const WebBrowser:TWebBrowser;
const Html: string);
var
Stream: IStream;
hHTMLText: HGLOBAL;
psi: IPersistStreamInit;
begin
if not Assigned(WebBrowser.Document) then
Exit;
hHTMLText := GlobalAlloc(GPTR, Length(Html) + 1);
if 0 = hHTMLText then
RaiseLastWin32Error;
CopyMemory(Pointer(hHTMLText),
PChar(Html), Length(Html));
OleCheck(CreateStreamOnHGlobal(hHTMLText, True, Stream));
try
OleCheck(WebBrowser.Document.QueryInterface(IPersistStreamInit, psi));
try
OleCheck(psi.InitNew);
OleCheck(psi.Load(Stream));
finally
psi := nil;
end;
finally
Stream := nil;
end;
end;
function TForm1.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.btntestClick(Sender: TObject);
begin
SetHtml(wbtest,Edit1.Text);
end;
procedure TForm1.InitDocument;
begin
wbtest.Navigate('about:blank');
while wbtest.ReadyState <> READYSTATE_COMPLETEdo
Application.ProcessMessages;
end;
function TForm1.LoadFromStream(const AStream: TStream): HRESULT;
begin
AStream.seek(0, 0);
Result := (wbtest.Document as IPersistStreamInit).Load(TStreamadapter.Create(AStream));
end;
function TForm1.LoadFromStrings(const AStrings: TStrings): HRESULT;
var
M: TMemoryStream;
begin
M := TMemoryStream.Create;
try
AStrings.SaveToStream(M);
Result := LoadFromStream(M);
except
Result := S_FALSE;
end;
M.free;
end;
initialization
OleInitialize(nil);
finalization
try
OleUninitialize;
except
end;
end.
