Многопоточность.

[newmister]

Приветствую.
Пишу прокси чекер. Необходимо реализовать многопоточность проверки (как во всех нормальных чекерах). Получилось только сделать отдельный поток для проверки, но проверяется по 1 прокси. Вопрос: как сделать, чтобы одновременно проверял 2,3 или 10 прокси?

unit x;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Memo2: TMemo;
    IdHTTP1: TIdHTTP;
    Edit1: TEdit;
    Button2: TButton;
    XPManifest1: TXPManifest;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TCheckThread = class(TThread)
  private
    str:string;
  protected
    procedure UpdateForm;
    procedure Execute; override;
    procedure ThreadsCount;
  public
    constructor create(createsuspennded: boolean; const proxy: string);
  end;

var
  Form1: TForm1;
  threads:integer=0;
  line:integer=0;
  CheckThread:TCheckThread;

implementation

{$R *.dfm}
constructor TCheckThread.create(createsuspennded: boolean; const proxy: string);
begin
inherited create(createsuspennded);
str:=proxy;
end;

procedure TCheckThread.Execute;
var prov:string;
begin
Form1.IdHttp1.ProxyParams.ProxyServer:=copy(str,1,pos(':',str)-1);
Form1.IdHttp1.ProxyParams.ProxyPort:=StrToInt(copy(str,pos(':',str)+1,length(str)-pos(':',str)));
try
 Form1.IdHttp1.ReadTimeout:=strtoint(form1.edit1.Text);
 prov:=Form1.Idhttp1.get('smallwedsite');
  if prov<>'' then Synchronize(UpdateForm);
 except

 end;
  Form1.IdHttp1.Disconnect;
  Synchronize(ThreadsCount);
end;

procedure TCheckThread.UpdateForm;
begin
Form1.memo2.Lines.Add(str);
end;

procedure TCheckThread.ThreadsCount;
begin
threads:=threads-1;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Timer1.Enabled:=True;   //time=200
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Memo1.Clear;
Memo2.Clear;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
If threads=0 then
  begin
  threads:=threads+1;
  CheckThread:=TCheckThread.Create(False,memo1.Lines[line]);
  inc(line);
  end;
if line=memo1.Lines.Count then
  begin
  Timer1.Enabled:=false;
  line:=0;
  end;

end;

end.

[Stilet]

Хм... Я бы обьединил IdHttp и TThread в один класс. Создал массив эких классов и запустил бы все, и пусть они независимо друг от друга работают со своими адресами.

[newmister]

Мысль хорошая.
Как в Делфи наследовать от 2х классов?
В Си просто, указать родителей через запятую, а в делфи что то не нашел как(

[Black Fregat]

Нафига наследовать от двух классов? IdHttp включить как член класса

[newmister]

а, окей) пошел делать)

[newmister]

Изменил свой класс:

type
  TCheckThread = class(TThread)
    IdHTTP1: TIdHTTP;
    str:string;
  private

  protected
    procedure UpdateForm;
    procedure Execute; override;
    procedure ThreadsCount;
  public
    constructor create(createsuspennded: boolean; const proxy: string);
  end;

В остальном все также, только в процедурах вместо Form1.IdHTTP1... оставил IdHTTP1...

в итоге вылетает на строке

IdHttp1.ProxyParams.ProxyServer:=copy(str,1,pos(':',str)-1);

с ошибкой

[Пепел Феникса]

а при создании потока idhttp1:=TidHTTP.Create(nil);
не забыл?
(обьекты то создавать сначало надо, а потом использовать)

[newmister]

Забыл. thx

[Пепел Феникса]

и в деструкторе не забудьте освобождать(Free)

[newmister]

unit checkunit;

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Memo2: TMemo;
    Edit1: TEdit;
    Button2: TButton;
    XPManifest1: TXPManifest;
    Timer1: TTimer;
    ProgressBar1: TProgressBar;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TCheckThread = class(TThread)
    IdHTTP1: TIdHTTP;
    str:string;
  private

  protected
    procedure UpdateForm;
    procedure Execute; override;
    procedure ThreadsCount;
  public
    constructor create(createsuspennded: boolean; const proxy: string);
    destructor Destroy; override;
  end;

var
  Form1: TForm1;
  threads:integer=0;
  line:integer=0;
  TC:integer=0;
  CheckThread:array[0..9] of TCheckThread;

implementation

{$R *.dfm}
constructor TCheckThread.create(createsuspennded: boolean; const proxy: string);
begin
inherited create(createsuspennded);
str:=proxy;
idhttp1:=TidHTTP.Create(nil)
end;

destructor TCheckThread.Destroy;
begin
IdHTTP1.Free;
inherited destroy;
end;

procedure TCheckThread.Execute;
var prov:string;
begin
IdHttp1.ProxyParams.ProxyServer:=copy(str,1,pos(':',str)-1);
IdHttp1.ProxyParams.ProxyPort:=StrToInt(copy(str,pos(':',str)+1,length(str)-pos(':',str)));
try
 IdHttp1.ReadTimeout:=strtoint(form1.edit1.Text);
 prov:=Idhttp1.get('http://new-mister.narod.ru/test.html');
  if prov<>'' then Synchronize(UpdateForm);
 except

 end;
  IdHttp1.Disconnect;
  Synchronize(ThreadsCount);
end;

procedure TCheckThread.UpdateForm;
begin
Form1.memo2.Lines.Add(str);
end;

procedure TCheckThread.ThreadsCount;
begin
threads:=threads-1;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Timer1.Enabled:=True;   //time=200
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Memo1.Clear;
Memo2.Clear;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var i:integer;
begin
If threads=0 then
  begin
  for i:=1 to 10 do
    begin
    if memo1.Lines[line]<>'' then
      CheckThread[threads]:=TCheckThread.Create(False,memo1.Lines[line])
      else break;
    inc(line);
    threads:=i;
    end;
  end;
if line=memo1.Lines.Count then
  begin
  Timer1.Enabled:=false;
  line:=0;
  end;

end;

end.

Сие чудо выкидывает Висту в синий экран.. Где то после отработки procedure TForm1.Timer1Timer(Sender: TObject)