如何使一個Mutlithreded idhttp調用在StringList上工作

Question

我是新來的線程，我有一個List包含一個字符串。我的目標是讓多個線程能夠工作到這個列表，這個代碼只針對單個線程，因爲我現在正在學習，但是當我按下開始按鈕時，我得到了AV。

type 
    TDemoThread = class(TThread) 
    private 
    procedure Abort; 
    protected 
    procedure Execute; override; 
    public 
    List: TStringList; 
    end; 

procedure TfrmMain.StartButton1Click(Sender: TObject); 
var 
    i: integer; 
    List: Tstrings; 
begin 
    for i := 0 to memo1.Lines.Count - 1 do 
    begin 
    List := TStringList.Create; 
    List.Add(memo1.Lines.Strings[i]); 
    end; 

    Thread := TDemoThread.Create(True); 
    Thread.FreeOnTerminate := True; 
    Thread.Start; 
end; 

procedure TDemoThread.Execute; 
var 
    lHTTP: TIdHTTP; 
    i: integer; 
    X: Tstrings; 
begin 
    inherited; 
    if Terminated then 
    Exit; 

    lHTTP := TIdHTTP.Create(nil); 
    X := TStringList.Create; 
    lHTTP.ReadTimeout := 30000; 
    lHTTP.HandleRedirects := True; 

    for i := 0 to List.Count - 1 do 
    try 
     X.Text := lHTTP.Get('https://instagram.com/' + List.Strings[i]); 
     S := ExtractDelimitedString(X.Text); 
     X.Clear; 
     TThread.Synchronize(nil, 
     procedure 
     begin 
      frmMain.Memo2.Lines.Add(List.Strings[i] + ' : ' + S); 
     end); 
    finally 
    end; 
end; 

Answer 1

就個人而言，我會避免從線程本身更新表單。線程是數據生成器，而不是GUI管理器。所以讓他們分開他們的顧慮。

我會讓所有線程將結果累積到同一個共享容器中，然後創建一個GUI線程來輪詢該容器。人眼看起來很慢，而且Windows GUI也很慢，所以你不應該每秒更新你的GUI 2次或3次以上。它只會浪費CPU負載，並使表單模糊不清。

另一件事是避免使用緩慢的TStringList，除非它的額外功能（這使得它變慢）是必需的。常規的TList<string>就像一個啞容器，而且速度更快。

type 
    TDemoThread = class; 

    TfrmMain = class(TForm) 
    private 
    Fetchers: TThreadList<TDemoThread>; 
    Data:  TThreadList<string>; 

    property inProcess: Boolean read ... write SetInProcess; 
    public 
    procedure AfterConstruction; override; 
    procedure BeforeDestruction; override; 
    .... 
    end; 

    // this demo makes each thread per each line - that is actually a bad design 
    // one better use a thread pool working over the same queue and only have 
    // 20-40 worker threads for all the URLs 
    TDemoThread = class(TThread) 
    private 
    URL: string; 
    List: TThreadList<string>; 
    Tracker: TThreadList<TDemoThread>; 
    protected 
    procedure Execute; override; 
    end; 

procedure TfrmMain.BeforeDestruction; 
begin 
    while TThreadList.Count > 0 do 
    Sleep(100); 

    FreeAndNil(Fetchers); 
    Data.Free; 

    inherited; 
end; 

procedure TfrmMain.AfterConstruction; 
begin 
    Fetchers := TThreadList<TDemoThread>.Create; 
    Data :=  TThreadList<string>.Create; 
    inherited; 
end; 

procedure TfrmMain.StartButton1Click(Sender: TObject); 
var 
    i: integer; 
    List: Tstrings; 
    worker: TDemoThread; 
    URL: string; 
begin 
    If inProcess then exit; 

    for URL in memo1.Lines do begin 
    worker := TDemoThread.Create(True); 
    worker.FreeOnTerminate := True; 
    worker.URL := URL; 
    worker.List := Data; 
    worker.Tracker := Fetchers; 
    Fetchers.Add(worker); 
    end; 

    InProcess := True; 

    for worker in Fetchers do 
    worker.Start; 
end; 

procedure TfrmMain.SetInProcess(const Value: Boolean); 
begin 
    if Value = InProcess then exit; // form already is in this mode 

    FInProcess := Value; 

    memo1.ReadOnly := Value; 
    StartButton.Enabled := not Value; 
    if Value then begin 
    Memo2.Lines.Clear; 
    Data.Clear; 
    end; 

    Timer1.Delay := 500; // twice per second 
    Timer1.Enabled := Value; 

    If not Value then // for future optimisation - make immediate mode change 
    FlushData;  // when last worker thread quits, no waiting for timer event 

    If not Value then 
    ShowMessage('Work complete'); 
end; 

procedure TfrmMain.Timer1Timer(const Sender: TObject); 
begin 
    FlushData; 

    if Fetchers.Count <= 0 then 
    InProcess := False; 
end; 

procedure TfrmMain.FlushData; 
begin 
    Data.LockList; // next two operations should go as non-interruptible atom 
    try 
    Memo2.Lines.AddStrings(Data.ToArray()); 
    Data.Clear; 
    finally 
    Data.UnLockList; 
    end; 
end; 

procedure TDemoThread.Execute; 
var 
    lHTTP: TIdHTTP; 
begin 
    try 
    lHTTP := TIdHTTP.Create(nil); 
    try 
     lHTTP.ReadTimeout := 30000; 
     lHTTP.HandleRedirects := True; 

     S := ExtractDelimitedString(lHTTP.Get('https://instagram.com/' + URL)); 

     List.Add(S); 
    finally 
     lHTTP.Destroy; 
    end; 
    finally 
    Tracker.Remove(Self); 
    end; 
end; 

• http://docwiki.embarcadero.com/Libraries/Seattle/en/System.Classes.TThreadList
• http://docwiki.embarcadero.com/Libraries/Seattle/en/System.Classes.TStrings.AddStrings

PS。就我個人而言，我也會使用OmniThreads庫，因爲它通常使維護數據生成線程更容易。例如，僅管理您創建的線程數就成爲設置一個屬性，並確定所有線程完成工作的時間是另一個線程。您實際上不應該創建一千個線程來獲取所有網址，而應該在Thread Pool中包含10-20個線程，這些線程將採用Input Queue的網址並逐個獲取它們。我建議你閱讀關於OTL的Parallel For和Fork-Join模式http://otl.17slon.com/tutorials.htm - 它可以使這樣一個應用程序更簡潔，更容易編寫。 Pipeline模式可能會更好地匹配此任務 - 因爲您無論如何都會將URL列表準備爲源集合。 StartButtonClick中一半的腳手架將會消失，整個TDemoThread類也會消失。

Answer 2

你的問題是，你永遠不會分配給線程類的List成員：

type 
    TDemoThread = class(TThread) 
    private 
    procedure Abort; 
    protected 
    procedure Execute; override; 
    public 
    List: TStringList; <-- never assigned to, hence always nil 
    end; 

因此，訪問衝突。

它看起來像你試圖將memo1的內容傳遞給線程。我會做到這一點，像這樣：

type 
    TDemoThread = class(TThread) 
    private 
    FData: TStringList; 
    protected 
    procedure Execute; override; 
    public 
    constructor Create; 
    destructor Destroy; override; 
    end; 

constructor TDemoThread.Create(Data: TStrings); 
begin 
    inherited Create(False); 
    FData := TStringList.Create; 
    FData.Assign(Data); 
    FreeOnTerminate := True; 
end; 

destructor TDemoThread.Destroy; 
begin 
    FData.Free; 
    inherited; 
end; 

procedure TDemoThread.Execute; 
var 
    lHTTP: TIdHTTP; 
    i: integer; 
    X: TStrings; 
begin 
    inherited; 
    if Terminated then 
    Exit; 

    lHTTP := TIdHTTP.Create(nil); 
    X := TStringList.Create; 
    lHTTP.ReadTimeout := 30000; 
    lHTTP.HandleRedirects := True; 

    for i := 0 to FData.Count - 1 do 
    try 
     X.Text := lHTTP.Get('https://instagram.com/' + FData[i]); 
     S := ExtractDelimitedString(X.Text); 
     X.Clear; 
     TThread.Synchronize(nil, 
     procedure 
     begin 
      frmMain.Memo2.Lines.Add(FData[i] + ' : ' + S); 
     end); 
    finally 
    end; 
end; 

procedure TfrmMain.StartButton1Click(Sender: TObject); 
begin 
    TDemoThread.Create(memo1.Lines); 
end; 

是沒有意義的創建暫停，然後立即開始。在線程啓動之後，它也不被允許保留對FreeOnTerminate線程的引用，所以我刪除了它。

TDemoThread.Execute中的代碼泄漏，除非您專門在ARC平臺上運行。而嘗試/最後是毫無意義的。你不需要一個字符串列表來保存一個string。假設你沒有使用ARC，它應該是：

procedure TDemoThread.Execute; 
var 
    lHTTP: TIdHTTP; 
    i: integer; 
    S: string; 
begin 
    if Terminated then 
    Exit; 

    lHTTP := TIdHTTP.Create(nil); 
    try 
    lHTTP.ReadTimeout := 30000; 
    lHTTP.HandleRedirects := True; 

    for i := 0 to FData.Count - 1 do 
    begin 
     S := ExtractDelimitedString(lHTTP.Get('https://instagram.com/' + FData[i])); 
     TThread.Synchronize(nil, 
     procedure 
     begin 
      frmMain.Memo2.Lines.Add(FData[i] + ' : ' + S); 
     end); 
    end; 
    finally 
    lHTTP.Free; 
    end; 
end;