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

' **************************************************************************************************
' ************************************* EXTERNAL DECLARATIONS **************************************
' **************************************************************************************************
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
' **************************************************************************************************

Private Const PLUGIN_VERSION As String = "1.0.0"
Private Const C_INTERVAL_DAYS As String = "TMT_PLUGIN_INTERVAL_DAYS"
Private Const C_INTERVAL_TEST_DAYS As String = "TMT_PLUGIN_INTERVAL_TEST_DAYS"
Private Const C_INTERVAL_COURSE_DAYS As String = "TMT_PLUGIN_INTERVAL_COURSE_DAYS"

Private Const SEP1 As String = "®"
Private Const SEP2 As String = "©"
Private Const SEP As String = SEP1 + SEP2

Private Const C_MODULE_NAME As String = "TMT_Plugin"      ' module name used in log table
Private Const SCREEN_NAME As String = "TMT_Plugin"
Private Const C_ERRORRAISE As Long = 2500

'AppMail Status const
Private Const EML_APPSTATUS_PROCESSED = "P"

#If LIVE = 1 Then
    Dim mo_Db As Object
#Else
    Dim mo_Db As ARMSYSCOMLib.ArmDb
#End If

Dim md_LastReminderSend                 As Date


Private ms_LanguageCode                 As String   ' Language code
Private mb_Initialized                  As Boolean  ' Initialized user control flag
Private ml_U_Code                       As Long     ' User code

Private ml_LogLevel                     As Long     ' live=0, debug=1


' **************************************** USER DEFINED ERRORS *************************************
' **************************************************************************************************
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 Enum ArmSysType
  DBTYPE_EMPTY = 0
  DBTYPE_I4 = 3
  DBTYPE_R4 = 4
  DBTYPE_R8 = 5
  DBTYPE_DATE = 7
  DBTYPE_BSTR = 8 '- UNICODE string
  DBTYPE_BOOL = 11
  DBTYPE_STR = 129
  DBTYPE_BMP = 999
End Enum

' *************************************** USER DEFINED ERRORS **************************************

Public Event OnAddToLog(ByRef as_msg As String, ByRef as_Type As String)

Public Sub Init()
On Error GoTo ErrHandler

    Exit Sub
    
ErrHandler:
    Call AddToLog("Error in Init!", "E")
    Call errorHandler(C_MODULE_NAME & ".Init")
End Sub

Public Function ProcessOnSendMail(ByRef ao_MailData As MailData) As Boolean
On Error GoTo ErrHandler
    
    If mb_Initialized = False Then
        Exit Function
    End If
    
    Call AddToLog("TMT_Plugin ProcessOnSendMail started.", "I")
    ProcessOnSendMail = True
    Exit Function

ErrHandler:
    Call AddToLog("Error in ProcessOnSendMail!", "E")
    ProcessOnSendMail = False
End Function

Public Function ProcessTasks() As Boolean
On Error GoTo ErrHandler

    ProcessTasks = False
        
    If mb_Initialized = False Then
        Exit Function
    End If

    If DateDiff("n", md_LastReminderSend, Now) >= 1 Then
        Call ProcessTranslationWorkflowReminders
        Call ProcessOutstandingCourseReminders
        Call ProcessOutstandingTestReminders
        md_LastReminderSend = Now
        Call Set_A_Config("TMT_Last_Reminder_Send", Format(md_LastReminderSend, "yyyy/mm/dd hh:mm:ss"))
        ProcessTasks = True
    End If

    ProcessTasks = True
    Exit Function

ErrHandler:
    
    ProcessTasks = False
    Call AddToLog("Error in ProcessTasks!", "E")
End Function

Private Sub ProcessTranslationWorkflowReminders()
On Error GoTo ErrHandler

    Dim ls_Message As String
    Dim ls_Subject As String
    Dim ls_MessagePart As String
    Dim ls_req As String
    Dim ll_Cursor As Long
    Dim li_user As Integer
    
    Const c_SqlRequest As String = "exec TMT_TranslationWorkflowReminder "
    
    ls_req = c_SqlRequest & Get_A_Config(C_INTERVAL_DAYS)
    li_user = 0

    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    If mo_Db.RowCount(ll_Cursor) > 0 Then
        While Not mo_Db.EOF(ll_Cursor)
            If li_user <> 0 Then
                If li_user <> mo_Db.GetFields(ll_Cursor, "P_code") Then
                    Call SendReminder(ls_Message, li_user, ls_Subject)
                    ls_Message = Get_TMT_Message(2000, mo_Db.GetFields(ll_Cursor, "Spoken_Language"), "The following items are outstanding for translation") & vbNewLine
                    ls_Subject = Replace(Get_TMT_Message(2020, mo_Db.GetFields(ll_Cursor, "Spoken_Language"), "Outstanding translation work for $date$"), "$date$", Format(Now, "dd\/mm\/yyyy"))
                End If
            Else
                ls_Message = Get_TMT_Message(2000, mo_Db.GetFields(ll_Cursor, "Spoken_Language"), "The following items are outstanding for translation") & vbNewLine
                ls_Subject = Replace(Get_TMT_Message(2020, mo_Db.GetFields(ll_Cursor, "Spoken_Language"), "Outstanding translation work for $date$"), "$date$", Format(Now, "dd\/mm\/yyyy"))
            End If
            li_user = mo_Db.GetFields(ll_Cursor, "P_code")
            
            ls_MessagePart = Replace(Get_TMT_Message(2010, mo_Db.GetFields(ll_Cursor, "Spoken_Language"), "$item_desc$ into language $Language_desc$."), "$Language_desc$", mo_Db.GetFields(ll_Cursor, "Language_desc"))
            If mo_Db.GetFields(ll_Cursor, "Action_Desc") <> "" Then
                ls_MessagePart = Replace(ls_MessagePart, "$item_desc$", mo_Db.GetFields(ll_Cursor, "Action_Desc") & " " & mo_Db.GetFields(ll_Cursor, "Activity_desc"))
            ElseIf mo_Db.GetFields(ll_Cursor, "Kit_desc") <> "" Then
                ls_MessagePart = Replace(ls_MessagePart, "$item_desc$", mo_Db.GetFields(ll_Cursor, "Kit_desc"))
            ElseIf mo_Db.GetFields(ll_Cursor, "Course_desc") <> "" Then
                ls_MessagePart = Replace(ls_MessagePart, "$item_desc$", mo_Db.GetFields(ll_Cursor, "Course_desc"))
            ElseIf mo_Db.GetFields(ll_Cursor, "Object_desc") <> "" Then
                ls_MessagePart = Replace(ls_MessagePart, "$item_desc$", mo_Db.GetFields(ll_Cursor, "Object_desc"))
            ElseIf mo_Db.GetFields(ll_Cursor, "Activity_desc") <> "" Then
                ls_MessagePart = Replace(ls_MessagePart, "$item_desc$", mo_Db.GetFields(ll_Cursor, "Activity_desc"))
            ElseIf mo_Db.GetFields(ll_Cursor, "Test_desc") <> "" Then
                ls_MessagePart = Replace(ls_MessagePart, "$item_desc$", mo_Db.GetFields(ll_Cursor, "Test_desc"))
            ElseIf mo_Db.GetFields(ll_Cursor, "Quest_Desc") <> "" Then
                ls_MessagePart = Replace(ls_MessagePart, "$item_desc$", mo_Db.GetFields(ll_Cursor, "Quest_Desc"))
            ElseIf mo_Db.GetFields(ll_Cursor, "Prop_Desc") <> "" Then
                ls_MessagePart = Replace(ls_MessagePart, "$item_desc$", mo_Db.GetFields(ll_Cursor, "Prop_Desc"))
            Else
                ls_MessagePart = Replace(ls_MessagePart, "$item_desc$", "MISSING SOURCE!!")
            End If
            
            ls_Message = ls_Message & vbNewLine & ls_MessagePart
            Call WorkflowReminderCount(ll_Cursor)
            
            Call mo_Db.Next(ll_Cursor)
        Wend
        If li_user <> 0 Then
            Call SendReminder(ls_Message, li_user, ls_Subject)
        End If
    End If
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    Exit Sub

ErrHandler:
    If ll_Cursor <> 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    
    Call AddToLog("ProcessTranslationWorkflowReminders!", "E")
End Sub

Private Sub ProcessOutstandingCourseReminders()
On Error GoTo ErrHandler

    Dim ls_Message As String
    Dim ls_Subject As String
    Dim ls_req As String
    Dim ll_Cursor As Long
    
    Const c_SqlRequest As String = "exec TMT_OutstandingCourseReminder "

    ls_req = c_SqlRequest & Get_A_Config(C_INTERVAL_COURSE_DAYS)

    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    If mo_Db.RowCount(ll_Cursor) > 0 Then
        While Not mo_Db.EOF(ll_Cursor)
            If mo_Db.GetFields(ll_Cursor, "CP_Status") = 0 Or mo_Db.GetFields(ll_Cursor, "CP_Status") = 1 Then
                ls_Subject = Replace(Get_TMT_Message(2030, mo_Db.GetFields(ll_Cursor, "Spoken_Language"), "Unstarted training course $Course_desc$"), "$Course_desc$", mo_Db.GetFields(ll_Cursor, "Course_desc"))
                ls_Message = Get_TMT_Message(2040, mo_Db.GetFields(ll_Cursor, "Spoken_Language"), "The course was assigned to you on $Date_assigned$ and has not been started.") & vbNewLine
                ls_Message = Replace(ls_Message, "$Date_assigned$", mo_Db.GetFields(ll_Cursor, "Date_assigned"))
            ElseIf mo_Db.GetFields(ll_Cursor, "CP_Status") = 2 Then
                ls_Subject = Replace(Get_TMT_Message(2050, mo_Db.GetFields(ll_Cursor, "Spoken_Language"), "Outstanding training course $Course_desc$"), "$Course_desc$", mo_Db.GetFields(ll_Cursor, "Course_desc"))
                ls_Message = Get_TMT_Message(2060, mo_Db.GetFields(ll_Cursor, "Spoken_Language"), "The course was assigned to you on $Date_assigned$, started on $Date_started$ but not yet finished.") & vbNewLine
                ls_Message = Replace(ls_Message, "$Date_assigned$", mo_Db.GetFields(ll_Cursor, "Date_assigned"))
                ls_Message = Replace(ls_Message, "$Date_started$", mo_Db.GetFields(ll_Cursor, "Date_started"))
            End If
            
            Call WorkflowReminderCount(ll_Cursor)
            Call SendReminder(ls_Message, mo_Db.GetFields(ll_Cursor, "P_code"), ls_Subject)
            
            'sent to manager
            If mo_Db.GetFields(ll_Cursor, "Manager_code") <> 0 Then
                If mo_Db.GetFields(ll_Cursor, "Number_of_reminders") Mod 2 <> 0 Then
                    ls_Subject = Replace(Get_TMT_Message(2110, mo_Db.GetFields(ll_Cursor, "Spoken_Language_Mngr"), "Outstanding training course for $P_First_Name$ $P_Name$"), "$P_First_Name$", mo_Db.GetFields(ll_Cursor, "P_First_Name"))
                    ls_Subject = Replace(ls_Subject, "$P_Name$", mo_Db.GetFields(ll_Cursor, "P_Name"))
                
                    ls_Message = Get_TMT_Message(2120, mo_Db.GetFields(ll_Cursor, "Spoken_Language_Mngr"), "The training course $Course_desc$ has not been completed.") & vbNewLine
                    ls_Message = Replace(ls_Message, "$Course_desc$", mo_Db.GetFields(ll_Cursor, "Course_desc_mngr"))
                
                    Call SendReminder(ls_Message, mo_Db.GetFields(ll_Cursor, "Manager_code"), ls_Subject)
                End If
            End If
            Call mo_Db.Next(ll_Cursor)
        Wend
    End If
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    Exit Sub

ErrHandler:
    If ll_Cursor <> 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    
    Call AddToLog("ProcessOutstandingCourseReminders!", "E")
End Sub

Private Sub ProcessOutstandingTestReminders()
On Error GoTo ErrHandler

    Dim ls_Message As String
    Dim ls_Subject As String
    Dim ls_req As String
    Dim ll_Cursor As Long

    Const c_SqlRequest As String = "exec TMT_OutstandingTestReminder "

    ls_req = c_SqlRequest & Get_A_Config(C_INTERVAL_TEST_DAYS)

    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    If mo_Db.RowCount(ll_Cursor) > 0 Then
        While Not mo_Db.EOF(ll_Cursor)
            ls_Subject = Replace(Get_TMT_Message(2070, mo_Db.GetFields(ll_Cursor, "Spoken_Language"), "Unstarted test $Test_desc$"), "$Test_desc$", mo_Db.GetFields(ll_Cursor, "Test_desc"))
            ls_Message = Get_TMT_Message(2080, mo_Db.GetFields(ll_Cursor, "Spoken_Language"), "The test was assigned to you on $Z_Creation$ and has not been started.") & vbNewLine
            ls_Message = Replace(ls_Message, "$Z_Creation$", mo_Db.GetFields(ll_Cursor, "Z_Creation"))
        
            Call WorkflowReminderCount(ll_Cursor)
            Call SendReminder(ls_Message, mo_Db.GetFields(ll_Cursor, "P_code"), ls_Subject)
            
            'sent to manager
            If mo_Db.GetFields(ll_Cursor, "Manager_code") <> 0 Then
                If mo_Db.GetFields(ll_Cursor, "Number_of_reminders") Mod 2 <> 0 Then
                    ls_Subject = Replace(Get_TMT_Message(2090, mo_Db.GetFields(ll_Cursor, "Spoken_Language_Mngr"), "Outstanding test for $P_First_Name$ $P_Name$"), "$P_First_Name$", mo_Db.GetFields(ll_Cursor, "P_First_Name"))
                    ls_Subject = Replace(ls_Subject, "$P_Name$", mo_Db.GetFields(ll_Cursor, "P_Name"))
                    
                    ls_Message = Get_TMT_Message(2100, mo_Db.GetFields(ll_Cursor, "Spoken_Language_Mngr"), "The test $Test_desc$ has not been started.") & vbNewLine
                    ls_Message = Replace(ls_Message, "$Test_desc$", mo_Db.GetFields(ll_Cursor, "Test_desc_mngr"))
                    Call SendReminder(ls_Message, mo_Db.GetFields(ll_Cursor, "Manager_code"), ls_Subject)
                End If
            End If
            Call mo_Db.Next(ll_Cursor)
        Wend
    End If
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    Exit Sub

ErrHandler:
    If ll_Cursor <> 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    
    Call AddToLog("ProcessOutstandingCourseReminders!", "E")
End Sub

Private Sub WorkflowReminderCount(ByVal al_Cursor As Long)
On Error GoTo ErrHandler

    Const c_SqlRequest2 As String = "exec TMT_WorkflowReminder_Count $WF_Id$,$Number_of_reminders$"
    
    Dim ls_req2 As String

    ls_req2 = c_SqlRequest2
    ls_req2 = Replace(c_SqlRequest2, "$WF_Id$", mo_Db.GetFields(al_Cursor, "WF_Id"), , , vbTextCompare)
    If mo_Db.GetFields(al_Cursor, "Number_of_reminders") = 0 Then
        ls_req2 = Replace(ls_req2, "$Number_of_reminders$", 1, , , vbTextCompare)
    Else
        ls_req2 = Replace(ls_req2, "$Number_of_reminders$", mo_Db.GetFields(al_Cursor, "Number_of_reminders") + 1, , , vbTextCompare)
    End If
    Call ExecuteSQLSafe(mo_Db, ls_req2)
    Exit Sub

ErrHandler:
    Call AddToLog("WorkflowReminderCount!", "E")
End Sub

Private Sub SendReminder(ByVal as_Message As String, ByVal al_U_Code As Long, ByVal as_Subject As String)
On Error GoTo ErrHandler

Dim lo_MailClient   As MailClient
Dim ll_Idx          As Long
    
    If mb_Initialized = False Then
        Exit Sub
    End If
    
    ' init MailClient
    Set lo_MailClient = New MailClient
    Set lo_MailClient.ArmDb = mo_Db
    lo_MailClient.U_Code = al_U_Code 'ml_U_code
    lo_MailClient.Load_A_COM

    ' set account which will be used by mo_MailClient
    If (lo_MailClient.SetActiveMailBox("TMT") = True) Then
           
        ll_Idx = lo_MailClient.AddEmail(as_Subject, as_Message, False, Now, "")
            
        Call lo_MailClient.AddEmailAddress(ll_Idx, lo_MailClient.GetAddressForUCode(al_U_Code), etEmailTo)
        Call lo_MailClient.SendEmail(ll_Idx)

    Else
        Call AddToLog("TMT Mail Account cannot be initialized.", "E")
    End If
        
    ' Unload MailClient
    lo_MailClient.Unload_A_COM
    Set lo_MailClient = Nothing
    Exit Sub
    
ErrHandler:
    
    Call UpdateError(True)
    If Not lo_MailClient Is Nothing Then
        lo_MailClient.Unload_A_COM
        Set lo_MailClient = Nothing
    End If
    Call UpdateError(False)
    Call errorHandler(C_MODULE_NAME & ".SendReminder")
End Sub
' **************************************************************************************************
' ********************************* PUBLIC CONTROL PROPERTIES **************************************
' **************************************************************************************************
' database controler property
' Params:
' ao_db (ARMSYSCOMLib.ArmDb) - ArmSysCom instance
#If LIVE Then
Public Property Set Db(ByRef ao_Db As Object)
#Else
Public Property Set Db(ByRef ao_Db As ARMSYSCOMLib.ArmDb)
#End If

On Error GoTo ErrHandler
    If Not mo_Db Is Nothing Then Err.Raise ArmErr.CPTAlreadyInitialized
    If ao_Db Is Nothing Then Err.Raise ArmErr.InvalidArgument
    
    Set mo_Db = ao_Db
    
    Exit Property
ErrHandler:
    Call errorHandler(C_MODULE_NAME & ".Db(Set)")
End Property

' Setting language code
Public Property Let Language_Code(ByVal as_newValue As String)
On Error GoTo ErrHandler
    If mb_Initialized Then Call Err.Raise(ArmErr.CPTAlreadyInitialized)
    If Len(as_newValue) <> 1 Then Call Err.Raise(ArmErr.InvalidArgument, "", "Language_code must contains only 1 char")
    
    ms_LanguageCode = as_newValue
    
    Exit Property
ErrHandler:
     Call errorHandler(C_MODULE_NAME & ".Language_Code")
End Property

' User code used in logs
Public Property Let U_Code(ByVal al_UserCode As Long)
On Error GoTo ErrHandler
    
    If mb_Initialized Then Call Err.Raise(ArmErr.CPTAlreadyInitialized)
    ml_U_Code = al_UserCode
    Exit Property
ErrHandler:
    Call errorHandler(C_MODULE_NAME & ".U_Code(Let)")
End Property

' ********************************* PUBLIC CONTROL PROPERTIES **************************************

' **************************************************************************************************
' ******************************* PUBLIC USER CONTROL METHODS **************************************
' **************************************************************************************************
' initialize user control
Public Function Load_A_COM() As Boolean
On Error GoTo ErrHandler
    
    Load_A_COM = False
    
    If mb_Initialized Then Err.Raise ArmErr.CPTAlreadyInitialized
       
    ml_LogLevel = 1
    
    If Get_A_Config("TMT_PLUGIN_PLUGIN_VERSION") <> PLUGIN_VERSION Then
        Call AddToLog("Incorrect TMT Plugin Version!", "E")
        Exit Function
    End If
    
    md_LastReminderSend = Get_A_Config("TMT_LAST_REMINDER_SEND")
    
    RaiseEvent OnAddToLog("Loaded", "I")
    
    mb_Initialized = True

    Load_A_COM = True
    Exit Function

ErrHandler:
    Call AddToLog("Error in TMT_Plugin Load_A_COM!", "E")
End Function

' uninitialize user control
Public Sub Unload_A_COM()
On Error GoTo ErrHandler
     
    'Other
    Set mo_Db = Nothing
    
    mb_Initialized = False

    Exit Sub
ErrHandler:
     Call errorHandler(C_MODULE_NAME & ".Unload_A_COM")
End Sub

Private Function ReplacePlaceHolder(ByVal as_Request As String, ByVal as_PlaceHolder As String, ByVal as_DefaultValue As String) As String
On Error GoTo ErrHandler
    
    ReplacePlaceHolder = Replace(as_Request, as_PlaceHolder, as_DefaultValue, , , vbTextCompare)

    Exit Function
ErrHandler:
    Call errorHandler(C_MODULE_NAME & ".ReplacePlaceholder")
End Function
' ******************************* PUBLIC USER CONTROL METHODS **************************************


' ************************************************************************************
' ********************** ERROR-HANDLING SUPPORT FUNCTIONS ****************************
' ************************************************************************************
' 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

Function MsgText(ByVal aID As Long, ByVal aLang As String, ByVal aDefault As String, Optional ByVal aInfo As Variant) As String
On Error GoTo ErrHandler

Const DB_REQ As String = "SELECT message_text FROM error_message WHERE msgid = $id$ AND Language_code = '$lang$'"

    MsgText = ""
    
    Dim lRequest As String
    lRequest = ReplacePlaceHolder(DB_REQ, "$id$", aID)
    lRequest = ReplacePlaceHolder(lRequest, "$lang$", aLang)
    Dim lData As Long
    
    lData = OpenSQLSafe(mo_Db, lRequest)
    
    Dim lBuffer As String
    lBuffer = mo_Db.GetFields(lData, "message_text")
    mo_Db.Close (lData)
    If lBuffer = "" Then lBuffer = aDefault
    
    Dim li_Idx As Integer
    If Not IsMissing(aInfo) Then
        For li_Idx = 0 To UBound(aInfo)
            lBuffer = Replace(lBuffer, aInfo(li_Idx, 0), aInfo(li_Idx, 1), , , vbTextCompare)
        Next li_Idx
    End If
    
    
    MsgText = lBuffer
    Exit Function
ErrHandler:
    mo_Db.Close (lData)
    Call MsgBox("Connection failure accessing message information.")
    MsgText = aDefault
End Function

' logs message to database
Private Sub LogMessage(ByVal as_logMsg As String, Optional ByVal as_logType As String = "E", Optional ab_ExitOnException As Boolean = False)
    Dim ll_errNumber As Long
    Dim ls_errDescription As String, ls_ErrSource As String
    
    ll_errNumber = Err.Number
    ls_errDescription = Err.Description
    ls_ErrSource = Err.Source

On Error GoTo ErrHandler

Const LOG_REQUEST As String = "EXEC A_log_ins $UCODE$,$LOGTYPE$,$MSG$,$APP$"
    Dim ls_req As String
    Dim ls_Source As String, ls_Msg As String
    
    ls_Source = SCREEN_NAME & " " & App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
    ls_Msg = as_logMsg & SEP1 & ll_errNumber & " : " & ls_errDescription & " - " & ls_ErrSource
     
    If ll_errNumber <> 0 Then
        RaiseEvent OnAddToLog(ls_Msg, as_logType)
    Else
        RaiseEvent OnAddToLog(as_logMsg, as_logType)
    End If
    
    ls_req = Replace(LOG_REQUEST, "$UCODE$", CStr(ml_U_Code), , , vbTextCompare)
    ls_req = Replace(ls_req, "$LOGTYPE$", SQLStr(as_logType), , , vbTextCompare)
    ls_req = Replace(ls_req, "$MSG$", SQLStr(Left(Trim(ls_Msg), 4000)), , , vbTextCompare)
    ls_req = Replace(ls_req, "$APP$", SQLStr(Left(Trim(ls_Source), 50)), , , vbTextCompare)
    
    Call ExecuteSQLSafe(mo_Db, ls_req)
    
    Err.Number = ll_errNumber
    Err.Description = ls_errDescription
    Err.Source = ls_ErrSource
    Exit Sub
    
ErrHandler:
    If ab_ExitOnException Then
        Call MsgBox("A fatal error occured. Unable to log error into database, the application will be closed. Please report the following message to your IT support: " & vbCrLf & _
            "Number:" & Err.Number & vbCrLf & "Description:" & Err.Description)
        End
    End If
    Err.Number = ll_errNumber
    Err.Description = ls_errDescription
    Err.Source = ls_ErrSource
End Sub

' procedure save/restore err object
Private Sub UpdateError(Optional ab_saveError As Boolean = False)
Static ls_ErrDesc As String
Static ls_ErrSource As String
Static ll_errnum As Long
    
    If ab_saveError Then
        ls_ErrDesc = Err.Description
        ls_ErrSource = Err.Source
        ll_errnum = Err.Number
    Else
        Err.Description = ls_ErrDesc
        Err.Source = ls_ErrSource
        Err.Number = ll_errnum
    End If
End Sub


' ********************** ERROR-HANDLING SUPPORT FUNCTIONS ****************************

' ************************************************************************************
' **************************** DB-ACCESS FUNCTIONS ***********************************
' ************************************************************************************

' 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

Private Function GetDbError(ByVal lo_Db As ARMSYSCOMLib.ArmDb) As String
On Error GoTo ErrHandler
    
    If IsArray(lo_Db.SQLErrorMessages) Then
        Debug.Assert (IsArray(mo_Db.SQLErrorCodes))
        ' Display errors msgBox
        GetDbError = Join(lo_Db.SQLErrorCodes, ",") & vbCrLf & Join(lo_Db.SQLErrorMessages, vbCrLf)
    Else
        ' ExecuteSQL failed but no error message?
        GetDbError = "Unknown error"
    End If
    Exit Function
ErrHandler:
    Call errorHandler("GetDbError()")
End Function

Public Function SQLStr(ByVal as_str As String, Optional ByVal al_MaxLen As Long = 0, Optional ByVal ab_LogError As Boolean = True) As String
On Error GoTo ErrHandler
    
    If as_str = "NULL" Then
        SQLStr = "NULL"
    Else
        If al_MaxLen > 0 Then
            as_str = Trim(as_str)
            If Len(as_str) > al_MaxLen Then
                If ab_LogError Then
                    Call LogMessage("Value trimmed (" & al_MaxLen & ") '" & as_str & "' to '" & Left(as_str, al_MaxLen) & "'")
                End If
                as_str = Left(as_str, al_MaxLen)
            End If
        End If
        SQLStr = "'" & Replace(as_str, "'", "''") & "'"
    End If
    Exit Function
ErrHandler:
    Call errorHandler("SQLStr as_Str=" & as_str)
End Function

Private Function SqlDbl(ByVal av_Data As Variant) As String
On Error GoTo ErrHandler

    SqlDbl = "NULL"
    If IsNull(av_Data) Then av_Data = ""
    If Trim(CStr(av_Data)) <> "" Then
        SqlDbl = Str(av_Data)
    End If
    Exit Function
ErrHandler:
    Call errorHandler("SqlDbl")
End Function

Private Function SqlDate(ByVal av_Data As Variant) As String
On Error GoTo ErrHandler

    SqlDate = "NULL"
    If IsNull(av_Data) Then av_Data = ""
    If (Trim(CStr(av_Data)) <> "") And (CStr(av_Data) <> "0") Then
        SqlDate = "'" & Format(av_Data, "yyyy-mm-dd") & "'"
    End If
    Exit Function
ErrHandler:
    Call errorHandler("SqlDate")
End Function

' **************************** DB-ACCESS FUNCTIONS ***********************************

' ************************************************************************************
' **************************** FRAMEWORK FUNCTIONS ***********************************
' ************************************************************************************

Private Function Get_A_Config(ByVal as_Key As String) As String
On Error GoTo ErrHandler

Dim ll_Curs As Long
Dim ls_req  As String

    Get_A_Config = ""
    ls_req = "select cfg_value from A_config where cfg_Key ='" & UCase(as_Key) & "'"
    
    ll_Curs = mo_Db.OpenSQL(ls_req)
    
        If ll_Curs = 0 Then
            Call AddToLog("Error executing " & ls_req & mo_Db.LastErrorCode & "  " & mo_Db.LastErrorMessage, "E")
            Exit Function
        Else
            If mo_Db.RowCount(ll_Curs) <> 1 Then
                mo_Db.Close (ll_Curs)
                Call AddToLog("Executing " & ls_req & " returned " & mo_Db.RowCount(ll_Curs) & " record(s) while one was expected", "E")
                Call errorHandler(C_MODULE_NAME & ".Get_A_Config")
                Exit Function
            Else
                Get_A_Config = mo_Db.GetFields(ll_Curs, 0)
                mo_Db.Close (ll_Curs)
            End If
        End If
    Exit Function
ErrHandler:
    Call AddToLog("Error in Get_A_Config! Key: " & as_Key, "E")
    Call errorHandler(C_MODULE_NAME & ".Get_A_Config")
End Function

Private Function Set_A_Config(ByVal as_Key As String, ByVal as_Value As String) As Boolean
On Error GoTo ErrHandler

Dim ll_Curs As Long
Dim ls_req  As String

    Set_A_Config = False
    ls_req = "UPDATE A_Config SET cfg_value ='" & as_Value & "'WHERE cfg_Key ='" & UCase(as_Key) & "'"
    
    ll_Curs = OpenSQLSafe(mo_Db, ls_req)
    
    Call mo_Db.Close(ll_Curs)
    ll_Curs = 0
        
    Exit Function
ErrHandler:
    Call errorHandler(C_MODULE_NAME & ".Set_A_Config")
End Function

Private Function Get_TMT_Message(ByVal al_msgid As Long, ByVal as_msgLang As String, ByVal as_Default As String) As String
On Error GoTo ErrHandler

Dim ll_Curs As Long
Dim ls_req  As String

    Get_TMT_Message = as_Default
    ls_req = "SELECT ISNULL( M2.message_text, M1.message_text) AS message_text " & _
             "FROM TMT_ERROR_MESSAGE M1 " & _
             "  LEFT JOIN TMT_Error_Message M2 ON M2.msgid=M1.msgid AND M2.language_code='" & UCase(as_msgLang) & "' " & _
             "WHERE M1.msgid=" & al_msgid & " AND M1.language_code='E'"
    
    ll_Curs = mo_Db.OpenSQL(ls_req)
    
        If ll_Curs = 0 Then
            Call AddToLog("Error executing " & ls_req & mo_Db.LastErrorCode & "  " & mo_Db.LastErrorMessage, "E")
            Exit Function
        Else
            If mo_Db.RowCount(ll_Curs) <> 1 Then
                mo_Db.Close (ll_Curs)
                Call AddToLog("Executing " & ls_req & " returned " & mo_Db.RowCount(ll_Curs) & " record(s) while one was expected", "E")
                Call errorHandler(C_MODULE_NAME & ".Get_TMT_Message")
                Exit Function
            Else
                Get_TMT_Message = mo_Db.GetFields(ll_Curs, 0)
                mo_Db.Close (ll_Curs)
            End If
        End If
    Exit Function
ErrHandler:
    Call AddToLog("Error in Get_TMT_Message! msgid: " & al_msgid & " language:" & as_msgLang, "E")
    Call errorHandler(C_MODULE_NAME & ".Get_TMT_Message")
End Function
' Log information
Private Sub AddToLog(ByVal as_Operation As String, Optional ByVal as_logType As String = "E", Optional ab_ExitOnException As Boolean = False)
Dim ll_errNumber As Long
Dim ls_errDescription As String, ls_ErrSource As String

ll_errNumber = Err.Number
ls_errDescription = Err.Description
ls_ErrSource = Err.Source
            
    On Error GoTo ErrHandler

    If ml_LogLevel <> 0 Or as_logType <> "D" Then
    
        Err.Number = ll_errNumber
        Err.Description = ls_errDescription
        Err.Source = ls_ErrSource
        
        Call LogMessage(as_Operation, as_logType, ab_ExitOnException)
    End If
    
    ll_errNumber = Err.Number
    ls_errDescription = Err.Description
    ls_ErrSource = Err.Source
    Exit Sub

ErrHandler:
    RaiseEvent OnAddToLog("Unable to create log." & SEP1 & Err.Number & " : " & Err.Description & " - " & Err.Source, "E")
    RaiseEvent OnAddToLog("Current error: " & SEP1 & ll_errNumber & " : " & ls_errDescription & " - " & ls_ErrSource, "E")
End Sub

' **************************** FRAMEWORK FUNCTIONS ***********************************

