Regalo de vacaciones

Regalo de vacaciones

Postby hmpaquito » Fri Jul 29, 2011 5:16 pm

Hola,

El tratamiento de excepciones en el código es cada día más habitual; por una parte debe incluirse en las partes mas "delicadas" del fuente y también el uso de componentes OLE, con comportamientos imprevisibles, debe llevar aparejado la protección contra operaciones de "riesgo".

Clipper incluía BEGIN SEQUENCE. [x]Harboures incluyen tb. el comando TRY (Harbour en modo compatibilidad), y al menos Harbour un BEGIN SEQUENCE un poco más cómodo que en Clipper. A pesar de las mejoras en los xHrbs hay algunas cosas que se pueden hacer para automatizar (y por tanto asegurar) nuestro trabajo.

Code: Select all  Expand view

///////////////////////////
// xTry.Ch
//
//
////////////////////////////////////////


#xCommand xTRY INI     TO <oTry> =>            ;
                         ;
                         <oTry>:= TxTry():New();;
                         BEGIN SEQUENCE



#xCommand xTRY END               =>            ;
                         ;
                         END                  ;;
                         oTry:End()



// xTRY CATCH para xTRY INI y xTRY END
// Este en general no sera necesario utilizarlo pq
// normalmente se preguntara y se hara las acciones
// oportunas despues del TRY END
#xCommand xTRY CATCH             =>            ;
                         ;
                         RECOVER










#xCommand xTRY RETRY INI  TO <oTry>                ;
                         [MSGRETRY <cMsgRetry>] => ;
                         ;
          DO WHILE .T.                        ;;
             ;
             <oTry>:= TxTry():New();;
             <oTry>:cMsgRetry:= If(<.cMsgRetry.>, <cMsgRetry>, <oTry>:cMsgRetry);;
             BEGIN SEQUENCE




#xCommand xTRY RETRY END                        => ;
                         ;
                            xTRY END                             ;;
                            IF oTry:lError()                     ;;
                               IF oTry:lRetry()                  ;;
                                  LOOP                           ;;
                               END                               ;;
                            END                                  ;;
                            EXIT                                 ;;
                         ENDDO

//eof\\







 




Code: Select all  Expand view

////////////////////////////////////////
// xTry.Prg              eXtended Try
//
//
//
// NOTA:
// ===========================================================
// NO UTILIZAR esta clase y utilizar mejor los comandos
// que hay en xTry.Ch (ver ejemplos)
//
//////////////////////////////////////////////////////////////
*
*
*
*
*
//-------------------------------------------------------------------------//
CLASS TxTry

   METHOD New()
   METHOD End()

   METHOD MsgError()        // Mensaje de error 'duro'

   METHOD MsgErrorUsuario() // Mensaje error 'blando' para que lo vea el usuario;
                            // utilizado para operaciones que son mas bien de control de operacion, mas que de error inesperado

   METHOD SaveError()       // Graba error 'duro'


   METHOD lError()          INLINE (::oError != NIL)
   METHOD lRetry()

   METHOD ElaboraError      HIDDEN

   DATA oError              HIDDEN
   DATA bError              HIDDEN

   DATA cMsgRetry


ENDCLASS
*
*
//-------------------------------------------------------------------------//
METHOD New() CLASS TxTry
::bError:= ErrorBlock( { |x| ::oError:= x, Break(x) } )
RETURN Self
*
*
//-------------------------------------------------------------------------//
METHOD End() CLASS TxTry
// Ojo ! *NO* inicializar aqui sobre todo el oError pq
// se puede utilizar, al menos para ::lError(), despues del ::End(); ver
// ejemplos
ErrorBlock(::bError )
RETURN NIL
*
*
//-------------------------------------------------------------------------//
#Define PARAMETROS_DE_USUARIO ;
  x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17
METHOD MsgError(PARAMETROS_DE_USUARIO) CLASS TxTry
Local nCount:= PCount()
::ElaboraError(1, nCount, PARAMETROS_DE_USUARIO)

RETURN NIL
*
//-------------------------------------------------------------------------//
METHOD SaveError(PARAMETROS_DE_USUARIO) CLASS TxTry
Local nCount:= PCount()
::ElaboraError(2, nCount, PARAMETROS_DE_USUARIO)

RETURN NIL
*

//-------------------------------------------------------------------------//
METHOD ElaboraError(nQue, nCount, PARAMETROS_DE_USUARIO) CLASS TxTry
Local aPar:= aSize({PARAMETROS_DE_USUARIO}, nCount)
Local oError:= ::oError
*
#Define MSG_ERROR "Se produjo un error controlado !!"
#Define PAR_BASE ;
                 oError,;
                 oError:SubSystem(),;
                 oError:Description,;
                 oError:Operation,;
                 oError:SubCode,;
                 oError:FileName,;
                 oError:Args,;
                 oError:OsCode,;
                 oError:GenCode,;
                 oError:Severity,;
                 ;
                 DosError(),;
                 FError()

IF nQue == 1
   IF nCount == 0
      msginfo(MSG_ERROR, PAR_BASE)
   ELSE
      msginfo(MSG_ERROR, PAR_BASE, aPar, aDebug(aPar))
   ENDIF
ELSE
   IF nCount == 0
      GrabaError(MSG_ERROR, PAR_BASE)
   ELSE
      GrabaError(MSG_ERROR, PAR_BASE, aPar, aDebug(aPar))
   ENDIF
ENDIF
RETURN NIL
*
*
*
//-------------------------------------------------------------------------//
METHOD lRetry(cMsgRetry)
Local lRetry
*
IF cMsgRetry == NIL
   cMsgRetry:= ::cMsgRetry
ENDIF
IF cMsgRetry == NIL
   cMsgRetry:= "Se ha producido un error !!"
ENDIF
*
lRetry:= mMsgYesNo(cMsgRetry+ CRLF+"¿ Reintentar ?")
*
RETURN lRetry
*
*
//-------------------------------------------------------------------------//
METHOD MsgErrorUsuario(cMsgErrorUsuario)
Local lRetry
*
IF cMsgErrorUsuario == NIL
   cMsgErrorUsuario:= "No se ha podido realizar la operacion !!"
ENDIF
*
lRetry:= mMsgInfo(cMsgErrorUsuario)
*
RETURN lRetry
*
//eof\\
 




Code: Select all  Expand view

/////////////////////////////////////////////////////////////////
FUNCTION TestxTry()
#include "xtry.ch"
Local oTry


ALERTA("----Ejemplo 1: Operacion que SI produce un error----")
xTRY INI TO oTry

   x:= y                   // Esto provocara un error

xTRY END

IF oTry:lError()
   oTry:MsgError()
ENDIF


ALERTA("----Ejemplo 2: Operacion que NO produce un error----")
xTRY INI TO oTry

   x:= 1

xTRY END

IF oTry:lError()
   oTry:MsgError()
ENDIF



ALERTA("----Ejemplo 3: Operacion que SI da error, pero posibilidad reintento---")
xTRY RETRY INI TO oTry

   x:= y                   // Esto provocara un error

xTRY RETRY END

IF oTry:lError()
   oTry:MsgError()
ENDIF



ALERTA("----Ejemplo 4: Operacion copiado de fichero que SI produce un error----")
xTRY RETRY INI TO oTry

   COPY FILE (cOri) TO (cDes)

xTRY RETRY END

IF oTry:lError()
   oTry:SaveError()
   oTry:MsgErrorUsuario("Fichero no pudo ser copiado !")
ENDIF



ALERTA("----Ejemplo 5: Retry a 'pelo'----")
DO WHILE .T.

   xTRY INI TO oTry

      x:= y                   // Esto provocara un error

   xTRY END

   IF oTry:lError()
      IF oTry:lRetry()
         LOOP
      ENDIF
   ENDIF


   EXIT

ENDDO


Alerta("-----------------Fin tests xTry----------------")

RETURN NIL
//eof\\
 



Saludos
hmpaquito
 
Posts: 1482
Joined: Thu Oct 30, 2008 2:37 pm

Re: Regalo de vacaciones

Postby hmpaquito » Sat Jul 30, 2011 9:47 am

Dos pequeñas mejoras:

1º Posibilidad de ver el error "duro" cuando se muestra el mensaje de reintento (error "blando").
2º Un problema del BEGIN SEQUENCE o del TRY es que en varias lineas de operacion "protegidas" el procname() no informa de la linea donde se ha producido el error: hay una nueva mejora que posibilita esto.

No lo dije antes, pero la "gracia" de este "montaje" consiste en que teniendo un codigo "muy limpio" tenemos total control del error, ya sea para capturarlo ya sea para conocer su origen. Por otra parte se integra mejor en el flujo del programa ya que no se hace necesario anidar bloques de TRY END para proteger los CATCH; es decir:

Modo normal es
TRY
x:= y
CATCH
TRY
x:= z
END
END


Modo nuevo es

xTRY INI TO oTry
x:= y
xTRY END

IF oTry:lError()
XTRY INI TO oTry
x:= z
XTRY END
ENDIF


Code: Select all  Expand view


////////////////////////////////////////
// xTry.Prg              eXtended Try
//
//
//
// NOTA:
// ===========================================================
// NO UTILIZAR esta clase y utilizar mejor los comandos
// que hay en xTry.Ch (ver ejemplos)
//
//////////////////////////////////////////////////////////////
*
*
*
*
*
//-------------------------------------------------------------------------//
CLASS TxTry

   METHOD New()
   METHOD End()

   METHOD MsgError()        // Mensaje de error 'duro'

   METHOD MsgErrorUsuario() // Mensaje error 'blando' para que lo vea el usuario;
                            // utilizado para operaciones que son mas bien de control de operacion, mas que de error inesperado

   METHOD SaveError()       // Graba error 'duro'


   METHOD lError()          INLINE (::oError != NIL)
   METHOD lRetry()

   METHOD ElaboraError      HIDDEN

   DATA oError              HIDDEN
   DATA bError              HIDDEN
   DATA cProcedures         HIDDEN  // Procnames (.prg+ function+ linea) con el PUNTO EXACTO donde se produjo el error

   DATA cMsgRetry


ENDCLASS
*
*
//-------------------------------------------------------------------------//
METHOD New() CLASS TxTry
*
#Define EXTRA_BLOCK ;
     (;
      ::oError:= x,;
      ::cProcedures:= LTrim(DebugProcNames(2, "", nil, .f.));
     )
::bError:= ErrorBlock( { |x| EXTRA_BLOCK, Break(x) } )
RETURN Self
*
*
//-------------------------------------------------------------------------//
METHOD End() CLASS TxTry
// Ojo ! *NO* inicializar aqui sobre todo el oError pq
// se puede utilizar, al menos para ::lError(), despues del ::End(); ver
// ejemplos
ErrorBlock(::bError )
RETURN NIL
*
*
//-------------------------------------------------------------------------//
#Define PARAMETROS_DE_USUARIO ;
  x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17
METHOD MsgError(PARAMETROS_DE_USUARIO) CLASS TxTry
Local nCount:= PCount()
::ElaboraError(1, nCount, PARAMETROS_DE_USUARIO)

RETURN NIL
*
//-------------------------------------------------------------------------//
METHOD SaveError(PARAMETROS_DE_USUARIO) CLASS TxTry
Local nCount:= PCount()
::ElaboraError(2, nCount, PARAMETROS_DE_USUARIO)

RETURN NIL
*

//-------------------------------------------------------------------------//
METHOD ElaboraError(nQue, nCount, PARAMETROS_DE_USUARIO) CLASS TxTry
Local aPar:= aSize({PARAMETROS_DE_USUARIO}, nCount)
Local oError:= ::oError
*
#Define MSG_ERROR "Se produjo un error controlado !!"
#Define PAR_BASE ;
                 oError,;
                 oError:SubSystem(),;
                 oError:Description,;
                 oError:Operation,;
                 oError:SubCode,;
                 oError:FileName,;
                 oError:Args,;
                 oError:OsCode,;
                 oError:GenCode,;
                 oError:Severity,;
                 ;
                 DosError(),;
                 FError()

IF nQue == 1
   IF nCount == 0
      msginfo(MSG_ERROR, PAR_BASE, ::cProcedures)
   ELSE
      msginfo(MSG_ERROR, PAR_BASE, ::cProcedures, aPar, aDebug(aPar))
   ENDIF
ELSE
   IF nCount == 0
      GrabaError(MSG_ERROR, PAR_BASE, ::cProcedures)
   ELSE
      GrabaError(MSG_ERROR, PAR_BASE, ::cProcedures, aPar, aDebug(aPar))
   ENDIF
ENDIF
RETURN NIL
*
*
*
//-------------------------------------------------------------------------//
// El msg es 'blando' pq es para verlo al usuario
METHOD lRetry(cMsgRetryBlando)
Local lRetry
Local nOpcion
*
IF cMsgRetryBlando == NIL
   cMsgRetryBlando:= ::cMsgRetry
ENDIF
IF cMsgRetryBlando == NIL
   cMsgRetryBlando:= "Se ha producido un error !!"
ENDIF
*
DO WHILE .T.
      nOpcion:= Alerta(cMsgRetryBlando+ CRLF+"¨ Reintentar ?",;
                        {"Sí", "No", "+Info"})
   IF nOpcion == 3
      ::MsgError()
      LOOP
   ENDIF
   lRetry:= nOpcion != 2
   EXIT
ENDDO
*
RETURN lRetry
*
*
//-------------------------------------------------------------------------//
METHOD MsgErrorUsuario(cMsgErrorUsuario)
*
IF cMsgErrorUsuario == NIL
   cMsgErrorUsuario:= "No se ha podido realizar la operacion !!"
ENDIF
*
*
RETURN NIL
*
//eof\\
 


Se agradece comentarios.
Felices vacaciones (a los afortunados) ;-)
hmpaquito
 
Posts: 1482
Joined: Thu Oct 30, 2008 2:37 pm

Re: Regalo de vacaciones

Postby sysctrl2 » Sun Jul 31, 2011 8:35 pm

holas quise probar tu aportacion,
pero hay error en las sig. funciones.

DebugProcNames()

GrabaError(MSG_ERROR, PAR_BASE, ::cProcedures)

utilizo xhb 1.2.1.

saludos...
Cesar Cortes Cruz
SysCtrl Software
Mexico

' Sin +- FWH es mejor "
User avatar
sysctrl2
 
Posts: 955
Joined: Mon Feb 05, 2007 7:15 pm

Re: Regalo de vacaciones

Postby hmpaquito » Mon Aug 01, 2011 7:24 am

Hola sysCtrl,

Esas son dos funciones de mi libreria de funciones. Al menos la GrabaError() se debe sustituir por una funcion particular y lo que tiene que hacer es grabar en un fichero de texto un error con el mensaje de error MSG_ERROR. No adjunto las mias porque a su vez incorporan llamadas a funciones a particulares que a su vez podrian llamar a funciones particulares;
Sin testear te adjunto unas que pueden ser validas:

FUNCTION DebugProcNames(nProc)
Local cProcNames:= ""

DO WHILE !Empty(ProcNames(nProc))
cProcNames+= ProcNames(nProc)
ENDDO
RETURN cProcNames
*
*
#Define TMP_PARAM x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17
FUNCTION GrabaError(cMsg, TMP_PARAM)
Local aParam:= aSize({TMP_PARAM}, PCount()- 1)
Local nI
Local nH
nH:= FCreate("FileErr.Txt")
IF !Empty(nH)
MsgInfo("Error creando el ficherito de errores !!")
ENDIF
FWrite(nH, cMsg, Len(cMsg))
FOR nI:= 1 TO Len(aParam)
cTmp:= cGetInfo(aParam[nI])
FWrite(nH, cTmp, Len(cTmp))
NEXT
FClose(nH)
RETURN NIL

Gracias por el feed. Comentame, por favor, qué tal te funcionó.

Saludos
hmpaquito
 
Posts: 1482
Joined: Thu Oct 30, 2008 2:37 pm

Re: Regalo de vacaciones

Postby sysctrl2 » Tue Aug 02, 2011 5:22 pm

no compila siguen faltando mas funciones,
saludos...

Code: Select all  Expand view
cGetInfo(aParam[nI])
aDebug(aPar)
ProcNames(nProc)


Error: Unresolved external '_HB_FUN_ADEBUG' referenced from C:\SYSCTRL\SYSCTRL\OBJ\XTRY.OBJ
Error: Unresolved external '_HB_FUN_PROCNAMES' referenced from C:\SYSCTRL\SYSCTRL\OBJ\XTRY.OBJ
Error: Unresolved external '_HB_FUN_CGETINFO' referenced from C:\SYSCTRL\SYSCTRL\OBJ\XTRY.OBJ


saludos..
Cesar Cortes Cruz
SysCtrl Software
Mexico

' Sin +- FWH es mejor "
User avatar
sysctrl2
 
Posts: 955
Joined: Mon Feb 05, 2007 7:15 pm

Re: Regalo de vacaciones

Postby hmpaquito » Wed Aug 03, 2011 7:37 am

sysctrl2,

ProcNames es un error ortográfico: debe ser ProcName

Con respecto a las otras, las detallo:
Code: Select all  Expand view

*
//-------------------------------------------------------------------------//
FUNCTION aDebug(a)
Local nI, c:= ""
IF a == NIL
   c:= "ES_NIL"
ELSE
   FOR nI:= 1 TO Len(a)
      c+= "["+ LTrim(Str(nI))+ "]"+ ValType(a[nI])+ ". "+;
           cGetInfo(a[nI])
      IF nI != Len(a)
         c+= Space(1)
      ENDIF
   NEXT
ENDIF
RETURN c


//----------------------------------------------------------------------------//
function cGetInfo( uVal, lExtendido )

   local cType := ValType( uVal )

   IF lExtendido == NIL
      lExtendido:= .F.
   ENDIF

   do case
      CASE uVal == NIL
         RETURN "NIL"

      case cType == "C"
           return 'Len: '+ LTrim(Str(Len(uVal)))+ Space(1)+;
                  '"' + cValToChar( uVal ) + '"'

      case cType == "O"
           return "Class: " + uVal:ClassName()

      case cType == "A"
           return "Array[" + Str( Len( uVal ), 4 )+ "]"+;
                  If(lExtendido, " "+ aDebug(uVal), "")

      otherwise
           return cValToChar( uVal )
   endcase

return nil

function cValToChar( uVal )

   local cType := ValType( uVal )
   Local xTmp, cRet, oError, bSaveHandler


   do case
      case cType == "C" .or. cType == "M"
           IF Len(uVal) > 100 .AND. "" $ uVal
              uVal:= "~SaveScreen()"
           ENDIF
           return uVal

      case cType == "D"
           return DToC( uVal )

      case cType == "L"
           return If( uVal, ".t.", ".f." )

      case cType == "N"
           return AllTrim( Str( uVal ) )

      case cType == "B"

           cRet:= NIL

           bSaveHandler := errorblock( { |x| break(x) } )

           BEGIN SEQUENCE
              xTmp:= Eval(uVal)
              cRet:= cValToChar(xTmp)

           END

           // Restore the default error handler
           errorblock( bSaveHandler )


           cRet:= "{|| ... }"+ If(cRet == NIL, "(imposible evaluar)", "="+ cRet+ "///")

           RETURN cRet

      case cType == "A"
           return "{ ... }"

      case cType == "O"
           RETURN "Object"+ ":"+ uVal:ClassName()

      otherwise
           return ""
   endcase

return nil

 



Saludos
hmpaquito
 
Posts: 1482
Joined: Thu Oct 30, 2008 2:37 pm

Re: Regalo de vacaciones

Postby ruben Dario » Wed Aug 17, 2011 11:05 pm

Uso Esta Sintaxis pero no me genera el numero error y se bloquea.
xTRY RETRY INI TO oTry

Codigo Uso Ado
xTRY RETRY END

IF oTry:lError()
oTry:SaveError()
oTry:MsgErrorUsuario("Fichero no pudo ser copiado !")
ENDIF


Con esta sintaxis no se bloquea. pero no me muestra la linea del error

xTRY INI TO oTry

Codigo uso Ado
xTRY END

IF oTry:lError()
oTry:MsgError()
ENDIF
Ruben Dario Gonzalez
Cali-Colombia
rubendariogd@hotmail.com - rubendariogd@gmail.com
User avatar
ruben Dario
 
Posts: 1061
Joined: Thu Sep 27, 2007 3:47 pm
Location: Colombia


Return to FiveWin para Harbour/xHarbour

Who is online

Users browsing this forum: No registered users and 9 guests