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.
