Summary Table
Categories |
Total Count |
PII |
0 |
URL |
0 |
DNS |
0 |
EKL |
0 |
IP |
0 |
PORT |
0 |
VsID |
0 |
CF |
0 |
AI |
0 |
VPD |
0 |
PL |
0 |
Other |
0 |
File Content
unit U_LogObject;
interface
uses
Classes, System.SyncObjs, Winapi.Windows, SysUtils,
System.DateUtils, Vcl.Forms, Winapi.SHFolder, CodeSiteLogging;
type
ILoggerInterface = interface(IInterface)
['{076BB521-F79C-4991-A5E8-3F50CE0E1CA2}']
Function GetLogFileName(): String;
procedure SetActive(aValue: Boolean);
Function GetActive: Boolean;
procedure LogText(Action, MessageTxt: String);
property LogFile: String read GetLogFileName;
Property Active: Boolean read GetActive write SetActive;
end;
TLogComponent = class(TInterfacedObject, ILoggerInterface)
private
FCriticalSection: TCriticalSection;
fOurLogFile: String;
fActive: Boolean;
procedure SetActive(aValue: Boolean);
Function GetActive: Boolean;
Function GetLogFileName(): String;
Function ThePurge: String;
Function RightPad(S: string; ch: char; Len: Integer): string;
public
constructor Create();
destructor Destroy; override;
procedure LogText(Action, MessageTxt: String);
property LogFile: String read GetLogFileName;
Property Active: Boolean read GetActive write SetActive;
end;
function LogInterface: ILoggerInterface;
implementation
var
fLogInterface: ILoggerInterface;
function LogInterface: ILoggerInterface;
begin
if not Assigned(fLogInterface) then
TLogComponent.Create.GetInterface(ILoggerInterface, fLogInterface);
fLogInterface.QueryInterface(ILoggerInterface, Result);
end;
constructor TLogComponent.Create();
begin
inherited Create();
FCriticalSection := TCriticalSection.Create;
end;
destructor TLogComponent.Destroy;
begin
FCriticalSection.Free;
inherited Destroy;
end;
function TLogComponent.GetLogFileName(): String;
Var
OurLogFile, LocalOnly, AppDir, AppName: string;
// ******************************************************************
// Finds the users special directory
// ******************************************************************
function LocalAppDataPath: string;
const
SHGFP_TYPE_CURRENT = 0;
var
path: array [0 .. MaxChar] of char;
begin
SHGetFolderPath(0, CSIDL_LOCAL_APPDATA, 0, SHGFP_TYPE_CURRENT, @path[0]);
Result := StrPas(path);
end;
begin
if Trim(fOurLogFile) <> '' then
Result := fOurLogFile
else
begin
OurLogFile := LocalAppDataPath;
if (Copy(OurLogFile, Length(OurLogFile), 1) <> '\') then
OurLogFile := OurLogFile + '\';
LocalOnly := OurLogFile;
// Now set the application level
OurLogFile := OurLogFile + ExtractFileName(Application.ExeName);
if (Copy(OurLogFile, Length(OurLogFile), 1) <> '\') then
OurLogFile := OurLogFile + '\';
AppDir := OurLogFile;
// try to create or use base direcrtory
if not DirectoryExists(AppDir) then
if not ForceDirectories(AppDir) then
OurLogFile := LocalOnly;
// Get the application name
AppName := ExtractFileName(Application.ExeName);
AppName := Copy(AppName, 0, Pos('.', AppName) - 1);
OurLogFile := OurLogFile + AppName + '_' + IntToStr(GetCurrentProcessID) +
'_' + FormatDateTime('mm_dd_yy_hh_mm', now) + '_JawsLog.TXT';
fOurLogFile := OurLogFile;
Result := OurLogFile;
end;
end;
procedure TLogComponent.LogText(Action, MessageTxt: string);
const
PadLen: Integer = 18;
VAR
AddText: TStringList;
X: Integer;
TextToAdd, Suffix, Suffix2: String;
myFile: TextFile;
begin
if not fActive then
exit;
Action := RightPad(Action, ' ', 11);
FCriticalSection.Acquire;
try
// Clean the old dir on first run
if Trim(fOurLogFile) = '' then
TextToAdd := ThePurge + TextToAdd;
// This should never be blank
if fOurLogFile = '' then
fOurLogFile := GetLogFileName;
if Trim(fOurLogFile) = '' then
fOurLogFile := GetLogFileName;
AddText := TStringList.Create;
try
AddText.Text := MessageTxt;
Suffix := FormatDateTime('hh:mm:ss', now) + ' [' +
UpperCase(Action) + ']';
if AddText.Count > 1 then
begin
Suffix2 := FormatDateTime('hh:mm:ss', now) + ' [' +
StringOfChar('^', Length(Action)) + ']';
for X := 1 to AddText.Count - 1 do
AddText.Strings[X] := Suffix2.PadRight(PadLen) + ' - ' +
AddText.Strings[X];
end;
TextToAdd := Suffix.PadRight(PadLen) + ' - ' + Trim(AddText.Text);
// Asign our file
AssignFile(myFile, fOurLogFile);
if FileExists(fOurLogFile) then
Append(myFile)
else
ReWrite(myFile);
// Write this final line
WriteLn(myFile, TextToAdd);
CloseFile(myFile);
finally
AddText.Free;
end;
finally
FCriticalSection.Release;
end;
end;
Function TLogComponent.ThePurge: String;
const
aFileMask = '*_JawsLog.txt';
var
searchResult: TSearchRec;
iDelCnt, iErrorCnt, iFile: Integer;
dtFileDate, dtNow: TDateTime;
sFilePath: string;
begin
// Init variables
iDelCnt := 0;
iErrorCnt := 0;
dtNow := Date;
sFilePath := ExtractFilePath(GetLogFileName);
// Loop through dir looking for the files
iFile := FindFirst(sFilePath + aFileMask, faAnyFile, searchResult);
while iFile = 0 do
begin
// Make sure we are on a file and not a directory
if (searchResult.Name <> '.') and (searchResult.Name <> '..') and
((searchResult.Attr and faDirectory) <> faDirectory) then
begin
// Check the date of the file
{$IFDEF VER180}
dtFileDate := searchResult.Time;
{$ELSE}
dtFileDate := searchResult.TimeStamp;
{$ENDIF}
if trunc(dtNow - dtFileDate) + 1 > 60 then
begin
// Try to delete and update the count as needed
if not SysUtils.DeleteFile(sFilePath + searchResult.Name) then
Inc(iErrorCnt)
else
Inc(iDelCnt);
end;
end;
// Grab the next file
iFile := FindNext(searchResult);
end;
// Free up memory allocation
SysUtils.FindClose(searchResult);
// If any files were purged or errored then add this to the return message
if (iErrorCnt > 0) or (iDelCnt > 0) then
begin
Result := (StringOfChar(' ', 15) + 'Log Purge Information');
Result := Result + #13#10 + (RightPad('', '=', 50));
Result := Result + #13#10 + (RightPad('Days', ' ', 10) + ': ' +
IntToStr(60));
Result := Result + #13#10 + (RightPad('Purged', ' ', 10) + ': ' +
IntToStr(iDelCnt));
Result := Result + #13#10 + (RightPad('NA', ' ', 10) + ': ' +
IntToStr(iErrorCnt));
Result := Result + #13#10 + #13#10;
end
else
Result := '';
end;
function TLogComponent.RightPad(S: string; ch: char; Len: Integer): string;
var
RestLen: Integer;
begin
Result := S;
RestLen := Len - Length(S);
if RestLen < 1 then
exit;
Result := S + StringOfChar(ch, RestLen);
end;
procedure TLogComponent.SetActive(aValue: Boolean);
begin
fActive := aValue;
end;
Function TLogComponent.GetActive: Boolean;
begin
Result := fActive;
end;
end.