我整理了一个小型包装器类,以简化使用VB6 / VBA创建参数化ADODB查询的过程。在这一点上,我将事情保持简单,因此它仅支持输入参数,并且根据我的测试,它似乎可以按预期工作。
编写此文件的主要原因是因为创建SQL Injection -safe查询使用ADODB涉及为每个参数值创建ADODB.Parameter,这可能很麻烦;对于初学者来说,将值连接到命令字符串中要容易得多。
我要做的第一件事是创建一个“转换器”类以获取任何值并吐出ADODB.Parameter对象-我将该类称为AdoValueConverter

AdoValueConverter类


 Option Explicit

Public Function ToStringParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter
   
    Dim stringValue As String
    stringValue = CStr(value)
    
    Dim result As New ADODB.Parameter
    With result
        .type = adVarChar
        .direction = direction
        .size = Len(stringValue)
        .value = stringValue
    End With
    
    Set ToStringParameter = result
    
End Function

Public Function ToIntegerParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter
    
    Dim integerValue As Long
    integerValue = CLng(value)
    
    Dim result As New ADODB.Parameter
    With result
        .type = adInteger
        .direction = direction
        .value = integerValue
    End With
    
    Set ToIntegerParameter = result
    
End Function

Public Function ToLongParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter
    
    Set ToLongParameter = ToIntegerParameter(value, direction)
    
End Function

Public Function ToDoubleParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter
    
    Dim doubleValue As Double
    doubleValue = CDbl(value)
    
    Dim result As New ADODB.Parameter
    With result
        .type = adDouble
        .direction = direction
        .value = doubleValue
    End With
    
    Set ToDoubleParameter = result
    
End Function

Public Function ToSingleParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter
    
    Dim singleValue As Single
    singleValue = CSng(value)
    
    Dim result As New ADODB.Parameter
    With result
        .type = adSingle
        .direction = direction
        .value = singleValue
    End With
    
    Set ToSingleParameter = result
    
End Function

Public Function ToCurrencyParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter
    
    Dim currencyValue As Currency
    currencyValue = CCur(value)
    
    Dim result As New ADODB.Parameter
    With result
        .type = adCurrency
        .direction = direction
        .value = currencyValue
    End With
    
    Set ToCurrencyParameter = result
    
End Function

Public Function ToBooleanParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter

    Dim boolValue As Boolean
    boolValue = CBool(value)
    
    Dim result As New ADODB.Parameter
    With result
        .type = adBoolean
        .direction = direction
        .value = boolValue
    End With
    
    Set ToBooleanParameter = result
    
End Function

Public Function ToDateParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter

    Dim dateValue As Date
    dateValue = CDate(value)
    
    Dim result As New ADODB.Parameter
    With result
        .type = adDate
        .direction = direction
        .value = dateValue
    End With
    
    Set ToDateParameter = result
    
End Function
 

然后我写了实际的包装类,我称之为SqlCommand

 Private converter As New AdoValueConverter
Option Explicit

Public Function Execute(connection As ADODB.connection, sql As String, ParamArray parameterValues()) As ADODB.Recordset
    
    Dim cmd As New ADODB.Command
    cmd.ActiveConnection = connection
    cmd.CommandType = adCmdText
    cmd.CommandText = sql
    
    Dim i As Integer
    Dim value As Variant
    For i = LBound(parameterValues) To UBound(parameterValues)
        value = parameterValues(i)
        cmd.parameters.Append ToSqlInputParameter(value)
    Next
    
    Set Execute = cmd.Execute
    
End Function

Public Function SelectSingleValue(sql As String, ParamArray parameterValues()) As Variant
    
    Dim connection As New ADODB.connection
    connection.ConnectionString = Application.ConnectionString
    connection.Open
    
    Dim cmd As New ADODB.Command
    cmd.ActiveConnection = connection
    cmd.CommandType = adCmdText
    cmd.CommandText = sql
    
    Dim i As Integer
    Dim value As Variant
    For i = LBound(parameterValues) To UBound(parameterValues)
        value = parameterValues(i)
        cmd.parameters.Append ToSqlInputParameter(value)
    Next
    
    Dim rs As ADODB.Recordset
    Set rs = cmd.Execute
    
    Dim result As Variant
    If Not rs.BOF And Not rs.EOF Then result = rs.Fields(0).value
    
    rs.Close
    Set rs = Nothing

    connection.Close
    Set connection = Nothing
    
    SelectSingleValue = result
    
End Function

Public Function ExecuteNonQuery(connection As ADODB.connection, sql As String, ParamArray parameterValues()) As Boolean

    Dim cmd As New ADODB.Command
    cmd.ActiveConnection = connection
    cmd.CommandType = adCmdText
    cmd.CommandText = sql
    
    Dim i As Integer
    Dim value As Variant
    For i = LBound(parameterValues) To UBound(parameterValues)
        value = parameterValues(i)
        cmd.parameters.Append ToSqlInputParameter(value)
    Next
    
    Dim result As Boolean
    On Error Resume Next
        cmd.Execute
        result = (Err.Number = 0)
    On Error GoTo 0
    
End Function

Private Function ToSqlInputParameter(ByVal value As Variant, Optional ByVal size As Integer, Optional ByVal precision As Integer) As ADODB.Parameter
    
    Dim result As ADODB.Parameter
    Set result = CallByName(converter, "To" & TypeName(value) & "Parameter", VbMethod, value, ADODB.ParameterDirectionEnum.adParamInput)
    
    If size <> 0 Then result.size = size
    If precision <> 0 Then result.precision = precision
    
    Set ToSqlInputParameter = result
    
End Function
 

Execute方法返回一个ADODB.Recordset对象,由客户端代码来关闭它-客户端代码拥有正在使用的连接。
ExecuteNonQuery方法返回一个Boolean值,该值指示命令是否已成功执行(即,不会引发任何错误)-同样,客户端代码拥有所使用的连接。
SelectSingleValue方法返回一个Variant值,该值代表第一个r的第一个字段的值返回的记录,如果指定的SQL语句返回了任何内容。

用法
 Dim cmd As New SqlCommand
Dim result As Variant
result = cmd.SelectSingleValue("SELECT SomeField FROM SomeTable WHERE SomeValue = ?", 123)
 


 Dim cmd As New SqlCommand
Dim result As ADODB.Recordset
Dim conn As New ADODB.Connection
conn.ConnectionString = "connection string"
conn.Open
Set result = cmd.Execute(conn, "SELECT * FROM SomeTable WHERE SomeField = ?", 123)
'use result
result.Close
conn.Close
 



 Dim cmd As New SqlCommand
Dim conn As New ADODB.Connection
Dim result As Boolean
conn.ConnectionString = "connection string"
conn.Open
result = cmd.ExecuteNonQuery(conn, "UPDATE SomeTable SET SomeField = ? WHERE SomeValue = ?", 123, "abc")
conn.Close
 

尽管没有为PrecisionDoubleSingle参数设置Currency(我还没有弄清楚),但测试表明所有小数都已正确传递到服务器,因此[令人惊讶地]这里没有[显而易见的]错误。 。

评论

已经有一种在ADO.NET中创建参数化查询的方法:support.microsoft.com/kb/200190

@GregBurghardt我知道,整个代码都基于ADODB参数化查询(顺便说一句,这是VBA,而不是.NET)...如果查看此代码的用法,您会意识到它会为您生成参数,因此SqlCommand.SelectSingleValue (“ SELECT SomeField FROM SomeTable WHERE SomeValue =?”,123)是您获得完整参数化查询所需的全部代码,而无需麻烦自己创建参数。

#1 楼

这似乎是没有目的的额外复杂性。

您可以使用任何类型变量并将其自动转换为参数(这很好)。

但是随后发生了一些奇怪的事情,您看起来在变量的类型上并将其转换为字符串,以便可以调用以该类型命名的函数来执行一组仅根据类型而变化的标准选项。

为什么要具有所有这些函数-您不会在设计中的其他任何地方使用它们。创建一个根据类型创建参数的函数-这就是您实际上正在做的。

Public Function ToParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter

    Dim result As New ADODB.Parameter

    result.direction = direction

    Select  TypeName(value)
      Case "String"
        result.type = adVarChar
        result.size = Len(CStr(value))
        result.value = CStr(value)
      Case "Integer"
        result.type = adInteger
        result.value = CLng(value)
      Case "Double"
        result.type = adDouble
        result.value = CDbl(value)
    End Select

    Set ToParameter = result

End Function


如果您觉得该函数“过长”,那么可以创建一个辅助函数来设置新ADODB的方向,类型和值。将所有这些行都考虑在内。

我很确定您不需要像那样将“ value”强制转换为类型,您已经检查了其类型并且没有更改类型。

请记住,除非有必要做某事,否则所有多余的东西就是多余的东西。

评论


\ $ \ begingroup \ $
+1是有效的转换。但是,这些功能专门实现了您所建议的替换Select..Case块的目的。提取该AdoValueConverter类型还可以通过进一步完善来扩展类型,例如可配置的类型映射。有时需要将Byte值作为smallint传递,而其他时候则作为int传递-将值转换为ADODB。参数会因大量边缘情况而变得非常复杂(关于包含GUID的字符串,我应该传递它吗?作为字符串还是GUID?),我发现它本身就是一个问题。
\ $ \ endgroup \ $
– Mathieu Guindon♦
2014年4月5日,凌晨3:08

\ $ \ begingroup \ $
我看到他们替换了Select,但是“动态命名的呼叫”将很慢,因此我认为以这种方式替换它并没有优势,只是一个缺点。为了解决边缘情况,强制转换将像ToParameter(CByte(aParm),... vs ToParameter(CShort(aParm),...)
\ $ \ endgroup \ $
– Hogan
2014-4-5的3:14



\ $ \ begingroup \ $
的确,我刚刚对添加到集合中的10000个项目进行了基准测试,直接调用:0-15个滴答声,间接调用:16-94个滴答声。对于100000个项目,我看到了更大的差异:直接调用为47滴答声,间接调用为180滴答声。我认为使用CallByName会严重影响性能,这是过早的优化,任何可能查询的参数数量都远低于会显着影响性能的任何参数。
\ $ \ endgroup \ $
– Mathieu Guindon♦
2014年4月5日在3:24



\ $ \ begingroup \ $
非常好的一点,在所有用例中,性能效果基本上为零。
\ $ \ endgroup \ $
– Hogan
2014年4月5日在3:38

#2 楼

为了更好地扩展,AdoConverter

该类中的方法不应像ToLongParameter调用ToIntegerParameter那样互相调用。同样,也可以不对类型进行硬编码

Private Type TypeMappings
    BooleanMap As ADODB.DataTypeEnum
    ByteMap As ADODB.DataTypeEnum
    CurrencyMap As ADODB.DataTypeEnum
    DateMap As ADODB.DataTypeEnum
    DoubleMap As ADODB.DataTypeEnum
    IntegerMap As ADODB.DataTypeEnum
    LongMap As ADODB.DataTypeEnum
    SingleMap As ADODB.DataTypeEnum
    StringMap As ADODB.DataTypeEnum
End Type

Private mappings As TypeMappings
Option Explicit

Private Sub Class_Initialize()

    mappings.BooleanMap = adBoolean
    mappings.ByteMap = adInteger
    mappings.CurrencyMap = adCurrency
    mappings.DateMap = adDate
    mappings.DoubleMap = adDouble
    mappings.IntegerMap = adInteger
    mappings.LongMap = adInteger
    mappings.SingleMap = adSingle
    mappings.StringMap = adVarChar

End Sub


然后,该类可以为[Type]Mapping的每个[Type]Map成员公开mappings属性,然后客户端代码可以控制创建ADODB参数。
Public Function ToLongParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter

    Dim longValue As Long
    longValue = CLng(value)

    Dim result As New ADODB.Parameter
    With result
        .type = mappings.LongMap ' mapped type is no longer hard-coded
        .direction = direction
        .value = longValue
    End With

    Set ToLongParameter = result

End Function

SqlCommand

传入Connection是一个好主意:它可以将这些数据库操作包装在事务中。但是SqlCommand的界面与此不一致:没有理由为什么SelectSingleValue也不应采用Connection参数。这样做不仅可以提高使用的一致性,而且可以重用现有连接,而不必每次都创建一个新连接。

每个公开的方法还创建一个Command对象,并且该代码每次都重复。您可以将其分解为自己的私有工厂方法:

Private Function CreateCommand(connection As ADODB.connection, ByVal cmdType As ADODB.CommandTypeEnum, ByVal sql As String, parameterValues() As Variant) As ADODB.Command

    Dim cmd As New ADODB.Command
    cmd.ActiveConnection = connection
    cmd.CommandType = cmdType
    cmd.CommandText = sql

    Dim i As Integer
    Dim value As Variant

    If IsArrayInitialized(parameterValues) Then

        For i = LBound(parameterValues) To UBound(parameterValues)
            value = parameterValues(i)
            cmd.parameters.Append ToSqlInputParameter(value)
        Next

    End If

    Set CreateCommand = cmd

End Function


这会将Execute方法变成:

Public Function Execute(connection As ADODB.connection, ByVal sql As String, ParamArray parameterValues()) As ADODB.Recordset

    Dim values() As Variant
    values = parameterValues

    Dim cmd As ADODB.Command
    Set cmd = CreateCommand(connection, adCmdText, sql, values)

    Set Execute = cmd.Execute

End Function


然后您可以轻松地添加ExecuteStoredProc方法,而无需复制所有创建命令的代码:

Public Function ExecuteStoredProc(connection As ADODB.connection, ByVal spName As String, ParamArray parameterValues()) As ADODB.Recordset

    Dim values() As Variant
    values = parameterValues

    Dim cmd As ADODB.Command
    Set cmd = CreateCommand(connection, adCmdStoredProc, spName, values)

    Set ExecuteStoredProc = cmd.Execute

End Function


一些机会

这个“包装器”并没有真正抽象出参数化查询的语法。如果需要两次,则需要指定两次;还必须以替换问号的相同顺序指定值。

您可以实现与此StringFormat代码类似的功能(尽管会降低性能),并启用命名参数,以及一种格式化语法,该语法允许为任何参数指定PrecisionSize,甚至为给定参数指定特定的映射(假设Integer参数1映射到smallint,Integer参数2映射到int,都在同一查询中),并且可以指定参数的方向,从而支持输出参数(然后您需要一种返回参数的方法)值)-并且还可以指定参数的顺序。

另一方面,这将使人们学习一种新的语法,这在一定程度上违背了使经验不足的程序员简化程序的目的。

#3 楼

我会在这里选择严格的类型检查。在函数名称中隐式将其强制为单个似乎有点懒。无需使用变体并通过强制将其强制为Single。

恕我直言,如果函数ToSingleParameter期望使用Single,则它应该获得Single值,并且如果未接收到则抱怨类型不匹配错误。

我还为Precision和NumericScale添加了带有默认值的可选参数。 ToDoubleParameter,ToCurrencyParameter也应该修改。

请记住,Precision是数字中的位数。 NumericScale是数字中小数点右边的位数。其中像99999999.99这样的数字的精度为10,数值范围为2。

    Public Function ToSingleParameter( _
        ByVal value As Single, _
        ByVal direction As ADODB.ParameterDirectionEnum, _
        Optional ByVal Precision As Integer = 10, _
        Optional ByVal NumericScale As Integer = 2) As ADODB.Parameter

        Dim result As New ADODB.Parameter
        With result
            .Precision = Precision
            .NumericScale = NumericScale
            .type = adSingle
            .direction = direction
            .value = value 
        End With

        Set ToSingleParameter = result
    End Function


评论


\ $ \ begingroup \ $
不错!欢迎来到华润!
\ $ \ endgroup \ $
–RubberDuck
15年3月2日在19:33

#4 楼

您觉得有必要在这里的帖子中花很多篇幅来说明客户端代码拥有并负责打开/关闭连接以及关闭返回的记录集,但是我在代码中没有提及此内容。对于您认为如此重要的内容,我会添加一些适当的文档。

评论


\ $ \ begingroup \ $
确实可以使用方法属性进行文档编制...
\ $ \ endgroup \ $
– Mathieu Guindon♦
2015年4月9日19:31

#5 楼

唤醒这一个...

ExecuteNonQuery

返回值从未分配

ExecuteNonQuery从未分配其返回值。

返回值类型

您有机会在这里返回比Boolean更丰富的值。通常,执行命令时,您会对受影响的记录数感兴趣。您可以返回受影响的记录数,如果有错误,则返回-1。

执行选项

您没有在Options上显式设置任何ADODB.Command.Execute。根据MSDN:


使用ExecuteOptionEnum值adExecuteNoRecords通过最小化内部处理来提高性能。


分配ActiveConnection

> ActiveConnection是一个对象,其默认属性为ConnectionString。分配ActiveConnection属性时,最好始终使用Set,尽管如果您忘记了而只是分配ConnectionString属性,则ADODB会在后台进行管理。

Public Function ExecuteNonQuery(connection As ADODB.connection, sql As String, ParamArray parameterValues()) As Long

    Dim cmd As New ADODB.Command
    Set cmd.ActiveConnection = connection
    cmd.CommandType = adCmdText
    cmd.CommandText = sql

    Dim i As Integer
    Dim value As Variant
    For i = LBound(parameterValues) To UBound(parameterValues)
        value = parameterValues(i)
        cmd.parameters.Append ToSqlInputParameter(value)
    Next

    Dim result As Long
    On Error Resume Next
        Dim recordsAffected As Long
        cmd.Execute recordsAffected, Options:=ExecuteOptionEnum.adExecuteNoRecords
        If Err.Number = 0 Then
          result = recordsAffected
        Else
          result = -1
        End If
    On Error GoTo 0
    ExecuteNonQuery = result
End Function


CreateCommand工厂方法

检查有效的ParamArray参数

根据MSDN


如果在IsMissing参数上使用ParamArray,则始终返回False。若要检测空的ParamArray,请测试数组的上限是否小于其下限。


尽管上面的文档,当ParamArray参数为时,IsMissing实际上似乎返回True

您显然在IsArrayInitialized中具有私有帮助器函数,但这不是必需的-如果ParamArray变量“缺失”,它将是一个数组,但其上限为-1,下限为0,因此For语句就足够了。

Private Function CreateCommand(connection As ADODB.connection, ByVal cmdType As ADODB.CommandTypeEnum, ByVal sql As String, parameterValues() As Variant) As ADODB.Command

    Dim cmd As New ADODB.Command
    cmd.ActiveConnection = connection
    cmd.CommandType = cmdType
    cmd.CommandText = sql

    Dim i As Integer
    Dim value As Variant

    For i = LBound(parameterValues) To UBound(parameterValues)
        value = parameterValues(i)
        cmd.parameters.Append ToSqlInputParameter(value)
    Next

    Set CreateCommand = cmd

End Function


话虽如此,您正在经历一些可变的体操技巧,以将ParamArray参数传递给私有方法。您可以通过将辅助函数的parameterValues参数声明为ByVal parameterValues As Variant来避免这种情况,但是在枚举之前,您确实需要检查它是否是一个数组。

Private Function CreateCommand(connection As ADODB.connection, ByVal cmdType As ADODB.CommandTypeEnum, ByVal sql As String, ByVal parameterValues As Variant) As ADODB.Command

    Dim cmd As New ADODB.Command
    cmd.ActiveConnection = connection
    cmd.CommandType = cmdType
    cmd.CommandText = sql

    Dim i As Integer
    Dim value As Variant

    If IsArray(parameterValues) Then

        For i = LBound(parameterValues) To UBound(parameterValues)
            value = parameterValues(i)
            cmd.parameters.Append ToSqlInputParameter(value)
        Next

    End If

    Set CreateCommand = cmd

End Function


然后,您可以将ExecuteStoredProc之类的公共方法简化为:

Public Function ExecuteStoredProc(connection As ADODB.connection, ByVal spName As String, ParamArray parameterValues()) As ADODB.Recordset

    Set ExecuteStoredProc = CreateCommand(connection, adCmdStoredProc, spName, values).Execute

End Function