2

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.

RRUZ
  • 134,889
  • 20
  • 356
  • 483
ColdZer0
  • 233
  • 1
  • 4
  • 19
  • Your code is a mess. First, fix the formatting. Then add the rest (the part where you declare `TMyThread = class(TThread)`. – Ken White May 09 '16 at 19:41
  • Alright, Done @KenWhite – ColdZer0 May 09 '16 at 20:07
  • *Please* learn how to properly format your code (both here and in your code editor). Properly indenting your code makes it much easier to read and understand. – Ken White May 09 '16 at 20:38
  • Your code has many problems, starting with accessing UI controls from within `TMyThread.Execute`. Also, count the number of TIdHTTP and TIdSSL variables you declare (at the form level, the thread class level, and twice in the code as local variables), and then count the number you actually use to do anything. Notice a problem (like declaring three or four times more than you need)? – Ken White May 09 '16 at 20:45
  • im still beginner with threads, so im just testing,its not a matter of declaring variables, its how to synchronize the thread with the UI, the listboxes and the memo1. @KenWhite – ColdZer0 May 09 '16 at 20:55
  • It's a matter of declaring variables as well. You have way too much clutter of the same variables with the same names all mixing scope. Get rid of the excess noise. – Ken White May 09 '16 at 20:58
  • alright, i removed `IdSSL` and ` lHTTP` now what? @KenWhite – ColdZer0 May 09 '16 at 21:10
  • "*i dont need the html, cause the decryption process takes time*" - if you pass a nil `TStream` to the optional `AResponseContent` parameter of `TIdHTTP.Get()`, it will discard any data received and not attempt to decode it at all. – Remy Lebeau May 09 '16 at 22:09
  • 1
    I rolled back your edit, because it was inappropriate. You cannot make edits that substantially change your question after you've received answers to it. The edit can change the meaning of the question entirely, invalidating the answers you've received. If you have a new question, **post a new question**. – Ken White May 10 '16 at 18:44
  • sorry buddy, alright i'll post a new question, thank you for your consideration @KenWhite – ColdZer0 May 10 '16 at 18:48
  • Or at least edit the question to *add* new information based from actions you have taken based on comments/answers, but do not change the content of the original question. – Remy Lebeau May 10 '16 at 18:58
  • very sorry, my bad, i posted i new question [link](http://stackoverflow.com/questions/37146847/how-to-use-ppl-correctly-in-delphi-10) @RemyLebeau – ColdZer0 May 10 '16 at 19:07

1 Answers1

8

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.
Remy Lebeau
  • 555,201
  • 31
  • 458
  • 770