home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 2 BBS / 02-BBS.zip / bvdoor10.zip / TRAPEXIT.PAS < prev   
Pascal/Delphi Source File  |  1996-12-12  |  5KB  |  174 lines
  1. (* This exit procedure may be used to trap HALT codes.    If defined in the
  2.      main body of your program (DoorExit := TrapExit), this procedure will be
  3.      called whenever your program encounters a HALT code or runtime error.
  4.  
  5.      As shown below, if ErrorAddr <> NIL (no runtime error has occurred) the
  6.      runtime error information is displayed to the local console and is also
  7.      written to a file called PROG_ERR.LOG.  You may wish to change the name
  8.      of this error log file to something more fitting to your program.
  9.  
  10.      If ErrorAddr = NIL then this code assumes that no runtime error has
  11.      occurred but rather that a HALT code has been encountered.  You could
  12.      conceivably handle all your HALT functions within the TRAPEXIT procedure.
  13.      However, in this demonstration, we can see that we are passing the HALT
  14.      code onto the TERMINATE procedure which is located within your program's
  15.      code.
  16. *)
  17.  
  18.  
  19. (* Converts a word into a 4 CHAR hex number *)
  20. FUNCTION itoh(w: WORD) : STRING;
  21.     CONST
  22.         hex : ARRAY[0..15] OF CHAR = '0123456789ABCDEF';
  23.     VAR
  24.         h : STRING[4];
  25.     BEGIN
  26.         h[0] := CHR(4);
  27.         h[1] := hex[(w SHR 12) AND $0f];
  28.         h[2] := hex[(w SHR 8) AND $0f];
  29.         h[3] := hex[(w SHR 4) AND $0f];
  30.         h[4] := hex[w AND $0f];
  31.         itoh := h;
  32.     END;
  33.  
  34.  
  35. FUNCTION error_message(code : INTEGER) : STRING;
  36.     VAR
  37.         classtype :  STRING;
  38.         msg : STRING;
  39.     BEGIN
  40.         CASE code OF
  41.                 1.. 99    : classtype := 'DOS ERROR : ';
  42.                 100..149: classtype := 'I/O ERROR : ';
  43.                 150..199: classtype := 'CRITICAL ERROR : ';
  44.                 200..249: classtype := 'FATAL ERROR : ';
  45.             ELSE
  46.                 classtype := 'UNKNOWN ERROR : ';
  47.         END;
  48.  
  49.     CASE code OF
  50.             2: msg := 'File not found';
  51.             3: msg := 'Path not found';
  52.             4: msg := 'Too many open files';
  53.             5: msg := 'File access denied';
  54.             6: msg := 'Bad file handle';
  55.             12: msg := 'Bad file access code';
  56.             15: msg := 'Bad drive number';
  57.             16: msg := 'Can''t remove current dir';
  58.             17: msg := 'Can''t rename across drives';
  59.             100: msg := 'Disk read error, read past eof on Typed File';
  60.             101: msg := 'Disk write error';
  61.             102: msg := 'File not assigned';
  62.             103: msg := 'File not open';
  63.             104: msg := 'File not open for input';
  64.             105: msg := 'File not open for output';
  65.             106: msg := 'Bad numeric format';
  66.             150: msg := 'Disk is write-protected';
  67.             151: msg := 'Unknown diskette unit';
  68.             152: msg := 'Drive not ready';
  69.             153: msg := 'Unknown command';
  70.             154: msg := 'CRC error in data';
  71.             155: msg := 'Bad drive request structure length';
  72.             156: msg := 'Disk seek error';
  73.             157: msg := 'Unknown diskette type';
  74.             158: msg := 'Sector not found';
  75.             159: msg := 'Printer out of paper';
  76.             160: msg := 'Device write fault';
  77.             161: msg := 'Device read fault';
  78.             162: msg := 'Hardware failure';
  79.             200: msg := 'Division by zero';
  80.             201: msg := 'Range check';
  81.             202: msg := 'Stack overflow';
  82.             203: msg := 'Heap overflow'+' (Not enough memory to run)';
  83.             204: msg := 'Bad pointer operation';
  84.             205: msg := 'Floating point overflow';
  85.             206: msg := 'Floating point underflow';
  86.             207: msg := 'Bad floating point operation';
  87.         ELSE
  88.             STR(code, msg);
  89.         END;
  90.     error_message := classtype + msg;
  91. END;
  92.  
  93.  
  94. FUNCTION Exit_message(Code: INTEGER): STRING;
  95.          {return message text for a given exit code}
  96.     VAR
  97.         msg:        STRING;
  98.     BEGIN
  99.         CASE Code OF
  100.                 0: msg := 'Normal Termination';
  101.                 1: msg := 'Carrier Lost';
  102.                 2: msg := 'Time Limit Exceeded';
  103.                 3: msg := 'User Inactivity Timeout';
  104.                 4:
  105.                         IF doorsys THEN
  106.                             msg := 'Door.Sys file not found'
  107.                         ELSE IF sessioninfo THEN
  108.                             msg := 'Session.Info file not found'
  109.                         ELSE
  110.                             msg := 'Dorinfo' + itoa(getnode) + '.Def file not found';
  111.                 5: msg := 'Cannot Find ExitInfo.Bbs';
  112.                 6: msg := 'Directory Change/Read Error';
  113.                 7: msg := 'CTS Timeout';
  114.                 8: msg := 'Forced Exit via RAXIT Semaphore';
  115.                 9: msg := 'File Lock Timeout';
  116.                 10:msg := 'User Logged Off';
  117.                 255: msg := 'Sysop Hit Ctrl-Break!';
  118.             ELSE
  119.                 STR(Code,msg);
  120.         END;
  121.     exit_message := msg;
  122. END;
  123.  
  124.  
  125. PROCEDURE hdr_errfile(VAR f : TEXT);
  126.     BEGIN
  127.         REWRITE(f) ;
  128.         WRITELN(f, 'Error Log Generated by ', productname,' On Node ' + itoa(getnode));
  129.         WRITELN(f);
  130.     END;
  131.  
  132.  
  133. PROCEDURE trapexit; FAR;
  134.     VAR
  135.         errfile : TEXT;
  136.     BEGIN
  137.         bv_Log('Trapexit Begin');
  138.         IF ERRORADDR = NIL THEN
  139.             BEGIN
  140.                 IF (EXITCODE IN [0, 10, 255]) THEN
  141.                     BEGIN
  142.                         terminate(EXITCODE) ;
  143.                         EXIT;
  144.                     END;
  145.                 ASSIGN(errfile, ckpath(exepath) + bvlogname + itoa(getnode) +'.Err') ;
  146.                 {$I-}
  147.                 APPEND(errfile);
  148.                 {$I+}
  149.                 IF IORESULT <> 0 then
  150.                     hdr_errfile(errfile);
  151.                 WRITELN(errfile, ' ! ',datestr,'  ', timestr,'   ' + exit_message(EXITCODE));
  152.                 FLUSH(errfile) ;
  153.                 CLOSE(errfile) ;
  154.                 terminate(EXITCODE);
  155.             END
  156.         ELSE
  157.             BEGIN
  158.                 ASSIGN(errfile, ckpath(exepath) + bvlogname + itoa(getnode)+'.Log') ;
  159.                 WRITELN('ERROR!!  Read ', ckpath(exepath) + bvlogname + itoa(getnode) + '.Log for more information');
  160.                 {$I-}
  161.                 APPEND(errfile);
  162.                 {$I+}
  163.                 IF IORESULT <> 0 THEN
  164.                     hdr_errfile(errfile);
  165.                 WRITE(errfile, ' ! ',datestr,'  ',timestr,'   Error : ', itoa(EXITCODE),' @ ',itoa(SEG(ERRORADDR^)));
  166.                 WRITELN(errfile, ':', itoa(OFS(ERRORADDR^)));
  167.                 WRITE(' ! ',datestr,'  ',timestr,'   ', error_message(EXITCODE));
  168.                 WRITELN(errfile);
  169.                 FLUSH(errfile);
  170.                 CLOSE(errfile);
  171.             END;
  172.     erroraddr := NIL;
  173. END;
  174.