Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : ERS501.ZIP
Filename : ERS501.PRG

/*
* ERS501.PRG - (C) Copyright 1991 by Tim Palmquist
* Error system for Clipper 5.01
* NOT FOR USE WITH CLIPPER SUMMER '87, 5.00, OR EARLIER VERSIONS!
* Version 1.03 - May 24, 1991
*
* This complete source code file may be freely distributed to any user
* of Clipper 5.01 (or any other interested person). Distribution is NOT
* limited to CompuServe; please feel free to upload this file to your
* favorite Clipper-oriented BBS. If you make any substantive
* improvements to this system, it is my hope that you will share your
* source code with other Clipper users (preferably in the form of
* another freely-distributed error system). We all will benefit from a
* more user-friendly error interface. (Clients don't seem to be
* impressed with a paper jam or other minor error throwing them out of
* the system, for some reason!)
*
* If you have any comments, questions, or suggestions, please contact
* me by phone, mail, or CompuServe:
* Tim Palmquist
* 6005 Chandler Way
* Bakersfield CA 93307-5509
* (805) 837-8730
* CompuServe 76517,1546
*
* To use this error system with an application, just compile this file
* with options "/n /w /m", then link ERS501.OBJ in with your program.
* (Please note that it is no longer necessary to re-link BASE50.PLL, as
* was required with Clipper 5.0. However, it is possible that other
* PLL configurations which include another error system may require
* re-linking.)
*
* Along with reporting all available information about this error and
* allowing the user to decide what action to take, this system also allows
* an error-tracking mechanism to be included, if desired. All error
* information will be written to a text file, and all memory variables will
* be saved to a .MEM file. If you are a consultant (like myself), it may
* be helpful to track errors which your client has not reported. If you do
* not wish to track errors in this manner, just comment out the "#define"
* lines below for MAKE_LOG and MAKE_MEM. (Please also note that if Clipper
* cannot create the error log file, the error system will appear to operate
* in its usual manner, without actually tracking the errors.)
*
* This error system has been tested and verified as functioning properly,
* with one exception. If pending PROMPTs exist (before a MENU TO
* command has been issued) when the error occurs, the pending prompts
* are included in the error-action menu, resulting in an internal error.
* Any suggestions on ways to avoid this problem would be appreciated.
*
* Please note also that Clipper bypasses the error system for some
* severe errors. I am not aware of any way to trap these severe errors.
*
* For those who are curious, the difference between version 1.00 of this
* error system and this current version is primarily compatibility with
* Clipper 5.01. Version 1.00 was compatible with Clipper 5.0, but not
* with 5.01; this version is compatible with Clipper 5.01, but not 5.0.
* However, a few additional changes were made: The severity level is
* now reported, and special handling is provided for printer errors, along
* with zero division and network append lock errors. The system still
* makes no use of the error object's "cargo"; if you have any ideas for
* using this capability, please contact me.
*
*/


#include "error.ch"
#include "set.ch"


#define CRLF Chr(13)+Chr(10)
/* comment out below line to turn off error log-file creation */
#define MAKE_LOG 'CLIP'
/* comment out below line to turn off error mem-file creation */
#define MAKE_MEM 'CLIP'

Static nLogFile


Procedure ErrorSys()
* executes automatically when program starts
ErrorBlock( {|oError| ErrorMenu(oError)} )
Return



Static Function ErrorMenu(oEr)
/* |-Error: BASE/9999---------------------------|
* | Code 99999: DESCRIPTION______ (retry 999) |
* | Dos error 999: DESCRIPTION________________ |
* | Operation attempted: ____________ |
* | Arguments: XXXXXXXXXX & XXXXXXXXXXXXXX |
* | Filename: XXXXXXXXXXXXXXXXX |
* | Called from: XXXXXXXXXX (111) |
* | XXXXXXXXXX (XXX) |
* | XXXXXXXXXX (XXX) |
* | Press to print this screen. |
* | Then notify the developer of this error. |
* | |--------------------------------| |
* | | Retry Ignore Fail Screen Abort | |
* |_____|________________________________|_____|
* NOTE: none of the above lines will display unless there is an appropriate
* value to display. (For example, the "Filename:" line will not
* display unless this error relates to a file.)
*/
MemVar ErrScreen
Local nErrLines,nActCount,cChoices,nErrTop,nChoice,cChoice,cErrScr,nIntense,;
cDevice,cColor,bOldErr,cMsg,cErrWrnMsg
/* Note: DosErr[] is an array containing error messages corresponding to
* some of the DOS error numbers. Messages may be edited or
* changed to null strings, if desired.
*/
Local DosErr:={"Invalid function number","File not found","Path not found",;
"Too many open files","Access denied","Invalid handle","Memory",;
"Insufficient memory","Memory","Invalid environment","Invalid format",;
"Invalid access code","Invalid data","","Invalid drive",;
"Cannot remove directory","Not same device","No more files","Write-protect",;
"Unknown unit","Drive not ready","Unknown command","Data error (CRC)",;
"Bad request","Seek error","Unknown media type","Sector not found",;
"Printer out of paper","Write fault","Read fault","General failure",;
"Sharing violation","Lock violation","Invalid disk change","FCB unavailable",;
"Sharing buffer overflow","","","","","","","","","","","","","",;
"Network request not supported","Remote not listening",;
"Duplicate name on network","Network name not found","Network busy",;
"Network device no longer exists","Network BIOS command limit exceeded",;
"Network adapter hardware error","Incorrect response from network",;
"Unexpected network error","Incompatible remote adapter","Print queue full",;
"Not enough space for print file","Print file deleted","Network name deleted",;
"Access denied","Network device type incorrect","Network name not found",;
"Network name limit exceeded","Network BIOS session limit exceeded",;
"Temporarily paused","Network request not accepted",;
"Print or disk redirection paused","","","","","","","","File already exists",;
"","Cannot make directory entry","Fail on INT 24H","Too many redirections",;
"Duplicate redirection","Invalid password","Invalid parameter",;
"Network device fault"}

// by default, division by zero yields zero
If (oEr:genCode == EG_ZERODIV)
Return (0)
EndIf

//for network open error, set NetErr() and subsystem default
If ((oEr:genCode == EG_OPEN) .and. oEr:osCode == 32 .and. (oEr:canDefault))
NetErr(.T.)
Return (.F.)
EndIf

// check for lock error during APPEND BLANK
If ( oEr:genCode == EG_APPENDLOCK .and. oEr:canDefault )
NetErr(.T.)
Return (.F.)
EndIf




/* If error occurs within this error-handler, handle with DuplError */
bOldErr:=ErrorBlock( {|oError| DuplError(oError)} )

nLogFile=-1
If (oEr:genCode != EG_PRINT)
#ifdef MAKE_LOG
nErrLines:=0
Do While (File(MAKE_LOG+LTrim(Str(nErrLines))+'.ERR') .And. (nErrLines<10000))
nErrLines++
EndDo

If (nErrLines<10000)
/* Open error log file (if possible) */
nLogFile=FCreate(MAKE_LOG+LTrim(Str(nErrLines))+'.ERR')
EndIf
#endif

#ifdef MAKE_MEM
nErrLines:=0
Do While (File(MAKE_MEM+LTrim(Str(nErrLines))+'.MEM') .And. (nErrLines<10000))
nErrLines++
EndDo
If (nErrLines<10000)
Private ErrScreen
Save Screen To ErrScreen
Save To (MAKE_MEM+LTrim(Str(nErrLines))+'.MEM')
EndIf
#endif
EndIf

cChoice:=' '
Do While cChoice!='A'
/* save original color and device setting,
then set to display on screen with red background */
/* NOTE: IF YOU ARE USING THIS SYSTEM WITH A MONOCHROME MONITOR,
CHANGE THE COLOR SETTING BELOW TO A MORE APPROPRIATE COMBINATION */
cColor=SetColor('N/R+')
cDevice=Set(_SET_DEVICE)
Set Device To Screen

/* count number of activations which will need to be displayed */
#ifdef MAKE_LOG
nErrLines:=5
#else
If (oEr:genCode == EG_PRINT)
nErrLines:=5
Else
nErrLines:=6
EndIf
#endif
If (oEr:genCode != EG_PRINT)
nActCount:=2
Do While (.Not. (ProcName(nActCount)==""))
nErrLines++
nActCount++
EndDo
nErrLines+=IIf(oEr:operation=="",0,1)
If (ValType(oEr:args)=='A')
If (Len(oEr:args)>0)
nErrLines++
EndIf
EndIf
nErrLines+=IIf(oEr:filename=="",0,1)
nErrLines+=IIf(oEr:osCode!=0,1,0)
EndIf
nErrTop=IIf(nErrLines<24,(24-nErrLines)/2,0)


cErrScr=SaveScreen(nErrTop,17,nErrTop+nErrLines,62)
@ nErrTop,17 Clear To nErrTop+nErrLines,62

If (oEr:genCode == EG_PRINT)
cErrWrnMsg='Printer error'
Else
If (oEr:severity==ES_CATASTROPHIC)
cErrWrnMsg='Severe error'
ElseIf (oEr:severity==ES_ERROR)
cErrWrnMsg='Error'
ElseIf (oEr:severity==ES_WARNING)
cErrWrnMsg='Warning'
Else
cErrWrnMsg='Message'
EndIf
#ifdef MAKE_LOG
ErLogWr(CRLF+'*** '+Upper(cErrWrnMsg)+' ON '+DToC(Date())+' AT '+;
Time()+' ***'+CRLF)
#endif
EndIf
@ nErrTop,17 To nErrTop+nErrLines,62 Double
If (.Not. Empty(oEr:subSystem))
cMsg=AllTrim(oEr:subsystem)+'/'+LTrim(Str(oEr:subCode))
@ nErrTop,18 Say 'µ'+cErrWrnMsg+': '+cMsg+'Æ'
#ifdef MAKE_LOG
If (oEr:genCode != EG_PRINT)
ErLogWr(cMsg+CRLF)
EndIf
#endif
EndIf
If (oEr:genCode != EG_PRINT)
cMsg='Code '+LTrim(Str(oEr:genCode))+': '+oEr:description
@ Row()+1,19 Say PadR(cMsg,60-Col())
#ifdef MAKE_LOG
ErLogWr(cMsg)
#endif
If (oEr:tries>1)
cMsg='(retry '+LTrim(Str(oEr:tries))+')'
@ Row(),48 Say ' '+cMsg
#ifdef MAKE_LOG
ErLogWr(cMsg)
#endif
EndIf
#ifdef MAKE_LOG
ErLogWr(CRLF)
#endif
If (oEr:osCode!=0)
cMsg='Dos error '+LTrim(Str(oEr:osCode))
@ Row()+1,19 Say cMsg+': '
If ((oEr:oscode<=Len(DosErr)) .And. (oEr:oscode>0))
@ Row(),Col() Say PadR(DosErr[oEr:osCode],60-Col())
EndIf
#ifdef MAKE_LOG
ErLogWr(cMsg+CRLF)
#endif
EndIf
If (.Not. (oEr:operation==""))
cMsg='Operation attempted: '+oEr:operation
@ Row()+1,19 Say PadR(cMsg,60-Col())
#ifdef MAKE_LOG
ErLogWr(cMsg+CRLF)
#endif
EndIf
If (ValType(oEr:args)=='A')
If (Len(oEr:args)>0)
cMsg='Arguments: '+ErrDispArg(oEr:args[1])
@ Row()+1,19 Say Left(cMsg,50-Col())
#ifdef MAKE_LOG
ErLogWr(cMsg)
#endif
If (Len(oEr:args)>1)
cMsg='& '+ErrDispArg(oEr:args[2])
@ Row(),Col() Say Left(cMsg,60-Col())
#ifdef MAKE_LOG
ErLogWr(cMsg)
#endif
EndIf
#ifdef MAKE_LOG
ErLogWr(CRLF)
#endif
EndIf
EndIf
If (.Not. (oEr:filename==""))
cMsg='Filename: '+oEr:filename
@ Row()+1,19 Say PadR(cMsg,60-Col())
#ifdef MAKE_LOG
ErLogWr(cMsg+CRLF)
#endif
EndIf
@ Row()+1,19 Say 'Called from: '
nActCount:=2
Do While (.Not. (ProcName(nActCount)==""))
cMsg=ProcName(nActCount)+' ('+LTrim(Str(ProcLine(nActCount)))+')'
If (Row()<20)
@ Row(),32 Say cMsg
@ Row()+1,Col() Say ''
EndIf
#ifdef MAKE_LOG
ErLogWr(cMsg+CRLF)
#endif
nActCount++
EndDo
#ifdef MAKE_LOG
@ Row(),19 Say 'Please notify the developer of this error.'
#else
@ Row(),19 Say 'Press to print this screen.'
@ Row()+1,19 Say 'Then notify the developer of this error.'
#endif
Else
@ Row()+1,19 Say 'Please check the printer to be sure that'
@ Row()+1,19 Say 'it is turned on and ready to print.'
EndIf
@ Row()+2,19 Say ''
nIntense=Set(_SET_INTENSITY,.T.)
cChoices:=""
If (oEr:canRetry)
cChoices+="R"
@ Row(),25 Prompt 'Retry'
Else
@ Row(),25 Say 'Retry'
EndIf
If (oEr:canDefault)
cChoices+="I"
@ Row(),31 Prompt 'Ignore'
Else
@ Row(),31 Say 'Ignore'
EndIf
@ Row(),38 Prompt 'Fail'
@ Row(),43 Prompt 'Screen'
@ Row(),50 Prompt 'Abort'
cChoices+='FSA'
@ Row()-1,23 Say 'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿'
@ Row()+1,23 Say '³'
@ Row(),56 Say '³'
@ Row()+1,23 Say 'Ï'
@ Row(),56 Say 'Ï'
Menu To nChoice
Set(_SET_INTENSITY,nIntense)
Set(_SET_DEVICE,cDevice)
SetColor(cColor)
If (nChoice==0)
* ESC re-views screen.
cChoice='S'
Else
cChoice=SubStr(cChoices,nChoice,1)
EndIf
#ifdef MAKE_LOG
ErLogWr('User choice = '+cChoice+CRLF)
#endif
RestScreen(nErrTop,17,nErrTop+nErrLines,62,cErrScr)
If cChoice=='R'
#ifdef MAKE_LOG
/* close error log file */
FClose(nLogFile)
#endif
ErrorBlock(bOldErr)
Return .T.
ElseIf cChoice=='I'
#ifdef MAKE_LOG
/* close error log file */
FClose(nLogFile)
#endif
ErrorBlock(bOldErr)
Return .F.
ElseIf cChoice=='F'
#ifdef MAKE_LOG
/* close error log file */
FClose(nLogFile)
#endif
ErrorBlock(bOldErr)
Break
ElseIf cChoice=='S'
Inkey(0)
Loop
EndIf
EndDo cChoice!='A' // loop only happens if 'Screen' is selected.
#ifdef MAKE_LOG
/* close error log file */
FClose(nLogFile)
#endif

SetCursor(1) // don't leave them in DOS without a cursor!
ErrorLevel(1)
Quit
Return .F. //superfluous RETURN required to compile without warning



Static Function ErrDispArg(arg)
Local cStr
If ValType(arg)=='A'
cStr:='(Array) '
ElseIf ValType(arg)=='B'
cStr:='(Block) '
ElseIf ValType(arg)=='C'
cStr:='(C) "'+arg+'" '
ElseIf ValType(arg)=='D'
cStr:='(D) '+DToC(arg)+' '
ElseIf ValType(arg)=='L'
cStr:='(L) .'+IIf(arg,'T','F')+'. '
ElseIf ValType(arg)=='M'
cStr:='(M) "'+arg+'" '
ElseIf ValType(arg)=='N'
cStr:='(N) '+AllTrim(Str(arg))+' '
ElseIf ValType(arg)=='O'
cStr:='(Object) '
Else
cStr:='(NIL) '
EndIf
Return cStr



Static Function ErLogWr(cStr)
If (nLogFile>-1)
FWrite(nLogFile,cStr)
EndIf
Return cStr


/* Note from Tim Palmquist: Who needs an error-handler, anyway?

Unfortunately, some kind of error-handler is a necessity in any
well-structured program. It would be nice if we could count on
our programs being free from logic bugs and typos, and if we could
always depend on our hardware to operate properly. But, sooner or
later (probably sooner), a glaring error in your system will reflect
your own lack of perfection.

What you would do if your computer demanded absolute perfection
in your programs, crashing your hard disk at the first sign of an
error? That's kind of like life without God. The Bible says that
"the wages of sin is death", so if you've ever done anything wrong,
God says your penalty is death! But--don't give up yet--for God knew
that we could never attain perfection on our own, so He became one
of us. Jesus lived a perfect life, then paid YOUR wages of death
by dying for you. Then, God's spiritual power physically raised
Jesus from the dead, demonstrating that death's stranglehold on
mankind had been broken.

The good news is that God's power is available to you today, if you
only recognize your errors and accept Jesus' payment of your penalty,
inviting Him to live within you from now on. He will take away all
of your sins, and you will be able to look forward to living forever
with Him in absolute perfection. (You'll never need another
error-handler!)

Or, you could reject Jesus' free gift of life, and continue your
proliferation of errors, finally paying for your errors with your
own blood. The choice is yours.

If you would like to know more about how to let God handle your
errors, please feel free to contact me by phone, mail, or
CompuServe. Or, read the book of John in the Bible.

Have a nice life!

-tim-
*/


/* this error handler will be used only for errors which occur WITHIN *
* the ErrorMenu error handling system */
Static Function DuplError(oEr)
? "Error ("+Trim(oEr:description)+") at ",;
Trim(ProcName(2))+' ('+LTrim(Str(ProcLine(2)))+')'
ERRORLEVEL(1)
QUIT
return (.f.)