Потоки + Idhttp

Добрый вечер.
Как работать с 1 потоком я вроде разобрался, теперь хочу понять как работать с многопоточностью.

Подскажите плиз как реализовать многопоточность,потоков 10 для данного примера:
(Программа должна в 10 потоках грузить разные странички)


unit1:

procedure TForm1.Button1Click(Sender: TObject);
var
  NewThread: TNewThread;
begin
  NewThread:=TNewThread.Create(true);
  NewThread.FreeOnTerminate:=true;
  NewThread.Priority:=tpLower;
  NewThread.Resume;
end;

Unit2:

TNewThread = class(TThread)
  private
    Progress: integer;
Otvet: TStringList;
    procedure SetProgress;
 
  protected
    procedure Execute; override;
  end;
...
 
procedure TNewThread.Execute;
var
  i: integer;
 idHTTP1:TidHTTP;
 IdCookieManager1: TIdCookieManager;
 
begin
 IdCookieManager1:= TIdCookieManager.Create(nil);
idHTTP1 := TidHTTP.Create(nil);
IdHTTP1.AllowCookies:=true;
IdHTTP1.CookieManager:= IdCookieManager1;
IdHTTP1.HandleRedirects:= true;
 
Otvet:= TStringList.Create;
    Synchronize(SetProgress);
  end;
 
 
procedure TNewThread.SetProgress;
begin
Otvet.Text:=IdHTTP1.Get('http://www.ya.ru');
end;

Сообщение отредактировано: Анчоус - 21.01.10, 16:57

Один поток работает? Теперь просто запусти 10 потоков.

если бы я знал как это сделать я бы не спрашивал тут.
может у кого-нибудь есть пример где много потоков используется.
не могу понять как их создавать

Цитата Anatoly Podgoretsky @ 21.01.10, 18:01

Один поток работает? Теперь просто запусти 10 потоков.

Один поток у автора тоже неправильно реализован.

Анчоус

IdHTTP

var
  NewThread: TNewThread;
  NewThread1: TNewThread;
  NewThread2: TNewThread;
begin
  NewThread:=TNewThread.Create(true);
  NewThread.FreeOnTerminate:=true;
  NewThread.Priority:=tpLower;
  NewThread.Resume;
  NewThread1:=TNewThread.Create(true);
  NewThread1.FreeOnTerminate:=true;
  NewThread1.Priority:=tpLower;
  NewThread1.Resume;
  NewThread2:=TNewThread.Create(true);
  NewThread2.FreeOnTerminate:=true;
  NewThread2.Priority:=tpLower;
  NewThread2.Resume;
end;

100 % не гарантирую но думаю вот так заработает.

Цитата Демо @ 21.01.10, 18:35

IdHTTP

то ,что надо...
Не мог бы помочь разбраться с ошибкой:
[Error] uGetHttpThread.pas(185): Incompatible types: 'TIdBytes' and 'Int64'
[Error] uGetHttpThread.pas(186): Incompatible types: 'TIdBytes' and 'Int64'

прочитал пост: IdHTTP (сообщение #2311934) - не помогло.

Сообщение отредактировано: Анчоус - 21.01.10, 21:06

Прикреплённый файлindy_Download.zip (24.75 Кбайт, скачиваний: 242)

Анчоус

Исправь в описаниях функций типы.

    procedure FHWork(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCount: Int64);
    procedure FLReceive(ASender: TIdConnectionIntercept;
      var ABuffer: TBytes);
    procedure FLSend(ASender: TIdConnectionIntercept;
      var ABuffer: TBytes);

Ну и в секции реализации такие же параметры должны быть.

поменять все TBytes на Int64 ?

полюбому ошибка в:
FL.OnReceive := FLReceive;
FL.OnSend := FLSend;

[Error] uGetHttpThread.pas(172): Incompatible types: 'TIdBytes' and 'Int64'



или заменив на то что выше?




procedure FHWork(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Int64);
procedure FLReceive(ASender: TIdConnectionIntercept;
var ABuffer: TBytes);
procedure FLSend(ASender: TIdConnectionIntercept;
var ABuffer: TBytes);

теперь ругается на
procedure FLReceive(ASender: TIdConnectionIntercept;
var ABuffer: TBytes);


я в этом не очень пока понимаю,не могли бы сделать готовы пример?плиз)
просто на примере легче учиться и разбираться

Сообщение отредактировано: Анчоус - 21.01.10, 23:22

    procedure FHWork(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCount: Int64);
    procedure FLReceive(ASender: TIdConnectionIntercept;
      var ABuffer: TBytes);
    procedure FLSend(ASender: TIdConnectionIntercept;
      var ABuffer: TBytes);

procedure TGetHTTP.FHWork(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: int64);
 
procedure TGetHTTP.FLReceive(ASender: TIdConnectionIntercept;
  var ABuffer: TBytes);
 
procedure TGetHTTP.FLSend(ASender: TIdConnectionIntercept;
  var ABuffer: TBytes);

Приветствую, скачал модуль описанный выше и доработал его немного под D2010, так вот пишу чекер прокси, чекает норм, но, когда остается последних 10 прокси процесс тупо висит, как будто что то жедт, помогите выловить ошибку в модуле или в моем коде его использования:

{
Модуль uGetHTTPThread
Выполнение запроса HTTP GET в отдельном потоке с
возможностью повторного использования.
Ведется учет количества потоков
 
Требования - установленный Indy10
 
 (c) Демо
 
Специально для Sources.ru (2005,2008)
 
Пример использования приложен
}
 
unit uGetHttpThread;
 
interface
 
uses
  windows, Messages, classes, SysUtils, idHTTP, idLogDebug, idComponent, idGlobal,IdIOHandler,
  IdIOHandlerSocket, IdIOHandlerStack,  IdIntercept,idException,IdStackConsts;
 
const
//Сообщение для добавления запроса в очередь
  WM_ADD=WM_USER+1;
//Сообщения для инициирования выполнения запроса
  WM_PROCESS=WM_USER+2;
 
var
//Список потоков
//  ThrList: TThreadList;
  ThrList: TThreadList;
 
type
 
  TStateHTTPThread=(shNone,shReady,shComplete,shWork);  //Состояние потока
  TActionHTTPThread=(ahNone,ahFree);  //Действие при обработке OnComplete
  TGetHTTP=class;
  TCompleteQuery=procedure(Sender: TGetHTTP;
    var Action:TActionHTTPThread) of Object;
  TProgressQuery=procedure(Sender: TGetHTTP;
    aReadCount,aSendCount: Integer) of Object;
 
//Структура, заполняемая в потоке.
  THTTPRec=record
    Query: String;              //Запрос в виде http://url
    ProxyServer: String;        //Адрес прокси-сервера
    ProxyPort: Integer;         //Порт прокси-сервера
    ErrorMsg: String;//String           //Результатт в текстовом виде
    ErrorCode: Integer;         //Результат в числовом виде
    RecvStr: AnsiString;//String            //Принятая строка(полностью с заголовком)
    SendStr: AnsiString;//String            //Отосланная строка
    CountSend: Integer;         //Количество отосланных байт
    CountRcv: Integer;          //Количество принятых байт
    Page: String;               //Возвращенная страница(без заголовка)
  end;
 
//Прокси-сервер
  TProxy=record
    ProxyAddr: String;
    Port: integer;
  end;
 
//Структура для передачи сообщений
  PQProxy=^TQProxy;
  TQProxy=record
    Proxy: TProxy;
    Query: String;
  end;
 
//Собственно, сам поток
  TGetHTTP=class(TThread)
  private
    FQueryList: TList;            //Очередь запросов
    FCS: RTL_CRITICAL_SECTION;
    FH: TidHTTP;
    FL: TidLogDebug;
    FS: TIdIOHandlerStack;
    FConnectionTimeOut: Integer;  //Таймаут ожидания соединения
    FReadTimeOut: Integer;        //Таймаут получения данных
    FResult: THTTPRec;
    FState: TStateHTTPThread;
    FOnComplete: TCompleteQuery;
    FOnProgress: TProgressQuery;
    FWaitHandle: THandle;
    function GetConnectionTimeOut: Integer;
    function GetReadTimeOut: Integer;
    procedure SetConnectionTimeOut(const Value: Integer);
    procedure SetReadTimeOut(const Value: Integer);
    function GetQueryCount: Integer;
    procedure FComplete;
    procedure FProgress;
    procedure FHWork(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCount: Int64);
    procedure FLReceive(ASender: TIdConnectionIntercept;
      var ABuffer: TBytes);
    procedure FLSend(ASender: TIdConnectionIntercept;
      var ABuffer: TBytes);
    procedure Lock;
    procedure Unlock;
    function GetFResult: THTTPRec;
    procedure LoadPage;
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Free;
    procedure Release;
//добавление в очередь нового запроса
    procedure Get(const Query: String;const ProxyAddr: String='';
      ProxyPort: integer=0);
 
    property OnComplete: TCompleteQuery read FOnComplete write FOnComplete;
    property OnProgress: TProgressQuery read FOnProgress write FOnProgress;
    property Result: THTTPRec read GetFResult;
    property State: TStateHTTPThread read FState;
    property ConnectionTimeOut: Integer read GetConnectionTimeOut write SetConnectionTimeOut;
    property ReadTimeOut: Integer read GetReadTimeOut write SetReadTimeOut;
    property QueryCount: Integer read GetQueryCount;
//    property ProxyServer: TProxy read FProxy write FProxy;
  end;
 
//Получение максимального количества потоков
function GetMaxThreads: Integer;
 
//Установка максимального количества потоков
procedure SetMaxThreads(aMaxThreads: Integer=10);
 
//завершение всех потоков и очистка списка
procedure TerminateAllThreads;
 
//Завершение конкретного потока
procedure ReleaseThread(Thread:TGetHTTP);
 
//Получение количества потоков в списке
function CheckCountThreads: Integer;
 
//Получение структуры TProxy по параметрам
function proxy(const ProxyAddr: String; ProxyPort: Integer): TProxy;
 
implementation
//uses ufMain;
var
//Максимальное количество потоков - недоступно из других модулей напрямую
  MaxThreads: Integer;
 
procedure SetTimeOut(Value: Cardinal);
var
  TicksNow: Cardinal;
begin
  TicksNow := GetTickCount;
  repeat
    Sleep(100);
    //Application.ProcessMessages;
  until GetTickCount - TicksNow >= Value;
end;
 
{ TGetHTTP }
 
//Получение структуры TProxy по параметрам
function proxy(const ProxyAddr: String; ProxyPort: Integer): TProxy;
begin
  Result.ProxyAddr := ProxyAddr;
  Result.Port := ProxyPort;
end;
 
constructor TGetHTTP.Create;
begin
  if CheckCountThreads=GetMaxThreads then raise Exception.Create('Can''t create thread. MaxThreads='+IntToStr(MaxThreads));
  FQueryList := TList.Create;
  inherited Create(True);
  FreeOnTerminate := False;
  FState := shNone;             //Поток еще не готов принять запрос
  with ThrList.LockList do      //Добавляем поток в список
  try
    Add(Self);
  finally
    ThrList.UnlockList;
  end;
  ConnectionTimeOut := 10000;             //Таймаут по-умолчанию 10 секунд
  ReadTimeOut := 10000;             //Таймаут по-умолчанию 10 секунд
  InitializeCriticalSection(FCS);
//Будем дожидаться инициализации параметров в поточной функции
  FWaitHandle := CreateEvent(nil,True,False,nil);
  Resume;
  try
    if WaitForSingleObject(FWaitHandle,1000)<>WAIT_OBJECT_0 then
    begin
      Release;
      raise Exception.Create('Create object error');
    end;
  finally
    CloseHandle(FWaitHandle);
  end;
end;
 
destructor TGetHTTP.Destroy;
begin
//Очищаем очередь запросов
  while FQueryList.Count>0 do
  begin
    Dispose(PQProxy(FQueryList[0]));
    FQuerylist.Delete(0);
  end;
 
  FQueryList.Free;
  DeleteCriticalSection(FCS);
  inherited;
end;
 
//Получение данных с сервера
procedure TGetHTTP.LoadPage;
var
  P: PQProxy;
begin
  if FState<>shReady then Exit;       //Поток не готов к обработке очередного
                                      //запроса
  if FQuerylist.Count=0 then Exit;    //Очередь запросов пуста
 
 
    FState := shWork;                 //Поток занят
    P := FQueryList[0];               //Выбираем первый запрос из очереди
    FResult.Query := P^.Query;
    FResult.ProxyServer := P^.Proxy.ProxyAddr;
    FResult.ProxyPort := P^.Proxy.Port;
    FResult.ErrorMsg := '';
    FResult.ErrorCode := 0;
    FResult.RecvStr := '';
    FResult.SendStr := '';
    FResult.CountSend := 0;
    FResult.CountRcv := 0;
    FResult.Page := '';
    Dispose(PQProxy(FQueryList[0]));  //Освобождаем ресурс
    FQueryList.Delete(0);
 
    try
    //try
 
      FH := TidHTTP.Create(nil);
      FL := TidLogDebug.Create(nil);
      FS := TIdIOHandlerStack.Create(nil);
      FH.ConnectTimeout := ConnectionTimeout;
      FH.ReadTimeout := ReadTimeout;
      FS.ConnectTimeout := FH.ConnectTimeout ;
      FS.ReadTimeout := FH.ReadTimeout;
      FH.HandleRedirects := FALSE;//Default True////////////////////////////////!!!!!!!!!!!!!
      FH.AllowCookies := FALSE;/////////////////////////////////////////////////!!!!!!!!!!!!!
      //FL := TidLogDebug.Create(nil);
      //FS := TIdIOHandlerStack.Create(nil);
      FS.Intercept := FL;
      FH.IOHandler := FS;
      FL.Active := True;
      FH.OnWork := FHWork;
      FL.OnReceive := FLReceive;
      FL.OnSend := FLSend;
 
      FH.ProxyParams.ProxyServer := FResult.ProxyServer;
      FH.ProxyParams.ProxyPort := FResult.ProxyPort;
    //try
    try
      FResult.Page := FH.Get(FResult.Query);
 
      FResult.ErrorMsg := FH.ResponseText;
      FResult.ErrorCode := FH.ResponseCode;
    except
      on e: Exception do        //Ошибка при получении данных
      begin
        FResult.ErrorMsg := e.Message;
        FResult.ErrorCode := -1;
      end;
    end;
    //finally/////////////////////////////////////////////////////////////////////!!!!!!!!!!!
      if FH.Connected then
      FH.Disconnect;
      if FS.Connected then
      FS.Close;
      FL.Close;
      FL.Active := FALSE;
    //end;
 
    FState := shComplete;       //Поток закончил выполнение запроса
    Synchronize(FComplete);     //Сообщаем пользователю
 
    finally
    FH.Free;
    FS.Free;
    FL.Free;
    end;
 
    FState := shReady;          //Поток свободен для обработки новых запросов
end;
 
procedure TGetHTTP.Execute;
var
  Handles: array[0..0] of THandle;
  M: TMsg;
  RC: Cardinal;
  p: PQProxy;
begin
//Создаём очередь выборки сообщений
  PeekMessage(M, 0, 0, 0, PM_NOREMOVE);
  FState := shReady;
 
  SetEvent(FWaitHandle);
  try
  repeat
//Ожидаем сообщений
    RC := MsgWaitForMultipleObjects(0, Handles, False, 10, QS_POSTMESSAGE);
    case RC of
//Получено сообщение в очередь выборки сообщений
      WAIT_OBJECT_0:
        begin
          GetMessage(M,0,0,0);
          case M.message of
            WM_QUIT:
            Terminate;   //Закончить работу потока
            WM_ADD:               //добавить запрос в очередь запросов
              begin
                p := PQProxy(M.wParam);
                FQueryList.Add(p);
                PostThreadMessage(ThreadId, WM_PROCESS, 0, 0); //Выполнить запрос
              end;
            WM_PROCESS:
            LoadPage; //Получить данные с сервера
          end;
        end;
//Новых сообщений не поступало, но очередь запросов надо проверить
      WAIT_TIMEOUT:
      PostThreadMessage(ThreadId, WM_PROCESS, 0, 0);
    end;
  until Terminated;
  finally
    ReleaseThread(Self);          //Удаляем себя из списка потоков
  end;
end;
 
//Запрос выполнен, обрабатываем данные
procedure TGetHTTP.FComplete;
var
  Action: TActionHTTPThread;
begin
  Action := ahNone;
  if Assigned(FOnComplete) then
  FOnComplete(Self,Action);
  if Action = ahFree then
  Release;
end;
 
procedure TGetHTTP.FHWork(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Int64);
begin
//Увеличиваем соответствующий счетчик
  Lock;
  try
    case AWorkMode of
      wmRead: FResult.CountRcv := AWorkCount;
      wmWrite: FResult.CountSend :=AWorkCount;
    end;
  finally
    Unlock;
  end;
  Synchronize(FProgress);
end;
 
procedure TGetHTTP.FLReceive(ASender: TIdConnectionIntercept;
  var ABuffer: TBytes);
var
  s: {String}AnsiString;
begin
//  Добавляем в буфер полученную информацию
  SetLength(s,Length(ABuffer));
  Move(ABuffer[0],s[1],Length(ABuffer));
  FResult.RecvStr := FResult.RecvStr + s;
end;
 
procedure TGetHTTP.FLSend(ASender: TIdConnectionIntercept;
  var ABuffer: TBytes);
var
  s: {String}AnsiString;
begin
//  Добавляем в буфер отправленную информацию
  SetLength(s,Length(ABuffer));
  Move(ABuffer[1],s[1],Length(ABuffer));
  FResult.SendStr := FResult.SendStr + s;
end;
 
procedure TGetHTTP.Free;
begin
//заменяем процедуру Free на нашу
  Release;
end;
 
//Получили новый запрос
procedure TGetHTTP.Get(const Query: String;const ProxyAddr: String='';
  ProxyPort: integer=0);
var
  p: PQProxy;
begin
//Заполняем структуру с параметрами
  New(p);
  p^.Proxy.ProxyAddr := ProxyAddr;
  p^.Proxy.Port := ProxyPort;
  p^.Query := Query;
  PostThreadMessage(ThreadId,WM_ADD,Integer(p),0);
end;
 
function TGetHTTP.GetConnectionTimeOut: Integer;
begin
  Result := InterlockedExchange(FConnectionTimeOut,FConnectionTimeOut);
end;
 
 
procedure TGetHTTP.SetConnectionTimeOut(const Value: Integer);
begin
  InterlockedExchange(FConnectionTimeOut,Value);
end;
 
procedure TGetHTTP.SetReadTimeOut(const Value: Integer);
begin
  InterlockedExchange(FReadTimeOut,Value);
end;
 
procedure TGetHTTP.Release;
begin
  FreeOnTerminate := True;      //Переводим в состояние автоуничтожения
  Terminate;                    //Взводим флаг Terminated
end;
 
//Закончить выполнение всех потоков
procedure TerminateAllThreads;
var
  i: Integer;
begin
  with ThrList.LockList do
  try
    for i := 0 to Count-1 do
    begin
      try
        TGetHTTP(Items[i]).Release;
      except
      end;
      //Sleep(100);///////////////////////////////////////////////////////////////!!!!!
    end;
  finally
    ThrList.UnlockList;
  end;
end;
 
//Получить максимальное количество потоков.
function GetMaxThreads: Integer;
begin
  Result := InterlockedExchange(MaxThreads,MaxThreads);
end;
 
//Установить максимальное количество потоков.
procedure SetMaxThreads(aMaxThreads: Integer=10);
var
  CurrValue: Integer;
begin
  CurrValue := InterlockedExchange(MaxThreads,MaxThreads);
  if CurrValue>aMaxThreads then
  InterlockedExchange(MaxThreads,aMaxThreads);
end;
 
//Получить теккущее количество потоков
function CheckCountThreads: Integer;
begin
  with ThrList.LockList do
  try
    Result := Count;
  finally
    ThrList.UnlockList;
  end;
end;
 
//Завершить поток
procedure ReleaseThread(Thread:TGetHTTP);
var
  i:Integer;
begin
  with ThrList.LockList do
  try
    for i := 0 to Count-1 do
    begin
      try
        if TGetHTTP(Items[i])=Thread then
        begin
          TGetHTTP(Items[i]).Free;
          Delete(i);
          //Sleep(100);///////////////////////////////////////////////////////////!!!!!!!!!
          break;
        end;
      except
      end;
    end;
  finally
    ThrList.UnlockList;
  end;
end;
 
procedure TGetHTTP.Lock;
begin
  EnterCriticalSection(FCS);
end;
 
procedure TGetHTTP.Unlock;
begin
  LeaveCriticalSection(FCS);
end;
 
procedure TGetHTTP.FProgress;
var
  r,s: Integer;
begin
  if Assigned(FOnProgress) then
  begin
    Lock;
    try
      r := FResult.CountRcv;
      s := FResult.CountSend;
    finally
      Unlock;
    end;
    FOnProgress(Self,r,s);
  end;
end;
 
function TGetHTTP.GetFResult: THTTPRec;
begin
  Lock;
  try
    Result := FResult;
  finally
    Unlock;
  end;
end;
 
 
function TGetHTTP.GetQueryCount: Integer;
begin
  Result := FQuerylist.Count;
end;
 
function TGetHTTP.GetReadTimeOut: Integer;
begin
  Result := InterlockedExchange(FConnectionTimeOut,FConnectionTimeOut);
end;
 
initialization
  MaxThreads := 10;
  ThrList := TThreadList.Create;
finalization
  TerminateAllThreads;
  ThrList.Free;
end.

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls, StdCtrls,
  FineProxy,  uGetHttpThread, Shared,
  ClipBrd, jpeg, PngImage, Buttons, ImgList, XPMan;
 
type
  TForm1 = class(TForm)
    Panel1: TPanel;
    SaveDialog1: TSaveDialog;
    Image1: TImage;
    Label1: TLabel;
    ImageList1: TImageList;
    StatusBar1: TStatusBar;
    BitBtn2: TBitBtn;
    BitBtn1: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    XPManifest1: TXPManifest;
    OpenDialog1: TOpenDialog;
    GroupBox7: TGroupBox;
    Label2: TLabel;
    LabeledEdit1: TLabeledEdit;
    UpDown1: TUpDown;
    Label3: TLabel;
    Label4: TLabel;
    CheckBox7: TCheckBox;
    ListView1: TListView;
    ProgressBar1: TProgressBar;
    UpDown2: TUpDown;
    LabeledEdit2: TLabeledEdit;
    procedure ListView1Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
      const Rect: TRect);
    procedure BitBtn4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function GetSite(const URL: string): String;
    procedure Complete(Sender: TGetHTTP; var Action:TActionHTTPThread);
    function AddThr: Boolean;
    function IsDoneChecking(L: TListView): Boolean;
    function FindItem(L: TListView; Server, Port: String): Integer;
    Procedure Log(Value: String);
    procedure PreWork(StartMsg: String; DisabledButton: TBitBtn);
    procedure PostWork(EndMsg: String);
    function CheckedCount(L: TListView): Integer;
    function ValidCount(L: TListView): Integer;
    function ErrorCount(L: TListView): Integer;
    function Total(L: TListView): Integer;
    procedure CopyToClpbrd(L: TListView);
    procedure SetCanceled(L: TListView);
  end;
 
var
  Form1: TForm1;
  C: TClipBoard;
  //
  FP: TFineProxy;
  //
  WorkRunning: Boolean;
  STOP: Boolean;
  //
  CurIP: String;
  CurAdded: Integer;
  //CurListView: Cardinal;//1=ListView1 etc
 
implementation
 
{$R *.dfm}
 
....................................................
 
////////////////////////////////////////////////////////////////////////////////
 
Procedure SetTimeOut(Value: Cardinal);
var
  TicksNow: Cardinal;
begin
  TicksNow := GetTickCount;
  repeat
    Sleep(100);
    if STOP then
    BREAK;//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    Application.ProcessMessages;
  until GetTickCount - TicksNow >= Value;
end;
 
Procedure TForm1.Log(Value: String);
begin
  //Form1.Memo1.Lines.Add('['+TimeToStr(Now)+'] '+Value);
  StatusBar1.Panels[1].Text := Value;
end;
 
function TForm1.AddThr: Boolean;
begin
  Result := False;
  try
    with TGetHTTP.Create do
    begin
      OnComplete := Complete;
      {ConnectionTimeout := 5000;
      ReadTimeout := 5000;}
      //Deafult 10000
    end;
    Result := True;
  except
  end;
end;
 
........................................................
 
function TForm1.FindItem(L: TListView; Server, Port: String): Integer;
var
I: Integer;
S1, S2: String;
begin
RESULT := -1;
for I := 0 to L.Items.Count - 1 do
begin
S1 := L.Items[I].Caption;
S2 := L.Items[I].SubItems[0];
if (S1 = Server) and (S2 = Port) then
RESULT := I;
if RESULT > -1 then
BREAK;
Application.ProcessMessages;
end;
end;
 
procedure TForm1.Complete(Sender: TGetHTTP; var Action: TActionHTTPThread);
var
  thr: TGetHTTP;
  I: Integer;
begin
  Thr := Sender;
  //
  if Thr.State = shComplete then
  begin
    if CurAdded > 0 then
    CurAdded := CurAdded - 1 else
    CurAdded := 0;
  end;
  //memo1.Lines.Add('Done');
  //
  I := FindItem(ListView1, Thr.Result.ProxyServer, IntToStr(Thr.Result.ProxyPort));
  if I > -1 then
  begin
  //
  if thr.Result.ErrorCode = 200 then
  ListView1.Items[I].SubItems[1] := 'OK' else
  begin
  if POSNew('timed out', Thr.Result.ErrorMsg) <> 0 then
  ListView1.Items[I].SubItems[1] := 'ERROR: Прокси-сервер слишком медленный (' + Thr.Result.ErrorMsg + ')' else
  if POSNew('Too many', Thr.Result.ErrorMsg) <> 0 then
  ListView1.Items[I].SubItems[1] := 'ERROR: Прокси-сервер слишком слабый (' + Thr.Result.ErrorMsg + ')' else
  ListView1.Items[I].SubItems[1] := 'ERROR: Прокси-сервер не валидный (' + Thr.Result.ErrorMsg + ')';
  end;
  if ParseIP(Thr.Result.RecvStr) = CurIP then
  ListView1.Items[I].SubItems[1] := 'ERROR: Прокси-сервер не анонимный';
  //
  ProgressBar1.Position := CheckedCount(ListView1) * 100 div Total(ListView1);
  //
  if STOP then
  LOG('Прерывание... [Всего: ' + IntToStr(Total(ListView1)) + ' Валидных/Невалидных: ' + IntToStr(ValidCount(ListView1)) + '/' + IntToStr(ErrorCount(ListView1)) + ']') else
  LOG('Проверка списка прокси [Всего: ' + IntToStr(Total(ListView1)) + ' Валидных/Невалидных: ' + IntToStr(ValidCount(ListView1)) + '/' + IntToStr(ErrorCount(ListView1)) + ']');
  //
  {if Thr.QueryCount = 0 then
  Action := ahFree;}
  //
  //if {IsDoneChecking(ListView1)}(CheckCountThreads < GetMaxThreads) or STOP then
  //begin
  //if Thr.QueryCount = 0 then
  //Action := ahFree;
  //end;
  end;
end;
 
////////////////////////////////////////////////////////////////////////////////
 
.............................................................
 
.....................................................
 
..........................................................
 
procedure TForm1.BitBtn2Click(Sender: TObject);
var
  i, j: integer;
begin
//WorkRunning := (CheckCountThreads > 0);
if WorkRunning then
begin
  STOP := TRUE;
  TerminateAllThreads;
  BitBtn2.Enabled := FALSE;
  {Log('Прерывание...');
  SetTimeOut(1000);}
  while CheckCountThreads > 0 do
  SetTimeOut(500);
  Log('Проверка прокси прервана пользователем');
  SetTimeOut(1000);
  PostWork('Готово [Всего: ' + IntToStr(Total(ListView1)) + ' Валидных/Невалидных: ' + IntToStr(ValidCount(ListView1)) + '/' + IntToStr(ErrorCount(ListView1)) + ']');//Статистика по проверенным прокси
  //BitBtn2.Enabled := TRUE;
  SetCanceled(ListView1);
  //TerminateAllThreads;
end else
begin
//
if ListView1.Items.Count > 0 then
begin
  CurIP := GetIPAdress;
  //ShowMessage('Ваш IP: ' + CurIP);
//CurListView := 0;
SetMaxThreads(UpDown2.Position);
BitBtn2.Caption := 'Остановить';
  BitBtn2.Glyph := nil;
  ImageList1.GetBitmap(2, BitBtn2.Glyph);
  Application.ProcessMessages;
  PreWork('Проверка списка прокси...', BitBtn1);
  //SetTimeOut(1000);
//
  {CurListView := GetListViewIndex(L);
  WriteStartLogFromListViewName(L);}
  //LOG('Проверка списка прокси...');
  //
  CurAdded := 0;
  //
  while AddThr do;
  {j := 0;
  with ThrList.LockList do
  try
    for i  := 0 to ListView1.Items.Count - 1 do
    begin
      //
      while CurAdded = 10 do
      SetTimeOut(500);
      //
      if j>Count-1 then
      j := 0;
      ListView1.Items[i].SubItems[1] := 'Checking...';
        TGetHTTP(Items[j]).Get(
          'http://internet.yandex.ru/',
          ListView1.Items[i].Caption,//Server
          StrToInt(ListView1.Items[i].SubItems[0]));//Port
      inc(j);
      //
      if STOP then
      BREAK;
      //
      Inc(CurAdded);
      //
    end;
  finally
    ThrList.UnlockList;
  end;
  end;}
  j := 0;
  //
  with ThrList.LockList do
  try
  //
  for i  := 0 to ListView1.Items.Count - 1 do
  begin
  //
  while CurAdded = 10 do
  SetTimeOut(500);
  //
      if j>Count-1 then
      j := 0;
      ListView1.Items[i].SubItems[1] := 'Checking...';
        TGetHTTP(Items[j]).Get(
          'http://internet.yandex.ru/',
          ListView1.Items[i].Caption,//Server
          StrToInt(ListView1.Items[i].SubItems[0]));//Port
      inc(j);
      //
      if STOP then
      BREAK;
      //
      Inc(CurAdded);
      //
  end;
      //
  finally
    ThrList.UnlockList;
  end;
  //
end;
end;
end;
 
...............................................
 
end.

ЗЫ
Сорри за форматирование, нет под рукой полной версии D2010

Я когда то делал массив потоков. Через конструктор собирал, и передавал в поток необходимые парамеиры. Только результаты у меня в базу писались.
Array of Thread. Делал динамическим. Перед началом задавал величину массива (количество потоков)