home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / PNL010.ZIP / ERR_DESC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-29  |  2.8 KB  |  102 lines
  1. Unit Err_Desc;
  2. (*Copyright (c) 1992 KHIRON Software
  3.  
  4.   All rights reserved. KHIRON Software hereby grants
  5.   permission for free distribution of this software,
  6.   and for use of this software within commercial and
  7.   non-commercial applications. This software itself
  8.   may not be distributed commercially without obtaining
  9.   written permission from KHIRON Software.
  10.  
  11.   Should you use this software or it's techniques in commercial
  12.   products send me a postcard at the following address to fulfill
  13.   a licensing commitment:
  14.  
  15.     Richard A. Morris
  16.     C/- KHIRON Software
  17.     P.O. Box 544
  18.     INDOOROOPILLY Qld 4068
  19.     AUSTRALIA
  20. *)
  21. (*
  22.   This unit reads a stringlist made by Make_Err containing descriptions of
  23.   common Turbo Pascal run time errors.  It then attempts to describe any
  24.   runtime errors that the program using this unit creates.
  25.  
  26.   The unit will also use read ini to find the Path/Name of the Errors file.
  27. *)
  28. INTERFACE
  29. Uses Objects,
  30.      ReadIni;
  31. IMPLEMENTATION
  32. Var
  33.   PreErrDesc_ExitProc: pointer;
  34. FUNCTION Hex(w : Word) : STRING;
  35. const
  36.   hexChars : array [0..$F] of Char =
  37.     '0123456789ABCDEF';
  38. begin
  39.   hEX :=hexChars[Hi(w) shr 4]+hexChars[Hi(w) and $F]+
  40.   hexChars[Lo(w) shr 4]+hexChars[Lo(w) and $F];
  41. END;
  42. FUNCTION PTR2Str(p : POINTER) : STRING;
  43. BEGIN
  44.        IF P = NIL THEN
  45.     PTR2Str := 'NIL'
  46.        else
  47.     PTR2Str := HEX(SEG(P^))+':'+HEX(OFS(P^));
  48. END;
  49. Function ErrorFor(ErrNumber : Word) : String;
  50. Var
  51.   ErrorDesc    : String;
  52.   ErrorStrings : pStringList;
  53.   ErrorStream  : pStream;
  54.   ErrorResource: pResourceFile;
  55.   StreamName   : fNameStr;
  56. begin
  57.   StreamName := GetParam('System','ErrorFile');
  58.   If StreamName = '' then
  59.     ErrorFor := 'Errorfile Parameter missing from INI File'
  60.   else
  61.   begin
  62.     ErrorStream := New(pBufStream,Init(StreamName,stOpen,1024));
  63.     if ErrorStream = nil then
  64.       ErrorFor := 'ERRORS.STM missing'
  65.     else
  66.     begin
  67.       ErrorResource := New(pResourceFile,Init(ErrorStream));
  68.       ErrorStrings := pStringList(ErrorResource^.Get('ERRORDESC'));
  69.       if ErrorStrings = nil then
  70.         ErrorFor := 'ERRORS.STM invalid'
  71.       else
  72.       begin
  73.         if ErrorStrings^.Get(ErrNumber) = '' then
  74.           ErrorFor := 'Unknown Error'
  75.         else
  76.           ErrorFor := ErrorStrings^.Get(ErrNumber);
  77.       end;
  78.     end;
  79.   end;
  80. end;
  81. Procedure DescribeError; far;
  82. begin
  83.   ExitProc := PreErrDesc_ExitProc;
  84.   if ExitCode = 0 then
  85.     ErrorAddr := nil
  86.   else
  87.   begin
  88.     Assign(OutPut,'');
  89.     Rewrite(Output);
  90.     Writeln('Run Time Error ',ExitCode);
  91.     Writeln(ErrorFor(ExitCode));
  92.     Writeln('at Location ',Ptr2Str(ErrorAddr));
  93.     ErrorAddr := nil;
  94.   end;
  95. end;
  96. begin
  97.   {Set Up ExitCode}
  98.   RegisterType(RStringList);
  99.   PreErrDesc_ExitProc := ExitProc;
  100.   ExitProc := @DescribeError;
  101. end.
  102.