unit uProgLog;

interface

uses
Windows, SysUtils, SyncObjs; const
C_LOG_LEVEL_TRACE = $;
C_LOG_LEVEL_WARNING = $;
C_LOG_LEVEL_ERROR = $;
type
EnumSeverity = (TraceLevel, WarningLevel, ErrorLevel, LogLevel); function SeverityDesc(severity: EnumSeverity): string; type
TLogFile = class
private
FLogKeepDays: Integer; //日志保存时间
FLogLevel: DWORD; //日志级别
FLogPath: string; //日志保存路径,以"\"结尾
FLogAppName: string; //应用程序名(日志文件前缀) FCsWriteLogFile: TCriticalSection;
FLogFile: TextFile; //日志文件句柄
FLogOpened: Boolean; //日志文件是否打开
FFileTimeStamp: TTimeStamp; //当前日志文件创建或打开时间 function GetLogKeepDays(): Integer;
procedure SetLogKeepDays(days: Integer);
function GetLogLevel(): DWORD;
procedure SetLogLevel(level: DWORD);
function GetLogPath(): string;
procedure SetLogPath(path: string);
function GetLogAppName(): string;
procedure SetLogAppName(name: string);
protected
function WriteLogFile(const szFormat: string; const Args: array of const): Boolean;
public ////////////////////////////////////////////////////////////////////////////
//Procedure/Function Name: Trace()
//Describe: 记录日志到日志文件。如果日志文件路径不存在,会自动创建。如果日志文件不存在,
// 则创建相应的日志文件;如果日子文件已存在,则打开相应的日志文件,并将日志添加到文件结尾。
//Input : severity: 日志级别。根据日志级别参数决定该级别日志是否需要保存,
// 但LogLevel级别的日志不受日志级别参数影响,都保存到了日志文件。
// subject: 模块名称。
// desc: 日志内容。
//Result : N/A
//Catch Exception: No
////////////////////////////////////////////////////////////////////////////
procedure Trace(severity: EnumSeverity; const subject, desc: string); overload; ////////////////////////////////////////////////////////////////////////////
//Procedure/Function Name: Trace()
//Describe: 记录日志到日志文件。如果日志文件路径不存在,会自动创建。如果日志文件不存在,
// 则创建相应的日志文件;如果日子文件已存在,则打开相应的日志文件,并将日志添加到文件结尾。
//Input : severity: 日志级别。根据日志级别参数决定该级别日志是否需要保存,
// 但LogLevel级别的日志不受日志级别参数影响,都保存到了日志文件。
// subject: 模块名称。
// descFormat: 包含格式化信息的日志内容。
// Args: 格式化参数数组。
//Result : N/A
//Catch Exception: No
////////////////////////////////////////////////////////////////////////////
procedure Trace(severity: EnumSeverity; const subject, descFormat: string; const Args: array of const); overload; ////////////////////////////////////////////////////////////////////////////
//Procedure/Function Name: DeleteLogFile()
//Describe: 删除超过保存期限的日志文件。在日志文件路径中搜索超过保存期限的日志,将之删除。
// 该方法只需在应用程序启动时调用一次,以删除超过保存期限的日志。
//Input : N/A
//Result : Boolean 成功返回TRUE,失败返回FALSE
//Catch Exception: No
////////////////////////////////////////////////////////////////////////////
function DeleteLogFile(): Boolean; constructor Create();
Destructor Destroy(); override; property LogKeepDays: Integer read GetLogKeepDays write SetLogKeepDays;
property Level: DWORD read GetLogLevel write SetLogLevel;
property LogPath: string read GetLogPath write SetLogPath;
property LogAppName: string read GetLogAppName write SetLogAppName;
end; function BooleanDesc(Value : Boolean): string; implementation uses Forms, SqlTimSt; function BooleanDesc(Value : Boolean): string;
begin
if Value then Result := 'TRUE'
else Result := 'FALSE';
end; function SeverityDesc(severity: EnumSeverity): string;
begin
if (severity = ErrorLevel) then result := 'X'
else if (severity = WarningLevel) then result := '!'
else result := ' ';
end; { TLogFile } constructor TLogFile.Create;
begin
FLogOpened := False;
FCsWriteLogFile := TCriticalSection.Create; FLogKeepDays := ;
FLogLevel := C_LOG_LEVEL_TRACE or C_LOG_LEVEL_WARNING or C_LOG_LEVEL_ERROR;
FLogPath := ExtractFilePath(Application.ExeName) + 'Log\';
FLogAppName := ChangeFileExt(ExtractFileName(Application.ExeName),'');
end; function TLogFile.DeleteLogFile(): Boolean;
var
rc : DWORD;
SearchRec: TSearchRec;
bResult: Boolean;
FileMask: string;
LocalFileTime: TFileTime;
FileTime: Integer;
begin
result := false;
rc := GetFileAttributes(PChar(FLogPath));
if (rc = $FFFFFFFF) or (FILE_ATTRIBUTE_DIRECTORY and rc = ) then exit; FileMask := FLogPath + FLogAppName + '*.log';
bResult := FindFirst(FileMask, faAnyFile, SearchRec) = ;
try
if bResult then
begin
repeat
if (SearchRec.Name[] <> '.') and
(SearchRec.Attr and faVolumeID <> faVolumeID) and
(SearchRec.Attr and faDirectory <> faDirectory) then
begin
FileTimeToLocalFileTime(SearchRec.FindData.ftCreationTime, LocalFileTime);
FileTimeToDosDateTime(LocalFileTime, LongRec(FileTime).Hi, LongRec(FileTime).Lo);
// 按照文件创建日期删除文件
if FileDateToDateTime(FileTime) <= Now() - GetLogKeepDays() then
DeleteFile(FLogPath + SearchRec.Name);
end;
until FindNext(SearchRec) <> ;
end;
finally
FindClose(SearchRec);
end;
end; destructor TLogFile.Destroy;
begin
if (FLogOpened) then CloseFile(FLogFile);
FCsWriteLogFile.Free();
inherited;
end; function TLogFile.GetLogAppName: string;
begin
result := FLogAppName;
end; function TLogFile.GetLogKeepDays: Integer;
begin
result := FLogKeepDays;
end; function TLogFile.GetLogLevel: DWORD;
begin
result := FLogLevel;
end; function TLogFile.GetLogPath: string;
begin
result := FLogPath;
end; procedure TLogFile.SetLogAppName(name: string);
begin
FLogAppName := ChangeFileExt(name, '');
end; procedure TLogFile.SetLogKeepDays(days: Integer);
begin
FLogKeepDays := days;
end; procedure TLogFile.SetLogLevel(level: DWORD);
begin
FLogLevel := level;
end; procedure TLogFile.SetLogPath(path: string);
begin
if Trim(path) = '' then exit;
if path[Length(path)] <> '\' then FLogPath := path + '\'
else FLogPath := path;
end; procedure TLogFile.Trace(severity: EnumSeverity; const subject, desc: string);
begin
// 根据配置的日志级别决定是否写日志
if ((severity = LogLevel) or
((severity = ErrorLevel) and (FLogLevel and C_LOG_LEVEL_ERROR = C_LOG_LEVEL_ERROR)) or
((severity = WarningLevel) and (FLogLevel and C_LOG_LEVEL_WARNING = C_LOG_LEVEL_WARNING)) or
((severity = TraceLevel) and (FLogLevel and C_LOG_LEVEL_TRACE = C_LOG_LEVEL_TRACE))) then
begin
WriteLogFile('%s @@ %s @ %s $ %s', [SeverityDesc(severity), FLogAppName, subject, desc]);
end;
end; procedure TLogFile.Trace(severity: EnumSeverity; const subject,
descFormat: string; const Args: array of const);
var
desc: string;
begin
// 根据配置的日志级别决定是否写日志
if ((severity = LogLevel) or
((severity = ErrorLevel) and (FLogLevel and C_LOG_LEVEL_ERROR = C_LOG_LEVEL_ERROR)) or
((severity = WarningLevel) and (FLogLevel and C_LOG_LEVEL_WARNING = C_LOG_LEVEL_WARNING)) or
((severity = TraceLevel) and (FLogLevel and C_LOG_LEVEL_TRACE = C_LOG_LEVEL_TRACE))) then
begin
desc := Format(descFormat, Args);
WriteLogFile('%s @@ %s @ %s $ %s', [SeverityDesc(severity), FLogAppName, subject, desc]);
end;
end; function TLogFile.WriteLogFile(const szFormat: string;
const Args: array of const): Boolean;
var
fileName: string;
currentTime: TDateTime;
currentTimeStamp: TTimeStamp;
currentSQLTimeStamp: TSQLTimeStamp;
buffer: string;
szDate, szTime: string;
begin
result := false; //进入临界区,保证多线程环境下此函数能安全执行
FCsWriteLogFile.Enter();
try
currentTime := Now(); //注意这里得到的是local time
currentSQLTimeStamp := DateTimeToSQLTimeStamp(currentTime);
currentTimeStamp := DateTimeToTimeStamp(currentTime); try
// . close the current log file?
if (FLogOpened and
(currentTimeStamp.Date <> FFileTimeStamp.Date)) then
begin
CloseFile(FLogFile);
FLogOpened := False;
end; // . whether to open a new log file?
if (not FLogOpened) then
begin
// 2.1如果指定的日志目录不存在,则创建它
if not DirectoryExists(FLogPath) then
if not ForceDirectories(FLogPath) then exit; // 2.2 然后再打开当前日志文件
szDate := Format('%4d%2d%2d',
[currentSQLTimeStamp.Year, currentSQLTimeStamp.Month, currentSQLTimeStamp.Day]);
// Format函数不支持在宽度不足位添0,只好用replace添加
szDate := StringReplace(szDate, ' ', '', [rfReplaceAll]); fileName := Format('%s%s%s.log', [FLogPath, FLogAppName, szDate]); Assignfile(FLogFile, fileName);
//if FileExists(fileName) then append(FLogFile)
//else rewrite(FLogFile); //$ modify by zhajl --
// 如果无法打开日志文件,则退出
try
if FileExists(fileName) then append(FLogFile)
else rewrite(FLogFile);
FLogOpened := True;
except
// 如果无法打开日志文件
FLogOpened := False;
//这里用CloseFile会出现异常
//CloseFile(FLogFile);
exit;
end; // 更新文件创建时间。要注意这里是 local time
FFileTimeStamp := DateTimeToTimeStamp(currentTime);
end; // . 写日志内容
ASSERT(FLogOpened);
if (FLogOpened) then
begin
szDate := Format('%4d/%2d/%2d',
[currentSQLTimeStamp.Year, currentSQLTimeStamp.Month, currentSQLTimeStamp.Day]);
// Format函数不支持在宽度不足位添0,只好用replace添加
szDate := StringReplace(szDate, ' ', '', [rfReplaceAll]);
szTime := Format('%2d:%2d:%2d',
[currentSQLTimeStamp.Hour, currentSQLTimeStamp.Minute, currentSQLTimeStamp.Second]);
szTime := StringReplace(szTime, ' ', '', [rfReplaceAll]); buffer := Format('%s %s ', [szDate, szTime]); // '%4d/%2d/%2d %2d:%2d:%2d '
buffer := buffer + szFormat;
buffer := Format(buffer, Args); writeln(FLogFile, buffer);
Flush(FLogFile); // 是否考虑性能而注释之?
end;
except
//写日志文件操作中若有异常(如目录是只读的等),则忽略它
end;
finally
FCsWriteLogFile.Leave; //离开临界区
end;
result := true;
end; end.

Delphi 写日志的类的更多相关文章

  1. C#写日志工具类

    代码: using System; using System.Collections.Generic; using System.IO; using System.Linq; using System ...

  2. 2.2 代码块--delphi 写日志模块

    //2.2 代码块--写日志 //调用例句如:LogMsg('FTP上传线程终止',False,true); procedure LogMsg(AMsg: string; const blnIsErr ...

  3. c# 多线程使用队列顺序写日志的类 (需要再优化)

    using System; using System.Collections.Generic; using System.Threading; public class LogManager { // ...

  4. PHP写日志公共类

    Txl_Log.php <?php if ( ! defined('BASEPATH')) exit('No direct script access allowed'); /** * * * ...

  5. 写日志(log)

    已下为我自己写的一个写日志的类,比较简洁. <?php class Log { /** * @Purpose : 写日志 * @Method Name : writeLog() * @param ...

  6. C#写文本日志帮助类(支持多线程)改进版(不适用于ASP.NET程序)

    由于iis的自动回收机制,不适用于ASP.NET程序 代码: using System; using System.Collections.Concurrent; using System.Confi ...

  7. C#写文本日志帮助类(支持多线程)

    代码: using System; using System.Configuration; using System.IO; using System.Threading.Tasks; namespa ...

  8. 重复造轮子,编写一个轻量级的异步写日志的实用工具类(LogAsyncWriter)

    一说到写日志,大家可能推荐一堆的开源日志框架,如:Log4Net.NLog,这些日志框架确实也不错,比较强大也比较灵活,但也正因为又强大又灵活,导致我们使用他们时需要引用一些DLL,同时还要学习各种用 ...

  9. .NET Core的日志[5]:利用TraceSource写日志

    从微软推出第一个版本的.NET Framework的时候,就在“System.Diagnostics”命名空间中提供了Debug和Trace两个类帮助我们完成针对调试和跟踪信息的日志记录.在.NET ...

随机推荐

  1. RabbitMQ Management HTTP API--官方文档

    Introduction Apart from this help page, all URIs will serve only resources of type application/json, ...

  2. Android(java)学习笔记224:横竖屏切换时Activity的生命周期

    1.横竖屏切换的生命周期     默认情况下横竖屏切换,先销毁再创建 2.有的时候,默认情况下的横竖屏切换(先销毁再创建),对应用户体验是不好的,比如是手机游戏横竖屏切换对游戏体验非常不好,下面两种方 ...

  3. 移动端屏幕自适应js与rem

    <meta content="width=device-width, initial-scale=1.0, maximum-scale=1.0, user-scalable=0;&qu ...

  4. C#接口的使用

    .接口: 接口与抽象类一样,也是表示某种规则,一旦使用了该规则,就必须实现相关的方法.对于C#语言而言,由于只能继承自一个父类,因此若有多个规则需要实现,则使用接口是个比较好的做法. .接口的定义 i ...

  5. jrae源码解析(一)

    jare用java实现了论文<Semi-Supervised Recursive Autoencoders for Predicting Sentiment Distributions>中 ...

  6. web前端对上传的文件进行类型大小判断的js自定义函数

    <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/ ...

  7. C++学习之DLL注入

    #include<stdio.h> #include<Windows.h> #include<TlHelp32.h> //typedef unsigned long ...

  8. 优秀的弹窗插件 jquery.lightbox_me.js

    项目地址: https://github.com/buckwilson/Lightbox_me用法:http://buckwilson.me/lightboxme/ var opt = { 'cent ...

  9. jquery mobile navbar

    <!DOCTYPE html> <html> <head> <meta charset="utf-8"> <meta name ...

  10. 解决spring mvc 上传报错,Field [] isn't an enum value,Failed to convert value of type 'java.lang.String[]' to required type '

    没有选择附件,但是点击上传按钮的时候会报错. 之前不选择文件,直接上传空文件是可以的,后来不知道改了什么就不行了. 错误信息: -- :: [http--] TRACE org.springframe ...