PC Toledo

Enviado: **07 Mar 2014 14:32**

Colaboração;

migrei de xHborbor para Harbour 3.2 e notei que a função hb_FuncPtr em Harbor não esta funcionando;

ValType( hb_FuncPtr( wexec ) )

a linha acima em xHarbour retorna "P" se "wexec" existe e deveria retornar "S" em Harbour, só que retorna "S" mesmo não existindo;

utilizando a rotina "errorsys.prg" para gerar as informações de erro, acrescentei as linhas abaixo que resolveu o problema:

if oError:gencode == EG_NOFUNC // erro de função não encontrada
// acrescente uma mensagem que a rotina não existe
return .T. // retorna para a rotina que originou o erro sem interromper o programa
endif

espero ter ajudado;

Enviado: **07 Mar 2014 16:12**

Isso é um dos BUGs do xHarbour que segundo consta ninguém sabe ninguém viu.

No Harbour não precisa disso.

Valtype() retorna a variável do tipo POINTER corretamente.

In xHarbour above code creates pointer item ( VALTYPE(funcSym) == "P" )
which can be used in some cases like in Harbour but because xHarbour VM
does not know if given pointer item is function reference or not then in
such context xHarbour has to accept any pointer items as function
references so any user mistake can cause GPF or some HVM structure
corruptions.

Saudações,
Itamar M. Lins Jr.

Enviado: **07 Mar 2014 19:33**

Pessoal, até hj eu não tenho uma "Rotina personalizada de Erro" que funcione adequadamente em meu sistemas console Harbour e xHarbour .

Já experimentei todas as q achei aqui no fórum, nenhuma funfou 100% e eu terminei usando a "padrão" (que não adianta nada) colocando apenas a chamada Errorsys() no programa inicial.

Se vcs possuirem "rotina de erro" q funcione 100% pra harbour e xHarbour e puderem postar , seria ótimo pra mim..

Enviado: **08 Mar 2014 09:24**

lugab;

a rotina errorsys.prg que utilizo foi retirada aqui do forum, acrescentada com algumas perfumarias pessoais;
com você declarou que já experimentou todas, entendo que não adianta postar aqui, pois estaria sendo repetitivo
e não atende as suas necessidades;

Enviado: **23 Mar 2014 09:49**

Bom dia Lugab.

Eu tenho uma rotina de erro que estou usando desde 2006 e que me atende de forma adequada, copiada do "ErroLog.prg" do Luiz Henrique Santos, com muitas perfumarias adaptadas para o meu uso no xHarbour. Nunca testei no Harbour. Parece-me que esta rotina foi copiada e adpatada do ErrorLog.prg do velho e bom Clipper.

Código: Selecionar todos

*--------------------------------------------------------------------------------------------------
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*                                                                           *
*   ERRORLOG.PRG                                                            *
*                                                                           *
*   Luiz Henrique dos Santos                                                *
*   luiz.hs@uol.com.br                                                      *
*                                                                           *
*   Adaptado por Ivo Fritz Hasse       Data:  30/04/2006                    *
*                                                                           *
*   ver os códigos de erro em:  error.ch                                    *
*                                                                           *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

// Função para Criação de Arquivo LOG contendo os Erros
*
*--------------------------------------------------------------------------------------------------
FUNCTION ErrorLog( oErr, nProcLine )

         Local cScreen   := SaveScreen()       ,;
               cCorAnt   := SetColor()         ,;
               cLogFile  := Space(12)          ,;
               nWorkArea := Select()           ,;
               nRange    := ( Maxcol()+1 ) * 2 ,;
               nStart    := 1                  

         Local aArqTemp  := Directory( 'ERRORLOG.*' )

         Local nFhandle   , nCount    , nForLoop  , nMemHandle ,;
               nMemLength , nMemWidth , nMemCount , cOutstring ,;
               cSubstring , cVarName  , cVarType  , cTemp      ,;
               nLenTemp   , nBytes    , cVarRec

         Local cExt, I
         
         Local aTeclas   := {}

*-------------------------------- Arquivar o Buffer do teclado num Array --------------------------

         AADD( aTeclas, LastKey() )
         For nConta = 1 TO 15
            nn := Inkey()
            IF nn == 0
               EXIT
            ENDIF
            AADD( aTeclas, nn )
         Next

*-------------------------------- Setar DEVICE para a Tela ----------------------------------------

         #include "set.ch"
         c_device  := SET(_SET_DEVICE)
         SET DEVICE TO SCREEN

         If ( oErr:GenCode() == 5 )                                  && Divisão por zero.

            @ 01,00 SAY "DivisÆo por Zero no M¢dulo >"+Procname(2)+"<, na Linha >" + StrValue(Procline(2)) + "<"
            SetColor( cCorAnt )
            Inkey( 2 )
            Return( 0 )                                              && Retorna o valor 0 (zero)

         Endif

         IF ( ProcName(2) == "IMPREXA" )
            If ( oErr:GenCode() == 1 )                               && Variáveis incompatíveis.

               Alertar("**********   Exame: '" + c_codexa + "'   **********;;" +;
                       "H  um erro no '" + c_codexa + ".IMP', na linha abaixo.  Verifique. ;;" +;
                       "=>>" + c_var1 + "<<= ;;" +;
                       "Possivelmente as vari veis nÆo sejam do mesmo tipo.")
               SetColor( cCorAnt )
               Return .F.
            Endif

            If ( oErr:GenCode() == 7 )                               && Erro de sintaxe.

                  Alertar("**********   Exame: '" + c_codexa + "'   **********;;" +;
                          "H  um erro no '" + c_codexa + ".IMP', na linha abaixo.  Verifique. ;;" +;
                          "=>>" + c_var1 + "<<= ;;" )
               SetColor( cCorAnt )
               Return .F.
            Endif
         ENDIF

         If ( oErr:GenCode() == 21 .And. oErr:OsCode() == 32 .And. oErr:CanDefault() )

            NetErr(.T.)                                             && 21 - Erro de abertura de arquivo.
            SetColor( cCorAnt )                                     && 32 - Corrupção de arquivo.
            Return .F.

         EndIf

         If ( oErr:GenCode() == 40 .And. oErr:CanDefault() )        && 40 - Erro de Append.

            NetErr(.T.)
            SetColor( cCorAnt )
            Return .F.

         EndIf

*------------------------------------ Gerar a extensão do LogFile ---------------------------------
         cExt:= '000'
         For I:= 1 To Len( aArqTemp )

             If Val( cExt ) < Val( Substr( aArqTemp[I][1], 10, 3 ) )
                cExt:= Substr( aArqTemp[I][1], 10, 3 )
             EndIf

         EndFor

         cExt     := StrZero( Val( cExt ) + 1, 3 )
         cLogFile := 'ERRORLOG.' + cExt

*----------------------------------- Gerar as mensagens de erro de TELA ---------------------------

            __cErro := ""
            DescrErro()
            NumerErro := "/" + STRTRAN( StrValue(oErr:SubCode()), ".", "" )
            n_pos1 := AT( NumerErro, __cErro )
            n_pos2 := AT( CHR(10), __cErro, n_pos1 ) - 01
         *
         __Error := Padr('Tipo de Mensagem .: ' + oErr:SubSystem(),50 ) + ";" +;
                    Padr('N£mero do Erro ...: ' + StrValue(oErr:SubCode()),50 ) + ";" +;
                    Padr('Descri‡Æo ........: ' + oErr:Description(),50) + ";" +;
                    Padr('Objeto do Erro ...: ' + Upper(oErr:Operation() ),50) + ";" +;
                    Padr('Erro do DOS ......: ' + Strvalue(oErr:OsCode() ),50) + ";" +;
                    Padr('µrea de Trabalho .: ' + StrValue(Select() ),50) + ";" +;
                    Padr('Nome do Arquivo ..: ' + oErr:FileName(),50) + ";" +;
                    Padr('Module Name.... ..: ' + oErr:ModuleName(),50) + ";" +;
                    Padr('M¢dulo .....: ' + Procname(2) + REPLICATE(".",15-LEN(Procname(2))) +;
                         ': Linha... ' + StrValue(Procline(2)),50)
         nCount := 2
         While ! Empty( Procname( ++nCount) )
            __Error += ";" + Padr(SPACE(14) + Procname(nCount) +;
                       REPLICATE(".",15-LEN(Procname(nCount))) +;
                       ': Linha... ' + StrValue(Procline(nCount)),50)
            IF nCount > 6
               EXIT
            ENDIF
         EndDo
*----------------------------------- Alerta de TELA do erro ocorrido ------------------------------

         If oErr:Severity() > 1                                 && Erro Severo ou Catastrófico.

            Alertar('Ocorreu um erro irrecuper vel na aplica‡Æo. ;;' +;
                    __Error + ' ; ;' +;
                    'Maiores detalhes no arquivo ' + cLogFile)

         Else                                                   && Erro de Simples ALERTA.

            Alertar('Ocorreu um erro na aplica‡Æo, por‚m o ;' +;
                    'trabalho pode continuar. ;;' + __Error + ' ; ;' +;
                    'Maiores detalhes no arquivo ' + cLogFile)

         EndIf
*------------------------------------ Gravar informações sobre o erro -----------------------------
         SetColor('W+/R')

         @ 10,15 Clear To 12,65
         @ 10,15 To 12,65 Double

         @ 11,17 Say 'Aguarde... Gravando informa‡äes sobre o erro ...'

         SetColor( cCorAnt )

         nFhandle:= Fcreate( cLogFile, 0 )

         If nFhandle < 4

            Alertar( '     As informa‡äes referentes ao erro;' +;
                      'nÆo puderam ser salvas.                '    )

         Else

            FWriteLine( nFhandle, padc( ' Informações sobre o Erro - ErrorLog ', 83, '*' ) )
            FWriteLine( nFhandle, '' )
            FWriteLine( nFhandle, '      Tipo de Mensagem ..............: ' + oErr:SubSystem() )
            FWriteLine( nFhandle, '      Número do Erro ................: ' + StrValue(oErr:SubCode()) )
            FWriteLine( nFhandle, '      Descrição .....................: ' + oErr:Description() )
            FWriteLine( nFhandle, '      Objeto do Erro ................: ' + Upper(oErr:Operation()) )
            FWriteLine( nFhandle, '      Erro do DOS ...................: ' + Strvalue(oErr:OsCode()) )
            FWriteLine( nFhandle, '      Área de Trabalho ..............: ' + StrValue(Select()) )
            FWriteLine( nFhandle, '      Nome do arquivo ...............: ' + Dbf() )
            FWriteLine( nFhandle, '      Nome do Arquivo associado .....: ' + oErr:FileName )
            FWriteLine( nFhandle, '      Número de argumentos ..........: ' + AllTrim(Str(Len(oErr:args))),50)
            FWrite    ( nFhandle, '      Módulo .........: ' )

            nCount := 1

            While ! Empty( Procname( ++nCount) )

                  cFile := Procname(nCount) + REPLICATE(".",25-LEN(Procname(nCount)))
                  FWriteLine( nFhandle, cFile + ' :Linha... ' +;
                                        Padr(StrValue(Procline(nCount)), 20) )
                  Fwrite( nFhandle, '                        ' )

            EndDo

            FWriteLine( nFhandle, '' )
            FWriteLine( nFhandle, Padc( ' Informações do Código de Erro ', 83, '*'  ) )
            FWriteLine( nFhandle, '' )
            FWriteLine( nFhandle, '      oErr:GenCode().................: ' + StrValue(oErr:GenCode()))
            FWriteLine( nFhandle, '      oErr:OsCode().(DOS)............: ' + StrValue(oErr:OsCode()))
            FWriteLine( nFhandle, '      oErr:Severity()................: ' + StrValue(oErr:Severity()))
            FWriteLine( nFhandle, '      oErr:CanDefault()..............: ' + StrValue(oErr:CanDefault()))

            FWriteLine( nFhandle, '' )
            FWriteLine( nFhandle, Padc( ' Informações do ambiente DOS ', 83, '*'  ) )
            FWriteLine( nFhandle, '' )
            FWriteLine( nFhandle, '      Data ..........................: ' + Dtoc( Date()) )
            FWriteLine( nFhandle, '      Hora ..........................: ' + Time() )
            FWriteLine( nFhandle, '      Espaço em Disco ...............: ' + StrValue(DiskSpace()) )

            FWriteLine( nFhandle, '' )
            FWriteLine( nFhandle, Padc( ' Informações da Memória Convencional ', 83, '*' ) )
            FWriteLine( nFhandle, '' )

            FWriteLine( nFhandle, '      Memória Livre .................: ' + StrValue(Memory(0)) )
            FWriteLine( nFhandle, '      Maior Bloco Contínuo ..........: ' + StrValue(Memory(1)) )
            FWriteLine( nFhandle, '      Memória Disponível ( RUN ) ....: ' + StrValue(Memory(2)) )

            FWriteLine( nFhandle, '' )
            FWriteLine( nFhandle, Padc( ' Informações do ambiente Clipper / xHarbour ', 83, '*' ) )
            FWriteLine( nFhandle, '' )

            FwriteLine( nFhandle, '      Exact is ......................: ' + StrValue(Set(01),.T.))
            FWriteLine( nFhandle, '      Fixed is ......................: ' + StrValue(Set(02),.T.))
            FWriteLine( nFhandle, '      Decimals is at ................: ' + StrValue(Set(03)))
            FWriteLine( nFhandle, '      Path is set to ................: ' + StrValue(Set(06)))
            FWriteLine( nFhandle, '      Default is at .................: ' + StrValue(Set(07)))
            FWriteLine( nFhandle, '      Epoch is ......................: ' + StrValue(Set(05)))
            FWriteLine( nFhandle, '      Date Format at ................: ' + StrValue(Set(04)))
            FWriteLine( nFhandle, '      Alternate is ..................: ' + StrValue(Set(18),.T.))
            FWriteLine( nFhandle, '      Alter File is .................: ' + StrValue(Set(19)))
            FWriteLine( nFhandle, '      Console is ....................: ' + StrValue(Set(17),.T.))
            FWriteLine( nFhandle, '      Margin is set .................: ' + StrValue(Set(25)))
            FWriteLine( nFhandle, '      Printer is ....................: ' + StrValue(Set(23),.T.))
            FWriteLine( nFhandle, '      Printer File ..................: ' + StrValue(Set(24)))
            FWriteLine( nFhandle, '      Device is at ..................: ' + StrValue(Set(20)))
            FWriteLine( nFhandle, '      Bell is .......................: ' + StrValue(Set(26),.T.))
            FWriteLine( nFhandle, '      Confirm is ....................: ' + StrValue(Set(27),.T.))
            FWriteLine( nFhandle, '      Delimiters are ................: ' + StrValue(Set(33),.T.))
            FWriteLine( nFhandle, '      Delimit Chars .................: ' + StrValue(Set(34)))
            FWriteLine( nFhandle, '      Escape is set .................: ' + StrValue(Set(28),.T.))
            FWriteLine( nFhandle, '      Intensity is ..................: ' + StrValue(Set(31),.T.))
            FWriteLine( nFhandle, '      Scoreboard is .................: ' + StrValue(Set(32),.T.))
            FWriteLine( nFhandle, '      Wrap is set ...................: ' + StrValue(Set(35),.T.))
            FWriteLine( nFhandle, '      Message line ..................: ' + StrValue(Set(36)))
            FWriteLine( nFhandle, '      Message Center ................: ' + StrValue(Set(37),.T.))
            FWriteLine( nFhandle, '      Exclusive is ..................: ' + StrValue(Set(08),.T.))
            FWriteLine( nFhandle, '      Softseek is ...................: ' + StrValue(Set(09),.T.))
            FWriteLine( nFhandle, '      Unique is .....................: ' + StrValue(Set(10),.T.))
            FWriteLine( nFhandle, '      Deleted is ....................: ' + StrValue(Set(11),.T.))

            FWriteLine( nFhandle, '' )
            FWriteLine( nFhandle, Padc( ' Detalhes da Área de Trabalho ', 83, '*' ) )
            FWriteLine( nFhandle, '' )

            For nCount := 1 to 55

                If ! Empty( (nCount)->( Alias() ) )

                   (nCount)->(FWriteLine( nFhandle, '      Área de Trabalho ' + REPL('.',30) + ': ' + StrValue( Select())))
                   (nCount)->(FWriteLine( nFhandle, '      Alias .........................: ' + Upper(Alias()) ))
                   (nCount)->(FWriteLine( nFhandle, '      Registro Atual ................: ' + Strvalue( Recno()) ))
                   (nCount)->(FWriteLine( nFhandle, '      Total de registros.............: ' + StrValue( Lastrec()) ))
                   (nCount)->(FWriteLine( nFhandle, '      Filtro Atual ..................: ' + DbFilter() ))
                   (nCount)->(FWriteLine( nFhandle, '      Expressão de Relacionamento ...: ' + DbRelation() ))
                   (nCount)->(FWriteLine( nFhandle, '      Ordem do Índice ...............: ' + StrValue( IndexOrd())))
                   (nCount)->(FWriteLine( nFhandle, '      Chave do Índice ...............: ' + IndexKey( IndexOrd())))
                   (nCount)->(FWriteLine( nFhandle, '      --------------------------------------------------------' ))
                   (nCount)->(FWriteLine( nFhandle, '' ))

                EndIf

            EndFor

*------------------------------------ Cópia da TELA onde ocorreu o erro ---------------------------

            FWriteLine( nFhandle,  '' )
            FWriteLine( nFhandle, Padc( ' Tela onde ocorreu o Erro ', 83, '*' ) )
            FWriteLine( nFhandle,  '' )
            FWriteLine( nFhandle,  'Ú' + Replicate('Ä',Maxcol()+3) + '¿' )
            
            cScreen := HB_OemToAnsi( cScreen )

            For nCount:= 1 to Maxrow()

                cOutString := ''
                cSubString := Substr(cScreen, nStart, nRange )

                For nForLoop:= 1 to nRange step 2

                    cOutString += Substr(cSubString, nForLoop, 1)

                EndFor

                FWriteLine( nFhandle, '³ '+cOutString+' ³' )
                nStart += nRange

            EndFor
            FWriteLine( nFhandle, 'À' + Replicate('Ä', Maxcol()+3) + 'Ù' )

*------------------------------------ Lista as Variáveis de Memória -------------------------------

            FWriteLine( nFhandle, '' )
            FWriteLine( nFhandle, padc( ' Variáveis de Memória ', 83, '*' ) )
            FWriteLine( nFhandle, '' )

            Save All Like * to ErrorMem

            nMemHandle := Fopen( 'Errormem.mem', 2 )
            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 $ Chr(195)+Chr(204), 14+cVarRec, 22 )

                  Fseek(nMemHandle, nMemCount, 1)

                  cTemp    := Left(cVarName + Space(10), 10)

                  *==================================================================================================
                  *  As 5 linhas abaixo foram adicionadas por Ivo F Hasse, 15/05/2006.
                  *  Imprime o valor da variáveis numéricas e o estado da variáveis lógicas.
                  *--------------------------------------------------------------------------------------------------
                  cTemp    += ' Tipo  ' + Type(cVarName)
                  cTemp    += ' = ' + IF( Type(cVarName)    == 'C', ['] + &cVarName + ['],;
                                        IIF( Type(cVarName) == 'L',StrValue( &cVarName ),;
                                        IIF( Type(cVarName) == 'N',StrValue( &cVarName ),;
                                        StrValue( cVarName ))))
                  *==================================================================================================
                  *--------------------------------------------------------------------------------------------------
                  *                  cTemp    += ' ' + If( Type(cVarName) == 'C', ['] + &cVarName + ['],;
                  *                                        StrValue( cVarName ))
                  *                                        StrValue( &cVarName ))
                  *  ==>> esta linha acima gera erro quando existem variáveis lógicas,
                  *  e foi substituída pelas linhas acima, criada em 15/05/2006 <<==
                  *--------------------------------------------------------------------------------------------------
                  nBytes   := 0

                  Do Case

                     Case Type(cVarName) == 'C'

                          nBytes += ( nLenTemp := Len( &cVarName. ) )

                     Case Type(cVarName) == 'N'

                          nBytes += ( nLenTemp := 9 )

                     Case Type(cVarName) == 'L'

                          nBytes += ( nLenTemp := 2 )

                     Case Type(cVarName) == 'D'

                          nBytes += ( nLenTemp := 9 )

                  EndCase

                  Fwrite(     nFhandle, '  ' + Transform(nLenTemp, '9999999') + ' Bytes -> ')
                  FWriteLine( nFhandle, '  ' + cTemp )

            EndDo

*------------------------------------ Lista as Últimas Teclas Pressionadas ------------------------

            FWriteLine( nFhandle, '' )
            FWriteLine( nFhandle, padc( ' Últimas Teclas Pressionadas ', 83, '*' ) )
            FWriteLine( nFhandle, '' )

            Fwrite(     nFhandle, '          LastKey()             ->   ' + Transform(aTeclas[1], '9999999') )
            FWriteLine( nFhandle, '' )
            FWriteLine( nFhandle, '' )

            For nConta = 2 TO Len( aTeclas )
               Fwrite(     nFhandle, '          Buffer do teclado'+Str(nConta-01,02)+'   ->   ' + Transform(aTeclas[nConta], '9999999') )
               FWriteLine( nFhandle, '' )
            Next nConta

*------------------------------------ FIM  DA  LISTA  DA  DESCRIÇÃO  DO  ERRO ---------------------

            FWriteLine( nFhandle, '' )
            FWriteLine( nFhandle, padc( ' Fim da Descrição do Erro - ErrorLog ', 83, '*' ) )
            FWriteLine( nFhandle, '' )

            Fclose( nMemHandle )
            Ferase( 'Errormem.mem' )
            Fclose( nFhandle )

         EndIf

         SetColor(cCorAnt)

         @ 10,15 Clear To 12,65

         If ( oErr:OsCode() == 2 .Or. oErr:OsCode() == 3 )

            Break(oErr)

         EndIf

         If oErr:Severity() == 3

            ErrorLevel(1)

            Cls
            DbCloseAll()
            Quit

         EndIf

         If ! oErr:CanDefault()

            Break(oErr)

         EndIf

         IF c_device = "PRINTER"
            DO WHILE SET(_SET_DEVICE) <> "PRINTER"
               SET DEVICE TO PRINTER
            ENDDO
         ENDIF

Return .F.

// Fim da funcao ErrorLog()
*
*--------------------------------------------------------------------------------------------------
Static Function StrValue( cString, OnOff )

       Local cRetValue:= Space(01) ,;
             cFormat  := Space(01) ,;
             nFormat  := 0         ,;
             nDecimals:= 0         ,;
             cStrDec  := Space(01) ,;
             nOndDec  := 0

       If Empty(OnOff)

          OnOff:= .F.

       EndIf

       Do Case

          Case ValType( cString ) == 'C'

               cRetValue:= cString

          Case ValType( cString ) == 'N'

               cStrDec  := Str( cString )
               nOndDec  := At(".", cStrDec )
               nDecimals:= 0

               If ( nOndDec > 0)
                  nDecimals:= Len( alltrim( SubStr( cStrDec, nOndDec + 1 ) ) )
               endif

               cFormat  := '@E 999,999,999,999,999,999,999,999,999'

               If nDecimals > 0

                  cFormat+= '.'

                  For nFormat:= 1 to nDecimals

                      cFormat+= '9'

                  EndFor

                  cRetValue:= alltrim( transform( cString , cFormat ) )

               Else

                  cRetValue:= alltrim( transform( cString , cFormat ) )

               EndIf

          Case ValType( cString ) == 'M'

               cRetValue:= If( Len(cString) > (Memory(0) * 1024) * .80, ;
                               Left(cString, Int( (Memory(0)*1024)*.80) ), cString )

          Case ValType( cString ) == 'D'

               cRetValue:= Dtoc( cString )

          Case ValType( cString ) == 'L'

               cRetValue:= If( OnOff, If(cString, 'On', 'Off'), ;
                                      If(cString, 'True', 'False') )

       EndCase

Return( cRetValue )
*
*
*--------------------------------------------------------------------------------------------------
Function Alertar(expC1,expA2,expC3)

         /*
             <expC1>    Mensagem de Alertar
             <expA2>    Array com Opcoes de Retorno
             <expC3>    Expressao de Cores do Video
         */

         Local Fundo   := SaveScreen() ,;
               Corant  := SetColor()   ,;
               Curant  := SetCursor()  ,;
               MsgAlert:= {}           ,;
               PxyAlert:= Array(4)     ,;
               TamAlert:= 00           ,;
               IniAlert:= 01           ,;
               MenAlert:= space(01)    ,;
               OpcAlert:= 00

         expC1:= If( Empty(expC1) , 'ERRO' , expC1 )
         expA2:= If( Empty(expA2) , { ' Ok ' }    , expA2 )
         expC3:= If( Empty(expC3) , 'R/W,W+/R'    , expC3 )

         SetColor(expC3)
         SetCursor(0)

         While At(';',expC1) > 0

               Aadd( MsgAlert , Substr( expC1 , 1 , At(';',expC1)-1 ) )

               expC1   := Substr( expC1 , At(';',expC1)+1 )
               TamAlert:= If( Len( MsgAlert[Len(MsgAlert)] ) > TamAlert , ;
                              Len( MsgAlert[Len(MsgAlert)] )     , ;
                              TamAlert )

         EndDo

         Aadd( MsgAlert , expC1 )

         TamAlert:= If( Len( MsgAlert[Len(MsgAlert)] ) > TamAlert , ;
                        Len( MsgAlert[Len(MsgAlert)] )     , ;
                        TamAlert )

         MenAlert:= expA2[1]

         For IniAlert:= 2 to Len(expA2)

             MenAlert+= Space(03) + expA2[IniAlert]

         EndFor

         TamAlert:= If( Len( MenAlert ) > TamAlert , ;
                        Len( MenAlert ) , TamAlert )

         PxyAlert[1]:= Int( ( 24 - ( Len(MsgAlert) + 6 ) ) / 2 )
         PxyAlert[2]:= Int( ( 80 - ( TamAlert + 4      ) ) / 2 )
         PxyAlert[3]:= PxyAlert[01] + Len(MsgAlert) + 3
         PxyAlert[4]:= PxyAlert[02] + TamAlert      + 3

         DispBox( PxyAlert[1], PxyAlert[2], PxyAlert[3], PxyAlert[4],    ;
                  Chr(219)+Chr(223)+Chr(219)+Chr(219)+Chr(219)+Chr(220)+ ;
                  Chr(219)+Chr(219)+' ' )

         For IniAlert:= 1 to Len(MsgAlert)

             DevPos( PxyAlert[1] + IniAlert , PxyAlert[2]+2 )
             DevOut( Padc( MsgAlert[IniAlert] , TamAlert ) )

         EndFor

         MenAlert:= Int( ( 79 - Len( AllTrim(MenAlert) ) ) / 2 ) - 3

         While OpcAlert == 0

               DevPos( PxyAlert[1] + 2 + Len(MsgAlert) , MenAlert )

               For IniAlert:= 1 to Len(expA2)

                   @ PxyAlert[1] + 2 + Len(MsgAlert) , Col() + 3 Prompt expA2[IniAlert]

               EndFor

               Menu To OpcAlert

         EndDo

         SetColor( Corant )
         SetCursor( Curant )
         RestScreen(,,,,Fundo)

RETURN( OpcAlert )
*
*
*--------------------------------------------------------------------------------------------------
STATIC FUNCTION FGravaTxt(cArq, cText)
   *
   IF FILE(cArq)
      *
      FHandle := FOpen(cArq, 2 )
      FSeek(FHandle, 0, 2 )
      *
   ELSE
      *
      FHandle := FCreate(cArq, 0 )
      *
   ENDIF
   *
   Fwrite(     FHandle, cText )
   FWriteLine( FHandle, "" )
   *
   FClose(FHandle )
   *
RETURN( NIL )
*
*
*--------------------------------------------------------------------------------------------------
STATIC FUNCTION FWriteLine( nHandle, cString )
   *
   Fwrite( nHandle, cString )
   Fwrite( nHandle, chr(13) )
   Fwrite( nHandle, chr(10) )
   *
Return( Nil )

Esta rotina cria um arquivo para cada ocorrência de erro, incrementando o nome do arquivo ErrorLog. Desta forma posso rastrear a sequência de erros mais facilmente.

Olá...

E como usar hasse... ?

Só salvar como errorsys.prg e compilar junto com o sistema ?

Obrigado
Rubens

Basta incluir a chamada logo após o início....

Código: Selecionar todos

FUNCTION MAIN()
*
LOCAL oERR := ERRORBLOCK( { | oERROR | ERRORLOG( oERROR ) } )

e compilar. Só......... rsrsrsrs....

Bom dia...
Tá faltando a função descrerro()
Linha 117
Obrigado
Rubens

Segue no Anexo.

Ainda não está funcionando a contento. Veja se te dá um tempo para arredondar esta função.

PC Toledo

harbour hb_funcPtr

harbour hb_funcPtr

harbour hb_funcPtr

harbour hb_funcPtr

harbour hb_funcPtr

harbour hb_funcPtr

harbour hb_funcPtr

harbour hb_funcPtr

harbour hb_funcPtr

harbour hb_funcPtr