home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0010 - 0019 / ibm0010-0019 / ibm0010.tar / ibm0010 / CLIPB51.ZIP / C5P78.EXE / SOURCE / ERRORSYS.PRG next >
Encoding:
Text File  |  1990-05-24  |  982 b   |  66 lines
  1. #include "error.ch"
  2.  
  3.  
  4. ****
  5. *    errorsys.prg
  6. *
  7.  
  8. #define OUT(str)        __OUTSTD( str )
  9. #define OUTNL(str)        __OUTSTD( Chr(13) + Chr(10) + str )
  10.  
  11.  
  12. ***
  13. *    ErrorSys()
  14. *
  15.  
  16. proc ErrorSys()
  17.     ErrorBlock( {|e| DefError(e)} )
  18. return
  19.  
  20.  
  21. ***
  22. *    DefError()
  23. *
  24. static func DefError(e)
  25. local i
  26.  
  27.     if ( e:genCode == EG_OPEN .and. NetErr() .and. e:canDefault )
  28.         return (.f.)    /* ignore */
  29.     end
  30.  
  31.     /* put message to STDOUT */
  32.     OUTNL( "Error" )
  33.  
  34.     if ( !Empty(e:subsystem()) )
  35.         OUT( " " + e:subsystem() + "[" + LTrim(Str(e:subCode())) + "]" )
  36.     end
  37.  
  38.     if ( !Empty(e:description()) )
  39.         OUT( "  " + e:description() )
  40.     end
  41.  
  42.     if ( !Empty(e:operation()) )
  43.         OUT( ": " + e:operation() )
  44.     end
  45.  
  46.     if ( !Empty(e:filename()) )
  47.         OUT( ": " + e:filename() )
  48.     end
  49.  
  50.  
  51.     i := 2
  52.     while (.t.)
  53.         OUTNL( "Called from " + Trim(ProcName(i)) + ;
  54.             "(" + Alltrim(Str(ProcLine(i))) + ")  " )
  55.  
  56.         i++
  57.  
  58.         if ( ProcName(i) == "" )
  59.             ERRORLEVEL(1)
  60.             QUIT
  61.         end
  62.     end
  63.  
  64. return (.f.)
  65.  
  66.