Building Better SQL Queries

Listing 4 The complete CSQL class

Option Compare Database
' Option Compare Text (for VB)
Option Explicit

' =====================================================
' Collections of the Query Elements
' =====================================================
Private Sels As New Collection
Private Whrs As New Collection
Private Tbls As New Collection
Private Ords As New Collection
Private Grps As New Collection
Private Havs As New Collection
Private InsTbls As New Collection
Private InsFlds As New Collection
Private UpdTbls As New Collection
Private UpdVals As New Collection

' The dialect determines how certain strings are formatted
Public Enum csqlDialect
    csqlAccess = 0
    csqlSQL = 1
    csqlSybase = 2
    csqlORACLE = 3
    csqlMySQL = 4
End Enum

Private m_Dialect As csqlDialect

'==========================================================================
' Start up with MS SQL as the default dialect
' but change this as appropriate for your system
'==========================================================================
Private Sub Class_Initialize()
    m_Dialect = csqlSQL
End Sub

'==========================================================================
' Terminate routines
'==========================================================================

Private Sub Class_Terminate()
    Clear
End Sub


' =====================================================
' Clear the collections
' =====================================================
Sub Clear()
    clear_collection Sels
    clear_collection Whrs
    clear_collection Tbls
    clear_collection Ords
    clear_collection Grps
    clear_collection Havs
    clear_collection InsTbls
    clear_collection InsFlds
    clear_collection UpdTbls
    clear_collection UpdVals
End Sub

' =====================================================
' Clears a single passed collection
' =====================================================
Private Sub clear_collection(coll As Collection)
    Dim ix As Long
    For ix = coll.Count To 1 Step -1
        coll.Remove ix
    Next ix
End Sub

'==========================================================================
' SELECT QUERY Clauses
'==========================================================================

' =====================================================
' When a user specifies s.Selct = "SOME_FIELD"
' this appends the table to the selections collection
' =====================================================
Property Let Selct(sl$)
    Sels.Add sl
End Property

' =====================================================
' When a user specifies s.Table = "SOME_TABLE"
' this appends the table to the collection
' =====================================================
Property Let Table(tb$)
    Tbls.Add tb$
End Property

' =====================================================
' When a user specifies s.Where = "SOMETHING = SOMETHING_ELSE"
' this appends the table to the Wheres collection
' =====================================================
Property Let Where(whr$)
    Whrs.Add whr
End Property

' =====================================================
' When the user does a get as in SQL$ = s.SelectQuery (Select Query)
' The Selects, Tables, Wheres Order By, Group and Having
' are retrieved and assembled
' and then concatenated
' =====================================================
Property Get SelectQuery() As String
    SelectQuery = Selct & Table & Where & Order & Group & Having
End Property

' =====================================================
' The get Logic for each specific property actually
' pulls the list together using this function.
' The function starts by building an output
' string with the passed StartString$
' it appends the collection items one by one
' and in between each inserts the Delimiter$ string
' and a new line which makes the result easier to read
' Finally if the string has any content, and optional
' CloseString$ is added. Note that the function
' is structured in such a way that an empty collection
' returns an empty string
' =====================================================
Private Function get_item_list(coll As Collection, _
                       StartString$, Delimiter$, Optional CloseString$ = "") As String
    Dim tx$
    Dim ix As Long
    For ix = 1 To coll.Count
        If ix = 1 Then
            tx$ = StartString$ & vbCrLf
        End If
        If ix > 1 Then
            tx = tx$ & Delimiter$ & " "
        End If
        tx = tx$ & coll(ix) & vbCrLf
    Next ix
    If tx$ <> "" Then
        tx$ = tx$ & CloseString$
    End If
    get_item_list = tx$
End Function


' =====================================================
' When the Get SelectQuery() property requests the Selct
' attribute This is assembled using the get_item_list
' helper function.
' =====================================================
Property Get Selct() As String
    Selct = get_item_list(Sels, "SELECT", ",")
End Property



' =====================================================
' When the Get SelectQuery() property requests the Table
' attribute This is assembled using the get_item_list
' helper function.
' =====================================================
Property Get Table() As String
    Table = get_item_list(Tbls, "FROM", ",")
End Property

' =====================================================
' When the Get SelectQuery() property requests the Table
' attribute This is assembled using the get_item_list
' helper function.
' =====================================================
Property Get Where() As String
    Where = get_item_list(Whrs, "WHERE", "AND")
End Property

' =====================================================
' When a user specifies s.Order = "SOME_FIELD"
' this appends the table to the Order by collection
' =====================================================
Property Let Order(ord$)
    Ords.Add ord
End Property

' =====================================================
' When the Get SelectQuery() property requests the Order
' attribute This is assembled using the get_item_list
' helper function.
' =====================================================
Property Get Order() As String
    Order = get_item_list(Ords, "ORDER BY", ",")
End Property
' =====================================================
' When a user specifies s.Group = "SOME_FIELD"
' this appends the table to the Group by collection
' =====================================================
Property Let Group(grp$)
    Grps.Add grp
End Property

' =====================================================
' When the Get SelectQuery() property requests the Group
' attribute This is assembled using the get_item_list
' helper function.
' =====================================================
Property Get Group() As String
    Group = get_item_list(Grps, "GROUP BY", ",")
End Property
' =====================================================
' When a user specifies s.Having = "SOMETHING = SOMETHING_ELSE"
' this appends the table to the Having collection
' =====================================================
Property Let Having(hav$)
    Havs.Add hav
End Property

' =====================================================
' When the Get SelectQuery() property requests the Having
' attribute This is assembled using the get_item_list
' helper function.
' =====================================================
Property Get Having() As String
    Having = get_item_list(Havs, "HAVING", "AND")
End Property

'==========================================================================
' INSERT QUERY Clauses
'==========================================================================
Property Let InsertTable(tb$)
    InsTbls.Add tb
End Property

Property Get InsertTable() As String
    InsertTable = get_item_list(InsTbls, "INSERT INTO", ",")
End Property
Property Let InsertField(fld$)
    InsFlds.Add fld
End Property

Property Get InsertField() As String
    InsertField = get_item_list(InsFlds, "(", ",", ")")
End Property

'==================================================
' Add a field and value pair to their appropriate
' collections. This keeps field and value
' pairs in sync for large insert queries
'==================================================

Public Function InsertValues(fld$, vl$)
    InsertField = fld$
    Selct = vl$
End Function

' =====================================================
' TheInsertQuery extracts the two additional
' collection lists followed by a select query
' if a table exists, otherwise it is a VALUES list
' =====================================================
Property Get InsertQuery() As String
    If Tbls.count > 0 Then
        InsertQuery = InsertTable & InsertField & SelectQuery
    Else
        InsertQuery = InsertTable & InsertField & get_item_list("VALUES(", ",", ")")
    End If
End Property


' =====================================================
' DELETE QUERY Clauses
' =====================================================
Property Let DeleteTable(tb$)
    Table = tb
End Property

Property Get DeleteTable() As String
    DeleteTable = get_item_list(Tbls, "DELETE", ",")
End Property


' =====================================================
' Format the delete query based on the dialect type
' =====================================================
Property Get DeleteQuery() As String
    If m_Dialect = csqlAccess Then
        DeleteQuery = "DELETE *" & vbCrLf & Table & Where
    Else
        DeleteQuery = DeleteTable & Where
    End If
End Property

' =====================================================
' Update QUERY Clauses
' =====================================================
Property Let UpdateTable(tb$)
    UpdTbls.Add tb
End Property

Property Get UpdateTable() As String
    UpdateTable = get_item_list(UpdTbls, "UPDATE", ",")
End Property

Property Let UpdateValue(vl$)
    UpdVals.Add vl
End Property

Property Get UpdateValue() As String
    UpdateValue = get_item_list(UpdVals, "SET", ",")
End Property
Public Function UpdateValues(fld$, vl$)
    UpdateValue = fld$ & "=" & vl$
End Function

Property Get UpdateQuery() As String
    UpdateQuery = UpdateTable & UpdateValue & Table & Where
End Property

' =====================================================
' Support routines
' =====================================================
'==========================================================================
' Returns the select query surrounded by open and close Parentheses
'==========================================================================
Property Get SubQuery() As String
    SubQuery = "( " & SelectQuery & ")"
End Property

' =====================================================
' Return a string in Single Quotes
' =====================================================
Public Function SingleQuoted$(aStr$)
    SingleQuoted$ = "'" & aStr$ & "'"
End Function

' =====================================================
'Return a string in Double Quotes
' =====================================================
Public Function DoubleQuoted$(aStr$)
    DoubleQuoted$ = chr$(34) & aStr$ & chr$(34)
End Function

' =====================================================
' Return a formatted date string in date quotes
' based on the dialect
' =====================================================
Function DateQuoted$(dt As Date)
    If m_Dialect = csqlAccess Then
        DateQuoted$ = "#" & CStr(dt) & "#"
    ElseIf m_Dialect = csqlMySQL Then
        DateQuoted$ = SingleQuoted(Format(dt, "yyyy-mm-dd"))
    Else
        DateQuoted$ = SingleQuoted(CStr(dt))
    End If
        
End Function

' =====================================================
' Let and Get the Dialect Type
' =====================================================
Property Let Dialect(dial As csqlDialect)
    m_Dialect = dial
End Property
Property Get Dialect() As csqlDialect
    Dialect = m_Dialect
End Property