Delphi开发系列(3):日志记录组件
程序员文章站
2022-05-12 20:30:33
...
在大型的信息系统中,出于效率的考虑,日志记录一般都先写入缓存(比如Kafka),再由单独的程序从缓存中取出持久化到硬盘。因为我只是用Delphi做些小工具,所以没有高并发的需求,我从RealThinClient中把日志记录相关的单元扣出来形成一个小的日志组件,版本和需要的文件如下:
封装成一个Logger单元,便于使用:
unit Logger;
interface
uses
SysUtils, rtcSystem, rtcLog, System.IOUtils;
type
TLogger = class
private
//DEBUG=1,INFO=2,WARN=3,ERROR=4,FATAL=5
logLevel : Integer;
procedure SetLogFileName(Value: string);
procedure SetLogNameUseDate(Value: Boolean);
function GetLogFileName:string;
function GetLogNameUseDate: Boolean;
public
constructor Create;
destructor Destroy; override;
//以下方法为自定义
procedure info(const s:string); overload;
procedure info(const s:AnsiString); overload;
procedure debug(const s:string); overload;
procedure debug(const s:AnsiString); overload;
procedure warning(const s:string); overload;
procedure warning(const s:AnsiString); overload;
procedure error(const s:string); overload;
procedure error(const s:AnsiString); overload;
procedure fatal(const s:string); overload;
procedure fatal(const s:AnsiString); overload;
procedure exception(const s:string; E:Exception); overload;
procedure exception(const s:AnsiString; E:Exception); overload;
property LogFileName: string read GetLogFileName write SetLogFileName;
property LogNameUseDate: Boolean read GetLogNameUseDate write SetLogNameUseDate;
procedure Dump;
function setLogLevel(LL: string):Integer;
procedure Start(BufSize:Integer=1024*1024; LogSize:Integer=1024*1024*100);
procedure Stop;
end;
var
gLogger : TLogger;
implementation
constructor TLogger.Create;
begin
logLevel := 2;
AppFileName := ChangeFileExt(ExtractFileName(ParamStr(0)),'');
RTC_LOG_FOLDER := ExtractFilePath(ParamStr(0));
RTC_LOG_FILENAME_USE_DATE := True;
RTC_LOGS_LIVE_DAYS := 365;
RTC_LOG_FILESIZE:=1024*1024*100;
StartLogBuffers(1024*1024*10);
end;
destructor TLogger.Destroy;
begin
DumpLogBuffers;
StopLog;
StopLogBuffers;
inherited;
end;
function TLogger.setLogLevel(LL: string):Integer;
begin
if LL='DEBUG' then
logLevel := 1
else
if LL='INFO' then
LogLevel := 2
else
if LL='WARN' then
logLevel := 3
else
if LL='ERROR' then
logLevel := 4
else
if LL='FATAL' then
logLevel := 5;
Result := logLevel;
end;
function TLogger.GetLogFileName:string;
begin
Result := AppFileName;
end;
function TLogger.GetLogNameUseDate: Boolean;
begin
Result := RTC_LOG_FILENAME_USE_DATE;
end;
procedure TLogger.SetLogFileName(Value: string);
begin
AppFileName := Value;
end;
procedure TLogger.SetLogNameUseDate(Value: Boolean);
begin
RTC_LOG_FILENAME_USE_DATE := Value;
end;
procedure TLogger.debug(const s:string);
begin
//DEBUG=1,INFO=2,WARN=3,ERROR=4,FATAL=5
if logLevel>1 then
exit;
Log('[DEBUG]; ' + s);
end;
procedure TLogger.debug(const s:AnsiString);
begin
debug(string(s));
end;
procedure TLogger.info(const s:string);
begin
//DEBUG=1,INFO=2,WARN=3,ERROR=4,FATAL=5
if logLevel>2 then
exit;
Log('[INFO]; ' + s);
end;
procedure TLogger.info(const s:AnsiString);
begin
info(string(s));
end;
procedure TLogger.warning(const s:string);
begin
//DEBUG=1,INFO=2,WARN=3,ERROR=4,FATAL=5
if logLevel>3 then
exit;
Log('[WARN]; ' + s);
end;
procedure TLogger.warning(const s:AnsiString);
begin
warning(string(s));
end;
procedure TLogger.error(const s:string);
begin
//DEBUG=1,INFO=2,WARN=3,ERROR=4,FATAL=5
if logLevel>4 then
exit;
Log('[ERROR]; ' + s);
end;
procedure TLogger.error(const s:AnsiString);
begin
error(string(s));
end;
procedure TLogger.fatal(const s:string);
begin
//DEBUG=1,INFO=2,WARN=3,ERROR=4,FATAL=5
if logLevel>5 then
exit;
Log('[FATAL]; ' + s);
end;
procedure TLogger.fatal(const s:AnsiString);
begin
fatal(string(s));
end;
procedure TLogger.exception(const s:string; E:Exception);
begin
Log('[EXCEPTION]; ' + E.Message + ':' + s);
end;
procedure TLogger.exception(const s:AnsiString; E:Exception);
begin
exception(string(s), E);
end;
procedure TLogger.Dump;
begin
DumpLogBuffers;
end;
procedure TLogger.Start(BufSize:Integer=1024*1024; LogSize:Integer=1024*1024*100);
begin
if LogSize <= BufSize then
LogSize:=BufSize*2;
RTC_LOG_FILESIZE:=LogSize;
StartLogBuffers(BufSize);
StartLog;
end;
procedure TLogger.Stop;
begin
DumpLogBuffers;
StopLog;
StopLogBuffers;
end;
initialization
gLogger := TLogger.Create;
finalization
gLogger.Free;
end.
对rtcLog进行适当修改,增加日期和日志大小控制功能,具体修改的行数为
81-84
317-328
350-360
482-485
368-571
{
@html(<b>)
Log File Creation
@html(</b>)
- Copyright 2004-2019 (c) Teppi Technology (https://rtc.teppi.net)
@html(<br><br>)
This unit gives you thread-safe Log writing support.
}
unit rtcLog;
{$INCLUDE rtcDefs.inc}
interface
uses
{$IFDEF WINDOWS}
Windows, // FileCreate + FileClose + GetCurrentThreadID
{$ENDIF}
{$IFDEF POSIX}
Posix.Unistd, // FileClose
Posix.PThread, // GetCurrentThreadID
System.IOUtils, //文件操作
{$ENDIF}
SysUtils,
{$IFDEF IDE_1}
FileCtrl,
{$ENDIF}
rtcTypes,
rtcSystem,
rtcSrcList;
var
{ Write Logged exception into the Log file?
Dafault=True. By changing this to False will remove any
Connection component exceptions from the Log file. }
LOG_EXCEPTIONS:boolean=True;
{ Write all "Log" calls to the CONSOLE (stdout)? }
LOG_TO_CONSOLE:boolean=False;
{ Write all "xLog" calls to the CONSOLE (stdout)? }
XLOG_TO_CONSOLE:boolean=False;
{ The RTC SDK can silently handle most exceptions which
would otherwise cause the components to stop working.
This is a safety-net which ensures that even bugs in
the RTC SDK do not cause your apps to crash, but an
exception getting that far down to the RTC SDK usually
means something is wrong in the RTC SDK.
When debugging the RTC SDK, LOG_AV_ERRORS should be
TRUE in order for all abnormal exceptions to be logged. }
LOG_AV_ERRORS:boolean={$IFDEF RTC_DEBUG}True{$ELSE}False{$ENDIF};
{ If you want old log files to be deleted after several days,
you can specify how long (in days) files should be kept.
If this variable is 0 (default), log files will NOT be deleted. }
RTC_LOGS_LIVE_DAYS:integer=0;
{ Sub-Folder inside AppFileName's directory where all LOG files will be stored.
If you want LOG files to be created in the same folder as AppFile (EXE/DLL),
set LOG_FOLDER to an empty String before calling "StartLog".
For this value to have any effect, you need to set it before calling "StartLog". }
LOG_FOLDER:RtcWideString='LOG';
{ Full path to the LOG folder. If you leave this variable empty (default),
it will be initialized automatically by using the AppFileName and LOG_FOLDER
variables, immediately before the first log entry needs to be written.
If you want your LOG files written to a specific folder by using full path,
you can do it by setting this variable before the first Log entry is written.
RTC_LOG_FOLDER should ALWAYS end with '\' on Windows and '/' on other platforms. }
RTC_LOG_FOLDER:RtcWideString='';
{ String used to format Date/Time output in RTC LOG. For more information on valid Data/Time
format strings, please refer to Delphi help about the "FormatDataTime" function. }
RTC_LOG_DATETIMEFORMAT:String='yyyy-mm-dd hh:nn:ss.zzz; ';
//日志文件名添加时间
RTC_LOG_FILENAME_USE_DATE:Boolean=True;
//日志文件大小
RTC_LOG_FILESIZE:LongInt=1024*1024*100;
{ Include CurrentThreadID in every LOG entry? }
RTC_LOG_THREADID:boolean=False;
{$IFDEF RTC_BYTESTRING}
{ Write exception with a short description into the Global App Log file.
This procedure will have no effect if Log writer not started
(by calling StartLog) or LOG_EXCEPTIONS is @false }
procedure Log(const s:RtcString; E:Exception; const name:String=''); overload;
{ Write message into the Global App Log file.
This procedure will have no effect if Log writer not started. }
procedure Log(const s:RtcString; const name:String=''); overload;
{ Write message into the Log file for the current date.
This procedure will have no effect if Log writer not started. }
procedure XLog(const s:RtcString; const name:String=''); overload;
{$ENDIF}
{ Copy LOG file "fromName" to LOG file "toName". }
procedure Copy_Log(const fromName,toName:String);
{ Delete LOG file "name" }
procedure Delete_Log(const name:String);
{ Write exception with a short description into the Global App Log file.
This procedure will have no effect if Log writer not started
(by calling StartLog) or LOG_EXCEPTIONS is @false }
procedure Log(const s:RtcWideString; E:Exception; const name:String=''); overload;
{ Write message into the Global App Log file.
This procedure will have no effect if Log writer not started. }
procedure Log(const s:RtcWideString; const name:String=''); overload;
{ Write message into the Log file for the current date.
This procedure will have no effect if Log writer not started. }
procedure XLog(const s:RtcWideString; const name:String=''); overload;
{ Before Log() procedures will have any effect,
you have to call this procedure to start the Log writer.
Without it, no Log file. }
procedure StartLog;
{ To stop Log file creation, simply call this procedure.
To continue log writing, call StartLog. }
procedure StopLog;
{ Start using Buffers for Logging, which makes logging a lot faster.
"MaxSize" is the maximum size (in bytes) the LOG may occupy
in memory before it has to be dumped to files. @html(<br><br>)
IMPORTANT!!! When using Buffers for logging, the "name" parameter is case-sensitive,
which means that a separte Buffer will be created for 'XName' than for 'xname', but
both buffers will at the end be dumbed into the same file, so you have to be careful
when using the "name" parameter to always use the exact same value for all LOG entries
which need to go to the same file, or the order of log entries could get mixed up. }
procedure StartLogBuffers(MaxSize:longint);
{ Stop using Buffers for Logging. }
procedure StopLogBuffers;
{ Dump current Log Buffers to files and release log buffer memory. }
procedure DumpLogBuffers;
implementation
var
ThrCS:TRtcCritSec=nil;
doLog:boolean=False;
doBuffers:boolean=False;
LogMaxBuff:longint;
LogCurBuff:longint;
LogBuff:TStringObjList;
AppOnlyFileName,
AppOnlyFilePath:RtcWideString;
procedure StartLog;
begin
if not doLog then
if assigned(ThrCS) then
begin
doLog:=True;
{$IFDEF RTC_DEBUG}Log('rtcLog START ...','DEBUG');{$ENDIF}
end;
end;
procedure StopLog;
begin
if doLog then
begin
{$IFDEF RTC_DEBUG} Log('rtcLog STOP.','DEBUG');{$ENDIF}
doLog:=False;
end;
end;
procedure Delete_old_logs;
var
vdate :TDatetime;
sr :TSearchRec;
intFileAge :LongInt;
myfileage :TDatetime;
begin
try
vdate:= Now - RTC_LOGS_LIVE_DAYS;
if FindFirst(RTC_LOG_FOLDER + '*.log', faAnyFile - faDirectory, sr) = 0 then
repeat
intFileAge := FileAge(RTC_LOG_FOLDER + RtcWideString(sr.name));
if intFileAge > -1 then
begin
myfileage:= FileDateToDateTime(intFileAge);
if myfileage < vdate then
Delete_File(RTC_LOG_FOLDER + RtcWideString(sr.name));
end;
until (FindNext(sr) <> 0);
finally
FindClose(sr);
end;
end;
procedure File_AppendEx(const fname:RtcWideString; const Data:RtcByteArray);
var
f:TRtcFileHdl;
iFileLength: Integer;
begin
f:=FileOpen(fname,fmOpenReadWrite+fmShareDenyNone);
if f=RTC_INVALID_FILE_HDL then
begin
try
if RTC_LOGS_LIVE_DAYS > 0 then
Delete_old_logs;
except
// ignore problems with file deletion
end;
f:=FileCreate(fname);
end;
if f<>RTC_INVALID_FILE_HDL then
try
iFileLength := FileSeek(f,0,2);
if iFileLength>=0 then
FileWrite(f,data[0],length(data));
finally
FileClose(f);
end;
end;
procedure File_Append(const fname:RtcWideString; const Data:RtcString);
var
f:TRtcFileHdl;
iFileLength: Integer;
begin
f:=FileOpen(fname,fmOpenReadWrite+fmShareDenyNone);
if f=RTC_INVALID_FILE_HDL then
begin
try
if RTC_LOGS_LIVE_DAYS > 0 then
Delete_old_logs;
except
// ignore problems with file deletion
end;
f:=FileCreate(fname);
end;
if f<>RTC_INVALID_FILE_HDL then
try
iFileLength := FileSeek(f,0,2);
if iFileLength>=0 then
{$IFDEF RTC_BYTESTRING}
FileWrite(f,data[1],length(data));
{$ELSE}
FileWrite(f,RtcStringToBytes(data)[0],length(data));
{$ENDIF}
finally
FileClose(f);
end;
end;
procedure PrepareLogFolder;
begin
if AppFileName='' then
AppFileName:=ExpandUNCFileName(RtcWideString(ParamStr(0)));
if AppOnlyFileName='' then
begin
AppOnlyFileName:=ExtractFileName(AppFileName);
AppOnlyFilePath:=ExtractFilePath(AppFileName);
if Copy(AppOnlyFilePath,length(AppOnlyFilePath),1)<>FOLDER_DELIMITER then
AppOnlyFilePath:=AppOnlyFilePath+FOLDER_DELIMITER;
end;
if RTC_LOG_FOLDER='' then
begin
RTC_LOG_FOLDER:=AppOnlyFilePath;
if LOG_FOLDER<>'' then
begin
RTC_LOG_FOLDER:=RTC_LOG_FOLDER+LOG_FOLDER;
if Copy(RTC_LOG_FOLDER,length(RTC_LOG_FOLDER),1)<>FOLDER_DELIMITER then
RTC_LOG_FOLDER:=RTC_LOG_FOLDER+FOLDER_DELIMITER;
end;
end;
if not DirectoryExists(RTC_LOG_FOLDER) then
if not CreateDir(RTC_LOG_FOLDER) then
begin
RTC_LOG_FOLDER:=GetTempDirectory;
if Copy(RTC_LOG_FOLDER,length(RTC_LOG_FOLDER),1)<>FOLDER_DELIMITER then
RTC_LOG_FOLDER:=RTC_LOG_FOLDER+FOLDER_DELIMITER;
RTC_LOG_FOLDER:=RTC_LOG_FOLDER+LOG_FOLDER;
if not DirectoryExists(RTC_LOG_FOLDER) then
CreateDir(RTC_LOG_FOLDER);
if Copy(RTC_LOG_FOLDER,length(RTC_LOG_FOLDER),1)<>FOLDER_DELIMITER then
RTC_LOG_FOLDER:=RTC_LOG_FOLDER+FOLDER_DELIMITER;
end;
end;
procedure WriteToLogEx(const ext:RtcWideString; const text:RtcByteArray);
var
s : string;
LogFileName : string;
f:TRtcFileHdl;
NewLogFileName: string;
iFileLength: Integer;
begin
PrepareLogFolder;
if RTC_LOG_FILENAME_USE_DATE then
s := FormatDateTime('yyyy_mm_dd',now)+'.'
else
s := '';
if Trim(AppFileName)='' then
Exit;
LogFileName := Format('%s%s.%s%s',[RTC_LOG_FOLDER,AppFileName,s,ext]);
f:=FileOpen(LogFileName,fmOpenReadWrite+fmShareDenyNone);
if f<>RTC_INVALID_FILE_HDL then
begin
iFileLength := FileSeek(f,0,2);
FileClose(f);
if iFileLength>=RTC_LOG_FILESIZE then
begin
NewLogFileName := Format('%s%s.%s.%s',[RTC_LOG_FOLDER,AppFileName,FormatdateTime('yyyy_mm_dd_hh_nn_ss',now),ext]);
{$IFDEF MSWINDOWS} MoveFile(PChar(LogFileName),PChar(NewLogFileName));{$ENDIF}
{$IFDEF POSIX} TFile.Move(LogFileName,NewLogFileName);{$ENDIF}
end;
end;
// File_AppendEx(RTC_LOG_FOLDER+AppOnlyFileName+'.'+ext, text);
File_AppendEx(LogFileName, text);
end;
procedure WriteToLog(const ext:RtcWideString; const text:RtcString);
var
s : string;
LogFileName : string;
f:TRtcFileHdl;
NewLogFileName: string;
iFileLength: Integer;
begin
PrepareLogFolder;
if RTC_LOG_FILENAME_USE_DATE then
s := FormatDateTime('yyyy_mm_dd',now)+'.'
else
s := '';
if Trim(AppFileName)='' then
Exit;
LogFileName := Format('%s%s.%s%s',[RTC_LOG_FOLDER,AppFileName,s,ext]);
f:=FileOpen(LogFileName,fmOpenReadWrite+fmShareDenyNone);
if f<>RTC_INVALID_FILE_HDL then
begin
iFileLength := FileSeek(f,0,2);
FileClose(f);
if iFileLength>=RTC_LOG_FILESIZE then
begin
NewLogFileName := Format('%s%s.%s.%s',[RTC_LOG_FOLDER,AppFileName,FormatdateTime('yyyy_mm_dd_hh_nn_ss',now),ext]);
{$IFDEF MSWINDOWS} MoveFile(PChar(LogFileName),PChar(NewLogFileName));{$ENDIF}
{$IFDEF POSIX} TFile.Move(LogFileName,NewLogFileName);{$ENDIF}
end;
end;
// File_Append(RTC_LOG_FOLDER+AppOnlyFileName+'.'+ext, text);
File_Append(LogFileName, text);
end;
procedure WriteToBuffEx(const ext:RtcWideString; const text:RtcByteArray);
var
obj:TObject;
data:TRtcHugeByteArray;
begin
obj:=LogBuff.search(ext);
if not assigned(obj) then
begin
data:=TRtcHugeByteArray.Create;
LogBuff.insert(ext,data);
end
else
data:=TRtcHugeByteArray(obj);
data.AddEx(text);
Inc(LogCurBuff,length(text));
if LogCurBuff>LogMaxBuff then
DumpLogBuffers;
end;
procedure WriteToBuff(const ext:RtcWideString; const text:RtcString);
var
obj:TObject;
data:TRtcHugeByteArray;
begin
obj:=LogBuff.search(ext);
if not assigned(obj) then
begin
data:=TRtcHugeByteArray.Create;
LogBuff.insert(ext,data);
end
else
data:=TRtcHugeByteArray(obj);
data.Add(text);
Inc(LogCurBuff,length(text));
if LogCurBuff>LogMaxBuff then
DumpLogBuffers;
end;
procedure StartLogBuffers(MaxSize:longint);
begin
ThrCS.Acquire;
try
doBuffers:=True;
if assigned(LogBuff) then
DumpLogBuffers
else
LogBuff:=tStringObjList.Create(128);
LogMaxBuff:=MaxSize;
LogCurBuff:=0;
finally
ThrCS.Release;
end;
end;
procedure DumpLogBuffers;
var
s:RtcWideString;
obj:TObject;
data:TRtcHugeByteArray;
begin
ThrCS.Acquire;
try
if assigned(LogBuff) then
begin
while not LogBuff.Empty do
begin
s:=LogBuff.search_min(obj);
LogBuff.remove(s);
if assigned(obj) then
begin
data:=TRtcHugeByteArray(obj);
try
WriteToLogEx(s,data.GetEx);
except
end;
data.Free;
end;
end;
LogCurBuff:=0;
end;
finally
ThrCS.Release;
end;
end;
procedure StopLogBuffers;
begin
ThrCS.Acquire;
try
doBuffers:=False;
DumpLogBuffers;
RtcFreeAndNil(LogBuff);
finally
ThrCS.Release;
end;
end;
procedure XLog(const s:RtcWideString; const name:String='');
var
d:TDateTime;
fname:RtcWideString;
s2:RtcString;
begin
if not doLog then Exit; // Exit here !!!!
d:=Now;
if RTC_LOG_DATETIMEFORMAT<>'' then
begin
if RTC_LOG_THREADID then
s2:= Utf8Encode(RtcWideString(IntToStr(Cardinal(GetCurrentThreadId))+'#'+FormatDateTime(RTC_LOG_DATETIMEFORMAT,d)))
else
s2:= Utf8Encode(RtcWideString(FormatDateTime(RTC_LOG_DATETIMEFORMAT,d)));
end
else if RTC_LOG_THREADID then
s2:= Int2Str(Cardinal(GetCurrentThreadId))+'#'
else
s2:= '';
if name<>'' then
fname:=RtcWideString(FormatDateTime('yyyy_mm_dd',d)+'.'+name)+'.log'
else
fname:=RtcWideString(FormatDateTime('yyyy_mm_dd',d))+'.log';
ThrCS.Acquire;
try
if XLOG_TO_CONSOLE then
Writeln(name,':',s);
if doBuffers then
WriteToBuff(fname, s2+Utf8Encode(s)+#13#10 )
else
WriteToLog(fname, s2+Utf8Encode(s)+#13#10 );
except
end;
ThrCS.Release;
end;
procedure Log(const s:RtcWideString; const name:String='');
var
d:TDateTime;
fname:RtcWideString;
s2:RtcString;
begin
if not doLog then Exit; // Exit here !!!!
d:=Now;
if RTC_LOG_DATETIMEFORMAT<>'' then
begin
if RTC_LOG_THREADID then
s2:=Utf8Encode(RtcWideString(IntToStr(Cardinal(GetCurrentThreadId))+'#'+FormatDateTime(RTC_LOG_DATETIMEFORMAT,d)))
else
s2:=Utf8Encode(RtcWideString(FormatDateTime(RTC_LOG_DATETIMEFORMAT,d)));
end
else if RTC_LOG_THREADID then
s2:=Int2Str(Cardinal(GetCurrentThreadId))+'#'
else
s2:='';
if name<>'' then
fname:=RtcWideString(name)+'.log'
else
fname:='log';
ThrCS.Acquire;
try
if LOG_TO_CONSOLE then
Writeln(name,':',s);
if doBuffers then
WriteToBuff(fname, s2+Utf8Encode(s)+#13#10 )
else
WriteToLog(fname, s2+Utf8Encode(s)+#13#10 );
except
end;
ThrCS.Release;
end;
procedure Log(const s:RtcWideString; E:Exception; const name:String='');
begin
if LOG_EXCEPTIONS then
Log(s+' Exception! '+RtcWideString(E.ClassName)+': '+RtcWideString(E.Message), name);
end;
{$IFDEF RTC_BYTESTRING}
procedure XLog(const s:RtcString; const name:String='');
var
d:TDateTime;
fname:RtcWideString;
s2:RtcString;
begin
if not doLog then Exit; // Exit here !!!!
d:=Now;
if RTC_LOG_DATETIMEFORMAT<>'' then
begin
if RTC_LOG_THREADID then
s2:= Utf8Encode(RtcWideString(IntToStr(Cardinal(GetCurrentThreadId))+'#'+FormatDateTime(RTC_LOG_DATETIMEFORMAT,d)))
else
s2:= Utf8Encode(RtcWideString(FormatDateTime(RTC_LOG_DATETIMEFORMAT,d)));
end
else if RTC_LOG_THREADID then
s2:= Int2Str(Cardinal(GetCurrentThreadId))+'#'
else
s2:= '';
if name<>'' then
fname:=RtcWideString(FormatDateTime('yyyy_mm_dd',d)+'.'+name)+'.log'
else
fname:=RtcWideString(FormatDateTime('yyyy_mm_dd',d))+'.log';
ThrCS.Acquire;
try
if XLOG_TO_CONSOLE then
Writeln(name,':',s);
if doBuffers then
WriteToBuff(fname, s2+s+#13#10 )
else
WriteToLog(fname, s2+s+#13#10 );
except
end;
ThrCS.Release;
end;
procedure Log(const s:RtcString; const name:String='');
var
d:TDateTime;
fname:RtcWideString;
s2:RtcString;
begin
if not doLog then Exit; // Exit here !!!!
d:=Now;
if RTC_LOG_DATETIMEFORMAT<>'' then
begin
if RTC_LOG_THREADID then
s2:=Utf8Encode(RtcWideString(IntToStr(Cardinal(GetCurrentThreadId))+'#'+FormatDateTime(RTC_LOG_DATETIMEFORMAT,d)))
else
s2:=Utf8Encode(RtcWideString(FormatDateTime(RTC_LOG_DATETIMEFORMAT,d)));
end
else if RTC_LOG_THREADID then
s2:=Int2Str(Cardinal(GetCurrentThreadId))+'#'
else
s2:='';
if name<>'' then
fname:=RtcWideString(name)+'.log'
else
fname:='log';
ThrCS.Acquire;
try
if LOG_TO_CONSOLE then
Writeln(name,':',s);
if doBuffers then
WriteToBuff(fname, s2+s+#13#10 )
else
WriteToLog(fname, s2+s+#13#10 );
except
end;
ThrCS.Release;
end;
procedure Log(const s:RtcString; E:Exception; const name:String='');
begin
if LOG_EXCEPTIONS then
Log(s+' Exception! '+RtcString(E.ClassName)+': '+RtcString(E.Message), name);
end;
{$ENDIF}
{ Copy LOG file "fromName" to LOG file "toName". }
procedure Copy_Log(const fromName,toName:String);
var
xname,fname,tname:RtcWideString;
cnt:integer;
begin
if not doLog then Exit; // Exit here !!!!
if fromName=toName then Exit; // and here !!!!
PrepareLogFolder;
if fromName='' then fname:='log' else fname:=RtcWideString(fromName)+'.log';
if toName='' then tname:='log' else tname:=RtcWideString(toName)+'.log';
DumpLogBuffers;
cnt:=1;
xname:=RTC_LOG_FOLDER+AppOnlyFileName+'.';
while not Copy_FileEx(xname+fname,xname+tname,0,0,-1,128000) do
begin
Sleep(100);
Inc(cnt);
if cnt>10 then Break;
end;
end;
{ Delete LOG file "name" }
procedure Delete_Log(const name:String);
var
xname,fname:RtcWideString;
cnt:integer;
begin
if not doLog then Exit; // Exit here !!!!
PrepareLogFolder;
if name='' then fname:='log' else fname:=RtcWideString(name)+'.log';
DumpLogBuffers;
cnt:=1;
xname:=RTC_LOG_FOLDER+AppOnlyFileName+'.';
while not Delete_File(xname+fname) do
begin
Sleep(100);
Inc(cnt);
if cnt>10 then Break;
end;
end;
initialization
AppOnlyFileName:='';
AppOnlyFilePath:='';
ThrCS:=TRtcCritSec.Create;
finalization
{$IFDEF RTC_DEBUG} Log('rtcLog Finalizing ...','DEBUG');{$ENDIF}
StopLogBuffers;
StopLog;
AppOnlyFileName:='';
AppOnlyFilePath:='';
RtcFreeAndNil(ThrCS);
end.
推荐阅读