HanDs
管理员

[Delphi文章] 自动填表 自动登录 



演示论坛的自动登录,自动发贴程序(源码)
说是原创,其实很多是学习和借鉴别人的

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw, StdCtrls;

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Function GetFrame(FrameNo:Integer):IWebbrowser2;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
      uses MSHTML,ActiveX;
Function TForm1.GetFrame(FrameNo:Integer):IWebbrowser2;
var
OleContainer:IOleContainer;
enum:IEnumUnknown;
unk:IUnknown;
Fetched:PLongint;
begin
while Form1.webbrowser1.ReadyState<>READYSTATE_COMPLETE do
Application.ProcessMessages;
if Assigned(webbrowser1.document) then
begin
Fetched:=nil;
OleContainer:=webbrowser1.Document as IOleContainer;
OleContainer.EnumObjects(OLECONTF_EMBEDDINGS,enum);
Enum.Skip(FrameNo);
Enum.Next(OLECONTF_EMBEDDINGS,Unk,Fetched);
Result:=Unk as IWebbrowser2;
end
else
Result:=nil;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
hform:IHTMLFormelement;
hdoc:ihtmldocument2;
hall:ihtmlelementcollection;
Hinput:IHTMLinputelement;
iw:iwebbrowser2;
hlen,tmploop:integer;
vk:oleVariant;
dispatch:IDispatch;
ovElements: OleVariant;
tables: IHTMLElementCollection;
Table1   :HTMLTable;
doc:IHTMLDocument3;
ii:Cardinal;
ObjTmp:OleVariant;

begin      //这段代码根据麻山论刀灌水机
if Assigned(webbrowser1) then ///确保网页里有内容;即已打开一个网页!
begin
hdoc:=webbrowser1.document as ihtmldocument2;
hall:=hdoc.get_all;
hlen:=hall.get_length;
////以上几步的操作为:将浏览器控件里的内容赋给hdoc.取其任何标识,并算出总数;
////下面的操作为:按总数循环找到用户名和密码的edit;并赋值;
for tmploop:=0 to hlen-1 do
begin
vk:=tmploop;
dispatch:=hall.item(vk,0);
if succeeded(Dispatch.QueryInterface(IHTMLInputelement,hinput)) then
///假如此标识是个edit控件.....
begin ////下面这里的uppercase是必需的!防止因大小写的不同而判断失误!
///下面的"TEXT"是由网页里的内容来确定的.也就是说您要判断就必需根据具体网页代码来!
///密码框和用户名处是相同的!
//if Hinput.type_=
if uppercase(hinput.Type_)='TEXT' then hinput.value:='myname'
else if uppercase(hinput.type_)='PASSWORD' then hinput.value:='mypass';
end;
//if succeeded(dispatch.QueryInterface(IHTMLFormElement,hform)) and
//(hform.name='submit') then
///此处是form提交.假如从html发现只有一个form的话那第二个条件是非必需的!
///而且也不一定要判断name属性,也能够根据其他属性来判断.
//sleep(2000);
//WebBrowser1.OleObject.document.getElementsByTagName('input').item(7).click;
// Break;
 // FormCreate(nil);

 
end;
end; //if end;  

end;


procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('http://bbs.2ccc.com/');
end;

procedure TForm1.Button2Click(Sender: TObject);
var 
hIE: HWND; 
ShellWindow: IShellWindows; 
WB: IWebbrowser2; 
spDisp: IDispatch; 
IDoc1: IHTMLDocument2; 
Document: Variant; 
k, m: Integer; 
ovElements: OleVariant; 
i: Integer; 
begin
ShellWindow := CoShellWindows.Create; 
// get the running instance of Internet Explorer 
for k := 0 to ShellWindow.Count do 
begin 
spDisp := ShellWindow.Item(k); 
if spDisp = nil then Continue; 
// QueryInterface determines if an interface can be used with an object 
spDisp.QueryInterface(iWebBrowser2, WB); 

if WB <> nil then 
begin 
WB.Document.QueryInterface(IHTMLDocument2, iDoc1); 
if iDoc1 <> nil then 
begin 
WB := ShellWindow.Item(k) as IWebbrowser2; 
begin 
Document := WB.Document; 

// count forms on document and iterate through its forms 
for m := 0 to Document.forms.Length - 1 do 
 begin
  ovElements := Document.forms.Item(m).elements;
// iterate through elements 
  for i := 0 to ovElements.Length - 1 do
  begin
    try
    if (ovElements.item(i).Value = '提 交')  //不知是不是这句,成功了。
    then // Suchen für German
      begin
      ovElements.item(i).Click;
      end;
    except
    end;
  end;

 end;
end; 
end; 
end; 
end; 
end;


procedure TForm1.Button3Click(Sender: TObject);
begin
WebBrowser1.OleObject.document.getElementsByTagName('input').item(7).click;

 
end;

end.


学习中请遵守法律法规,本网站内容均来自于互联网,本网站不负担法律责任
自动
#1楼
发帖时间:2016-7-9   |   查看数:0   |   回复数:0
游客组
快速回复