如何讓TWebBrower直接讀取HTML源碼？

實際上，我有兩個問題，但只要解決其中之一便可(最好是在D4中解決)
我看過Cakk在http://www.gislab.ecnu.edu.cn/delphibbs/DispQ.asp?LID=159175中的回答
，但只能在D5上使用，如何在D4中使用？
如只能在D5中使用，那麼，如何解決RxLib2.75(for D5)中的
RxRichEdit經D5編譯後沒有Popmenu的問題(在D4中正常)？  

來自：liguang, 時間：2000-8-3 6:15:00, ID：301437

兩段代碼一段是直接從WebBorwser中讀出HTML源碼，是一個是不通過文件裝入HTML頁面。
procedure 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 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;  

來自：lrbym, 時間：2000-8-3 10:26:00, ID：301671

d4使用THIML  

來自：woodstock, 時間：2000-8-17 10:11:00, ID：311221

  procedure GetCurrentDoc(var theList: TStringList);
  var
    all:IHTMLElementcollection;
    doc:IHTMLDocument2;
    item:OleVariant;
  begin
      doc := Browser.document as ihtmldocument2;
      all:=doc.all;
      item:=all.item(0,varEmpty);

      //item.innerhtml是源文件的＜title＞到＜/body＞
      //item.outerhtml是全文

      theList.Add( item.innerhtml );
  end;
</font>  

來自：yeah, 時間：2000-8-18 1:49:00, ID：311996

終於進來了，各位老哥可能沒看清楚問題吧
我的意思是讓Twebbrowser從Stream或Buffer中讀取源文件並顯示.  

來自：an, 時間：2000-8-19 7:13:00, ID：312526

listen  

來自：yeah, 時間：2000-8-20 1:53:00, ID：313266

如果這個問題在D4下沒有辦法解決，那麼誰知道Rxlib(2.75)中的RxRichedit，已設置
Popupmenu,但在D5中編譯後無論如何也彈不出菜單來，我用Rxlib自帶的示範程序編譯後，
也是同樣的問題，請問是如何造成的，如何修改？  

來自：yeah, 時間：2000-8-22 1:26:00, ID：315097

沒有人知道嗎？  

來自：yeah, 時間：2000-8-23 0:32:00, ID：315857

請在D5下用Rxlib的朋友幫助試一下，謝謝！  

來自：Chenlili, 時間：2000-8-23 1:51:00, ID：315905

---- 爲了實現在自己的程序中顯示HTML文檔，我們一般採用IE(Internet Explorer本文中簡稱爲IE)發行時附帶的一個ActiveX控件TWebBrowser。這個控件使用和IE相同的內核，功能強大，並從Delphi5開始，正式得到Inprise公司的支持，取代了原來的那個THTML控件，成爲Delphi中顯示HTML文檔的首選控件。

---- 但是在實際編程過程中，我發現這個控件提供的功能有很多限制，比如對HTML文檔的瀏覽，只能通過指定URL或文件名來實現，不能像以往使用THTML控件那樣直接讀寫HTML源碼。因此如果程序動態生成了一段HTML文本，就必須把文本內容先寫到一個臨時文件，然後再將此文件的文件名傳遞給WebBrowser控件，實現顯示。走這一個彎路使程序響應速度受到很大影響，而且容易遺留下一些"垃圾"(臨時文件)。

---- 在考察了一些使用了WebBrowser控件的程序後，我發現大部分程序，如著名國產軟件FoxMail，都是使用的通過臨時文件傳遞HTML文檔的方法；但一些國外的軟件，如MS自己的OutLook Express則不存在這個問題，而因爲其無需產生臨時文件，因此對HTML文檔的顯示速度明顯超過Foxmail。

---- 爲此，我查閱了一些相關資料，最後在網友的幫助下找到了實現直接訪問WebBrowser控件中的HTML源碼的方法。在此要特別感謝白雲黃鶴BBS(bbs.whnet.edu.cn)上的網友AngleFalls提供線索。

---- 其實，WebBrowser控件中的Document對象，這個對象提供了一個IPersistStreamInit接口，通過此接口，我們可以方便地實現對HTML源碼的讀寫。

---- 以下是IPersistStreamInit接口的相關定義及說明：

{ 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;

首先來實現寫，因爲這是最迫切的要求：
procedure 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;

---- 首先，此過程需要的兩個參數，WebBrowser是顯示目的控件，Html是需要顯示的HTML源碼；然後，先檢查WebBrowser.Document對象是否有效，無效則退出；接着在系統全局堆裏分配一塊內存，將需要顯示的HTML源碼複製進去。這是因爲下一步需要建立一個WebBrowser控件可以讀取的流。GlobalAlloc函數的參數GPTR表示需要分配一塊固定的以0初始化過的內存區域，如果分配失敗則返回0，則通過RaiseLastWin32Error函數引發一個異常，提示用戶；然後用CreateStreamOnHGlobal函數建立一個基於全局堆內存塊的流，第二個參數如果爲True則流在釋放時自動釋放所佔全局堆內存。如果建立成功則此流和剛剛建立的內存塊共用同一塊內存區域。接着用WebBrowser.Document.QueryInterface函數建立一個IPersistStreamInit接口。然後就可以直接使用此接口，psi.InitNew初始化狀態；psi.Load(Stream)從流中載入HTML源碼。
---- 至此，以Html參數指定的HTML源碼就在WebBrowser參數指定的控件中顯示出來。

---- 值得注意的是，每個關於COM接口的函數調用，也就是那些返回類型爲HResult的函數，都必須以OleCheck包裝，因爲一個不檢查返回狀態的COM接口操作實在太危險了；此外接口的釋放，雖然Delphi可以在後臺自動完成，但作爲一個好的編程習慣，還是應該顯式地手工釋放，釋放只需將接口設爲nil即可。

---- 接着來實現HTML源碼的讀：

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;

---- 此函數有一個參數WebBrowser指定從那個控件讀取HTML源碼，返回一個字符串爲此控件中的HTML源碼。首先還是要先檢查WebBrowser.Document對象是否有效，無效則退出；然後取得IPersistStreamInit接口；接着取得HTML源碼的大小：本來應該使用IPersistStreamInit接口的GetSizeMax函數，但在我的機器上測試，這個函數範圍值衡爲0，無效。因此只能先定義一個足夠大的緩衝區，如BufSize = $10000字節(注意此緩衝區應該足夠大)；然後同樣地分配全局堆內存塊，建立流，然後將HTML文本寫到流中。因爲此HTML文本在流中是以#0結尾的字符串，因此可以用Size := StrLen(PChar(hHTMLText))取得實際長度，用SetLength(Result, Size);設置返回字符串長度爲HTML源碼實際長度，最後複製字符串到返回字符串中。
---- 至此，直接訪問WebBrowser控件中的HTML源碼所需的兩個函數全部解析完畢。

---- 不過需要注意的時，在使用這兩個函數前，最好對WebBrowser.Document對象進行初始化。下面提供一個函數，通過顯示一個空白頁面實現WebBrowser.Document對象初始化。

procedure ShowBlankPage(WebBrowser:
TWebBrowser);
var
URL: OleVariant;
begin
URL := 'about:blank';
WebBrowser.Navigate2(URL);
end;

  

來自：yeah, 時間：2000-8-25 0:18:00, ID：317765

to Chenlili:
您抄的這張貼子我早就看過了，在D4+IE4中不行。  

來自：CathyEagle, 時間：2000-8-26 16:33:00, ID：319177

太簡單了，這樣怎麼樣？我的是D5+IE5.5。
var
   DoC: IHTMLDocument2;
begin
   Doc := WebBrowser1.Document as IHTMLDocument2;
   Memo1.Lines.Add(Doc.body.outerhtml);     //讀源碼
   Memo1.Lines.Add(Doc.body.outerText);     //Html To Text
end;  

來自：swanheart, 時間：2000-8-29 22:43:00, ID：321615

》》誰知道Rxlib(2.75)中的RxRichedit，已設置
Popupmenu,但在D5中編譯後無論如何也彈不出菜單來，我用Rxlib自帶的示範程序編譯後，
也是同樣的問題，請問是如何造成的，如何修改？
可變通如下：
procedure TForm1.RxRichEdit1DblClick(Sender: TObject);
var
x,y:integer;
lppoint:Tpoint;

begin

   Getcursorpos(lppoint);
   x:=lppoint.x;
   y:=lppoint.y;
RxPopupMenu1.Popup (x,y);
end;
  

來自：swanheart, 時間：2000-8-29 22:54:00, ID：321619

》》誰知道Rxlib(2.75)中的RxRichedit，已設置
Popupmenu,但在D5中編譯後無論如何也彈不出菜單來，我用Rxlib自帶的示範程序編譯後，
也是同樣的問題，請問是如何造成的，如何修改？
哪位大蝦知道，請賜教！


  

來自：swanheart, 時間：2000-8-29 23:17:00, ID：321636

》》誰知道Rxlib(2.75)中的RxRichedit，已設置
Popupmenu,但在D5中編譯後無論如何也彈不出菜單來，我用Rxlib自帶的示範程序編譯後，
也是同樣的問題，請問是如何造成的，如何修改？
哪位大蝦知道，請賜教！


  

來自：swanheart, 時間：2000-8-30 22:00:00, ID：322323

我找到了:
在//BORLAND/DELPHI5/RX/UNIT/RXRICHED.PAS中:
{$IFDEF RX_D5}
procedure TRxCustomRichEdit.WMRButtonUp(var Message: TMessage);
begin
  { RichEd20 does not pass the WM_RBUTTONUP message to defwndproc, }
  { so we get no WM_CONTEXTMENU message. Simulate message here.    }
  if Win32MajorVersion <5 then
    Perform(WM_CONTEXTMENU, Handle, LParam(PointToSmallPoint(
      ClientToScreen(SmallPointToPoint(TWMMouse(Message).Pos)))));
  inherited;
end;
{$ENDIF}
修改爲:
{$IFDEF RX_D5}
procedure TRxCustomRichEdit.WMRButtonUp(var Message: TMessage);
begin
  { RichEd20 does not pass the WM_RBUTTONUP message to defwndproc, }
  { so we get no WM_CONTEXTMENU message. Simulate message here.    }
  if Win32MajorVersion <= 5 then
    Perform(WM_CONTEXTMENU, Handle, LParam(PointToSmallPoint(
      ClientToScreen(SmallPointToPoint(TWMMouse(Message).Pos)))));
  inherited;
end;
{$ENDIF}
因爲DELPHI5用WM_CONTEXTMENU響應彈出菜單.  

來自：swanheart, 時間：2000-8-30 22:03:00, ID：322325

我找到了:
在//BORLAND/DELPHI5/RX/UNIT/RXRICHED.PAS中:
{$IFDEF RX_D5}
procedure TRxCustomRichEdit.WMRButtonUp(var Message: TMessage);
begin
  { RichEd20 does not pass the WM_RBUTTONUP message to defwndproc, }
  { so we get no WM_CONTEXTMENU message. Simulate message here.    }
  if Win32MajorVersion <5 then
    Perform(WM_CONTEXTMENU, Handle, LParam(PointToSmallPoint(
      ClientToScreen(SmallPointToPoint(TWMMouse(Message).Pos)))));
  inherited;
end;
{$ENDIF}
修改爲:
{$IFDEF RX_D5}
procedure TRxCustomRichEdit.WMRButtonUp(var Message: TMessage);
begin
  { RichEd20 does not pass the WM_RBUTTONUP message to defwndproc, }
  { so we get no WM_CONTEXTMENU message. Simulate message here.    }
  if Win32MajorVersion <= 5 then
    Perform(WM_CONTEXTMENU, Handle, LParam(PointToSmallPoint(
      ClientToScreen(SmallPointToPoint(TWMMouse(Message).Pos)))));
  inherited;
end;
{$ENDIF}
因爲DELPHI5用WM_CONTEXTMENU響應彈出菜單.