1 { Version 041103. Copyright � Alexey A.Chernobaev, 1996-2004 }
2 
3 unit ChckFree;
4 {
5   ������ ������������ ��� �������: �� ��������� ���������, ��� ��� ���������
6   ������� ������������ ����� ����������� ������ ���������.
7 }
8 
9 interface
10 
11 {$I VCheck.inc}
12 {$IFDEF V_D3}{$WRITEABLECONST ON}{$ENDIF}
13 
14 uses
15   LCLType,
16   {$IFDEF LiNUX}
17   Forms, Controls,
18   {$ELSE}
19   Forms, Controls,
20   {$ENDIF}
21   SysUtils, Classes,
22   {$IFDEF V_WIN}
23     {$IFNDEF WIN32}
24       {WinTypes, WinProcs,}Windows,
25     {$ELSE}
26       Windows,
27     {$ENDIF}
28   {$ENDIF}
29   LogFile;
30 
31 procedure RegisterObjectCreate(AnObject: TObject);
32 procedure RegisterObjectFree(AnObject: TObject);
33 
34 implementation
35 
36 {$IFDEF V_D7}
37   {$WARN UNSAFE_TYPE OFF}
38   {$WARN UNSAFE_CAST OFF}
39 {$ENDIF}
40 
41 const
42   LogFileName = 'free_err.log';
43   MaxLogSize = 32768;
44 
45   CreatedObjects: TList = nil;
46 
47 procedure RegisterObjectCreate(AnObject: TObject);
48 begin
49   if CreatedObjects <> nil then CreatedObjects.Add(AnObject);
50 end;
51 
52 procedure RegisterObjectFree(AnObject: TObject);
53 var
54   I: Integer;
55 begin
56   if CreatedObjects <> nil then begin
57     I:=CreatedObjects.IndexOf(AnObject);
58     if I >= 0 then CreatedObjects.Delete(I);
59   end;
60 end;
61 
62 procedure CheckAllFree;
63 var
64   I: Integer;
65   FileName: String;
66 {$IFDEF UNIX}
67 //const
68 //  MB_YESNO = [mbYes,smbNo];
69 //  IDYES = smbYes;
70 {$ENDIF}
71 begin
72   if CreatedObjects.Count > 0 then begin
73     FileName:=ExtractFilePath(Application.ExeName) + LogFileName;
74     if Application.MessageBox(
75       {$IFDEF WIN32}
76       PChar(Format('CheckFree has found some objects were not freed.'#13 +
77         'Add report to log file ''%s''?', [FileName])),
78       {$ELSE}
79       'CheckFree has found some objects were not freed.'#13 +
80         'Add report to log file ''' + LogFileName + '''?',
81       {$ENDIF}
82       'Warning',
83       MB_YESNO) = IDYES then
84     begin
85       WriteStringToLog(FileName, ['*** CheckFree ***'], MaxLogSize, True);
86       for I:=0 to CreatedObjects.Count - 1 do
87         WriteStringToLog(FileName, [TObject(CreatedObjects[I]).ClassName],
88           MaxLogSize, False);
89       WriteStringToLog(FileName, ['*** end ***'], MaxLogSize, False);
90     end;
91   end;
92 end;
93 
94 procedure NewExitProc; far;
95 begin
96   CheckAllFree;
97   CreatedObjects.Free;
98   CreatedObjects:=nil;
99 end;
100 
101 initialization
102   CreatedObjects:=TList.Create;
103   AddExitProc(NewExitProc);
104 end.
105