Потоки. Нагрузка на ЦП.

[Test3r]

Задача - проверять списки сайтов на определённую страницу, работает шустро, быстро, загрузка ЦП в районе 10%, но через несколько минут работы (списки сайтов большие) ЦП - 100%. Что делать, как поступить?

Вступление, ну кому нужно...

  TMyThread = class(TThread)
  private
    FOnDone: TNotifyEvent;
    Rez : Integer;
  protected
    procedure Execute; override;
    procedure SyncMe;
    procedure WorkEnd;
  public
    Pass: String;
    Site: string;
    IP: string;
    Port: Integer;
    constructor Create(CreateSuspended: Boolean);
    destructor Destroy; override;
    property OnDone: TNotifyEvent read FOnDone write FOnDone;
  end;    

var
  Form1: TForm1;
  i:string; z:Byte;
  Sites:Tstringlist;
  t:integer;
  Work,check:boolean;
  GoodFile, GoodFile2, GoodFile3: textfile; 

implementation

{$R *.dfm}

{ TMyThread }

constructor TMyThread.Create(CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);
  FreeOnTerminate := True;
end;
                                                         
destructor TMyThread.Destroy;
begin
  inherited;
end;

Сам поток

procedure TMyThread.Execute;
var
    HTTP: TIdHTTP;
    a:string;
begin
     HTTP:=TIdHTTP.create;
     HTTP.HandleRedirects:=false;
//code
     try
      a:=HTTP.Get('http://'+Site+'/stranica.php');
     except
     end;
     if Pos('key', a)<>0 then rez:=1
     else
     rez:=0;
//code
     Synchronize(SyncMe);//Єръ фюыцэю сvЄ№) фтр ёшэър
     HTTP.Free;
     Synchronize(WorkEnd);
end;

procedure TMyThread.SyncMe;
begin
case Rez of
 1:
 begin
      Append(GoodFile);
      Writeln(GoodFile,'site');
      Closefile(GoodFile);
 end;
// 2:
// 3:
//etc...

end;
end;

procedure TMyThread.WorkEnd;
   begin
  if Assigned(FOnDone) then
  FOnDone(Self);
end;

procedure TForm1.btn1Click(Sender: TObject);
var
  m: TMyThread; b:integer;
begin
  if Sites.Count<>0 then
  begin
  for b := 0 to Min(StrToIntDef(Edt3.Text, 0), Sites.Count - 1) do
  begin
  m := TMyThread.Create(True);
  m.Site:=Sites[0];
  Sites.Delete(0);
  m.OnDone := DoneWork;
  m.Resume;
  end;
  end;

procedure TForm1.DoneWork(Sender: TObject);
var
  m: TMyThread;
begin
  lbl6.Caption:=IntToStr(Sites.Count);//осталось
  if Sites.Count > 0 then
  begin
    m := TMyThread.Create(True);
    m.Site:=Sites[0];
    Sites.Delete(0);
    m.OnDone := DoneWork;
    m.Resume;
end;