注:有一定的参考价值,转存

// Code 1

uses
  
ActiveX, MSHTML_TLB, ComCtrls, ComObj;

function GetBrowserForFrame(Doc: IHTMLDocument2; nFrame: Integer): IWebBrowser2;
  //Thanks to Rik Barker
  //returns an interface to the frame's browser
var
  
pContainer: IOLEContainer;
  enumerator: ActiveX.IEnumUnknown;
  nFetched: PLongInt;
  unkFrame: IUnknown;
  hr: HRESULT;
begin
  
Result := nil;
  nFetched := nil;
  // Cast the page as an OLE container
  
pContainer := Doc as IOleContainer;
  // Get an enumerator for the frames on the page
  
hr := pContainer.EnumObjects(OLECONTF_EMBEDDINGS or OLECONTF_OTHERS, enumerator);
  if hr <> S_OK then
  begin
    
pContainer._Release;
    Exit;
  end;
  // Now skip to the frame we're interested in
  
enumerator.Skip(nFrame);
  // and get the frame as IUnknown
  
enumerator.Next(1,unkFrame, nFetched);
  // Now QI the frame for a WebBrowser Interface - I'm not  entirely
  // sure this is necessary, but COM never ceases to surprise me
  
unkframe.QueryInterface(IID_IWebBrowser2, Result);
end;

function GetFrameSource(WebDoc: iHTMLDocument2): string;
  //returns frame HTML and scripts as a text string
var
  
re: integer;
  HTMLel: iHTMLElement;
  HTMLcol: iHTMLElementCollection;
  HTMLlen: Integer;
  ScriptEL: IHTMLScriptElement;
begin
  
Result := '';
  if Assigned(WebDoc) then
  begin
    
HTMLcol := WebDoc.Get_all;
    HTMLlen := HTMLcol.Length;
    for re := 0 to HTMLlen - 1 do
    begin
      
HTMLel := HTMLcol.Item(re, 0) as iHTMLElement;
      if HTMLEl.tagName = 'HTML' then
        
Result := Result + HTMLEl.outerHTML;
    end;
  end;
end;

function WB_SaveFrameToFile(HTMLDocument: IHTMLDocument2;
  const FileName: TFileName): Boolean;
// Save IHTMLDocument2 to a file
var
  
PersistFile: IPersistFile;
begin
  
PersistFile := HTMLDocument as IPersistFile;
  PersistFile.Save(StringToOleStr(FileName), System.True);
end;

function SaveWBFrames(WebBrowser1: TWebBrowser): string;
// return the source for all frames in the browser
var
  
Webdoc, HTMLDoc: ihtmldocument2;
  framesCol: iHTMLFramesCollection2;
  FramesLen: integer;
  pickFrame: olevariant;
  p: integer;
begin
  try
    
WebDoc := WebBrowser1.Document as IHTMLDocument2;
    Result := GetFrameSource(WebDoc);

// §§§ Hier kann Result in eine Datei gespeichert werden §§§§  oder  mit
    // WB_SaveFrameToFile(WebDoc,'c:\MainPage.html');

//Handle multiple or single frames
    
FramesCol := WebDoc.Get_frames;
    FramesLen := FramesCol.Get_length;
    if FramesLen > 0 then
      for 
p := 0 to FramesLen - 1 do
      begin
        
pickframe := p;
        HTMLDoc   := WebBrowser1.Document as iHTMLDocument2;

WebDoc := GetBrowserForFrame(HTMLDoc, pickframe).document as iHTMLDocument2;
        if WebDoc <> nil then
        begin
          
Result := GetFrameSource(WebDoc);
          WB_SaveFrameToFile(WebDoc, 'c:\Frame' + IntToStr(p) + '.html');
          // ShowMessage(HTMLDoc.Get_parentWindow.Get_name);
          // ShowMessage(HTMLDoc.Get_parentWindow.Parent.Get_document.nameProp);

end;
      end;
  except
    
Result := 'No Source Available';
  end;
end;

// Test:

procedure TForm1.Button1Click(Sender: TObject);
begin
  
SaveWBFrames(Webbrowser1);
end;

// Code 2
uses
  
ActiveX;

function TForm1.GetFrame(FrameNo: Integer): IWebbrowser2;
var
  
OleContainer: IOleContainer;
  enum: IEnumUnknown;
  unk: IUnknown;
  Fetched: PLongint;
begin
  while 
Webbrowser1.ReadyState <> READYSTATE_COMPLETE do
    
Application.ProcessMessages;
  if Assigned(Webbrowser1.document) then
  begin
    
Fetched := nil;
    OleContainer := Webbrowser1.Document as IOleContainer;
    OleContainer.EnumObjects(OLECONTF_EMBEDDINGS, Enum);
    Enum.Skip(FrameNo);
    Enum.Next(1, Unk, Fetched);
    Result := Unk as IWebbrowser2;
  end
  else
    
Result := nil;
end;

// Load sample page
// Testseite laden
procedure TForm1.Button1Click(Sender: TObject);
begin
  
Webbrowser1.Navigate('http://www.warebizprogramming.com/tutorials/html/framesEx1.htm');
end;

// Save all frames in single files
// Alle Frameseiten in einzelne Dateien speichern
procedure TForm1.Button2Click(Sender: TObject);
var
  
IpStream: IPersistStreamInit;
  AStream: TMemoryStream;
  iw: IWebbrowser2;
  i: Integer;
  sl: TStringList;
begin
  for 
i := 0 to Webbrowser1.OleObject.Document.frames.Length - 1 do
  begin
    
iw := GetFrame(i);
    AStream := TMemoryStream.Create;
    try
      
IpStream := iw.document as IPersistStreamInit;
      if Succeeded(IpStream.save(TStreamadapter.Create(AStream), True)) then
      begin
        
AStream.Seek(0, 0);
        sl := TStringList.Create;
        sl.LoadFromStream(AStream);
        sl.SaveToFile('c:\frame' + IntToStr(i) + '.txt');
        //  memo1.Lines.LoadFromStream(AStream);
        
sl.Free;
      end;
    except
    end
;
    AStream.Free;
  end;
end;

end.

http://www.swissdelphicenter.ch/en/showcode.php?id=2054

[转]save all TWebbrowser Frame Sources?的更多相关文章

  1. linux内核调试指南

    linux内核调试指南 一些前言 作者前言 知识从哪里来 为什么撰写本文档 为什么需要汇编级调试 ***第一部分:基础知识*** 总纲:内核世界的陷阱 源码阅读的陷阱 代码调试的陷阱 原理理解的陷阱 ...

  2. Linux Kernel - Debug Guide (Linux内核调试指南 )

    http://blog.csdn.net/blizmax6/article/details/6747601 linux内核调试指南 一些前言 作者前言 知识从哪里来 为什么撰写本文档 为什么需要汇编级 ...

  3. PatentTips - Method and Apparatus to Support Virtualization with Code Patches

    BACKGROUND As recognized in Revision 2.0 of the Intel® Virtualization Technology Specification for t ...

  4. ORB-SLAM2 运行 —— ROS + Android 手机摄像头

    转载请注明出处,谢谢 原创作者:Mingrui 原创链接:https://www.cnblogs.com/MingruiYu/p/12404730.html 本文要点: ROS 配置安装 解决 sud ...

  5. Idea使用指南--实用版

    idea使用指南--基础配置: 视频链接:https://www.bilibili.com/video/av21735428/?p=1 idea安装: 快捷方式create destop shortc ...

  6. pycharm快捷键及一些常用设置

    pycharm快捷键及一些常用设置,有需要的朋友可以参考下. Alt+Enter 自动添加包 Ctrl+t SVN更新 Ctrl+k SVN提交 Ctrl + / 注释(取消注释)选择的行 Ctrl+ ...

  7. PhpStorm 8.x/9.x 快捷键设置/个性化设置,如何多项目共存?如何更换主题?

    1."自定义"常用快捷键(设置成跟Eclipse差不多) 按照路径:File -> Settings -> Appearance & Behavior -> ...

  8. pycharm快捷键、常用设置、包管理

    pycharm快捷键.常用设置.包管理 在PyCharm安装目录 /opt/pycharm-3.4.1/help目录下可以找到ReferenceCard.pdf快捷键英文版说明 or 打开pychar ...

  9. phpstorm使用手册

    参考:http://www.cnblogs.com/luojianqun/p/4596052.html 罗总说这是php最好的IDE,phpstorm9.02,没有之一.各种功能各种好,罗总此等大神说 ...

随机推荐

  1. libgdx 裁剪多边形(clip polygon、masking polygon)

    直接放例子代码,代码中以任意四边形为例,如果需要做任意多边形,注意libgdx不能直接用ShapeRender填充多边形,需要先切割成三角形. public static void drawClip( ...

  2. ios上position:fixed失效问题

    手机端上的猫腻真是多啊~~~ 此起彼伏! 最近又遇到了 固定定位的底部导航在ios上被弹出去 此时内心1w+个草泥马奔过~~~~~~~~ 直接上解决方案: <div class="ma ...

  3. iOS蓝牙开发CoreBluetooth快速入门

    在iOS开发中,实现蓝牙通信有两种方式,一种是使用传统的GameKit.framework,另一种就是使用在iOS 5中加入的CoreBluetooth.framework. 利用CoreBlueto ...

  4. centos 安装pptp

    1. 安装依赖 ppp yum -y install ppp 2. 编译安装pptpd wget http://jaist.dl.sourceforge.net/project/poptop/pptp ...

  5. mysql slave to master

    1, 在maste A上面创建专门用于备份的用户Bshow master statusget log_file and log_pos 2,CHANGE MASTER TO MASTER_HOST=' ...

  6. mapreduce性能提升2

    mapreduce性能提升2mapreduce性能提升2mapreduce性能提升2

  7. JS学习之路

    前言 接触js也有四五年的时间了,对js的认识也逐渐加深,想把自己这几年学习js的经历记录一下. 总则-都是对象,都是引用 在接触js前用的比较多的是java,在刚开始接触js的时候,老实讲,我是有点 ...

  8. jquery+ajax实现分页

    var curPage = 1; //当前页码 var total,pageSize,totalPage; //总记录数,每页显示数,总页数 getData(1); $("#pagecoun ...

  9. 南非的5DT数据手套使用说明

    数据手套-5 Ultra/数据手套-14 Ultra 5DT 数据手套-Ultra数据手套的设计目的是为了满足现代动作捕捉和动画制作等专业人士的严格要求.它提供了舒适,易于使用,小型要素和多种应用的驱 ...

  10. iOS设置cell选中时文字颜色的变化

    cell.titleStr.highlightedTextColor = EMCGreenColor;