Парсер логинов.

Почему не работает? Я уже всё, что можно перепробывал, наверно как всегда, что - то очевидное, а я не вижу!
Вот код:

Code:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP,SyncObjs, ComCtrls, ExtCtrls;

type
  Tmain = class(TForm)
    Edit: TEdit;
    IdHTTP1: TIdHTTP;
    Edit1: TEdit;
    ProgressBar1: TProgressBar;
    Label1: TLabel;
    Label2: TLabel;
    Edit2: TEdit;
    Label3: TLabel;
    Edit3: TEdit;
    Label4: TLabel;
    button1: TButton;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);



  private
    { Private declarations }
  public
    { Public declarations }
  end;

  potok = class(TThread)
  private
   FAcc : string;
   FPas : string;
   Rez : Longword;
  protected
    procedure Execute; override;
  public
    procedure Sync;
    constructor Create(CreateSuspended: Boolean);
end;

var
  main: Tmain;
  nom, nomk, noms:Longword;
  z:string;
  CS:TcriticalSection;
  Thread:integer;
  work:boolean;

implementation

{$R *.dfm}
constructor potok.Create(CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);
end;

procedure potok.Execute;
var
asd,zloc,listen:string;
nomloc:Longword;
http:TIdHTTP;
ed:tedit;
GoodFile, BadFile: textfile;
begin
HTTP:=TIdHTTP.create;
http.HandleRedirects:=false;


while nom<nomk do
begin
cs.Enter;
inc(nom);
nomloc:=nom;
zloc:=z;
cs.Leave;
try
asd:=http.Get(zloc+inttostr(nomloc));
except

end;

while pos('<font color="#1F8DBE">', asd)<>0 do
begin
delete(asd,1,pos('<font color="#1F8DBE">', asd)-1);
delete(asd,1,22);
listen:=copy(asd,1,pos('</font>',asd)-1);
delete(asd,1,pos('>',asd));
FAcc:=listen;
Synchronize(Sync);
end;

cs.enter;
main.ProgressBar1.Position:=main.ProgressBar1.Position+1;
main.Label9.Caption:=inttostr(nom);
cs.leave;
end;

http.Free;
end;




procedure potok.Sync;
var
GoodFile, BadFile: textfile;
begin
inc(noms);
Assignfile(GoodFile, ExtractFilePath(Application.ExeName)+'logins.ini');
Append(GoodFile);
Writeln(GoodFile,facc);
Closefile(GoodFile);

end;






procedure Tmain.Button1Click(Sender: TObject);
var
 GoodFile, BadFile: textfile;
begin
z:=edit.Text;
nom:=strtoint(edit1.Text);

for Thread:=1  to strtoint(Edit1.Text) do
  potok.Create(false);
 Thread:=strtoint(Edit1.Text);
 nom:=strtoint(Edit2.Text);
 nomk:=strtoint(edit3.Text);
 progressbar1.Max:=nomk;
end;

procedure Tmain.FormCreate(Sender: TObject);
begin
CS:=TcriticalSection.create;
end;

end.

Более мение работает, но перестаёт записывать логины когда их количество достигает: 1073, перестаёт добавлять... В чём проблема?