home *** CD-ROM | disk | FTP | other *** search
/ BUG 4 / BUGCD1997_05.BIN / aplic / clip4win / clip4win.exe / C4W30E.HUF / SOURCE / ERRORSYS.PRG < prev    next >
Text File  |  1993-01-29  |  4KB  |  219 lines
  1. /***
  2. *    Errorsys.prg
  3. *    Standard Clipper 5.0 error handler
  4. *    Copyright (c) 1990 Nantucket Corp.  All rights reserved.
  5. *
  6. *    Compile:  /m/n/w
  7. */
  8.  
  9. #include "error.ch"
  10.  
  11.  
  12. // put messages to STDERR
  13. #command ? <list,...>   =>  ?? Chr(13) + Chr(10) ; ?? <list>
  14. #command ?? <list,...>  =>  OutErr(<list>)
  15.  
  16.  
  17. // used below
  18. #define NTRIM(n)        ( LTrim(Str(n)) )
  19.  
  20.  
  21.  
  22. /***
  23. *    ErrorSys()
  24. *
  25. *    Note:  automatically executes at startup
  26. */
  27.  
  28. proc ErrorSys()
  29.     ErrorBlock( {|e| DefError(e)} )
  30. return
  31.  
  32.  
  33.  
  34.  
  35. /***
  36. *    DefError()
  37. */
  38. static func DefError(e)
  39. local i, cMessage, aOptions, nChoice
  40.  
  41.  
  42.  
  43.     // by default, division by zero yields zero
  44.     if ( e:genCode == EG_ZERODIV )
  45.         return (0)
  46.     end
  47.  
  48.  
  49.     // for network open error, set NETERR() and subsystem default
  50.     if ( e:genCode == EG_OPEN .and. e:osCode == 32 .and. e:canDefault )
  51.  
  52.         NetErr(.t.)
  53.         return (.f.)                                    // NOTE
  54.  
  55.     end
  56.  
  57.  
  58.     // for lock error during APPEND BLANK, set NETERR() and subsystem default
  59.     if ( e:genCode == EG_APPENDLOCK .and. e:canDefault )
  60.  
  61.         NetErr(.t.)
  62.         return (.f.)                                    // NOTE
  63.  
  64.     end
  65.  
  66.  
  67.  
  68.     // build error message
  69.     cMessage := ErrorMessage(e)
  70.  
  71.  
  72.     // build options array
  73.     // aOptions := {"Break", "Quit"}
  74.     aOptions := {"Quit"}
  75.  
  76.     if (e:canRetry)
  77.         AAdd(aOptions, "Retry")
  78.     end
  79.  
  80.     if (e:canDefault)
  81.         AAdd(aOptions, "Default")
  82.     end
  83.  
  84.  
  85.     // put up alert box
  86.     nChoice := 0
  87.     while ( nChoice == 0 )
  88.  
  89.         if ( Empty(e:osCode) )
  90.             nChoice := Alert( cMessage, aOptions )
  91.  
  92.         else
  93.             nChoice := Alert( cMessage + ;
  94.                             ";(DOS Error " + NTRIM(e:osCode) + ")", ;
  95.                             aOptions )
  96.         end
  97.  
  98.  
  99.         if ( nChoice == NIL )
  100.             exit
  101.         end
  102.  
  103.     end
  104.  
  105.  
  106.     if ( !Empty(nChoice) )
  107.  
  108.         // do as instructed
  109.         if ( aOptions[nChoice] == "Break" )
  110.             Break(e)
  111.  
  112.         elseif ( aOptions[nChoice] == "Retry" )
  113.             return (.t.)
  114.  
  115.         elseif ( aOptions[nChoice] == "Default" )
  116.             return (.f.)
  117.  
  118.         end
  119.  
  120.     end
  121.  
  122.  
  123.     // display message and traceback
  124.     if ( !Empty(e:osCode) )
  125.         cMessage += " (DOS Error " + NTRIM(e:osCode) + ") "
  126.     end
  127.  
  128. #define    CLIP4WIN
  129.  
  130. #ifdef    CLIP4WIN
  131.  
  132.     #include "windows.ch"
  133.     #define    nFH    nChoice        // re-use the var.
  134.     #define    CRLF    chr(13) + chr(10)
  135.  
  136.     if MessageBox( , "Write error log to _ERR.TXT ?", "ERRORSYS", MB_ICONQUESTION + MB_YESNO) == IDYES
  137.         if (nFH := fcreate("_err.txt"))    == -1
  138.             MessageBox( , "Failed to create the file", "ERRORSYS", MB_ICONHAND + MB_OK)
  139.         else
  140.             fwrite(nFH, cMessage + CRLF)
  141.             i := 2
  142.             while ( !Empty(ProcName(i)) )
  143.                 fwrite(nFH, "Called from " + Trim(ProcName(i)) + ;
  144.                     "(" + NTRIM(ProcLine(i)) + ")  " + CRLF)
  145.  
  146.                 i++
  147.             end
  148.             fclose(nFH)
  149.         endif
  150.     endif
  151.  
  152. #else    // ! CLIP4WIN
  153.  
  154.     ? cMessage
  155.     i := 2
  156.     while ( !Empty(ProcName(i)) )
  157.         ? "Called from", Trim(ProcName(i)) + ;
  158.             "(" + NTRIM(ProcLine(i)) + ")  "
  159.  
  160.         i++
  161.     end
  162.  
  163. #endif    // CLIP4WIN
  164.  
  165.     // give up
  166.     ErrorLevel(1)
  167.     QUIT
  168.  
  169. return (.f.)
  170.  
  171.  
  172.  
  173.  
  174. /***
  175. *    ErrorMessage()
  176. */
  177. static func ErrorMessage(e)
  178. local cMessage
  179.  
  180.  
  181.     // start error message
  182.     cMessage := if( e:severity > ES_WARNING, "Error ", "Warning " )
  183.  
  184.  
  185.     // add subsystem name if available
  186.     if ( ValType(e:subsystem) == "C" )
  187.         cMessage += e:subsystem()
  188.     else
  189.         cMessage += "???"
  190.     end
  191.  
  192.  
  193.     // add subsystem's error code if available
  194.     if ( ValType(e:subCode) == "N" )
  195.         cMessage += ("/" + NTRIM(e:subCode))
  196.     else
  197.         cMessage += "/???"
  198.     end
  199.  
  200.  
  201.     // add error description if available
  202.     if ( ValType(e:description) == "C" )
  203.         cMessage += ("  " + e:description)
  204.     end
  205.  
  206.  
  207.     // add either filename or operation
  208.     if ( !Empty(e:filename) )
  209.         cMessage += (": " + e:filename)
  210.  
  211.     elseif ( !Empty(e:operation) )
  212.         cMessage += (": " + e:operation)
  213.  
  214.     end
  215.  
  216.  
  217. return (cMessage)
  218.  
  219.