Как сделать 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;
- http://docwiki.embarcadero.com/Libraries/Seattle/en/System.Classes.TThreadList
- http://docwiki.embarcadero.com/Libraries/Seattle/en/System.Classes.TStrings.AddStrings
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;