Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 15.11.2014, 18:29   #1
Shouldercannon
Участник клуба Подтвердите свой е-майл
 
Аватар для Shouldercannon
 
Регистрация: 26.01.2008
Сообщений: 1,897
Вопрос Работа потока останавливается после входа в критическую секцию

Доброго времени суток!
Используя критические секции частенько сталкиваюсь с проблемой, когда после CS.Enter; происходит остановка работы потока. В данном примере это врятли будет, но когда работаешь с IdHTTP, такое наблюдается, особенно когда происходят ошибки (хост недоступен или что-то подобное) и критическая секция используется только в одном потоке. Из-за чего такое происходит?
Код:
...
type
  TTest_Thread = class(TThread)
  private
    { Private declarations }
    s: string;
  protected
    procedure Execute; override;
    procedure SyncProc;
  public
  end;

var
  Form1: TForm1;
  Test_Thread: TTest_Thread;
  CS: TCriticalSection;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  CS := TCriticalSection.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(CS);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Test_Thread := TTest_Thread.Create(True);
  Test_Thread.FreeOnTerminate := True;
  Test_Thread.Resume;
end;

procedure TTest_Thread.Execute;
var
  i: Integer;
begin
  CS.Enter; // При отладке после этого места наступает тишина
  for i := 0 to 5 do
  begin
    s := s + IntToStr(i);
  end;

  Synchronize(SyncProc);

  CS.Leave;

  Terminate;
end;

procedure TTest_Thread.SyncProc;
begin
  Form1.Caption := s;
end;
Shouldercannon вне форума Ответить с цитированием
Старый 15.11.2014, 18:39   #2
Slym
Участник клуба
 
Регистрация: 07.12.2011
Сообщений: 1,025
По умолчанию

1. потому что исключения не обрабатываешь.
надо
Код:
CS.Enter;
try
....
finally
  CS.Leave;
end;
2.
Код:
CS.Enter;
Synchronize(SyncProc);
CS.Leave;
двойная синхронизация - словить дедлок недолго

зачем одному потоку CS?
Не стесняемся, плюсуем!
Slym вне форума Ответить с цитированием
Старый 16.11.2014, 14:31   #3
Shouldercannon
Участник клуба Подтвердите свой е-майл
 
Аватар для Shouldercannon
 
Регистрация: 26.01.2008
Сообщений: 1,897
По умолчанию

Работает! Но перестаёт работать если выполняешь код из другого Unit
Код:
procedure TFormMain.TBRefreshUsersClick(Sender: TObject);
begin
  GetUsers_Thread := TGetUsers_Thread.Create(True);
  GetUsers_Thread.URL := Format('http://%s/%s/%s', [FormMain.ChatHost, WorkFolder, UsersFile]);
  GetUsers_Thread.FreeOnTerminate := True;
  GetUsers_Thread.Resume;
end;

procedure TGetUsers_Thread.Execute;
begin
  CS.Enter;
  try
    Users := GetUsers(URL);
    Synchronize(SyncProc);
  finally
    CS.Leave;
  end;

  Terminate;
end;
...
Utils
...
function GetUsers(URL: string): TUsersDataArr;
var
  HTTP: TIdHTTP;
  s: string;
  i: Integer;
begin
  try
    HTTP := TIdHTTP.Create(nil);
    try
      s := Utf8ToAnsi(HTTP.Get(URL));
    except
    end;
  finally
    FreeAndNil(HTTP);
  end;

  SetLength(Result, 0); // Î÷èñòèì ìàññèâ

  while Pos(SeparatorName, s) <> 0 do
  begin
    i := High(Result) + 2;
    SetLength(Result, i);
    Result[i - 1].UserID := StrToIntDef(Copy(s, 1, Pos('~', s) - 1), -1);
    Delete(s, 1, Pos('~', s));
    Result[i - 1].Nick := Copy(s, 1, Pos('~', s) - 1);
    Delete(s, 1, Pos(SeparatorName, s) + 8);
  end;
end;
Shouldercannon вне форума Ответить с цитированием
Старый 16.11.2014, 20:13   #4
xxbesoxx
Участник клуба
 
Регистрация: 10.08.2010
Сообщений: 1,389
По умолчанию

Цитата:
Работает! Но перестаёт работать если выполняешь код из другого Unit
И что надо для этого , Что процедура или функция мог вызвать из другом Unit тоже
Код:
  public
нет ?

Последний раз редактировалось xxbesoxx; 16.11.2014 в 20:16.
xxbesoxx вне форума Ответить с цитированием
Старый 16.11.2014, 20:42   #5
Slym
Участник клуба
 
Регистрация: 07.12.2011
Сообщений: 1,025
По умолчанию

что-то подсказывает что у тебя косяк с определением Users, а именно не глобально ли он задан?
и про дедлоки ты не внял:

Код:
type
 TGetUsers_Thread=class...
  private
  Users:TUsersDataArr;
... 

procedure TGetUsers_Thread.Execute;
begin
  CS.Enter;
  try
    Users := GetUsers(URL);
  finally
    CS.Leave;
  end;
  Synchronize(SyncProc);
end;
Не стесняемся, плюсуем!
Slym вне форума Ответить с цитированием
Старый 17.11.2014, 13:18   #6
Shouldercannon
Участник клуба Подтвердите свой е-майл
 
Аватар для Shouldercannon
 
Регистрация: 26.01.2008
Сообщений: 1,897
По умолчанию

Цитата:
Сообщение от Slym Посмотреть сообщение
что-то подсказывает что у тебя косяк с определением Users, а именно не глобально ли он задан?
Users был задан в привате, как у вас.
Вот как было
Код:
unit frm_Main;

interface

uses
  ..., Utils{Модуль};

type
  TGetUsers_Thread = class(TThread)
  private
    { Private declarations }
    URL: string;
    Users: TUsersDataArr;
  protected
    procedure Execute; override;
    procedure SyncProc;
  public
  end;

var
  FormMain: TFormMain;
  GetUsers_Thread: TGetUsers_Thread;

implementation

{$R *.dfm}

procedure TFormMain.TBRefreshUsersClick(Sender: TObject);
begin
  GetUsers_Thread := TGetUsers_Thread.Create(True);
  GetUsers_Thread.URL := Format('http://%s/%s/%s', [FormMain.ChatHost, WorkFolder, UsersFile]);
  GetUsers_Thread.FreeOnTerminate := True;
  GetUsers_Thread.Resume;
end;

procedure TGetUsers_Thread.Execute;
begin
  Users := GetUsers(URL);
  Synchronize(SyncProc);

  Terminate;
end;

procedure TGetUsers_Thread.SyncProc;
var
  Item: TListItem;
  i: Integer;
begin
  // Очищаем список пользователей
  FormMain.LVUsers.Clear;
  // Добавляем online пользователей
  for i := 0 to Length(Users) - 1 do
  begin
    if Users[i].Status = 1 then
    begin
      Item := FormMain.LVUsers.Items.Add;
      Item.Caption := '';
      Item.SubItems.Add(Users[i].Nick); // Ник пользователя
      Item.SubItems.Add(IntToStr(Users[i].UserID)); // ID пользователя
    end;
  end;
end;

end.
сам модуль
Код:
unit Utils;

interface

uses
  Windows, SysUtils, IdHTTP;

type
  TUsersDataRec = record
    UserID: Integer;
    Status: Integer;
    Nick: string;
    Cabinet: Integer;
    AdminStatus: Integer;
  end;

  TUsersDataArr = array of TUsersDataRec;

var
  UsersDataArr: array of TUsersDataArr;

function GetUsers(URL: string): TUsersDataArr;

implementation

uses frm_Main;

function GetUsers(URL: string): TUsersDataArr;
var
  HTTP: TIdHTTP;
  s: string;
  i: Integer;
begin
  try
    HTTP := TIdHTTP.Create(nil);
    try
      s := Utf8ToAnsi(HTTP.Get(URL));
    except
    end;
  finally
    FreeAndNil(HTTP);
  end;

  SetLength(Result, 0); // Очистим массив

  while Pos(SeparatorName, s) <> 0 do
  begin
    i := High(Result) + 2;
    SetLength(Result, i);
    Result[i - 1].UserID := StrToIntDef(Copy(s, 1, Pos('~', s) - 1), -1);
    Delete(s, 1, Pos('~', s));
    Result[i - 1].Nick := Copy(s, 1, Pos('~', s) - 1);
    Delete(s, 1, Pos(SeparatorName, s) + 8);
  end;
end;

end.
Цитата:
Сообщение от Slym Посмотреть сообщение
и про дедлоки ты не внял:
Shouldercannon вне форума Ответить с цитированием
Старый 17.11.2014, 17:05   #7
Slym
Участник клуба
 
Регистрация: 07.12.2011
Сообщений: 1,025
По умолчанию

Код:
procedure TGetUsers_Thread.SyncProc;
var
  Item: TListItem;
  i: Integer;
begin
  FormMain.LVUsers.BeginUpdate;//рекомендую
  try
    FormMain.LVUsers.Clear;
    for i := 0 to Length(Users) - 1 do
    begin
      if Users[i].Status = 1 then//доступ к не инициализированной переменной 
      begin
        Item := FormMain.LVUsers.Items.Add;
        Item.Caption := '';
        Item.SubItems.Add(Users[i].Nick); // Ник пользователя
        Item.SubItems.Add(IntToStr(Users[i].UserID)); // ID пользователя
      end;
    end;
  finally
    FormMain.LVUsers.EndUpdate;
  end;
end;
а так ничего криминального не вижу... должно работать
Не стесняемся, плюсуем!
Slym вне форума Ответить с цитированием
Старый 18.11.2014, 21:06   #8
Shouldercannon
Участник клуба Подтвердите свой е-майл
 
Аватар для Shouldercannon
 
Регистрация: 26.01.2008
Сообщений: 1,897
По умолчанию

FormMain.LVUsers.Items.BeginUpdate
FormMain.LVUsers.Items.EndUpdate

А вот теперь получил ошибку AccessViolation при
Код:
  CS.Enter;
  try
    Users := GetUsers(URL);
  finally
    CS.Leave;
  end;
  Synchronize(SyncProc);
Очевидно мой случай просто не предусматривает использование критических секций.
Shouldercannon вне форума Ответить с цитированием
Старый 19.11.2014, 05:45   #9
Slym
Участник клуба
 
Регистрация: 07.12.2011
Сообщений: 1,025
По умолчанию

попробуй совсем без cs..
по мне она тут не нужна... нету у тебя ресурса для синхронизации
Не стесняемся, плюсуем!
Slym вне форума Ответить с цитированием
Старый 19.11.2014, 06:43   #10
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

Честно говоря я тоже думаю что критическая секция тут как пятое колесо зайцу со спущенными рукавами.
I'm learning to live...
Stilet вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Пару вопросов про синхронизацию\критическую секцию bakanaev Общие вопросы Delphi 8 14.03.2013 12:19
Программа вхождения и выхождения в критическую секцию.. hen Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM 1 06.11.2011 22:38
Отображение блока после входа. soonner PHP 5 14.03.2011 16:09
Автоматическое подключение после входа в систему (телефон-компьютер, Linux) Alex Cones Операционные системы общие вопросы 1 22.09.2009 22:20
Виснет вся система после входа в Интернет DeKot Компьютерное железо 12 29.04.2009 00:06