Bu unit program hatalı işleminde kullanılır.
Kod: Tümünü seç
unit ads_Exception;
interface
Uses SysUtils, Classes, Windows, FileCtrl;
{
This unit is devoted to exception handling.
If the RaiseError procedure is used throughout an application all
ambiguity is removed as to when and where errors are
occurring. This procedure can record exactly when, where
and the specific error. All errors can be logged for
future reference. Size limits can be set on the log
file and how often the file is written thereby freeing up
memory resources. The log orders the data newest to oldest
so that the newest errors appear at the beginning.
}
{!~
RaiseError
This procedure is a centralized error handler.
If this procedure is used throughout an application all
ambiguity is removed as to when and where errors are
occurring. This procedure can record exactly when, where
and the specific error. All errors can be logged for
future reference. Size limits can be set on the log
file and how often the file is written thereby freeing up
memory resources. The log orders the data newest to oldest
so that the newest errors appear at the beginning.
To use this procedure add ads_Exception to a units uses
clause and call RaiseError in functions and procedures where
you desire error handling.
Example:
unit MyCodeUnit;
interface
Uses
ads_Exception;
procedure MyProc;
Implementation
const UnitName = MyCodeUnit;
procedure MyProc;
Var
ProcName : String;
Begin
ProcName := MyProc'; Try
.
.
.
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
End.
This procedure handles:
cleanup prior to handling an error (RaiseErrorInit),
graceful processing of errors (RaiseErrorHandle),
logging errors to file (LogErrors True/False),
raising errors (RaiseErrors True/False),
post error actions (RaiseErrorLast)
Set the following variables to control the behavior
of the error handling. The values shown below are the
defaults.
LogErrors := True;
RaiseErrors := False;
ErrorLogSizeLimit := 1000000;
SaveToFileEveryNErrors := 20;
ErrorLogFileName := Copy(ParamStr(0),1,Length(ParamStr(0))-4)+'_err_'+UserIDFromWindows+'.txt';
}
Procedure RaiseError(UnitName,ProcName:String;E : Exception);
Var
{!~
LogErrors
Errors are recorded to file, i.e., lofgged based on
the LogErrors boolean variable. If True errors are
written to file, if false error messages are not
logged. LogErrors can be used in any
combination with RasiseErrors to control presentation
and recording of errors.
RaiseErrors LogErrors See Error Log Error
TRUE TRUE YES YES
TRUE FALSE YES NO
FALSE TRUE NO YES
FALSE FALSE NO NO }
LogErrors : Boolean;
{!~
RaiseErrors
Errors are presented to users or suppressed based on
the RaiseErrors boolean variable. If True errors are
presented to users, if false error messages are
suppressed. RasiseErrors can be used in any
combination with LogErrors to control presentation
and recording of errors.
RaiseErrors LogErrors See Error Log Error
TRUE TRUE YES YES
TRUE FALSE YES NO
FALSE TRUE NO YES
FALSE FALSE NO NO }
RaiseErrors : Boolean;
{!~
ErrorLogFileName
If LogErrors is set to True then all unhandled errors
are logged to a file. The log file path and name are
set by ErrorLogFileName. The default value for
ErrorLogFileName is
ExecutableName+'_err_'+UserIDFromWindows+'.txt'.
This default naming allows for an executable to be run
from the network and each user has his own error log.
The filename can be changed at runtime.}
ErrorLogFileName : String;
{!~
RaiseErrorInit
This procedure is run first in the RaiseError procedure.
This procedure provides an opportunity to do cleanup
before processing an error. An example of cleanup
would be correcting the mouse cursor.
}
RaiseErrorInit : Procedure;
{!~
RaiseErrorHandle
This procedure is run after RaiseErrorInit in the RaiseError
procedure.
If the RaiseErrorHandle function returns True meaning that
the error has been successfully handled, then the error is
not raised or logged, otherwise flow continues in the
RaiseError procedure to log and raise the error as appropriate.
The RaiseErrorHandle procedure is a place to handle errors.
Procedures can be assigned to RaiseErrorHandle on the fly
like: RaiseErrorHandle := MyErrorHandler;
To disable a current setting for RaiseErrorHandle set this
variable to nil.
}
RaiseErrorHandle : Function(UnitName,ProcName:String;E : Exception): Boolean;
{!~
RaiseErrorLast
This procedure is run last in the RaiseError procedure.
}
RaiseErrorLast : Procedure;
{!~
ErrorLogSizeLimit
This variable establishes the upper limit on the size of the
log file. If LogErrors = True then errors are recorded in
ErrorLogFileName. If the size of the log file reaches
the value set by ErrorLogSizeLimit then the file is reduced
in size until it reaches the size limit. Error messages
are deleted from the oldest to the newest. The default
value for ErrorLogSizeLimit is 1000000. Please remember
this variable is of type Int64 not Integer. There is a
difference.
}
ErrorLogSizeLimit : Int64;
{!~
SaveToFileEveryNErrors
This variable establishes how frequently the error data
in memory is written to file. The default is 20, meaning
that after 20 errors the log in memory is written to file
and then the memory log is cleared. This allows the
maximum amount of memory to be available to the application
and solves a problem where a user keeps an application open
all day and the log keeps on getting bigger and bigger
thereby draining memory resources.
Setting SaveToFileEveryNErrors to 20 ensures that never
will the memory log be any bigger than 20 errors.}
SaveToFileEveryNErrors : Integer;
implementation
Const UnitName = 'ads_Exception';
Var
ErrorLog : TStringList;
ProcName : String;
Function 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;
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;
{!~
TrimErrorLog
This routine controls the saving and sizing of the error log.
}
Procedure TrimErrorLog(lst : TStringList);
Var
inCounter : Integer;
ProcName : String;
boBreak : Boolean;
begin
ProcName := 'TrimErrorLog'; Try
boBreak := False;
inCounter := 1;
lst.SaveToFile(ErrorLogFileName);
While True Do
Begin
If FileExists(ErrorLogFileName) Then
Begin
If GetFileSize(ErrorLogFileName) > ErrorLogSizeLimit Then
Begin
lst.Delete(lst.Count-1);
lst.SaveToFile(ErrorLogFileName);
End
Else
Begin
boBreak := True;
End;
End
Else
Begin
Break;
End;
inc(inCounter);
If boBreak Then Break;
If inCounter > 1000 Then Break;
If lst.Count < 10 Then Break;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
{!~
SaveErrorLog
This routine controls the saving and sizing of the error log.
}
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);
Finally
lst.Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
{!~
RaiseError
This procedure is a centralized error handler.
If this procedure is used throughout an application all
ambiguity is removed as to when and where errors are
occurring. This procedure can record exactly when, where
and the specific error. All errors can be logged for
future reference. Size limits can be set on the log
file and how often the file is written thereby freeing up
memory resources. The log orders the data newest to oldest
so that the newest errors appear at the beginning.
To use this procedure add ads_Exception to a units uses
clause and call RaiseError in functions and procedures where
you desire error handling.
Example:
unit MyCodeUnit;
interface
Uses
ads_Exception;
procedure MyProc;
Implementation
const UnitName = MyCodeUnit;
procedure MyProc;
Var
ProcName : String;
Begin
ProcName := MyProc'; Try
.
.
.
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
End.
This procedure handles:
cleanup prior to handling an error (RaiseErrorInit),
graceful processing of errors (RaiseErrorHandle),
logging errors to file (LogErrors True/False),
raising errors (RaiseErrors True/False),
post error actions (RaiseErrorLast)
Set the following variables to control the behavior
of the error handling. The values shown below are the
defaults.
LogErrors := True;
RaiseErrors := False;
ErrorLogSizeLimit := 1000000;
SaveToFileEveryNErrors := 20;
ErrorLogFileName := Copy(ParamStr(0),1,Length(ParamStr(0))-4)+'_err_'+UserIDFromWindows+'.txt';
}
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;
Initialization
ProcName := 'Initialization'; Try
LogErrors := True;
RaiseErrors := False;
ErrorLogSizeLimit := 1000000;
SaveToFileEveryNErrors := 20;
ErrorLogFileName := Copy(ParamStr(0),1,Length(ParamStr(0))-4)+'_err_'+UserIDFromWindows+'.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.