PC Toledo

Código: Selecionar todos

//Somewhere, Viktor Szakáts mentioned about "ErrorInHandler()." So I tried the following experiment:

PROC Main()
    set(_SET_HBOUTLOG,"error.log")
    ErrorInHandler() // to force an internal error
    RETURN

Código: Selecionar todos

itamar@itamar-desktop:~/fontes/exemplos$ ./error 
   
Unrecoverable error 9001: Error recovery failure                                                                                     
Called from ERRORINHANDLER(0)                   
Called from MAIN(3) in error.prg
itamar@itamar-desktop:~/fontes/exemplos$ ls *.log
error.log
itamar@itamar-desktop:~/fontes/exemplos$ cat error.log 
Application Internal Error - /home/itamar/fontes/exemplos/error
Terminated at: 2021-06-16 15:47:51
Unrecoverable error 9001: Error recovery failure
Called from ERRORINHANDLER(0)
Called from MAIN(3) in error.prg
------------------------------------------------------------------------
itamar@itamar-desktop:~/fontes/exemplos$ 

Código: Selecionar todos

*************
Function Main 
************* 
LOCAL ScreenWidth := Wvt_GetScreenWidth(), ScreenHeight := Wvt_GetScreenHeight()
wvt_Core()
wvt_Utils()
*-*-*
wvt_SetTitle('TESTE DE ERRO')
wvt_Setcodepage(255)

nHeight = Int(ScreenHeight / maxrow() * 0.85)
nWidth  = Int(ScreenWidth / maxcol() -.5)
wvt_setfont('Lucida Console', nHeight , nWidth )

@ 5,5 say "Erro vai acontecer na sequencia"
inkey(0)

// tentando abrir um arquivo que nao existe
use arquivo

@ 7,5 say "nunca chega aqui"

clear
return 

Código: Selecionar todos

/*
ERRORSYS                                                       *

...
2014.04.04.1355 - Nome do usuário JPA
2014.07.06.2130 - Ajuste ref. dos error 64 pra tentar contornar
2014.07.22.2130 - Ajuste ref. dos error 64 situações específicas
2014.08.08.1026 - Não tenta novamente em erro gravação
2014.09.24.1825 - Tenta somente se for erro 64 ref servidor
2014.10.28.0910 - Ajuste no texto
2016.06.30.1120 - Formatação do fonte
*/

#include "error.ch"
#include "hbgtinfo.ch"

// put messages to STDERR
#command ? <list,...>   =>  ?? hb_Eol() ; ?? <list>
#command ?? <list,...>  =>  OutErr(<list>)

* Note:  automatically executes at startup

PROCEDURE ERRORSYS

   ErrorBlock( { | e | JoseQuintasError( e ) } )

   RETURN

STATIC FUNCTION JoseQuintasError( e )

   LOCAL nCont, cMessage

   // by default, division by zero yields zero
   IF ( e:GenCode == EG_ZERODIV )
      RETURN 0
   ENDIF

   // build error message
   cMessage := ErrorMessage(e)
   hb_Default( @cMessage )
   IF ! Empty( e:OsCode )
      cMessage += ";(DOS Error " + Ltrim( Str( e:OsCode ) ) + ")"
   ENDIF
   IF cMessage == NIL
      cMessage := ""
   ENDIF

   // Only retry IF open error 2014.09.24.1810
   IF e:OsCode == 64 .AND. e:GenCode == EG_OPEN
      //@ 15, 15 SAY "Servidor sumiu. Tentar novamente em 2 segundos"
      Inkey(5)
      RETURN .T.
   ENDIF

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

   // for lock error during APPEND BLANK, set NetErr() and subsystem default
   IF ( e:GenCode == EG_APPENDLOCK .AND. e:CanDefault )
      NetErr( .T. )
      RETURN ( .F. )     // NOTE
   ENDIF
   Errorsys_WriteErrorLog( "SYSTEM ERROR", 1 ) // com id maquina
   @ MaxRow(), 0 SAY ""
   ? cMessage
   Errorsys_WriteErrorLog( cMessage )
   nCont := 2
   DO WHILE ( ! Empty( ProcName( nCont ) ) )
      cMessage := "Called from " + Trim( ProcName( nCont ) ) + "(" + Ltrim( Str( ProcLine( nCont ) ) ) + ")  "
      ? cMessage
      Errorsys_WriteErrorLog( cMessage )
      nCont++
   ENDDO
   Errorsys_WriteErrorLog( Replicate( "-", 80 ) )
   RUN ( "start notepad.exe hb_out.log" )
   // give up
   ErrorLevel( 1 )
   QUIT

   RETURN .F.

STATIC FUNCTION ErrorMessage( e )

   LOCAL cMessage := ""

   // start error message
   BEGIN SEQUENCE WITH __BreakBlock()
      cMessage := if( e:Severity > ES_WARNING, "Error ", "Warning " )
   ENDSEQUENCE

   // add subsystem name IF available
   IF ( ValType( e:SubSystem ) == "C" )
      cMessage += e:SubSystem
   ELSE
      cMessage += "???"
   ENDIF

   // add subsystem's error code IF available
   IF ( ValType( e:SubCode ) == "N" )
      cMessage += ( "/" + Ltrim(Str( e:SubCode ) ) )
   ELSE
      cMessage += "/???"
   ENDIF

   // add error description IF available
   IF ( ValType( e:Description ) == "C" )
      cMessage += ( "  " + e:Description )
   ENDIF

   // add either filename or operation
   IF ! Empty( e:Filename )
      cMessage += (": " + e:Filename )
   ELSEIF ! Empty( e:Operation )
      cMessage += ( ": " + e:Operation )
   ENDIF

   RETURN cMessage

FUNCTION Errorsys_WriteErrorLog( cText, nDetail )

   LOCAL hFileOutput, cFileName, nCont, nCont2

   hb_Default( @cText, "" )
   hb_Default( @nDetail, 0 )

   IF nDetail > 0
      Errorsys_WriteErrorLog()
      Errorsys_WriteErrorLog( "Error on "       + Dtoc( Date() ) + " " + Time() )
      Errorsys_WriteErrorLog( "EXE Name; " + hb_Argv(0) )
      Errorsys_WriteErrorLog( "JPA: "           + AppVersaoExe() )
      Errorsys_WriteErrorLog( "Login JPA: "     + AppUserName() )
      Errorsys_WriteErrorLog( "Alias:  "        + Alias() )
      Errorsys_WriteErrorLog( "Folder: "        + hb_cwd() )
      Errorsys_WriteErrorLog( "Windows: "       + OS() )
      Errorsys_WriteErrorLog( "Computer Name: " + GetEnv( "COMPUTERNAME" ) )
      Errorsys_WriteErrorLog( "Windows User: "  + GetEnv( "USERNAME" ) )
      Errorsys_WriteErrorLog( "Logon Server: "  + Substr( GetEnv( "LOGONSERVER" ), 2 ) )
      Errorsys_WriteErrorLog( "User Domain: "   + GetEnv( "USERDOMAIN" ) )
      Errorsys_WriteErrorLog( "Harbour: "       + Version() )
      Errorsys_WriteErrorLog( "Compiler: "      + HB_Compiler() )
      Errorsys_WriteErrorLog( "GT: "            + hb_GtInfo( HB_GTI_VERSION ) )
      Errorsys_WriteErrorLog()
      Errorsys_WriteErrorLog()
   ENDIF
   cFileName := "hb_out.log"
   IF ! File( cFileName )
      hFileOutput := fCREATE( cFileName )
      fClose( hFileOutput )
   ENDIF

   hFileOutput := fOpen( cFileName, 1 )
   fSeek( hFileOutput, 0, 2 )
   fWrite( hFileOutput, cText + Space(2) + hb_Eol() )
   IF nDetail > 1
      nCont  := 1
      nCont2 := 0
      DO WHILE nCont2 < 5
         IF Empty( ProcName( nCont ) )
            nCont2++
         ELSE
            cText := "Called from " + Trim( ProcName( nCont ) ) + "(" + Ltrim( Str( ProcLine( nCont ) ) ) + ")  "
            fWrite( hFileOutput, cText + hb_Eol() )
         ENDIF
         nCont++
      ENDDO
      fWrite( hFileOutput, hb_Eol() )
   ENDIF
   fClose( hFileOutput )

   RETURN NIL