如何在 delphi 10 中使用带有 idhttp 的线程

Question

我需要帮助来加速我的项目，我有 2 个列表框，第一个充满了 URL，第二个我在其中存储了导致 Listbox1 出现 404 错误的 URL，它只是检查过程。 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.

现在，当我点击按钮 3 时，表单标题变为 TMyThread is Starting...，此后什么也没有发生！请查看代码，非常感谢。

Answer 1

您应该为每个 URL 使用单独的线程，而不是使用单个线程循环遍历所有 URLs.

尝试更像这样的东西：

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.

如何在 delphi 10 中使用带有 idhttp 的线程

How to use threads with idhttp in delphi 10

delphi

vcl

delphi-10-seattle

idhttp