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

Private Const PLUGIN_VERSION As String = "1.0.0"

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

Private Const C_MODULE_NAME As String = "SPA_Plugin"      ' module name used in log table
Private Const SCREEN_NAME As String = "SPA_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 mo_FSO                              As Object   ' filesystem object
Dim md_LastReminderSend                 As Date
Dim md_LastManualReminderCheck          As Date
Dim ml_ManualReminderCheckInterval      As Long     ' in seconds

Private ml_EML_Code                     As Long     ' EML_Code of processed email
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 mv_AccountsList                 As Variant  ' mail accounts scanned by SPA_Approval plugin

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

Private Enum en_SPA_TypeFlag
    PROJECT = 1
    STOCK = 2
End Enum
' *************************************** USER DEFINED ERRORS **************************************

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

Public Function ProcessOnReadMail(ByRef ao_MailData As MailData) As Boolean
On Error GoTo ErrHandler
    
Dim lb_Answer           As Boolean
Dim ll_SPA_ID           As Long
Dim ll_SIA_ID           As Long
Dim ls_ApproverName     As String
Dim ls_ApprovalStatus   As String
Dim ls_Msg              As String
Dim lo_MailClient       As MailClient
Dim ll_Auth_U_Code_From_Email   As Long
Dim ll_Auth_U_Code      As Long

    If mb_Initialized = False Then
        Exit Function
    End If
    
    Call AddToLog("SPA_Approval plugin ProcessOnReadMail started.", "I")
    
    'this needs to be set because of LogMessage where EML_Code is added
    ml_EML_Code = ao_MailData.EML_Code
    
    ' init MailClient
    Set lo_MailClient = New MailClient
    Set lo_MailClient.ArmDb = mo_Db
    lo_MailClient.U_Code = ml_U_Code
    lo_MailClient.Load_A_COM
    
    ' restrict from email address only to addresses available in GEN_Systems_Users
    ' this test is disabled because incoming mail format cannot be used
    
    ll_Auth_U_Code_From_Email = lo_MailClient.GetUCodeForAddress(ao_MailData.EML_Addresses_From)
    
    If ll_Auth_U_Code_From_Email = 0 Then
        Call AddToLog("Email ignored. Unknown email address:" & ao_MailData.EML_Addresses_From & ",EML_Code=" & ao_MailData.EML_Code, "E")
    Else
    
        ll_Auth_U_Code = IdentifySPA(ll_SPA_ID, ll_SIA_ID, ao_MailData)
        If ll_Auth_U_Code > 0 Then
            Call AddToLog("Email Identified.", "D")
            If ValidateAnswer(lb_Answer, ao_MailData) = True Then
                Call AddToLog("Answer is valid.", "D")
                ' the following test is disabled because incoming mail format cannot be used
                
                If AuthenticateApprover(ll_SPA_ID, ll_SIA_ID, ao_MailData) = True Then
                    Call AddToLog("Approver Authenticated.", "D")
                    If AvoidApprovalOverride(ll_SPA_ID, ll_SIA_ID, ls_ApproverName, ls_ApprovalStatus) = True Then
                        'all checks sucessfully passed, can approve
                        'if ls_Answer
                        Call ApplyApproval(ll_Auth_U_Code, ll_SPA_ID, ll_SIA_ID, lb_Answer, ao_MailData.EML_Code)
                    Else
                        ls_Msg = MsgText(8666, ms_LanguageCode, "#$Approver$ have already answer to this SPA Approval Request")
                        ls_Msg = Replace(ls_Msg, "$Approver$", ls_ApproverName, , , vbTextCompare)
                        ls_Msg = ls_Msg & " Current Status:" & ls_ApprovalStatus
                        Call AddToLog(ls_Msg, "I")
                        Call ReplyWithHistory(ls_Msg, ao_MailData)
                    End If
                Else
                    ls_Msg = MsgText(8665, ms_LanguageCode, "#You are not authorized to answer to this SPA Approval Request")
                    Call AddToLog(ls_Msg, "I")
                    Call ReplyWithHistory(ls_Msg, ao_MailData)
                End If
                
            Else
                ls_Msg = MsgText(8664, ms_LanguageCode, "#Unable to analyse the answer to the SPA Approval request. Please answer Yes,OK or NO")
                Call AddToLog(ls_Msg, "I")
                Call ReplyWithHistory(ls_Msg, ao_MailData)
            End If
        End If
    End If
    
    ' mark email like processed by SPA_Approval
    Call lo_MailClient.SetAppStatusForReadedEmail(-1, EML_APPSTATUS_PROCESSED, Val(ao_MailData.EML_Code))
    ' Unload MailClient
    lo_MailClient.Unload_A_COM
    Set lo_MailClient = Nothing
    
    ProcessOnReadMail = True
    Exit Function

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 AddToLog("Error in ProcessOnReadMail!", "E")
    ProcessOnReadMail = False
End Function

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("SPA_Approval plugin ProcessOnSendMail started.", "I")
    ProcessOnSendMail = True
    Exit Function

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

Public Function ProcessTasks() As Boolean

Dim ls_req                              As String
Dim ls_ManualReminderForce             As String
Dim ls_ABPE_SPA_SendRemindersTime      As String
Dim ld_TimeToSend                       As Date
Dim la_TimeArray()                      As String

On Error GoTo ErrHandler

    ProcessTasks = False
        
    If mb_Initialized = False Then
        Exit Function
    End If
        
    ls_ABPE_SPA_SendRemindersTime = Get_A_Config("ABPE_SPA_SendRemindersTime")
    la_TimeArray = Split(ls_ABPE_SPA_SendRemindersTime, ":")
    
    If UBound(la_TimeArray) = 2 Then
        ld_TimeToSend = TimeSerial(la_TimeArray(0), la_TimeArray(1), la_TimeArray(2))
        If DateDiff("d", md_LastReminderSend, Now) >= 1 And ld_TimeToSend <= TimeValue(Now) Then
            Call ProcessReminders
            Call ResendApprovalEmails
            md_LastReminderSend = Now
            Call Set_A_Config("ABPE_SPA_Last_Reminder_Send", Format(md_LastReminderSend, "yyyy/mm/dd hh:mm:ss"))
            ProcessTasks = True
        End If
    Else
        Call AddToLog("Send Reminders Time undefined! ABPE_SPA_SendRemindersTime in A_Config should be hh:mm:ss", "E")
    End If
    
    
    If ProcessTasks = False And DateDiff("s", md_LastManualReminderCheck, Now) > ml_ManualReminderCheckInterval Then
        ml_ManualReminderCheckInterval = Get_A_Config("ABPE_SPA_ManualReminderInterval")
        ls_ManualReminderForce = Get_A_Config("ABPE_SPA_ReminderForce")
        
        If ls_ManualReminderForce = "X" Then
            Call ProcessReminders
            Call ResendApprovalEmails
            Call Set_A_Config("ABPE_SPA_ReminderForce", "")
        End If
        
    End If
    ProcessTasks = True
    Exit Function

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

Private Function ResendApprovalEmails() As Boolean
Const RESEND_ALL As String = "UPDATE T1 SET T1.EML_MailStatus='N' FROM EML_Mail T1 " & _
                            "INNER JOIN SPA_ApprovalPath AP ON AP.EML_Code_Sent = T1.EML_Code " & _
                            "WHERE AP.Status_Code='1' AND AP.Date_Emailed is not NULL AND AP.Drop_Flag=''"
Const RESEND_LIST As String = "UPDATE T1 SET T1.EML_MailStatus='N' FROM EML_Mail T1 " & _
                            "INNER JOIN SPA_ApprovalPath AP ON AP.EML_Code_Sent = T1.EML_Code " & _
                            "WHERE AP.Status_Code='1' AND AP.Date_Emailed is not NULL AND AP.Auth_U_Code IN ($UCodes$) AND AP.Drop_Flag=''"

On Error GoTo ErrHandler

Dim ls_req                              As String
Dim ls_ResendAll                        As String
Dim la_ResendList()                     As String
Dim ls_ABPE_SPA_ReminderAllResend      As String
Dim ls_ABPE_SPA_ReminderAllResendOnce  As String
Dim ls_ABPE_SPA_ReminderUserResend     As String
Dim ls_ABPE_SPA_ReminderUserResendOnce As String
Dim ls_SerializedResendList             As String
Dim ll_Idx                              As Long

    ls_ABPE_SPA_ReminderAllResend = Get_A_Config("ABPE_SPA_ReminderAllResend")
    ls_ABPE_SPA_ReminderAllResendOnce = Get_A_Config("ABPE_SPA_ReminderAllResendOnce")
    ls_ABPE_SPA_ReminderUserResend = Get_A_Config("ABPE_SPA_ReminderUserResend")
    ls_ABPE_SPA_ReminderUserResendOnce = Get_A_Config("ABPE_SPA_ReminderUserResendOnce")

    ReDim la_ResendList(-1 To -1)
    ls_ResendAll = ""
    
    If ls_ABPE_SPA_ReminderAllResend = "X" Or ls_ABPE_SPA_ReminderAllResendOnce = "X" Then
        ls_ResendAll = "X"
    End If
    
    If ls_ResendAll <> "X" Then
        If Trim(ls_ABPE_SPA_ReminderUserResend) <> "" Then
            la_ResendList = Split(ls_ABPE_SPA_ReminderUserResend, ",")
        ElseIf Trim(ls_ABPE_SPA_ReminderUserResendOnce) <> "" Then
            la_ResendList = Split(ls_ABPE_SPA_ReminderUserResendOnce, ",")
        End If
    End If

    If ls_ResendAll = "X" Then
        ls_req = RESEND_ALL
        Call ExecuteSQLSafe(mo_Db, ls_req)
    ElseIf UBound(la_ResendList) >= 0 Then
        ls_req = RESEND_LIST
        ls_SerializedResendList = ""
        For ll_Idx = 0 To UBound(la_ResendList)
            If la_ResendList(ll_Idx) <> "" Then
                If ls_SerializedResendList <> "" Then
                    ls_SerializedResendList = ls_SerializedResendList & ","
                End If
                ls_SerializedResendList = ls_SerializedResendList & la_ResendList(ll_Idx)
            End If
        Next
        ls_req = Replace(ls_req, "$UCodes$", ls_SerializedResendList, , , vbTextCompare)
        Call ExecuteSQLSafe(mo_Db, ls_req)
    End If

    If ls_ABPE_SPA_ReminderAllResendOnce = "X" Then
        Call Set_A_Config("ABPE_SPA_ReminderAllResendOnce", "")
    End If
    If ls_ABPE_SPA_ReminderUserResendOnce <> "" Then
        Call Set_A_Config("ABPE_SPA_ReminderUserResendOnce", "")
    End If
            
    ResendApprovalEmails = True
    Exit Function
ErrHandler:
   
    ResendApprovalEmails = False
    Call ErrorHandler(C_MODULE_NAME & ".ResendApprovalEmails")
End Function


Private Function ProcessReminders() As Long
Const REMINDER_LST As String = "exec SPA_ApprovalReminder_Lst $Language_code$"

Const LAST_REMINDER_UPD As String = "UPDATE SPA_ApprovalPath SET Date_LastReminder=GetDate() " & _
                            "WHERE Status_Code=1 AND Date_Emailed is not NULL AND SPA_Id IN ($SPA_ID_LIST$) AND Drop_Flag=''"

On Error GoTo ErrHandler

Dim ls_req                              As String
Dim ll_Cursor                           As Long
Dim ll_Auth_U_Code                      As Long
Dim ls_Message                          As String
Dim ls_MessageHeader                    As String
Dim ls_MessageFooter                    As String
Dim ls_SPA_Id_List                      As String
Dim ls_comment                          As String
            
    ls_req = REMINDER_LST
    ls_req = Replace(ls_req, "$Language_code$", "'" & ms_LanguageCode & "'", , , vbTextCompare)
    
    'Debug.Print 1 / 0
    
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    If mo_Db.RowCount(ll_Cursor) > 0 Then
        ll_Auth_U_Code = 0
        ls_MessageHeader = "<table border='1'><tr><td>SPA Id</td><td>Project Name</td><td>Required by</td><td>Requestor</td><td>Customer</td><td>Cust. country</td></tr>"
        'ls_MessageHeader = "SPA Id" & vbTab & "Project Name" & vbTab & "Required by" & vbNewLine
        ls_MessageFooter = "</table>"
        'ls_MessageFooter = ""
        ll_Auth_U_Code = mo_Db.GetFields(ll_Cursor, "Auth_U_Code")
        
        While Not mo_Db.EOF(ll_Cursor)
            
            ls_Message = ""
            ls_SPA_Id_List = ""
            
            While Not mo_Db.EOF(ll_Cursor) And ll_Auth_U_Code = mo_Db.GetFields(ll_Cursor, "Auth_U_Code")
                If ls_SPA_Id_List <> "" Then
                    ls_SPA_Id_List = ls_SPA_Id_List & ","
                End If
                ls_SPA_Id_List = ls_SPA_Id_List & mo_Db.GetFields(ll_Cursor, "SPA_Id")
                
                ls_Message = ls_Message & "<tr><td>" & mo_Db.GetFields(ll_Cursor, "SPA_Id") & "</td>"
                
                ls_comment = mo_Db.GetFields(ll_Cursor, "SP_Desc")
                
                If ls_comment = "" Then
                    ls_comment = "&nbsp;"
                End If
                
                If mo_Db.GetFields(ll_Cursor, "SPA_TypeFlag") = en_SPA_TypeFlag.STOCK Then
                    ls_Message = ls_Message & "<td>" & mo_Db.GetFields(ll_Cursor, "RF_desc") & "</td>"
                Else
                    ls_Message = ls_Message & "<td>" & ls_comment & "</td>"
                End If
                
                If mo_Db.GetFields(ll_Cursor, "Date_Required") = 0 Then
                    ls_Message = ls_Message & "<td>" & "&nbsp;" & "</td>"
                Else
                    ls_Message = ls_Message & "<td>" & mo_Db.GetFields(ll_Cursor, "Date_Required") & "</td>"
                End If
                
                ' Requestor
                ls_Message = ls_Message & "<td>" & mo_Db.GetFields(ll_Cursor, "U_Name") & "</td>"
                
                ' Customer
                ls_Message = ls_Message & "<td>" & mo_Db.GetFields(ll_Cursor, "CCU_Desc") & "</td>"
                
                ' Customer country
                ls_Message = ls_Message & "<td>" & mo_Db.GetFields(ll_Cursor, "CT_Code") & "</td>"
                                
                
                ls_Message = ls_Message & "</tr>"
                'txt version
                'ls_Message = ls_Message & mo_Db.GetFields(ll_Cursor, "SPA_Id") & vbTab
                'ls_Message = ls_Message & mo_Db.GetFields(ll_Cursor, "SP_Desc") & vbTab
                'ls_Message = ls_Message & mo_Db.GetFields(ll_Cursor, "Date_Required") & vbNewLine
                Call mo_Db.Next(ll_Cursor)
            Wend
            
            ls_Message = ls_MessageHeader & ls_Message & ls_MessageFooter
            Call SendReminder(ls_Message, ll_Auth_U_Code)
            
            ls_req = Replace(LAST_REMINDER_UPD, "$SPA_ID_LIST$", ls_SPA_Id_List, , , vbTextCompare)
            Call ExecuteSQLSafe(mo_Db, ls_req)
            
            ll_Auth_U_Code = mo_Db.GetFields(ll_Cursor, "Auth_U_Code")
                            
        Wend
    End If
        
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    Exit Function
ErrHandler:
   
    If ll_Cursor <> 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    
    ProcessReminders = 0
    Call ErrorHandler(C_MODULE_NAME & ".ProcessReminders")
End Function

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

Dim lo_MailClient   As MailClient
Dim ll_Idx          As Long
    
    ' init MailClient
    Set lo_MailClient = New MailClient
    Set lo_MailClient.ArmDb = mo_Db
    lo_MailClient.U_Code = ml_U_Code
    lo_MailClient.Load_A_COM

    ' set account which will be used by mo_MailClient
    lo_MailClient.SetActiveMailBox ("SPA Approval")
           
    ll_Idx = lo_MailClient.AddEmail("Outstanding SPAs for " & Format(Now, "yyyy/mm/dd hh:mm:ss"), as_Message, True, Now, "")
        
    Call lo_MailClient.AddEmailAddress(ll_Idx, lo_MailClient.GetAddressForUCode(al_U_Code), etEmailTo)
    Call lo_MailClient.SendEmail(ll_Idx)

    ' 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

Private Sub ReplyWithHistory(ByVal as_Message As String, ByRef ao_MailData As MailData)
On Error GoTo ErrHandler

Dim lo_MailClient   As MailClient
Dim ll_Idx          As Long
    
    ' init MailClient
    Set lo_MailClient = New MailClient
    Set lo_MailClient.ArmDb = mo_Db
    lo_MailClient.U_Code = ml_U_Code
    lo_MailClient.Load_A_COM

    ' set account which will be used by mo_MailClient
    lo_MailClient.SetActiveMailBox ("SPA Approval")
       
    ll_Idx = lo_MailClient.AddEmail("RE:" & ao_MailData.EML_Subject, as_Message & vbNewLine & vbNewLine & ao_MailData.EML_Body, False, Now, "")
        
    Call lo_MailClient.AddEmailAddress(ll_Idx, ao_MailData.EML_Addresses_From, etEmailTo)
    Call lo_MailClient.SendEmail(ll_Idx)

    ' 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 & ".ReplyWithHistory")
End Sub

Public Sub Init()
On Error GoTo ErrHandler

Dim lo_MailClient   As MailClient
Dim lo_MailData     As MailData
Dim ll_EmailsCount  As Long
Dim ll_Idx          As Long
Dim ll_Idx2         As Long
Dim ll_Idx3         As Long
Dim ll_NrOfAttach   As Long
Dim ls_MailAttPath  As String
Dim lo_folder           As Object

    Set lo_MailClient = New MailClient
    Set lo_MailClient.ArmDb = mo_Db
    lo_MailClient.U_Code = ml_U_Code
    lo_MailClient.Load_A_COM
    
    ls_MailAttPath = App.Path & "\Temp\" & C_MODULE_NAME
    If Not mo_FSO.FolderExists(ls_MailAttPath) Then
        If Not CreateDirStruct(ls_MailAttPath, mo_FSO) Then
            Call Err.Raise(CompFncFailed, "Init", "Folder for incoming email attachment does not exist and cannot be created. (" & ls_MailAttPath & ")")
        End If
    End If
    
    Set lo_folder = mo_FSO.GetFolder(ls_MailAttPath)
    
    For ll_Idx = 0 To UBound(mv_AccountsList) - 1
    
        ' set account which will be used by MailClient
        If lo_MailClient.SetActiveMailBox(mv_AccountsList(ll_Idx)) = True Then
        
            ll_EmailsCount = lo_MailClient.ReadEmails("N", "") ' read all unprocessed emails
            
            For ll_Idx2 = 0 To ll_EmailsCount - 1
                
                ll_NrOfAttach = lo_MailClient.GetNumberOfAttachments(ll_Idx2)
                
                Call mo_FSO.DeleteFile(ls_MailAttPath & "\*.*", True)
                
                For ll_Idx3 = 0 To ll_NrOfAttach - 1
                    Call lo_MailClient.GetAttachment(ll_Idx2, ll_Idx3, ls_MailAttPath, , True)
                Next
                                
                Set lo_MailData = New MailData
                Call lo_MailClient.GetEmailData(ll_Idx2, lo_MailData)
                lo_MailData.EML_Attachments = lo_folder
                
                'Call OnReadMail Event for SPA_Approval
                Call ProcessOnReadMail(lo_MailData)
                
                Set lo_MailData = Nothing

            Next
        Else
            Call AddToLog("SPA_Approval Mail Account cannot be initialized:" & mv_AccountsList(ll_Idx), "E")
        End If
    Next
                
    ' Unload MailClient
    lo_MailClient.Unload_A_COM
    Set lo_MailClient = Nothing
    Exit Sub
    
ErrHandler:
    
    Set lo_MailData = Nothing
    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 AddToLog("Error in Init!", "E")
    Call ErrorHandler(C_MODULE_NAME & ".Init")
End Sub

Private Function ApplyApproval(ByVal al_Approving_U_Code As Long, ByVal al_SPA_ID As Long, ByVal al_SIA_ID As Long, ByVal ab_Answer As Boolean, ByVal al_EML_Code) As Boolean
Const APPLY_APPROVAL As String = _
"UPDATE SPA_ApprovalPath AP SET Status_Code=2 " & _
"WHERE SPA_ID=$SPA_ID$ AND SIA_ID=$SIA_ID$"

Dim ls_req                          As String

On Error GoTo ErrHandler

    ApplyApproval = False
    
    Dim lo_SPA_Approval   As SPA_Approval
    
    ' init SPA_Approval
    Set lo_SPA_Approval = New SPA_Approval
    Set lo_SPA_Approval.Db = mo_Db
    lo_SPA_Approval.U_Code = ml_U_Code
    lo_SPA_Approval.MailBox = "SPA Approval"
    lo_SPA_Approval.Load_A_COM
    
    On Error Resume Next
    
    If lo_SPA_Approval.SetSIAStatus(al_Approving_U_Code, al_SPA_ID, al_SIA_ID, ab_Answer, al_EML_Code) = False Then
        Call AddToLog("ApplyApproval:" & lo_SPA_Approval.LastErrorMessage, "E")
        Call AddToLog("SetSIAStatus error for SPA_ID:" & al_SPA_ID & ",SIA_ID:" & al_SIA_ID & ",by U_Code:" & al_Approving_U_Code & ",Answer was:" & ab_Answer & ",EML_Code:" & al_EML_Code, "E")
    Else
        Call AddToLog("New status set for SPA_ID:" & al_SPA_ID & ",SIA_ID:" & al_SIA_ID & ",by U_Code:" & al_Approving_U_Code & ",Answer was:" & ab_Answer, "I")
    End If
    
    On Error GoTo ErrHandler
    
    ' Unload SPA_Approval
    lo_SPA_Approval.Unload_A_COM
    Set lo_SPA_Approval = Nothing
    
    ApplyApproval = True
    Exit Function

ErrHandler:
    
    ApplyApproval = False
    
    Call UpdateError(True)
    If Not lo_SPA_Approval Is Nothing Then
        lo_SPA_Approval.Unload_A_COM
        Set lo_SPA_Approval = Nothing
    End If
    Call UpdateError(False)

    Call ErrorHandler(C_MODULE_NAME & ".ApplyAproval")
End Function

Private Function AvoidApprovalOverride(ByVal al_SPA_ID As Long, ByVal al_SIA_ID As Long, ByRef as_ApproverName As String, ByRef as_StatusDesc As String) As Boolean
Const APPR_OVERIDE As String = _
"SELECT AP.Status_Code,RM.RF_desc,PE.P_Name + ' ' + PE.P_First_Name as ApproverName " & _
"FROM SPA_ApprovalPath AP " & _
"INNER JOIN A_References_ML RM ON RM.GR_Code=204 AND RM.RF_Code=AP.Status_Code AND RM.Language_Code=$Language_code$ " & _
"INNER JOIN GEN_Systems_Users SU ON SU.U_Code = AP.Approving_U_Code " & _
"INNER JOIN GEN_People PE ON PE.P_Code = SU.P_Code " & _
"WHERE SPA_ID=$SPA_ID$ AND SIA_ID=$SIA_ID$ AND AP.Drop_Flag=''"

Dim ll_StatusCode As Long
Dim ls_req                          As String
Dim ll_Cursor                       As Long

On Error GoTo ErrHandler

    AvoidApprovalOverride = False
    
    ls_req = Replace(APPR_OVERIDE, "$SPA_ID$", SqlDbl(al_SPA_ID), , , vbTextCompare)
    ls_req = Replace(ls_req, "$SIA_ID$", SqlDbl(al_SIA_ID), , , vbTextCompare)
    ls_req = Replace(ls_req, "$Language_code$", SQLStr(ms_LanguageCode), , , vbTextCompare)
        
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    If mo_Db.RowCount(ll_Cursor) > 0 Then
        ll_StatusCode = mo_Db.GetFields(ll_Cursor, "Status_Code")
        
        If ll_StatusCode = 1 Then
            AvoidApprovalOverride = True
        Else
            as_ApproverName = mo_Db.GetFields(ll_Cursor, "ApproverName")
            as_StatusDesc = mo_Db.GetFields(ll_Cursor, "RF_desc")
        End If
    Else
        AvoidApprovalOverride = True
    End If
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    Exit Function

ErrHandler:
    
    AvoidApprovalOverride = False
    
    Call UpdateError(True)
    
    If ll_Cursor > 0 Then
        mo_Db.Close (ll_Cursor)
        ll_Cursor = 0
    End If

    Call UpdateError(False)
    
    Call ErrorHandler(C_MODULE_NAME & ".AvoidApprovalOverride")
End Function

Private Function AuthenticateApprover(ByVal al_SPA_ID As Long, ByVal al_SIA_ID As Long, ByRef ao_MailData As MailData) As Boolean
Const AUTH_APPROVER As String = "SELECT Auth_U_Code FROM SPA_ApprovalPath WHERE SPA_ID=$SPA_ID$ AND SIA_ID=$SIA_ID$"

On Error GoTo ErrHandler

Dim ll_Auth_U_Code_From_Email       As Long
Dim ll_Auth_U_Code_From_Subject     As Long
Dim lo_MailClient                   As MailClient
Dim ls_req                          As String
Dim ll_Cursor                       As Long

    Set lo_MailClient = New MailClient
    Set lo_MailClient.ArmDb = mo_Db
    lo_MailClient.U_Code = ml_U_Code
    lo_MailClient.Load_A_COM
    
    AuthenticateApprover = False

    ll_Auth_U_Code_From_Email = lo_MailClient.GetUCodeForAddress(ao_MailData.EML_Addresses_From)
        
    ls_req = Replace(AUTH_APPROVER, "$SPA_ID$", SqlDbl(al_SPA_ID), , , vbTextCompare)
    ls_req = Replace(ls_req, "$SIA_ID$", SqlDbl(al_SIA_ID), , , vbTextCompare)
        
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    If mo_Db.RowCount(ll_Cursor) > 0 Then
        ll_Auth_U_Code_From_Subject = mo_Db.GetFields(ll_Cursor, "Auth_U_Code")
    End If
    
    If ll_Auth_U_Code_From_Email = ll_Auth_U_Code_From_Subject Then
        AuthenticateApprover = True
    End If
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    ' Unload MailClient
    lo_MailClient.Unload_A_COM
    Set lo_MailClient = Nothing
    Exit Function
    
ErrHandler:
        
    Call UpdateError(True)
    
    AuthenticateApprover = False
    
    If ll_Cursor > 0 Then
        mo_Db.Close (ll_Cursor)
        ll_Cursor = 0
    End If
    
    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 & ".AuthenticateApprover")
End Function


Private Function ValidateAnswer(ByRef ab_Answer As Boolean, ByRef ao_MailData As MailData) As Boolean
On Error GoTo ErrHandler
    
Dim ls_TrimmedBody  As String
Dim la_Approved()   As String
Dim la_Reject()     As String
Dim ll_Idx          As Long

    ValidateAnswer = False
        
    ls_TrimmedBody = Replace(ao_MailData.EML_Body, vbCrLf, "", , , vbTextCompare)
    ls_TrimmedBody = Replace(ls_TrimmedBody, Chr(160), "", , , vbTextCompare)
    ls_TrimmedBody = Replace(UCase(Trim(ls_TrimmedBody)), " ", "", , , vbTextCompare)
        
    la_Approved = Split(Get_A_Config("ABPE_SPA_KEY_Approve"), SEP, , vbTextCompare)
    
    For ll_Idx = 0 To UBound(la_Approved)
        If Left(ls_TrimmedBody, Len(Replace(UCase(la_Approved(ll_Idx)), " ", "", , , vbTextCompare))) = Replace(UCase(la_Approved(ll_Idx)), " ", "", , , vbTextCompare) Then
        ab_Answer = True
        ValidateAnswer = True
            Exit Function
    End If
    Next
    
    la_Reject = Split(UCase(Get_A_Config("ABPE_SPA_KEY_Reject")), SEP, , vbTextCompare)
    
    For ll_Idx = 0 To UBound(la_Reject)
        If Left(ls_TrimmedBody, Len(Replace(UCase(la_Reject(ll_Idx)), " ", "", , , vbTextCompare))) = Replace(UCase(la_Reject(ll_Idx)), " ", "", , , vbTextCompare) Then
        ab_Answer = False
        ValidateAnswer = True
            Exit Function
    End If
    Next
    
    Exit Function
ErrHandler:
    ValidateAnswer = False
    Call ErrorHandler(C_MODULE_NAME & ".ValidateAnswer")
End Function

Private Function IdentifySPA(ByRef al_SPA_ID As Long, ByRef al_SIA_ID As Long, ByRef ao_MailData As MailData) As Long
Const VALIDATE_REQUEST As String = "SELECT Auth_U_Code, Drop_Flag FROM SPA_ApprovalPath WHERE SPA_ID=$SPA_ID$ AND SIA_ID=$SIA_ID$"

On Error GoTo ErrHandler

Dim ll_Subj_len         As Long
Dim ll_SPA_pos          As Long
Dim ll_SIA_ID_start_pos   As Long
Dim ll_SIA_ID_end_pos   As Long
Dim ls_SPA_ID           As Long
Dim ls_SIA_ID           As Long
Dim ls_req              As String
Dim ll_Cursor           As Long
Dim ls_ErrMsg            As String

    IdentifySPA = 0
    
    ll_SPA_pos = 0
    ll_SIA_ID_start_pos = 0
    ll_SIA_ID_end_pos = 0
    
    ll_Subj_len = Len(ao_MailData.EML_Subject)
    ll_SPA_pos = InStr(1, ao_MailData.EML_Subject, " SPA ", vbTextCompare)
    If ll_SPA_pos > 0 Then
        ll_SIA_ID_start_pos = InStr(ll_SPA_pos, ao_MailData.EML_Subject, " (", vbTextCompare)
    End If
    If ll_SIA_ID_start_pos > 0 Then
        ll_SIA_ID_end_pos = InStr(ll_SIA_ID_start_pos, ao_MailData.EML_Subject, ")", vbTextCompare)
    End If
    
    If ll_SPA_pos > 0 And ll_SIA_ID_start_pos > 0 And ll_SIA_ID_end_pos > 0 Then
        ls_SPA_ID = Val(Mid(ao_MailData.EML_Subject, ll_SPA_pos + 5, ll_SIA_ID_start_pos - (ll_SPA_pos + 5)))
        ls_SIA_ID = Val(Mid(ao_MailData.EML_Subject, ll_SIA_ID_start_pos + 2, ll_SIA_ID_end_pos - (ll_SIA_ID_start_pos + 2)))
        
        ls_req = Replace(VALIDATE_REQUEST, "$SPA_ID$", SQLStr(ls_SPA_ID), , , vbTextCompare)
        ls_req = Replace(ls_req, "$SIA_ID$", SQLStr(ls_SIA_ID), , , vbTextCompare)
        
        ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
        If mo_Db.RowCount(ll_Cursor) > 0 Then
            If mo_Db.GetFields(ll_Cursor, "Drop_Flag") = "X" Then
                ' SPA_ID was dropped in after sending the request
                ls_ErrMsg = MsgText(8668, ms_LanguageCode, "#Approval request was dropped. For more info, please contact Application Support.")
                Call AddToLog(ls_ErrMsg, "I")
                Call ReplyWithHistory(ls_ErrMsg, ao_MailData)
            Else
                ' subject ok and combination ok
                IdentifySPA = mo_Db.GetFields(ll_Cursor, "Auth_U_Code")
                al_SPA_ID = ls_SPA_ID
                al_SIA_ID = ls_SIA_ID
            End If
        Else
            ' SPA_ID SIA_ID combination is not valid
            ls_ErrMsg = MsgText(8667, ms_LanguageCode, "#Unable to find a SPA with this ID. Please contact Application Support.")
            Call AddToLog(ls_ErrMsg, "I")
            Call ReplyWithHistory(ls_ErrMsg, ao_MailData)
        End If
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
        
    Else
        ' subject does not match expected format
        ls_ErrMsg = MsgText(8663, ms_LanguageCode, "#Unable  to identity the SPA")
        Call AddToLog(ls_ErrMsg, "I")
        Call ReplyWithHistory(ls_ErrMsg, ao_MailData)
    End If
    Exit Function

ErrHandler:
    If ll_Cursor <> 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    
    IdentifySPA = 0
    Call ErrorHandler(C_MODULE_NAME & ".IdentifySPA")
End Function

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

' **************************************************************************************************
' ********************************* 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 AccountsList(ByVal av_Accounts As Variant)
On Error GoTo ErrHandler
    
    If mb_Initialized Then Call Err.Raise(ArmErr.CPTAlreadyInitialized)
    mv_AccountsList = av_Accounts
    Exit Property
ErrHandler:
    Call ErrorHandler(C_MODULE_NAME & ".AccountsList(Let)")
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
    
    Set mo_FSO = CreateObject("Scripting.FileSystemObject")
    
    If Get_A_Config("ABPE_SPA_PluginVersion") <> PLUGIN_VERSION Then
        Call AddToLog("Incorrect SPA Plugin Version!", "E")
        Exit Function
    End If
    
    md_LastReminderSend = Get_A_Config("ABPE_SPA_Last_Reminder_Send")
    md_LastManualReminderCheck = 0
    ml_ManualReminderCheckInterval = Get_A_Config("ABPE_SPA_ManualReminderInterval")

    RaiseEvent OnAddToLog("Loaded", "I")
    
    mb_Initialized = True

    Load_A_COM = True
    Exit Function
ErrHandler:
    Call AddToLog("Error in SPA Plugin Load_A_COM!", "E")
End Function

' uninitialize user control
Public Sub Unload_A_COM()
On Error GoTo ErrHandler
     
    'Other
    Set mo_Db = Nothing
    Set mo_FSO = 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 & "/" & ml_EML_Code
    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 ***********************************
' ************************************************************************************

' 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 ***********************************

' *******************************************************************************
' ************************ DISK IO FUNCTIONS ************************************
' *******************************************************************************
' create directory if not exist
Private Function CreateDirStruct(ByVal strPath As String, ByVal ao_FSO As Object) As Boolean

On Error GoTo Create_Dir_Struct_Errors
    Dim intIndex    As Integer
    Dim strTmpPath  As String
    
    If Len(Trim$(strPath)) = 0 Then
        ' if we specify wrong path it is error
        CreateDirStruct = False
        Exit Function
    End If
    
    If right$(strPath, 1) <> "\" Then strPath = strPath & "\"
    intIndex = 0
    
    Do
        ' get the next path chunk
        intIndex = InStr(intIndex + 1, strPath, "\")
        
        If intIndex > 0 Then
            strTmpPath = Left$(strPath, intIndex - 1)
        Else
            Exit Do
        End If
        
        ' see if this folder exists
        If Not ao_FSO.FolderExists(strTmpPath) Then
            ' Create this folder.
            ' If there is an error, it will be trapped bellow
            ao_FSO.CreateFolder strTmpPath
            intIndex = 1
        End If
    Loop
    CreateDirStruct = True
    Exit Function

Create_Dir_Struct_Errors:
    Call ErrorHandler(C_MODULE_NAME & ".CreateDirStruct()")
End Function

' delete files one by one
Private Function DeleteFiles(ByVal as_Path As String, ByVal as_pattern As String, ao_FSO As Object) As Boolean
  
On Error GoTo KillFiles_Errors
  
    Dim lo_Files    As Object
    Dim lo_folder   As Object
    Dim lo_File     As Object


    Set lo_folder = ao_FSO.GetFolder(as_Path)
    Set lo_Files = lo_folder.Files

    For Each lo_File In lo_Files
        If lo_File.Name Like as_pattern Then Call DeleteFile(lo_File)
    Next
    
    Set lo_File = Nothing
    Set lo_Files = Nothing
    Set lo_folder = Nothing
    
    DeleteFiles = True
    Exit Function
    
KillFiles_Errors:
    ' free resources
    If Not lo_File Is Nothing Then Set lo_File = Nothing
    If Not lo_Files Is Nothing Then Set lo_Files = Nothing
    If Not lo_folder Is Nothing Then Set lo_folder = Nothing
    
    Call ErrorHandler(C_MODULE_NAME & ".DeleteFiles()")
End Function

' function will delete file
' if file cannot be deleted, function return false and log event
Private Function DeleteFile(ByVal ao_File As Object) As Boolean
On Error GoTo KillFile_Errors
    Debug.Assert (Not ao_File Is Nothing)
    ao_File.Delete (True)
    DeleteFile = True
    Exit Function
KillFile_Errors:
    Call ErrorHandler(C_MODULE_NAME & "DeleteFile()")
End Function
' ************************ DISK IO FUNCTIONS ************************************


