(转自:http://hi.baidu.com/xiaoqing2305/blog/item/6a64398103472ef8bd3e1e2d.html)
在程序开发中遇到跨域访问提示“拒绝访问”,过网上查找,自己实际测试写出得方法能够实现写文本域,但是个人感觉很麻烦,不知道是 不是最佳办法,写出来分享一下,如果有好的处理方法请大家多多指正!
HTML页面代码如下:
1、主页面main.html
<html>
<title>信息系统</title>
<body>
<iframe name="bodyFrame" height="510" width="610" src="iframe.html"></iframe>
</body>
</html>
2、iframe.html
<html>
<title>应用模板</title>
<body>
<iframe name="module" height="500" width="600" src="http://www.baidu.com"></iframe>
</body>
</html>
3、百度首页中的标题是‘百度一下,你就知道’;文本框的name为‘wd’;delphi 代码如下:
uses ActiveX, MSHTML, SHdocvw,
共用方法:
procedure TfrmDSNet.GetDocumentPtrFromWnd(Wnd: HWND; var pDoc: IHTMLDocument2);
type
TObjectFromLResult = function(LRESULT: LRESULT; const IID: TGUID; wParam: WPARAM; out PObject): HRESULT; stdcall;
var
GetDocPtr: TObjectFromLResult;
hModule: THandle;
Msg: Cardinal;
lRes: Cardinal;
begin
hModule := LoadLibrary('OLEACC.DLL');
try
if hModule <> 0 then
begin
GetDocPtr := GetProcAddress(hModule, 'ObjectFromLresult');
if @GetDocPtr <> nil then
begin
Msg := RegisterWindowMessage('WM_HTML_GETOBJECT');
SendMessageTimeOut(Wnd, Msg, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes);
if GetDocPtr(lRes, IID_IHTMLDocument2, 0, pDoc) <> S_OK then
begin
pDoc := nil;
end;
end;
end;
finally
FreeLibrary(hModule);
end;
end;
非跨域访问方法
function TfrmDSNet.WriteHtmlFrameElement(sArgMsg: string): Boolean;
var
h: HWND;
doc: IHTMLDocument2;
area: IHTMLInputElement;
i, j: Integer;
iDx, jDx: OleVariant;
FrameDis, FrameDisChild: IDispatch;
FrameWin, FrameWinChild: IHTMLWindow2;
begin
Result := False;
try
// 查找相应页面的句柄,由于IE6默认追加的标题名有的是Windows Internet Explorer,
// 有的是Microsoft Internet Explorer,为了适应两种情况,做了如下的处理
h := FindWindow(‘IEFrame', '信息系统 - Windows Internet Explorer');
if h = 0 then
h := FindWindow('IEFrame', ‘信息系统 - Microsoft Internet Explorer’);
h := FindWindowEx(h, 0, 'Shell DocObject View', nil);
h := FindWindowEx(h, 0, 'Internet Explorer_Server', nil);
if h <> 0 then
begin
GetDocumentPtrFromWnd(h, doc);
if doc = nil then
Exit;
for i := 0 to doc.frames.length - 1 do
begin
iDx := i;
FrameDis := doc.frames.item(iDx);
if FrameDis.QueryInterface(IHTMLWindow2, FrameWin) <> 0 then
Exit;
if FrameWin.name <> 'bodyFrame' then
Continue;
for j := 0 to FrameWin.document.frames.length - 1 do
begin
jDx := j;
FrameDisChild := FrameWin.document.frames.item(jDx);
if FrameDisChild.QueryInterface(IHTMLWindow2, FrameWinChild) <> 0 then
Exit;
if FrameWinChild.name <> 'module' then // 此处报错‘拒绝访问’
Continue;
FrameWinChild.document.all.item(‘wd’, 0).QueryInterface(IHTMLInputElement, area);
if area <> nil then
begin
area.value := sArgMsg;
Result := True;
end;
end;
end;
end;
except
on E: Exception do
MessageBox(Application.Handle,
PChar(Format('出现异常:%s',[E.Message])),
'提示', 0);
end;
end;
跨域访问方法
function TfrmDSNet.WriteHtmlFrameElement(sArgMsg: string): Boolean;
var
h: HWND;
doc, docFrame, docFrameChild: IHTMLDocument2;
area: IHTMLInputElement;
i, j: Integer;
iDx, jDx: OleVariant;
FrameDis, FrameDisChild: IDispatch;
FrameWin, FrameWinChild: IHTMLWindow2;
psi, psiChild: IServiceProvider;
frameb, framebChild: IWebBrowser2;
begin
Result := False;
try
// 查找相应页面的句柄,由于IE6默认追加的标题名有的是Windows Internet Explorer,
// 有的是Microsoft Internet Explorer,为了适应两种情况,做了如下的处理
h := FindWindow(‘IEFrame', '信息系统 - Windows Internet Explorer');
if h = 0 then
h := FindWindow('IEFrame', ‘信息系统 - Microsoft Internet Explorer’);
h := FindWindowEx(h, 0, 'Shell DocObject View', nil);
h := FindWindowEx(h, 0, 'Internet Explorer_Server', nil);
if h <> 0 then
begin
GetDocumentPtrFromWnd(h, doc);
if doc = nil then
Exit;
for i := 0 to doc.frames.length - 1 do
begin
iDx := i;
FrameDis := doc.frames.item(iDx);
if FrameDis.QueryInterface(IHTMLWindow2, FrameWin) <> S_OK then
Continue;
if FrameWin.QueryInterface(IServiceProvider, psi) <> S_OK then
Continue;
if psi.QueryService(IID_IWebBrowserApp, IID_IWebBrowser2, frameb) <> S_OK then
Continue;
if frameb.Document.QueryInterface(IID_IHTMLDocument2, docFrame) <> S_OK then
Continue;
if docFrame.title <> '应用模板' then // 由于读frame 的 name 报错,只好用 title 判断了
Continue;
for j := 0 to docFrame.frames.length - 1 do
begin
jDx := j;
FrameDisChild := docFrame.frames.item(jDx);
if FrameDisChild.QueryInterface(IHTMLWindow2, FrameWinChild) <> S_OK then
Continue;
if FrameWinChild.QueryInterface(IServiceProvider, psiChild) <> S_OK then
Continue;
if psiChild.QueryService(IID_IWebBrowserApp, IID_IWebBrowser2, framebChild) <> S_OK then
Continue;
if framebChild.Document.QueryInterface(IID_IHTMLDocument2, docFrameChild) <> S_OK then
Continue;
if docFrameChild.title <> '百度一下,你就知道' then
Continue;
try
if docFrameChild.all.item('wd', 0).QueryInterface(IHTMLInputElement, area) = S_OK then
begin
area.value := sArgMsg;
Result := True;
end;
except
end;
end;
end;
end;
except
on E: Exception do
MessageBox(Application.Handle,
PChar(Format('出现异常:%s',[E.Message])),
'提示', 0);
end;
end;