Как использовать потоки с idhttp в delphi 10

Question

Мне нужна помощь, чтобы ускорить мой проект, у меня есть 2 ListBoxs, первый пополнен URL-адресами, второй я храню в нем URL-адреса, которые вызывают ошибку 404 из Listbox1, его просто проверка обработать. idhttp занимает около 2 секунд, чтобы проверить 1 URL, я не нужен HTML, вызвать процесс дешифрования требует времени, поэтому я решил добавить темы в моем проекте, мой код до сих пор

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. 

теперь, когда я ударил Button3 Заголовок формы идет TMyThread is Starting..., и ничего не происходит после !, пожалуйста, посмотрите коды, Большое спасибо.

Answer 1

Вы должны использовать отдельный поток для каждого 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 Parallel Programming Library вместо:

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. 

Или:

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.