Как сделать Mutlithreded idhttp вызовы для работы над StringList

Я новичок в потоках, у меня есть список содержит строки. Моя цель - сделать так, чтобы несколько потоков работали с этим списком, это коды только для одного потока, потому что я учусь в настоящее время, однако я получаю 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;

2 ответа

Решение

Лично я бы избегал обновления формы из самих потоков. Потоки здесь являются генераторами данных, а не менеджерами GUI. Так что пусть они разделяют их проблемы.

Я бы заставил все потоки накапливать результаты в одном и том же общем контейнере, а затем создал бы поток с графическим интерфейсом для опроса этого контейнера. Человеческие глаза медленные, а Windows GUI тоже медленный, поэтому не следует обновлять графический интерфейс чаще, чем 2 или 3 раза в секунду. Это будет только тратить нагрузку на процессор и размывать форму до нечитаемости.

Другое дело, чтобы избежать использования медленных 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;

PS. Лично я бы также использовал библиотеку OmniThreads, поскольку она обычно упрощает поддержку потоков, генерирующих данные. Например, просто управление тем, сколько потоков вы создали, становится установкой одного свойства, а определение того, когда все потоки завершили свою работу, - это еще один вкладчик. Вы действительно не должны создавать тысячи потоков для извлечения всех URL, вместо этого у вас должно быть 10-20 потоков в Thread Pool что бы взять URL-адреса из Input Queue и получать их один за другим. Я предлагаю вам прочитать о OTL Parallel For а также Fork-Join шаблоны на http://otl.17slon.com/tutorials.htm - это позволит сделать такое приложение более лаконичным и простым в написании. Pipeline шаблон, вероятно, будет даже лучше соответствовать этой задаче - так как вы в любом случае подготовите список URL-адресов как исходную коллекцию. Половина лесов в StartButtonClick исчезнет, ​​и весь TDemoThread класс тоже.

Ваша проблема в том, что вы никогда не назначаете 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;
Другие вопросы по тегам