Delphi中WebBrowser自动填表模板

 

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.