delphimvcframework/sources/Iocp.Logger.pas
2013-10-29 23:48:23 +00:00

526 lines
13 KiB
ObjectPascal
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

unit Iocp.Logger;
interface
uses
Windows,
Classes,
SysUtils,
SyncObjs,
uGlobalVars,
Iocp.Utils;
type
TLogType = (ltNormal, ltWarning, ltError, ltException);
TLogTypeSets = set of TLogType;
const
LogTypeStr: array [TLogType] of string = ('ALL', 'WAR', 'ERR', 'EXP');
type
TCacheFileStream = class(TThread)
private
FFileStream : TFileStream;
FFileTime : TDateTime;
FLocker : TCriticalSection;
FCacheBuffer, FCacheBufferA, FCacheBufferB: TMemoryStream;
FFlushInterval : DWORD;
protected
procedure Lock;
procedure Unlock;
procedure Execute; override;
public
constructor Create(const AFileName: string); reintroduce;
destructor Destroy; override;
function Write(const Buffer; Count: Longint): Longint;
procedure AppendStr(const S: RawByteString); overload;
procedure AppendStr(const S: UTF8String); overload;
procedure AppendStr(const S: UnicodeString); overload;
procedure Flush;
property FileTime: TDateTime read FFileTime;
property FlushInterval: DWORD read FFlushInterval write FFlushInterval;
end;
TIocpLogger = class
private
FRefCount : Integer;
FFileWriters : array [TLogType] of TCacheFileStream;
FFileLocker : array [TLogType] of TCriticalSection;
FLogColor : array [TLogType] of Integer;
FConsoleHandle: THandle;
FShowConsole : Boolean;
FConsoleLocker: TCriticalSection;
procedure SetShowConsole(const Value: Boolean);
protected
function GetLogFileName(LogType: TLogType; Date: TDateTime): string;
procedure AppendStrToLogFile(const S: UnicodeString; LogType: TLogType);
function AddRef: Integer;
function Release: Boolean;
public
constructor Create; virtual;
destructor Destroy; override;
procedure AppendLog(const Log: UnicodeString; const TimeFormat: string;
LogType: TLogType = ltNormal; CRLF: string = ';'); overload;
procedure AppendLog(const Log: UnicodeString; LogType: TLogType = ltNormal;
CRLF: string = ';'); overload;
procedure AppendLog(const Fmt: UnicodeString; const Args: array of const;
const TimeFormat: string; LogType: TLogType = ltNormal; CRLF: string = ';'); overload;
procedure AppendLog(const Fmt: UnicodeString; const Args: array of const;
LogType: TLogType = ltNormal; CRLF: string = ';'); overload;
property ShowConsole: Boolean read FShowConsole write SetShowConsole;
end;
procedure ShowConsoleLog(OnOff: Boolean);
procedure AppendLog(const Log: UnicodeString; const TimeFormat: string;
LogType: TLogType = ltNormal; CRLF: string = ';'); overload;
procedure AppendLog(const Log: UnicodeString; LogType: TLogType = ltNormal;
CRLF: string = ';'); overload;
procedure AppendLog(const Fmt: UnicodeString; const Args: array of const; const TimeFormat: string;
LogType: TLogType = ltNormal; CRLF: string = ';'); overload;
procedure AppendLog(const Fmt: UnicodeString; const Args: array of const;
LogType: TLogType = ltNormal; CRLF: string = ';'); overload;
function gIocpLogger: TIocpLogger;
implementation
constructor TIocpLogger.Create;
var
i: TLogType;
begin
FRefCount := 1;
for i := low(TLogType) to high(TLogType) do
begin
FFileLocker[i] := TCriticalSection.Create;
end;
FShowConsole := False;
FConsoleHandle := INVALID_HANDLE_VALUE;
FConsoleLocker := TCriticalSection.Create;
{ <20><><EFBFBD><EFBFBD>̨<EFBFBD><CCA8>ɫ<EFBFBD><C9AB>
FOREGROUND_INTENSITY - ǰ<><C7B0>ɫ<EFBFBD><C9AB><EFBFBD><EFBFBD>
FOREGROUND_BLUE - ǰ<><C7B0>ɫ<EFBFBD><C9AB><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɫ
FOREGROUND_GREEN - ǰ<><C7B0>ɫ<EFBFBD><C9AB><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɫ
FOREGROUND_RED - ǰ<><C7B0>ɫ<EFBFBD><C9AB><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɫ
BACKGROUND_INTENSITY - <20><><EFBFBD><EFBFBD>ɫ<EFBFBD><C9AB><EFBFBD><EFBFBD>
BACKGROUND_BLUE - <20><><EFBFBD><EFBFBD>ɫ<EFBFBD><C9AB><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɫ
BACKGROUND_GREEN - <20><><EFBFBD><EFBFBD>ɫ<EFBFBD><C9AB><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɫ
BACKGROUND_RED - <20><><EFBFBD><EFBFBD>ɫ<EFBFBD><C9AB><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɫ
<20><>ɫ<EFBFBD><C9AB><EFBFBD><EFBFBD>ԭɫ<D4AD><C9AB><EFBFBD>϶<EFBFBD><CFB6><EFBFBD>
}
FLogColor[ltNormal] := FOREGROUND_RED or FOREGROUND_GREEN or FOREGROUND_BLUE;
FLogColor[ltWarning] := FOREGROUND_INTENSITY or FOREGROUND_RED or FOREGROUND_GREEN;
FLogColor[ltError] := FOREGROUND_INTENSITY or FOREGROUND_RED;
FLogColor[ltException] := FOREGROUND_INTENSITY or FOREGROUND_RED or FOREGROUND_BLUE;
end;
destructor TIocpLogger.Destroy;
var
i: TLogType;
begin
for i := low(TLogType) to high(TLogType) do
begin
if Assigned(FFileWriters[i]) then
begin
FFileWriters[i].Flush;
FFileWriters[i].Terminate;
FFileWriters[i].Free;
FFileWriters[i] := nil;
end;
FFileLocker[i].Free;
end;
FConsoleLocker.Free;
inherited Destroy;
end;
function TIocpLogger.GetLogFileName(LogType: TLogType; Date: TDateTime): string;
begin
Result := LogTypeStr[LogType];
if (Result <> '') then
Result := Result + '-';
{$IFDEF USEPIDFORLOGFILE}
Result := Result + ThreadFormatDateTime('YYYY-MM-DD', Date) + '_PID' +
IntToStr(GetCurrentProcessID) + '.log';
{$ELSE}
Result := Result + ThreadFormatDateTime('YYYY-MM-DD', Date) + '.log';
{$ENDIF}
end;
function TIocpLogger.Release: Boolean;
begin
Result := (InterlockedDecrement(FRefCount) = 0);
if Result then
Free;
end;
procedure TIocpLogger.SetShowConsole(const Value: Boolean);
var
ConSize: TCoord;
ConRec : TSmallRect;
begin
if (FShowConsole = Value) then
Exit;
FShowConsole := Value;
if FShowConsole then
begin
if (FConsoleHandle = INVALID_HANDLE_VALUE) then
begin
AllocConsole;
FConsoleHandle := GetStdHandle(STD_OUTPUT_HANDLE);
// <20><><EFBFBD>ÿ<EFBFBD><C3BF><EFBFBD>̨<EFBFBD><CCA8>Ļ<EFBFBD><C4BB><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>С<EFBFBD><D0A1>X=<3D><>(<28>ֽ<EFBFBD><D6BD><EFBFBD>), Y=<3D><>
ConSize.X := 80;
ConSize.Y := 8192;
SetConsoleScreenBufferSize(FConsoleHandle, ConSize);
// <20><><EFBFBD>ÿ<EFBFBD><C3BF><EFBFBD>̨λ<CCA8>ô<EFBFBD>С(<28><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ϊ<EFBFBD><CEAA>λ)
ConRec.Left := 0;
ConRec.Top := 0;
ConRec.Right := 80 - 1;
ConRec.Bottom := 25 - 1;
SetConsoleWindowInfo(FConsoleHandle, True, ConRec);
end;
end
else
begin
if (FConsoleHandle <> INVALID_HANDLE_VALUE) then
begin
FreeConsole;
FConsoleHandle := INVALID_HANDLE_VALUE;
end;
end;
end;
procedure TIocpLogger.AppendLog(const Log: UnicodeString; const TimeFormat: string;
LogType: TLogType; CRLF: string);
var
LogText: UnicodeString;
begin
if (AddRef = 1) then
Exit;
try
if (CRLF <> '') then
LogText := StringReplace(StringReplace(Log, #13#10, CRLF, [rfReplaceAll]), #10, CRLF,
[rfReplaceAll])
else
LogText := Log;
LogText := ThreadFormatDateTime(TimeFormat, Now) + ' ' + LogText + #13#10;
if FShowConsole then
try
FConsoleLocker.Enter;
SetConsoleTextAttribute(FConsoleHandle, FLogColor[LogType]);
System.Write(LogText);
SetConsoleTextAttribute(FConsoleHandle, FLogColor[ltNormal]);
finally
FConsoleLocker.Leave;
end;
AppendStrToLogFile(LogText, LogType);
finally
Release;
end;
end;
procedure TIocpLogger.AppendLog(const Log: UnicodeString; LogType: TLogType; CRLF: string);
begin
if (AddRef = 1) then
Exit;
try
AppendLog(Log, 'HH:NN:SS:ZZZ', LogType, CRLF);
finally
Release;
end;
end;
procedure TIocpLogger.AppendLog(const Fmt: UnicodeString; const Args: array of const;
const TimeFormat: string; LogType: TLogType; CRLF: string);
begin
if (AddRef = 1) then
Exit;
try
AppendLog(ThreadFormat(Fmt, Args), TimeFormat, LogType, CRLF);
finally
Release;
end;
end;
function TIocpLogger.AddRef: Integer;
begin
Result := InterlockedIncrement(FRefCount);
end;
procedure TIocpLogger.AppendLog(const Fmt: UnicodeString; const Args: array of const;
LogType: TLogType; CRLF: string);
begin
if (AddRef = 1) then
Exit;
try
AppendLog(ThreadFormat(Fmt, Args), LogType, CRLF);
finally
Release;
end;
end;
procedure TIocpLogger.AppendStrToLogFile(const S: UnicodeString; LogType: TLogType);
var
LogDir, LogFile: string;
begin
if (AddRef = 1) then
Exit;
try
FFileLocker[LogType].Enter;
try
// CREATE OR ROTATE //daniele
if not Assigned(FFileWriters[LogType]) or (Trunc(FFileWriters[LogType].FileTime) <> Trunc(Now))
then
begin
if Assigned(FFileWriters[LogType]) then
begin
FFileWriters[LogType].Flush;
FFileWriters[LogType].Terminate;
end;
LogDir := gAppPath + gAppName + '.Log\';
LogFile := LogDir + GetLogFileName(LogType, Now);
ForceDirectories(LogDir);
FFileWriters[LogType] := TCacheFileStream.Create(LogFile);
end;
finally
FFileLocker[LogType].Leave;
end;
FFileWriters[LogType].AppendStr(S);
finally
Release;
end;
end;
{ TCacheFileStream }
procedure TCacheFileStream.AppendStr(const S: RawByteString);
begin
write(S[1], Length(S));
end;
procedure TCacheFileStream.AppendStr(const S: UTF8String);
begin
AppendStr(RawByteString(S));
end;
procedure TCacheFileStream.AppendStr(const S: UnicodeString);
begin
AppendStr(UTF8Encode(S));
end;
constructor TCacheFileStream.Create(const AFileName: string);
var
UTF8Header: RawByteString;
begin
// <20><><EFBFBD>̴߳<DFB3><CCB4><EFBFBD>֮<EFBFBD>󴥷<EFBFBD><F3B4A5B7><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD>ʧ<EFBFBD>ܵ<EFBFBD><DCB5><EFBFBD><ECB3A3><EFBFBD><EFBFBD><EFBFBD>ɳ<EFBFBD><C9B3><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
// <20><><EFBFBD>԰Ѵ<D4B0><D1B4><EFBFBD><EFBFBD>߳<EFBFBD>(inherited Create)<29><><EFBFBD>ڴ<EFBFBD><DAB4><EFBFBD><EFBFBD><EFBFBD>־<EFBFBD>ļ<EFBFBD>֮<EFBFBD><D6AE>
if FileExists(AFileName) then
begin
FFileStream := TFileStream.Create(AFileName, fmOpenReadWrite or fmShareDenyWrite);
UTF8Header := '';
end
else
begin
FFileStream := TFileStream.Create(AFileName, fmCreate);
FFileStream.Free;
FFileStream := TFileStream.Create(AFileName, fmOpenReadWrite or fmShareDenyWrite);
// дUTF8<46>ļ<EFBFBD>ͷ
UTF8Header := RawByteString(#$EF#$BB#$BF);
end;
inherited Create(True);
// FreeOnTerminate := True;
FLocker := TCriticalSection.Create;
FCacheBufferA := TMemoryStream.Create;
FCacheBufferB := TMemoryStream.Create;
FCacheBuffer := FCacheBufferA;
FFileTime := Now;
FFlushInterval := 1000;
if (UTF8Header <> '') then
AppendStr(UTF8Header);
Suspended := False;
end;
destructor TCacheFileStream.Destroy;
begin
Lock;
Flush; // daniele
try
if Assigned(FCacheBufferA) then
FreeAndNil(FCacheBufferA);
if Assigned(FCacheBufferB) then
FreeAndNil(FCacheBufferB);
if Assigned(FFileStream) then
FreeAndNil(FFileStream);
finally
Unlock;
end;
if Assigned(FLocker) then
FreeAndNil(FLocker);
inherited Destroy;
end;
procedure TCacheFileStream.Execute;
var
t: DWORD;
begin
t := GetTickCount;
// while not Terminated do
// begin
// if (CalcTickDiff(t, GetTickCount) >= FFlushInterval) then
// begin
// Flush;
// t := GetTickCount;
// end
// else
// SleepEx(100, True);
// end;
while not Terminated do
begin
Flush;
TThread.Sleep(1000);
end;
// Flush;
end;
procedure TCacheFileStream.Flush;
var
Buffer: TMemoryStream;
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ǰ<EFBFBD><C7B0><EFBFBD><EFBFBD><EFBFBD><EFBFBD>û<EFBFBD><C3BB><EFBFBD><EFBFBD><EFBFBD>ݣ<EFBFBD><DDA3><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>д<EFBFBD>ļ<EFBFBD>
if (FCacheBuffer.Position <= 0) then
Exit;
// ˫<><CBAB><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ԣ<EFBFBD>
// <20><>ȡ<EFBFBD><C8A1>ǰ<EFBFBD><C7B0><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ݣ<EFBFBD><DDA3><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>һ<EFBFBD><D2BB><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ϊ<EFBFBD><CEAA>ǰ<EFBFBD><C7B0><EFBFBD><EFBFBD>
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ҫ<EFBFBD><D2AA><EFBFBD><EFBFBD><EFBFBD><EFBFBD>TCacheFileStream.Write<74><65>Ҳ<EFBFBD><D2B2>Ҫ<EFBFBD><D2AA>ͬһ<CDAC><D2BB><EFBFBD><EFBFBD>
Buffer := FCacheBuffer;
Lock;
if (FCacheBuffer = FCacheBufferA) then
FCacheBuffer := FCacheBufferB
else
FCacheBuffer := FCacheBufferA;
FCacheBuffer.Position := 0;
Unlock;
try
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>е<EFBFBD><D0B5><EFBFBD><EFBFBD><EFBFBD>׷<EFBFBD>ӵ<EFBFBD><D3B5>ļ<EFBFBD>β
FFileStream.Seek(0, soEnd);
FFileStream.Write(Buffer.Memory^, Buffer.Position);
FlushFileBuffers(FFileStream.Handle);
finally
Buffer.Position := 0;
end;
end;
procedure TCacheFileStream.Lock;
begin
FLocker.Enter;
end;
procedure TCacheFileStream.Unlock;
begin
FLocker.Leave;
end;
function TCacheFileStream.Write(const Buffer; Count: Integer): Longint;
begin
Lock;
try
Result := FCacheBuffer.Write(Buffer, Count);
finally
Unlock;
end;
end;
procedure ShowConsoleLog(OnOff: Boolean);
begin
gIocpLogger.ShowConsole := OnOff;
end;
procedure AppendLog(const Log: UnicodeString; const TimeFormat: string;
LogType: TLogType = ltNormal; CRLF: string = ';');
begin
gIocpLogger.AppendLog(Log, TimeFormat, LogType, CRLF);
end;
procedure AppendLog(const Log: UnicodeString; LogType: TLogType = ltNormal; CRLF: string = ';');
begin
gIocpLogger.AppendLog(Log, LogType, CRLF);
end;
procedure AppendLog(const Fmt: UnicodeString; const Args: array of const; const TimeFormat: string;
LogType: TLogType = ltNormal; CRLF: string = ';');
begin
gIocpLogger.AppendLog(Fmt, Args, TimeFormat, LogType, CRLF);
end;
procedure AppendLog(const Fmt: UnicodeString; const Args: array of const;
LogType: TLogType = ltNormal; CRLF: string = ';');
begin
gIocpLogger.AppendLog(Fmt, Args, LogType, CRLF);
end;
var
_gIocpLogger: TIocpLogger;
function gIocpLogger: TIocpLogger;
begin
{ if (TInterlocked.CompareExchange<TIocpLogger>(_gIocpLogger, nil, nil) <> nil) then Exit(_gIocpLogger);
Result := TIocpLogger.Create;
TInterlocked.Exchange<TIocpLogger>(_gIocpLogger, Result); }
Result := _gIocpLogger;
end;
initialization
_gIocpLogger := TIocpLogger.Create;
finalization
if Assigned(_gIocpLogger) then
_gIocpLogger.Release;
end.