ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Delphi [игнор отключен] [закрыт для гостей] / поток зависает
11 сообщений из 11, страница 1 из 1
поток зависает
    #39779266
evgen29
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
evgen29
Гость
Здравствуйте! Суть проблемы в том, что через некоторое время программа зависает. В программе создается поток, который лезет в бд и берет оттуда список фтп, лезет в каждый фтп и считывает кол-во файлов. Далее посчитанное кол-во выводит в таблице.
Работает где-то 4 часа нормально, а потом ни с того ни с сего винда показывает, что программа зависла, при этом никаких ошибок нет, пытался вынести в лог сообщение об ошибках, в лог тоже после зависания перестает писать. Вес программы не увеличивается и стабильно находится в районе 7 мегабайт. Грешу на переполнение очереди сообщений виндовс, но не знаю, как это поправить. Ставил Application.ProcessMessages в дополнительном потоке - не помогает. Также грешу на TIdFtp Indy. И на свои кривые руки )


Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
type

  TMonitorTableThread = class(TThread) //поток для изменения таблицы формы
  private
  protected
    procedure Execute; override;
    procedure CallMonitorCycle;
  end;

...

procedure TMonitorTableThread.Execute;
begin
  while not terminated do
  begin
    synchronize(CallMonitorCycle);
    Sleep(5000);
  end;
end;

//вызов из основного потока
procedure TfmMonitor.FormActivate(Sender: TObject);
begin
  if MonitorTableThread = nil then
  begin
    MonitorTableThread := TMonitorTableThread.Create(True);
    MonitorTableThread.FreeOnTerminate := True;
    MonitorTableThread.Priority := tpIdle;
  end;
  MonitorTableThread.Resume;

end;


procedure TMonitorTableThread.CallMonitorCycle;
var
  recno, e: integer;
  f: string;
  msg: string;
begin
  LogClass.WriteLog('start monitor cycle synchronize');
  try
    e := 1;
    //if DM.pFIBDsTemp.Active then exit;
    LogClass.WriteLog('DM.GetMonitor');
    DM.GetMonitor;
    e := 2;
    DSS.ds_monitor_c.First;
    while not DSS.ds_monitor_c.Eof do
    begin
      DSS.ds_monitor_c.Edit;
      try
        if DSS.ds_monitor_c.FieldValues['DirIn'] <> '' then
        begin
          e := 4;
          DSS.ds_monitor_c.FieldValues['DirInCount'] := GetFileCount(DSS.ds_monitor_c.FieldValues['DirIn']);
          e := 5;
        end else
        begin
          e := 6;
          DSS.ds_monitor_c.FieldValues['DirInCount'] := TFTPMainClass.GetFTPFilesCountStr(
            DSS.ds_monitor_c.FieldValues['FTPINLOGIN'],
            DSS.ds_monitor_c.FieldValues['FTPINPASSW'],
            DSS.ds_monitor_c.FieldValues['FTPINHOST'],
            DSS.ds_monitor_c.FieldValues['FTPINPATH'],
            DSS.ds_monitor_c.FieldValues['FTPINPORT'],
            IntToBool(DSS.ds_monitor_c.FieldValues['FTPINISPASSIVEMODE'])
            );
          e := 7;
        end;
        DSS.ds_monitor_c.FieldValues['dirinerr'] := '';
      except
        on EX: Exception do
        begin
          msg := StringReplace(EX.Message, #13, ' ', [rfReplaceAll]);
          msg := StringReplace(EX.Message, #10, ' ', [rfReplaceAll]);
          DSS.ds_monitor_c.FieldValues['dirinerr'] :=  copy(msg,1,90);
          LogClass.WriteLog('dirin error '+EX.Message);
        end;
      end;
      try
        if DSS.ds_monitor_c.FieldValues['DirOut'] <> '' then
        begin

          e := 8;
          DSS.ds_monitor_c.FieldValues['DirOutCount'] := GetFileCount(DSS.ds_monitor_c.FieldValues['DirOut']);
          e := 9;
        end else
        begin
          e := 10;
          DSS.ds_monitor_c.FieldValues['DirOutCount'] := TFTPMainClass.GetFTPFilesCountStr(
            DSS.ds_monitor_c.FieldValues['FTPOUTLOGIN'],
            DSS.ds_monitor_c.FieldValues['FTPOUTPASSW'],
            DSS.ds_monitor_c.FieldValues['FTPOUTHOST'],
            DSS.ds_monitor_c.FieldValues['FTPOUTPATH'],
            DSS.ds_monitor_c.FieldValues['FTPOUTPORT'],
            IntToBool(DSS.ds_monitor_c.FieldValues['FTPOUTISPASSIVEMODE'])
            );
          e := 11;
        end;
        DSS.ds_monitor_c.FieldValues['dirouterr'] := '';
      except
        on EX: Exception do
        begin
          msg := StringReplace(EX.Message, #13, ' ', [rfReplaceAll]);
          msg := StringReplace(EX.Message, #10, ' ', [rfReplaceAll]);
          DSS.ds_monitor_c.FieldValues['dirouterr'] :=  copy(msg,1,90);
          LogClass.WriteLog('dirout error '+EX.Message);
        end;
      end;
      if DSS.ds_monitor_c.FieldValues['DirError'] <> '' then
      begin
        e := 12;
        DSS.ds_monitor_c.FieldValues['DirErrorCount'] := GetFileCount(DSS.ds_monitor_c.FieldValues['DirError']);
        e := 13;
      end;
    //Application.ProcessMessages;
      if DSS.ds_monitor_c.State = dsEdit then
        DSS.ds_monitor_c.Post;
      e := 14;
      DSS.ds_monitor_c.Next;
    end;
    recno := DSS.ds_monitor.RecNo;
    e := 15;
    //TClientDataSetNoDelta(cxGridElDocsDBTableView1.DataController.DataSource.DataSet).EmptyDataSet;
    fmMonitor.cxGridElDocsDBTableView1.DataController.DataSource := nil;
    e := 16;
    DSS.Data2Ds(DSS.ds_monitor, DSS.ds_monitor_c.Data);
    e := 17;
    DSS.ds_monitor.RecNo := recno;
    e := 18;
    fmMonitor.cxGridElDocsDBTableView1.DataController.DataSource := DM.DSMonitor;
    //SetThreadExecutionState(ES_DISPLAY_REQUIRED);
    e := 19;
  except
    on Exx: Exception do
    begin
      try
        f := DSS.ds_monitor.FieldValues['FCNAME'];
      except
        f := '';
      end;
      msg := Format('шаг %d, формат %s, ошибка %s', [e, f, Exx.Message]);
      msg := StringReplace(msg, #13, ' ', [rfReplaceAll]);
      msg := StringReplace(msg, #10, ' ', [rfReplaceAll]);
      fmMain.StatusBar1.Panels[0].Text := msg;
      LogClass.WriteLog('cycle error '+msg);
    end;
  end;
  //Application.ProcessMessages;
end;
...
Рейтинг: 0 / 0
26.02.2019, 13:19
| Ответить | Цитировать | Написать  
поток зависает
    #39779272
goldmi45
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
goldmi45
Участник
evgen29,

Ваш поток не работает.
Этой командой вы всю работу потока свели на нет.
Код: pascal
1.
synchronize(CallMonitorCycle);


Он выполняется в основном потоке. Синхронизация нужна только для доступа к UI. Чтобы поток заработал, необходимо полностью изменить подход, а не просто "скопировать код".
...
Рейтинг: 0 / 0
26.02.2019, 13:26
| Ответить | Цитировать | Написать  
поток зависает
    #39779274
evgen29
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
evgen29
Гость
goldmi45,
а можно подробности?
так-то и я могу ответить )))
странно, но даже в примерах delphi подход через synchronize()
как лечить?
...
Рейтинг: 0 / 0
26.02.2019, 13:30
| Ответить | Цитировать | Написать  
поток зависает
    #39779278
Sinemurius
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Sinemurius
Участник
goldmi45 безусловно прав. Обязательно почитайте про synchronize и потоки.

Но причина зависания вряд ли в этом. Попробуйте IsMultiThread := true; установить перед созданием потока.
...
Рейтинг: 0 / 0
26.02.2019, 13:37
| Ответить | Цитировать | Написать  
поток зависает
    #39779282
goldmi45
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
goldmi45
Участник
evgen29goldmi45,
а можно подробности?
так-то и я могу ответить )))
Для начала необходимо отделить расчётную часть от отображения.
Поток не должен обращаться к интерфейсу для получения каких-либо данных. Самое простое - создать в потоке соединение с БД и с ним работать. Отображение можете засунуть в synchronize. Или использовать сообщения форме.
evgen29странно, но даже в примерах delphi подход через synchronize()
Читайте про потоки и синхронизацию. И уж в примерах дельфи нет такого кода, что весь поток выполняется в методе synchronize (как у вас).
evgen29как лечить?
Читать про потоки и синхронизацию. С наскока за пару минут это не осваивается.
...
Рейтинг: 0 / 0
26.02.2019, 13:41
| Ответить | Цитировать | Написать  
поток зависает
    #39779286
goldmi45
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
goldmi45
Участник
evgen29,
ну и ещё - мало записей в лог.
Application.ProcessMessages в дополнительном потоке - не нужно.
Протоколируйте доступ на фтп. Наверняка это не атомарная функция.
Протоколируйте время записи - будет видно время выполнения операций.
...
Рейтинг: 0 / 0
26.02.2019, 13:47
| Ответить | Цитировать | Написать  
поток зависает
    #39779291
evgen29
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
evgen29
Гость
goldmi45,
да суть в том,что класс лога пишет время записи и по нему можно определить, когда запись была сделана, но проблема в зависании программы, когда программа не отвечает и в лог ничего не пишется.
...
Рейтинг: 0 / 0
26.02.2019, 13:50
| Ответить | Цитировать | Написать  
поток зависает
    #39779324
Фотография wadman
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
wadman
Участник
evgen29,

попробуй https://github.com/wadman/wthread

скелет твоего приложения будет выглядеть примерно так:
 
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
    Classes, SysUtils, Forms, Controls, Graphics, Dialogs, wcthread;

type

    { TForm1 }

    TForm1 = class(TForm)
        WCThread1: TWCThread; // доп.поток
        Task1: TTask; // задача доп.потока
        procedure FormCreate(Sender: TObject);
        procedure Task1Execute(const Sender: TTask; const Msg: Word; var Param: Variant);
        procedure Task1Message(const Sender: TTask; const Msg: Word; const Param: Variant);
    private

    public

    end;

var
    Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
    Task1.Start; // запуск задачи в другом (дополнительном) потоке
end;

procedure TForm1.Task1Execute(const Sender: TTask; const Msg: Word; var Param: Variant);
begin
    // это выполняется в дополнительном потоке
    // из этого обработчика нельзя обращаться к визуальной части напрямую (гриды, формы и т.п.). только через Sender.PostMessage

    // перед запуском беспокнечно цикла проверяем, что поток не ожидает прибития (например при закрытии приложения)
    while not Sender.Terminated do begin
        // основной цикл работы

        // если нужно что-то сказать главному потоку, то
        Sender.PostMessage(1, 'Тут что-то делается');

        // если нужно поспать между делом, то
        Sender.WaitMs(5000);
        // поток "спит" примерно 5 сек или до его прерывания, закрытия приложения
    end;
end;

procedure TForm1.Task1Message(const Sender: TTask; const Msg: Word; const Param: Variant);
var s: string;
begin
    // этот метод выполняется в основном (главном) потоке, тут можно работать с визуальной частью как обычно
    case Msg of
        1: begin
            s := Param; // тут строка 'Тут что-то делается'
        end;
    end;
end;

end.

...
Рейтинг: 0 / 0
26.02.2019, 14:27
| Ответить | Цитировать | Написать  
поток зависает
    #39779327
Фотография wadman
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
wadman
Участник
Там же есть модуль wlog и потокобезопасная процедура PostToLog для логирования в файл.
...
Рейтинг: 0 / 0
26.02.2019, 14:27
| Ответить | Цитировать | Написать  
поток зависает
    #39779345
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Док
Участник
evgen29,

с учетом замечаний, у тебя логика должна выглядеть примерно так
 
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
  TMonitorTableThread = class(TThread) //поток для изменения таблицы формы
  private
  protected
    procedure Execute; override;
    procedure CallMonitorCycle;
    procedure ShowCurrentTime;
  end;

...

procedure TMonitorTableThread.ShowCurrentTime;
begin
  Form1.Caption:= 'Current time is ' + TimeToStr(today);
end;

...

procedure TMonitorTableThread.Execute;
begin
  while not terminated do
  begin
    synchronize(ShowCurrentTime);
    CallMonitorCycle;
    Sleep(5000);
  end;
end;


Причем, новый коннект, как и сказали, нужно делать в потоке, внутри CallMonitorCycle и закрывать его в той же процедуре, поскольку вызов CallMonitorCycle у тебя происходит циклически, сюда по коду
...
Рейтинг: 0 / 0
26.02.2019, 14:52
| Ответить | Цитировать | Написать  
поток зависает
    #39779866
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_Vasilisk_
Участник
evgen29странно, но даже в примерах delphi подход через synchronize()Где? Примеры в студию.SinemuriusПопробуйте IsMultiThread := true; установить перед созданием потока.Он устанавливается при вызове функции BeginThread, которая вызывается из конструктора TThread
...
Рейтинг: 0 / 0
27.02.2019, 14:50
| Ответить | Цитировать | Написать  
11 сообщений из 11, страница 1 из 1
Форумы / Delphi [игнор отключен] [закрыт для гостей] / поток зависает
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=58&msg=39779272&tid=2039752]:
 0ms
get settings:
 5ms
get forum list:
 10ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 212ms
get topic data:
 8ms
get forum data:
 3ms
get page messages:
 32ms
get tp. blocked users:
 1ms
others: 192ms
total:  469ms
созд. / загр.: 469ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]