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

Private Const EMPTY_STRING      As String = ""
Private m_CN                    As ADODB.Connection
Private m_RS                    As ADODB.Recordset
Private m_OpenConnection        As Boolean

Private WithEvents m_Login      As Login
Attribute m_Login.VB_VarHelpID = -1

Public Sub Initialize()
    Set m_Login = New Login
    Set m_CN = m_Login.MyDBConnection
End Sub

Public Property Get IsConnected() As Boolean
    IsConnected = m_OpenConnection
End Property

Public Function getRows(ByVal eActionID As ExecuteActionID, ParamArray ActionParams() As Variant) As ADODB.Recordset
    If executeAction(eActionID, ActionParams(0)) Then Set getRows = m_RS
End Function

Public Property Get ConnectionStatus() As ObjectStateEnum
    ConnectionStatus = m_CN.State
End Property

Public Function UserExists(ByVal UserName As String) As Boolean
    If executeAction(bea_VerifyUser, UserName) Then UserExists = (Not m_RS.EOF And Not m_RS.BOF)
End Function

Public Function PrisonNumberExists(ByVal TableName As String, ByVal PrisonNumber As String) As Boolean
    Set m_RS = m_CN.Execute("SELECT * FROM `" & TableName & "` WHERE prison_no = '" & PrisonNumber & "'")
    PrisonNumberExists = (Not m_RS.EOF And Not m_RS.BOF)
End Function

Public Function PasswordVerified(ByVal UserName As String, ByVal UserPassword As String) As Boolean
    If executeAction(bea_VerifyPassword, UserName, UserPassword) Then PasswordVerified = (Not m_RS.EOF And Not m_RS.BOF)
End Function

Public Function PrisonerName(ByVal PrisonerNumber As String) As String
    If executeAction(bea_FetchPrisonerName, PrisonerNumber) Then PrisonerName = m_RS.Fields("fullname")
End Function

Public Function FetchInmateDetails(ByVal PrisonerNumber As String) As String()
    If executeAction(bea_FetchInmateDetails, PrisonerNumber) Then FetchInmateDetails = Split(m_RS.Fields("inmate_details"), "|")
End Function

Public Function FetchSingleInmate(ByRef This As Form, ByVal PrisonNumber As String) As Boolean
    If executeAction(bea_FetchInmateRecord, PrisonNumber) Then
        SetFields This, m_RS
        FetchSingleInmate = True
    Else
        FetchSingleInmate = False
    End If
End Function

Public Function FetchSingleRecord(ByRef This As Form, ByVal TagPrefix As String, ByVal eAction As ExecuteActionID, ByVal RecID As String) As Boolean
    If executeAction(eAction, RecID) = True Then
        SetDataByFieldName This, TagPrefix, m_RS
        FetchSingleRecord = True
    Else
        FetchSingleRecord = False
    End If
End Function

Public Function FetchRecords(ByRef lvw As ListView, ByVal eAction As ExecuteActionID, ByVal ConcatCol As String, Optional ByVal SetTag As Boolean = False) As Boolean
    
    If executeAction(eAction, EMPTY_STRING) Then
    
        Dim i               As Integer
        Dim details()       As String
        Dim Item            As ListItem
        
        lvw.ListItems.Clear
        Do While Not m_RS.EOF
            details = Split(m_RS.Fields(ConcatCol), "|")
            Set Item = lvw.ListItems.Add(, , details(0))
            For i = 1 To lvw.ColumnHeaders.Count - 1
                Item.ListSubItems.Add , , details(i)
            Next
            If SetTag Then Item.Tag = details(i)
            m_RS.MoveNext
        Loop
        FetchRecords = True
        
    Else
        
        FetchRecords = False
        
    End If
    
End Function

Public Function FetchPrisonNumbers(ByVal eAction As ExecuteActionID, ByVal InmateName As String) As String()
    
    If executeAction(eAction, InmateName) Then
        Dim ctr                 As Integer
        Dim PrisonNumbers()     As String
        ReDim PrisonNumbers(500) As String
        
        If Not m_RS.EOF And Not m_RS.BOF Then
            Do While Not m_RS.EOF
                ctr = ctr + 1
                PrisonNumbers(ctr) = m_RS.Fields("prison_number")
                m_RS.MoveNext
            Loop
            ReDim Preserve PrisonNumbers(ctr) As String
            FetchPrisonNumbers = PrisonNumbers
        End If
    End If
        
End Function

Public Function FetchInmates(ByRef lvw As ListView) As Boolean
    
    If executeAction(bea_FetchInmates, EMPTY_STRING) Then
    
        Dim i               As Integer
        Dim details()       As String
        Dim Item            As ListItem
        
        lvw.ListItems.Clear
        Do While Not m_RS.EOF
            details = Split(m_RS.Fields("inmate"), "|")
            Set Item = lvw.ListItems.Add(, , details(0))
            For i = 1 To lvw.ColumnHeaders.Count - 1
                Item.ListSubItems.Add , , details(i)
            Next
            m_RS.MoveNext
        Loop
        FetchInmates = True
    Else
        FetchInmates = False
    End If
    
End Function

Public Function FetchItems(ByRef lvw As ListView, ByVal PrisonNumber As String) As Boolean

    If executeAction(bea_FetchItems, PrisonNumber) Then
    
        Dim i               As Integer
        Dim details()       As String
        Dim Item            As ListItem
        
        lvw.ListItems.Clear
        Do While Not m_RS.EOF
            details = Split(m_RS.Fields("item"), "|")
            Set Item = lvw.ListItems.Add(, , details(0))
            For i = 1 To lvw.ColumnHeaders.Count - 1
                Item.ListSubItems.Add , , details(i)
            Next
            m_RS.MoveNext
        Loop
        FetchItems = True
    Else
        FetchItems = False
    End If

End Function

Private Sub SetFields(ByRef This As Form, ByVal pRS As ADODB.Recordset)

    Dim Ctrl            As Control
    Dim FieldIndex      As Integer
    Dim Data            As String
        
        For Each Ctrl In This.Controls
            If Ctrl.Tag <> EMPTY_STRING Then
                FieldIndex = CInt(Ctrl.Tag)
                If TypeOf Ctrl Is ComboBox Then
                    Ctrl.ListIndex = ListIndex(Ctrl, pRS.Fields(FieldIndex).value)
                ElseIf TypeOf Ctrl Is TextBox Then
                    Ctrl.Text = pRS.Fields(FieldIndex).value
                ElseIf TypeOf Ctrl Is Label Then
                    Ctrl.Caption = pRS.Fields(FieldIndex).value
                ElseIf TypeOf Ctrl Is DTPicker Then
                    Data = pRS.Fields(FieldIndex).value
                    If Data = EMPTY_STRING Then
                        Ctrl.value = Date
                    Else
                        Ctrl.value = Format(CDate(Data), "Short Date")
                    End If
                End If
            End If
        Next
        
End Sub

Private Sub SetDataByFieldName(ByRef This As Form, ByVal TagPrefix As String, ByVal pRS As ADODB.Recordset)

    Dim Ctrl            As Control
    Dim Prefix          As String
    Dim FieldName       As String
    Dim Data            As String
        
        For Each Ctrl In This.Controls
            If Ctrl.Tag <> EMPTY_STRING Then
                Prefix = left(Ctrl.Tag, 3)
                FieldName = Right(Ctrl.Tag, Len(Ctrl.Tag) - 3)
                If StrComp(Prefix, TagPrefix, vbTextCompare) = 0 Then
                    If TypeOf Ctrl Is ComboBox Then
                        Ctrl.ListIndex = ListIndex(Ctrl, pRS.Fields(FieldName).value)
                    ElseIf TypeOf Ctrl Is TextBox Then
                        Ctrl.Text = pRS.Fields(FieldName).value
                    ElseIf TypeOf Ctrl Is Label Then
                        Ctrl.Caption = pRS.Fields(FieldName).value
                    ElseIf TypeOf Ctrl Is DTPicker Then
                        Data = pRS.Fields(FieldName).value
                        If Data = EMPTY_STRING Then
                            Ctrl.value = Date
                        Else
                            Ctrl.value = Format(CDate(Data), "Short Date")
                        End If
                    End If
                End If
            End If
        Next
        
End Sub

Private Function ListIndex(ByRef Combo As ComboBox, ByVal Text As String) As Integer
    Dim i As Integer
    
    For i = 0 To Combo.ListCount - 1
        If StrComp(Combo.List(i), Text, vbTextCompare) = 0 Then
            ListIndex = i
            Exit Function
        End If
    Next
    
End Function

Public Function NewPrisonNumber(ByVal emptyStr As String) As String
    If executeAction(bea_NewPrisonNumber, emptyStr) Then NewPrisonNumber = m_RS("seq")
End Function

Public Function NewItemControlNumber(ByVal PrisonNumber As String) As String
    If executeAction(bea_CreateItemControlNo, PrisonNumber) Then NewItemControlNumber = m_RS("item_control_no")
End Function

Private Sub m_Login_Connected()
    m_OpenConnection = True
End Sub

Private Sub m_Login_ConnectionFailed(ByVal DB As String, ByVal UID As String, ByVal Password As String, ByVal Server As String, ByVal Port As String)
    
    Dim msg     As String
    
    msg = "Failed trying to connect with the database server at " & Server & " port " & Port & "." & vbCrLf
    msg = msg & "Please check/verify your login account entries." & vbCrLf & vbCrLf
    msg = msg & "User id: " & UID & vbCrLf
    msg = msg & "Password: " & Password
    
    MsgBox msg, vbCritical, "Database Server Connection Failure"
    m_OpenConnection = False
    End

End Sub

Private Sub m_Login_ServerUnknown()
    MsgBox "Server is unknown. Please contact your system administrator to fix the problem.", vbCritical, "Unknown Server"
    m_OpenConnection = False
    End
End Sub

Private Sub Class_Initialize()
    Set m_CN = Nothing
    Set m_RS = Nothing
End Sub

Private Sub Class_Terminate()
    If Not m_CN Is Nothing Then Set m_CN = Nothing
    If Not m_RS Is Nothing Then Set m_RS = Nothing
    If Not m_Login Is Nothing Then Set m_Login = Nothing
End Sub

Public Function executeAction(ByVal eActionID As ExecuteActionID, ParamArray ActionParams() As Variant) As Boolean

On Error GoTo BailOut

    If m_CN Is Nothing Then
        executeAction = False
        GoTo BailOut
    End If

    Dim aParams     As String
    Dim StoredProc  As String
    
    Set m_RS = New ADODB.Recordset

    If UBound(ActionParams) >= 0 Then
        aParams = ResetParams(ActionParams)
    Else
        aParams = EMPTY_STRING
    End If
        
    Select Case eActionID
        Case bea_VerifyUser:                            StoredProc = "verify_user"
        Case bea_VerifyPassword:                        StoredProc = "verify_password"
        Case bea_AddInmate:                             StoredProc = "add_inmate"
        Case bea_UpdateInmate:                          StoredProc = "update_inmate"
        Case bea_NewPrisonNumber:                       StoredProc = "create_prison_number"
        Case bea_FetchInmateRecord:                     StoredProc = "fetch_single_inmate"
        Case bea_FetchInmates:                          StoredProc = "fetch_inmates"
        Case bea_VerifyPrisonNumber:                    StoredProc = "verify_prison_number"
        Case bea_SaveArrestDetails:                     StoredProc = "save_arrest_details"
        Case bea_UpdateArrestDetails:                   StoredProc = "update_arrest_details"
        Case bea_FetchArrestRecord:                     StoredProc = "fetch_arrest_record"
        Case bea_FetchPrisonerName:                     StoredProc = "fetch_prisoner_name"
        Case bea_CreateItemControlNo:                   StoredProc = "create_item_control_no"
        Case bea_SaveItem:                              StoredProc = "add_item"
        Case bea_UpdateItem:                            StoredProc = "update_item"
        Case bea_DeleteItem:                            StoredProc = "delete_item"
        Case bea_FetchItems:                            StoredProc = "fetch_items"
        Case bea_FetchItem:                             StoredProc = "fetch_single_item"
        Case bea_FetchReleases:                         StoredProc = "fetch_releases"
        Case bea_FetchVisits:                           StoredProc = "fetch_visits"
        Case bea_FetchVisitRecord:                      StoredProc = "fetch_visit_record"
        Case bea_FetchInmateDetails:                    StoredProc = "fetch_inmate_details"
        Case bea_FetchPrisonNumbers:                    StoredProc = "fetch_prison_numbers"
        Case bea_FetchPrisonNumbers2:                   StoredProc = "fetch_prison_numbers_for_visitors"
    End Select
    
    Set m_RS = m_CN.Execute("CALL " & StoredProc & "(" & aParams & ")")
    If m_RS.State = adStateOpen Then
        executeAction = (Not m_RS.EOF And Not m_RS.BOF)
    Else
        executeAction = True
    End If
        

ExitHere:

    Exit Function

BailOut:

    executeAction = False
    'MsgBox Err.Description, vbExclamation, "BJMP"
    Resume ExitHere

End Function

Private Function ResetParams(ByVal aParams As Variant) As String

    On Error GoTo BailOut
    
    Dim i           As Integer
    Dim rParams     As String
    
    rParams = "'"
    For i = 0 To UBound(aParams)
        rParams = rParams & CStr(aParams(i)) & "','"
    Next
    rParams = left(rParams, Len(rParams) - 2)
    
    ResetParams = rParams
    Exit Function
    
BailOut:

    ResetParams = EMPTY_STRING
    Err.Clear

End Function

Public Function FillCombo(ByVal eAction As ExecuteActionID, ByRef Combo As Object, ByVal ColValue As String, ByVal ColIndex As String, ParamArray Params() As Variant) As Boolean

    On Error GoTo BailOut

    Set m_RS = New ADODB.Recordset
    Set m_RS = getRows(eAction, Params(0))

    Combo.Clear
    If Not (Not m_RS.EOF And Not m_RS.BOF) Then
        FillCombo = True
        Exit Function
    End If
    
    Do While Not m_RS.EOF
        Combo.AddItem m_RS.Fields(ColValue)
        Combo.ItemData(Combo.NewIndex) = m_RS.Fields(ColIndex)
        m_RS.MoveNext
    Loop
    Combo.ListIndex = 0
    FillCombo = True
    
ExitHere:

    Set m_RS = Nothing
    Exit Function
    
BailOut:

    FillCombo = False
    Err.Clear
    Resume ExitHere

End Function
