PC Toledo

Em homenagem a Paulo Cesar Toledo
https://pctoledo.org/

errorsys no Harbour

https://pctoledo.org/viewtopic.php?t=13575

Página 2 de 3

errorsys no Harbour

Enviado: 12 Out 2012 02:42
por cjp
Nossa, meu caro, agora ficou ótimo!!! Era exatamente isto que eu precisava. Muito obrigado.

Só uma questão: ainda não está aparecendo o módulo (arquivo prg compilado). No xharbour mostrava. Mas isto não é o mais importante. Se não for possível, não tem problema.

Também notei que, quando dá "Tipo incorreto de dado", o Harbour não informa quais são os dados que estão em contradição. O xharbour informava, por exemplo, que estou querendo colocar um dado caractere num campo numérico.

errorsys no Harbour

Enviado: 13 Nov 2012 01:00
por cjp
Ressuscitando este assunto, gostaria de saber se tem como acrescer uma informação neste log de erro: a linha do programa onde deu o erro. Mas não é o nr da linha do programa (isso eu já tenho), queria a própria linha, ou seja, como está escrito o programa nessa linha (à semelhança do que faz o debug, eu acho).

Explico a razão disso: eu altero o programa frequentemente. Quando o programa de um usuário dá algum erro, o log indica a linha do erro da época em que a versão do programa que o usuário está usando foi compilada. Mas depois disso eu já fiz alguma alteração no programa, e a linha já não é a mesma. Daí, a informação do nr da linha do programa fica divergente.

Isso é possível?

Além disso, se for possível, gostaria também das informações detalhadas do erro "Tipo incorreto de dado" e também o módulo (arquivo prg compilado) do erro.

Obrigado.

errorsys no Harbour

Enviado: 14 Nov 2012 02:01
por lucimauro
Tentei compilcar aqui em minha aplicacao e forçei um erro de variavel,so que ele dar uma erro de recursividade. e sai.

errorsys no Harbour

Enviado: 19 Nov 2012 23:12
por cjp
Acho que é porque tem algumas funções que eu coloquei que dependiam de algumas funções e variáveis que não estavam definidas.

Tente este 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

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


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


if "Create error"$NTRIM(e:osCode)
   mandmail1("","Ver forma de tratar o create error - ERRORS2 158")
endif   
 

   /*
     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())+"; hora: "+time() + Hb_Eol()
   cMessage += "Programa......: " + Hb_CmdArgArgV() + Hb_Eol()
   cMessage += ansi("Na função.....: ") + ProcName(2) + Hb_Eol()
   cMessage += "Na linha......: " + NTRIM(ProcLine(2)) + Hb_Eol()
   cMessage += "Base em uso...: " + Alias() + Hb_Eol()
   cMessage += ansi("Área em uso...: ") + alltrim(str(select())) + Hb_Eol()
   cMessage += "Pasta.........: " + CurDir() + Hb_Eol()
   cMessage += ansi("Usuário.......: ") + us + Hb_Eol()
   cMessage += ansi("Versão........: ") + vers + Hb_Eol()
   cMessage += ansi("Área 1........: ") + alias(1) + Hb_Eol()
   cMessage += ansi("Área 2........: ") + alias(2) + Hb_Eol()
   cMessage += ansi("Área 3........: ") + alias(3) + Hb_Eol()
   cMessage += ansi("Área 4........: ") + alias(4) + Hb_Eol()
   cMessage += ansi("Área 5........: ") + alias(5) + Hb_Eol()
   cMessage += ansi("Área 6........: ") + alias(6) + Hb_Eol()

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

   i := 2
   While ( !Empty( ProcName(i) ) )
    cMessage += "Vindo de......: " + Trim(ProcName(i))
    cMessage += " Linha: (" + NTRIM(ProcLine(i)) + ")" + Hb_Eol()
    i++
   EndDo
   
   cMessage += Hb_Eol()
   cMessage += Hb_Eol()
   cMessage += Hb_Eol()
   cMessage += Hb_Eol()
		   cMessage += "**************** Video Screen Dump ****************" + Hb_Eol() 
           cMessage += Replicate( '-', nCols -18 ) + 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(procname(0)))=0  .and. at("TAR2P",upper(procname(1)))=0 .and. at("TAR2P",upper(procname(2)))=0 .and. at("TAR2P",upper(procname(3)))=0 .and. at("TAR2P",upper(procname(4)))=0 .and. at("CRIANCAS",upper(procname(0)))=0  .and. at("CRIANCAS",upper(procname(1)))=0 .and. at("CRIANCAS",upper(procname(2)))=0 .and. at("CRIANCAS",upper(procname(3)))=0 .and. at("CRIANCAS",upper(procname(4)))=0 //.and. at("ACERTAT",upper(procname(0)))=0  .and. at("ACERTAT",upper(procname(1)))=0 .and. at("TAR2P",upper(procname(2)))=0 .and. at("TAR2P",upper(procname(3)))=0 .and. at("TAR2P",upper(procname(4)))=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+"; "+alltrim(cmessage,1,50)+".")
endif


//if us#"I" .and. (oError:description)="Corruption detected"
if us#"I" .and. ( "X/1012" $ cMessage )
   i := 2
   while ( !Empty(ProcName(i)) )
      cMessage += Hb_Eol()      
      cMessage += "Called from" + Trim(ProcName(i)) + "(" + NTRIM(ProcLine(i)) + ")  " + Hb_Eol()
      i++
   end
   use
   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() )
*if type("us")#"U"
   fWriteLine ( nHandle, "US:"+us )
*endif
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 )

errorsys no Harbour

Enviado: 20 Nov 2012 11:05
por lugab
Cjp, bom dia..

Onde acho a função

Código: Selecionar todos

  Hb_Eol() '
?

errorsys no Harbour

Enviado: 20 Nov 2012 11:37
por Jairo Maia
Olá Lugab,

A função Hb_Eol() é uma função do harbour 3.0.0 ou superior. Sua finalidade é retornar o controle de final de linha e retorno de carro conforme a plataforma usada.

Caso não queira atualizar o Harbour para os testes:

Em DOS/Windows, o separador de linhas é CR+LF (Carriage Return / Line Feed),ou seja:

Código: Selecionar todos

Function Hb_Eol()
Return ( Chr( 13 ) + Chr( 10 ) )
Em Unix/Linux, o separador de linhas é LF (Line Feed),ou seja:

Código: Selecionar todos

Function Hb_Eol()
Return Chr( 10 ) )

errorsys no Harbour

Enviado: 20 Nov 2012 14:27
por lugab
Obrigado, Jairo..

errorsys no Harbour

Enviado: 22 Nov 2012 02:57
por cjp
Colegas,

Alguém me ajuda no que eu pedi acima?

Inacio

errorsys no Harbour

Enviado: 27 Jan 2013 00:22
por lugab
Amigos, estou usando o ERRORSYS ( para XHARBOUR) abaixo, que copiei daqui do fórum mesmo.

Essa rotina chama a função ANSI() e eu não sei onde buscar.

Alguém aqui sabe onde acho essa função ?

Abaixo,um dos trechos onde essa função é requisitada:

Código: Selecionar todos

 cMessage := "Ocorreu o erro: " + Ansi(cMessage) + Hb_Eol()


Abaixo, o ERRORSYS completo

Código: Selecionar todos


#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

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

 
******* minha fun?Êo ******

if "Create error"$NTRIM(e:osCode)
 //mandmail1("","Ver forma de tratar o create error - ERRORS2 158")
 Alert("Eu hein, Ver forma de tratar o create error - ERRORS2 158")
endif 
 

 /*
  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())+"; hora: "+time() + Hb_Eol()
 cMessage += "Programa......: " + Hb_CmdArgArgV() + Hb_Eol()
 cMessage += Ansi("Na função.....: ") + ProcName(2) + Hb_Eol()
 cMessage += "Na linha......: " + NTRIM(ProcLine(2)) + Hb_Eol()
 cMessage += "Base em uso...: " + Alias() + Hb_Eol()
 cMessage += Ansi("Área em uso...: ") + alltrim(str(select())) + Hb_Eol()
 cMessage += "Pasta.........: " + CurDir() + Hb_Eol()
 cMessage += Ansi("Usuário.......: ") + us + Hb_Eol()
 cMessage += Ansi("Versão........: ") + vers + Hb_Eol()
 cMessage += Ansi("Área 1........: ") + alias(1) + Hb_Eol()
 cMessage += Ansi("Área 2........: ") + alias(2) + Hb_Eol()
 cMessage += Ansi("Área 3........: ") + alias(3) + Hb_Eol()
 cMessage += Ansi("Área 4........: ") + alias(4) + Hb_Eol()
 cMessage += Ansi("Área 5........: ") + alias(5) + Hb_Eol()
 cMessage += Ansi("Área 6........: ") + alias(6) + Hb_Eol()

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

 i := 2
 While ( !Empty( ProcName(i) ) )
  cMessage += "Vindo de......: " + Trim(ProcName(i))
  cMessage += " Linha: (" + NTRIM(ProcLine(i)) + ")" + Hb_Eol()
  i++
 EndDo
 
 cMessage += Hb_Eol()
 cMessage += Hb_Eol()
 cMessage += Hb_Eol()
 cMessage += Hb_Eol()
   cMessage += "**************** Video Screen Dump ****************" + Hb_Eol() 
     cMessage += Replicate( '-', nCols -18 ) + 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(procname(0)))=0 .and. at("TAR2P",upper(procname(1)))=0 .and. at("TAR2P",upper(procname(2)))=0 .and. at("TAR2P",upper(procname(3)))=0 .and. at("TAR2P",upper(procname(4)))=0 .and. at("CRIANCAS",upper(procname(0)))=0 .and. at("CRIANCAS",upper(procname(1)))=0 .and. at("CRIANCAS",upper(procname(2)))=0 .and. at("CRIANCAS",upper(procname(3)))=0 .and. at("CRIANCAS",upper(procname(4)))=0 //.and. at("ACERTAT",upper(procname(0)))=0 .and. at("ACERTAT",upper(procname(1)))=0 .and. at("TAR2P",upper(procname(2)))=0 .and. at("TAR2P",upper(procname(3)))=0 .and. at("TAR2P",upper(procname(4)))=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+"; "+alltrim(cmessage,1,50)+".")
endif

//if us#"I" .and. (oError:description)="Corruption detected"
if us#"I" .and. ( "X/1012" $ cMessage )
 i := 2
 while ( !Empty(ProcName(i)) )
   cMessage += Hb_Eol()   
   cMessage += "Called from" + Trim(ProcName(i)) + "(" + NTRIM(ProcLine(i)) + ") " + Hb_Eol()
   i++
 end
 use
 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() )
*if type("us")#"U"
 fWriteLine ( nHandle, "US:"+us )
*endif
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 )

Func Hb_Eol
Return ( chr(13) +chr(10) )

errorsys no Harbour

Enviado: 28 Jan 2013 00:27
por cjp
A função ansi() é só para transformar a acentuação. O conteúdo dela é:

Código: Selecionar todos

//=========================================================
//N|ANSI
//---------------------------------------------------------
//D|converte textos com caracteres ASCII para o padrÒo ANSI
//---------------------------------------------------------
//R|texto convertido
//=========================================================
function ANSI(cTxt) // 1 texto a ser convertido para o padrÒo ANSI

local I
local aTab
local nCod

aTab:= {;
199,252,233,226,228,224,229,231,234,235,232,239,238,236,196,197,;
201,230,198,244,246,242,251,249,255,214,220,248,163,216,215,131,;
225,237,243,250,241,209,170,176,191,174,172,189,188,161,171,187,;
35, 35, 35,124, 43,193,194,192,169, 43,124, 43, 43,162,165, 43,;
43, 43, 43, 43, 45, 43,227,195, 43, 43, 43, 43, 43, 61, 43,164,;
240,208,202,203,200,185,205,206,207, 43, 43, 35, 35,166,204, 35,;
211,223,212,210,245,213,181,254,222,218,219,217,253,221,175,180,;
173,177, 61,190,182,167,247,184,186,168,183,185,179,178, 35, 32 }

for I:= 1 to Len(cTxt)
nCod:= ASC(SubStr(cTxt,I,1))

if nCod >= 128
cTxt:= Stuff(cTxt,I,1,Chr(aTab[nCod -127]))
endif
next
return cTxt

errorsys no Harbour

Enviado: 28 Jan 2013 02:13
por lugab
Valeu, CJP, muito obrigado

errorsys no Harbour

Enviado: 09 Set 2016 11:45
por clodoaldomonteiro
Bom dia amigos,

Gostei muito desse tópico e queria reabri-lo perguntando ao CJP, para que ser a função Mander()?

Desde já agradeço a atenção.

errorsys no Harbour

Enviado: 10 Set 2016 22:44
por cjp
Olá, Clodoaldo.

Criei essa função mander() apenas para o sistema do usuário me enviar automaticamente, por e-mail, o log do erro que deu no sistema.

Inacio

errorsys no Harbour

Enviado: 26 Set 2023 15:45
por deividdjs
Tarde Galera!

estou usando a função com Harbour 3.2 .. quando ocorre o erro simplismente fecha o sistema .. tipo um CTRL + C da vida ... onde estou errando ??

Att,

errorsys no Harbour

Enviado: 27 Set 2023 16:09
por clodoaldomonteiro
Boa tarde.

Chega a dar alguma mensagem de erro, e vc tem sua própria rotina de gerenciamento dos erros do sistema?

Abraços.
Todos os horários são UTC-03:00
Página 2 de 3

Powered by phpBB® Forum Software © phpBB Limited

Traduzido por: Suporte phpBB