Sordie.co.uk

libsassy/libSassy.Errors.pas

Raw

{(
 )) libSassy.Errors
((    Error and Exception handlers
 ))
((  Copyright  Sordie Aranka Solomon-Smith 2015
 ))
((  This work is made available under the terms of the Creative Commons
 )) Attribution-NonCommercial-ShareAlike 3.0 Unported license
((  http://creativecommons.org/licenses/by-nc-sa/3.0/
 )}

unit libSassy.Errors;

interface

uses
  Winapi.Windows,

  libSassy.Log;

{$REGION 'TException'}
type
  TException = class
  private
    fMessage: String;
  public
    constructor Create(const AMessage: String);

    property Message: String read fMessage;

    class procedure RaiseException(const AMessage: String = '');
  end;

  TExceptionClass = class of TException;
{$ENDREGION}

type
  TRuntimeError = class(TException);

implementation

uses
  libSassy.Strings;

{$REGION 'TException'}
constructor TException.Create;
begin
  inherited Create;

  fMessage := AMessage;
end;

class procedure TException.RaiseException;
begin
  raise Self.Create(AMessage) at ReturnAddress;
end;
{$ENDREGION}

{$REGION 'Error handlers'}
procedure ErrorHandler(ErrorCode: Byte; ErrorAddr: Pointer);
begin
  raise TRuntimeError.Create('Runtime error #' + String.Int(ErrorCode)) at ErrorAddr;
end;

procedure ExceptionHandler(ExceptObject: TObject; ExceptAddr: Pointer);
var
  Msg: String;
begin
  Msg := 'Exception ' + ExceptObject.ClassName + ' at ' + String.Pointer(ExceptAddr);

  if (ExceptObject is TException) and (not TException(ExceptObject).Message.Empty) then
    Msg := Msg + #13#10 + TException(ExceptObject).Message;

  if IsConsole then
    Log([Msg])
  else
    MessageBox(0, Msg.Ptr, ParamStr(0).Ptr, MB_OK or MB_ICONERROR or MB_TASKMODAL or MB_TOPMOST);

  Halt(1);
end;
{$ENDREGION}

initialization
  System.ErrorProc      := ErrorHandler;
  System.ExceptProc     := @ExceptionHandler;
  System.ExceptionClass := TException;
end.