delphi 获取含跨域网址的框架网页的源码
前面介绍过的获取框架网页的源码的方法在针对框架中每个文档的URL都是和主网页在同一个域名（同一个网站）的情况下是不会出什么问题的，但如果框架包含的网页是别的域的话，例如以下网页：该网页含左右两个框架，都包含别的域的网址，该网页源码如下：
框架网页
<body><br />
</body><br />
如果使用以下的代码获取这两个框架的网页源码：
procedure TForm1.Button1Click(Sender: TObject);
var
doc, framedoc: IHTMLDocument2;
frame_dispatch: IDispatch;
ole_index: OleVariant;
i: Integer;
begin
doc := WebBrowser1.Document as IHTMLDocument2;
if doc = nil then Exit;
for i := 0 to doc.frames.length - 1 do
begin
ole_index := i;
frame_dispatch := doc.frames.item(ole_index);
if frame_dispatch = nil then Continue;
framedoc := (frame_dispatch as IHTMLWindow2).document;
if framedoc = nil then Continue;
ShowMessage(framedoc.body.innerHTML);
end;
end;
执行这段代码，系统会弹出“拒绝访问”的出错对话框，没有任何商量的余地。怎么办，框架网页的源码还是要获取的，不会因为跨域问题而放弃的。只有百度一下了，几番搜索，终于找到了另一种获取网页源码的方法，而这种方法可以解决跨域问题，方法如下：
1. 单元引用 Uses MsHtml, ActiveX
2. 代码：
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
ole_index: OleVariant;
FrameDis: IDispatch;
FrameWin: IHtmlWindow2;
psi:IServiceProvider;
frameb: IWebBrowser2;
pPersist: IPersistStreamInit;
ss: TStringStream;
str1, str2: String;
begin
if WebBrowser1.Busy then Exit;
Memo1.Lines.Clear;
//获取主网页网址
Memo1.Lines.Add(WebBrowser1.OleObject.document.url);
//获取主网页源码
Memo1.Lines.Add(WebBrowser1.OleObject.document.documentElement.outerHTML);
//添加空行
Memo1.Lines.Add(' ');
for i := 0 to WebBrowser1.OleObject.document.frames.length - 1 do
begin
ole_index := i;
FrameDis := (WebBrowser1.Document as IHtmlDocument2).frames.item(ole_index);
FrameDis.QueryInterface(IID_IHTMLWindow2, FrameWin) ;
if FrameWin = nil then Continue;
FrameWin.QueryInterface(IServiceProvider, psi);
if psi = nil then Continue;
psi.QueryService(IID_IWebBrowserApp,IID_IWebBrowser2,frameb);
if frameb=nil then continue;
frameb.Document.QueryInterface(IPersistStreamInit, pPersist);
if pPersist = nil then Continue;
//获取框架页网址
Memo1.Lines.Add((frameb.Document as IHtmlDocument2).url);
ss := TStringStream.Create('');
try
//获取框架页源码
if Succeeded(pPersist.Save(TStreamAdapter.Create(ss), True)) then
begin
str1 := ss.DataString;
str2 := Utf8ToAnsi(str1); //有些网页使用UTF-8编码方式，不进行转换中文会乱码
if str2 = '' then
Memo1.Lines.Add(str1)
else
Memo1.Lines.Add(str2);
end;
finally
FreeAndNil(ss);
end;
Memo1.Lines.Add(' '); //添加空行
end;
end;
如果使用以下的代码获取这两个框架的网页源码：
procedure TForm1.Button1Click(Sender: TObject);
var
doc, framedoc: IHTMLDocument2;
frame_dispatch: IDispatch;
ole_index: OleVariant;
i: Integer;
begin
doc := WebBrowser1.Document as IHTMLDocument2;
if doc = nil then Exit;
for i := 0 to doc.frames.length - 1 do
begin
ole_index := i;
frame_dispatch := doc.frames.item(ole_index);
if frame_dispatch = nil then Continue;
framedoc := (frame_dispatch as IHTMLWindow2).document;
if framedoc = nil then Continue;
ShowMessage(framedoc.body.innerHTML);
end;
end;
执行这段代码，系统会弹出“拒绝访问”的出错对话框，没有任何商量的余地。怎么办，框架网页的源码还是要获取的，不会因为跨域问题而放弃的。只有百度一下了，几番搜索，终于找到了另一种获取网页源码的方法，而这种方法可以解决跨域问题，方法如下：
1. 单元引用 Uses MsHtml, ActiveX
2. 代码：
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
ole_index: OleVariant;
FrameDis: IDispatch;
FrameWin: IHtmlWindow2;
psi:IServiceProvider;
frameb: IWebBrowser2;
pPersist: IPersistStreamInit;
ss: TStringStream;
str1, str2: String;
begin
if WebBrowser1.Busy then Exit;
Memo1.Lines.Clear;
//获取主网页网址
Memo1.Lines.Add(WebBrowser1.OleObject.document.url);
//获取主网页源码
Memo1.Lines.Add(WebBrowser1.OleObject.document.documentElement.outerHTML);
//添加空行
Memo1.Lines.Add(' ');
for i := 0 to WebBrowser1.OleObject.document.frames.length - 1 do
begin
ole_index := i;
FrameDis := (WebBrowser1.Document as IHtmlDocument2).frames.item(ole_index);
FrameDis.QueryInterface(IID_IHTMLWindow2, FrameWin) ;
if FrameWin = nil then Continue;
FrameWin.QueryInterface(IServiceProvider, psi);
if psi = nil then Continue;
psi.QueryService(IID_IWebBrowserApp,IID_IWebBrowser2,frameb);
if frameb=nil then continue;
frameb.Document.QueryInterface(IPersistStreamInit, pPersist);
if pPersist = nil then Continue;
//获取框架页网址
Memo1.Lines.Add((frameb.Document as IHtmlDocument2).url);
ss := TStringStream.Create('');
try
//获取框架页源码
if Succeeded(pPersist.Save(TStreamAdapter.Create(ss), True)) then
begin
str1 := ss.DataString;
str2 := Utf8ToAnsi(str1); //有些网页使用UTF-8编码方式，不进行转换中文会乱码
if str2 = '' then
Memo1.Lines.Add(str1)
else
Memo1.Lines.Add(str2);
end;
finally
FreeAndNil(ss);
end;
Memo1.Lines.Add(' '); //添加空行
end;
end;
推荐分享
图文皆来源于网络，内容仅做公益性分享，版权归原作者所有，如有侵权请告知删除！
Copyright © 2014 DelphiW.com 开发 源码 文档 技巧 All Rights Reserved
晋ICP备14006235号-8 晋公网安备 14108102000087号
执行时间: 0.12612009048462 seconds