Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Общие вопросы > Проблема с многопоточностью


Автор: CynicRus 29.8.2013, 09:10
Приветсвую уважаемых форумчан. Задача - организовать скачивание и фильтрацию данных. Использую Win 7 и Delphi XE3 Для этого было заведены кустарных очереди и глобальная крит секция типа TRTLCriticalSection.


Схематичный код очереди:
Код

type
    TURLQueue = class(TList<AnsiString>)
  private
    //FCS: TRTLCriticalSection;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Push(APost: AnsiString);
    function Pop: AnsiString;
  end;
//

constructor TURLQueue.Create;
begin
  inherited Create;
   //InitializeCriticalSection(FCS);
end;

destructor TURLQueue.Destroy;
begin
 //DeleteCriticalSection(FCS);
  inherited;
end;

function TURLQueue.Pop: AnsiString;
begin
  EnterCriticalSection(FCS);
  if (Count > 0) then
  begin
    Result := Items[0];

    Delete(0);
  end
  else
    Result := '';
  LeaveCriticalSection(FCS);
end;

procedure TURLQueue.Push(APost: AnsiString);
begin
  EnterCriticalSection(FCS);
  Add(APost);
  LeaveCriticalSection(FCS);
end;

Критическая секция инициализируется в initialization разделе юнита.

Очереди создаются там же.

Затем я запускаю первый тред, который выглядит:
Код

constructor TThreadUrlWorker.Create(UrlList: TList<AnsiString>;Status: TStatusProc);
begin
 inherited Create(false);
 FUnprocessedUrls:=UrlList;
 FWriteLn:=Status;
end;

destructor TThreadUrlWorker.Destroy;
begin

  inherited;
end;

procedure TThreadUrlWorker.Execute;
var
 i,cnt: integer;
begin
  inherited;
  cnt:=FUnprocessedUrls.Count;
  for I := 0 to cnt-1 do
   begin
   ProcessThreadUrl(FUnprocessedUrls[i]);
    if Assigned(FWriteLn) then
      FWriteLn('We grabbed '+#32+IntToStr(i+1)+#32+'pages from' + #32 + IntToStr(cnt));
   end;
   if Assigned(FWriteLn) then
      FWriteLn('We fully grabbed the post urls!');
  // FPostParser:= TPostsThreadPool.Create(7,FWriteLn);
end;

procedure TThreadUrlWorker.ProcessThreadUrl(Url: AnsiString);
var
 info: ansistring;
 GotUrls: TList<ansistring>;
 i: integer;
begin
 info:=GetPage(Url);
 Sleep(100);
 try
 if (Length(info) > 0) then
  begin
    GotUrls:=GetPostUrls(info);
     if Assigned(GotUrls) then
     for I := 0 to GotUrls.Count-1 do
       begin 
        PostUrlQueue.Push(GotUrls[i]);
        Sleep(100); 
      end;
  end;
 finally
   if Assigned(GotUrls) then
    GotUrls.Free;
 end;

end;


В одиночестве он нормально отрабатывает, вопросов к нему никаких. Кидает в эту кустарную очередь полученые итемы.
После первого треда я запускаю второй тред вида:

Код

constructor TUrlWorker.Create(Status: TStatusProc);
begin
 inherited create(false);
 FWriteLn:=status;
end;

procedure TUrlWorker.Execute;
var
 item: AnsiString;
begin
  inherited;
 while not Terminated do
  begin
  if (PostUrlqueue.Count > 0) then
  begin
    Item:=PostUrlQueue.Pop;
    if not eq(Item,'Empty!') and not eq(Item,'') then
      begin
       processUrl(Item);
       sleep(100);
       end;
    end else sleep(20);
  end;
  //until Terminated;
end;

procedure TUrlWorker.ProcessUrl(Url: AnsiString);
var
 Post: TPost;
 info,userInfo: AnsiString;
 //item: string;
begin
 if Assigned(FWriteLn) then
  FWriteLn('Processing: '+#32+Url);
 info:=GetPage(Url);
 Sleep(100);
 if Length(info) > 0 then
  begin
 userInfo:=GetPage(GetUserUrl(Url));
 sleep(100);
 Post:= CreatePost(Info,UserInfo);
 SearchQueue.Push(Post);
 //FList.Add(Post);
  end;// else exit;
end;

Где SearchingQueue совсем другая очередь, к которой никто не обращается кроме потока 2.

Так вот, по отдельности треды очень даже хорошо работают, а вот вместе - нет. Я подозреваю что проблема в функции GetPage с использованием synapse, которая выглядит:

Код

function GetPage(URL: AnsiString): AnsiString;
var
  HTTP : THTTPSend;
begin;
//EnterCriticalSection(GeneralCS);
  HTTP := THTTPSend.Create;

  HTTP.UserAgent := 'Opera/9.80 (Windows NT 6.0) Presto/2.12.388 Version/12.14';

  Result := '';
  try
    if HTTP.HTTPMethod('GET', URL) then
    begin
      SetLength(result,HTTP.Document.Size);
      HTTP.Document.Read(result[1],length(result));
    end;
  finally
    HTTP.Free;
  end;
//LeaveCriticalSection(GeneralCS);
end;
 

но, критические секции в данной функции проблему не решают, да и по идее - разве не в каждом потоке используется не свой экземпляр функции? Вообщем каким образом мне заставить подобную конструкцию работать?

PS: попробовал завести функцию скачивания каждую, как метод класса моего потока - не помогло. Бьётся память и все тут.

Переход на Indy и заведения своего экземпляра IdHTTP в каждом потоке проблему не решил, всё так же кидает exception на строку 1908 файла GetMem.inc которая выглядит как  mov [eax - 4], edx. И функция зовётся SysGetMem.

Автор: CynicRus 29.8.2013, 10:44
Сделал в очередях критические секции локальными, вызов второго потока сделал из первого, и закомментировал добавление в searchingQueue - падать перестало...Но почему падает то? Нельзя наследоваться от Generic'ов чтоли?

Автор: Illusion Dolphin 29.8.2013, 10:50
Цитата

FWriteLn

Не виже синхронизации этой функции (надеюсь внутри она thread-safe?)

Цитата

if (PostUrlqueue.Count > 0) then

Count не thread-safe

Цитата

Sleep(100/20);

Этого не надо

Цитата

всё так же кидает exception на строку 1908 файла GetMem.inc которая выглядит как  mov [eax - 4], edx. И функция зовётся SysGetMem.

Посмотрите Call-Stack!

Автор: CynicRus 29.8.2013, 11:07
Цитата(Illusion Dolphin @ 29.8.2013,  10:50)
Цитата

FWriteLn

Не виже синхронизации этой функции (надеюсь внутри она thread-safe?)

Цитата

if (PostUrlqueue.Count > 0) then

Count не thread-safe

Цитата

Sleep(100/20);

Этого не надо

Цитата

всё так же кидает exception на строку 1908 файла GetMem.inc которая выглядит как  mov [eax - 4], edx. И функция зовётся SysGetMem.

Посмотрите Call-Stack!

FWriteLn - да, она ThreadSafe, внутри её вызов заключен в критические секции.

Разбираюсь дальше, спасибо за наводку.

Обрамление вызова в крит секции Count так же не помогло-(

Ну а стек выглядит вот так:

user posted image

Автор: Illusion Dolphin 29.8.2013, 11:14
Цитата

Но почему падает то?

Верните как было, дождитесь падения и посмотрите всё-таки на Call-Stack

Автор: CynicRus 29.8.2013, 11:15
Ну вот я смотрю, и падает она в процессе работы при добавлении итема в очередь. Толи критические секции не отрабатывают, толи ещё что...Не пойму.

А вот стек падения с GetMem.ini

user posted image

Автор: Illusion Dolphin 29.8.2013, 11:28
Вот перейдите на ThreadParser.TUrlWorker.ProcessUrl в колстеке и дважды кликните посмотрите на какой строке падает.

Добавлено через 1 минуту и 27 секунд
Вы пользоваться колстеком умеете? smile http://www.gunsmoker.ru/p/blog-page_13.html#exceptions тута были?

Автор: CynicRus 29.8.2013, 11:33
Цитата(Illusion Dolphin @ 29.8.2013,  11:28)
Вот перейдите на ThreadParser.TUrlWorker.ProcessUrl в колстеке и дважды кликните посмотрите на какой строке падает.

Добавлено @ 11:30
Вы пользоваться колстеком умеете? smile http://www.gunsmoker.ru/p/blog-page_13.html#exceptions тута были?

Огромное спасибо! Два дня сношался, но до такой простой вещи не додумался:) Оказалось что падает функция очистки строки от html тэгов-))))

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)