{*******************************************************} { } { Tocsg.Trace } { } { Copyright (C) 2022 kkuzil } { } {*******************************************************} unit Tocsg.Trace; interface uses System.SysUtils, System.Classes, Winapi.Windows, Vcl.Forms, Winapi.Messages; const WM_WRITE_LOG = WM_USER + 8745; type PLogEnt = ^TLogEnt; TLogEnt = record dt: TDateTime; nLevel: Integer; sMsg: String; end; TTgTraceForm = class(TForm) // protected // procedure WriteLog(dt: TDateTime; nLevel: Integer; sMsg: String); virtual; abstract; public Constructor Create; virtual; Destructor Destroy; override; end; TTgTrace = class(TObject) private sFName_, sLPath_, sLogHead_: String; bEnc_, bWFile_, bDaliy_, bLevelLock_, bAllocConsole_: Boolean; evBeforeLog_, evAfterLog_: TNotifyEvent; nLevel_: Integer; procedure SetLogLevel(nVal: Integer); public Constructor Create(sLogDir, sLogFName: String; bDaliy: Boolean = false); overload; Constructor Create(sLogPath: String; bDaliy: Boolean = false); overload; Destructor Destroy; override; procedure DeleteOldLogs(nLeaveDay: Integer = 10); class procedure T(sLog: String; nLevel: Integer = 0); overload; class procedure T(const sFormat: String; const Args: array of const; nLevel: Integer = 0); overload; class function SetAllocConsole(bVal: Boolean): Boolean; property OnBeforeLog: TNotifyEvent write evBeforeLog_; property OnAfterLog: TNotifyEvent write evAfterLog_; property LoadHead: String write sLogHead_; property IsAllocConsole: Boolean read bAllocConsole_; property Level: Integer read nLevel_ write SetLogLevel; property LevelLock: Boolean read bLevelLock_ write bLevelLock_; property LogEnc: Boolean read bEnc_ write bEnc_; end; function WriteLnFileEndA(const sPath: String; const sData: AnsiString): Boolean; inline; function WriteLnFileEndUTF8(const sPath: String; const sData: UTF8String): Boolean; inline; function WriteLnFileEndW(const sPath, sData: WideString): Boolean; inline; function DecLog(sText: String): String; var gTrace: TTgTrace = nil; gTrForm: TTgTraceForm = nil; implementation uses System.SyncObjs, Tocsg.Safe, Tocsg.Path, Tocsg.Files, System.DateUtils, Tocsg.DateTime, Tocsg.Encrypt; const PASS_LOG = 'O=5+QCU;yCV3:8Z*'; var _CS: TCriticalSection = nil; procedure _Lock; begin if _CS <> nil then _CS.Acquire; end; procedure _Unlock; begin if _CS <> nil then _CS.Release; end; { TTgTraceForm } Constructor TTgTraceForm.Create; begin Inherited Create(nil); ASSERT(gTrForm = nil); gTrForm := Self; end; Destructor TTgTraceForm.Destroy; begin gTrForm := nil; Inherited; end; { TTgTrace } Constructor TTgTrace.Create(sLogDir, sLogFName: String; bDaliy: Boolean = false); begin Inherited Create; @evBeforeLog_ := nil; @evAfterLog_ := nil; gTrace := Self; sFName_ := ''; sLPath_ := ''; sLogHead_ := ''; bAllocConsole_ := false; nLevel_ := 0; bEnc_ := false; bDaliy_ := bDaliy; {$IFDEF TRACE_FILE} bWFile_ := (sLogDir <> '') and (sLogFName <> '') and ForceDirectories(sLogDir) and IsValidFilename(sLogFName); if bWFile_ then begin sLPath_ := IncludeTrailingBackslash(sLogDir); sFName_ := sLogFName; end; {$ELSE} bWFile_ := false; {$ENDIF} // if sLPath_ = '' then // sLPath_ := GetRunExePathDir; // // if sFName_ = '' then // sFName_ := CutFileExt(ExtractFileName(GetRunExePath)) + '.log'; end; Constructor TTgTrace.Create(sLogPath: String; bDaliy: Boolean = false); var sPath, sLName: String; begin sPath := ExtractFilePath(sLogPath); sLName := ExtractFileName(sLogPath); if GetFileExt(sLName).ToUpper <> 'LOG' then sLName := CutFileExt(sLName) + '.log'; Create(sPath, sLName, bDaliy); end; Destructor TTgTrace.Destroy; begin gTrace := nil; Inherited; end; class function TTgTrace.SetAllocConsole(bVal: Boolean): Boolean; begin Result := false; try if gTrace = nil then exit; if gTrace.bAllocConsole_ <> bVal then begin var hConsole: HWND := GetConsoleWindow; gTrace.bAllocConsole_ := bVal; if gTrace.bAllocConsole_ then begin if hConsole = 0 then begin if AllocConsole then begin // SetConsoleCP(CP_UTF8); // SetConsoleOutputCP(CP_UTF8); end; end else ShowWindow(hConsole, SW_SHOWNORMAL); end else begin if hConsole <> 0 then ShowWindow(hConsole, SW_HIDE); // FreeConsole; end; Result := true; end; except // .. end; end; procedure TTgTrace.SetLogLevel(nVal: Integer); begin try if bLevelLock_ then exit; if nVal <> nLevel_ then nLevel_ := nVal; except // .. end; end; procedure TTgTrace.DeleteOldLogs(nLeaveDay: Integer = 10); var dtNow: TDateTime; function FindLogFile(sDir: String): Boolean; var sPath: String; nSubDirCnt, nFileCnt: Integer; wfd: TWin32FindData; hSc: THandle; dtLog: TDateTime; begin Result := false; sDir := IncludeTrailingPathDelimiter(sDir); sPath := sDir + '*.*'; hSc := FindFirstFile(PChar(sPath), wfd); if hSc = INVALID_HANDLE_VALUE then exit; nSubDirCnt := 0; nFileCnt := 0; try Repeat if (String(wfd.cFileName) <> '.') and (String(wfd.cFileName) <> '..') then begin if ((wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0) then begin if FindLogFile(sDir + wfd.cFileName) then DeleteDir(sDir + wfd.cFileName) else Inc(nSubDirCnt); end else begin if Pos(sFName_, wfd.cFileName) > 0 then begin dtLog := ConvFileTimeToDateTime_Local(wfd.ftLastWriteTime); // 마지막 수정일 기준 if (dtLog <> 0) and (DaysBetween(dtNow, dtLog) > nLeaveDay) then begin if DeleteFile(PChar(sDir + wfd.cFileName)) then continue; end; end; Inc(nFileCnt); end; end; Until not FindNextFile(hSc, wfd); finally FindClose(hSc); end; Result := (nSubDirCnt + nFileCnt) = 0; end; begin _Lock; try if bDaliy_ then begin dtNow := Now; if DirectoryExists(sLPath_) then FindLogFile(sLPath_); end; finally _Unlock; end; end; function EncLog(sText: String): String; inline; begin Result := ':' + EncStrToBinStr(ekAes256cbc, PASS_LOG, sText); end; function DecLog(sText: String): String; begin Result := ''; if Length(sText) < 2 then exit; if sText[1] = ':' then begin Delete(sText, 1, 1); Result := DecBinStrToStr(ekAes256cbc, PASS_LOG, sText); end else Result := sText; end; class procedure TTgTrace.T(sLog: String; nLevel: Integer = 0); var dtNow: TDateTime; begin try if (gTrace = nil) and (nLevel > 0) then exit; dtNow := Now; if gTrace = nil then begin {$IFDEF TRACE} OutputDebugString(PChar(FormatDateTime('[yyyy-mm-dd hh:nn:ss] ', dtNow) + sLog + #13#10)); {$ENDIF} {$IFDEF TRACE_CONSOLE} if AllocConsole then begin // SetConsoleCP(CP_UTF8); // SetConsoleOutputCP(CP_UTF8); end; System.WriteLn(FormatDateTime('[yyyy-mm-dd hh:nn:ss] ', dtNow) + sLog); {$ENDIF} end; {$IFDEF TRACE_FILE} if gTrace <> nil then begin if gTrace.Level < nLevel then exit; {$IFDEF TRACE} OutputDebugString(PChar(FormatDateTime('[yyyy-mm-dd hh:nn:ss] ', dtNow) + sLog + #13#10)); {$ENDIF} if gTrForm <> nil then begin var Log: TLogEnt; Log.dt := dtNow; Log.nLevel := nLevel; Log.sMsg := sLog; SendMessage(gTrForm.Handle, WM_WRITE_LOG, 0, LPARAM(@Log)); // gTrForm.WriteLog(dtNow, nLevel, sLog); // 스레드에서 실행하면 안됨... 25_0923 16:24:42 kku end; if nLevel <> 0 then sLog := Format('[L%d] ', [nLevel]) + sLog; if Assigned(gTrace.evBeforeLog_) then gTrace.evBeforeLog_(gTrace); if gTrace.IsAllocConsole then System.WriteLn(FormatDateTime('[yyyy-mm-dd hh:nn:ss] ', dtNow) + sLog); _Lock; try if gTrace.bWFile_ then begin var sLogPath: String; if gTrace.bDaliy_ then begin sLogPath := gTrace.sLPath_ + FormatDateTime('yyyy\mm\', dtNow); if not DirectoryExists(sLogPath) then begin if not ForceDirectories(sLogPath) then exit; end; sLogPath := sLogPath + FormatDateTime('yy_mmdd ', dtNow) + gTrace.sFName_; end else sLogPath := gTrace.sLPath_ + gTrace.sFName_; var sLogC: String := FormatDateTime('[yyyy-mm-dd hh:nn:ss] ', dtNow) + gTrace.sLogHead_ + sLog; if gTrace.bEnc_ then WriteLnFileEndUTF8(sLogPath, EncLog(sLogC)) else WriteLnFileEndUTF8(sLogPath, sLogC); end; finally _Unlock; end; // if Assigned(gTrace.evAfterLog_) then if @gTrace.evAfterLog_ <> nil then gTrace.evAfterLog_(gTrace); end; {$ENDIF} except end; end; class procedure TTgTrace.T(const sFormat: string; const Args: array of const; nLevel: Integer = 0); var str: String; begin FmtStr(str, sFormat, Args); T(str, nLevel); end; { Other } function WriteLnFileEndA(const sPath: String; const sData: AnsiString): Boolean; var fs: TFileStream; begin try fs := nil; try if FileExists(sPath) then begin fs := TFileStream.Create(sPath, fmOpenWrite or fmShareDenyNone); fs.Seek(0, soEnd); end else fs := TFileStream.Create(sPath, fmCreate); fs.Write(PAnsiChar(sData+#13#10)^, Length(sData)+2); finally if fs <> nil then FreeAndNil(fs); end; Result := true; except Result := false; end; end; function WriteLnFileEndUTF8(const sPath: String; const sData: UTF8String): Boolean; var fs: TFileStream; begin try fs := nil; try if FileExists(sPath) then begin fs := TFileStream.Create(sPath, fmOpenWrite or fmShareDenyNone); fs.Seek(0, soEnd); end else fs := TFileStream.Create(sPath, fmCreate); fs.Write(PAnsiChar(sData+#13#10)^, Length(sData)+2); finally if fs <> nil then FreeAndNil(fs); end; Result := true; except Result := false; end; end; function WriteLnFileEndW(const sPath, sData: WideString): Boolean; var fs: TFileStream; begin try fs := nil; try if FileExists(sPath) then begin fs := TFileStream.Create(sPath, fmOpenWrite or fmShareDenyNone); fs.Seek(0, soEnd); end else fs := TFileStream.Create(sPath, fmCreate); fs.Write(PWideChar(sData+#13#10)^, (Length(sData)+2)*2); finally if fs <> nil then FreeAndNil(fs); end; Result := true; except Result := false; end; end; initialization _CS := TCriticalSection.Create; finalization if _CS <> nil then FreeAndNil(_CS); end.