webbrowser自动填表模板

 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.