Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[3.144.212.145] |
|
Сообщ.
#1
,
|
|
|
Добрый вечер.
Как работать с 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; |
Сообщ.
#2
,
|
|
|
Один поток работает? Теперь просто запусти 10 потоков.
|
Сообщ.
#3
,
|
|
|
если бы я знал как это сделать я бы не спрашивал тут.
может у кого-нибудь есть пример где много потоков используется. не могу понять как их создавать |
Сообщ.
#4
,
|
|
|
Цитата Anatoly Podgoretsky @ Один поток работает? Теперь просто запусти 10 потоков. Один поток у автора тоже неправильно реализован. Анчоус IdHTTP |
Сообщ.
#5
,
|
|
|
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 % не гарантирую но думаю вот так заработает. |
Сообщ.
#6
,
|
|
|
то ,что надо... Не мог бы помочь разбраться с ошибкой: [Error] uGetHttpThread.pas(185): Incompatible types: 'TIdBytes' and 'Int64' [Error] uGetHttpThread.pas(186): Incompatible types: 'TIdBytes' and 'Int64' прочитал пост: IdHTTP (сообщение #2311934) - не помогло. Прикреплённый файлindy_Download.zip (24.75 Кбайт, скачиваний: 244) |
Сообщ.
#7
,
|
|
|
Анчоус
Исправь в описаниях функций типы. procedure FHWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64); procedure FLReceive(ASender: TIdConnectionIntercept; var ABuffer: TBytes); procedure FLSend(ASender: TIdConnectionIntercept; var ABuffer: TBytes); Ну и в секции реализации такие же параметры должны быть. |
Сообщ.
#8
,
|
|
|
поменять все 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); я в этом не очень пока понимаю,не могли бы сделать готовы пример?плиз) просто на примере легче учиться и разбираться |
Сообщ.
#9
,
|
|
|
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); |
Сообщ.
#10
,
|
|
|
Приветствую, скачал модуль описанный выше и доработал его немного под 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 |
Сообщ.
#11
,
|
|
|
Я когда то делал массив потоков. Через конструктор собирал, и передавал в поток необходимые парамеиры. Только результаты у меня в базу писались.
Array of Thread. Делал динамическим. Перед началом задавал величину массива (количество потоков) |