VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "HeartBeat"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Const SEP1 As String = "®"
Private Const SEP2 As String = "©"
Private Const C_ERRORRAISE As Long = 2500

Private Enum ArmErr
    DBCnxFailed = C_ERRORRAISE + 1             ' Unable to connect to the database
    CPTAlreadyInitialized = C_ERRORRAISE + 2   ' We try to initialize a component that is already initialized
    CPTNotInitialized = C_ERRORRAISE + 3       ' We try to use or free that is not initialized yet
    InvalidArgument = C_ERRORRAISE + 4
    PropertyNotSet = C_ERRORRAISE + 5
    SQLFailure = C_ERRORRAISE + 6               ' A SQL runtime error has occured : syntax wrong....
    SQLBadRowAffectedCount = C_ERRORRAISE + 7   ' A SQL request has not affected the expected rowcount (ex: one Update do nothing)
    SQLBadRowExpectedCount = C_ERRORRAISE + 8   ' A SQL request does not return the expected rowcount : select an item return nothing...
    DrivingError = C_ERRORRAISE + 9
    CompFncFailed = C_ERRORRAISE + 10           ' when component function fail
    GridLoadFailed = C_ERRORRAISE + 11          ' load function failed ... bad sql
    InvalidValue = C_ERRORRAISE + 12          ' load function failed ... bad sql
End Enum

Private Enum ArmCusErr
    DuplicityDetected = C_ERRORRAISE + 2301                ' detected row with same unique id
End Enum

Private m_heartbeatTimer    As Long
Private m_heartbeatEnabled  As Boolean
Private m_machineName       As String
Private md_last_time        As Date

Private Sub Class_Initialize()
    m_heartbeatEnabled = False
End Sub

' Get Heartbeat Enabled
Public Property Get Enabled() As Boolean
On Error GoTo ErrHandler
    Enabled = m_heartbeatEnabled
    Exit Property
ErrHandler:
     Call ErrorHandler("Property Get Enabled")
End Property

' Get HeartbeatTimer value
Public Property Get HeartBeatTimer() As Long
On Error GoTo ErrHandler
    HeartBeatTimer = m_heartbeatTimer
    Exit Property
ErrHandler:
     Call ErrorHandler("Property Get HeartbeatTimer")
End Property


Public Function HeartbeatTest(ByRef ao_Db As ArmDb, ByVal as_processName As String) As Boolean
On Error GoTo ErrHandler
Const C_REQ As String = "EXEC A_Heartbeat_test '$PROCESSNAME$'"

    Dim lb_retVal As Boolean
    Dim ll_diff As Long
    Dim ll_check As Long
    Dim ls_req As String
    Dim ll_Cursor As Long
    lb_retVal = False
    HeartbeatTest = False
    
    If m_heartbeatEnabled = False Then
        Exit Function
    End If
    
    ls_req = Replace(C_REQ, "$PROCESSNAME$", as_processName, , , vbTextCompare)
    ll_Cursor = OpenSQLSafe(ao_Db, ls_req)
    
    ll_diff = ao_Db.GetFields(ll_Cursor, "diff")
    lb_retVal = (ao_Db.GetFields(ll_Cursor, "HB_checkin_date") = 0)
    ll_check = ao_Db.GetFields(ll_Cursor, "HB_CFG_check")
    
    If Not lb_retVal Then
        If ll_diff > ll_check Then
            ' it seems that other batch is crashed or is paused
            ' log it as error and contune with this instance
            ' Call LogMessage("Detected second instance.", "E")
            lb_retVal = True
            
        End If
    End If
    
    Call ao_Db.Close(ll_Cursor)
    ll_Cursor = 0

    HeartbeatTest = lb_retVal
    Exit Function
ErrHandler:
    If ll_Cursor > 0 Then
        Call ao_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call ErrorHandler("HeartbeatTest")
End Function

Public Function HeartBeatConfig(ByRef ao_Db As ArmDb, ByVal as_processName As String) As Boolean
On Error GoTo ErrHandler
Const C_REQ As String = "EXEC A_Heartbeat_CFG '$PROCESSNAME$'"

    ' Setup HeartBeat timer
    Dim lFSO As FileSystemObject
    Dim loNetObject As Object
    Set loNetObject = CreateObject("WScript.Network")
    m_machineName = right(loNetObject.ComputerName, 50)
    Set loNetObject = Nothing

    Dim ls_req As String
    Dim ll_Cursor As Long
    
    ls_req = Replace(C_REQ, "$PROCESSNAME$", as_processName, , , vbTextCompare)
    ll_Cursor = OpenSQLSafe(ao_Db, ls_req)
    
    If ao_Db.RowCount(ll_Cursor) = 1 Then
        m_heartbeatTimer = ao_Db.GetFields(ll_Cursor, "HB_CFG_timer")
        m_heartbeatEnabled = True
        HeartBeatConfig = True
    Else
        m_heartbeatTimer = 0
        m_heartbeatEnabled = False
        HeartBeatConfig = False
    End If
    
    Call ao_Db.Close(ll_Cursor)
    ll_Cursor = 0

    Exit Function
ErrHandler:
    If ll_Cursor > 0 Then
        Call ao_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    HeartBeatConfig = False
    Call ErrorHandler("HeartBeatConfig")
End Function

Public Function HeartBeatHit(ByRef ao_Db As ArmDb, ByVal as_processName As String) As Boolean
On Error GoTo ErrHandler
Const C_REQ As String = "EXEC A_Heartbeat_update '$PROCESSNAME$'"

    Dim ls_req As String
    
    HeartBeatHit = False
    
    If m_heartbeatEnabled = False Then
        Exit Function
    End If
    
    If DateDiff("s", md_last_time, Now) >= m_heartbeatTimer Then
        ' update heartbeat
    
        ls_req = Replace(C_REQ, "$PROCESSNAME$", as_processName, , , vbTextCompare)
        Call ExecuteSQLSafe(ao_Db, ls_req)
        
        HeartBeatHit = True
        
        md_last_time = Now
    End If

    Exit Function
ErrHandler:
    HeartBeatHit = False
    Call ErrorHandler("HeartBeatHit")
End Function

Public Sub HeartBeatEnable(ByRef ao_Db As ArmDb, ByVal as_processName As String, ByVal ab_Enable As Boolean)
On Error GoTo ErrHandler
    Const C_REQ As String = "EXEC A_Heartbeat_set '$PROCESSNAME$', '$MACHINE$', '$APPPATH$', '$VER$', '$RUNNING$'"

    Dim ls_req As String
    
    If m_heartbeatEnabled = False Then
        Exit Sub
    End If
    
    ls_req = Replace(C_REQ, "$PROCESSNAME$", as_processName, , , vbTextCompare)
    ls_req = Replace(ls_req, "$MACHINE$", m_machineName, , , vbTextCompare)
    ls_req = Replace(ls_req, "$APPPATH$", App.Path & "\" & App.EXEName, , , vbTextCompare)
    ls_req = Replace(ls_req, "$VER$", App.Major & "." & App.Minor & "." & App.Revision, , , vbTextCompare)
    ls_req = Replace(ls_req, "$RUNNING$", IIf(ab_Enable, "X", ""), , , vbTextCompare)
    
    Call ExecuteSQLSafe(ao_Db, ls_req)

    Exit Sub
ErrHandler:
    Call ErrorHandler("HeartBeatEnable")
End Sub

' Return the result of a SQL request
' Convert SQL runtime errors and process errors to VB Error
' Return the result of a SQL request
' Convert SQL runtime errors and process errors to VB Error
#If LIVE = 1 Then
Private Function OpenSQLSafe(ByVal ao_Db As Object, ByVal as_Request As String, Optional ByVal al_RowExpectedCount = -1) As Long
#Else
Private Function OpenSQLSafe(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_Request As String, Optional ByVal al_RowExpectedCount = -1) As Long
#End If

On Error GoTo ErrHandler

    Dim lc_Data As Long
    lc_Data = ao_Db.OpenSQL(as_Request)
    
    If lc_Data = 0 Then
        Err.Raise ArmErr.SQLFailure, "SQL : " & as_Request, Join(ao_Db.SQLErrorCodes, SEP2) & SEP1 & Join(ao_Db.SQLErrorMessages, SEP2)
    End If
    
    If al_RowExpectedCount <> -1 Then
        ' Then check the rowcount
        If ao_Db.RowCount(lc_Data) <> al_RowExpectedCount Then
            Err.Raise ArmErr.SQLBadRowExpectedCount, "SQL : " & as_Request, al_RowExpectedCount & "<>" & ao_Db.RowCount(lc_Data)
        End If
    End If

    OpenSQLSafe = lc_Data

    Exit Function

ErrHandler:
    Call ErrorHandler("OpenSQLSafe")
End Function

' Execute a SQL request returning no data
' Convert SQL runtime errors and process errors to VB Error
' Params:
' ao_Db (Object)
' as_Request (String)
' al_RowAffectedCount (String)
#If LIVE = 1 Then
Private Sub ExecuteSQLSafe(ByVal ao_Db As Object, ByVal as_Request As String, Optional ByVal al_RowAffectedCount = -1, Optional ab_DuplicityCheck As Boolean = False)
#Else
Private Sub ExecuteSQLSafe(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_Request As String, Optional ByVal al_RowAffectedCount = -1, Optional ab_DuplicityCheck As Boolean = False)
#End If
On Error GoTo ErrHandler

    ' First execute the request
    If Not ao_Db.ExecuteSQL(as_Request) Then
        Err.Raise ArmErr.SQLFailure, "SQL : " & as_Request, Join(ao_Db.SQLErrorCodes, SEP2) & SEP1 & Join(ao_Db.SQLErrorMessages, SEP2)
    End If

    If al_RowAffectedCount <> -1 Then
        ' Then check the rowcount
        If ao_Db.SQLRowsAffected <> al_RowAffectedCount Then
            
            If ab_DuplicityCheck Then
                Err.Raise ArmCusErr.DuplicityDetected, "SQL : " & as_Request, al_RowAffectedCount & "<>" & ao_Db.SQLRowsAffected
            Else
                Err.Raise ArmErr.SQLBadRowAffectedCount, "SQL : " & as_Request, al_RowAffectedCount & "<>" & ao_Db.SQLRowsAffected
            End If
        End If
    End If

    Exit Sub

ErrHandler:
    Call ErrorHandler("ExecuteSQLSafe")
End Sub

' Standard error handler
Private Sub ErrorHandler(ByVal as_Fct As String)
  
    Call Err.Raise(Err.Number, as_Fct & SEP1 & Err.Source, Err.Description)
End Sub

