home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a012 / 1.ddi / CHAP27.EXE / CHP2705.PRG < prev    next >
Encoding:
Text File  |  1991-04-30  |  2.1 KB  |  96 lines
  1. /*
  2.    Listing 27.5. Source code for Clipper's DefError()
  3.                  function, located in ERRORSYS.PRG, reprinted
  4.                  here for reference and edited slightly for
  5.                  formatting.
  6.    Copyright (c) 1990-91 Nantucket Corporation
  7. */
  8.  
  9. #include "error.ch"
  10.  
  11. static func DefError(e)
  12. local i, cMessage, aOptions, nChoice
  13.  
  14.   // by default, division by zero yields zero
  15.   if ( e:genCode == EG_ZERODIV )
  16.     return (0)
  17.   endif
  18.  
  19.   // for network open error, set NETERR() and subsystem default
  20.   if ( e:genCode == EG_OPEN .and. e:osCode == 32 .and. e:canDefault )
  21.     NetErr(.t.)
  22.     return (.f.)                  // NOTE
  23.   endif
  24.  
  25.   // for lock error during APPEND BLANK, set NETERR() and subsystem default
  26.   if ( e:genCode == EG_APPENDLOCK .and. e:canDefault )
  27.     NetErr(.t.)
  28.     return (.f.)                  // NOTE
  29.   endif
  30.  
  31.   // build error message
  32.   cMessage := ErrorMessage(e)
  33.  
  34.   // build options array
  35.   // aOptions := {"Break", "Quit"}
  36.   aOptions := {"Quit"}
  37.  
  38.   if (e:canRetry)
  39.     AAdd(aOptions, "Retry")
  40.   endif
  41.  
  42.   if (e:canDefault)
  43.     AAdd(aOptions, "Default")
  44.   endif
  45.  
  46.   // put up alert box
  47.   nChoice := 0
  48.   do while ( nChoice == 0 )
  49.  
  50.     if ( Empty(e:osCode) )
  51.       nChoice := Alert( cMessage, aOptions )
  52.     else
  53.       nChoice := Alert( cMessage + ;
  54.               ";(DOS Error " + NTRIM(e:osCode) + ")", ;
  55.               aOptions )
  56.     endif
  57.  
  58.     if ( nChoice == NIL )
  59.       exit
  60.     endif
  61.   enddo
  62.  
  63.   if ( !Empty(nChoice) )
  64.     // do as instructed
  65.     if ( aOptions[nChoice] == "Break" )
  66.       Break(e)
  67.  
  68.     elseif ( aOptions[nChoice] == "Retry" )
  69.       return (.t.)
  70.  
  71.     elseif ( aOptions[nChoice] == "Default" )
  72.       return (.f.)
  73.     endif
  74.   endif
  75.  
  76.   // display message and traceback
  77.   if ( !Empty(e:osCode) )
  78.     cMessage += " (DOS Error " + NTRIM(e:osCode) + ") "
  79.   endif
  80.  
  81.   ? cMessage
  82.   i := 2
  83.   do while ( !Empty(ProcName(i)) )
  84.     ? "Called from", Trim(ProcName(i)) + ;
  85.       "(" + NTRIM(ProcLine(i)) + ")  "
  86.     i++
  87.   enddo
  88.  
  89.   // give up
  90.   ErrorLevel(1)
  91.   QUIT
  92.  
  93. return (.f.)
  94.  
  95. * eof
  96.