i need help to speedup my project,i have 2 ListBoxs, the first is full with URLs, the second i store in it the URLs that causes 404 error from Listbox1, its just checking process. the idhttp takes about 2s to check 1 url, i dont need the html, cause the decryption process takes time, So i decided to add threads in my project, my code so far
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
IdSSLOpenSSL, Vcl.StdCtrls, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdHTTP;
type
TForm1 = class(TForm)
IdHTTP1: TIdHTTP;
Button1: TButton;
ListBox1: TListBox;
ListBox2: TListBox;
Button3: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
public
end;
Type
TMyThread = class(TThread)
IdHTTP1: TIdHTTP;
Button1: TButton;
ListBox1: TListBox;
ListBox2: TListBox;
Button3: TButton;
Memo1: TMemo;
private
fStatusText : string;
lHTTP: TIdHTTP;
protected
procedure Execute; override;
public
Constructor Create(CreateSuspended : boolean);
end;
var
Form1: TForm1;
procedure TForm1.Button3Click(Sender: TObject);
var
MyThread : TMyThread;
begin
MyThread := TMyThread.Create(True);
MyThread.Start;
end;
constructor TMyThread.Create(CreateSuspended : boolean);
var
s: string;
IdSSL : TIdSSLIOHandlerSocketOpenSSL;
begin
FreeOnTerminate := True;
inherited Create(CreateSuspended);
lHTTP := TIdHTTP.Create(nil);
IdSSL := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
try
lHTTP.ReadTimeout := 30000;
lHTTP.IOHandler := IdSSL;
IdSSL.SSLOptions.Method := sslvTLSv1;
IdSSL.SSLOptions.Method := sslvTLSv1;
IdSSL.SSLOptions.Mode := sslmUnassigned;
lHTTP.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(lHTTP);
lHTTP.HandleRedirects := True;
finally
end;
end;
destructor TMyThread.Destroy;
begin
inherited;
end;
procedure TMyThread.Execute;
var
s: string;
i: Integer;
satir: Integer;
str: TStringList;
newStatus : string;
begin
fStatusText := 'TMyThread Starting...';
Synchronize(Showstatus);
fStatusText := 'TMyThread Running...';
while (not Terminated) do
begin
for i:= 0 to satir-1 do
begin
try
lHTTP.Get('http://website.com/'+ListBox1.Items.Strings[i]);
Memo1.Lines.Add(ListBox1.Items[i])
except
on E: EIdHTTPProtocolException do
begin
if E.ErrorCode <> 404 then
raise;
ListBox2.Items.Add(ListBox1.Items[i]);
end;
end;
end;
end;
if NewStatus <> fStatusText then
begin
fStatusText := newStatus;
Synchronize(Showstatus);
end;
end;
procedure TMyThread.ShowStatus;
begin
Form1.Caption := fStatusText;
end;
end.
now when i hit button3 the Form caption goes TMyThread is Starting... and nothing happens after!, please have a look at the codes, Many thanks.
You should be using a separate thread for each URL, not using a single thread that loops through all of the URLs.
Try something more like this instead:
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.
With that said, you could consider using Delphi's Parallel Programming Library instead:
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.