Вы должны использовать отдельный поток для каждого URL-адреса, а не использовать один поток, который перебирает все URL-адреса.
Вместо этого попробуйте что-то вроде этого:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
ListBox2: TListBox;
Button3: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
procedure MyThreadPathResult(const APath: string; AResult: Boolean);
procedure MyThreadStatus(const AStr: string);
end;
var
Form1: TForm1;
implementation
uses
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, IdSSLOpenSSL;
type
TMyThreadPathResultEvent = procedure(const APath: string; AResult: Boolean) of object;
TMyThreadStatusEvent = procedure(const APath, AStr: string) of object;
TMyThread = class(TThread)
private
fPath: string;
fOnPathResult: TMyThreadPathResultEvent;
fOnStatus: TMyThreadStatusEvent;
procedure PathResult(AResult: Boolean);
procedure ShowStatus(const Str: string);
protected
procedure Execute; override;
public
constructor Create(const APath: string); reintroduce;
property OnPathResult: TMyThreadPathResultEvent read fOnPathResult write fOnPathResult;
property OnStatus: TMyThreadStatusEvent read fOnStatus write fOnStatus;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
i: Integer;
Thread: TMyThread;
begin
for i := 0 to ListBox1.Items.Count-1 do
begin
Thread := TMyThread.Create(ListBox1.Items.Strings[i]);
Thread.OnPathResult := MyThreadPathResult;
Thread.OnStatus := MyThreadStatus;
Thread.Start;
end;
end;
procedure TForm1.MyThreadPathResult(const APath: string; AResult: Boolean);
begin
if AResult then
Memo1.Lines.Add(APath)
else
ListBox2.Items.Add(APath);
end;
procedure TForm1.MyThreadStatus(const AStr: string);
begin
Caption := AStr;
end;
constructor TMyThread.Create(const APath: string);
begin
inherited Create(True);
FreeOnTerminate := True;
fPath := APath;
end;
procedure TMyThread.Execute;
var
lHTTP: TIdHTTP;
IdSSL: TIdSSLIOHandlerSocketOpenSSL;
begin
ShowStatus('TMyThread Starting...');
lHTTP := TIdHTTP.Create(nil);
try
lHTTP.ReadTimeout := 30000;
lHTTP.HandleRedirects := True;
IdSSL := TIdSSLIOHandlerSocketOpenSSL.Create(lHTTP);
IdSSL.SSLOptions.Method := sslvTLSv1;
IdSSL.SSLOptions.Mode := sslmClient;
lHTTP.IOHandler := IdSSL;
ShowStatus('TMyThread Running...');
try
lHTTP.Get('http://website.com/'+fPath, TStream(nil));
except
on E: EIdHTTPProtocolException do
begin
if E.ErrorCode = 404 then
PathResult(False)
else
raise;
end;
end;
finally
lHttp.Free;
end;
PathResult(True);
end;
procedure TMyThread.PathResult(AResult: Boolean);
begin
if Assigned(fOnPathResult) then
begin
TThread.Synchronize(
procedure
begin
if Assigned(fOnPathResult) then
fOnPathResult(fPath, AResult);
end
);
end;
end;
procedure TMyThread.ShowStatus(const Str: string);
begin
if Assigned(fOnStatus) then
begin
TThread.Synchronize(
procedure
begin
if Assigned(fOnStatus) then
fOnStatus(fPath, Str);
end
);
end;
end;
end.
С учетом сказанного вы можете вместо этого использовать библиотеку параллельного программирования Delphi:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
ListBox2: TListBox;
Button3: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
uses
System.Threading, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, IdSSLOpenSSL;
procedure TForm1.Button3Click(Sender: TObject);
begin
TParallel.&For(0, ListBox1.Items.Count-1,
procedure(AIndex: Integer)
var
lPath: string;
lHTTP: TIdHTTP;
IdSSL: TIdSSLIOHandlerSocketOpenSSL;
begin
TThread.Synchronize(nil,
procedure
begin
Form1.Caption := 'Task Starting...';
lPath := ListBox1.Items.Strings[AIndex];
end;
end;
lHTTP := TIdHTTP.Create(nil);
try
lHTTP.ReadTimeout := 30000;
lHTTP.HandleRedirects := True;
IdSSL := TIdSSLIOHandlerSocketOpenSSL.Create(lHTTP);
IdSSL.SSLOptions.Method := sslvTLSv1;
IdSSL.SSLOptions.Mode := sslmClient;
lHTTP.IOHandler := IdSSL;
TThread.Synchronize(nil,
procedure
begin
Form1.Caption := 'Task Running...';
end;
end;
try
lHTTP.Get('http://website.com/'+lPath, TStream(nil));
except
on E: EIdHTTPProtocolException do
begin
if E.ErrorCode = 404 then
begin
TThread.Synchronize(nil,
procedure
begin
Form1.ListBox2.Items.Add(lPath);
end
);
end;
Exit;
end;
end;
finally
lHttp.Free;
end;
TThread.Synchronize(nil,
procedure
begin
Form1.Memo1.Lines.Add(lPath);
end
);
end
);
end;
end.
Or:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
ListBox2: TListBox;
Button3: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
uses
System.Threading, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, IdSSLOpenSSL;
procedure TForm1.Button3Click(Sender: TObject);
var
i: Integer;
lPath: string;
begin
for i := 0 to ListBox1.Items.Count-1 do
begin
lPath := ListBox1.Items.Strings[i];
TTask.Create(
procedure
var
lHTTP: TIdHTTP;
IdSSL: TIdSSLIOHandlerSocketOpenSSL;
begin
TThread.Synchronize(nil,
procedure
begin
Form1.Caption := 'Task Starting...';
end;
end;
lHTTP := TIdHTTP.Create(nil);
try
lHTTP.ReadTimeout := 30000;
lHTTP.HandleRedirects := True;
IdSSL := TIdSSLIOHandlerSocketOpenSSL.Create(lHTTP);
IdSSL.SSLOptions.Method := sslvTLSv1;
IdSSL.SSLOptions.Mode := sslmClient;
lHTTP.IOHandler := IdSSL;
TThread.Synchronize(nil,
procedure
begin
Form1.Caption := 'Task Running...';
end;
end;
try
lHTTP.Get('http://website.com/'+lPath, TStream(nil));
except
on E: EIdHTTPProtocolException do
begin
if E.ErrorCode = 404 then
begin
TThread.Synchronize(nil,
procedure
begin
Form1.ListBox2.Items.Add(lPath);
end
);
end;
Exit;
end;
end;
finally
lHttp.Free;
end;
TThread.Synchronize(nil,
procedure
begin
Form1.Memo1.Lines.Add(lPath);
end
);
end
).Start;
end;
end;
end.
person
Remy Lebeau
schedule
09.05.2016
TMyThread = class(TThread)
. - person Ken White   schedule 09.05.2016TMyThread.Execute
. Кроме того, подсчитайте количество переменных TIdHTTP и TIdSSL, которые вы объявляете (на уровне формы, на уровне класса потока и дважды в коде как локальные переменные), а затем подсчитайте количество, которое вы фактически используете для каких-либо действий. Заметили проблему (например, декларируете в три или четыре раза больше, чем нужно)? - person Ken White   schedule 09.05.2016IdSSL
и `lHTTP`, что дальше? @КенУайт - person ColdZer0   schedule 10.05.2016TStream
в необязательный параметрAResponseContent
параметраTIdHTTP.Get()
, он отбросит все полученные данные и вообще не будет пытаться их декодировать. - person Remy Lebeau   schedule 10.05.2016