Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Delphi [игнор отключен] [закрыт для гостей] / поток зависает / 11 сообщений из 11, страница 1 из 1
26.02.2019, 13:19
    #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:26
    #39779272
goldmi45
goldmi45
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поток зависает
evgen29,

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


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

Но причина зависания вряд ли в этом. Попробуйте IsMultiThread := true; установить перед созданием потока.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
26.02.2019, 13:41
    #39779282
goldmi45
goldmi45
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поток зависает
evgen29goldmi45,
а можно подробности?
так-то и я могу ответить )))
Для начала необходимо отделить расчётную часть от отображения.
Поток не должен обращаться к интерфейсу для получения каких-либо данных. Самое простое - создать в потоке соединение с БД и с ним работать. Отображение можете засунуть в synchronize. Или использовать сообщения форме.
evgen29странно, но даже в примерах delphi подход через synchronize()
Читайте про потоки и синхронизацию. И уж в примерах дельфи нет такого кода, что весь поток выполняется в методе synchronize (как у вас).
evgen29как лечить?
Читать про потоки и синхронизацию. С наскока за пару минут это не осваивается.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
26.02.2019, 13:47
    #39779286
goldmi45
goldmi45
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поток зависает
evgen29,
ну и ещё - мало записей в лог.
Application.ProcessMessages в дополнительном потоке - не нужно.
Протоколируйте доступ на фтп. Наверняка это не атомарная функция.
Протоколируйте время записи - будет видно время выполнения операций.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
26.02.2019, 13:50
    #39779291
evgen29
evgen29
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поток зависает
goldmi45,
да суть в том,что класс лога пишет время записи и по нему можно определить, когда запись была сделана, но проблема в зависании программы, когда программа не отвечает и в лог ничего не пишется.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
26.02.2019, 14:27
    #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:52
    #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
| Ответить | Цитировать | Написать  
27.02.2019, 14:50
    #39779866
_Vasilisk_
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
поток зависает
evgen29странно, но даже в примерах delphi подход через synchronize()Где? Примеры в студию.SinemuriusПопробуйте IsMultiThread := true; установить перед созданием потока.Он устанавливается при вызове функции BeginThread, которая вызывается из конструктора TThread
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Форумы / Delphi [игнор отключен] [закрыт для гостей] / поток зависает / 11 сообщений из 11, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение  
Полит. конфиден.  
созд. / загр.: 409ms
Закрыть
start [/forum/topic.php?fid=58&mobile=1&tid=2039752]:
 0ms
get settings:
 6ms
get forum list:
 9ms
check forum access:
 2ms
check topic access:
 2ms
track hit:
 135ms
get topic data:
 8ms
get forum data:
 2ms
get page messages:
 36ms
get tp. blocked users:
 1ms
others: 208ms
total:  409ms
x
x
Закрыть


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