Erro interno

[cjp]

Colegas,

Depois de meses, estou ressuscitando este tópico porque finalmente descobri a causa deste erro: ele ocorre quando o .DBF que se está tentando abrir tem campo memo e o arquivo .DBT correspondente não existe ou está com defeito.

Pergunto em primeiro lugar: isso não é bug do Harbour? Ele não deria informar a inexistência ou o defeito do arquivo .DBT?

Pergunto também: tem como verificar previamente algum defeito no arquivo .DBT, para evitar o erro? Eu já verifico a eventual inexistência do arquivo, mas o defeito eu não sei como verificar.

[cjp]

Fico a me perguntar por que ele não chama o errorsys neste caso. Alguém sabe me dar uma luz?

[Jairo Maia]

Olá Inácio,

Creio que chama, porém, ao tratar esse erro deve estar havendo estouro de recursividade, isto é: seu errorsys.prg provoca algum erro ao tentar tratar esse, e ao ocorrer isso 10 vezes, na décima o sistema é abortado.

Outro problema que também pode ocorrer, é você estar retornando .T. em seu errorsys ao detectar esse erro especifico, e ocorre a mesma coisa visto que ele se repete.

Para saber exatamente qual é o erro, remova o errorsys.prg personalizado da compilação, assim, será compilado o errorsys.prg original do harbour, e você poderá saber o que está ocorrendo.

[cjp]

De fato vc tem razão, Jairo. Tirando o meu errorsys.prg, parou de dar esse problema.

Mas o fato é que eu preciso do meu errorsys. E não achei nele o defeito que poderia ter.

Por favor, dê uma olhada no meu errorsys:

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 ?    =>  ?? 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 cScreen
local i, cMessage, aOptions, nChoice
     LOCAL nCount
        RDDSETDEFAULT("DBFNTX")
 
   // 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 := 1
   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
     cScreen := Savescreen()
     nCols := MaxCol()
     nRows := MaxRow()
     nStart      := 1


   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

*   LogError( oError )

   
******* minha fun■Êo ******

*cls
*catch oErr
*?oErr:Subcode
*wait ""
 /* Tratativa de erro fpt
 *********************************************************************
 ?e:osCode
 ?type(e:osCode)
* ?ntrim(e:osCode)
* ?type(ntrim(e:osCode))
 wait ""
* if ( Empty(e:osCode) ) .And. !Empty( e:filename )
  If "1010"$e:osCode //( NTRIM(e:osCode) == "1010" ) .And. ( ".FPT" $ Upper(e:filename) )
   cBuffer := If( File( "Registro.ERR" ), MemoRead( "Registro.ERR" ), "" )
   cBuffer += "Erro no Registro: " + NTRIM(Recn()) + Chr(13)+Chr(10)
   MemoWrit( "Registro.ERR", NTRIM(Recn()) )
   Return .t.
  Endi
* Endi
 *********************************************************************

*/

 
 if "CRIAÇÃO"$upper(cmessage) .or. "CREATE"$upper(cmessage) .or. "CORRUPTION"$upper(cmessage) .or. "OPEN ERROR"$upper(cmessage) .or. "ABERTURA"$upper(cmessage)
    if us="I"
	   cls
	   @ 5,1 say "Ver erro de abertura/criação (ERRORS2 163): "
	   @ 7,1 say cmessage
	   if vzerr<2
	      tone(261.7,33)
	   endif
	   wait ""
	   wait ""
	endif
       cls
	   vzerr++
	   if usebase("\tarefas\numeros")=.t.
	      if rlbs()=.t.
	         repl errocreate with vzerr
		  endif
	   endif
	   use
       if (e:canRetry)
	      if vzerr=2 .or. int(vzerr/11)=vzerr/11
	         mandmail1("","Retornou .t. no canRetry: "+cmessage+"; vzerr: "+alltrim(str(vzerr)))
		  endif	 
		  if vzerr<50
	         if usebase("\tarefas\numeros")=.t.
			    if rlbs()
	               repl errocreate with 0
				endif
	         endif
			 use
			 wait ""
             return (.t.)
		  endif
	   else
          mandmail1("","Retornou falso no canRetry: "+cmessage)	   
	   endif	  
 Endif
 
 
 if "LEITURA"$upper(cmessage)
	@ maxrow()-2,1 clear to maxrow()-1,maxcol()-1
	@ maxrow()-1,1 say "Há um erro de leitura; aguarde tentativa de solução"
	if us="I"
	   @ 7,1 say cmessage
	   if vzerr<2
	      tone(261.7,33)
	   endif
	   wait ""
	   wait ""
	endif
	   vzerr++
	   if usebase("\tarefas\numeros")=.t.
	      if rlbs()=.t.
	         repl errocreate with vzerr
		  endif
	   endif
	   use
       if (e:canRetry)
	      if vzerr=5 .or. int(vzerr/19)=vzerr/19
	         mandmail1("","Retornou .t. no canRetry: "+cmessage+"; vzerr: "+alltrim(str(vzerr)))
		  endif	 
		  if vzerr<40
	         if usebase("\tarefas\numeros")=.t.
			    if rlbs()=.t.
	               repl errocreate with 0
				endif
	         endif
			 use
			 inkey(30)
			 wait ""
             return (.t.)
		  endif
		  if vzerr>30 .and. "CONSULTA"$upper(cmessage)
		     erase consulta.dbf
		  endif
	   else
          mandmail1("","Retornou falso no canRetry: "+cmessage)	   
	   endif	  
 Endif
 

 

*          FWriteLine( nHandle, Padr( Procname( nCount ), 21 ) + ' : ' + Transform( Procline( nCount ), "999,999" ) + " in Module: " + ProcFile( nCount ) )
*       FWriteLine( nHandle, 'Application name...: ' + hb_cmdargargv() )
*        FWriteLine( nHandle, 'Workstation name...: ' + netname() )
 

   /*
     Cria o log do erro e grava no arquivo error.Log
     Nota: A funΒo Hb_Eol(), coloca o 'End Off Line'
   */

   cMessage := "Ocorreu o erro: " + ansi(cMessage) + Hb_Eol()
   cMessage += "Data..........: "+dtoc(date())+ Hb_Eol()
   cMessage += "Hora..........: "+time() + Hb_Eol()
   cMessage += "Máquina....: "+netname() + hb_eol()
   cMessage += "Programa......: " + Hb_CmdArgArgV() + Hb_Eol() //+ hb_eol()
   cMessage += ansi("Versão........: ") + vers + Hb_Eol() + Hb_Eol()
   cMessage += ansi("Na função.....: ") + ProcName(2) + Hb_Eol() //+ hb_eol()
   cMessage += "Na linha......: " + NTRIM(ProcLine(2)) + Hb_Eol() //+ hb_eol()
   cMessage += "No prg........: " + procfile(2) + Hb_Eol() + hb_eol()
   cMessage += "Pasta.........: " + CurDir() + Hb_Eol()
   cMessage += ansi("Usuário.......: ") + us + Hb_Eol()
   cMessage += "Base em uso...: " + Alias() + Hb_Eol()
   cMessage += ansi("Área em uso...: ") + alltrim(str(select())) + Hb_Eol()
*   cMessage += ansi("Área 1........: ") + alias(1) + Hb_Eol()
   cMessage += if(!empty(alias(2)),ansi("Área 2........: ") + alias(2) + Hb_Eol(),"")
   cMessage += if(!empty(alias(3)),ansi("Área 3........: ") + alias(3) + Hb_Eol(),"")
   cMessage += if(!empty(alias(4)),ansi("Área 4........: ") + alias(4) + Hb_Eol(),"")
   cMessage += if(!empty(alias(5)),ansi("Área 5........: ") + alias(5) + Hb_Eol(),"")
   cMessage += if(!empty(alias(6)),ansi("Área 6........: ") + alias(6) + Hb_Eol(),"")
   cMessage += if(!empty(alias(7)),ansi("Área 7........: ") + alias(7) + Hb_Eol(),"")
   cMessage += if(!empty(alias(8)),ansi("Área 8........: ") + alias(8) + Hb_Eol(),"")
   cMessage += if(!empty(alias(9)),ansi("Área 9........: ") + alias(9) + Hb_Eol(),"")

   cMessage += Hb_Eol()
   cMessage += "Caminho Percorrido Antes do Erro:"  + Hb_Eol()
 *  cMessage += Hb_Eol()

   i := 2
   While ( !Empty( ProcName(i) )) //.and. procname(i)#"MAIN" )
         cMessage += "Vindo de......: " + Trim(ProcName(i)) + "(" + NTRIM(ProcLine(i)) + " - " + procfile(i) + ")" + Hb_Eol() + hb_eol()
         i++
   EndDo
   
   cMessage += Hb_Eol()+"Memória disponível para valores caracteres: "+alltrim(str(memory(0)))
   cMessage += Hb_eol()+"Maior bloco disponível para valores caracteres: "+alltrim(str(memory(1)))
   cMessage += Hb_eol()+"Área disponível para comandos RUN: "+alltrim(str(memory(2)))

   cMessage += Hb_Eol()
   cMessage += Hb_Eol()
*   cMessage += Hb_Eol()
*   cMessage += Hb_Eol()

		   cMessage += "Vídeo Screen Dump:" + Hb_Eol() 
           cMessage += Replicate( '-', nCols -15 ) + Hb_Eol()
           nCellSize := len( Savescreen( 0, 0, 0, 0 ) )
           nRange := ( nCols + 1 ) * nCellSize
           For nCount := 1 To nRows + 1
               cOutString := ''
               cSubString := Substr( cScreen, nStart, nRange )
               For nForLoop := 1 To nRange step nCellSize
                   cOutString += Substr( cSubString, nForLoop, 1 )
               Next
			   cMessage += "|" + cOutString + "|" + Hb_Eol()
               nStart += nRange
           Next
           cMessage += Replicate( '-', nCols -18 ) + Hb_Eol()
   Use
   Ferase( "error.log")
   MemoWrit( "error.log", cMessage )

if at("TAR2P",upper(hb_progname()))=0  .and. at("CRIANCAS",upper(hb_progname()))=0
   close all
   Alert( "Ocorreu um erro no programa, que será informado automaticamente ao Dr. Inacio. O programa será reiniciado na versão anterior. Você pode prosseguir usando o programa normalmente.") // Código do erro (para uso do Dr. Inacio): "+procname(2)+"("+alltrim(str(procline(2)))+"); "+procname(3)+"("+alltrim(str(procline(3)))+"); "+procname(4)+"("+alltrim(str(procline(4)))+"); "+procname(5)+"("+alltrim(str(procline(5)))+"); "+vers+"; "+substr(cmessage,1,55)+".")
endif

* ferase( "error.log")


   ?"Aguarde"
if us#"I" .and. us#"Evelyn" .and. usebase("\tarefas\numeros")=.t.
   if dtmander<date() .or. (dtmander=date() .and. scmander<seconds()-300)
      mander()
	  if usebase("\tarefas\numeros")=.t.
		 if rlbs()=.t.
		    repl dtmander with date()
		    repl scmander with seconds()
		 endif
	  endif
   endif
   use
else
   mander()
endif

if ( "X/1012" $ cMessage )
   inicio=at("corrompido",cMessage)+12
   arqv=substr(cMessage,inicio,at(".dbf",cMessage)-inicio)+".dbf"
if us="I"
cls
?"Ver erro de índice corrompido no arquivo "+arqv   
?inicio
?arqv
tone(261.7,333)
endif
   i := 2
   while ( !Empty(ProcName(i)) )
      cMessage += Hb_Eol()      
      cMessage += "Called from" + Trim(ProcName(i)) + "(" + NTRIM(ProcLine(i)) + ")  " + Hb_Eol()
      i++
   end
   use
   __run("del " + arqv)
   if file("pega.bat")
      __run("pega " + ftps + " " + usftp + " " + snhftp + " " + ptftp+"copypen/tarefas . "+arqv)
mandmail1("pega.log","Conferir se pegou arquivo "+arqv)   
   else
      __run("recebe " + ftps + " " + usftp + " " + snhftp + " " + ptftp+"copypen/tarefas . " + arqv )
mandmail1("recebe.log","Conferir se recebeu arquivo "+arqv)   
   endif
   RETURN .T.
ENDIF


**********

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

STATIC FUNCTION LogError( oerr )

     LOCAL cScreen
     LOCAL aLogFile    := SET( _SET_ERRORLOG )
     LOCAL cLogFile    := aLogFile[1]  // error log file name
     LOCAL lAppendLog  := aLogFile[2]  // .f. = create a new error log (default) .t. = append to a existing one.
     LOCAL nStart      := 1
     LOCAL nCellSize
     LOCAL nRange
     LOCAL nCols
     LOCAL nRows

     LOCAL nCount

     LOCAL nForLoop
     LOCAL cOutString
     LOCAL cSubString

     LOCAL nHandle
     LOCAL nBytes

     LOCAL nHandle2   := -1
     LOCAL cLogFile2  := "_error.log"
     LOCAL cBuff      := ""
     LOCAL nRead      := 0


     nCols := MaxCol()
     IF nCols > 0
        nRows := MaxRow()
        cScreen := Savescreen()
     ENDIF
     //Alert( 'An error occured, Information will be ;written to error.log' )

     If !lAppendLog
        nHandle := FCreate( cLogFile, FC_NORMAL )
     Else
        If !File( cLogFile )
           nHandle := FCreate( cLogFile, FC_NORMAL )
        Else
           nHandle  := FCreate( cLogFile2, FC_NORMAL )
           nHandle2 := FOpen( cLogFile, FO_READ )
        Endif
     Endif


     If nHandle < 3 .and. lower( cLogFile ) != 'error.log'
        // Force creating error.log in case supplied log file cannot
        // be created for any reason
        cLogFile := 'error.log'
        nHandle := Fcreate( cLogFile, FC_NORMAL )
     Endif

     If nHandle < 3
     Else

        FWriteLine( nHandle, Padc( ' xHarbour Error Log ' , 79, '-' ) )
        FWriteLine( nHandle, '' )

        FWriteLine( nHandle, 'Date...............: ' + dtoc( date() )  )
        FWriteLine( nHandle, 'Time...............: ' + time()          )

        FWriteLine( nHandle, '' )
        FWriteLine( nHandle, 'Application name...: ' + hb_cmdargargv() )
        FWriteLine( nHandle, 'Workstation name...: ' + netname() )
        FWriteLine( nHandle, 'Available memory...: ' + strvalue( Memory(0) )  )
        FWriteLine( nHandle, 'Current disk.......: ' + diskname() )
        FWriteLine( nHandle, 'Current directory..: ' + curdir() )
        FWriteLine( nHandle, 'Free disk space....: ' + strvalue( DiskSpace() ) )
        FWriteLine( nHandle, '' )
        FWriteLine( nHandle, 'Operating system...: ' + os() )
*        FWriteLine( nHandle, 'xHarbour version...: ' + version() )
*        FWriteLine( nHandle, 'xHarbour built on..: ' + hb_builddate() )
*        FWriteLine( nHandle, 'C/C++ compiler.....: ' + hb_compiler() )

*        FWriteLine( nHandle, 'Multi Threading....: ' + If( Hb_MultiThread(),"YES","NO" ) )
*        FWriteLine( nHandle, 'VM Optimization....: ' + strvalue( Hb_VmMode() ) )

*        IF Type( "Select()" ) == "UI"
*        FWriteLine( nHandle, '' )
*        FWriteLine( nHandle, 'Current Area ......:' + strvalue( &("Select()") ) )
*        ENDIF

*        FWriteLine( nHandle, '' )
*        FWriteLine( nHandle, Padc( ' Environmental Information ', 79, '-' ) )
*        FWriteLine( nHandle, '' )

*        FWriteLine( nHandle, "SET ALTERNATE......: " + strvalue( Set( _SET_ALTERNATE  ), .T. ) )
*        FWriteLine( nHandle, "SET ALTFILE........: " + strvalue( Set( _SET_ALTFILE  )      ) )
*        FWriteLine( nHandle, "SET AUTOPEN........: " + strvalue( Set( _SET_AUTOPEN  ), .T. ) )
*        FWriteLine( nHandle, "SET AUTORDER.......: " + strvalue( Set( _SET_AUTORDER )      ) )
*        FWriteLine( nHandle, "SET AUTOSHARE......: " + strvalue( Set( _SET_AUTOSHARE )      ) )

*        FWriteLine( nHandle, "SET BACKGROUNDTASKS: " + strvalue( Set( _SET_BACKGROUNDTASKS ), .T. ) )
*        FWriteLine( nHandle, "SET BACKGROUNDTICK.: " + strvalue( Set( _SET_BACKGROUNDTICK ), .T. ) )
*        FWriteLine( nHandle, "SET BELL...........: " + strvalue( Set( _SET_BELL  ), .T. ) )
*        FWriteLine( nHandle, "SET BLINK..........: " + strvalue( SetBlink()      ) )

*        FWriteLine( nHandle, "SET CANCEL.........: " + strvalue( Set( _SET_CANCEL  ), .T. ) )
*        FWriteLine( nHandle, "SET CENTURY........: " + strvalue( __SetCentury(), .T. ) )
*        FWriteLine( nHandle, "SET COLOR..........: " + strvalue( Set( _SET_COLOR  )      ) )
*        FWriteLine( nHandle, "SET CONFIRM........: " + strvalue( Set( _SET_CONFIRM  ), .T. ) )
*        FWriteLine( nHandle, "SET CONSOLE........: " + strvalue( Set( _SET_CONSOLE  ), .T. ) )
*        FWriteLine( nHandle, "SET COUNT..........: " + strvalue( Set( _SET_COUNT  )      ) )
*        FWriteLine( nHandle, "SET CURSOR.........: " + strvalue( Set( _SET_CURSOR  )      ) )

*        FWriteLine( nHandle, "SET DATE FORMAT....: " + strvalue( Set( _SET_DATEFORMAT )      ) )
*        FWriteLine( nHandle, "SET DBFLOCKSCHEME..: " + strvalue( Set( _SET_DBFLOCKSCHEME )      ) )
*        FWriteLine( nHandle, "SET DEBUG..........: " + strvalue( Set( _SET_DEBUG ), .T. ) )
*        FWriteLine( nHandle, "SET DECIMALS.......: " + strvalue( Set( _SET_DECIMALS )      ) )
*        FWriteLine( nHandle, "SET DEFAULT........: " + strvalue( Set( _SET_DEFAULT )      ) )
*        FWriteLine( nHandle, "SET DEFEXTENSIONS..: " + strvalue( Set( _SET_DEFEXTENSIONS ), .T. ) )
*        FWriteLine( nHandle, "SET DELETED........: " + strvalue( Set( _SET_DELETED ), .T. ) )
*        FWriteLine( nHandle, "SET DELIMCHARS.....: " + strvalue( Set( _SET_DELIMCHARS )      ) )
*        FWriteLine( nHandle, "SET DELIMETERS.....: " + strvalue( Set( _SET_DELIMITERS ), .T. ) )
*        FWriteLine( nHandle, "SET DEVICE.........: " + strvalue( Set( _SET_DEVICE )      ) )
*        FWriteLine( nHandle, "SET DIRCASE........: " + strvalue( Set( _SET_DIRCASE )      ) )
*        FWriteLine( nHandle, "SET DIRSEPARATOR...: " + strvalue( Set( _SET_DIRSEPARATOR )      ) )

*        FWriteLine( nHandle, "SET EOL............: " + strvalue( Asc( Set( _SET_EOL ) ) )  )
*        FWriteLine( nHandle, "SET EPOCH..........: " + strvalue( Set( _SET_EPOCH )      ) )
*        FWriteLine( nHandle, "SET ERRORLOG.......: " + if(!Empty(aLogFile), strvalue( aLogFile[1] )+","+strvalue( aLogFile[2] ), "") )
*        FWriteLine( nHandle, "SET ERRORLOOP......: " + strvalue( Set( _SET_ERRORLOOP )      ) )
*        FWriteLine( nHandle, "SET ESCAPE.........: " + strvalue( Set( _SET_ESCAPE ), .T. ) )
*        FWriteLine( nHandle, "SET EVENTMASK......: " + strvalue( Set( _SET_EVENTMASK )      ) )
*        FWriteLine( nHandle, "SET EXACT..........: " + strvalue( Set( _SET_EXACT ), .T. ) )
*        FWriteLine( nHandle, "SET EXCLUSIVE......: " + strvalue( Set( _SET_EXCLUSIVE ), .T. ) )
*        FWriteLine( nHandle, "SET EXIT...........: " + strvalue( Set( _SET_EXIT ), .T. ) )
*        FWriteLine( nHandle, "SET EXTRA..........: " + strvalue( Set( _SET_EXTRA ), .T. ) )
*        FWriteLine( nHandle, "SET EXTRAFILE......: " + strvalue( Set( _SET_EXTRAFILE )      ) )

*        FWriteLine( nHandle, "SET FILECASE.......: " + strvalue( Set( _SET_FILECASE )      ) )
*        FWriteLine( nHandle, "SET FIXED..........: " + strvalue( Set( _SET_FIXED ), .T. ) )
*        FWriteLine( nHandle, "SET FORCEOPT.......: " + strvalue( Set( _SET_FORCEOPT ), .T. ) )

*        FWriteLine( nHandle, "SET HARDCOMMIT.....: " + strvalue( Set( _SET_HARDCOMMIT ), .T. ) )

*        FWriteLine( nHandle, "SET IDLEREPEAT.....: " + strvalue( Set( _SET_IDLEREPEAT ), .T. ) )
*        FWriteLine( nHandle, "SET INSERT.........: " + strvalue( Set( _SET_INSERT ), .T. ) )
*        FWriteLine( nHandle, "SET INTENSITY......: " + strvalue( Set( _SET_INTENSITY ), .T. ) )

*        FWriteLine( nHandle, "SET LANGUAGE.......: " + strvalue( Set( _SET_LANGUAGE )      ) )

*        FWriteLine( nHandle, "SET MARGIN.........: " + strvalue( Set( _SET_MARGIN )      ) )
*        FWriteLine( nHandle, "SET MBLOCKSIZE.....: " + strvalue( Set( _SET_MBLOCKSIZE )      ) )
*        FWriteLine( nHandle, "SET MCENTER........: " + strvalue( Set( _SET_MCENTER ), .T. ) )
*        FWriteLine( nHandle, "SET MESSAGE........: " + strvalue( Set( _SET_MESSAGE )      ) )
*        FWriteLine( nHandle, "SET MFILEEXT.......: " + strvalue( Set( _SET_MFILEEXT )      ) )

*        FWriteLine( nHandle, "SET OPTIMIZE.......: " + strvalue( Set( _SET_OPTIMIZE ), .T. ) )
*        FWriteLine( nHandle, "SET OUTPUTSAFETY...: " + strvalue( Set( _SET_OUTPUTSAFETY ), .T. ) )

*        FWriteLine( nHandle, "SET PATH...........: " + strvalue( Set( _SET_PATH )      ) )
*        FWriteLine( nHandle, "SET PRINTER........: " + strvalue( Set( _SET_PRINTER ), .T. ) )
*        FWriteLine( nHandle, "SET PRINTERJOB.....: " + strvalue( Set( _SET_PRINTERJOB )      ) )
*        FWriteLine( nHandle, "SET PRINTFILE......: " + strvalue( Set( _SET_PRINTFILE )      ) )

*        FWriteLine( nHandle, "SET SCOREBOARD.....: " + strvalue( Set( _SET_SCOREBOARD ), .T. ) )
*        FWriteLine( nHandle, "SET SCROLLBREAK....: " + strvalue( Set( _SET_SCROLLBREAK ), .T. ) )
*        FWriteLine( nHandle, "SET SOFTSEEK.......: " + strvalue( Set( _SET_SOFTSEEK ), .T. ) )
*        FWriteLine( nHandle, "SET STRICTREAD.....: " + strvalue( Set( _SET_STRICTREAD ), .T. ) )

*        FWriteLine( nHandle, "SET TRACE..........: " + strvalue( Set( _SET_TRACE ), .T. ) )
*        FWriteLine( nHandle, "SET TRACEFILE......: " + strvalue( Set( _SET_TRACEFILE )      ) )
*        FWriteLine( nHandle, "SET TRACESTACK.....: " + strvalue( Set( _SET_TRACESTACK )      ) )
*        FWriteLine( nHandle, "SET TRIMFILENAME...: " + strvalue( Set( _SET_TRIMFILENAME )      ) )

*        FWriteLine( nHandle, "SET TYPEAHEAD......: " + strvalue( Set( _SET_TYPEAHEAD )      ) )

*        FWriteLine( nHandle, "SET UNIQUE.........: " + strvalue( Set( _SET_UNIQUE ), .T. ) )

*        FWriteLine( nHandle, "SET VIDEOMODE......: " + strvalue( Set( _SET_VIDEOMODE )      ) )

*        FWriteLine( nHandle, "SET WRAP...........: " + strvalue( Set( _SET_WRAP ), .T. ) )


        FWriteLine( nHandle, "" )

        IF nCols > 0
            FWriteLine( nHandle, Padc( 'Detailed Work Area Items', nCols, '-' ) )
        ELSE
            FWriteLine( nHandle, 'Detailed Work Area Items ' )
        ENDIF
        FWriteLine( nHandle, "" )

        IF Type( "Select()" ) == "UI"
           For nCount := 1 To 600
              If !Empty( ( nCount )->( &("Alias()") ) )
                 ( nCount )->( FWriteLine( nHandle, "Work Area No ......: " + strvalue( &("Select()") ) ) )
                 ( nCount )->( FWriteLine( nHandle, "Alias .............: " + &("Alias()") ) )
                 ( nCount )->( FWriteLine( nHandle, "Current Recno .....: " + strvalue( &("RecNo()") ) ) )
                 ( nCount )->( FWriteLine( nHandle, "Current Filter ....: " + &("DbFilter()") ) )
                 ( nCount )->( FWriteLine( nHandle, "Relation Exp. .....: " + &("DbRelation()") ) )
                 ( nCount )->( FWriteLine( nHandle, "Index Order .......: " + strvalue( &("IndexOrd(0)") ) ) )
                 ( nCount )->( FWriteLine( nHandle, "Active Key ........: " + strvalue( &("IndexKey(0)") ) ) )
                 ( nCount )->( FWriteLine( nHandle, "" ) )
              Endif
           Next
        ENDIF

        FWriteLine( nHandle, "" )
        IF nCols > 0
            FWriteLine( nHandle, Padc( " Internal Error Handling Information  ", nCols, "-" ) )
        ELSE
            FWriteLine( nHandle, " Internal Error Handling Information  " )
        ENDIF
        FWriteLine( nHandle, "" )
        FWriteLine( nHandle, "Subsystem Call ....: " + oErr:subsystem() )
        FWriteLine( nHandle, "System Code .......: " + strvalue( oErr:suBcode() ) )
        FWriteLine( nHandle, "Default Status ....: " + strvalue( oerr:candefault() ) )
        FWriteLine( nHandle, "Description .......: " + oErr:description() )
        FWriteLine( nHandle, "Operation .........: " + oErr:operation() )
        FWriteLine( nHandle, "Arguments .........: " + Arguments( oErr ) )
        FWriteLine( nHandle, "Involved File .....: " + oErr:filename() )
        FWriteLine( nHandle, "Dos Error Code ....: " + strvalue( oErr:oscode() ) )

        #ifdef HB_THREAD_SUPPORT
        FWriteLine( nHandle, "Running threads ...: " + strvalue( oErr:RunningThreads() ) )
        FWriteLine( nHandle, "VM thread ID ......: " + strvalue( oErr:VmThreadId() ) )
        FWriteLine( nHandle, "OS thread ID ......: " + strvalue( oErr:OsThreadId() ) )
        #endif

        FWriteLine( nHandle, "" )
        FWriteLine( nHandle, " Trace Through:" )
        FWriteLine( nHandle, "----------------" )

fWriteLine ( nHandle, "Base em uso: "+alias() )
fWriteLine ( nHandle, "Pasta: "+curdir() )
fWriteLine ( nHandle, "US:"+us )
fWriteLine ( nHandle, "VersÒo: "+vers )
        FWriteLine( nHandle, Padr( oErr:ProcName, 21 ) + " : " + Transform( oErr:ProcLine, "999,999" ) + " in Module: " + oErr:ModuleName )
        nCount := 3
        While !Empty( Procname( ++ nCount ) )
          FWriteLine( nHandle, Padr( Procname( nCount ), 21 ) + ' : ' + Transform( Procline( nCount ), "999,999" ) + " in Module: " + ProcFile( nCount ) )
        Enddo

        FWriteLine( nHandle, "" )
        FWriteLine( nHandle, "" )

        IF valtype( cScreen ) == "C"
            FWriteLine( nHandle, Padc( " Video Screen Dump ", nCols, "#" ) )
            FWriteLine( nHandle, "" )
            //FWriteLine( nHandle, "" )
            FWriteLine( nHandle, "+" + Replicate( '-', nCols + 1 ) + "+" )
            //FWriteLine( nHandle, "" )
            nCellSize := len( Savescreen( 0, 0, 0, 0 ) )
            nRange := ( nCols + 1 ) * nCellSize
            For nCount := 1 To nRows + 1
               cOutString := ''
               cSubString := Substr( cScreen, nStart, nRange )
               For nForLoop := 1 To nRange step nCellSize
                  cOutString += Substr( cSubString, nForLoop, 1 )
               Next
               FWriteLine( nHandle, "|" + cOutString + "|" )
               nStart += nRange
            Next
            FWriteLine( nHandle, "+" + Replicate( '-', nCols + 1 ) + "+" )
            FWriteLine( nHandle, "" )
            FWriteLine( nHandle, "" )
        ELSE
            FWriteLine( nHandle, " Video Screen Dump not available" )
        ENDIF


    /*
     *  FWriteLine( nHandle, padc(" Available Memory Variables ",nCols,'+') )
     *  FWriteLine( nHandle, "" )
     *  Save All Like * To errormem
     *  nMemHandle := Fopen( 'errormem.mem', FO_READWRITE )
     *  nMemLength := Fseek( nMemHandle, 0, 2 )
     *  Fseek( nMemHandle, 0 )
     *  nCount := 1
     *  While Fseek( nMemHandle, 0, 1 ) + 1 < nMemLength
     *    nMemWidth := Space( 18 )
     *    Fread( nMemHandle, @nMemWidth, 18 )
     *    cVarName  := Left( nMemWidth, At( Chr( 0 ), nMemWidth ) - 1 )
     *    cVarType  := Substr( nMemWidth, 12, 1 )
     *    cVarRec   := Bin2w( Right( nMemWidth, 2 ) )
     *    nMemCount := If( cVarType IN Chr( 195 ) + Chr( 204 ), 14 + cVarRec, 22 )
     *    Fseek( nMemHandle, nMemCount, 1 )
     *    cTemp  := Left( cVarName + Space( 10 ), 10 )
     *    cTemp  += " TYPE " + Type( cVarName )
     *    cTemp  += " " + If( Type( cVarName ) == "C", '"' + &cVarName + '"', strvalue( &cVarName ) )
     *    nBytes := 0
     *    Switch ValType( cVarName )
     *        Case "C"
     *            nBytes += ( nLenTemp := Len( &cVarName ) )
     *            exit
     *        Case "N"
     *            nBytes += ( nLenTemp := 9 )
     *            exit
     *        Case 'L'
     *            nBytes += ( nLenTemp := 2 )
     *            exit
     *        Case "D"
     *            nBytes += ( nLenTemp := 9 )
     *            exit
     *    End
     *    Fwrite( nFhandle, "            " + Transform( nLenTemp, '999999' ) + 'bytes -> ' )
     *    FWriteLine( nHandle, "      " + cTemp )
     *  Enddo
     *  Fclose( nMemHandle )
     *  Ferase( 'errormem.mem' )
     */
        if lAppendLog .and. nHandle2 != -1

           nBytes := FSeek( nHandle2, 0, FS_END )

           cBuff := space(10)
           FSeek( nHandle2, 0, FS_SET )

           while nBytes > 0
             nRead := FRead( nHandle2, @cBuff, 10 )
             FWrite( nHandle, cBuff, nRead )
             nBytes -= nRead
             cBuff := space( 10 )
           enddo

           FClose( nHandle2 )
           FClose( nHandle )

           FErase( cLogFile )
           FRename( cLogFile2, cLogFile )
        else
           FClose( nHandle )
        endif

     Endif

Return .f.

STATIC FUNCTION FWriteLine( nh, c )

   Fwrite( nh, c + HB_OsNewLine() )
   //HB_OutDebug( c + HB_OsNewLine() )
Return nil

STATIC FUNCTION Arguments( oErr )

   LOCAL xArg, cArguments := ""

   IF ValType( oErr:Args ) == "A"
      FOR EACH xArg IN oErr:Args
         cArguments += " [" + Str( HB_EnumIndex(), 2 ) + "] = Type: " + ValType( xArg )

         IF xArg != NIL
            cArguments +=  " Val: " + CStr( xArg )
         ENDIF
      NEXT
   ENDIF

RETURN cArguments

STATIC FUNCTION strvalue( c, l )

     LOCAL cr := ''
*     Default l To .f.
     Switch ValType( c )
         Case "C"
             cr := c
             exit
         Case "N"
             cr := Alltrim( Str( c ) )
             exit
         Case "M"
             cr := c
             exit
         Case "D"
             cr := Dtoc( c )
             exit
         Case "L"
//             cr := If( l, If( c, "On", "Off" ), If( c, "True", "False" ) )
             cr := If( l, If( c, "On", "Off" ), If( c, ".t.", ".f." ) )
             exit
     End
Return Upper( cr )


FUNCTION throwerr (enum, esev, eargs) 
LOCAL e := errornew() 
e:gencode := 0 
e:subcode := enum 
e:subsystem := "MYCODE" 
e:cargo := eargs 
e:severity := IIF (esev == NIL, ES_WHOCARES, esev) 
RETURN eval 
(errorblock(), e) 

As alterações que eu fiz estão a partir da linha 135.

Na linha 161 em diante, tem a situação do erro de criação ou de abertura, que eu tento tratar. Neste eu realmente retorno .t. Mas antes ele funcionava, e agora não está mais funcionando.

Outro problema que eu tenho enfrentado nesse errorsys é alguma incompatibilidade dele com o MySQL. Ao tentar usar o MySQL com o RDDSETDEFAULT( "SQLMIX" ), se compilo junto o meu errorsys, dá erro. Se não compilo, funciona. Mas também não achei nada no meu errorsys que conflite com o MySQL.

[JoséQuintas]

Diria que seu errorsys é potencialmente perigoso.

Mas deixando MySql como default, seu log de erro vai ser no mysql, usando a tabela \tarefas\numeros.
Como essa tabela vai dar erro de abertura, vai entrar novamente na errorsys e tentar salvar em \tarefas\numeros.
E vai repetir isso até estourar o limite de recursividade.

Minha errorsys apenas salva o erro em disco (em txt).
A próxima execução do sistema é que trabalha com o log gerado.

[cjp]

Mas observe que eu coloquei RDDSETDEFAULT("DBFNTX")
no início do Errorsys.

[JoséQuintas]

O que também é um erro, já que alguns erros são tratados pra retornar .T. e vai retornar com RDD errada.
Rotina de erro serve pra demonstrar erro, e não pra ficar fazendo processamento.

[Jairo Maia]

Olá Inácio,

O que também é um erro, já que alguns erros são tratados pra retornar .T. e vai retornar com RDD errada.

Embora concordo que errorsys tenha mesmo a finalidade de mostrar erros e não tratar erros, essa questão de retornar o RDD errado é fato. Se pretende continuar usando seu errorsys, terá que colocar antes de cada Return o RDD padrão de seu sistema, para que ao entrar no errorsys não retorne com o RDD DBFNTX.

[Hasse]

Bom dia colegas.

Também tive um problema semelhante no ErrorSys que desenvolvi especificamente para o meu uso. Ele acusava inclusive os erros dentro do próprio ErrorSys, quando havia.

Funcionava muito bem no xHarbour modo console.

Quando passeis para o Harbour x Minigui, peguei esta mesma função e compilei com um pequeno aplicativo que já funcionava sem o ErrorSys. A compilação passou sem problemas. Mas ao executar o aplicativo o sistema travava ao detectar qualquer erro. Para abortar somente via Gerenciador de Tarefas.

Descobri que ao ocorrer um erro no ErrorSys é que o sistema travava.

Solução: Fui comentando as linhas até que a função passou a funcionar. E depois, descomentando (e depois comentando) linha a linha e compilando e testando, consegui lentamente identificar as linhas que davam erro e arredondar o meu novo ErrorSys especial para Minigui x Harbour. Foi uma trabalheira infernal. Eu não contei, mas acredito que compilei mais de mil vezes. Passei um feriadão, do tipo quinta, sexta, sábado e domingo neste trabalho.

Até hoje ainda não sei porque determinadas funções que estão documentadas no Harbour ou Minigui (não me lembro) não funcionam no ErrorSys. Vou passar alguns exemplos abaixo, e podem observar que continuam comentadas:

Código: Selecionar todos

*   c_Message += '      SET BACKGROUNDTASKS............: ' + strvalue( Set( _SET_BACKGROUNDTASKS ), .T. ) + CRLF
*   c_Message += '      SET BACKGROUNDTICK.............: ' + strvalue( Set( _SET_BACKGROUNDTICK ), .T. ) + CRLF
*   c_Message += '      SET ERRORLOG...................: ' + if(!Empty(aLogFile), strvalue( aLogFile[1] )+','+strvalue( aLogFile[2] ), '') + CRLF
*   c_Message += '      SET ERRORLOOP..................: ' + strvalue( Set( _SET_ERRORLOOP ) ) + CRLF
*   c_Message += '      SET OUTPUTSAFETY...............: ' + strvalue( Set( _SET_OUTPUTSAFETY ), .T. ) + CRLF
*   c_Message += '      SET PRINTERJOB.................: ' + strvalue( Set( _SET_PRINTERJOB ) ) + CRLF
*   c_Message += '      SET TRACE......................: ' + strvalue( Set( _SET_TRACE ), .T. ) + CRLF
*   c_Message += '      SET TRACEFILE..................: ' + strvalue( Set( _SET_TRACEFILE ) ) + CRLF
*   c_Message += '      SET TRACESTACK.................: ' + strvalue( Set( _SET_TRACESTACK ) ) + CRLF
*   c_Messaege += '      oErr:GenCode().................: ' + StrValue( oError:GenCode ) + CRLF
*   c_Messaege += '      oErr:OsCode().(DOS)............: ' + StrValue( oError:OsCode ) + CRLF
*   c_Messaege += '      oErr:Severity()................: ' + StrValue( oError:Severity ) + CRLF
*   c_Messaege += '      oErr:CanDefault()..............: ' + StrValue( oError:CanDefault ) + CRLF

[JoséQuintas]

Uma coisa que não achei no Harbour foi pra converter qualquer valor para string.
Na verdade achei várias funções pra isso, mas nenhuma do jeito que eu achava certo.
Acabei criando a minha própria função.
Talvez seja esse o problema, do StrValue()
Preferi chamar de XToC() apesar de já existir uma com mesmo nome em alguma lib.

[Jairo Maia]

Olá José,

Você testou também a função Hb_ValToStr( xConteúdo )?

[JoséQuintas]

Todas. Algumas deixam de converter NIL, e outras convertem até o que não deveria.
Em core: hb_CStr(), hb_ValToExp(), hb_ValToStr(), Transform()
Em hbct: XtoC()
Em hbmisc: StrFormat()
Em hbnf: ft_XTOY()
Em xhb: CStr(), StringToLiteral(), Any2Str()

[Jairo Maia]

Olá José,

Que interessante. De todas que você citou, eu conhecia apenas as funções: hb_ValToExp() (que é bastante citada nos exemplos da contrib), hb_ValToStr() e claro, a Transform(). As demais não conhecia.

Acho que depende muito da característica de cada modo de programar. Seu método é mais complexo, como sempre podemos ver em suas contribuições. Para mim, a hb_ValToStr() facilitou muito e funciona muito bem.

Não sei se é pedir muito, mas embora a HBCT.LIB tem a função XToC(), será que você não poderia compartilhar a XToC() que você desenvolveu com a gente?

[cjp]

Caros colegas,

Agradeço muito pela vossa ajuda.

Eu até poderia abandonar o meu errorsys, mas preciso de um jeito para resolver pelo menos uma das questões que tento resolver no errorsys:

Tenho frequentes erros de criação ou de abertura de bases de dados no programa em razão de estar tentando salvar a base num local onde ela esteja aberta. Faço a verificação antes de tentar salvar, mas pode ser (e acontece com alguma frequência) que um usuário abra a base bem na hora que vou tentar salvá-la, mesmo depois de verificado.

Eu só queria uma forma de isso não causar erro no programa. Ainda que não seja possível salvar, se ele pudesse apenas tentar novamente (ou até abordar a tentativa), mas sem dar erro, seria ótimo. Há algum jeito?

[JoséQuintas]

Não entendi direito.
Não seria o begin sequence-end sequence?

Se é porque o programa é multithread, então basta cada thread abrir sua própria conexão.