webbrowser自动填表模板


本文整理自网络,侵删。

 自动填表

1.有框架

2.无框架


未完善:

有些框架还有问题,如三层框架等

代码见下:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,MSHTML, SHDOCVW,IdGlobal;

type
TMainFrm = class(TForm)
btnTest: TButton;
edURL: TEdit;
Label1: TLabel;
procedure btnTestClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
MainFrm: TMainFrm;

implementation

{$R *.dfm}
procedure FillIEForm(aURL:string);
procedure DoWithHtmlElement(aElementCollection:IHTMLElementCollection);
var
k:integer;
vk:oleVariant;
Dispatch: IDispatch;
HTMLInputElement:IHTMLInputElement;
HTMLSelectElement:IHTMLSelectElement;
HTMLOptionElement: IHTMLOptionElement;
HTMLTextAreaElement: IHTMLTextAreaElement;
HTMLFormElement:IHTMLFormElement;
HTMLOptionButtonElement:IHTMLOptionButtonElement;
begin
for k:=0 to aElementCollection.length -1 do
begin
Vk:=k;
Application.ProcessMessages;
Dispatch:=aElementCollection.item(Vk,0);
if Succeeded(Dispatch.QueryInterface(IHTMLInputElement,HTMLInputElement)) then
begin
With HTMLInputElement do//单行文本
begin
if (UpperCase(Type_)='TEXT') or (UpperCase(Type_)='PASSWORD') then
begin
value:='text';
end
else if (UpperCase(Type_)='CHECKBOX') then//复选框
begin
checked:=true;
end
else if (UpperCase(Type_)='RADIO') then//单选框
begin
checked :=true;
end;
end;
end
else if Succeeded(Dispatch.QueryInterface(IHTMLSelectElement,HTMLSelectElement)) then
begin
With HTMLSelectElement do//下拉框
begin
selectedIndex :=1;
end;
end
else if Succeeded(Dispatch.QueryInterface(IHTMLTEXTAreaElement,HTMLTextAreaElement)) then
begin
with HTMLTextAreaElement do//多行文本
begin
value :='textarea';
end;
end
else if Succeeded(Dispatch.QueryInterface(IHTMLOptionElement,HTMLOptionElement)) then
begin
with HTMLOptionElement do//下拉选项
begin
//处理
end;
end
else if SUCCEEDED(Dispatch.QueryInterface(IHTMLFormElement,HTMLFormElement))then
begin
with HTMLFormElement do//表单
begin
//处理
end;
end
else if SUCCEEDED(Dispatch.QueryInterface(IHTMLOptionButtonElement,HTMLOptionButtonElement))then
begin
//不明
//处理
end
else
//showmessage('other');
;
end;
end;
var
ShellWindow: IShellWindows;
Web: IWebBrowser2;
Dispatch: IDispatch;
i,j:integer;
IEAddress:string;
HTMLDocument:IHTMLDocument2;
ElementCollection:IHTMLElementCollection;
FrameWindow:IHTMLWindow2;
Vi,Vj:OLEVariant;
HTMLFrameBase :IHTMLFrameBase ;
HTMLFrameElement:IHTMLFrameElement ;
HTMLIFrameElement:IHTMLIFrameElement;
begin
ShellWindow := CoShellWindows.Create;
for i:=0 to ShellWindow.Count -1 do
begin
Vi:=i;
Dispatch:=ShellWindow.Item(Vi);
if Dispatch=nil then continue;
Dispatch.QueryInterface(IWebBrowser2,Web);
if Web<>nil then
begin
IEAddress:=Web.LocationURL;
if Pos(aURL,IEAddress)>0 then
begin
Web.Document.QueryInterface(IHTMLDocument2,HTMLDocument);
if HTMLDocument<>nil then
begin
if HTMLDocument.frames.length =0 then//无框架
begin
ElementCollection:=HTMLDocument.Get_All;
DoWithHtmlElement(ElementCollection);
end
else//有框架
begin
for j:=0 to HTMLDocument.frames.length -1 do
begin
Vj:=j;
Dispatch:=HTMLDocument.frames.item(Vj);
// if Succeeded(Dispatch.QueryInterface(IHTMLFrameBase,HTMLFrameBase)
if Succeeded(Dispatch.QueryInterface(IHTMLWindow2,FrameWindow)) then
begin
// DoWithHtmlElement(FrameWindow.document.all);
end;
End;
end;
end;
end;
End;
end;
end;

procedure TMainFrm.btnTestClick(Sender: TObject);
begin
FillIEForm(edUrl.Text);
end;
end.

相关阅读 >>

Delphi 取得开机时间 开机时间总长度(可精确到秒,分钟等)

Delphi dbgrideh footer的设置和使用

Delphi2010 编译变量$region用法

Delphi 数组复制利用copymemory 最为完美

Delphi 窗体内控件实现滚动字母

Delphi webbrowser1 保存文档为 .mht

Delphi 10.x ide界面

Delphi fmx自定义对话框样式,多屏幕布局

通过崩溃地址找错误行数之Delphi

Delphi xe7 判断android应用程序中的通信状态类型

更多相关阅读请进入《Delphi》频道 >>



打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

管理员已关闭评论功能...