Liren Large Software Subsidy 5/05.iso/a/a012/1.ddi/APPENDIX.EXE/ERRSAVE.PRG

Text File | 1991-05-01 | 18.3 KB | 556 lines

/*
   ERRSAVE.PRG:  Error object inspector and recorder.
   Author: Craig Yellick
   Excerpted from "Clipper 5: A Developer's Guide"
   Copyright (c) 1991 M&T Books
                      501 Galveston Drive
                      Redwood City, CA 94063-4728
                      [phone]

   Thanks to Ted Means for supplying the little Default() ditty in ASM.

   ------------------------------------------------------------------------

   To install this utility in your application the following lines must
   be executed prior to any errors that you want to trap.  This means
   they must be the first executable statements in your application if
   you want ErrorSaver() to be in effect for the entire application. The
   text filename is optional, if specified the file will be appended
   with error information.

          local defErr := errorblock()
          errorblock( { |e| ErrorSaver(e, defErr, ;
                      "<App Title>", "ERR.TXT") } )

   Compile with: /n /w /a

   ------------------------------------------------------------------------

   Note: ErrorSaver() calls Default(), a small ASM routine that returns
   the letter of the current drive volume. An object file, DEFAULT.OBJ,
   has been included. If you currently use a 3rd-party library which
   already supplies this function you can change the call to Default()
   to use the library's syntax. If you prefer not to use the function
   you can delete the reference, it's not critical.

   ------------------------------------------------------------------------

   File Contents
   =============

   ErrorSaver( objError, [bError], [cAppTitle], [cFilename] )  -->  .f.

     Target function for error blocks.  Displays screen containing
     complete error information and scrolling program trace back window.
     If optional filename is specified the error information is appended
     to file.


   static Message( nTop, nLeft, [nDepth], [nWidth], ;
                   [aStaticText], [cStaticColor],   ;
                   [aVariText], [cColorVari] )  -->  nSelection

     General-purpose message display utility.  Many possible parameter
     combinations. See source code comments for details.


   static SetScrEnv( [aNewEnv] )  -->  aOldEnv

     Saves/restores screen environment to/from an array: cursor, color,
     row, column, screen contents.


   static XtoS( xValue )  -->  cValue

     Takes parameter of any data type and returns character string
     representation.


   static DosErrText( nError )  -->  cDescription

     Returns description of DOS error code number.

   ------------------------------------------------------------------------
*/


/*
    []  A test of the error handler.

    Compile ERRSAVE.PRG to ERRSAVE.OBJ and link with CLIPPER.LIB,
    EXTEND.LIB and the supplied DEFAULT.OBJ.

    When you run ERRSAVE.EXE it will immediatly bomb with a "missing
    database" error and display the ErrorSaver screen.  A file called
    ERR.TXT will also have a copy of the error information appended to
    the end of it.

    Comment-out the "#define TESTING" line and re-compile to prevent
    function Main() and the four "nesting" functions from being
    included in the ERRSAVE.OBJ you use in your applications.
*/

#define TESTING
#ifdef TESTING

         function Main()
           local defErr := errorblock()
           errorblock( { |e| ErrorSaver(e, defErr, ;
                       "Test Application", "ERR.TXT") } )
           ? "Here we go..."
           nest1()
         return nil

         function nest1()
           nest2()
         return nil
         function nest2()
           nest3()
         return nil
         function nest3()
           nest4()
         return nil
         function nest4()
           nest5()
         return nil
         function nest5()
           use WHERIZIT
         return nil
#endif

/* --------------------------------------------------------------------- */

/*
    Handy preprocessor directives.
*/


//  Convert integers to left-trimmed strings.
#define lstr(n)  (ltrim(str(n)))

//  Convert logicals to text.
#define YN(L)    if(L, "Yes", "No ")

//  Short-hand.
#translate ifempty(<a>, <b>) => if(empty(<a>), <b>, <a>)

/* --------------------------------------------------------------------- */


function ErrorSaver(e, defError, appTitle, filename)
/*
   Display a screen containing everything known about the run-time error
   represented by the error object passed as a parameter.  If a filename
   is specified, append error information to the file.  If an application
   title is specified it will be displayed and written to the file.

   e          The error object containing run-time information.

   defError   The default error handler, required if you want
              to be able to pass the error along to Clipper's
              default error handler after inspecting it here.

   appTitle   Optional but important, this string will get displayed
              on the screen and written to the file. Put a version
              number here as well, it'll help with phone support.

   filename   Optional name of the file in which to record the error.
              If it already exists it will be appended.

*/

local errEnv, appEnv := SetScrEnv()
local varList_, trace_
local i, r, c, sel, argStr, argCnt, osDescr

  /*
     Build array with procedure/line traceback. Start from 1, since we
     don't care about being down here in ErrorSaver() or where the
     errorblock was installed.
  */
  i := 1
  trace_ := {}
  do while .not. empty(procname(i))
    aadd(trace_, procname(i) +" (" +lstr(procline(i)) +")")
        i++
  enddo

  //  Build list of arguments (if any)
  if valtype(e:args) = "A"
    argStr := ""
    aeval(e:args, { |s| argStr += (XtoS(s) +", ")} )
    argStr := left(argStr, min(len(argStr) -2, 35))
    argCnt := lstr(len(e:args))
  else
    argStr := "<none>"
    argCnt := "0"
  endif

  //  Build description of operating systen error
  if e:osCode > 0
    osDescr := lstr(e:osCode) +": " +left(DosErrText(e:osCode), 35)
  else
    osDescr := "0: n/a"
  endif

  varList_ := {"arg count         " +argCnt,              ;
               "args              " +argStr,              ;
               "canDefault        " +YN(e:canDefault),    ;
               "canRetry          " +YN(e:canRetry),      ;
               "canSubstitute     " +YN(e:canSubstitute), ;
               "description       " +e:description,       ;
               "filename          " +e:filename,          ;
               "genCode           " +lstr(e:genCode),     ;
               "operation         " +e:operation,         ;
               "osCode            " +osDescr,             ;
               "severity          " +lstr(e:severity),    ;
               "subCode           " +lstr(e:subCode),     ;
               "subSystem         " +e:subSystem,         ;
               "tries             " +lstr(e:tries),       ;
               "----------------- ",                      ;
               "Free memory   (0) " +lstr(memory(0)),     ;
               "Largest block (1) " +lstr(memory(1)),     ;
               "Run area      (2) " +lstr(memory(2))  }


  //  Display screen heading
  if valtype(appTitle) <> "C"
    appTitle := ""
  endif
  Message(1, 20,,, {padc(appTitle, 40), ;
                    padc("Run-Time Error", 40)}, "R+/B")


  //  If filename was specified, open it up and append error info.
  if valtype(filename) = "C"
    set alternate to (filename) additive
    set alternate on
    set console off
    ? replicate("=", 70)
    ?  "ErrorSaver: This run-time error logged on "
    ?? dtoc(date()) +" at " +time()
    if .not. empty(appTitle)
      ?  "Application: " +appTitle
    endif
    ?  "Operating system = " +os() +", network = "
    ?? ifempty(netname(), "<none>")
    ?  "Available diskspace = "
    ??  ltrim(transform(diskspace(), "999,999,999,999")) +" in "
    ??  default() +":\" +curdir()
    ?  "PATH    = " +ifempty(gete("PATH"),    "<none>")
    ?  "COMSPEC = " +ifempty(gete("COMSPEC"), "<none>")
    ?  "CLIPPER = " +ifempty(gete("CLIPPER"), "<none>")
    //
    //  Add other DOS environment variables you might need to know about.
    //
    ? replicate("-", 70)
    ? "Traceback: Proc (Line)   Error Information"
    ? "~~~~~~~~~~~~~~~~~~~~~~   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
    for i := 1 to max(len(trace_), len(varList_))
      if i <= len(trace_)
        ? "  " +padr(trace_[i], 20)
      else
        ? space(22)
      endif
      ?? space(3)
      if i <= len(varList_)
         ?? varList_[i]
      endif
    next i
    set console on
    set alternate off
    set alternate to
  endif


  //  Display error object instance variables
  Message(4, 2, 19, 44, varlist_, "W+/B")

  //  Instructions for viewing traceback window.
  //  (If window isn't filled, no need to display this.)
  if len(trace_) > 7
    Message(15, 47, 8, 30, {"Use page-up and", ;
                            "page-down keys to", ;
                            "scroll through the", ;
                            "traceback window.", "", ;
                            "Press ESC to continue."}, "GR+/B")
  endif

  //  If window isn't filled, no need to wait for keystroke.
  if len(trace_) <= 7
    keyboard(chr(27))
  endif

  //  Display traceback in scrolling window
  Message(4, 47, 10, 30, ;                           // Co-ordinates
         {"Traceback: Procedure (Line)"}, "W+/B", ;  // Static portion
         trace_, "W/B,B+/W")                         // Scrollable portion


  do while .t.
    sel := Message(15, 47, 8, 30, ;
                  {"Select..."}, "GR+/B", ;
                  {"Quit to DOS", ;
                   "Pass Error to Clipper", ;
                   "View Application Screen"}, "W/B,B+/W")
   do case
   case sel = 1
     exit
   case sel = 2
     if defError <> nil
       SetScrEnv(appEnv)
       return eval(defError, e)
     endif
   case sel = 3
     errEnv := SetScrEnv()
     SetScrEnv(appEnv)
     r := row()
     c := col()
     setcolor("W+*/R")
     @ 0,0 say "ERROR!"
     devpos(r,c)
     inkey(0)
     SetScrEnv(errEnv)
   endcase
  enddo

  //  Before returining, restore screen environment.
  SetScrEnv(appEnv)

return .f.

/* --------------------------------------------------------------------- */


static function Message(r1, c1, rLen, cLen, ;
                        stat_, clrStat, ;
                        vari_, clrVari)
/*
   Display static message in box with scrolling variable section.
   Returns variable selection number, or zero if no selection made.

   Important note-- the window size parameters are not the usual "four
   corners", you must specify a starting row/col and optionally a
   depth and width.  For example, (2,5,10,30) is a box 10 rows long
   and 30 columns wide starting at row 2, column 5.

   ╔═══════════════════╗
   ║ Static line(s)    ║
   ║ :                 ║
   ╟───────────────────╢
   ║ Scrolling line(s) ║
   ║ : (optional)      ║
   ║ :                 ║
   ╚═══════════════════╝

   r1, c1   Required starting row and column.

   rLen     Optional number of rows down from r1, if not specified
            will be calculated based on maxRow() and larger
            of element count in stat_ and vari_ arrays.

   cLen     Optional number of columns over from c1, if not specified
            will be calculated based on maxCol() and longest
            element within stat_ and vari_ arrays.

   stat_    Array of strings which form static part of message.

   clrStat  Option color for static part of message.

   vari_    Optional array of strings which form the scrolling part
            of the message.

   clrVari  Optional color for scrolling part of message.

*/

local i, sel := 0, maxC := 0, maxR := 0, clr := setcolor()

  //  Determine length of longest string in stat_ and vari_.
  if cLen = nil
    aeval(stat_, { |s| maxC := max(len(s), maxC) } )
    if vari_ <> nil
      aeval(vari_, { |s| maxC := max(len(s), maxC) } )
    endif
    //  Add extra columns for box lines and spacing.
    maxC := min(maxCol() -c1, maxC +3)
  else
    maxC := min(maxCol() -c1, cLen)
  endif

  //  Determine number of rows required.
  if rLen = nil
    //  Add extra rows for spacing.
    i := if(vari_ = nil, 1, len(vari_) +2)
    maxR := min(maxRow() -r1, len(stat_) +i)
  else
    maxR := min(maxRow() -r1, rLen)
  endif

  //  Clear the area and draw box lines
  setcolor(clrStat)
  @ r1, c1 clear to r1 +maxR, c1 +maxC
  @ r1, c1 to r1 +maxR, c1 +maxC double
  if vari_ <> nil
    @ r1 +len(stat_) +1, c1 say "╟" +replicate("─", maxC -1) +"╢"
  endif

  //  Display static line(s)
  for i := 1 to len(stat_)
    @ r1 +i, c1 +2 say stat_[i]
  next i

  //  If variable portion specified, display in scrolling window.
  if vari_ <> nil
    setcolor(clrVari)
    sel := achoice(r1 +len(stat_) +2, c1 +2, ;
                   r1 +maxR -1, c1 +maxC -2, vari_)
  endif

  //  Restore original colors.
  setcolor(clr)

return sel


/* --------------------------------------------------------------------- */


static function SetScrEnv(restore_)
/*
   Return array containing current cursor, color, row, column
   and screen contents.  If an array is passed, restore the
   same elements based on the array's contents.
*/

// Save current screen environment
local old := { setcursor(), ;  //  1
               setcolor(),  ;  //  2
               row(), ;        //  3
               col(), ;        //  4
               savescreen(0,0,maxrow(),maxcol()) }  //  5

  if valtype(restore_) = "A"
    setcursor(restore_[1])
    setcolor(restore_[2])
    devpos(restore_[3], restore_[4])
    restscreen(0,0,maxrow(),maxcol(), restore_[5])
  endif

return old


/* --------------------------------------------------------------------- */


static function XtoS(x)
/*
   Takes parameter of any type and returns a string version.
*/
local s
  if     valtype(x) = "C"
    s := x
  elseif valtype(x) = "N"
    s := lstr(x)
  elseif valtype(x) = "D"
    s := dtoc(x)
  elseif valtype(x) = "L"
    s := if(x, ".t.", ".f.")
  endif
return s


/* --------------------------------------------------------------------- */


static function DosErrText(n)
/*
   Return description of DOS error code.
   (Descriptions based on table D-1 in
   Clipper 5.0 Programming & Utilities Guide.)
*/
local descr_ := {"Invalid function number", ;  // 1
                 "File not found", ;  // 2
                 "Path not found", ;  // 3
                 "Too many files open (no handles left)", ;  // 4
                 "Access denied", ;  // 5
                 "Invalid handle", ;  // 6
                 "Memory control blocks destroyed (oh, my)", ; // 7
                 "Insufficient memory", ;  // 8
                 "Invalid memory block address", ;  // 9
                 "Invalid environment", ;  // 10
                 "Invalid format", ;  // 11
                 "Invalid access code", ;  // 12
                 "Invalid data", ;  // 13
                 , ;  // 14
                 "Invalid drive was specified", ;  // 15
                 "Attempt to remove the current directory", ;  // 16
                 "Not same device", ;  // 17
                 "No more files", ;  // 18
                 "Attempt to write on write-protected diskette", ;  // 19
                 "Unknown unit", ;  // 20
                 "Drive not ready", ;  // 21
                 "Unknown command", ;  // 22
                 "Data error (CRC)", ;  // 23
                 "Bad request structure length", ;  // 24
                 "Seek error", ;  // 25
                 "Unknown media type", ;  // 26
                 "Sector not found", ;  // 27
                 "Printer out of paper", ;  // 28
                 "Write fault", ;  // 29
                 "Read fault", ;  // 30
                 "General failure", ;  // 31
                 "Sharing violation", ;  // 32
                 "Lock violation", ;  // 33
                 "Invalid disk change", ;  // 34
                 "FCB unavailable", ;  // 35
                 "Sharing buffer overflow", ;  // 36
                 ,,,,,,,,,,,,, ;  // 37-49
                 "Network request not supported", ;  // 50
                 "Remote computer not listening", ;  // 51
                 "Duplicate name on network", ;  // 52
                 "Network name not found", ;  // 53
                 "Network busy", ;  // 54
                 "Network device no longer exists", ;  // 55
                 "Network BIOS command limit exceeded", ;  // 56
                 "Network adapter hardware error", ;  // 57
                 "Incorrect response from network", ;  // 58
                 "Unexpected network error", ;  // 59
                 "Incompatible remote adapter", ;  // 60
                 "Print queue full", ;  // 61
                 "Not enough space for print file", ;  // 62
                 "Print file deleted (not enough space)", ;  // 63
                 "Network name deleted", ;  // 64
                 "Access denied", ;  // 65
                 "Network device type incorrect", ;  // 66
                 "Network name not found", ;  // 67
                 "Network name limit exceeded", ;  // 68
                 "Network BIOS session limit exceeded", ;  // 69
                 "Temporarily paused", ;  // 70
                 "Network request not accepted", ;  // 71
                 "Print or disk redirection paused", ;  // 72
                 ,,,,,,, ;  // 73-79
                 "File already exists", ;  // 80
                 , ;  // 81
                 "Cannot make directory entry", ;  // 82
                 "Fail on INT 24h", ;  // 83
                 "Too many redirections", ;  // 84
                 "Duplicate redirection", ;  // 85
                 "Invalid password", ;  // 86
                 "Invalid parameter", ;  // 87
                 "Network device fault", ;  // 88
                 ;
                 "Undefined or reserved error code!" } // +1

  /*
     Check that code number is within known upper limit,
     and that a description is available for it.
  */
  if (n > (len(descr_) -1)) .or. (descr_[n] = nil)
    n := len(descr_)
  endif

return descr_[n]

* eof ErrSave.Prg