[转]save all TWebbrowser Frame Sources?
注:有一定的参考价值,转存
// 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?的更多相关文章
- linux内核调试指南
linux内核调试指南 一些前言 作者前言 知识从哪里来 为什么撰写本文档 为什么需要汇编级调试 ***第一部分:基础知识*** 总纲:内核世界的陷阱 源码阅读的陷阱 代码调试的陷阱 原理理解的陷阱 ...
- Linux Kernel - Debug Guide (Linux内核调试指南 )
http://blog.csdn.net/blizmax6/article/details/6747601 linux内核调试指南 一些前言 作者前言 知识从哪里来 为什么撰写本文档 为什么需要汇编级 ...
- 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 ...
- ORB-SLAM2 运行 —— ROS + Android 手机摄像头
转载请注明出处,谢谢 原创作者:Mingrui 原创链接:https://www.cnblogs.com/MingruiYu/p/12404730.html 本文要点: ROS 配置安装 解决 sud ...
- Idea使用指南--实用版
idea使用指南--基础配置: 视频链接:https://www.bilibili.com/video/av21735428/?p=1 idea安装: 快捷方式create destop shortc ...
- pycharm快捷键及一些常用设置
pycharm快捷键及一些常用设置,有需要的朋友可以参考下. Alt+Enter 自动添加包 Ctrl+t SVN更新 Ctrl+k SVN提交 Ctrl + / 注释(取消注释)选择的行 Ctrl+ ...
- PhpStorm 8.x/9.x 快捷键设置/个性化设置,如何多项目共存?如何更换主题?
1."自定义"常用快捷键(设置成跟Eclipse差不多) 按照路径:File -> Settings -> Appearance & Behavior -> ...
- pycharm快捷键、常用设置、包管理
pycharm快捷键.常用设置.包管理 在PyCharm安装目录 /opt/pycharm-3.4.1/help目录下可以找到ReferenceCard.pdf快捷键英文版说明 or 打开pychar ...
- phpstorm使用手册
参考:http://www.cnblogs.com/luojianqun/p/4596052.html 罗总说这是php最好的IDE,phpstorm9.02,没有之一.各种功能各种好,罗总此等大神说 ...
随机推荐
- Web存储-Web Storage
/* // 如下是initStorageEvent()方法参数,其中两个参数我默认写成false了,一般都不用改动 initStorageEvent(eventType, false, false, ...
- ZTE交换路由设备配置的备份与恢复
一.TFTP服务器搭建 使用用户计算机搭建TFTP服务器,交换路由设备作为TFTP客户端. 运行TFTPServer.exe,该程序所在的目录为TFTP的根目录. 请保证您的TFTP可以Ping通所要 ...
- 自动化测试工具——JMeter
Apache JMeter是Apache组织开发的基于Java的压力测试工具.用于对软件做压力测试,它最初被设计用于Web应用测试,但后来扩展到其他测试领域. 它可以用于测试静态和动态资源,例如静态文 ...
- linq join的lambda写法
var query = _db.Bank_CommercialOpus .Join(_db.Bank_Opus, s => s.OpusID, Opus => Opus.ID, (s, O ...
- Windows 下TortoiseGit 设置避免每次登录帐号密码
TortoiseGit ->Settings 1.选择设置的git目录 2.输入登录帐号与email 3.点击Edit global.gitconfig 编辑,将文本 [credential] ...
- hive --service metastore 出现的问题
Could not create ServerSocket on address 0.0.0.0/0.0.0.0:9083 执行命令jps root@hadoopm:/usr# jps1763 Res ...
- 远程连接服务器for Linux
远程连接Linux云服务器-命令行模式 1.远程连接工具.目前Linux远程连接工具有很多种,您可以选择顺手的工具使用.下面使用的是名为Putty的Linux远程连接工具.该工具是免费的,且不需要安装 ...
- MySql常用日期函数(转载)
/*date_add(date,interval expr type)和date_sub(date,interval expr type)执行日期运算. date 是一个 datetime 或date ...
- linux io stack
- 查看apache、linux、kernel、nginx等版本
查看apache版本 /usr/sbin/apachectl -v httpd -v 安装目录,使用apachectl -v 查看mysql版本 mysql –help | grep Distri ...