一个写delphi日志的类
![](https://images.cnblogs.com/OutliningIndicators/ContractedBlock.gif)
1 unit uProgLog; 2 3 interface 4 5 uses 6 Windows, SysUtils, SyncObjs; 7 8 const 9 C_LOG_LEVEL_TRACE = $00000001; 10 C_LOG_LEVEL_WARNING = $00000002; 11 C_LOG_LEVEL_ERROR = $00000004; 12 type 13 EnumSeverity = (TraceLevel, WarningLevel, ErrorLevel, LogLevel); 14 15 function SeverityDesc(severity: EnumSeverity): string; 16 17 type 18 TLogFile = class 19 private 20 FLogKeepDays: Integer; //日志保存时间 21 FLogLevel: DWORD; //日志级别 22 FLogPath: string; //日志保存路径,以"\"结尾 23 FLogAppName: string; //应用程序名(日志文件前缀) 24 25 FCsWriteLogFile: TCriticalSection; 26 FLogFile: TextFile; //日志文件句柄 27 FLogOpened: Boolean; //日志文件是否打开 28 FFileTimeStamp: TTimeStamp; //当前日志文件创建或打开时间 29 30 function GetLogKeepDays(): Integer; 31 procedure SetLogKeepDays(days: Integer); 32 function GetLogLevel(): DWORD; 33 procedure SetLogLevel(level: DWORD); 34 function GetLogPath(): string; 35 procedure SetLogPath(path: string); 36 function GetLogAppName(): string; 37 procedure SetLogAppName(name: string); 38 protected 39 function WriteLogFile(const szFormat: string; const Args: array of const): Boolean; 40 public 41 42 //////////////////////////////////////////////////////////////////////////// 43 //Procedure/Function Name: Trace() 44 //Describe: 记录日志到日志文件。如果日志文件路径不存在,会自动创建。如果日志文件不存在, 45 // 则创建相应的日志文件;如果日子文件已存在,则打开相应的日志文件,并将日志添加到文件结尾。 46 //Input : severity: 日志级别。根据日志级别参数决定该级别日志是否需要保存, 47 // 但LogLevel级别的日志不受日志级别参数影响,都保存到了日志文件。 48 // subject: 模块名称。 49 // desc: 日志内容。 50 //Result : N/A 51 //Catch Exception: No 52 //////////////////////////////////////////////////////////////////////////// 53 procedure Trace(severity: EnumSeverity; const subject, desc: string); overload; 54 55 //////////////////////////////////////////////////////////////////////////// 56 //Procedure/Function Name: Trace() 57 //Describe: 记录日志到日志文件。如果日志文件路径不存在,会自动创建。如果日志文件不存在, 58 // 则创建相应的日志文件;如果日子文件已存在,则打开相应的日志文件,并将日志添加到文件结尾。 59 //Input : severity: 日志级别。根据日志级别参数决定该级别日志是否需要保存, 60 // 但LogLevel级别的日志不受日志级别参数影响,都保存到了日志文件。 61 // subject: 模块名称。 62 // descFormat: 包含格式化信息的日志内容。 63 // Args: 格式化参数数组。 64 //Result : N/A 65 //Catch Exception: No 66 //////////////////////////////////////////////////////////////////////////// 67 procedure Trace(severity: EnumSeverity; const subject, descFormat: string; const Args: array of const); overload; 68 69 //////////////////////////////////////////////////////////////////////////// 70 //Procedure/Function Name: DeleteLogFile() 71 //Describe: 删除超过保存期限的日志文件。在日志文件路径中搜索超过保存期限的日志,将之删除。 72 // 该方法只需在应用程序启动时调用一次,以删除超过保存期限的日志。 73 //Input : N/A 74 //Result : Boolean 成功返回TRUE,失败返回FALSE 75 //Catch Exception: No 76 //////////////////////////////////////////////////////////////////////////// 77 function DeleteLogFile(): Boolean; 78 79 constructor Create(); 80 Destructor Destroy(); override; 81 82 property LogKeepDays: Integer read GetLogKeepDays write SetLogKeepDays; 83 property Level: DWORD read GetLogLevel write SetLogLevel; 84 property LogPath: string read GetLogPath write SetLogPath; 85 property LogAppName: string read GetLogAppName write SetLogAppName; 86 end; 87 88 function BooleanDesc(Value : Boolean): string; 89 90 implementation 91 92 uses Forms, SqlTimSt; 93 94 function BooleanDesc(Value : Boolean): string; 95 begin 96 if Value then Result := 'TRUE' 97 else Result := 'FALSE'; 98 end; 99 100 function SeverityDesc(severity: EnumSeverity): string; 101 begin 102 if (severity = ErrorLevel) then result := 'X' 103 else if (severity = WarningLevel) then result := '!' 104 else result := ' '; 105 end; 106 107 { TLogFile } 108 109 constructor TLogFile.Create; 110 begin 111 FLogOpened := False; 112 FCsWriteLogFile := TCriticalSection.Create; 113 114 FLogKeepDays := 31; 115 FLogLevel := C_LOG_LEVEL_TRACE or C_LOG_LEVEL_WARNING or C_LOG_LEVEL_ERROR; 116 FLogPath := ExtractFilePath(Application.ExeName) + 'Log\'; 117 FLogAppName := ChangeFileExt(ExtractFileName(Application.ExeName),''); 118 end; 119 120 function TLogFile.DeleteLogFile(): Boolean; 121 var 122 rc : DWORD; 123 SearchRec: TSearchRec; 124 bResult: Boolean; 125 FileMask: string; 126 LocalFileTime: TFileTime; 127 FileTime: Integer; 128 begin 129 result := false; 130 rc := GetFileAttributes(PChar(FLogPath)); 131 if (rc = $FFFFFFFF) or (FILE_ATTRIBUTE_DIRECTORY and rc = 0) then exit; 132 133 FileMask := FLogPath + FLogAppName + '*.log'; 134 bResult := FindFirst(FileMask, faAnyFile, SearchRec) = 0; 135 try 136 if bResult then 137 begin 138 repeat 139 if (SearchRec.Name[1] <> '.') and 140 (SearchRec.Attr and faVolumeID <> faVolumeID) and 141 (SearchRec.Attr and faDirectory <> faDirectory) then 142 begin 143 FileTimeToLocalFileTime(SearchRec.FindData.ftCreationTime, LocalFileTime); 144 FileTimeToDosDateTime(LocalFileTime, LongRec(FileTime).Hi, LongRec(FileTime).Lo); 145 // 按照文件创建日期删除文件 146 if FileDateToDateTime(FileTime) <= Now() - GetLogKeepDays() then 147 DeleteFile(FLogPath + SearchRec.Name); 148 end; 149 until FindNext(SearchRec) <> 0; 150 end; 151 finally 152 FindClose(SearchRec); 153 end; 154 end; 155 156 destructor TLogFile.Destroy; 157 begin 158 if (FLogOpened) then CloseFile(FLogFile); 159 FCsWriteLogFile.Free(); 160 inherited; 161 end; 162 163 function TLogFile.GetLogAppName: string; 164 begin 165 result := FLogAppName; 166 end; 167 168 function TLogFile.GetLogKeepDays: Integer; 169 begin 170 result := FLogKeepDays; 171 end; 172 173 function TLogFile.GetLogLevel: DWORD; 174 begin 175 result := FLogLevel; 176 end; 177 178 function TLogFile.GetLogPath: string; 179 begin 180 result := FLogPath; 181 end; 182 183 procedure TLogFile.SetLogAppName(name: string); 184 begin 185 FLogAppName := ChangeFileExt(name, ''); 186 end; 187 188 procedure TLogFile.SetLogKeepDays(days: Integer); 189 begin 190 FLogKeepDays := days; 191 end; 192 193 procedure TLogFile.SetLogLevel(level: DWORD); 194 begin 195 FLogLevel := level; 196 end; 197 198 procedure TLogFile.SetLogPath(path: string); 199 begin 200 if Trim(path) = '' then exit; 201 if path[Length(path)] <> '\' then FLogPath := path + '\' 202 else FLogPath := path; 203 end; 204 205 procedure TLogFile.Trace(severity: EnumSeverity; const subject, desc: string); 206 begin 207 // 根据配置的日志级别决定是否写日志 208 if ((severity = LogLevel) or 209 ((severity = ErrorLevel) and (FLogLevel and C_LOG_LEVEL_ERROR = C_LOG_LEVEL_ERROR)) or 210 ((severity = WarningLevel) and (FLogLevel and C_LOG_LEVEL_WARNING = C_LOG_LEVEL_WARNING)) or 211 ((severity = TraceLevel) and (FLogLevel and C_LOG_LEVEL_TRACE = C_LOG_LEVEL_TRACE))) then 212 begin 213 WriteLogFile('%s @@ %s @ %s $ %s', [SeverityDesc(severity), FLogAppName, subject, desc]); 214 end; 215 end; 216 217 procedure TLogFile.Trace(severity: EnumSeverity; const subject, 218 descFormat: string; const Args: array of const); 219 var 220 desc: string; 221 begin 222 // 根据配置的日志级别决定是否写日志 223 if ((severity = LogLevel) or 224 ((severity = ErrorLevel) and (FLogLevel and C_LOG_LEVEL_ERROR = C_LOG_LEVEL_ERROR)) or 225 ((severity = WarningLevel) and (FLogLevel and C_LOG_LEVEL_WARNING = C_LOG_LEVEL_WARNING)) or 226 ((severity = TraceLevel) and (FLogLevel and C_LOG_LEVEL_TRACE = C_LOG_LEVEL_TRACE))) then 227 begin 228 desc := Format(descFormat, Args); 229 WriteLogFile('%s @@ %s @ %s $ %s', [SeverityDesc(severity), FLogAppName, subject, desc]); 230 end; 231 end; 232 233 234 function TLogFile.WriteLogFile(const szFormat: string; 235 const Args: array of const): Boolean; 236 var 237 fileName: string; 238 currentTime: TDateTime; 239 currentTimeStamp: TTimeStamp; 240 currentSQLTimeStamp: TSQLTimeStamp; 241 buffer: string; 242 szDate, szTime: string; 243 begin 244 result := false; 245 246 //进入临界区,保证多线程环境下此函数能安全执行 247 FCsWriteLogFile.Enter(); 248 try 249 currentTime := Now(); //注意这里得到的是local time 250 currentSQLTimeStamp := DateTimeToSQLTimeStamp(currentTime); 251 currentTimeStamp := DateTimeToTimeStamp(currentTime); 252 253 try 254 // 1. close the current log file? 255 if (FLogOpened and 256 (currentTimeStamp.Date <> FFileTimeStamp.Date)) then 257 begin 258 CloseFile(FLogFile); 259 FLogOpened := False; 260 end; 261 262 // 2. whether to open a new log file? 263 if (not FLogOpened) then 264 begin 265 // 2.1如果指定的日志目录不存在,则创建它 266 if not DirectoryExists(FLogPath) then 267 if not ForceDirectories(FLogPath) then exit; 268 269 // 2.2 然后再打开当前日志文件 270 szDate := Format('%4d%2d%2d', 271 [currentSQLTimeStamp.Year, currentSQLTimeStamp.Month, currentSQLTimeStamp.Day]); 272 // Format函数不支持在宽度不足位添0,只好用replace添加 273 szDate := StringReplace(szDate, ' ', '0', [rfReplaceAll]); 274 275 fileName := Format('%s%s%s.log', [FLogPath, FLogAppName, szDate]); 276 277 Assignfile(FLogFile, fileName); 278 //if FileExists(fileName) then append(FLogFile) 279 //else rewrite(FLogFile); 280 281 //$1 modify by zhajl 2005-11-30 282 // 如果无法打开日志文件,则退出 283 try 284 if FileExists(fileName) then append(FLogFile) 285 else rewrite(FLogFile); 286 FLogOpened := True; 287 except 288 // 如果无法打开日志文件 289 FLogOpened := False; 290 //这里用CloseFile会出现异常 291 //CloseFile(FLogFile); 292 exit; 293 end; 294 295 // 更新文件创建时间。要注意这里是 local time 296 FFileTimeStamp := DateTimeToTimeStamp(currentTime); 297 end; 298 299 // 3. 写日志内容 300 ASSERT(FLogOpened); 301 if (FLogOpened) then 302 begin 303 szDate := Format('%4d/%2d/%2d', 304 [currentSQLTimeStamp.Year, currentSQLTimeStamp.Month, currentSQLTimeStamp.Day]); 305 // Format函数不支持在宽度不足位添0,只好用replace添加 306 szDate := StringReplace(szDate, ' ', '0', [rfReplaceAll]); 307 szTime := Format('%2d:%2d:%2d', 308 [currentSQLTimeStamp.Hour, currentSQLTimeStamp.Minute, currentSQLTimeStamp.Second]); 309 szTime := StringReplace(szTime, ' ', '0', [rfReplaceAll]); 310 311 buffer := Format('%s %s ', [szDate, szTime]); // '%4d/%2d/%2d %2d:%2d:%2d ' 312 buffer := buffer + szFormat; 313 buffer := Format(buffer, Args); 314 315 writeln(FLogFile, buffer); 316 Flush(FLogFile); // 是否考虑性能而注释之? 317 end; 318 except 319 //写日志文件操作中若有异常(如目录是只读的等),则忽略它 320 end; 321 finally 322 FCsWriteLogFile.Leave; //离开临界区 323 end; 324 result := true; 325 end; 326 327 end.