PC Toledo

Código: Selecionar todos

.
ErrorBlock( { |X| ErrInfo(X) } )  
.
Function ErrInfo(X)
  use ERROSYS
  appe blank
  repla ERS_LINHA with '********** Data: ' + dtoc(date())
  appe blank
  repla ERS_LINHA with 'Descricao.: ' + X:Description
  appe blank
  repla ERS_LINHA with 'Arquivo...: ' + X:Filename
  appe blank
  repla ERS_LINHA with 'Campo.....: ' + X:Operation
  quit
  return NIL

Código: Selecionar todos

/***
*
*	Errorsys.prg
*
*  Standard Clipper error handler
*
*  Copyright (c) 1990-1993, Computer Associates International, Inc.
*  All rights reserved.
*
*  Compile:  /m /n /w
*
*/

#include "error.ch"


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


// 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



	// 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



	// 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 := Alert( cMessage, aOptions )

		else
			nChoice := Alert( 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


	// 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)

Código: Selecionar todos

FUNCTION undef_error( a1, a2, a3, a4, a5 )
   ret_row = row()
   ret_col = col()
   sounderr()
   errorscr = savescreen(17,10,24,70)
   @ 17,10 clear to 24,70
   @ 17,10 to 24,70 double
   @ 17,12 say "< OCORRENCIA DE ERRO ON-LINE >"
   @ 19,12 say "ocorreu um &a3. no programa/funcao"
   @ 20,12 say "modulo &a1., no arquivo "+procfile()+" na linha "+alltrim(str(a2))
   DO CASE
      CASE "UNDEFINED IDENTIFIER" $ upper(a3)
           DO WHILE .t.
              @ 23,12 say "Insira tipo de dado de &a5. (DNCL)"
              dataset = upper(chr(inkey(0)))
              IF     dataset = "D"
                     error = ctod("  /  /  ")
                     errpic= "99/99/99"
              ELSEIF dataset = "L"
                     error = .f.
                     errpic= ""
              ELSEIF dataset = "N"
                     error = 1000000000.000000 - 1000000000.000000
                     errpic= "999999999999.999999999999"
              ELSEIF dataset = "C"
                     @ 23,12 say space(len("Insira o tipo de dado de &a5. (DNCL)"))
                     error = ctod("  /  /  ")
                     error1= 0
                     @ 23,12 say "Insira tamanho da string => " get error1 valid error1 >= 1 .and. error1 < 3000
                     READ
                     @ 23,12 say "                            "
                     error = space(error1)
                     errpic= if(error1 > 20, "@S20", "@X")
              ELSE
                     LOOP
              ENDIF
              EXIT
           ENDDO
           @ 23,12 say space(len("Insira o tipo de dado de &a5. (DNCL)"))
           @ 23,12 say "Insira o novo valor para &a5. =>" get error pict errpic
           READ
           PUBLIC &a5.
           STORE erro TO &a5.
           IF     dataset = "L"
                  errmess = "STORE "+if(error,".t.",".f.")+" TO &a5."
           ELSEIF dataset = "D"
                  errmess = "STORE ctod("+alltrim(strvalue(error))+") TO &a5."
           ELSEIF dataset = "C"
                  errmess = "STORE ["+alltrim(strvalue(error))+"] TO &a5."
           ELSE
                  errmess = "STORE "+alltrim(strvalue(error))+" TO &a5."
           ENDIF
   ENDCASE
   
FUNCTION sounderr
   tone(700,8)
   inkey(.3)
   tone(700,8)
   inkey(.3)
   tone(700,8)
   return

FUNCTION strvalue( showstring )
   DO CASE
      CASE TYPE("showstring") = "C"
           RETURN ("showstring")
      CASE TYPE("showstring") = "N"
           RETURN STR("showstring")
      CASE TYPE("showstring") = "M"
           RETURN " "
      CASE TYPE("showstring") = "D"
           RETURN DTOC("showstring")
      CASE TYPE("showstring") =
           RETURN ("showstring")
      OTHERWISE
           RETURN IIF(showstring,"Verdadeiro","Falso")
   ENDCASE