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

 
Output of file : ERRORSYS.PRG contained in archive : SNDVIS.ZIP
/***
*
* Errorsys.prg
*
* Standard Clipper error handler
*
* Copyright (c) 1990-1993, Computer Associates International, Inc.
* All rights reserved.
*
* Modified for Sound & Vision by Tom Groeger 1993
*
* Compile: /m /n /w
*
*/

#include "error.ch"


// put messages to STDERR
#command ? => ?? Chr(13) + Chr(10) ; ??
#command ?? => OutErr()


// used below
#define NTRIM(n) ( LTrim(Str(n)) )



/***
* ErrorSys()
*
* Note: automatically executes at startup
*/

proc ErrorSys()
ErrorBlock( {|e| DefError(e)} )
return




/***
* DefError()
*/
static func DefError(e)
local i, cMessage, aOptions, nChoice, nStatus



// by default, division by zero yields zero
if ( e:genCode == EG_ZERODIV )
return (0)
end


// for network open error, set NETERR() and subsystem default
if ( e:genCode == EG_OPEN .and. e:osCode == 32 .and. e:canDefault )

NetErr(.t.)
return (.f.) // NOTE

end


// for lock error during APPEND BLANK, set NETERR() and subsystem default
if ( e:genCode == EG_APPENDLOCK .and. e:canDefault )

NetErr(.t.)
return (.f.) // NOTE

end

//@New
IF ( e:genCode == EG_PRINT )

nStatus := PrtStatus( 0 )
aOptions := {'~Retry', '~Cancel' }

DO CASE
CASE IsBitSet( nStatus,5)
cMessage := 'The Printer is out of Paper;What to do ?'

CASE ! IsBitSet( nStatus, 7)
cMessage := 'The Printer is in use; Command ?'

OTHERWISE
cMessage := 'The Printer is disconnected ;or stolen'

ENDCASE

IF AlertBox( 1, cMessage, aOptions) # 1
BREAK (e)

ENDIF

SET CONSOLE OFF
SET DEVICE TO PRINT
SET PRINT ON

RETURN (.t.)

ENDIF


// build error message
cMessage := ErrorMessage(e)


// build options array
// aOptions := {"Break", "Quit"}
aOptions := {"Quit"}

if (e:canRetry)
AAdd(aOptions, "Retry")
end

if (e:canDefault)
AAdd(aOptions, "Default")
end


// put up alert box
nChoice := 0
while ( nChoice == 0 )

if ( Empty(e:osCode) )
nChoice := AlertBox(1, cMessage, aOptions )

else
nChoice := AlertBox (1, cMessage + ;
";(DOS Error " + NTRIM(e:osCode) + ")", ;
aOptions )
end


if ( nChoice == NIL )
exit
end

end


if ( !Empty(nChoice) )

// do as instructed
if ( aOptions[nChoice] == "Break" )
Break(e)

elseif ( aOptions[nChoice] == "Retry" )
return (.t.)

elseif ( aOptions[nChoice] == "Default" )
return (.f.)

end

end

// Deaktivate Mouse !!
Mse_Exit()


// display message and traceback
if ( !Empty(e:osCode) )
cMessage += " (DOS Error " + NTRIM(e:osCode) + ") "
end

? cMessage
i := 2
while ( !Empty(ProcName(i)) )
? "Called from", Trim(ProcName(i)) + ;
"(" + NTRIM(ProcLine(i)) + ") "

i++
end


// give up
ErrorLevel(1)
QUIT

return (.f.)




/***
* ErrorMessage()
*/
static func ErrorMessage(e)
local cMessage


// start error message
cMessage := if( e:severity > ES_WARNING, "Error ", "Warning " )


// add subsystem name if available
if ( ValType(e:subsystem) == "C" )
cMessage += e:subsystem()
else
cMessage += "???"
end


// add subsystem's error code if available
if ( ValType(e:subCode) == "N" )
cMessage += ("/" + NTRIM(e:subCode))
else
cMessage += "/???"
end


// add error description if available
if ( ValType(e:description) == "C" )
cMessage += (" " + e:description)
end


// add either filename or operation
if ( !Empty(e:filename) )
cMessage += (": " + e:filename)

elseif ( !Empty(e:operation) )
cMessage += (": " + e:operation)

end


return (cMessage)



  3 Responses to “Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : SNDVIS.ZIP
Filename : ERRORSYS.PRG

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/