FiveTech Support Forums

// Error handler system adapted to FiveWin
// ErrSysW.prg

REQUEST HB_CODEPAGE_ESWIN

#include "error.ch"
#include "FiveWin.ch"

#define CLR_FONDO_DLG   nRGB( 255, 40, 0 ) //( 231, 120,  23 ) Naranja mgIdeas
#define CLR_FONDO_LST   nRGB( 255, 254, 203 )

external _fwGenError   // Link FiveWin generic Error Objects Generator

#define NTRIM(n)    ( LTrim( Str( n ) ) )

#ifdef __CLIPPER__
   #define DLG_TITLE "FiveWin: The CA-Clipper for Windows Library"
#else
   #ifdef __HARBOUR__
      #define DLG_TITLE "Manejador de Error ~ mgIdeas © 2009"
      #command QUIT => ( PostQuitMessage( 0 ), __Quit() )
   #else
      #define DLG_TITLE "FiveWin for Xbase++"
   #endif
#endif

/*************
*   ErrorSys()
*
*   Note:  automatically executes at startup
*/
proc ErrorSys()
    ErrorBlock( { | e | ErrorDialog( e ) } )
return

proc ErrorLink()
return


/*************
*   ErrorDialog()
*/
static function ErrorDialog( e ) // -> logical or quits App.

   local oDlg, oLbx, oFont, oBmp, oBrush, oBtn1, oBtn2, oBtn3
   local lRet    // if lRet == nil -> default action: QUIT
   local n, j, cMessage, aStack:= {}
   local oSay, hLogo
   local nButtons := 1
   local cErrorLog:= ""
   local aVersions:= GetVersion()
   local aTasks
   local aRDDs, nTarget, uValue
   local oOldError
   local cRelation

   // 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 )
      NetErr( .t. )
      return .f.       // Warning: Exiting!
   end

   // for lock error during APPEND BLANK, set NETERR() and subsystem default
   if ( e:genCode == EG_APPENDLOCK .and. e:canDefault )
      NetErr( .t. )
      return .f.       // OJO SALIDA
   endif

   HB_SetCodePage( "ESWIN" )
   if Left( ProcName( 7 ), 10 ) == "ERRORDIALO"
      SET RESOURCES TO
      ErrorLevel( 1 )
      QUIT
   endif

   ErrorBlock( {|e| MsgStop( ErrorMessage(e) + " desde ErrorSys, linea:" + ;
                             Str( ProcLine( 1 ), 3 ) ),__quit() } )

   cErrorLog += "Applicación" +CRLF
   cErrorLog += "___________________________________________________" +CRLF +CRLF
   cErrorLog += "Ubicación y Nombre     : " + GetModuleFileName( GetInstance() )
   #ifdef __CLIPPER__
      cErrorLog += " (16 bits)" +CRLF
   #else
      cErrorLog += " (32 bits)" +CRLF
   #endif
   cErrorLog += "Tamaño de la Aplicacion: " + Transform( FSize( GetModuleFileName( GetInstance() ) ), "9,999,999 bytes" ) +CRLF +CRLF

   cErrorLog += "Estación de Trabajo: " + NetName()  +CRLF
   cErrorLog += "Usuario en Sesión: " + NetName( 1 ) +CRLF
   #ifdef __CLIPPER__
      cErrorLog += "Max. Archivos Handles permitidos: ( SetHandleCount() ) " + Str( SetHandleCount(), 3 ) +CRLF
   #endif

   cErrorLog += "Ocurrido el:    " + FechaErr()  +CRLF
   cErrorLog += "Ocurrido a las: " +Time()       +CRLF
   TRY
      cErrorLog += "Transcurrido desde el inicio: "+ TimeFromStart()  +CRLF+CRLF
   CATCH
      cErrorLog += "Transcurrido desde el inicio: N/D"  +CRLF+CRLF
   END

   // Error object analysis
   cMessage  := "Descripción de Error generado: " +CRLF+ ;
                "___________________________________________________"+CRLF +CRLF + ;
                ErrorMessage( e ) +CRLF
   cErrorLog += cMessage

   if ValType( e:Args ) == "A"
      cErrorLog += "   Args:" +CRLF
      for n:= 1 to Len( e:Args )
         cErrorLog += "     [" + Str( n, 4 ) + "] = " + ValType( e:Args[ n ] ) + ;
                      "   " + cValToChar( e:Args[ n ] ) +CRLF
      next
   endif

   cErrorLog += CRLF+CRLF + "Llamadas al Stack:" +CRLF
   cErrorLog += "___________________________________________________" +CRLF +CRLF
      n:= 2    // we don't disscard any info again !
      while ( n < 74 )
          if ! Empty(ProcName( n ) )
             AAdd( aStack, "Llamado desde:  " +ProcFile( n ) +" " +Trim( ProcName( n ) ) + ;
                           "(" + NTRIM( ProcLine( n ) ) + ")" )
             cErrorLog += ATail( aStack ) +CRLF
          endif
          n++
    end

   cErrorLog += CRLF + "System" +CRLF
   cErrorLog += "======" +CRLF

   #ifdef __CLIPPER__
      cErrorLog += "CPU tipo: " + GetCPU() +CRLF
   #else
      cErrorLog += "CPU tipp: " + GetCPU() + " " + AllTrim( Str( GetCPUSpeed() ) ) + " Mhz" +CRLF
   #endif

   cErrorLog += "Memoria del Pc: " + cValToChar( Int( nExtMem() / ( 1024 * 1024 ) ) + 1 ) + ;
                                     " megs" +CRLF +CRLF
   cErrorLog += "Recursos del Sistema:   " + AllTrim( Str( GetFreeSystemResources( 0 ) ) ) + " %" +CRLF + ;
                "Recuros  GDI:           " + AllTrim( Str( GetFreeSystemResources( 1 ) ) ) + " %" +CRLF + ;
                "Recursos para Usuario:  " + AllTrim( Str( GetFreeSystemResources( 2 ) ) ) + " %" +CRLF +CRLF

   cErrorLog += "Versión del Compilador: " + Version() +CRLF

   #ifdef __CLIPPER__
      cErrorLog += "versión de Windows y MsDos: " + ;
                   AllTrim( Str( aVersions[ 1 ] ) ) + "." + ;
                   AllTrim( Str( aVersions[ 2 ] ) ) + ", " + ;
                   AllTrim( Str( aVersions[ 3 ] ) ) + "." + ;
                   AllTrim( Str( aVersions[ 4 ] ) ) + CRLF + CRLF
   #else
      cErrorLog += "versión Windows: " + ;
                   AllTrim( Str( aVersions[ 1 ] ) ) + "." + ;
                   AllTrim( Str( aVersions[ 2 ] ) ) + ", Build " + ;
                   AllTrim( Str( aVersions[ 3 ] ) ) + ;
                   " " + aVersions[ 5 ] + CRLF + CRLF
   #endif

   aTasks:= GetTasks()
   cErrorLog += "Total de aplicaciones Windows en ejecución: " + ;
                AllTrim( Str( Len( aTasks ) ) ) + CRLF
   for n:= 1 to Len( aTasks )
      cErrorLog += "    " + Str( n, 3 ) + " " + aTasks[ n ] + CRLF
   next

   // 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:=  FWBitMap()

   if e:canRetry
      nButtons++
   endif

   if e:canDefault
      nButtons++
   endif

   cErrorLog += CRLF+CRLF + "Variables en uso:" + CRLF + "___________________________________________________" + CRLF + CRLF
   cErrorLog += "Procedimiento Tipo  Valor:" + CRLF
   cErrorLog += "___________________________________________________" + CRLF + 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 ) ) + ;
                          "    " + cGetInfo( GetParam( n, j ) ) + CRLF
          next
          for j = 1 to LocalCount( n )
             cErrorLog += "     Local " + Str( j, 3 ) + ":    " + ;
                          ValType( GetLocal( n, j ) ) + ;
                          "    " + cGetInfo( GetLocal( n, j ) ) + CRLF
          next
       endif

       n++
   end

   cErrorLog += CRLF + "RDD´s Enlazadas" + CRLF + "___________________________________________________" + CRLF + CRLF
   aRDDs = RddList( 1 )
   for n = 1 to Len( aRDDs )
      cErrorLog += "   " + aRDDs[ n ] + CRLF
   next

   cErrorLog += CRLF + "Base de Datos en Uso: " + CRLF + "___________________________________________________" + 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 + CRLF
         cErrorLog += "     RecNo    RecCount    BOF   EOF" + CRLF
         cErrorLog += "    " + Transform( ( Alias( n ) )->( RecNo() ), "9999999" ) + ;
                      "      " + Transform( ( Alias( n ) )->( RecCount() ), "9999999" ) + ;
                      "      " + cValToChar( ( Alias( n ) )->( BoF() ) ) + ;
                      "   " + cValToChar( ( Alias( n ) )->( EoF() ) ) + CRLF + CRLF

         if ( Alias( n ) )->( RddName() ) != "ARRAYRDD"
            cErrorLog += "Indices en Uso: " + 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+CRLF + "Relaciones en uso: " + 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
      endif
   next

   n = 1
   cErrorLog += CRLF+CRLF + "Clases en uso:" + CRLF
   cErrorLog += "___________________________________________________" + CRLF + CRLF

   #ifndef __XHARBOUR__
      while ! Empty( __ClassName( n ) )
         cErrorLog += "   " + Str( n, 3 ) + " " + __ClassName( n++ ) + CRLF
      end
   #else
      while n <= __ClsCntClasses()
         cErrorLog += "   " + Str( n, 3 ) + " " + __ClassName( n++ ) + CRLF
      end
   #endif

   cErrorLog += CRLF+CRLF + "Analisis de Memoria:" + CRLF
   cErrorLog +=        "___________________________________________________" + CRLF + CRLF

   #ifdef __CLIPPER__
      cErrorLog += "Memoria Estatica:" + CRLF
      cErrorLog += "Datos Segmentados: 64k" + CRLF
   #endif

   #ifdef __CLIPPER__
   cErrorLog += "Tamaño inicial:" + ;
                LTrim( Str( nInitDSSize() ) ) + ;
                " bytes  (SYMP=" + LTrim( Str( nSymPSize() ) ) + ;
                ", Stack=" + LTrim( Str( nStackSize() ) ) + ;
                ", Heap=" + LTrim( Str( nHeapSize() ) ) + ")" + CRLF
   cErrorLog += "PRG Stack:          " + ;
                LTrim( Str( 65535 - ( nStatics() * 14 ) - nInitDSSize() ) ) + ;
                " bytes" + CRLF
   #endif

   #ifdef __CLIPPER__
      cErrorLog += "      " + LTrim( Str( nStatics() ) ) + " Static variables: " + ;
                   LTrim( Str( nStatics() * 14 ) ) + " bytes" + CRLF + CRLF
   #else
      cErrorLog += "" + LTRIM( STR( nStatics() ) ) + " Variables Estaticas" + ;
                   CRLF + CRLF
   #endif

   cErrorLog += "Consumo Dinámico de Memoria:" + CRLF
   cErrorLog += "Valor Actual: " + STR( MemUsed() ) + " bytes" + CRLF
   cErrorLog += "Valor Máximo: " + STR( MemMax() ) + " bytes" + CRLF

   // Generates a file with an Error Log
   BEGIN SEQUENCE
      oOldError = ErrorBlock( { || DoBreak() } )
      MemoWrit( Lower( cFileNoExt( HB_Argv( 0 ) ) )+"_Error.log", cErrorLog )
   END SEQUENCE
   ErrorBlock( oOldError )

   ////// Dialogo
   DEFINE BRUSH oBrush COLOR CLR_FONDO_DLG
   DEFINE DIALOG oDlg TITLE DLG_TITLE SIZE 480, 285 BRUSH oBrush ;
          STYLE  nOr( WS_POPUP, WS_VISIBLE, WS_BORDER, 4 )

   @ 1, 1 BITMAP oBmp FILE "\mgIdeas\mgBmp\LogErr.bmp" SIZE 32,38 PIXEL NOBORDER ADJUST OF oDlg
   if oBmp:hBitmap == 0
      oBmp:End()
      oDlg:Update()
   end
   @ 0, 0  SAY oSay PROMPT cMessage CENTERED OF oDlg COLOR CLR_BLACK, CLR_FONDO_DLG FONT oFont SIZE 180, 55

   oSay:nStyle   = nOR( oSay:nStyle, 128 )   // SS_NOPREFIX
   oSay:nTop     =   3
   oSay:nLeft    =  40
   oSay:nBottom  =  40
   oSay:nRight   = 200

   @ 42, 6 SAY "&Stack List" OF oDlg COLOR CLR_WHITE, CLR_FONDO_DLG FONT oFont PIXEL

   n = aStack[ 1 ]

   @ 50, 3 LISTBOX oLbx VAR n ITEMS aStack OF oDlg COLOR CLR_BLACK, CLR_FONDO_LST SIZE 180, 74 PIXEL

   if nButtons == 1 .or. nButtons == 3
      @ 127,  20 BUTTON oBtn1 PROMPT "&Salir"      OF oDlg ACTION (oDlg:END())                 SIZE 30, 11 FONT oFont PIXEL DEFAULT
      @ 127,  67 BUTTON oBtn2 PROMPT "&Reintentar" OF oDlg ACTION ( lRet  := .t., oDlg:END() ) SIZE 30, 11 FONT oFont PIXEL
      @ 127, 115 BUTTON oBtn3 PROMPT "&Default"    OF oDlg ACTION ( lRet  := .f., oDlg:END() ) SIZE 30, 11 FONT oFont PIXEL
      oBtn2:Disable()
      oBtn3:Disable()
   else
      @ 125, 15 BUTTON oBtn1 PROMPT "&Salir" OF oDlg ACTION oDlg:END() SIZE 30, 11 PIXEL FONT oFont
   endif

   if e:CanRetry
      @ 121, IF( nButtons == 2, 62, 62 ) BUTTON oBtn2 PROMPT "&Reintentar" OF oDlg ACTION ( lRet  := .t., oDlg:END() ) SIZE 30, 11 FONT oFont PIXEL
      @ 121, 110                         BUTTON oBtn3 PROMPT "&Default"    OF oDlg ACTION ( lRet  := .f., oDlg:END() ) SIZE 30, 11 FONT oFont PIXEL
      oBtn3:Disable()
   endif

   if e:CanDefault
      @ 125, 110 BUTTON oBtn3 PROMPT "&Default"  OF oDlg ACTION ( lRet  := .f., oDlg:END() ) SIZE 30, 11 FONT oFont PIXEL
   endif

   @ 50,187 BUTTON "See Error.log file" OF oDlg FONT oFont PIXEL SIZE 48, 15 ;
            ACTION WinExec( "Notepad.exe "+Lower( cFileNoExt( HB_Argv( 0 ) ) )+"_Error.log" )

   @ 70,187 BUTTON "Enviar x correo-e"  OF oDlg FONT oFont PIXEL SIZE 48, 15 ;
            ACTION TSendMail():New():DlgMailErr()

   ACTIVATE DIALOG oDlg CENTERED ;
            ON INIT Sonidos()   ;

   if !Empty( oBmp )
      oBmp:End()
   end
   if lRet == nil .or. ( !LWRunning() .and. lRet )
      SET RESOURCES TO
      ErrorLevel( 1 )
      // Add these lines if using MDI child windows with dialogboxes
      // for n = 1 to Len( GetAllWin() )
      //    if ValType( GetAllWin()[ n ] ) == "O"
      //       GetAllWin()[ n ]:UnLink()
      //    endif
      // next
      QUIT              // must be QUIT !!!
   endif

return lRet

//----------------------------------------------------------------------------//

static function DoBreak()

   BREAK

return nil

//----------------------------------------------------------------------------//

static function ErrorMessage( e )

    // start error message
    local cMessage := if( empty( e:OsCode ), ;
                          if( e:severity > ES_WARNING, "Error ", "Warning " ),;
                          "(DOS Error " + NTRIM(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",;
                    "/" + NTRIM( 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

//----------------------------------------------------------------------------//
// returns extended info for a certain variable type

static function cGetInfo( uVal )

   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

//----------------------------------------------------------------------------//

#define  HKEY_LOCAL_MACHINE  2147483650  // 0x80000002

function GetCPU()

   local oReg := TReg32():New( HKEY_LOCAL_MACHINE,;
                               "HARDWARE\DESCRIPTION\System\CentralProcessor\0",;
                               .f. )
   local cCpu := oReg:Get( "ProcessorNameString" )

   oReg:Close()


return cCpu

//----------------------------------------------------------------------------//

#ifdef __HARBOUR__
   #ifndef __XHARBOUR__
      REQUEST HB_GT_GUI_DEFAULT
      procedure HB_GTSYS() ; return
      // procedure HB_GT_GUI_DEFAULT() ; return
      procedure FW_GT ; return
   #endif
#endif

//----------------------------------------------------------------------------//
static function Sonidos()

   Tone(2000,3)
   Tone(3000,3)

return nil

//----------------------------------------------------------------------------//
static function FechaErr()
local aMes:= {" ENE'"," FEB'"," MAR'", " ABR'", " MAY'", " JUN'", " JUL'", " AGO'", " SEP'", " OCT'", " NOV'", " DIC'" }, ;
      nMes:= Month( Date() )
local cMes:= aMes[nMes]


return ( StrZero( Day( Date() ), 2 )+cMes+Str( Year( Date() ),4 ) )

#ifdef __HARBOUR__
   #ifndef __XHARBOUR__
      REQUEST HB_GT_GUI_DEFAULT
      PROCEDURE HB_GTSYS() ; return
      procedure FW_GT ; return
   #endif
#endif

##############################################################################
# Template para construir librerias.                                         # 
# Copyright (c) 2004 Hernan Diego Ceccarelli.                                #
##############################################################################

# Win2000 bug ################################################################
# Uncomment next line if you receive any DEL error ###########################
# set DEL=cmd /c del

!if !$d(DEL)
   DEL = del 
!endif

# Directorios Principales ####################################################

FIVEWIN_DIR   = \Harbour\fwh
HARBOUR_DIR   = \xHarbour
BORLANDC_DIR  = \bcc582

# Make directives ############################################################

.swap
.suffixes: .prg 

# Application directories & filenames ########################################

LIB_NAME         = MiFWH    # (Your LIB name without extension)
LIB_PRG_DIR      = sources  # .
LIB_OBJ_DIR      = obj      # (create the app\obj directory first)
LIB_INCLUDE_DIR  = include  # .
LIB_LIB_DIR      = lib      # $(LIB_PRG_DIR)

LIB_LIB  = $(LIB_LIB_DIR)\$(LIB_NAME).lib


# Paths for dependent files ##################################################

.path.c   = $(LIB_PRG_DIR)
.path.prg = $(LIB_PRG_DIR)
.path.obj = $(LIB_OBJ_DIR)

# Application PRG and C files (your PRG/C files go here) #####################

LIB_PRG_LIST = \
    alert.prg\
        errsysw.prg\

# Contruction of the rest dependency lists ###################################

LIB_PRGS = $(LIB_PRG_LIST)

TMP_001  = $(LIB_PRG_LIST:.prg=.obj)
LIB_OBJ  = $(TMP_001:.c=.obj)

LIB_TMP0 = OBJ\$(LIB_OBJ:.obj=.obj +OBJ\)
LIB_TMP1 = $(LIB_TMP0: =)
LIB_TMP2 = $(LIB_TMP1:.obj=.obj )_
LIB_TMP3 = +$(LIB_TMP2:+OBJ\_=)