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