home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 16 / CD_ASCQ_16_0994.iso / news / 4611 / fw16d.ins / SOURCE / FUNCTION / ERRSYSW.PRG < prev    next >
Text File  |  1994-06-10  |  4KB  |  161 lines
  1. /*************
  2. *   Errsysw.prg
  3. *   From Standard Clipper 5.0 error handler
  4. *    Compile:  /m/n/w
  5. */
  6.  
  7. #include "error.ch"
  8. #include "FiveWin.ch"
  9.  
  10. external _fwGenError   // Link FiveWin generic Error Objects Generator
  11.  
  12. #define NTRIM(n)        ( LTrim(Str(n)) )
  13.  
  14. /*************
  15. *    ErrorSys()
  16. *
  17. *    Note:  automatically executes at startup
  18. */
  19. proc ErrorSys()
  20.     ErrorBlock( { | e | ErrorDialog( e ) } )
  21. return
  22.  
  23.  
  24. /*************
  25. *   ErrorDialog()
  26. */
  27. static func ErrorDialog( e ) // -> logical  or quits App.
  28.  
  29.    local oDlg, oLbx
  30.    local lRet    // if lRet == nil -> default action: QUIT
  31.    local i, cMessage, aStack := {}
  32.    local oSay, hLogo := FWBitMap()
  33.    local nButtons := 1
  34.  
  35.    
  36.  
  37.    // by default, division by zero yields zero
  38.    if ( e:genCode == EG_ZERODIV )
  39.        return (0)
  40.    end
  41.  
  42.  
  43.    // for network open error, set NETERR() and subsystem default
  44.    if ( e:genCode == EG_OPEN .and. e:osCode == 32 .and. e:canDefault )
  45.  
  46.        NetErr(.t.)
  47.        return .f.       // Warning: Exiting!
  48.  
  49.    end
  50.  
  51.  
  52.    // for lock error during APPEND BLANK, set NETERR() and subsystem default
  53.    if ( e:genCode == EG_APPENDLOCK .and. e:canDefault )
  54.  
  55.        NetErr(.t.)
  56.        return .f.       // OJO SALIDA
  57.  
  58.    endif
  59.  
  60.    if e:canRetry
  61.       nButtons++
  62.    endif
  63.  
  64.    if e:canDefault
  65.       nButtons++
  66.    endif
  67.  
  68.  
  69.    // build error message
  70.    cMessage := ErrorMessage(e)
  71.  
  72.  
  73.    i := 2
  74.    while ( i < 74 )
  75.  
  76.        if !Empty(ProcName(i))
  77.           AAdd( aStack, "Called from " + Trim(ProcName(i)) + ;
  78.                         "(" + NTRIM(ProcLine(i)) + ")" )
  79.        endif
  80.  
  81.        i++
  82.    end
  83.  
  84.    DEFINE DIALOG oDlg FROM 0, 0 TO 20, 58 ;
  85.       TITLE OemToAnsi( FWVERSION + " ERROR Window" )
  86.  
  87.    @ 0, 0 SAY oSay PROMPT OemToAnsi( cMessage ) CENTERED BORDER OF oDlg
  88.  
  89.    oSay:nTop     = 10
  90.    oSay:nLeft    = 21
  91.    oSay:nBottom  = 36
  92.    oSay:nRight   = 206
  93.  
  94.    @ 3,  3 SAY "&Stack List" OF oDlg
  95.  
  96.    i = aStack[ 1 ]
  97.  
  98.    @ 4, 2 LISTBOX oLbx VAR i ITEMS aStack OF oDlg SIZE 193, 72
  99.  
  100.    oLbx:nTop  -= 5
  101.    oLbx:nLeft += 3
  102.  
  103.    @ 11, if( nButtons > 1, 3, 13 ) BUTTON "&Quit"     OF oDlg ACTION oDlg:End() ;
  104.                                            SIZE 40, 12
  105.    if e:canRetry
  106.       @ 11, if( nButtons == 2, 24, 13 ) BUTTON "&Retry"    OF oDlg ACTION ( lRet  := .t., oDlg:End() ) ;
  107.                                         SIZE 40, 12
  108.    endif
  109.  
  110.    if e:canDefault
  111.       @ 11, 24 BUTTON "&Default"  OF oDlg ACTION ( lRet  := .f., oDlg:End() ) ;
  112.                                         SIZE 40, 12
  113.    endif
  114.  
  115.    ACTIVATE DIALOG oDlg CENTERED ;
  116.       ON PAINT ( DrawBitmap( oDlg:hDC, hLogo, 34, 4 ),;
  117.                  DrawBitmap( oDlg:hDC, hLogo, 34, 420 ) )
  118.  
  119.    DeleteObject( hLogo )
  120.  
  121.    if lRet == nil .or. ( !LWRunning() .and. lRet )
  122.       SET RESOURCES TO
  123.       ErrorLevel(1)
  124.       QUIT              // OJO QUIT
  125.    endif
  126.  
  127. return lRet
  128.  
  129.  
  130. /*************
  131. *    ErrorMessage()
  132. */
  133. static func ErrorMessage(e)
  134.  
  135.     // start error message
  136.     local cMessage := if( empty( e:osCode ), ;
  137.                           if( e:severity > ES_WARNING, "Error ", "Warning " ),;
  138.                           "(DOS Error " + NTRIM(e:osCode) + ") " )
  139.  
  140.     // add subsystem name if available
  141.     cMessage += if( ValType( e:subsystem ) == "C",;
  142.                     e:subsystem()                ,;
  143.                     "???" )
  144.  
  145.     // add subsystem's error code if available
  146.     cMessage += if( ValType( e:subCode ) == "N",;
  147.                     "/" + NTRIM( e:subCode )   ,;
  148.                     "/???" )
  149.     // add error description if available
  150.     if ( ValType(e:description) == "C" )
  151.         cMessage += "  " + e:description
  152.     end
  153.  
  154.     // add either filename or operation
  155.     cMessage += if( !Empty( e:filename ),;
  156.                     ": " + e:filename   ,;
  157.                     if( !Empty( e:operation ),;
  158.                         ": " + e:operation   ,;
  159.                         "" ) )
  160. return cMessage
  161.