登录 用户中心() [退出] 后台管理 注册
 

热门搜索:
您的位置:首页 >> 马上代码 >> 马上代码 >> 主题: ...get the HTML Code out of all Internet Explorer Instances?
标题 ...get the HTML Code out of all Internet Explorer Instances?
clq
浏览(1929) 2006-03-24 02:00:13 发表 编辑

关键字:

http://www.swissdelphicenter.ch/torry/showcode.php?id=1615
--------------------------------------------------
...get the HTML Code out of all Internet Explorer Instances?      
Author: Thomas Stutz      
3 Comments to this tip [Write new comment]      
[ Print tip ]                  

Tip Rating (21):            
         



uses
MSHTML_TLB, ActiveX;


function GetHTMLCode(WB: IWebbrowser2; ACode: TStrings): Boolean;
var
ps: IPersistStreamInit;
s: string;
ss: TStringStream;
sa: IStream;
begin
ps := WB.document as IPersistStreamInit;
s := '';
ss := TStringStream.Create(s);
try
  sa:= TStreamAdapter.Create(ss, soReference) as IStream;
  Result := Succeeded(ps.Save(sa, Bool(True)));
  if Result then ACode.Add(ss.Datastring);
finally
  ss.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
ShellWindow: IShellWindows;
WB: IWebbrowser2;
spDisp: IDispatch;
IDoc1: IHTMLDocument2;
k: Integer;
begin
ShellWindow := CoShellWindows.Create;
// get the running instance of Internet Explorer
for k := 0 to ShellWindow.Count do
begin
  spDisp := ShellWindow.Item(k);
  if spDisp = nil then Continue;
  // QueryInterface determines if an interface can be used with an object
  spDisp.QueryInterface(iWebBrowser2, WB);
  if WB <> nil then
  begin
  WB.Document.QueryInterface(IHTMLDocument2, iDoc1);
  if iDoc1 <> nil then
  begin
    WB := ShellWindow.Item(k) as IWebbrowser2;
    begin
      // Add HTML Code to Memo
      Memo1.Lines.Add('****************************************');
      Memo1.Lines.Add(WB.LocationURL);
      Memo1.Lines.Add('****************************************');
      GetHTMLCode(WB, Memo1.Lines);
    end;
  end;
  end;
end;
end;

clq
2006-3-24 2:11:28 发表 编辑

下面是发展而来的完整代码.
function GetHTMLCode2(WB: TWebBrowser): string;
var
ps: IPersistStreamInit;
s: string;
ss: TStringStream;
sa: IStream;
r:boolean;
begin
ps := WB.document as IPersistStreamInit;
s := '';
ss := TStringStream.Create(s);
try
sa:= TStreamAdapter.Create(ss, soReference) as IStream;
r := Succeeded(ps.Save(sa, Bool(True)));
if r then result:=ss.Datastring;
finally
ss.Free;
end;
end;

guest
2017-11-08 10:39:43 发表 编辑


guest
2018-02-21 06:51:09 发表 编辑


guest
2018-04-17 14:10:57 发表 编辑


guest
2019-05-09 05:25:03 发表 编辑


guest
2019-08-21 03:14:24 发表 编辑


guest
2019-08-22 18:27:53 发表 编辑


guest
2019-09-29 04:53:48 发表 编辑


guest
2023-10-19 00:25:35 发表 编辑



总数:9 页次:1/1 首页 尾页  


发表评论:
文本/html模式切换 插入图片 文本/html模式切换


附件:




Copyright © 2005-2012 CLQ工作室, All Rights Reserved

CLQ工作室 版权所有