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
*
* Observa‡Æo: Return(.T.) = Retry = Repetir
* Return(.F.) = Default = PadrÆo
************************************************************/
//
#include "error.ch"
#command ? <list,...> => ?? Chr(13) + Chr(10) ; ?? <list>
#command ?? <list,...> => OutErr(<list>)
#define NTRIM(n) ( LTrim(Str(n)) )
//
/************************************************************** ErrorSys()
*
* Aten‡Æo: Automaticamente Executado na Inicializacao
****************************************************************************/
proc ErrorSys()
ErrorBlock( {|e| DefError(e)} )
return
*****************************************************************************
function DefError(e)
// qdo retorna .T. = Repetir a Operacao
// qdo retorna .F. = Pular o Erro
************************************************************* //
LOCAL i, cMessage, aOptions, nChoice, nOpc, nArea, nTent
LOCAL cAlias, nOrder, nReg
//
// Tratamento do // Erro DBCMD/2001 Workarea not in use: ORDSETFOCU e
// Tratamento do // Erro DBCMD/2001 Workarea not in use: DBGOTO
//
if e:genCode==EG_NOTABLE .and. e:Severity==ES_ERROR .and. e:subCode=2001
if e:canDefault() // se deseja pular o erro
return(.F.) // default
end
end
//
// Tratamento de PRINTER ERROR
if (e:genCode == EG_PRINT .and. e:Severity == ES_ERROR)
if ChkPrn() // se deseja tentar de novo
return(.T.) // repetir
else
return(.F.) // default
end
end
//
// Tratamento do // Erro DBFCDX/610 Bad index expression!:
if (e:genCode == EG_OPEN .and. e:subcode == 610)
Mensagem("Erro lendo arquivo " +ALIAS(),3,3)
ALERT("Antes de usar o sistema Novamente,; " +;
"Recrie os Öndices referente a este arquivo")
end
//
// by PADRAO, indice corrompido
//
if ( e:genCode == EG_CORRUPTION ) .and. e:canDefault
Mensagem("Arquivo "+ALIAS()+" com Indice CORROMPIDO. Favor Reindex -lo",5,3)
return (.f.) // pula o erro
end
//
// by PADRAO, DIFERENCA DE TAMANHO DO DADO
if ( e:genCode == EG_DATAWIDTH ) .and. e:canDefault
Mensagem("Arquivo com Problema no Tamanho de Campo",2,3)
GravaErro(e)
return (.f.) // pula o erro
end
//
// by PADRAO, DIVISAO POR ZERO RETORNA 0
//
if ( e:genCode == EG_ZERODIV )
return(0)
end
//
// Erro abrindo arquivo em rede, set NETERR() and subsystem default
// ERRO DOS 32 = Viola‡Æo de Compartilhamento
// ERRO DOS 55 = Dispositivo de Rede nÆo Existe
//
if e:genCode == EG_OPEN .and. (e:osCode == 55 .OR. e:osCode == 32)
if e:canDefault
NetErr(.t.) // Informa o Sistema Que houve um erro
return(.f.) // pula o erro
end
end
//
// ERRO DOS 03 = Path nao Encontrado
//
if e:genCode == EG_OPEN .and. (e:osCode == 03)
if e:canDefault
NetErr(.t.) // Informa o Sistema Que houve um erro
return(.f.) // pula o erro
end
end
//
// APPEND BLANK, set NETERR() and subsystem default
//
if e:genCode == EG_APPENDLOCK .and. e:canDefault
if e:canDefault
NetErr(.t.)
return(.f.) // pula o erro
end
end
//
if e:genCode == EG_READ
Mensagem("Erro lendo arquivo " +ALIAS()+ ". Tentanto Recriar os Indices")
cAlias := ALIAS()
nOrder := INDEXORD()
nReg := RECNO()
FechaDbfNtx( {cALIAS} )
AbreDbfNtx( {cALIAS}, Nil, .F. ) // Abre em modo exclusivo
REINDEX EVAL Ind("Criando Indices do Arquivo "+ cAlias )
FechaDbfNtx( {cALIAS} )
AbreDbfNtx( {cALIAS}, Nil, .T. ) // Abre em modo compartilhado
DBSELECTAREA(cAlias)
SET ORDER TO nOrder
GO nReg
Return(.T.) // repetir
end
//
if (e:genCode == EG_NOFUNC .and. e:subcode == 1001)
Return(.F.) // default
end
//
GravaErro(e)
//
return (.t.)
*************************************************************
