smartsql.cls

VB中的ADO操作教程

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

#If False Then
    Private Const sqlDateAndTime = 0
    Private Const sqlDateOnly = 1
    Private Const sqlTimeOnly = 2
#End If

Public Enum SQLDateTypes
    sqlDateAndTime
    sqlDateOnly
    sqlTimeOnly
End Enum

Public Enum JOIN_TYPE
    INNER_JOIN = 1
    LEFT_JOIN = 2
    RIGHT_JOIN = 3
    FULL_JOIN = 4 'SUPPORTED BY SQL SERVER ONLY
End Enum

Public Enum CLAUSE_OPERATOR
    CLAUSE_EQUALS
    CLAUSE_LIKE
    CLAUSE_GREATERTHAN
    CLAUSE_LESSTHAN
    CLAUSE_GREATERTHANOREQUAL
    CLAUSE_LESSTHANOREQUAL
    CLAUSE_DOESNOTEQUAL
    CLAUSE_STARTWITH
    CLAUSE_ENDWITH
End Enum

Public Enum WHERE_CLAUSE_LOGIC
    LOGIC_AND
    LOGIC_OR
End Enum

Public Enum STATEMENT_TYPE
    TYPE_SELECT
    TYPE_INSERT
    TYPE_UPDATE
    TYPE_DELETE
    TYPE_OTHER 'NOT CURRENTLY USED
End Enum

Public Enum SQL_TYPE
    SQL_TYPE_ACCESS
    SQL_TYPE_ANSI
End Enum

Private Enum ERR_NUMBERS
    ERR_TABLE_REQUIRED = 25000
    ERR_LIST_REQUIRED = 25010
    ERR_INVALID_VALUE = 25020
    ERR_INVALID_LISTITEM = 25030
End Enum

Const ERR_TABLE_REQUIRED_DESC = "Table Name property must be set"
Const ERR_LIST_REQUIRED_DESC = "Invalid argument; array or collection required."
Const ERR_INVALID_VALUE_DESC = "Invalid argument type"
Const ERR_INVALID_LISTITEM_DESC = "At least one element in the argument list is invalid"

Private pColOrderClause As Collection
Private pColFieldNames As Collection
Private pColValues As Collection 'for INSERT, UPDATE QUERIES

Private pColWhereClauses As Collection

Private psFromClause As String

Private psWhereClause As String

Private psTableNames() As String
Private psJoinTables As String
Private psJoinFields As String
Private piJoinOp As CLAUSE_OPERATOR
Private piJoinType As JOIN_TYPE

Private piWhereLogic() As WHERE_CLAUSE_LOGIC
Private pbOrderByDesc() As Boolean

Private piStatementType As STATEMENT_TYPE
Private piSQLType As SQL_TYPE
Private psSQL As String
Private psOrderClause As String

Private pbAutoQuote As Boolean
Private pbAutoLike As Boolean
Private pbAutoBracket As Boolean

Const Delimiter = "@*"
'
'#########################################################################################
'                                   Public Subroutines
'#########################################################################################
Public Sub AddComplexWhereClause(ByVal Clause As String, Optional Logic As WHERE_CLAUSE_LOGIC = LOGIC_AND)
    Dim i As Integer

    i = UBound(piWhereLogic) + 1
    ReDim Preserve piWhereLogic(i) As WHERE_CLAUSE_LOGIC
    piWhereLogic(i) = Logic
    pColWhereClauses.Add Clause
End Sub
 
 Public Sub AddField(ByVal FieldName As String, Optional ByVal TableName As String)
    Dim sTable As String
    Dim sField As String
    
    If Len(TableName) Then
        sTable = DoAutoBracket(TableName) & "."
    End If
    sField = DoAutoBracket(FieldName)
    sField = sTable & sField
    
    pColFieldNames.Add sField
End Sub

Public Sub AddFields(ParamArray args() As Variant)
    Dim sSplit() As String
    Dim i As Integer
    Dim sField As String
    
    For i = 0 To UBound(args)
        If ValidateValues(args(i)) = False Then
            Err.Raise ERR_INVALID_VALUE, , ERR_INVALID_VALUE_DESC
        End If
        sField = DoAutoBracket(args(i))
        pColFieldNames.Add sField
    Next
End Sub

Public Sub AddOrderClause(ByVal FieldName As String, Optional OrderDesc = False, Optional ByVal TableName As String)
    Dim iCount As Integer
    Dim sField As String

    iCount = UBound(pbOrderByDesc) + 1
    ReDim Preserve pbOrderByDesc(iCount)
    pbOrderByDesc(iCount) = OrderDesc
    If Len(TableName) Then sField = DoAutoBracket(TableName) & "."
    sField = sField & DoAutoBracket(FieldName)
    pColOrderClause.Add sField
End Sub

Public Function AddSimpleWhereClause(ByVal FieldName As String, ByVal Value As Variant, Optional ByVal TableName As String, Optional Op As CLAUSE_OPERATOR = CLAUSE_EQUALS, Optional Logic As WHERE_CLAUSE_LOGIC = LOGIC_AND) As String

    Dim i               As Integer
    Dim sField          As String
    Dim sWhereStatement As String
    Dim bString         As Boolean
    Dim sValueClause    As String

    If ValidateValues(Value) = False Then Err.Raise ERR_INVALID_VALUE, , ERR_INVALID_VALUE_DESC

    i = UBound(piWhereLogic) + 1
    ReDim Preserve piWhereLogic(i) As WHERE_CLAUSE_LOGIC
    piWhereLogic(i) = Logic

    bString = (VarType(Value) = vbString)

    If Len(TableName) > 0 Then sWhereStatement = DoAutoBracket(TableName) & "."

    sWhereStatement = sWhereStatement & DoAutoBracket(FieldName)
    If Not bString And Op = CLAUSE_LIKE Then
        Op = CLAUSE_EQUALS
    End If

    sWhereStatement = sWhereStatement & " " & TransformOp(Op)

    sValueClause = CStr(Value)

    If Op = CLAUSE_LIKE Then
        If pbAutoLike Then
            sValueClause = LikeCharacter & sValueClause & LikeCharacter
            If pbAutoQuote Then sValueClause = prepStringForSQL(sValueClause)
        Else
            If pbAutoQuote Then sValueClause = prepStringForSQL(sValueClause)
        End If
    ElseIf Op = CLAUSE_STARTWITH Then
        If pbAutoLike Then
            sValueClause = sValueClause & LikeCharacter
            If pbAutoQuote Then sValueClause = prepStringForSQL(sValueClause)
        Else
            If pbAutoQuote Then sValueClause = prepStringForSQL(sValueClause)
        End If
    ElseIf Op = CLAUSE_ENDWITH Then
        If pbAutoLike Then
            sValueClause = LikeCharacter & sValueClause
            If pbAutoQuote Then sValueClause = prepStringForSQL(sValueClause)
        Else
            If pbAutoQuote Then sValueClause = prepStringForSQL(sValueClause)
        End If
    Else
        If pbAutoQuote And bString Then sValueClause = prepStringForSQL(sValueClause)
    End If

    sValueClause = " " & sValueClause
    sWhereStatement = sWhereStatement & sValueClause
    pColWhereClauses.Add sWhereStatement
    AddSimpleWhereClause = sWhereStatement

End Function

Public Sub AddTable(ByVal TableName As String)
    Dim iCount      As Integer
    Dim sTableName  As String

    sTableName = DoAutoBracket(TableName)

    If Not TablePresent(sTableName) Then
        iCount = UBound(psTableNames) + 1
        ReDim Preserve psTableNames(iCount)
        psTableNames(iCount) = sTableName
    End If

    'clear jointables and complex from
    psFromClause = ""
    psJoinTables = ""
    psJoinFields = ""
    piJoinOp = CLAUSE_EQUALS 'default
    piJoinType = INNER_JOIN 'default
End Sub

Public Sub AddValue(ByVal Value As Variant)
    Dim sValue As String

    If UCase(TypeName(Value)) = "FIELD" Then
        Value = Value.Value
    End If

    If Not ValidateValues(Value) Then Err.Raise ERR_INVALID_VALUE, , ERR_INVALID_VALUE_DESC
    If ValidateValues(Value) Then
        sValue = Value
        If VarType(Value) = vbString And pbAutoQuote Then
            sValue = prepStringForSQL(sValue)
        ElseIf VarType(Value) = vbDate And pbAutoQuote Then
            sValue = prepDateForSQL(sValue)
        End If
        pColValues.Add sValue
    End If
End Sub

Public Sub AddValues(ParamArray args() As Variant)
    Dim sSplit() As String
    Dim i    As Integer
    Dim iCtr As Integer
    Dim sAns As String

    For i = 0 To UBound(args)
        If ValidateValues(args(i)) = False Then
            If UCase(TypeName(args(i))) = "FIELD" Then
                args(i) = args(i).Value
            End If
            Err.Raise ERR_INVALID_VALUE, , ERR_INVALID_VALUE_DESC
        End If
    Next

    For i = 0 To UBound(args)
        sAns = args(i)
        If VarType(args(i)) = vbString And pbAutoQuote Then sAns = prepStringForSQL(sAns)
        pColValues.Add sAns
    Next
End Sub

Public Sub ClearFromClause()
    psFromClause = ""
    psJoinTables = ""
    psJoinFields = ""
    piJoinType = INNER_JOIN
    piJoinOp = CLAUSE_EQUALS
    ReDim psTableNames(0) As String
End Sub

Public Sub ClearWhereClause()
    Set pColWhereClauses = New Collection
    ReDim piWhereLogic(0) As WHERE_CLAUSE_LOGIC
End Sub

Public Sub ClearOrderClause()
    Set pColOrderClause = New Collection
    ReDim pbOrderByDesc(0) As Boolean
End Sub

Public Sub ClearFields()
    Set pColFieldNames = New Collection
End Sub

Public Sub ClearValues()
    Set pColValues = New Collection
End Sub

Public Sub ListAddFields(ByVal FieldList As Variant, Optional ByVal TableName As String)
    Dim bValid      As Boolean
    Dim bCollection As Boolean
    Dim sAns        As String
    Dim l           As Long
    Dim v           As Variant
    Dim sItem       As String
    Dim lStartPoint As Long

    If IsObject(FieldList) Then
        bValid = (TypeOf FieldList Is Collection)
        bCollection = True
    Else
        bValid = IsArray(FieldList)
    End If

    If Not bValid Then
        Err.Raise ERR_LIST_REQUIRED, , ERR_LIST_REQUIRED_DESC
        Exit Sub
    End If

    'optional: add type check for each value in array or collection
    'can't have objects,
    
    If bCollection Then