smartsql.cls

VB中的ADO操作教程

                For i = 1 To pColValues.Count
                    sCommand = sCommand & pColValues(i)
                    If i <> pColValues.Count Then sCommand = sCommand & ", "
                Next
                sCommand = sCommand & ")"
            End If
    Case TYPE_UPDATE
          If pColFieldNames.Count > 0 And pColValues.Count > 0 And psTableNames(1) <> "" Then
          lUpLimit = IIf(pColFieldNames.Count > pColValues.Count, pColValues.Count, pColFieldNames.Count)
          sCommand = "UPDATE " & psTableNames(1) & " SET "
          For i = 1 To lUpLimit
            sCommand = sCommand & pColFieldNames(i) & " = " & pColValues(i)
            If i <> lUpLimit Then sCommand = sCommand & ", "
          Next
          End If
    Case TYPE_DELETE
          If psTableNames(1) <> "" Then
            sCommand = "DELETE FROM " & psTableNames(1)
          End If
    End Select
    
    If piStatementType <> TYPE_INSERT And sCommand <> "" Then
        For i = 1 To pColWhereClauses.Count
            If i = 1 Then
                sWhereClause = "WHERE"
            Else
                sWhereClause = sWhereClause & IIf(piWhereLogic(i) = LOGIC_AND, " AND", " OR")
            End If
            sWhereClause = sWhereClause & " (" & pColWhereClauses.Item(i) & ")"
            'If Not pbWhereClauseNumeric(i) Then sWhereClause = sWhereClause & "'"
        Next
    End If ' pistatement type <> ..
    
    'ORDER CLAUSE
    If piStatementType = TYPE_SELECT Then
        For i = 1 To pColOrderClause.Count
            If i = 1 Then sOrderClause = "ORDER BY "
            sOrderClause = sOrderClause & pColOrderClause.Item(i)
            If pbOrderByDesc(i) = True Then sOrderClause = sOrderClause & " DESC"
           If i <> pColOrderClause.Count Then sOrderClause = sOrderClause & ", "
         Next
    End If
    sAns = sCommand
    If Len(sWhereClause) > 0 Then sAns = sAns & " " & sWhereClause
    If Len(sOrderClause) > 0 Then sAns = sAns & " " & sOrderClause
    psOrderClause = sOrderClause
    psSQL = sAns
End Sub

'#########################################################################################
'                                   Private Functions
'#########################################################################################
Private Function DistinctValues(InputArray As Variant) As String()
    Dim asAns()     As String
    Dim lStartPoint As Long
    Dim lEndPoint   As Long
    Dim lCount      As Long
    Dim col         As New Collection
    Dim l           As Long
    Dim vTest       As Variant

    ReDim asAns(0) As String

    lCount = UBound(InputArray)

    On Error Resume Next
    vTest = InputArray(0)
    lStartPoint = IIf(Err.Number = 0, 0, 1)
    Err.Clear

    For l = lStartPoint To lCount
        col.Add 0, InputArray(l)
        If Err.Number = 0 Then
            If asAns(0) = "" Then
                asAns(0) = InputArray(l)
            Else
                ReDim Preserve asAns(UBound(asAns) + 1) As String
                asAns(UBound(asAns)) = InputArray(l)
            End If
        End If
        Err.Clear
    Next
    DistinctValues = asAns
End Function

Private Function DoAutoBracket(ByVal DBObjectName As String) As String
    Dim sSplit() As String
    Dim sAns As String
    Dim iCtr As Integer

    If InStr(DBObjectName, ".") > 0 Then
        sSplit = Split(DBObjectName, ".")
        For iCtr = 0 To UBound(sSplit)
            If InStr(sSplit(iCtr), " ") > 0 And InStr(sSplit(iCtr), "(") = 0 And InStr(sSplit(iCtr), ")") = 0 And InStr(sSplit(iCtr), "[") = 0 And pbAutoBracket Then
                sAns = sAns & "[" & sSplit(iCtr) & "]"
            Else
                sAns = sAns & Trim(sSplit(iCtr))
            End If
        
            If iCtr < UBound(sSplit) Then sAns = sAns & "."
        Next
    Else
        sAns = Trim(DBObjectName)
        If InStr(sAns, " ") > 0 And InStr(sAns, "(") = 0 And Left$(sAns, 1) <> "[" And pbAutoBracket Then
            sAns = "[" & sAns & "]"
        End If
    End If

    DoAutoBracket = sAns
End Function

Public Function prepDateForSQL(ByVal vDate As Variant, Optional vType As SQLDateTypes = sqlDateAndTime) As String

    On Error GoTo LocalError

    'Remove all invalid characters
    vDate = Trim(CStr(vDate))
    vDate = Replace(vDate, "#", "")
    vDate = Replace(vDate, "'", "")
    vDate = Replace(vDate, Chr(34), "")

    '--------------------------------------
    'Convert the Date to a Double Precision
    '   for international compatability
    '--------------------------------------
    prepDateForSQL = ""

    'First see in what format the data came
    If Not IsDate(vDate) Or IsNull(vDate) Then
        'Maybe it is a number
        If IsNumeric(vDate) Then
            vDate = CDate(vDate)
        End If
        If Not IsDate(vDate) Then
            'Still not a date
            Exit Function
        End If
    End If

    'Valid if we get this far
    Dim lDelim As String

    lDelim = IIf(SQL_TYPE_ANSI, "'", "#")
    If vType = sqlDateOnly Then
        prepDateForSQL = IIf(SQL_TYPE_ANSI, Format(vDate, "mm\/dd\/yyyy"), FormatDateTime(vDate, vbShortDate))
    ElseIf vType = sqlTimeOnly Then
        prepDateForSQL = IIf(SQL_TYPE_ANSI, Format(vDate, "hh\:mm\:ss"), Format(vDate, "hh\:mm\:ss"))
    Else    'Return Date and Time
        prepDateForSQL = IIf(SQL_TYPE_ANSI, Format(vDate, "mm\/dd\/yyyy hh\:mm\:ss"), FormatDateTime(vDate, vbShortDate) & " " & Format(vDate, "hh\:mm\:ss"))
    End If

    prepDateForSQL = lDelim & prepDateForSQL & lDelim

Exit Function

LocalError:
    prepDateForSQL = ""
End Function

Private Function prepStringForSQL(ByVal sValue As String) As String
    Dim sAns As String
    sAns = Replace(sValue, Chr(39), "''")
    sAns = "'" & sAns & "'"
    prepStringForSQL = sAns
End Function

Private Function ComplexTableCount() As Long
    Dim sSplit()    As String
    Dim sSplit2()   As String
    
    Dim sInput      As String
    Dim asTables()  As String

    Dim sFinal      As String
    Dim iCtr        As Integer

    Dim vUnique     As Variant
    Dim iPos        As Integer
    Dim lAns        As Long

    If psFromClause <> "" Then
        sSplit = Split(psFromClause, " ")
        ReDim asTables(0) As String
        asTables(0) = sSplit(0)
        
        sSplit = Split(psFromClause, "JOIN")
    
        For iCtr = 1 To UBound(sSplit)
            sSplit2 = Split(Trim$(sSplit(iCtr)), " ")
            ReDim Preserve asTables(UBound(asTables) + 1)
            asTables(UBound(asTables)) = sSplit2(0)
        Next
    
        vUnique = DistinctValues(asTables)
    
        lAns = UBound(vUnique) + 1
    ElseIf Trim$(psJoinTables) <> "" Then
        sSplit = Split(psJoinTables, Delimiter)
        vUnique = DistinctValues(sSplit)
        lAns = UBound(vUnique) + 1
    End If

    ComplexTableCount = lAns
End Function

Private Function TablePresent(TableName As String) As Boolean
    Dim iCtr As Integer
    Dim bAns As Boolean

    If UBound(psTableNames) = 0 Then Exit Function

    For iCtr = 1 To UBound(psTableNames)
        If TableName = psTableNames(iCtr) Then bAns = True
    Next
    TablePresent = bAns
End Function

Private Function TransformOp(Op As CLAUSE_OPERATOR) As String
    Dim sOp As String

    Select Case Op
        Case CLAUSE_EQUALS
            sOp = "="
        Case CLAUSE_LIKE
            sOp = "LIKE"
        Case CLAUSE_STARTWITH
            sOp = "LIKE"
        Case CLAUSE_ENDWITH
            sOp = "LIKE"
        Case CLAUSE_GREATERTHAN
            sOp = ">"
        Case CLAUSE_LESSTHAN
            sOp = "<"
        Case CLAUSE_GREATERTHANOREQUAL
            sOp = ">="
        Case CLAUSE_LESSTHANOREQUAL
            sOp = "<="
         Case CLAUSE_DOESNOTEQUAL
            sOp = "<>"
        Case Else
            sOp = "="
    End Select
    TransformOp = sOp
End Function

Private Function ValidateValues(Values As Variant) As Boolean
    'Purpose: Determines if a collection, variant array, or single value
    'has valid values for an SQL String
    Dim bCollection     As Boolean
    Dim iBadVarTypes(4) As Integer
    Dim v               As Variant
    Dim i               As Integer
    Dim lCtr            As Long
    Dim lListCount      As Long
    Dim lStartPoint     As Long
    Dim iCount          As Integer

    Dim bAns As Boolean

    iBadVarTypes(0) = vbObject
    iBadVarTypes(1) = vbError
    iBadVarTypes(2) = vbDataObject
    iBadVarTypes(3) = vbUserDefinedType
    iBadVarTypes(4) = vbArray

    bAns = True
    iCount = UBound(iBadVarTypes)

    If IsObject(Values) Then
        If Not TypeOf Values Is Collection Then
            ValidateValues = False
            Exit Function
        End If
    Else
        If Not VarType(Values) = vbArray Then
            For i = 0 To iCount
                If VarType(Values) = iBadVarTypes(i) Then
                    bAns = False
                    Exit For
                End If
            Next
            ValidateValues = bAns
            Exit Function
        End If
    End If

    bCollection = IsObject(Values) 'has to be collection

    If bCollection Then
        For Each v In Values
            For i = 1 To iCount
                If VarType(v) = iBadVarTypes(i) Or VarType(v) = iBadVarTypes(i) + vbVariant Then
                    bAns = False
                    Exit For
                End If
            Next
            If bAns = False Then Exit For
        Next
    Else
        lListCount = UBound(Values)
        On Error Resume Next
        v = Values(0)
        lStartPoint = IIf(Err.Number = 0, 0, 1)
        Err.Clear
        On Error GoTo 0
        For lCtr = lStartPoint To lListCount
            For i = 1 To iCount
                If VarType(Values(lCtr)) = iBadVarTypes(i) Or VarType(v) = iBadVarTypes(i) + vbVariant Then
                    bAns = False
                    Exit For
                End If
            Next
            If bAns = False Then Exit For
        Next
    End If

    ValidateValues = bAns
End Function


Private Sub Class_Initialize()
    Reset
    pbAutoLike = True
    pbAutoQuote = True
    piSQLType = SQL_TYPE_ACCESS
    pbAutoBracket = True
End Sub