Модераторы: Poseidon, Snowy, bems, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Проблема с многопоточностью, Где-то я туплю. 
V
    Опции темы
CynicRus
Дата 29.8.2013, 09:10 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 248
Регистрация: 31.5.2012

Репутация: нет
Всего: 5



Приветсвую уважаемых форумчан. Задача - организовать скачивание и фильтрацию данных. Использую 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, 09:49
PM MAIL   Вверх
CynicRus
Дата 29.8.2013, 10:44 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 248
Регистрация: 31.5.2012

Репутация: нет
Всего: 5



Сделал в очередях критические секции локальными, вызов второго потока сделал из первого, и закомментировал добавление в searchingQueue - падать перестало...Но почему падает то? Нельзя наследоваться от Generic'ов чтоли?
PM MAIL   Вверх
Illusion Dolphin
Дата 29.8.2013, 10:50 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 36
Всего: 63



Цитата

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!


--------------------
В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5
PM MAIL WWW ICQ   Вверх
CynicRus
Дата 29.8.2013, 11:07 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 248
Регистрация: 31.5.2012

Репутация: нет
Всего: 5



Цитата(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

Это сообщение отредактировал(а) CynicRus - 29.8.2013, 11:14
PM MAIL   Вверх
Illusion Dolphin
Дата 29.8.2013, 11:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 36
Всего: 63



Цитата

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

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


--------------------
В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5
PM MAIL WWW ICQ   Вверх
CynicRus
Дата 29.8.2013, 11:15 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 248
Регистрация: 31.5.2012

Репутация: нет
Всего: 5



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

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

user posted image

Это сообщение отредактировал(а) CynicRus - 29.8.2013, 11:23
PM MAIL   Вверх
Illusion Dolphin
Дата 29.8.2013, 11:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 36
Всего: 63



Вот перейдите на ThreadParser.TUrlWorker.ProcessUrl в колстеке и дважды кликните посмотрите на какой строке падает.

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


--------------------
В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5
PM MAIL WWW ICQ   Вверх
CynicRus
Дата 29.8.2013, 11:33 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 248
Регистрация: 31.5.2012

Репутация: нет
Всего: 5



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

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

Огромное спасибо! Два дня сношался, но до такой простой вещи не додумался:) Оказалось что падает функция очистки строки от html тэгов-))))
PM MAIL   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »


 




[ Время генерации скрипта: 0.0567 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.