mirror of
https://github.com/danieleteti/delphimvcframework.git
synced 2024-11-15 15:55:54 +01:00
525 lines
13 KiB
ObjectPascal
525 lines
13 KiB
ObjectPascal
{
|
||
THIS UNIT IS A MODIFIED VERSION OF delphi-iocp-framework PROJECT
|
||
You can find the original version here
|
||
https://code.google.com/p/delphi-iocp-framework/
|
||
}
|
||
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;
|
||
begin
|
||
// 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.
|