unit GetSynsInfo;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, HttpProt;
type
TForm1 = class(TForm)
HttpCli1: THttpCli;
Timer1: TTimer;
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
HttpCli2: THttpCli;
HttpCli3: THttpCli;
HttpCli4: THttpCli;
HttpCli5: THttpCli;
HttpCli6: THttpCli;
HttpCli7: THttpCli;
HttpCli8: THttpCli;
HttpCli9: THttpCli;
HttpCli10: THttpCli;
ListBox1: TListBox;
Image1: TImage;
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
const TrdNum = 10;
StrN = 90;
ColN = 17;
var Start,Stop: integer;
HTTP: array [1..10] of THttpCli;
//A: array [0..999] of integer;
B: array [1..10] of integer; { Status }
CurPtr,Size: integer;
FreeTrd: integer;
const Names: array [1..10] of string =
('roulet01.tmp','roulet02.tmp','roulet03.tmp',
'roulet04.tmp','roulet05.tmp','roulet06.tmp','roulet07.tmp','roulet08.t
mp',
'roulet09.tmp','roulet10.tmp');
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
Start:=StrToInt(Edit1.Text);
Stop:=StrToInt(Edit2.Text);
Size:=Stop-Start+1;
CurPtr:=Stop;
// FillChar(A,SizeOf(A),0);
FillChar(B,SizeOf(B),0);
Image1.Picture.Bitmap.PixelFormat:=pf24bit;
Image1.Picture.Bitmap.Width:=Size;
Image1.Picture.Bitmap.Height:=2;
Image1.Picture.Bitmap.Canvas.Pen.Color:=clBlue;
Timer1.Enabled:=True;
FreeTrd:=TrdNum;
Button1.Enabled:=False;
end;
{function Process(Name: string): integer;
var S: string;
I: integer;
F: text;
Code: integer;
begin
Assign(F,Name);
Reset(F);
for I:=1 to StrN do Readln(F,S);
Delete(S,1,ColN-1);
I:=1;
S:=S+';';
while S[I] in ['0'..'9'] do Inc(I);
S:=Copy(S,1,I-1);
Val(S,Result,Code);
if (Code<>0) then Result:=-1;
Close(F);
Erase(F);
end;}
procedure WriteResults;
var F: text;
I: integer;
begin
{ Assign(F,'results.out');
Rewrite(F);
for I:=Start to Stop do Writeln(F,A[I-Start]);
Close(F);}
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var I,J: integer;
begin
ListBox1.Clear;
for I:=1 to TrdNum do
case Ord(HTTP[I].State) of
0: ListBox1.Items.Add('OK');
1: ListBox1.Items.Add('Not connected');
2: ListBox1.Items.Add('Connected');
3: ListBox1.Items.Add('DNS lookup');
4: ListBox1.Items.Add('DNS lookup done');
5: ListBox1.Items.Add('Waiting header');
6: ListBox1.Items.Add('Waiting body');
7: ListBox1.Items.Add('Aborting');
end;
ListBox1.Refresh;
for I:=1 to TrdNum do if (Ord(HTTP[I].State)=0) and (B[I]<>0) then
begin
HTTP[I].RcvdStream.Destroy;
HTTP[I].RcvdStream:=nil;
// A[B[I]-Start]:=Process(Names[I]);
Image1.Picture.Bitmap.Canvas.MoveTo(B[I]-Start,0);
Image1.Picture.Bitmap.Canvas.LineTo(B[I]-Start,2);
B[I]:=0;
Inc(FreeTrd);
end;
for I:=1 to TrdNum do if Ord(HTTP[I].State)=0 then HTTP[I].Abort;
if (FreeTrd=TrdNum) and (CurPtr<Start) then
begin
Timer1.Enabled:=False;
WriteResults;
Button1.Enabled:=True;
end;
while (CurPtr>=Start) and (FreeTrd>0) do
begin
for I:=1 to TrdNum do if B[I]=0 then
begin
HTTP[I].URL:='
http://www.gwars.io/syndicate.php?id='+IntToStr(CurPtr);
HTTP[I].RcvdStream:=TFileStream.Create('List\'+IntToStr(CurPtr)+'.htm',fmCr
eate);
HTTP[I].GetASync;
B[I]:=CurPtr;
Dec(FreeTrd);
Dec(CurPtr);
Break;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
HTTP[1]:=HttpCli1;
HTTP[2]:=HttpCli2;
HTTP[3]:=HttpCli3;
HTTP[4]:=HttpCli4;
HTTP[5]:=HttpCli5;
HTTP[6]:=HttpCli6;
HTTP[7]:=HttpCli7;
HTTP[8]:=HttpCli8;
HTTP[9]:=HttpCli9;
HTTP[10]:=HttpCli10;
end;
end.