delphi读写跨域页面文本域(IE6)在程序开发中遇到跨域访问提示“拒绝访问”,过网上查找,自己实际测试写出得方法能够实现写文本域,但是个人感觉很麻烦,不知道是 不是最佳办法,写出来分享一下,如果有好的处理方法请大家多多指正! <html> <title>信息系统</title> <body> <iframe name="bodyFrame" height="510" width="610" src="iframe.html"></iframe> </body> </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 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; |
|