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.