Advanced Delphi Systems Code: ads

//Advanced Delphi Systems Code: ads_Metrics

unit ads_Metrics;
{Copyright(c)2016 Advanced Delphi Systems

 Richard Maley
 Advanced Delphi Systems
 12613 Maidens Bower Drive
 Potomac, MD 20854 USA
 phone 301-840-1554
 dickmaley@advdelphisys.com

 The code herein can be used or modified by anyone.  Please retain references
 to Richard Maley at Advanced Delphi Systems.  If you make improvements to the
 code please send your improvements to dickmaley@advdelphisys.com so that the
 entire Delphi community can benefit.  All comments are welcome.
}
(*

UnitIndex Master Index Implementation Section Download Units

Description: ads_Metrics.pas
This unit contains the following routines.

TCustomLog_ads.Add_1 TCustomLog_ads.Add_2 TCustomLog_ads.GetActive TCustomLog_ads.GetDescriptor TCustomLog_ads.GetDuplicatesAllowed TCustomLog_ads.GetFieldDefs TCustomLog_ads.GetFileName TCustomLog_ads.GetLastEntry TCustomLog_ads.GetMaxFileSize TCustomLog_ads.GetMaxLinesInMemory TCustomLog_ads.GetSorted TCustomLog_ads.GetSortedDescending TCustomLog_ads.GetTimeStamp TCustomLog_ads.GetTrimExcessFromTop TCustomLog_ads.GetUserID TCustomLog_ads.SaveLog TCustomLog_ads.SetDescriptor TCustomLog_ads.SetDuplicatesAllowed TCustomLog_ads.SetFieldDefs TCustomLog_ads.SetFileName TCustomLog_ads.SetMaxFileSize TCustomLog_ads.SetMaxLinesInMemory TCustomLog_ads.SetSorted TCustomLog_ads.SetSortedDescending TCustomLog_ads.SetTrimExcessFromTop TCustomLog_ads.Sort TCustomLog_ads.TrimLog TCustomLog_ads.UserIDFromWindows

*)
interface
Uses
  Classes;
Type
  TLogFieldDef_ads = record
    Name         : String;
    WidthFixed   : Boolean;
    Width        : Integer;
    Alignment    : TAlignment;
  End;
         tfieldtype
         tfields
  TLogFDefs = record
    FieldDefs    : Array of TLogFieldDef_ads;
    FieldSpacing : Integer;
    KeyColumn    : Integer;
  End;

  TLogRecordValues_ads = Array of String;

  TCustomLog_ads = class(TObject)
  private
    function GetTrimExcessFromTop: Boolean;
    procedure SetTrimExcessFromTop(const Value: Boolean);
    function GetFieldDefs: TLogFDefs;
    procedure SetFieldDefs(const Value: TLogFDefs);
  protected
    FExePath           : String;
    FExeName           : String;
    FFileExt           : String;
    FActive            : Boolean;
    FDuplicatesAllowed : Boolean;
    FDescriptor        : String;
    FFileName          : String;
    FFieldDefs         : TLogFDefs;
    FFileNameDefault   : String;
    FLastEntry         : String;
    FLog               : TStringList;
    FMaxFileSize       : Int64;
    FMaxLinesInMemory  : Integer;
    FSorted            : Boolean;
    FSortedDescending  : Boolean;
    FTrimExcessFromTop : Boolean;
    FUserID            : String;
    function  GetDescriptor: String;
    procedure SetDescriptor(const Value: String);
    function  GetActive: Boolean;
    function  GetDuplicatesAllowed: Boolean;
    function  GetFileName: String;
    function  GetLastEntry: String;
    function  GetMaxFileSize: Int64;
    function  GetMaxLinesInMemory: Integer;
    function  GetSorted: Boolean;
    function  GetSortedDescending: Boolean;
    function  GetUserID: String;
    procedure SetDuplicatesAllowed(const Value: Boolean);
    procedure SetFileName(const Value: String);
    procedure SetMaxFileSize(const Value: Int64);
    procedure SetMaxLinesInMemory(const Value: Integer);
    procedure SetSorted(const Value: Boolean);
    procedure SetSortedDescending(const Value: Boolean);
    Function  UserIDFromWindows: string;
  Public
    constructor Create;
    destructor  Destroy; override;
    Function    GetTimeStamp: String;
    Procedure   SaveLog;
    procedure   Sort;
    Procedure   TrimLog;
    Procedure   Add(const S: string); OverLoad; Virtual;
    Procedure   Add(const Key, Data: String); OverLoad; Virtual;
    property    Active            : Boolean Read GetActive;
    property    DuplicatesAllowed : Boolean Read GetDuplicatesAllowed Write SetDuplicatesAllowed;
    property    Descriptor        : String  Read GetDescriptor        Write SetDescriptor;
    property    FieldDefs         : TLogFDefs Read GetFieldDefs Write SetFieldDefs;
    property    FileName          : String  Read GetFileName          Write SetFileName;
    property    LastEntry         : String  Read GetLastEntry;
    property    MaxFileSize       : Int64   Read GetMaxFileSize       Write SetMaxFileSize;
    property    MaxLinesInMemory  : Integer Read GetMaxLinesInMemory  Write SetMaxLinesInMemory;
    property    Sorted            : Boolean Read GetSorted            Write SetSorted;
    property    SortedDescending  : Boolean Read GetSortedDescending  Write SetSortedDescending;
    property    TrimExcessFromTop : Boolean Read GetTrimExcessFromTop Write SetTrimExcessFromTop;
    property    UserID            : String  Read GetUserID;
  End;

implementation

Uses
  Windows,SysUtils;

constructor TCustomLog_ads.Create;
begin
  With FFieldDefs Do
  Begin
    KeyColumn    := 0;
    FieldSpacing := 4;
    SetLength(FieldDefs,1);
    With FFieldDefs.FieldDefs[0] Do
    Begin
      {taCenter,taLeftJustify,taRightJustify}
      Alignment  := taLeftJustify;
      Name       := 'Column01';
      WidthFixed := True;
      Width      := 50;
    End;
  End;
  FExeName           := ExtractFileName(ParamStr(0));
  FExeName           := LowerCase(FExeName);
  FExeName           := Copy(FExeName,1,Length(FExeName)-4);
  FExeName           := UpperCase(Copy(FExeName,1,1))+Copy(FExeName,2,Length(FExeName)-1);
  FExePath           := ExtractFilePath(ParamStr(0));
  FExePath           := LowerCase(FExePath);
  FDescriptor        := '';
  FFileExt           := '.txt';
  FActive            := True;
  FDuplicatesAllowed := True;
  FLastEntry         := '';
  FLog               := TStringList.Create();
  FMaxFileSize       := 1000000;
  FMaxLinesInMemory  := 20;
  FSorted            := True;
  FSortedDescending  := False;
  FUserID            := UserIDFromWindows;
  FFileNameDefault   := FExePath+FExeName+'_'+GetTimeStamp+'_'+FUserID+FFileExt;
  FFileName          := FFileNameDefault;
  FTrimExcessFromTop := True;
  If FDuplicatesAllowed Then
    FLog.Duplicates := dupAccept
    Else
    FLog.Duplicates := dupIgnore;
end;

destructor TCustomLog_ads.Destroy;
begin

  FreeAndNil(FLog);
  inherited;
end;

//

Unit Description UnitIndex Master Index

function TCustomLog_ads.GetActive: Boolean;
begin
  FActive := True;
  If Descriptor = '' Then FActive := False;
  Result := FActive;
end;

//

Unit Description UnitIndex Master Index

function TCustomLog_ads.GetDuplicatesAllowed: Boolean;
begin
  Result := FDuplicatesAllowed;
end;

//

Unit Description UnitIndex Master Index

function TCustomLog_ads.GetDescriptor: String;
begin
  Result := FDescriptor;
end;

//

Unit Description UnitIndex Master Index

function TCustomLog_ads.GetFileName: String;
begin
  Result := FFileName;
end;

//

Unit Description UnitIndex Master Index

function TCustomLog_ads.GetLastEntry: String;
begin
  Result := FLastEntry;
end;

//

Unit Description UnitIndex Master Index

function TCustomLog_ads.GetMaxFileSize: Int64;
begin
  Result := FMaxFileSize;
end;

//

Unit Description UnitIndex Master Index

function TCustomLog_ads.GetMaxLinesInMemory: Integer;
begin
  Result := FMaxLinesInMemory;
end;

//

Unit Description UnitIndex Master Index

function TCustomLog_ads.GetSorted: Boolean;
begin
  Result := FSorted;
end;

//

Unit Description UnitIndex Master Index

function TCustomLog_ads.GetSortedDescending: Boolean;
begin
  Result := FSortedDescending;
end;

//

Unit Description UnitIndex Master Index

function TCustomLog_ads.GetTimeStamp: String;
Var
  t : TDateTime;
Begin
  t := now();
  Result := FormatDateTime('yyyymmddhhnnss',t)+Copy(FormatFloat('0000000.00000000000',t),14,6);
End;

//

Unit Description UnitIndex Master Index

function TCustomLog_ads.GetTrimExcessFromTop: Boolean;
begin
  Result := FTrimExcessFromTop;
end;

//

Unit Description UnitIndex Master Index

function TCustomLog_ads.GetUserID: String;
begin
  Result := FUserID;
end;

//

Unit Description UnitIndex Master Index

procedure TCustomLog_ads.SetDuplicatesAllowed(const Value: Boolean);
begin
  If FDuplicatesAllowed <> Value Then
    FDuplicatesAllowed := Value;
  If FDuplicatesAllowed Then
    FLog.Duplicates := dupAccept
    Else
    FLog.Duplicates := dupIgnore;
end;

//

Unit Description UnitIndex Master Index

procedure TCustomLog_ads.SetDescriptor(const Value: String);
Var
  sgTemp : String;
begin
  If FDescriptor <> Value Then
  Begin
    FDescriptor := Value;
    If FDescriptor<>'' Then
    Begin
      If FFileName = FFileNameDefault Then
      Begin
        sgTemp := FDescriptor;
        If Length(sgTemp) > 50 Then sgTemp := Copy(sgTemp,1,50);
        FFileName := FExePath+FExeName+'_'+sgTemp+'_'+FUserID+FFileExt;
      End;
    End;
  End;
End;

//

Unit Description UnitIndex Master Index

procedure TCustomLog_ads.SetFileName(const Value: String);
begin
  If FFileName <> Value Then FFileName := Value;
end;

//

Unit Description UnitIndex Master Index

procedure TCustomLog_ads.SetMaxFileSize(const Value: Int64);
begin
  If FMaxFileSize <> Value Then FMaxFileSize := Value;
end;

//

Unit Description UnitIndex Master Index

procedure TCustomLog_ads.SetMaxLinesInMemory(const Value: Integer);
begin
  If FMaxLinesInMemory <> Value Then FMaxLinesInMemory := Value;
end;

//

Unit Description UnitIndex Master Index

procedure TCustomLog_ads.SetSorted(const Value: Boolean);
begin
  If FSorted <> Value Then
  Begin
    FSorted := Value;
    Sort;
  End;
End;

//

Unit Description UnitIndex Master Index

procedure TCustomLog_ads.SetSortedDescending(const Value: Boolean);
begin
  If FSortedDescending <> Value Then
  Begin
    FSortedDescending := Value;
    If FSortedDescending Then FSorted := True;
    Sort;
  End;
End;

//

Unit Description UnitIndex Master Index

procedure TCustomLog_ads.SetTrimExcessFromTop(const Value: Boolean);
begin
  If FTrimExcessFromTop <> Value Then
  Begin
    FTrimExcessFromTop := Value;
  End;
end;

//

Unit Description UnitIndex Master Index

procedure TCustomLog_ads.Sort;
Var
  inCounter : Integer;
  lst       : TStringList;
  sgTemp    : String;
begin
  If FDuplicatesAllowed Then
  Begin
    FLog.Sort;
  End
  Else
  Begin
    sgTemp := FLog.Text;
    FLog.Clear;
    FLog.Duplicates := dupIgnore;
    FLog.Sorted     := True;
    FLog.SetText(PChar(sgTemp));
    FLog.Duplicates := dupAccept;
    FLog.Sorted     := False;
  End;
  If FSortedDescending Then
  Begin
    lst := TStringList.Create();
    Try
      lst.Clear;
      lst.Duplicates  := dupAccept;
      lst.Sorted      := False;
      For inCounter   := (FLog.Count-1) DownTo 0 Do lst.Add(FLog[inCounter]);
      FLog.Clear;
      FLog.Duplicates := dupAccept;
      FLog.Sorted     := False;
      FLog.SetText(PChar(lst.Text));
    Finally
      lst.Free;
    End;
  End;
End;

//

Unit Description UnitIndex Master Index

procedure TCustomLog_ads.TrimLog;
Var
  inCounter : Integer;
begin
  If Length(FLog.Text) > FMaxFileSize Then
  Begin
    For inCounter := (FLog.Count-1) DownTo 0 Do
    Begin
      If Length(FLog.Text) < FMaxFileSize Then Break;
      If FTrimExcessFromTop Then
        FLog.Delete(0)
        Else
        FLog.Delete(inCounter);
    End;
  End;
End;

//

Unit Description UnitIndex Master Index

function TCustomLog_ads.UserIDFromWindows: string;
Var
  UserName    : string;
  UserNameLen : Dword;
begin
  UserNameLen := 255;
  SetLength(userName, UserNameLen);
  If GetUserName(PChar(UserName), UserNameLen) Then
    Result := Copy(UserName,1,UserNameLen - 1)
  Else
    Result := 'Unknown';
End;

//

Unit Description UnitIndex Master Index

procedure TCustomLog_ads.SaveLog;
Var
  lst       : TStringList;
  sgPath    : String;
  sgTemp    : String;
begin
  sgPath := ExtractFilePath(FileName);
  If Not DirectoryExists(sgPath) Then ForceDirectories(sgPath);
  sgTemp := '';
  If FileExists(FileName) Then
  Begin
    lst := TStringList.Create();
    Try
      lst.Clear;
      lst.LoadFromFile(FileName);
      sgTemp := FLog.Text+lst.Text;
    Finally
      lst.Clear;
    End;
  End;
  If sgTemp = '' Then sgTemp := FLog.Text;
  FLog.Clear;
  FLog.Duplicates := dupAccept;
  FLog.Sorted     := False;
  FLog.SetText(PChar(sgTemp));
  Sort;
  TrimLog;
  FLog.SaveToFile(FileName);
End;

//

Unit Description UnitIndex Master Index

procedure TCustomLog_ads.Add(const S: string);
begin
  //
end;

//

Unit Description UnitIndex Master Index

Procedure  TCustomLog_ads.Add(const Key, Data: String); 
begin
 //
end;

//

Unit Description UnitIndex Master Index

function TCustomLog_ads.GetFieldDefs: TLogFDefs;
begin
  Result := FFieldDefs;
end;

//

Unit Description UnitIndex Master Index

procedure TCustomLog_ads.SetFieldDefs(const Value: TLogFDefs);
begin
  FFieldDefs := Value;
end;

end.
//