吵吵   2011-03-02  阅读:3,717

吵吵发布

闲来无事,研究了一下刷票的程序,发现现在大部分的网站是用ajax技术来进行投票,这样用一些控件,比如说idhttp的post方法构造数据包发送就有点难度了,于是我用webbrowser进行模拟投票。有一个好用的方法就是:webbrowser1.OleObject.document.all.item(‘xml元素’,0)这个东西能够获取到网页中的某个元素,比如说投票的按钮,然后click方法就是了,一下是源码:

吵吵发布



unit tp;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, SHDocVw,Registry,ShellApi, WinInet,ShlObj,ComObj,
ExtCtrls, AppEvnts, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdHTTP;

type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
Button1: TButton;
Button2: TButton;
Timer1: TTimer;
Button3: TButton;
Timer2: TTimer;
Label4: TLabel;
Edit1: TEdit;
ApplicationEvents1: TApplicationEvents;
Button4: TButton;
Button5: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
//procedure IdHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
procedure Button4Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
tag:integer;

implementation

{$R *.dfm}

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);

begin

if msg.wParam=27 then
begin
timer1.Enabled:=false;

label4.Caption:='投票停止...';
end;
if msg.wParam=65 then
begin
timer1.Enabled:=true;

label4.Caption:='投票开始...';
end;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
webbrowser1.Navigate(edit1.Text);
end;

function GetCookiesFolder:string;
var
pidl:pItemIDList;
buffer:array [ 0..255 ] of char ;
begin
SHGetSpecialFolderLocation(
application.Handle , CSIDL_COOKIES, pidl);
SHGetPathFromIDList(pidl, buffer);
result:=strpas(buffer);
end;
function ShellDeleteFile(sFileName: string): Boolean;
var
FOS: TSHFileOpStruct;
begin
FillChar(FOS, SizeOf(FOS), 0); {记录清零}
with FOS do
begin
wFunc := FO_DELETE;//删除
pFrom := PChar(sFileName);
fFlags := FOF_NOCONFIRMATION;
end;
Result := (SHFileOperation(FOS) = 0);
end;

//删除cookies
procedure DelCookie;
var
dir:string;
begin
try
InternetSetOption(nil, INTERNET_OPTION_END_BROWSER_SESSION, nil, 0);
dir:=GetCookiesFolder;
ShellDeleteFile(dir+'\*.txt'+#0);
except
abort;
end;

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
timer1.Enabled:=true;

label4.Caption:='开始投票...';
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
timer1.Enabled:=false;

label4.Caption:='投票停止...';

end;

procedure TForm1.Button4Click(Sender: TObject);
begin
tag:=2;
label4.Caption:='开始自动浏览...';
DelCookie;
webbrowser1.Navigate(edit1.Text);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
tag:=1;
label4.Caption:='停止自动浏览...';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
tag:=1;
end;

//procedure TForm1.IdHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
//var
//response:tStringStream;
//begin
//response:=tstringstream.Create;
//idhttp1.Disconnect;
//idhttp1.Get(edit1.Text,response);
// response.Destroy;
//end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
loginBt:OleVariant;
begin

loginBt:=webbrowser1.OleObject.document.all.item('btn_votes_156203',0);
if VarIsEmpty(loginBt)=false then
begin
loginBt.click;

DelCookie;
end;
timer2.Enabled:=true;

//setCursorpos(mousePt.X,mousept.y);
end;

procedure TForm1.Timer2Timer(Sender: TObject);
var

okBt:OleVariant;
begin
okBt:=webbrowser1.OleObject.document.all.item('do_OK',0);
if varisempty(okBt)=false then
begin
okBt.click;
end
else
begin
okBt:=webbrowser1.OleObject.document.all.item('do_OK',0);
if varisempty(okBt)=false then okBt.click;
end;

timer2.Enabled:=false;

end;

procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
if tag=2 then
begin
DelCookie;
webbrowser1.Navigate(edit1.Text);
end;
end;

end.

吵吵发布

吵吵微信朋友圈,请付款实名加入:

吵吵 吵吵

发表评论

电子邮件地址不会被公开。 必填项已用*标注