monik

unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, sSkinManager, Vcl.StdCtrls, Vcl.ExtCtrls,
sEdit, Vcl.Buttons, sBitBtn, sLabel, sSpinEdit, sDialogs, httpsend, SyncObjs, shellapi;
type
TForm1 = class(TForm)
sSkinManager1: TsSkinManager;
sEdit1: TsEdit;
sLabel1: TsLabel;
sBitBtn1: TsBitBtn;
sBitBtn2: TsBitBtn;
sLabel2: TsLabel;
sLabel3: TsLabel;
sOpenDialog1: TsOpenDialog;
sLabel4: TsLabel;
sLabel5: TsLabel;
sSpinEdit1: TsSpinEdit;
sWebLabel1: TsWebLabel;
procedure sBitBtn1Click(Sender: TObject);
procedure sBitBtn2Click(Sender: TObject);
procedure sWebLabel1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
thread = class(TThread)
private
rez: integer;
public
protected
procedure Execute; override;
procedure analiz;
end;
var
Form1: TForm1;
proxy: TStringList;
oct: integer;
stream: TStringStream;
ipp: integer;
cs: TCriticalSection;
work: boolean;
error, goods: integer;
site: string;
implementation
{$R *.dfm}
procedure TForm1.sBitBtn1Click(Sender: TObject);
begin
proxy:=TStringList.Create;
if sOpenDialog1.Execute then
begin
proxy.Clear;
proxy.LoadFromFile(sopendialog1.FileName);
oct:=proxy.Count;
slabel4.Caption:='Осталось: '+IntToStr(oct);
End;
end;
procedure TForm1.sBitBtn2Click(Sender: TObject);
function Pars(T_, ForS, _T: string): string;
var a, b:integer;
begin
Result := '';
if (T_='') or (ForS='') or (_T='') then Exit;
a:=Pos(T_, ForS);
if a=0 then Exit else a:=a+Length(T_);
ForS:=Copy(ForS, a, Length(ForS)-a+1);
b:=Pos(_T, ForS);
if b>0 then
Result:=Copy(ForS, 1, b - 1);
end;
var
i:integer;
sernum : string;
begin
sernum:=pars('serv-',sedit1.Text,'/');
site:=pars('http://',sedit1.Text,'/serv');
ipp:=-1;
work:=true;
error:=0;
goods:=0;
cs:=TCriticalSection.Create;
stream:=TStringStream.Create;
stream.WriteString('id='+sernum);
for I := 0 to sspinedit1.Value-1 do
with thread.Create(True) do
begin
Priority:=tpNormal;
FreeOnTerminate:=True;
Resume;
end;
end;
procedure TForm1.sWebLabel1Click(Sender: TObject);
begin
ShellExecute(0, 'open', 'http://forum.coders-community.ru/', nil, nil, SW_SHOW);
end;
{ thread }
procedure thread.analiz;
begin
case rez of
0: begin
error:=error+1;
form1.sLabel3.Caption:='Неудач: '+IntToStr(error);
end;
1: begin
goods:=goods+1;
form1.sLabel2.Caption:='Накручено: '+IntToStr(goods);
end;
end;
oct:=oct-1;
form1.sLabel4.Caption:='Осталось: '+intToStr(oct);
end;
procedure thread.Execute;
var
httpsend: THTTPSend;
str, prip, prprot, prs: string;
i: integer;
sostring: TStringList;
begin
while work do begin
if ipp<proxy.Count then begin
cs.Enter;
ipp:=ipp+1;
Str := proxy[ipp];
i := Pos(':', Str);
prip := Copy(Str, 1, i - 1);
prprot := Copy(Str, i + 1, Length(Str));
cs.Leave;
httpsend:=THTTPSend.Create;
httpsend.MimeType:='application/x-www-form-urlencoded; charset=UTF-8';
httpsend.document.LoadFromStream(stream);
httpsend.ProxyHost:=prip;
httpsend.ProxyPort:=prprot;
httpsend.Timeout:=10000;
httpsend.HTTPMethod('post','http://'+site+'/up/');
sostring:=TStringList.Create;
sostring.LoadFromStream(httpsend.Document);
prs:=sostring.Text;
sostring.Free;
httpsend.Free;
rez:=0;
if Pos('<status>ok</status>', prs)<>0 then rez:=1;
Synchronize(analiz);
end else work:=false;
end;
end;
end.