многопоточного downloadstring Делой

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; 

ListBox Линия

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 

, как это сделать? Есть ли способ сделать это? Я считаю, что этот метод будет более эффективным.

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

Вы можете попробовать использовать ForEach образец omnithreadlibrary:

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

Проект такова:

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. обратите внимание, что онлайн-версия книги устарела, вам, возможно, придется обновить ее до функций в текущей версии источников omnithreadlibrary.

PPS: код имеет тонкую ошибку:

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

Учитывая ваше внедрение DownloadString, что означает, в случае ошибки HTTP ваша функция будет повторно вернуть предыдущее значение LResult снова и снова и снова .... пока не произойдет загрузка без ошибок. Вот почему я изменил определение функции, чтобы быть ясным при возникновении ошибки и не выдавать выходные данные.