FiveTech Software tech support forums

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 )