Page 1 of 1

Please make a visual update for errorsysw

Posted: Wed Sep 11, 2019 6:53 am
by Uwe.Diemer
No changes in the last 20 Years

Tx

Re: Please make a visual update for errorsysw

Posted: Wed Sep 11, 2019 7:39 am
by cnavarro
I agree
Please feel free to expose your ideas and if possible an image that inspires us all. I also believe that there are many users that have their own versions of this functionality that they could share as well.

Re: Please make a visual update for errorsysw

Posted: Wed Sep 11, 2019 5:01 pm
by TimStone
I modified the program in several ways for my specific needs:
1). I provide the actual name of the DBF file rather than the alias the system creates
2). I've added more info on the compiler, linker, and API being used
3). I've added in the workstation that failed, user name, etc.

Thus the report is more helpful because it automatically attaches to an email sent from the system, and helps me to diagnose where the problem occurs.

Since it is simply data we need to professionally diagnose a problem, I'm not sure how it could be improved visually that would be of benefit. However, it might be nice if we could add to the dialog box a programmable spot for what the end user should do at that point, ie. an email or phone number to communicate with for support, and perhaps also a programmable method for automatically sending the error report to a remote location.

Re: Please make a visual update for errorsysw

Posted: Wed Sep 11, 2019 7:23 pm
by Silvio.Falconi
I remember there is an apportation of Ing. Stephan Haupt ( ripped) but I not remember where I saved it perhaps Linares have a copy

Re: Please make a visual update for errorsysw

Posted: Fri Sep 13, 2019 1:29 pm
by ORibeiro
See my ERRSYSW.PRG modified:

Code: Select all

* fErro.prg
* 02/03/2001
* OASyS Informatica
* Adaptacao da rotina ( c:\fw20\source\function\ERRSYSW.PRG )
* Error handler system adapted to FiveWin

#include "error.ch"
#include "fivewin.ch"
external _fwGenError // Link FiveWin generic Error Objects Generator

*--------------------------------------------------------------------------*
Proc ErrorSys()      // Automaticamente chamada ao executar o sistema
*--------------------------------------------------------------------------*
    ErrorBlock( { | e | ErrorDialog( e ) } )
Return

*--------------------------------------------------------------------------*
Proc ErrorLink()
*--------------------------------------------------------------------------*
Return

*--------------------------------------------------------------------------*
Static Function ErrorDialog( e ) // -> logical or quits App.
*--------------------------------------------------------------------------*
   local oDlg, oLbx, oFont, oChk, lChk:=.T.
   local lRet    // if lRet == nil -> default action: QUIT
   local n, j, cMessage, aStack := {}
   local oSay, hLogo
   local aRDDs, nTarget, uValue
   local oOldError
   local cRelation
   local aVersions := GetVersion()
   local aTasks    := GetTasks()
   local lIsWinNT  := IsWinNT()
   local nButtons  := 1
   local cErrorLog := ""
   local cErrorOAS := ""
   local cPrograma := ""
   if Left(Type("cErrorOAS1"),1)="U"
      PUBLIC cErrorOAS1  := ""
   endif


   // Aplicação que estava sendo executada //
   cErrorLog += "Aplicacao" + CRLF
   cErrorLog += "=========" + CRLF
   cErrorLog += "   Erro ocorrido em..: " + DToC( mmdate ) + " as " + Time() + " horas" + CRLF
   cErrorLog += "   Aplicativo........: " + GetModuleFileName( GetInstance() ) + CRLF
   cErrorLog += "   Versao............: " + mVersao +CRLF
   if Left(Type("MMDTREORG"),1)="D" .AND. !Empty(MMDTREORG)
    cErrorLog+= "   BD Organizado em..: " + DTOC( MMDTREORG ) + " a " + alltrim(str(Date()-MMDTREORG,5)) + " dias." +CRLF
   endif
   cErrorLog += "   Computador\Usuario: " + Alltrim(NetName())+"\"+Alltrim(wNetGetUser())+"\"+pOperador +CRLF
*  cErrorLog += "   Tamanho...........: " + Alltrim(Transform( FSize( GetModuleFileName( GetInstance() ) ), "@E 999,999,999,999 bytes" )) + CRLF
*  cErrorLog += "   Maximo de arquivos: SetHandleCount( "+Alltrim(Str( SetHandleCount(), 3 ))+" )" + CRLF
   cMessage   = "   Descricao do erro.: " + Alltrim(ErrorMessage( e )) + CRLF
   cErrorLog += cMessage
   if ValType( e:Args ) == "A"
      cErrorLog += "   Args:" + CRLF
      cErrorLog += "   Args:" + CRLF
      for n = 1 to Len( e:Args )
         cErrorLog += "     [" + Str( n, 4 ) + "] = " + ValType( e:Args[ n ] ) + ;
                      "   " + cValToChar( e:Args[ 1 ] ) + CRLF
      next
   endif


   cErrorLog += CRLF + "Sequencia de erros" + CRLF
   cErrorLog +=        "==================" + CRLF
   n := 2    // we don't disscard any info again !
   while ( n < 74 )
      if !Empty(ProcName(n)).AND.; // Se identificar o nome do programa
         !Empty(ProcLine(n))       // Se identificar a linha do erro
         AAdd( aStack, "   Programa: " + PadR( ProcName( n ) ,17) + ;
                         " Linha: " + AllTrim(Str( ProcLine( n ) )) )
         cErrorLog += ATail( aStack ) + CRLF
         cPrograma := iif(Empty(cPrograma), Upper(Alltrim(ProcName( n ))), cPrograma)
      endif
      n++
   end


   cErrorLog += CRLF + "Avaliacao do Sistema " + CRLF
   cErrorLog +=        "=====================" + CRLF
   cErrorLog += "   Sistema Operacional.......: " + os() + " " + iif(Os_IsWtsClient(),"(TS)","") + iif(IsWin64(),"(64)","") + CRLF
   cErrorLog += "   Memoria Fisica............: " + cValToChar( nExtMem() + 768 ) + " (" + cValToChar( Int( ( nExtMem() + 768 ) / 1024 ) ) + " megas)" + CRLF
*  cErrorLog += "   CPU tipo..................: " + GetCPU() + " ou superior" + CRLF
*  cErrorLog += "   CPU tipo..................: " + { "386", "486", "Pentium" }[ CPUType() - 2 ] + CRLF
*  cErrorLog += "   Versoes do Windows / MsDos: " + Alltrim(Str( aVersions[ 1 ], 8 )) + "." + Alltrim(Str( aVersions[ 2 ], 8 )) + " / " + Alltrim(Str( aVersions[ 3 ], 8 )) + "." + Alltrim(Str( aVersions[ 4 ], 8 )) + CRLF
*  cErrorLog += "   Recursos Livres do Sistema: " + AllTrim(Str( GetFreeSystemResources( 0 ) )) + "% - GDI: " + AllTrim(Str( GetFreeSystemResources( 1 ) )) + "% - Usuario: " + AllTrim(Str( GetFreeSystemResources( 2 ) )) + "%" + CRLF
*  cErrorLog += "   Lista de programas abertos: Aplicacoes( " + AllTrim(Str(GetNumTasks()))+ " )" + CRLF
*  for n = 1 to Len( aTasks )
*     cErrorLog += "    " + Str( n, 3 ) + " " + aTasks[ n ] + CRLF
*  next


*  // Analise da memória //
*  cErrorLog += CRLF + "Analise da memoria" + CRLF
*  cErrorLog +=        "==================" + CRLF
*  cErrorLog += "   Memoria estatica:" + CRLF
*  cErrorLog += "      Segmento de dados.: 64k" + CRLF
*  cErrorLog += "      Tamanho inicial...: " + ;
*               AllTrim(Str( nInitDSSize() )) + ;
*               " bytes  (SYMP=" + AllTrim(Str( nSymPSize() )) + ;
*               ", Stack=" + AllTrim(Str( nStackSize() )) + ;
*               ", Heap="  + AllTrim(Str( nHeapSize()  )) + ")" + CRLF
*  cErrorLog += "      Clipper Stack.....: " + ;
*               AllTrim(Str( 65535-(nStatics()*14)-nInitDSSize() )) + ;
*               " bytes" + CRLF
*  cErrorLog += "      Variveis estaticas: " + AllTrim(Str( nStatics() )) + ;
*               " usando " + AllTrim(Str( nStatics() * 14 )) + " bytes" + CRLF + CRLF
*  cErrorLog += "   Memoria dinamica:" + CRLF
*  cErrorLog += "      Valor Atual.......: " + AllTrim(Str( MemUsed() )) + " bytes" + CRLF
*  cErrorLog += "      Valor Maximo......: " + AllTrim(Str( MemMax()  ))  + " bytes" + CRLF


*  // nSymNames() no longer returns a real value! 15/April/97
*  cErrorLog += "   SYMBOLS segment.:" + CRLF
*  cErrorLog += "      " + AllTrim(Str( nSymNames() )) + " SymbolNames:   " + ;
*                AllTrim(Str( nSymNames() * 16 )) + " bytes"


   // Variável para gravar arquivo (OA_LOG.ERR) //
*  cErrorOAS := if(File(pDado+"OA_LOG.ERR"),MemoRead(pDado+"OA_LOG.ERR"),"")
   cErrorOAS += Replicate("*",78) + CRLF
   cErrorOAS += cErrorLog
   cErrorOAS += Replicate("*",78) + CRLF


   // 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 .or. e:osCode == 5 ) .and. ;
        e:canDefault )
*      if INT(e:Tries/10)*10==e:Tries
*         MsgStop("Erro na abertura do arquivo! Nº de Tentativas: "+StrZero(e:Tries/10,6)+chr(13)+chr(13)+Alltrim(cMessage)+chr(13)+;
*                 "Aguarde até que o arquivo esteja disponível na rede e então, pressione <OK>.","Falha na comunicação com o banco de dados")
*      endif
      NetErr( .t. )
      return .f.       // Warning: Exiting!
   end

   // for network create error, set NETERR() and subsystem default
   if ( e:genCode == EG_CREATE              .and. ;
      ( e:osCode == 32 .or. e:osCode == 5 ) .and. ;
        e:canDefault )
      if INT(e:Tries/10)*10==e:Tries
         MsgStop("Não consegui criar o arquivo! Nº de Tentativas: "+StrZero(e:Tries/10,6)+chr(13)+chr(13)+Alltrim(cMessage)+chr(13)+;
                 "Verifique se outro usuário está executando essa mesma rotina na sua rede e em caso afirmativo aguarde a liberação porque essa função não pode ser executada por mais de uma pessoa ao mesmo tempo; depois disso, pressione <OK>.","Mensagem do Banco de Dados")
      endif
      NetErr( .t. )
      return .t.       // Mostra erro de criação e permanece na tela enquanto o arquivo não for liberado!
   end

   // for lock error during APPEND BLANK, set NETERR() and subsystem default
   if ( e:genCode == EG_APPENDLOCK          .and.;
        e:canDefault )
*      if INT(e:Tries/10)*10==e:Tries
*         MsgStop("Erro na criação de um novo registro no arquivo! Nº de Tentativas: "+StrZero(e:Tries/10,6)+chr(13)+chr(13)+Alltrim(cMessage)+chr(13)+;
*                 "Aguarde até que o arquivo esteja disponível na rede e então, pressione <OK>.","Falha na comunicação com o banco de dados")
*      endif
      NetErr( .t. )
      return .f.       // Warning: Exiting!
   endif

   // for error in Memo Fields and subsystem default
   if ( "DBFCDX/2006"$cMessage              .and.;
        e:canDefault )
*      NetErr( .t. )
      return .f.       // Warning: Exiting!
   endif

   // for error in Incompatible type field and subsystem default
   if ( "DBFCDX/1020"$cMessage              .and.;
        e:canDefault )
*      NetErr( .t. )
      return .f.       // Warning: Exiting!
   endif

   // for error in Index on SQLRDD default
   if "Indice ou tag inv"$cMessage
      cMessage = cMessage + " (O INDEX ESTA FECHADO OU ELE NAO EXISTE NA TABELA)."
   endif

   // erros nos indices do arquivo //
   if "DBFCDX/1201"$cMessage .OR. "Read error on index heading"$cMessage
      cMessage := cMessage + " (Indices corrompidos)."
      MsgWait1("(Atenção:) Organize imediatamente o seu banco de dados 'Menu: Utilitários / Organização...'   Não utilize rede sem fio 'Wireless' e mantenha _ bem conectados.", cMessage, 5, .T.)
   endif

   // Erro ao salvar a planilha do Excel //
   if "DISP_E_MEMBERNOTFOUND"$cMessage
      if "EXCEL"$cPrograma
         MsgAlert("(ATENÇÃO) Utilize a versão COMPLETA e atualizada do MS-Excel."+chr(13)+chr(13)+"O 'Office Start Edition' não contém todas as funções necessárias para a geração automática de planilhas.","(OASyS) Excel")
      endif
      return .f.       // Warning: Exiting!
   endif

   // erro: variável não existe: nova versão sem organização //
*  if "BASE/1003"$cMessage
*     cMessage := cMessage + " (A ORGANIZAÇÃO É NECESSÁRIA NA INSTALAÇÃO DE UMA NOVA VERSÃO)."
*     MsgWait("(Atenção:) Organize imediatamente o seu banco de dados 'Menu: Utilitários / Organização...'   Não utilize rede sem fio 'Wireless' e mantenha _ bem conectados.",cMessage,5)
*  endif

   // erros de conexão da estação com o servidor, normalmente com rede sem fio //
   if "DBFCDX/1004"$cMessage .OR. "DBFCDX/1010"$cMessage // 1004=Erro de criação, 1010=Erro de leitura
      // Verifica se o erro foi no arquivo (RGSYS).DBF da empresa e então o apaga //
      cDbf  := Alltrim(pRGSyS)
      cDbf  := StrAlfaNum(cDbf)
      cDbf  := Upper(pPath+StrTran(cDbf,' ','')+".DBF")
      cDbf1 := SUBST(cDbf, RAT("\",cDbf)+1, Len(cDbf) )
      cDbf2 := Upper(Right(cMessage,Len(cDbf)))
      cDbf2 := SUBST(cDbf2,RAT("\",cDbf2)+1,Len(cDbf1))
      if cDbf1 == cDbf2
         DbCloseAll()
         FnErase( cDbf1 )   // Apaga arquivo corrompido
         if !_File( cDbf1 ) // Força a saída do sistema
            SET RESOURCES TO
//          ResAllFree()
            ErrorLevel( 1 )
            QUIT
         else
            MsgStop("O arquivo: "+cDbf+" está corrompido!"+chr(13)+chr(13)+"Para evitar esse erro, apague esse arquivo do seu banco de dados que o sistema irá cria-lo novamente.", cMessage)
         endif
      endif
   endif

   if ProcName( 7 ) == "ERRORDIALO"   // recursive error !!!
      SET RESOURCES TO
//    ResAllFree()
      ErrorLevel( 1 )
      QUIT
   endif


   if e:canRetry
      nButtons++
   endif
   if e:canDefault
      nButtons++
   endif


   // RDDs Usadas no BD //
   cErrorLog += CRLF + "RDDs ligadas" +;
                CRLF + "============" + CRLF
   aRDDs = RddList( 1 )
   for n = 1 to Len( aRDDs )
      cErrorLog += "   " + aRDDs[ n ] + CRLF
   next


   // Aliases Criados //
   if Type("aAliasDes")<>"U"
      cErrorLog += CRLF + "Alias usados:" + CRLF
      cErrorLog +=        "=============" + CRLF
      For n = 1 To Len(aAliasDes)
         if aAliasQtd[ n ] > 1
            cErrorLog += "   " + aAliasDes[ n ] + " = " + Alltrim(Str(aAliasQtd[ n ],4)) + CRLF
         endif
      Next
   endif


   // Arquivos Abertos //
   cErrorLog += CRLF + "Arquivos em uso" +;
                CRLF + "===============" + CRLF
   for n = 1 to 255
      if ! Empty( Alias( n ) )
         cErrorLog += CRLF + Str( n, 3 ) + ": " + If( Select() == n,"=> ", "   " ) + ;
                      PadR( Alias( n ), 15 ) + Space( 20 ) + "RddName: " + ;
                      ( Alias( n ) )->( RddName() ) + CRLF
         cErrorLog += "     ==============================" + CRLF
         cErrorLog += "     RegNo    RegCont     BOF   EOF" + CRLF
         cErrorLog += "    " + Transform( ( Alias( n ) )->( RecNo() ), "99999" ) + ;
                      "      " + Transform( ( Alias( n ) )->( RecCount() ), "99999" ) + ;
                      "      " + cValToChar( ( Alias( n ) )->( BoF() ) ) + ;
                      "   " + cValToChar( ( Alias( n ) )->( EoF() ) ) + CRLF + CRLF
         cErrorLog += "     Indices usados " + Space( 23 ) + "TagName" + CRLF
         for j = 1 to 15
            if ! Empty( ( Alias( n ) )->( IndexKey( j ) ) )
               cErrorLog += Space( 8 ) + ;
                            If( ( Alias( n ) )->( IndexOrd() ) == j, "=> ", "   " ) + ;
                            PadR( ( Alias( n ) )->( IndexKey( j ) ), 35 ) + ;
                            ( Alias( n ) )->( OrdName( j ) ) + ;
                            CRLF
            endif
         next
         cErrorLog += CRLF + "     Relacoes usadas" + CRLF
         for j = 1 to 8
            if ! Empty( ( nTarget := ( Alias( n ) )->( DbRSelect( j ) ) ) )
               cErrorLog += Space( 8 ) + Str( j ) + ": " + ;
                            "TO " + ( Alias( n ) )->( DbRelation( j ) ) + ;
                            " INTO " + Alias( nTarget ) + CRLF
               // uValue = ( Alias( n ) )->( DbRelation( j ) )
               // cErrorLog += cValToChar( &( uValue ) ) + CRLF
            endif
         next
      endif
   next


   // Classes Usadas //
   n = 1
   cErrorLog += CRLF + "Classes usadas:" + CRLF
   cErrorLog +=        "===============" + CRLF
   while ! Empty( __ClassName( n ) )
      cErrorLog += "   " + Str( n, 3 ) + " " + __ClassName( n++ ) + CRLF
   end


   // Variáveis usadas //
   cErrorLog += CRLF + "Variaveis usadas" + CRLF + "================" + CRLF
   cErrorLog += "   Programa        Tipo Valor" + CRLF
   cErrorLog += "   =============== ==== =====" + CRLF
   n := 2    // we don't disscard any info again !
   while ( n < 74 )
       if ! Empty( ProcName( n ) )
          cErrorLog += "   " + Trim( ProcName( n ) ) + CRLF
          for j = 1 to ParamCount( n )
             cErrorLog += "     Param " + Str( j, 3 ) + ":    " + ;
                          ValType( GetParam( n, j ) ) + ;
                          "    " + TrocAcentos(cGetInfo( GetParam( n, j ) )) + CRLF
          next
          for j = 1 to LocalCount( n )
             cErrorLog += "     Local " + Str( j, 3 ) + ":    " + ;
                          ValType( GetLocal( n, j ) ) + ;
                          "    " + TrocAcentos(cGetInfo( GetLocal( n, j ) )) + CRLF
          next
       endif
       n++
   end

   // Situações em que o erro não precisa ser enviado para a OASyS Informatica //
   // "has no exported method"$cMessage     .OR.;
   // "Message not found"$cMessage          .OR.;
   // "EXCEPTION_ACCESS_VIOLATION"$cMessage .OR.;
   // "Workarea nÆo indexada"$cMessage      .OR.;
   lChk := .T.
   IF "Alias nÆo existe"$cMessage           .OR.;
      "Workarea nÆo est  em uso"$cMessage   .OR.;
      "Erro de leitura"$cMessage            .OR.;
      "Erro de abertura"$cMessage           .OR.;
      "Cannot create Dialog Box"$cMessage   .OR.;
      "Word.Application"$cMessage           .OR.;
      "Excel.Application"$cMessage          .OR.;
      "S_OK"$cMessage                       .OR.;
      "CELLS"$cMessage
      lChk := .F.
   ENDIF

   // Warning!!! Keep here this code !!! Or we will be consuming GDI as
   // we don't generate the error but we were generating the bitmap
   hLogo = LoadBitmap( GetResources(), "ERRO" ) // hLogo = FWBitMap()

   // Tira os acentos da Mensagem do Erro //
   cMessage := TrocAcentos( cMessage, "DOS" )

   // Mostra na Tela //
   DEFINE FONT oFont  NAME "Ms Sans Serif" SIZE 0, -10
   DEFINE DIALOG oDlg SIZE 500, 425 + If( lIsWinNT, 50, 0 ) TITLE "(OASyS) Ocorrência - Versão: "+mVersao FONT oFont // TRANSPARENT

      // Descrição do Erro //
      @ 000,03 GROUP TO 085,245 FONT oFont TRANSPARENT Pixel
      @ 025,06 SAY "Erros:" SIZE  15,10 COLOR CLR_HRED FONT oFont OF oDlg PIXEL
      @ 005,25 SAY cMessage SIZE 218,77 COLOR CLR_RED  FONT oFont OF oDlg CENTERED PIXEL
      n = aStack[ 1 ]

      // Sequencia de erros //
      @ 090,03 LISTBOX oLbx VAR n ITEMS aStack OF oDlg SIZE 245, 55 + If( lIsWinNT, 18, 0 ) PIXEL

      // CheckBox   //
      @ 157,05 CHECKBOX oChk VAR lChk PROMPT "Quer nos ajudar a identificar e corrigir esse erro?" SIZE 245,08 COLOR CLR_HRED FONT oFont OF oDlg PIXEL ON CHANGE iif(lChk, oGet:Enable(), oGet:Disable())
      @ 165,13.5 SAY "Por favor, descreva abaixo como podemos reproduzí-lo." SIZE 145,08 COLOR CLR_HRED FONT oFont OF oDlg PIXEL

      // Campo Memo //
      cInfo := Space( 1000 )
      @ 173,03 GET oGet VAR cInfo SIZE 244,45 VALID (iif(!Empty(cInfo), lChk:=.T.,), oChk:Refresh(), .T.) COLOR CLR_RED FONT oFont OF oDlg PIXEL
      oGet:cToolTip := "Informe nesse campo quais janelas estavam abertas no momento desse erro e, por favor, tente lembrar a sequência de <cliques> e <enters> que você pressionou até aqui. Assim, você nos ajudará a corrigir esse erro!"
      // oGet:bLostFocus := {|| (iif(!Empty(cInfo), lChk:=.T.,), oChk:Refresh()) }

    if e:CanRetry
      @ 198 + If( lIsWinNT, 24, 0 ),003 BUTTON "&Forçar"   OF oDlg ACTION (lRet:=.t.,oDlg:End()) SIZE 30, 12 FONT oFont PIXEL
    endif
    if e:CanDefault
      @ 198 + If( lIsWinNT, 24, 0 ),109 BUTTON "&Continuar" OF oDlg ACTION (lRet:=.f.,oDlg:End()) SIZE 30, 12 FONT oFont PIXEL
    endif
      @ 198 + If( lIsWinNT, 24, 0 ),218 BUTTON "&Sair"      OF oDlg ACTION oDlg:End()             SIZE 30, 12 FONT oFont PIXEL

   ACTIVATE DIALOG oDlg CENTERED RESIZE16 ON PAINT (DrawBitmap( hDC, hLogo, 6, 6 ), oGet:SetFocus())
   DeleteObject( hLogo )
   oFont:End()

   // Motivo do erro digitado pelo usuário  //
   cInfo = Alltrim( cInfo )
   if !Empty( cInfo )
      cErrorLog = "Motivo do erro informado pelo usuario" + CRLF +;
                  "=====================================" + CRLF +;
                   cInfo + CRLF + CRLF + cErrorLog
   endif

   // Grava arquivos ERROR.LOG e OA_LOG.ERR //
   BEGIN SEQUENCE
      oOldError = ErrorBlock( { || DoBreak() } )
      if lChk
         MemoWrit( pPath+"Error.log",  cErrorLog )
      endif
      if     !file(pPath+"OA_LOG.ERR")   // Se o arquivo não existe...
         MemoWrit( pPath+"OA_LOG.ERR", cErrorOAS )
      elseif Empty(cErrorOAS1)           // Se é não é uma repetição do erro (Botão Continue)
         nArqHandle := FOpen(pPath+"OA_LOG.ERR",2+64) // Gravação e Compartilhado
         if FError()=0
            // Encontra o Fim do Arquivo //
            cErrorOAS1 := Space(250)
            DO WHILE FREAD(nArqHandle,@cErrorOAS1,250)<>0
            ENDDO
            cErrorOAS1 := cErrorOAS
            // Grava no Fim do Arquivo   //
            FWrite(nArqHandle,cErrorOAS)
            FClose(nArqHandle)
         endif
      endif
   END SEQUENCE
   ErrorBlock( oOldError )

   // Encerra a tela do Erro //
   if lRet == nil .or. ( !LWRunning() .and. lRet )
   // SET RESOURCES TO ***Comando retirado pois qdo o mvend é fechado causa erro no prog. wNotas.exe se ele estiver aberto.
//    ResAllFree()
      ErrorLevel( 1 )
      QUIT                          // must be QUIT !!!
   elseif File( pPath+"Error.log" ) // Se criou o arquivo, mas deseja continuar...
      FErase( pPath+"Error.log" )
   endif
return lRet

*--------------------------------------------------------------------------*
static function DoBreak()
*--------------------------------------------------------------------------*
   BREAK
return nil

*--------------------------------------------------------------------------*
static func ErrorMessage( e )
*--------------------------------------------------------------------------*
    // start error message
    local cMessage := if( empty( e:OsCode ), ;
                          if( e:severity > ES_WARNING, "Erro ", "Alerta " ),;
                          "(DOS Error " + AllTrim(Str(e:osCode)) + ") " )
    // add subsystem name if available
    cMessage += if( ValType( e:SubSystem ) == "C",;
                    e:SubSystem()                ,;
                    "???" )
    // add subsystem's error code if available
    cMessage += if( ValType( e:SubCode ) == "N",;
                    "/" + AllTrim(Str( e:SubCode )),;
                    "/???" )
    // add error description if available
    if ( ValType( e:Description ) == "C" )
        cMessage += "  " + e:Description
    end
    // add either filename or operation
    cMessage += if( ! Empty( e:FileName ),;
                    ": " + e:FileName   ,;
                    if( !Empty( e:Operation ),;
                        ": " + e:Operation   ,;
                        "" ) )
return cMessage

*--------------------------------------------------------------------------*
static function cGetInfo( uVal ) // retorna extended info for a certain variable type
*--------------------------------------------------------------------------*
   local cType := ValType( uVal )
   do case
      case cType == "C"
           return '"' + cValToChar( uVal ) + '"'
      case cType == "O"
           return "Class: " + uVal:ClassName()
      case cType == "A"
           return "Len: " + Str( Len( uVal ), 4 )
      otherwise
           return cValToChar( uVal )
   endcase
return nil

*--------------------------------------------------------------------------*
* Funcao para evitar erro "tela branca" do Windows                         *
*--------------------------------------------------------------------------*
DLL FUNCTION SetErrorMode( nMode AS WORD ) AS WORD PASCAL LIB "KERNEL"
Return nil


///////////////////////////////
// ROTINA PARA LER GPR ERROR //
///////////////////////////////
// __GenGpf() // msgstop( "-Simula erro GPF-" )
#include "hbexcept.ch"
********************************
Function GpfHandler( Exception )
********************************
   local cMsg, nCode, oError
** TraceLog( "GPF:", Exception )
** memowrit( "gpf.txt", valtoprg( Exception ) )
   IF Exception <> NIL
      nCode := Exception:ExceptionRecord:ExceptionCode
      SWITCH nCode
      CASE EXCEPTION_ACCESS_VIOLATION
         cMsg := "EXCEPTION_ACCESS_VIOLATION - Tentativa de ler/escrever onde o usuário não tem acesso."
         EXIT
      CASE EXCEPTION_DATATYPE_MISALIGNMENT
         cMsg := "EXCEPTION_DATATYPE_MISALIGNMENT - O thread tentou ler/escrever dados desalinhados em hardware que não oferece alinhamento. Por exemplo, valores de 16 bits precisam ser alinhados em limites de 2 bytes; valores de 32 bits em limites de 4 bytes, etc. "
         EXIT
      CASE EXCEPTION_ARRAY_BOUNDS_EXCEEDED
         cMsg := "EXCEPTION_ARRAY_BOUNDS_EXCEEDED - O thread tentou acessar um elemento de array fora dos limites e o hardware possibilita a checagem de limites."
         EXIT
      CASE EXCEPTION_FLT_DENORMAL_OPERAND
         cMsg := "EXCEPTION_FLT_DENORMAL_OPERAND - Um dos operandos numa operação de ponto flutuante está desnormatizado. Um valor desnormatizado é um que seja pequeno demais para poder ser representado no formato de ponto flutuante padrão."
         EXIT
      CASE EXCEPTION_FLT_DIVIDE_BY_ZERO
         cMsg := "EXCEPTION_FLT_DIVIDE_BY_ZERO - O thread tentou dividir um valor em ponto flutuante por um divisor em ponto flutuante igual a zero."
         EXIT
      CASE EXCEPTION_FLT_INEXACT_RESULT
         cMsg := "EXCEPTION_FLT_INEXACT_RESULT - O resultado de uma operação de ponto flutuante não pode ser representado como uma fração decimal exata."
         EXIT
      CASE EXCEPTION_FLT_INVALID_OPERATION
         cMsg := "EXCEPTION_FLT_INVALID_OPERATION - Qualquer operação de ponto flutuante não incluída na lista."
         EXIT
      CASE EXCEPTION_FLT_OVERFLOW
         cMsg := "EXCEPTION_FLT_OVERFLOW - O expoente de uma operação de ponto flutuante é maior que a magnitude permitida pelo tipo correspondente."
         EXIT
      CASE EXCEPTION_FLT_UNDERFLOW
         cMsg := "EXCEPTION_FLT_UNDERFLOW - O expoente de uma operação de ponto flutuante é menor que a magnitude permitida pelo tipo correspondente."
         EXIT
      CASE EXCEPTION_INT_DIVIDE_BY_ZERO
         cMsg := "EXCEPTION_INT_DIVIDE_BY_ZERO - O thread tentou dividir um valor inteiro por um divisor inteiro igual a zero."
         EXIT
      CASE EXCEPTION_INT_OVERFLOW
         cMsg := "EXCEPTION_INT_OVERFLOW - O resultado de uma operação com _ uma transposição (carry) além do bit mais significativo do resultado."
         EXIT
      CASE EXCEPTION_PRIV_INSTRUCTION
         cMsg := "EXCEPTION_PRIV_INSTRUCTION - O thread tentou executar uma instrução cuja operação não é permitida no modo de máquina atual."
         EXIT
      CASE EXCEPTION_IN_PAGE_ERROR
         cMsg := "EXCEPTION_IN_PAGE_ERROR - O thread tentou acessar uma página que não estava presente e o sistema não foi capaz de carregar a página. Esta exceção pode ocorrer, por exemplo, se uma conexão de rede é perdida durante a execução do programa via rede."
         EXIT
      CASE EXCEPTION_ILLEGAL_INSTRUCTION
         cMsg := "EXCEPTION_ILLEGAL_INSTRUCTION - O thread tentou executar uma instrução inválida."
         EXIT
      CASE EXCEPTION_NONCONTINUABLE_EXCEPTION
         cMsg := "EXCEPTION_NONCONTINUABLE_EXCEPTION - O thread tentou continuar a execução após a ocorrência de uma exceção irrecuperável."
         EXIT
      CASE EXCEPTION_STACK_OVERFLOW
         cMsg := "EXCEPTION_STACK_OVERFLOW - O thread esgotou sua pilha (estouro de pilha)."
         EXIT
      CASE EXCEPTION_INVALID_DISPOSITION
         cMsg := "EXCEPTION_INVALID_DISPOSITION - Um manipulador (handle) de exceções retornou uma disposição inválida para o tratador de exceções. Uma exceção deste tipo nunca deveria ser encontrada em linguagens de médio/alto nível."
         EXIT
      CASE EXCEPTION_GUARD_PAGE
         cMsg := "CASE EXCEPTION_GUARD_PAGE"
         EXIT
      CASE EXCEPTION_INVALID_HANDLE
         cMsg := "EXCEPTION_INVALID_HANDLE"
         EXIT
      CASE EXCEPTION_SINGLE_STEP
         cMsg := "EXCEPTION_SINGLE_STEP Um interceptador de passos ou outro mecanismo de instrução isolada sinalizou que uma instrução foi executada."
         EXIT
      CASE EXCEPTION_BREAKPOINT
         cMsg := "EXCEPTION_BREAKPOINT - Foi encontrado um ponto de parada (breakpoint)."
         EXIT
      CASE EXCEPTION_FLT_STACK_CHECK
         cMsg := "EXCEPTION_FLT_STACK_CHECK - A pilha ficou desalinhada ('estourou' ou 'ficou abaixo') como resultado de uma operação de ponto flutuante."
         EXIT
      DEFAULT
         cMsg := "UNKNOWN EXCEPTION (" + cStr( Exception:ExceptionRecord:ExceptionCode ) + ")"
      END
   ENDIF
** IF cMsg <> NIL
**    Tracelog( "GPF Intercepted!", cMsg )
**    Alert( "GPF Intercepted!" + CRLF + cMsg )
** ENDIF
** Throw( ErrorNew( "GPFHANDLER", 0, 0, ProcName(), "Erro de GPF", { cMsg, Exception, nCode }, Procfile(), Procname(), procline() ) )
   oError := ErrorNew( "GPFHANDLER", 0, 0, ProcName(), cMsg, { cMsg, Exception, nCode }, Procfile(), Procname(), procline() )
   ErrorDialog( oError )
RETURN(EXCEPTION_EXECUTE_HANDLER)

*Eof( fErro.prg )


Re: Please make a visual update for errorsysw

Posted: Fri Sep 27, 2019 1:01 pm
by nnicanor
Some missing functions

Compilando MySQL_utils.PRG...
Enlazando WadmonSQL.exe...
Error: Unresolved external '_HB_FUN_MSGWAIT1' referenced from H:\PROYECTOSFW\SQLWADMON\OBJ\MYSQL_UTILS.OBJ
Error: Unresolved external '_HB_FUN_STRALFANUM' referenced from H:\PROYECTOSFW\SQLWADMON\OBJ\MYSQL_UTILS.OBJ
Error: Unresolved external '_HB_FUN_FNERASE' referenced from H:\PROYECTOSFW\SQLWADMON\OBJ\MYSQL_UTILS.OBJ
Error: Unresolved external '_HB_FUN__FILE' referenced from H:\PROYECTOSFW\SQLWADMON\OBJ\MYSQL_UTILS.OBJ
Error: Unresolved external '_HB_FUN_TROCACENTOS' referenced from H:\PROYECTOSFW\SQLWADMON\OBJ\MYSQL_UTILS.OBJ
Error: Unable to perform link
1 Files, 0 Warnings, 6 Errors
Tiempo de compilación: 0.78s Tiempo de enlazado: 0.96s Tiempo total: 1.80s