本文整理自网络，侵删。
自动填表
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 f1026 file not found: ''quickrpt.dcu''解决方法
Delphi 如何在程序中动态设置墙纸（使用iactivedesktop接口）
Delphi研究之驱动开发篇（六）--利用section与用户模式程
Delphi 多次改变 richedit.text部份文本的颜色后，出现所有字体都变色的的解决办法
更多相关阅读请进入《Delphi》频道 >>
