多线程下载字符串delphi

Question

Function

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;

Boot

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;

Listbox Lines

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

in this case only one thread will download all URL's content but I would like to make it creates a thread for each item...

example:

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

how make this? Is there any way to do this ?, I believe that this method will be more effective.

Answer 1

In order to create separate threads, you have to bind the url variable value like this:

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;

See Anonymous Methods Variable Binding

Answer 2

You can try using ForEach pattern of omnithreadlibrary :

• http://otl.17slon.com/book/chap04.html#highlevel-foreach
• http://otl.17slon.com/book/chap04.html#leanpub-auto-iomniblockingcollection

Draft is like that:

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;

• http://docwiki.embarcadero.com/Libraries/XE4/en/System.StrUtils.ContainsText
• http://docwiki.embarcadero.com/Libraries/Seattle/en/Vcl.ExtCtrls.TTimer_Properties

PS. note that the online version of the book is old, you perhaps would have to update it to features in the current version of the omnithreadlibrary sources.

PPS: your code has a subtle error:

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

Given your implementation of DownloadString that means in the case of HTTP error your function would re-return the previous value of LResult again and again and again and.... until the no-error downloading happened. That is why I changed your function definition to be clear when error happens and no output data is given.