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

Private Const m_cFIRSTONEFOUND As String = "<FirstColumnFound>"

Private m_oConnection As ADODB.Connection
Private m_sTableName As String
Private m_sPrimaryKeyName As String
Private m_bLoadedSchema As Boolean
Private m_bLoadedRSet As Boolean
Private m_bRecordsExistInDB As Boolean
Private m_oRSet As ADODB.Recordset

Private m_sColumnList As String
Private m_sColumnListWOPrimaryKey As String

Public Property Get Connection() As ADODB.Connection
    Set Connection = m_oConnection
End Property

Public Sub LoadSchema(oDB As ADODB.Connection, sTableName As String, Optional sPrimaryKeyName As String = m_cFIRSTONEFOUND)
    Set m_oConnection = oDB
    m_sTableName = sTableName
    m_sPrimaryKeyName = sPrimaryKeyName
    If m_sPrimaryKeyName = m_cFIRSTONEFOUND Then
        Call FindPrimaryKey
    End If
    
    m_bLoadedSchema = (Not oDB Is Nothing And Len(Trim(sTableName)) > 0)
End Sub
'Returns records found
Public Function LoadRecords(Optional sWhereClause As String = "") As Long
    If m_bLoadedSchema = False Then Call Err.Raise(-1, "FOTATools.clsFOTAADOTableHelper", "LoadSchema must be called first with a valid table name and ADO.Connection object")
    
    Dim sSQL As String
    Dim i As Long
    Dim oFunc As New clsFunctions
    
    sSQL = "SELECT * FROM " & m_sTableName & " " & sWhereClause
    Set m_oRSet = oFunc.OpenMyRset(m_oConnection, sSQL)
    LoadRecords = m_oRSet.RecordCount
    m_bLoadedRSet = True
    m_bRecordsExistInDB = (m_oRSet.RecordCount > 0)
    
    m_sColumnList = ""
    m_sColumnListWOPrimaryKey = ""
    For i = 0 To m_oRSet.Fields.Count - 1
        m_sColumnList = m_sColumnList & m_oRSet.Fields(i).Name
        If i < m_oRSet.Fields.Count - 1 Then
            m_sColumnList = m_sColumnList & ","
        End If
        
        If Not (m_sPrimaryKeyName = m_cFIRSTONEFOUND Or m_sPrimaryKeyName = m_oRSet.Fields(i).Name) Then
            m_sColumnListWOPrimaryKey = m_sColumnListWOPrimaryKey & m_oRSet.Fields(i).Name
            If i < m_oRSet.Fields.Count - 1 Then
                m_sColumnListWOPrimaryKey = m_sColumnListWOPrimaryKey & ","
            End If
        ElseIf i = m_oRSet.Fields.Count - 1 Then
            m_sColumnListWOPrimaryKey = left(m_sColumnListWOPrimaryKey, Len(m_sColumnListWOPrimaryKey) - 1)
        End If
    Next i

End Function
Public Function GetEOF() As Boolean
    If m_bLoadedSchema = False Then Call Err.Raise(-1, "FOTATools.clsFOTAADOTableHelper", "LoadSchema must be called first with a valid table name and ADO.Connection object.")
    If m_bLoadedRSet = False Then Call Err.Raise(-1, "FOTATools.clsFOTAADOTableHelper", "LoadRecords must be called first.")
    
    GetEOF = m_oRSet.EOF()
End Function
Public Sub MoveFirst()
    If m_bLoadedSchema = False Then Call Err.Raise(-1, "FOTATools.clsFOTAADOTableHelper", "LoadSchema must be called first with a valid table name and ADO.Connection object")
    If m_bLoadedRSet = False Then Call Err.Raise(-1, "FOTATools.clsFOTAADOTableHelper", "LoadRecords must be called first.")
    
    Call m_oRSet.MoveFirst
End Sub
Public Sub MoveLast()
    If m_bLoadedSchema = False Then Call Err.Raise(-1, "FOTATools.clsFOTAADOTableHelper", "LoadSchema must be called first with a valid table name and ADO.Connection object")
    If m_bLoadedRSet = False Then Call Err.Raise(-1, "FOTATools.clsFOTAADOTableHelper", "LoadRecords must be called first.")

    Call m_oRSet.MoveLast
End Sub
Public Sub MoveNext()
    If m_bLoadedSchema = False Then Call Err.Raise(-1, "FOTATools.clsFOTAADOTableHelper", "LoadSchema must be called first with a valid table name and ADO.Connection object")
    If m_bLoadedRSet = False Then Call Err.Raise(-1, "FOTATools.clsFOTAADOTableHelper", "LoadRecords must be called first.")

    Call m_oRSet.MoveNext
End Sub
Public Property Get GetValue(sColumnName As String) As Variant
    If m_bLoadedSchema = False Then Call Err.Raise(-1, "FOTATools.clsFOTAADOTableHelper", "LoadSchema must be called first with a valid table name and ADO.Connection object")
    If m_bLoadedRSet = False Then Call Err.Raise(-1, "FOTATools.clsFOTAADOTableHelper", "LoadRecords must be called first.")

    If IsNull(m_oRSet(sColumnName)) = True Then
        'Boolean
        If FieldType(m_oRSet.Fields(sColumnName).Type) = 0 Then
            GetValue = False
        'Date
        ElseIf FieldType(m_oRSet.Fields(sColumnName).Type) = 1 Then
            GetValue = Date
        'String
        ElseIf FieldType(m_oRSet.Fields(sColumnName).Type) = 2 Then
            GetValue = ""
        'Unknown
        ElseIf FieldType(m_oRSet.Fields(sColumnName).Type) = 3 Then
            Call Err.Raise(-1, "FOTATools.clsFOTAADOTableHelper.GetValue", "Data type returned from recordset is not currently supported")
        Else
            Call Err.Raise(-1, "FOTATools.clsFOTAADOTableHelper.GetValue", "Unknown data type returned from recordset")
        End If
    Else
        GetValue = m_oRSet.Fields(sColumnName).Value
    End If
End Property
Public Sub CreateNewRecord()
    If m_bLoadedSchema = False Then Call Err.Raise(-1, "FOTATools.clsFOTAADOTableHelper", "LoadSchema must be called first with a valid table name and ADO.Connection object")
    
    Call LoadRecords("WHERE 1 = 2")
    Call m_oRSet.AddNew
    m_bLoadedRSet = True
End Sub
Public Property Let SetValue(sColumnName As String, vNewVal As Variant)
    If m_bLoadedSchema = False Then Call Err.Raise(-1, "FOTATools.clsFOTAADOTableHelper", "LoadSchema must be called first with a valid table name and ADO.Connection object")
    
    If m_bLoadedRSet = False Then
        Call LoadRecords("WHERE 1 = 2")
        Call m_oRSet.AddNew
        m_bLoadedRSet = True
    End If

    m_oRSet(sColumnName).Value = vNewVal
End Property
Public Function Save() As String

    Dim sSQL As String
    Dim oFunc As New clsFunctions
    Dim oRst As ADODB.Recordset

    If m_bRecordsExistInDB Then
        Call CreateSQLUpdate(True)
        Save = m_oRSet(m_sPrimaryKeyName)
    Else
        Call CreateSQLInsert(True)
        
        sSQL = "SELECT MAX(" & m_sPrimaryKeyName & ") AS sID FROM " & m_sTableName
        Set oRst = m_oConnection.Execute(sSQL)
        Save = oRst![sID]
        
        sSQL = "SELECT * FROM " & m_sTableName & " WHERE " & m_sPrimaryKeyName & " = " & Save
        Set m_oRSet = oFunc.OpenMyRset(m_oConnection, sSQL)
        
        m_bRecordsExistInDB = True
    End If

End Function
Public Function CreateSQLInsert(Optional bAndRunIt As Boolean = False, Optional ByRef nNewID As Long) As String
    If m_bLoadedSchema = False Then Call Err.Raise(-1, "FOTATools.clsFOTAADOTableHelper", "LoadSchema must be called first with a valid table name and ADO.Connection object")
    If m_bLoadedRSet = False Then Call Err.Raise(-1, "FOTATools.clsFOTAADOTableHelper", "LoadRecords must be called first.")
    
    Dim oRst As ADODB.Recordset
    Dim sSQL As String
    Dim oFunc As New clsFunctions
    Dim i As Long
    
    sSQL = "INSERT INTO " & m_sTableName & "(" & m_sColumnListWOPrimaryKey & ") " & _
           "VALUES("
    
    For i = 0 To m_oRSet.Fields.Count() - 1
        If m_sPrimaryKeyName = m_cFIRSTONEFOUND Or m_sPrimaryKeyName = m_oRSet.Fields(i).Name Then
            If i = m_oRSet.Fields.Count() - 1 Then sSQL = left(sSQL, Len(sSQL) - 1)
        Else
            sSQL = sSQL & PrepareValue(i)
            If i < m_oRSet.Fields.Count() - 1 Then
                sSQL = sSQL & ","
            End If
        End If
    Next i
    
    sSQL = sSQL & ");"
    
    CreateSQLInsert = sSQL
    If bAndRunIt = True Then
        Call m_oConnection.Execute(sSQL)
        
        sSQL = "SELECT MAX(" & m_sPrimaryKeyName & ") AS nNew FROM " & m_sTableName
        Set oRst = oFunc.OpenMyRset(m_oConnection, sSQL)
        
        'Now lets automatically refresh our recordset
        nNewID = oRst![nNew]
        Call LoadRecords("WHERE " & m_sPrimaryKeyName & " = " & nNewID)
    End If
    
End Function
Public Function CreateSQLUpdate(Optional bAndRunIt As Boolean = False) As String
    
    On Error GoTo ErrorHandler
    
    If m_bLoadedSchema = False Then Call Err.Raise(-1, "FOTATools.clsFOTAADOTableHelper", "LoadSchema must be called first with a valid table name and ADO.Connection object")
    If m_bLoadedRSet = False Then Call Err.Raise(-1, "FOTATools.clsFOTAADOTableHelper", "LoadRecords must be called first.")

    Dim sSQL As String
    Dim sPrimaryKey As String
    Dim bWrittenOne As Boolean
    Dim i As Long

    sSQL = "UPDATE " & m_sTableName & " SET "
    
    For i = 0 To m_oRSet.Fields.Count() - 1

        If m_oRSet.Fields(i).Name = m_sPrimaryKeyName Or (m_sPrimaryKeyName = m_cFIRSTONEFOUND And i = 0) Then
            sPrimaryKey = " WHERE " & m_oRSet.Fields(i).Name & " = " & PrepareValue(i)
        ElseIf IsNull(m_oRSet.Fields(i).Value) = True Then
            'I can't figure out how to write NULL's
            If bWrittenOne = True Then
                sSQL = sSQL & ","
            End If
            sSQL = sSQL & m_oRSet.Fields(i).Name & " = null"
            bWrittenOne = True
        Else
            If bWrittenOne = True Then
                sSQL = sSQL & ","
            End If
            sSQL = sSQL & m_oRSet.Fields(i).Name & " = " & PrepareValue(i)
            bWrittenOne = True
        End If
    Next i
    
    sSQL = sSQL & sPrimaryKey

    If bAndRunIt = True Then
        Call m_oConnection.Execute(sSQL)
    End If
    CreateSQLUpdate = sSQL
    
    
    Exit Function
ErrorHandler:
    Call Err.Raise(Err.Number, Err.Source, Err.Description & vbCrLf & "SQL(" & sSQL & ")")
    
End Function
Private Function PrepareValue(nColumnIndex As Long) As Variant

    Dim oFn As New clsFunctions

    'Null values
    If IsNull(m_oRSet.Fields(nColumnIndex).Value) = True Then
        PrepareValue = "NULL"
    'Boolean values
    ElseIf FieldType(m_oRSet.Fields(nColumnIndex).Type) = 0 Then
        PrepareValue = m_oRSet.Fields(nColumnIndex).Value
    'Date values
    ElseIf FieldType(m_oRSet.Fields(nColumnIndex).Type = adDate) = 1 Then
        PrepareValue = "#" & m_oRSet.Fields(nColumnIndex).Value & "#"
    'String values
    ElseIf FieldType(m_oRSet.Fields(nColumnIndex).Type) = 2 Then
        PrepareValue = oFn.PrepareSQLValue(m_oRSet.Fields(nColumnIndex).Value)
        'PrepareValue = "'" & oFn.SearchAndReplace(m_oRSet.Fields(nColumnIndex).Value, "'", "''") & "'"
    'Unknown values
    ElseIf FieldType(m_oRSet.Fields(nColumnIndex).Type) > 2 Then
        Call Err.Raise(-1, "FOTATools.clsFOTAADOTableHelper.LoadFromRecordSet", "data type returned from recordset( " & FieldType(m_oRSet.Fields(nColumnIndex).Type) & " is not currently supported")
    Else
        Call Err.Raise(-1, "FOTATools.clsFOTAADOTableHelper.LoadFromRecordSet", "Unknown data type returned from recordset")
    End If
    
End Function
'Bool=0,Date=1,String=2,Unknown=3
Private Function FieldType(nType As Long) As Long
    'Boolean values
    If nType = adBoolean Or _
       nType = adDouble Or _
       nType = adDecimal Or _
       nType = adSingle Or _
       nType = adInteger Or _
       nType = adSmallInt Or _
       nType = adTinyInt Or _
       nType = adUnsignedBigInt Or _
       nType = adUnsignedInt Or _
       nType = adUnsignedSmallInt Or _
       nType = adUnsignedTinyInt Or _
       nType = adBigInt Or _
       nType = adCurrency Or _
       nType = adNumeric Then
                FieldType = 0
    'Date values
    ElseIf nType = adDate Or _
           nType = adDBDate Or _
           nType = adDBFileTime Or _
           nType = adDBTime Or _
           nType = adDBTimeStamp Then
                FieldType = 1
    'String values
    ElseIf nType = adVarChar Or _
           nType = adChar Or _
           nType = adLongVarChar Or _
           nType = adLongVarWChar Or _
           nType = adBSTR Or _
           nType = adVarWChar Or _
           nType = adWChar Then
                FieldType = 2
    'Unknown values
    ElseIf nType = adBinary Then
                FieldType = 3
    ElseIf nType = adEmpty Then
                FieldType = 5
    ElseIf nType = adError Then
                FieldType = 6
    ElseIf nType = adGUID Then
                FieldType = 7
    ElseIf nType = adIDispatch Then
                FieldType = 8
    ElseIf nType = adIUnknown Then
                FieldType = 9
    ElseIf nType = adLongVarBinary Then
                FieldType = 10
    ElseIf nType = adUserDefined Then
                FieldType = 12
    ElseIf nType = adVarBinary Then
                FieldType = 13
    ElseIf nType = adVariant Then
                FieldType = 14
    Else
        Call Err.Raise(-1, "FOTATools.clsFOTAADOTableHelper.LoadFromRecordSet", "Unknown data type returned from recordset")
    End If
End Function
Public Function CreateSQLDelete(Optional bAndRunIt As Boolean = False)

    On Error GoTo ErrorHandler
    
    If m_bLoadedSchema = False Then Call Err.Raise(-1, "FOTATools.clsFOTAADOTableHelper", "LoadSchema must be called first with a valid table name and ADO.Connection object")
    If m_bLoadedRSet = False Then Call Err.Raise(-1, "FOTATools.clsFOTAADOTableHelper", "LoadRecords must be called first.")

    Dim sSQL As String
    
    sSQL = "DELETE * FROM " & m_sTableName & " " & _
           "WHERE " & m_sPrimaryKeyName & " = " & m_oRSet(m_sPrimaryKeyName)
    
    If bAndRunIt = True Then
        Call m_oConnection.Execute(sSQL)
    End If
    CreateSQLDelete = sSQL
    
    
    Exit Function
ErrorHandler:
    Call Err.Raise(Err.Number, Err.Source, Err.Description & vbCrLf & "SQL(" & sSQL & ")")
    
End Function
Private Function FindPrimaryKey()

    Dim oRst As ADODB.Recordset
    Dim sSQL As String
    Dim oFunc As New clsFunctions
    Dim i As Long
    
    'Do we know the primary key field?
    If m_sPrimaryKeyName = m_cFIRSTONEFOUND Then
    
        sSQL = "SELECT * FROM " & m_sTableName & " WHERE 1 = 2"
        Set oRst = oFunc.OpenMyRset(m_oConnection, sSQL)
        For i = 0 To oRst.Fields.Count()
            If oRst.Fields(i).Name = m_sPrimaryKeyName Or (m_sPrimaryKeyName = m_cFIRSTONEFOUND And i = 0) Then
                m_sPrimaryKeyName = oRst.Fields(i).Name
                Exit For
            End If
        Next i
        If m_sPrimaryKeyName = m_cFIRSTONEFOUND Then
            Call Err.Raise(-1, "FOTATools.clsFOTAADOTableHelpter.CreateSQLInsert", "Unable to locate primary key for table " & m_sTableName)
        End If
        
    End If

End Function
Public Function IsRecordLoaded() As Boolean

    IsRecordLoaded = m_bLoadedRSet

End Function
