*
 **  Errorsys.prg
 **  NTK Win32/64 compliant
*/


// xHarbour
#include "common.ch"
#include "error.ch"
#include "fileIO.ch"


// NTK
#include "windows.ch"
#include "ntkcmd.ch"
#include "wNtk.ch"
#INCLUDE "wNtkKeys.ch"


#define NTRIM(n)( LTrim(Str(n)) )
#define CR Chr(13)
#define CRLF CHR(13)+CHR(10)




/***
*	ErrorSys()
*
*  Notes:
   - NTKCore - Insert after the first NTK_RegisterClass() in your Main() proc

   - NTKRad -  Insert after the first CREATE WINDOW <hWnMain>... in your Main() proc
*
*/

PROCEDURE ErrorSys()
	ErrorBlock( {|e| DefError(e)} )
RETURN




//       DefError()
// FUNCTION DefError(e)
STATIC FUNCTION DefError(e)
local i
Local cMessage, cDOSError, cErrMsgHistory, cOperationStatus, cSysDateTime
Local aBtnOpt, nKey, nChoice
Local cTxtColor  := NTK_RGB(255,255,255)  // Txt color of the error msg
local cBkgColor  := NTK_RGB(183,0,0)      // Bkg color of the DialogBox

        // default: DIV/0 always returns 0
        IF ( e:genCode == EG_ZERODIV )
           return (0)
        ENDIF


        if (e:gencode == EG_OPEN .and. e:oscode==32 .and. e:candefault)
           neterr(.t.)
           return (.f.)
        endif

        if (e:gencode==EG_APPENDLOCK .and. e:candefault)
           neterr(.t.)
           return (.f.)
        endif

        if ( e:genCode == EG_OPEN .and. NetErr() .and. e:canDefault )
           // driver default
           return (.f.)
        endif


        // Save TimeStamp when error occurs
        cSysDateTime := DTOS(Date())+"_"+STRTRAN(Time(),":","")+"_"+nToc(Second())


        // Building the error message...
        cMessage := ERRORMESSAGE(e)
        IF ! Empty( e:osCode )
           cDOSError := "(DOS Error " + LTrim( Str( e:osCode ) ) + ")"
           cMessage  += " " + cDOSError
        ENDIF

        // Building the error history, then save it with error message to _ERRSYS.TXT
        cOperationStatus := "OK"
        IF !FILE( "_ERRSYS.TXT" )
           PRIVATE NumF := FCREATE( "_ERRSYS.TXT" )
           IF NumF == -1
              FCLOSE( NumF )
              cOperationStatus := "CANCELED"
              NTK_MsgBox( , "Cannot create _ERRSYS.TXT",  "ERRORSYS...",  MB_OK+MB_ICONHAND+MB_TOPMOST )
              RETURN (.F.)
           ENDIF
        ELSE
           PRIVATE NumF := FOPEN( "_ERRSYS.TXT", FO_READWRITE )
           IF NumF == -1
              FCLOSE( NumF )
              cOperationStatus := "CANCELED"
              NTK_MsgBox( , "Cannot update _ERRSYS.TXT",  "ERRORSYS...",  MB_OK+MB_ICONHAND+MB_TOPMOST )
              RETURN (.F.)
           ENDIF
        ENDIF


        IF cOperationStatus == "OK"
           FSEEK( NumF, 0 , FS_END )
           FWRITE( NumF , "APPLICATION FAILED AT "  )
           FWRITE( NumF , TIME()  )
           FWRITE( NumF , " " )
           FWRITE( NumF , DTOC( DATE() ) + CRLF )

           FWRITE( NumF , "*** "+cMessage + CRLF )
           FWRITE( NumF ,"-----------------------------------------------------" + CRLF )
        ENDIF

        nLiErrMsg := 0
        cErrMsgHistory := ""

        i := 2
        WHILE ! Empty( ProcName( i ) )

          IF cOperationStatus == "OK"
             FWRITE( NumF ,"Called From " + PROCNAME(i)+SPACE(20-LEN(PROCNAME(i)))+;
                           " L("+NTOC(PROCLINE(i))+")  " + CRLF )
          ENDIF

          cErrMsgHistory := cErrMsgHistory + "Called from " + ProcName( i ) + ;
                                       " L(" + NTOC(ProcLine(i)) + ")"+CR
          i++
          nLiErrMsg++  // Count the number of lines in cErrMsgHistory
        ENDDO


        IF cOperationStatus == "OK"
           FWRITE( NumF ,"-----------------------------------------------------" + CRLF )
           FWRITE( NumF ,"" + CRLF )
           FCLOSE( NumF )
        ENDIF

        IF VALTYPE(cErrMsgHistory) != "C"
           cErrMsgHistory := "Unknown error..."
        ENDIF

      /*
          // Switch-off any existing timers (background tasks) attached to the main window
          // in order to avoid cascading errors du to thread concurency.
          FOR i := 1 TO 30  // This value must be ajusted according to the number of timer/s defined in the App.
              NTK_KillTimer( hWndMain , i )
          NEXT
       */


        // Building the Array that contains user choices according to the error severity
        aBtnOpt := {}
        AADD( aBtnOpt, { " &Quit ", K_Q } )


        ///////////////////////////////////////////////////////////////////////////////
        // The code below is not compliant with an application currently handling
        // Background Tasks/Timers. Hence, only the 'Quit' button is availabe.
        // Just comment the followings if your App is using bkg task or timers.
        //////////////////////////////////////////////////////////////////////////////
        IF (e:canRetry)
           AADD( aBtnOpt, { " &Retry ", K_R } )
        ENDIF

        IF (e:canDefault)
           AADD( aBtnOpt, { " &Ignorer ", K_I } )
        ENDIF
        //////////////////////////////////////////////////////////////////////////////


        // Building a DialogBox that contains error msg + error history
        cMessage  += CR+CR+cErrMsgHistory
        nLiErrMsg += 7  // 1Row for cMessage + 2CR + 3Rows for Quit button + 1Empty Row
        SET PIXEL OFF   // Switch to Row/Col mode
        // N.B. When no coordinates are defined in NtkWarnBox() it means: autosizing + autocentring
        nKey := NtkWarnBox( nil, nil, nLiErrMsg, 80, cMessage, aBtnOpt, cTxtColor, cBkgColor )

        IF nKey == K_Q
           nChoice := "Quit"
        ELSEIF nKey == K_R
           nChoice := "Retry"
        ELSEIF nKey == K_I
           nChoice := "Ignore"
        ENDIF

        IF ( !EMPTY(nChoice) )
           If nChoice == "Quit"
              ** BREAK(e)
           ElseIf nChoice == "Retry"
              RETURN (.T.)
           ElseIf nChoice == "Ignore"
              RETURN (.F.)
           EndIf
        ENDIF


        // give up
        ERRORLEVEL(1)


        CLOSE DATABASE


        // Ensure perfect application closing
        QUIT

RETURN (.F.)




*
*ERRORMESSAGE()
*
STATIC FUNCTION ERRORMESSAGE(e)
LOCAL i
LOCAL cMessage

// Starts error message
cMessage := IF( e:severity > ES_WARNING, " Error ", " Warning " ) + " "



// add subsystem name if available
IF ( VALTYPE(e:subsystem) == "C" )
   cMessage += e:SUBSYSTEM()
ELSE
   cMessage += "???"
ENDIF



// add subsystem's error code if available
IF ( VALTYPE(e:subCode) == "N" )
   cMessage += ("/" + NTOC(e:subCode))
ELSE
   cMessage += "/???"
ENDIF


// add error description (if any)
IF ( VALTYPE(e:description) == "C" )
   cMessage += ("  " + e:description)
ENDIF


// add either filename or operation
IF ( !EMPTY(e:filename) )
   cMessage += (": " + e:filename)
ELSEIF ( !EMPTY(e:operation) )
   cMessage += (": " + e:operation)
ENDIF


RETURN (cMessage)


STATIC FUNCTION NTOC( nValue, nDec )
Default nDec To 0
RETURN ALLTRIM( STR(nValue, 18-(nDec+1), nDec) )