unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,
StdCtrls, ComCtrls, Gauges, SyncObjs, IdCookieManager, ActiveX, VBScript_RegExp_55_TLB;
type
TForm1 = class(TForm)
Edit1: TEdit;
UpDown1: TUpDown;
Button1: TButton;
Label1: TLabel;
OpenDialog1: TOpenDialog;
GoodLabel: TLabel;
IdHTTP1: TIdHTTP;
Gauge1: TGauge;
Button2: TButton;
Memo1: TMemo;
IdCookieManager1: TIdCookieManager;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button2Click(Sender: TObject);
private
public
end;
TNewThread = class(TThread)
private
FAcc : string;
page:string;
session,security,u,u2,lastcomment:string;
protected
procedure Execute; override;
public
procedure Sync;
constructor Create(CreateSuspended: Boolean);
function Parse(page:string; pattern:string):string;
end;
var
Form1: TForm1;
Accounts:Tstringlist;
Thread, Acc:integer;
Work:boolean;
CS:TcriticalSection;
implementation
{$R *.dfm}
constructor TNewThread.Create(CreateSuspended: Boolean);
begin
inherited Create(CreateSuspended);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
OpenDialog1.InitialDir:=ExtractFilePath(Application.ExeName);
if OpenDialog1.Execute then
begin
Accounts.Clear;
Accounts.LoadFromFile(OpenDialog1.FileName);
Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
GoodLabel.Caption:='0';
Gauge1.MaxValue:=Accounts.Count;
Gauge1.Progress:=0;
Work:=true;
for Thread:=1 to strtoint(Edit1.Text) do
TNewThread.Create(false);
Thread:=strtoint(Edit1.Text);
end;
procedure TNewThread.Execute;
var CurAcc:integer;
data:Tstringlist;
HTTP: TIdHTTP;
CookieManager:TIdCookieManager;
begin
CoInitialize(nil);
while Work do
begin
CS.Enter;
Inc(Acc);
if Acc<Accounts.Count then CurAcc:=Acc else Work:=false;
CS.Leave;
if Work then
begin
FAcc:= Accounts[CurAcc];
data:=tstringlist.Create;
HTTP:=tidHTTP.Create();
CookieManager:=tidCookieManager.Create();
HTTP.AllowCookies:=true;
HTTP.CookieManager:=CookieManager;
HTTP.HandleRedirects:=true;
HTTP.Request.UserAgent:='Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.2.13) Gecko/20101203 Firefox/3.6.13';
session:=Parse(page,'name="s" value="(.*)"');
security:=Parse(page,'name="securitytoken" value="(.*)"');
data.Add('vb_login_username=USERNAME');
data.Add('cookieuser=1');
data.Add('vb_login_password=');
data.Add('s='+session);
data.Add('securitytoken='+security);
data.Add('do=login');
data.Add('vb_login_md5password=0945fc9611f55fd0e183fb8b144f1afe');
data.Add('vb_login_md5password_utf=0945fc9611f55fd0e183fb8b144f1afe');
data.Clear;
page:=HTTP.Get(trim(Facc));
security:=Parse(page,'name="securitytoken" value="(.*)"');
u:=Parse(page,'name="u" value="(.*)"');
u2:=Parse(page,'name="u2" value="(.*)"');
lastcomment:=Parse(page,'name="lastcomment" value="(.*)"');
data.Add('ajax=1');
data.Add('wysiwyg=0');
data.Add('styleid=0');
data.Add('fromquickcomment=1');
data.Add('s=');
data.Add('securitytoken='+security);
data.Add('do=message');
data.Add('u='+u);
data.Add('u2='+u2);
data.Add('loggedinuser='+u);
data.Add('parseurl=1');
data.Add('lastcomment='+lastcomment);
data.Add('allow_ajax_qc=1');
data.Add('fromconverse=');
data.Add('message=MESSAGE');
try
data.Clear;
finally
data.Free;
HTTP.Free;
CookieManager.Free;
end;
Synchronize(Sync);
end;
end;
dec(Thread);
if Thread=0 then ShowMessage('OK');
end;
function TNewThread.Parse(page, pattern: string): string;
var
Reg: TRegExp;
mc: MatchCollection;
m: Match;
sm: SubMatches;
i:Integer;
s,r:string;
begin
Reg := TRegExp.Create(Form1);
try
s:=page;
Reg.Pattern:=pattern;
Reg.IgnoreCase:=true;
Reg.Global:=true;
Reg.Multiline:=true;
mc:=Reg.Execute(s) as MatchCollection;
for I := 0 to mc.Count - 1 do begin
m:=mc[i] as Match;
sm:=m.SubMatches as SubMatches;
r:=trim(VarToStr(sm[0]));
Result:=r;
end;
finally
m:=nil;
sm:=nil;
mc:=nil;
Reg.Free;
end;
end;
procedure TNewThread.Sync;
begin
Form1.GoodLabel.Caption:=IntToStr(StrToInt(Form1.GoodLabel.Caption)+1);
Form1.Gauge1.Progress:=Form1.Gauge1.Progress+1;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Accounts.Free;
CS.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Accounts:=Tstringlist.create;
CS:=TcriticalSection.create;
end;
end.
15.12.2010, 19:23
Одна авторизация - много потоков
), потом создаем потоки TPostThread для каждого сообщения из мемы1. в мему2 добавляются отправленые сообщения для контроля.
Линейный вид
