Advanced Delphi Systems Code: ads

//Advanced Delphi Systems Code: ads_Exception

unit ads_Exception;
{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_Exception.pas
This unit contains the following routines.

GetFileSize RaiseError SaveErrorLog SetProcName TrimErrorLog UserIDFromWindows

*)
interface
Uses
  SysUtils
  ,Classes
  {$IFDEF MSWINDOWS}, Windows{$ENDIF}
  ;
Procedure RaiseError(UnitName,ProcName:String;E : Exception);
Procedure SaveErrorLog;
Procedure SetProcName(var p,ProcName);
Var
  LogErrors                 : Boolean;
  LogAppFlow                : Boolean = False;
  RaiseErrors               : Boolean;
  ErrorLogFileName          : String;
  RaiseErrorInit            : Procedure;
  RaiseErrorHandle          : Function(UnitName,ProcName:String;E : Exception): Boolean;
  RaiseErrorLast            : Procedure;
  ErrorLogSizeLimit         : Int64;
  SaveToFileEveryNErrors    : Integer;
  LastError                 : String;

implementation


Const UnitName              = 'ads_Exception';
Var
  ErrorLog                  : TStringList;
  ProcName                  : String;

//

Unit Description UnitIndex Master Index

Procedure SetProcName(var p,ProcName);
Begin

End;

//

Unit Description UnitIndex Master Index

Function UserIDFromWindows: string;
{$IFDEF MSWINDOWS}
Var
  UserName    : string;
  UserNameLen : Dword;
{$ENDIF}
Begin
  Result := 'Unknown';
  {$IFDEF MSWINDOWS}
  UserNameLen := 255;
  SetLength(userName, UserNameLen);
  If GetUserName(PChar(UserName), UserNameLen) Then
    Result := Copy(UserName,1,UserNameLen - 1)
  Else
    Result := 'Unknown';
  {$ENDIF}  
End;

//

Unit Description UnitIndex Master Index

function GetFileSize(const FileName: string): LongInt;
Var
  SearchRec: TSearchRec;
  sgPath   : String;
  inRetval : Integer;
begin
  sgPath   := ExpandFileName(FileName);
  Try
    inRetval := FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec);
    If inRetval = 0 Then
      Result := SearchRec.Size
    Else Result := -1;
  Finally
    SysUtils.FindClose(SearchRec);
  End;
end;

//

Unit Description UnitIndex Master Index

Procedure RaiseError(UnitName,ProcName:String;E : Exception);
Var
  sgErr          : String;
  boHandled      : Boolean;
Begin
  If Assigned(RaiseErrorInit)   Then RaiseErrorInit;
  If Assigned(RaiseErrorHandle) Then
  Begin
    boHandled := RaiseErrorHandle(UnitName,ProcName,E);
    If boHandled Then Exit;
  End;
  If LogErrors Then
  Begin
    sgErr := E.Message;
    sgErr := StringReplace(sgErr,#13,'',[rfReplaceall]);
    sgErr := StringReplace(sgErr,#10,'',[rfReplaceall]);
    ErrorLog.Add(FormatDateTime('yyyymmddhhnnss',now())+' '+UnitName+'.'+Procname+' error: '+sgErr);
    If ErrorLog.Count > SaveToFileEveryNErrors Then
    Begin
      SaveErrorLog;
      ErrorLog.Clear;
    End;
  End;
  If RaiseErrors     Then Raise Exception.Create(UnitName+'.'+Procname+' error: '+sgErr);
  If Assigned(RaiseErrorLast) Then RaiseErrorLast;
End;//{|end }


//

Unit Description UnitIndex Master Index

Procedure TrimErrorLog(lst : TStringList);
Var
  inCounter : Integer;
  ProcName  : String;
  boBreak   : Boolean;
begin
  ProcName  := 'TrimErrorLog'; Try
  boBreak   := False;
  inCounter := 1;
  While True Do
  Begin
    If Length(lst.Text) > ErrorLogSizeLimit Then
    Begin
      lst.Delete(lst.Count-1);
    End
    Else
    Begin
      boBreak := True;
    End;
    inc(inCounter);
    If boBreak          Then Break;
    If inCounter > 1000 Then Break;
    If lst.Count < 10   Then Break;
  End;
  If lst.Count > 1 Then
  Begin
    lst.SaveToFile(ErrorLogFileName);
  End
  Else
  Begin
    If lst.Count = 1 Then
    Begin
      If Trim(lst[0]) <> '' Then lst.SaveToFile(ErrorLogFileName);
    End;
  End;
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;

//

Unit Description UnitIndex Master Index

Procedure SaveErrorLog;
Var
  lst       : TStringList;
  inCounter : Integer;
  ProcName  : String;
  sgPath    : String;
begin
  ProcName := 'SaveErrorLog'; Try
  lst := TStringList.create();
  Try
    sgPath := ExtractFilePath(ErrorLogFileName);
    If Not DirectoryExists(sgPath) Then ForceDirectories(sgPath);
    lst.Clear;
    If FileExists(ErrorLogFileName) Then
      lst.LoadFromFile(ErrorLogFileName);
    ErrorLog.SetText(PChar(ErrorLog.Text+lst.Text));
    ErrorLog.Sorted := True;
    ErrorLog.Sorted := False;
    lst.Clear;
    For inCounter := (ErrorLog.Count - 1) DownTo 0 Do
    Begin
      lst.Add(ErrorLog[inCounter]);
    End;
    TrimErrorLog(lst);
    ErrorLog.Clear;
  Finally
    lst.Free;
  End;
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;

Initialization
  ProcName                  := 'Initialization'; Try
  LogErrors                 := True;
  RaiseErrors               := False;
  ErrorLogSizeLimit         := 100000;
  SaveToFileEveryNErrors    := 1;
  ErrorLogFileName          := Copy(ParamStr(0),1,Length(ParamStr(0))-4)+'_err.txt';
  ErrorLog                  := TstringList.Create();
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
Finalization
  ProcName := 'Finalization'; Try
  If LogErrors Then SaveErrorLog;
  ErrorLog        .Free; ErrorLog        := nil;
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End.


//