10 / 10 / 6
Регистрация: 14.03.2011
Сообщений: 392
1

Не очищается память при завершении потока

14.11.2015, 14:40. Показов 824. Ответов 11
Метки нет (Все метки)

Добрый день уважаемые форумчане.

Из главного потока создаю поток который работает в цикле
Delphi
1
while not Terminated do
. В этом цикле при достижении какого то условия создаю еще один поток. Создал, поток отработал, поток завершаю, но после завершения
Delphi
1
Thread.Terminate Thread.WaitFor, Thread.Free
- память в диспетчере задач не уменьшается, а за несколько часов только увеличивается.

Если не создавать последний поток. То программа работает стабильно память не растет.

Можете глянуть код потока пожалуйста, может я что то не понимаю...
Кликните здесь для просмотра всего текста
Delphi
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
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
unit uSendThread;
 
interface
 
uses
  Classes, Windows, Messages, SysUtils, Variants, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ScktComp, Spin, Registry, Buttons, ExtCtrls;
  
const
//==============================================================================
 
  SEND_CMD_SENDALLPROGRAM = $A1F0;
 
//==============================================================================
//==============================================================================
 
  RETURN_ERROR_NOSUPPORT_USB = $F6;
  RETURN_ERROR_NO_USB_DISK = $F5;
  RETURN_ERROR_AERETYPE = $F7;
  RETURN_ERROR_RA_SCREENNO = $F8;
  RETURN_ERROR_NOFIND_AREAFILE = $F9;
  RETURN_ERROR_NOFIND_AREA = $FA;
  RETURN_ERROR_NOFIND_PROGRAM = $FB;
  RETURN_ERROR_NOFIND_SCREENNO = $FC;
  RETURN_ERROR_NOW_SENDING = $FD;
  RETURN_ERROR_OTHER = $FF;
  RETURN_NOERROR    = 0;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
 
  Controller_BX_5M1 = $0052;
 
//------------------------------------------------------------------------------
 
type
  MyThread = class(TThread)
   private
    { Private declarations }
    function GetDisplayMode(nDisplayModeIndex: Integer):Integer;
    function GetColor(nColorIndex: Integer):Integer;
    function GetScreenControlTypeValue(): Cardinal;
  public
    { Public declarations }
    function GetErrorMessage(nResult: Cardinal): string;
  protected
    procedure Execute; override;
  end;
 
var
{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}
  AddScreen         : function(nControlType, nScreenNo, nWidth, nHeight, nScreenType, nPixelMode: Integer;
    nDataDA, nDataOE: Integer; nRowOrder, nFreqPar: Integer; pCom: PChar; nBaud: Integer;
    pSocketIP: PChar; nSocketPort: Integer; pWiFiIP: PChar; nWiFiPort: Integer; pFileName: PChar): integer; stdcall;
 
{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}
  AddScreenProgram  : function(nScreenNo, nProgramType: Integer; nPlayLength: Integer;
    nStartYear, nStartMonth, nStartDay, nEndYear, nEndMonth, nEndDay: Integer;
    nMonPlay, nTuesPlay, nWedPlay, nThursPlay, bFriPlay, nSatPlay, nSunPlay: integer;
    nStartHour, nStartMinute, nEndHour, nEndMinute: Integer): Integer; stdcall;
 
{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}
  AddScreenProgramBmpTextArea: function(nScreenNo, nProgramOrd: Integer;
    nX, nY, nWidth, nHeight: integer): Integer; stdcall;
{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}
  AddScreenProgramAreaBmpTextFile: function(nScreenNo, nProgramOrd, nAreaOrd: Integer;
    pFileName: PChar; nShowSingle: Integer; pFontName: PChar; nFontSize, nBold, nFontColor: Integer;
    nStunt, nRunSpeed, nShowTime: Integer): Integer; stdcall;
{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}
  DeleteScreen      : function(nScreenNo: Integer): Integer; stdcall;
{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}
  DeleteScreenProgram: function(nScreenNo, nProgramOrd: Integer): Integer; stdcall;
{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}
  DeleteScreenProgramArea: function(nScreenNo, nProgramOrd, nAreaOrd: Integer): Integer; stdcall;
{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}
  DeleteScreenProgramAreaBmpTextFile: function(nScreenNo, nProgramOrd, nAreaOrd, nFileOrd: Integer): Integer; stdcall;
{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}
  SendScreenInfo    : function(nScreenNo, nSendMode, nSendCmd, nOtherParam1: Integer): Integer; stdcall;
{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}
 
implementation
uses uMain;
 
function MyThread.GetDisplayMode(nDisplayModeIndex: Integer):Integer;
begin
  case nDisplayModeIndex of
  0: Result := 1;         //Static
  1: Result := 4;                 //Cont move left
  2: Result := 38;                       //Cont move right
  3: Result := 6;
    else
    Result := 1;
  end;
end;
 
function MyThread.GetColor(nColorIndex: Integer):Integer;
begin
  case nColorIndex of
  0: Result := 16777215;  //clWhite
  1: Result := 255;                //clRed
  2: Result := 32768;                    //clGreen
  3: Result := 16711680;                           //clBlue
    else
    Result := 16777215;
  end;
end;
 
function MyThread.GetScreenControlTypeValue(): Cardinal;
begin
  Result := Controller_BX_5M1;
end;
 
function MyThread.GetErrorMessage(nResult: Cardinal): string;
begin
  Result := FormatDateTime('YYYY-MM-DD HH:nn:ss', Now) + '--';
  case nResult of
    RETURN_ERROR_AERETYPE:
      Result := Result + 'Area type is wrong. If users get error when add or delete area, will return to there.';
    RETURN_ERROR_RA_SCREENNO:
      Result := Result + 'Already has this screen information';
    RETURN_ERROR_NOFIND_AREAFILE:
      Result := Result + 'Do not find out valid area file;';
    RETURN_ERROR_NOFIND_AREA:
      Result := Result + 'Do not find out valid display area; can use AddScreenProgramBmpTextArea to add area information.';
    RETURN_ERROR_NOFIND_PROGRAM:
      Result := Result + 'Do not find out valid display area; can useAddScreenProgramto add program.';
    RETURN_ERROR_NOFIND_SCREENNO:
      Result := Result + 'Do not find this screen in the system; can use AddScreen.';
    RETURN_ERROR_NOW_SENDING:
      Result := Result + 'It’s communicating now, please try again later.';
    RETURN_ERROR_OTHER:
      Result := Result + 'Other error.';
    RETURN_ERROR_NOSUPPORT_USB:
      Result := Result + 'Do not support USB mode.';
    RETURN_ERROR_NO_USB_DISK:
      Result := Result + 'Do not find out usb route.';
    RETURN_NOERROR:
      Result := Result + 'NoError';
    $01..$18, $FE:
      Result := Result + 'ͨѶ´íÎó';
  else
    Result := Result + 'ÆäËü´íÎó';
  end;
end;
 
 
procedure MyThread.Execute;
var
    f: System.Text;
    a, i, j: Integer;
    one, zero: Boolean;
    hDll              : THandle;
    g_nSendMode       : Cardinal;
    DeviceN           : Integer;
    nResult           : Integer;
 
begin
 if not Terminated then begin
   try
     try
      DeviceN:=1;
 
      one:=False;
      zero:=False;
 
      hDll := LoadLibrary('BX_IV.dll');
      if hDll < 32 then exit;
      AddScreen := GetProcAddress(hDll, 'AddScreen');
      SendScreenInfo := GetProcAddress(hDll, 'SendScreenInfo');
      AddScreenProgram := GetProcAddress(hDll, 'AddScreenProgram');
      AddScreenProgramBmpTextArea := GetProcAddress(hDll, 'AddScreenProgramBmpTextArea');
      AddScreenProgramAreaBmpTextFile := GetProcAddress(hDll, 'AddScreenProgramAreaBmpTextFile');
 
      DeleteScreen := GetProcAddress(hDll, 'DeleteScreen');
      DeleteScreenProgram := GetProcAddress(hDll, 'DeleteScreenProgram');
      DeleteScreenProgramArea := GetProcAddress(hDll, 'DeleteScreenProgramArea');
      DeleteScreenProgramAreaBmpTextFile := GetProcAddress(hDll, 'DeleteScreenProgramAreaBmpTextFile');
 
      g_nSendMode:=2; //Ethernet
 
 
      nResult := DeleteScreen(DeviceN);
      nResult := AddScreen(GetScreenControlTypeValue(), DeviceN,
        192, 64, 1, 2, 0, 0, 0, 0,
        PChar('COM1'), 57600,
        PChar('192.168.5.118'), 5005, '192.168.1.199', 5005, PChar(ExtractFilePath(Application.ExeName) + 'ScreenStatus.ini'));
      nResult := AddScreenProgram(DeviceN, 0, 0, 65535, 11, 26, 2011, 11, 26, 1, 1, 1, 1, 1, 1, 1, 0, 0, 23, 59);
 
 
        //Åñëè ìàññèâ ñ äàíûìè
        for a:=0 to High(Frm_Main.arrTrEntry) do
        begin
           if Frm_Main.arrTrEntry[a]=1 then begin
 
              try
                  Delete(Frm_Main.Tr_number[a], Pos('/', Frm_Main.Tr_number[a]), Length(Frm_Main.Tr_number[a]));
                  Frm_Main.Tr_number[a]:='   '+Frm_Main.Tr_number[a];
 
                AssignFile(f, Frm_Main.myDir+'\text.txt'); //Âåðõíèé íîìåð
                Rewrite(f);
                Write(f, Frm_Main.Tr_number[a]);
                finally
                CloseFile(f);
                one:=True;
                end;
 
 
           end else if Frm_Main.arrTrEntry[a]=2 then begin
              try
                  Delete(Frm_Main.Tr_number[a], Pos('/', Frm_Main.Tr_number[a]), Length(Frm_Main.Tr_number[a]));
                  Frm_Main.Tr_number[a]:='   '+Frm_Main.Tr_number[a];
 
                  AssignFile(f, Frm_Main.myDir+'\text2.txt'); //Íèæíèé íîìåð
                  Rewrite(f);
                  Write(f, Frm_Main.Tr_number[a]);
                finally
                  CloseFile(f);
                  zero:=True;
                end;
           end;
        end;
 
        if one = false then begin
            try
              AssignFile(f, Frm_Main.myDir+'\text.txt');
              Rewrite(f);
              Write(f, '-------------------');
            finally
              CloseFile(f);
            end;
        end;
 
      if zero = false then begin
            try
              AssignFile(f, Frm_Main.myDir+'\text2.txt');
              Rewrite(f);
              Write(f, '-------------------');
            finally
              CloseFile(f);
            end;
        end;
 
          DeleteScreenProgram(DeviceN,0);
          SendScreenInfo(DeviceN, g_nSendMode, SEND_CMD_SENDALLPROGRAM, 0);
 
          nResult := AddScreenProgram(DeviceN, 0, 0, 65535, 11, 26, 2011, 11, 26, 1, 1, 1, 1, 1, 1, 1, 0, 0, 23, 59);
          SendScreenInfo(DeviceN, g_nSendMode, SEND_CMD_SENDALLPROGRAM, 0);
 
        nResult := AddScreenProgramBmpTextArea(DeviceN, 0, 0, 0, 192, 32); //127
        nResult := AddScreenProgramAreaBmpTextFile(DeviceN, 0,
          0, PChar(Frm_Main.myDir+'\text.txt'), 1, PChar('Arial Narrow'),
          28, 0, GetColor(1), GetDisplayMode(0), 40, 0);
 
        nResult := AddScreenProgramBmpTextArea(DeviceN, 0, 0, 34, 192, 30);  //127
        nResult := AddScreenProgramAreaBmpTextFile(DeviceN, 0,
          1, PChar(Frm_Main.myDir+'\text2.txt'), 1, PChar('Arial Narrow'),
          28, 0, GetColor(1), GetDisplayMode(0), 40, 0);
        nResult := SendScreenInfo(DeviceN, g_nSendMode, SEND_CMD_SENDALLPROGRAM, 0);
 
     except
      on E:Exception do ShowMessage(E.Message);
     end;
    finally
      FreeLibrary(hDll);
      
      SetLength(Frm_Main.arrSW,0);
      SetLength(Frm_Main.arrTid,0);
      SetLength(Frm_Main.Tr_number,0);
      SetLength(Frm_Main.arrTrEntry,0);
 
      Terminate;
    end;
  end;
end;
 
end
__________________
Помощь в написании контрольных, курсовых и дипломных работ здесь
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
14.11.2015, 14:40
Ответы с готовыми решениями:

При завершении потока программа вылетает
вроде все работает но почему завершается AccesViolation вкурить немогу( unit reg; interface ...

QThread как очищать память при завершении работы потока?
В моей минипрограммке используется класс наследованный от QThread. Этот объект в качестве полей...

Ошибка при завершении потока
Есть класс DBmanager, для работы с базой данных. По содержанию примерно такой: class DBmanager...

Запуск новой формы при завершении потока
Дело вот в чём, существует поток и при его завершении должна открываться новая форма. Но, Form1...

11
2648 / 2270 / 279
Регистрация: 24.12.2010
Сообщений: 13,725
14.11.2015, 18:40 2
Цитата Сообщение от Critically Посмотреть сообщение
поток который работает в цикле
С ног на голову поставил)

Не поток в цикле, а цикл в потоке !

В этом цикле при достижении какого то условия создаю еще один поток
В упор не вижу в твоем коде ничего подобного.

За то вижу явные несуразности - доп.поток лезет в формы, что сулит лес граблей, а ShowMessage завеломо хлобыщет этими граблями.
0
10 / 10 / 6
Регистрация: 14.03.2011
Сообщений: 392
14.11.2015, 20:18  [ТС] 3
Я выложил код последнего потока ) При отрабатывании которого, память не очищается. Хотя я делаю Free. Если его не вызывать то память не растет, вот я и думаю что где то в этом потоке утечка, но найти ее сам не могу ((

В формах это просто пару глобальных переменных. А ShowMessage так для теста просто был добавлен.


P.S. Мужики выручайте...
0
2648 / 2270 / 279
Регистрация: 24.12.2010
Сообщений: 13,725
14.11.2015, 20:34 4
Цитата Сообщение от Critically Посмотреть сообщение
где то в этом потоке утечка
Чему ж удивляться ?
Наговнокодил - получи утечки)

Бери отладчик и выясняй пошагово что у тебя где не срастается. На то он, отладчик, и существует.
Все что угодно может быть - от утечек в либе до утечек в глоб.переменных, куда ты лезешь из нити и куда не следует лезть, ибо нет этому никакого оправдания.

Цитата Сообщение от Critically Посмотреть сообщение
Terminate;
Это вообще лишняя хрень.
0
10 / 10 / 6
Регистрация: 14.03.2011
Сообщений: 392
14.11.2015, 20:39  [ТС] 5
Тоесть теоретически, утечка может быть из за DLL которую я подгружаю и использую ?
0
2648 / 2270 / 279
Регистрация: 24.12.2010
Сообщений: 13,725
14.11.2015, 20:52 6
Ну а почему нет ?
Тебе видней что либа делает ..

Добавлено через 1 минуту
причем грузишь ты ее почему то внутри try..finally-блока, а не снаружи, как положено по феньшую)

Добавлено через 2 минуты
опять же - файлы открываешь внутри try..finally, а не снаружи

все эти несуразности - потенциальные грабли, которые могут выстрелить в любой момент.. если уже не стреляют)

Добавлено через 1 минуту
Феньшуй гласит:
Delphi
1
2
3
4
5
6
занял ресурс
try
.. поработал с ресурсом ..
finally
  безусловно освободил ресурс, что бы ни случилось в ходе работы с ним
end
0
10 / 10 / 6
Регистрация: 14.03.2011
Сообщений: 392
14.11.2015, 20:56  [ТС] 7
Ну и вообщем когда программа работает больше суток, вылетает Runtime Error, и приложение виснет и глушит систему )) Ничего нельзя открыть )) Приходиться ребутать комп.
0
2648 / 2270 / 279
Регистрация: 24.12.2010
Сообщений: 13,725
14.11.2015, 20:57 8
Прискорбный факт)
0
10 / 10 / 6
Регистрация: 14.03.2011
Сообщений: 392
14.11.2015, 20:58  [ТС] 9
Наверное все таки это библа косячит, ибо она китайская ((
0
2648 / 2270 / 279
Регистрация: 24.12.2010
Сообщений: 13,725
14.11.2015, 21:01 10
На библу можно грешить, но не раньше чем ты приведешь в порядок собственный код.
В том виде в котором он у тебя сейчас - это тихий ужас
0
пофигист широкого профиля
4437 / 2927 / 828
Регистрация: 15.07.2013
Сообщений: 16,859
15.11.2015, 01:05 11
Цитата Сообщение от Critically Посмотреть сообщение
Наверное все таки это библа косячит, ибо она китайская ((
Critically, А ты случайно не из Албании родом?
0
5058 / 3944 / 1303
Регистрация: 14.04.2014
Сообщений: 18,152
Записей в блоге: 18
15.11.2015, 06:49 12
судя по коду, этот поток призван существовать в единственном экземпляре, поэтому сверхстрашного ничего нет
по сути, учитывая единственность главной формы, это разновидность глобального массива.
но только в случае, когда и поток и форма - синглтоны. иначе - сразу выносить в глобальные и прикрывать код критическими секциями.
по-хорошему, нужно завести в классе потока копии этих переменных и заполнять их при создании потока, перед его запуском. (и это нужно сделать, несмотря на рассуждения из первого абзаца )
try стр. 169 перенести в стр.177

еще напрягает большая длина процедуры execute
нужно вынести куски из нее в отдельные процедуры, тогда структура действий буде гораздо понятнее

очень странно выглядит перезаписывание файлов строкой "----------------"
проще сделать это через TStringStream.Create('--------------').SaveToFile(filename);
и все...
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
15.11.2015, 06:49

Не очищается память при связи дочерней формы со статическим классом
Доброго времени суток! Есть Form1-главная, Form2- дочерняя, Static class- класс со статическими...

Корректное освобождение памяти при принудительном завершении потока TThread
У меня в отдельном потоке выполняются некоторые вычисления. В процессе выполнения этой функции...

Как при завершении главного потока прерывать фоновые потоки?
При завершении главного потока фоновые прерываются. Как сделать?

Как проверить очищена ли память при завершении приложения
В приложении динамически создается много переменных: компонентов, классов, Tlist, TStringList. ...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
12
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.