delphi读写跨域页面文本域（IE6）

最新推荐文章于 2024-04-25 10:52:13 发布
最新推荐文章于 2024-04-25 10:52:13 发布
阅读量1.4k 收藏
点赞数
分类专栏： delphi xe2 学习 delphi webbrowser 文章标签： delphi ie internet microsoft exception integer

（转自：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;


t1122
关注
  • 0
    点赞
  • 踩
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
专栏目录
Delphi HttpServer跨域
04-03
Delphi HttpServer跨域 CustomHeadersStringList.Add('Access-Control-Allow-Origin:*'); AResponseInfo.CustomHeaders := CustomHeadersStringList;
xmlHttp ie6下不跨域还提示没有权限，ie8下不会有这错误
10-30
昨天晚上叫我好弄啊，最后发现原因是我url太长了，最后发现URL在2070B左右就不行了
Delphi开发IE中添加工具栏
weixin_34162629的博客
01-08 109
我们首先要建立一个ActiveX Library。将其保存为MailIEBand.Dpr；然后建立一个COM Object，将其保存为BandUnit.pas；然后建立一个Form，这个窗口将作为子窗口显示在IE工具栏中，将窗口的BorderStyle属性改为bsNone，添加一个TButton组件和一个TComboBox组件，将TButton的Caption属性改为获取全部，然后将窗口文件其保存...
免费沙箱软件模拟支付_CVE20193969：Comodo沙箱逃逸提权漏洞分析
weixin_28323057的博客
12-16 436
译文声明本文是翻译文章，文章原作者tenable-techblog，文章来源：medium.com原文地址：https://medium.com/tenable-techblog/comodo-from-sandbox-to-system-cve-2019-3969-b6a34cc85e67译文仅供参考，具体内容表达以及含义原文为准0x00 前言AV(反病毒软件)一直以来都是漏洞挖掘的绝...
delphi webbrowser 跨域访问
weixin_30338497的博客
07-17 156
procedure IterateFrames(const AWB: IWebBrowser2);var Doc: IHTMLDocument2; Container: IOleContainer; Enumerator: ActiveX.IEnumUnknown; Unknown: IUnknown; Browser: IWebBrowser2; Fetched: Longint; ...
Delphi IdHttpServer解决 Http请求跨域问题
重楼的博客
09-09 1203
//Response 增加允许跨域请求头属性，即可允许跨域访问 procedure TMain.idHttpServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); begin AResponseInfo.CustomHeaders.Add('Access-Control-Allow-Origin:*'); ARespo.
IE9 IE8 ajax跨域问题的快速解决方法
12-09
网上解决办法均是 在发起请求之前添加 jQuery.support.cors=true;...以上这篇IE9 IE8 ajax跨域问题的快速解决方法就是小编分享给大家的全部内容了，希望能给大家一个参考，也希望大家多多支持软件开发网。
IE8、IE9 Ajax 跨域解决办法
08-03
解决ie8、9Ajax跨域问题（前端）：jsp引入此js，Jquery Ajax正常写
Delphi自动提交网页表单和获取框架网页源码
diligentcat的专栏
12-10 2482
这两个问题的实现原理其实是差不多的，所以放在一起介绍，单元MSHtml封装了我们需要的功能。 首先，新建一个DELPHI工程，在USES部分添加MSHtml单元的引用。 然后，在窗体上放置一个TWebBrowser控件和四个按钮。 最后，编写四个按钮的响应代码： 1. 自动提交网页表单 procedure TForm1.Button1Click(Sender: T
MSAA，Oleacc.dll，Oleacc.pas，Oleacc.dcu
10-04
MS Active Accessibility 接口技术编程尝试 Delphi 源码 Oleacc.pas
DELPHI 抓取PDF内容
12-29
使用fpdfsdk.dll类库，通过DELPHI抓取PDF指定区域的文本内容
Delphi提取PDF文本实例
08-30
下面小编就为大家带来一篇Delphi提取PDF文本实例。小编觉得挺不错的，现在就分享给大家，也给大家做个参考。一起跟随小编过来看看吧
在TwebBrowser中调用隐藏的IE命令
laoli的专栏
11-04 1637
//命令句柄ID,是来自Shell DocObject View这个类const ID_IE_FILE_PAGESETUP           = 259;const ID_IE_FILE_PRINT               = 260;const ID_IE_FILE_NEWWINDOW           = 275;const ID_IE_FILE_PRINTPREVIEW       
Delphi通过IE窗口句柄获取网页接口（IWebBrowser2）
diligentcat的专栏
12-10 3011
主要用到的是MSAA(Microsoft Active Accessibility) 函数：ObjectFromLResult，该函数在动态链接库 oleacc.dll 中定义。 uses SHDocVw, MsHtml, ActiveX; type   TObjectFromLResult = function(LRESULT: lResult; const IID: TIID;
【微软押注ARM架构，“Wintel”联盟摇摇欲坠？】
weixin_44237705的博客
04-19 442
英伟达、AMD和联发科都计划为Windows平台推出基于ARM架构的芯片，另外三星则有可能会有对应的Exynos芯⽚，加上⾼通带来的骁⻰ X Elite，“百花齐放”的盛况将帮助Windows on ARM设备进⼊新阶段。不过从⽬前掌握的情况来看，⾼通的骁⻰ X Elite或许仍然是最强的竞争者，其引⼊了基于NUVIA技术的定制Oryon内核，放弃了以往基于ARM公版的设计，采⽤了台积电4nm⼯艺制造， 初步的测试结果显示有着不错的性能表现。2024年，对于PC产业而言也许将会是转折性的一年。
AI Agent新对决：LangGraph与AutoGen的技术角力
最新发布
2401_82452722的博客
04-25 948
个人认为这个“Graph”框架使其在构建更复杂和更有见地的工作流程时更具直观性和更好的开发体验，通过对“Graph”的定义，可以对一个 LLM 应用的处理过程进行非常细节的编排设计，从而满足大量复杂场景的 AI Agent 产业应用落地。当然，这一特征也是可选的，如果你不需要要时，就可以选择完全自动的模式。对于简单的问答系统，LCEL都能够提供快速且准确的服务，然而当面对一些更为复杂的任务时，就显得力不从心，因此需要一个具备更精细控制能力的框架来支持更复杂场景的LLM应用，它就是LangGraph。
设计模式- 中介者模式（Mediator）
m0_51176516的博客
04-23 1463
中介者模式（Mediator Pattern）是一种行为型设计模式，用于减少对象之间的直接相互依赖，使得对象间的交互通过一个中介者对象来进行协调。在中介者模式中，对象之间不再直接相互调用，而是通过中介者对象来传递消息和协调行为。 中介者模式的主要目的是简化对象之间的复杂交互关系，降低对象之间的耦合度，使得系统更加易于维护和扩展。通过将交互逻辑集中在一个中介者对象中，可以避免对象之间直接相互依赖和通信的混乱。 中介者模式适用于对象之间存在复杂网状结构关系，且这些关系导致依赖关系混乱和难以复用的场景。
【项目亮点】大厂中分布式事务的最佳实践 问题产生-＞难点与权衡(偏爱Saga)-＞解决方案
正直 的博客
04-19 587
不断有同学问我大厂中实践分布式事务的问题,这里从**分布式事务的产生**,到**强弱一致性与性能的权衡**,再到最终**落地的解决方案**,再到**实际的代码实现**,再到我工作中实际**使用SAGA模式的应用案例**,一篇文章讲清楚.

“相关推荐”对你有帮助么？

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值