Question

功能

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

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

示例：

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

怎么做到这个？有没有办法做到这一点？，我相信这种方法会更有效。

Answer 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

Answer 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。请注意，本书的在线版本已经过时，您可能需要将其更新为当前版本的omnithreadlibrary来源中的功能。

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

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

考虑到DownloadString的实现，这意味着在HTTP错误的情况下，您的函数会一次又一次地重新返回LResult的先前值，直到无错误下载发生了。这就是我将函数定义更改为在发生错误时没有输出数据的原因。

多线程downloadstring delphi

2 个答案: