多线程下载字符串delphi答案

【问题标题】：multithread downloadstring delphi多线程下载字符串delphi
【发布时间】：2016-03-29 06:15:04
【问题描述】：

功能

function DownloadString(AUrl: string): string;
var
  LHttp: TIdHttp;
begin
  LHttp := TIdHTTP.Create;
  try
    LHttp.HandleRedirects := true;
    result := LHttp.Get('http://127.0.0.1/a.php?n='+AUrl);
  finally
    LHttp.Free;
  end;
end;

启动

procedure TForm1.Button1Click(Sender: TObject);
var
  LUrlArray: TArray<String>;
begin
  LUrlArray := form1.listbox1.Items.ToStringArray;
  TThread.CreateAnonymousThread(
    procedure
    var
      LResult: string;
      LUrl: string;
    begin
      for LUrl in LUrlArray do
      begin
        LResult := DownloadString(LUrl);
        TThread.Synchronize(nil,
        procedure
        begin
          if Pos('DENEGADA',LResult)>0 then
          begin
            Memo1.Lines.Add(LResult);
          end
          else
          begin
            Memo1.Lines.Add(LResult + 'DIE');
          end;
        end
        );
      end;
    end
  ).Start;
end;

列表框行

http://127.0.0.1/a.php?n=4984
http://127.0.0.1/a.php?n=4986
http://127.0.0.1/a.php?n=4989

在这种情况下，只有一个线程会下载所有 URL 的内容，但我想让它为每个项目创建一个线程...

示例：

thread1 - check item1 listbox - http://127.0.0.1/a.php?n=4984
thread2 - check next item 4986
thread3 - check next item 4989

这是怎么做的？有什么办法吗？，我相信这个方法会更有效。

【问题讨论】：

在CreateAnonymousThread 之前移动for LUrl in LUrlArray ... 怎么样？

标签： multithreading delphi

【解决方案1】：

为了创建单独的线程，你必须像这样绑定 url 变量值：

procedure TForm1.Button1Click(Sender: TObject);
var
  LUrlArray: TArray<String>;
  LUrl: String;

function CaptureThreadTask(const s: String) : TProc;
begin
  Result := 
    procedure
    var 
      LResult : String;
    begin
      LResult := DownloadString(s);
      TThread.Synchronize(nil,
        procedure
        begin
          if Pos('DENEGADA',LResult)>0 then
          begin
            Memo1.Lines.Add(LResult);
          end
          else
          begin
            Memo1.Lines.Add(LResult + 'DIE');
          end;
        end
        );
    end;
end;

begin
  LUrlArray := form1.listbox1.Items.ToStringArray;
  for LUrl in LUrlArray do
    // Bind variable LUrl value like this
    TThread.CreateAnonymousThread( CaptureThreadTask(LUrl)
    ).Start;
end;

见Anonymous Methods Variable Binding

【讨论】：

【解决方案2】：

您可以尝试使用 omnithreadlibrary 的 ForEach 模式：

草稿是这样的：

TMyForm = class(TForm)
private 
   DownloadedStrings: iOmniBlockingCollection;
published
   DownloadingProgress: TTimer;
   MemoSourceURLs: TMemo;
   MemoResults: TMemo;
...
published
   procedure DownloadingProgressOnTimer( Sender: TObject );
   procedure StartButtonClick ( Sender: TObject ); 
.....

private
   property InDownloadProcess: boolean write SetInDownloadProcess;
   procedure FlushCollectedData;
end;

procedure TMyForm.StartButtonClick ( Sender: TObject );  
begin
  DownloadedStrings := TOmniBlockingCollection.Create;

  Parallel.ForEach<string>(MemoSourceURLs.Lines)
     .NumTasks(10) // we do not want to overload computer by millions of threads when given a long list. We are not "fork bomb"

    //  .PreserveOrder - usually not a needed option
     .Into(DownloadedStrings)  // - or you would have to manually seal the container by calling .CompleteAdding AFTER the loop is over in .OnStop option
     .NoWait
     .Execute(
        procedure (const URL: string; var res: TOmniValue)
        var Data: string; Success: Boolean;
        begin
          if my_IsValidUrl(URL) then begin
             Success := my_DownloadString( URL, Data);  
             if Success and my_IsValidData(Data) then begin
                if ContainsText(Data, 'denegada') then
                   Data := Data + ' DIE';
                res := Data;
          end;  
        end
     );

   InDownloadProcess := true;
end;

procedure TMyForm.SetInDownloadProcess(const process: Boolean);
begin
  if process then begin
     StartButton.Hide;
     Prohibit-Form-Closing := true;
     MemoSourceURLs.ReadOnly := true;
     MemoResults.Clear;
     with DownloadingProgress do begin
        Interval := 333; // update data in form 3 times per second - often enough
        OnTimer := DownloadingProgressOnTimer;
        Enabled := True;
     end;
  end else begin
     DownloadingProgress.Enabled := false;
     if nil <> DownloadedStrings then
        FlushCollectedData; // one last time 
     Prohibit-Form-Closing := false;
     MemoSourceURLs.ReadOnly := false;
     StartButton.Show;
  end;
end;

procedure TMyForm.FlushCollectedData;
var s: string; value: TOmniValue; 
begin
  while DownloadedStrings.TryTake(value) do begin
    s := value;
    MemoResults.Lines.Add(s);
  end;

  PostMessage( MemoResults.Handle, .... ); // not SendMessage, not Perform
  // I do not remember, there was something very easy to make the memo auto-scroll to the last line added
end;

procedure TMyForm.DownloadingProgressOnTimer( Sender: TObject );
begin
  if nil = DownloadedStrings then begin
     InDownloadProcess := false;
     exit;
  end;

  FlushCollectedData;

  if DownloadedStrings.IsCompleted then begin
     InDownloadProcess := false;  // The ForEach loop is over, everything was downloaded
     DownloadedStrings := nil;    // free memory 
  end;
end;

PS。请注意，这本书的在线版本很旧，您可能需要将其更新为omnithreadlibrarysources 的当前版本中的功能。

PPS：您的代码有一个细微的错误：

 for LUrl in LUrlArray do
  begin
    LResult := DownloadString(LUrl);

鉴于您对DownloadString 的实现，这意味着在出现HTTP 错误的情况下，您的函数将一次又一次地重新返回LResult 的先前值，并且......直到发生无错误下载。这就是为什么我将您的函数定义更改为在发生错误并且没有给出输出数据时清晰。

【讨论】：