33
\$\begingroup\$

I have put together a small wrapper class to simplify creating parameterized ADODB queries with VB6/VBA. At this point I'm keeping things simple, so it's only supporting input parameters and from what I've tested it seems to work exactly as intended.

The main reason for writing this, is because creating SQL Injection -safe queries with ADODB involves creating an ADODB.Parameter for each parameter value, which can be combersome; to a beginner it's much easier to just concatenate the values into the command string.

The first thing I did was creating a "converter" class to take any value and spit out an ADODB.Parameter object - I called that class AdoValueConverter:

AdoValueConverter Class

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

Then I wrote the actual wrapper class, which I've called SqlCommand:

SqlCommand Class

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

The Execute method returns a ADODB.Recordset object, and it's up to the client code to close it - the client code owns the connection being used.

The ExecuteNonQuery method returns a Boolean value indicating whether the command was executed successfully (that is, without throwing any errors) - again, the client code owns the connection being used.

The SelectSingleValue method returns a Variant value that represents the value of the first field of the first returned record, if anything is returned from the specified SQL statement.


Usage

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

Although the Precision doesn't get set (I have yet to figure that one out) for Double, Single and Currency parameters, tests have shown that all decimals are being correctly passed to the server, so there's [surprisingly] no immediately apparent bug here.

\$\endgroup\$
2
  • \$\begingroup\$ There is already a way to create parameterized queries in ADO.NET: support.microsoft.com/kb/200190 \$\endgroup\$ Mar 2, 2015 at 17:44
  • 4
    \$\begingroup\$ @GregBurghardt I know, this entire code builds on ADODB parameterized queries (BTW this is VBA, not .NET)... if you looked at how this code is used, you realize that it generates the parameters for you, so SqlCommand.SelectSingleValue("SELECT SomeField FROM SomeTable WHERE SomeValue = ?", 123) is all you need to code to get a full-fledged parameterized query, without the hassle of creating the parameters yourself. \$\endgroup\$ Mar 2, 2015 at 17:47

5 Answers 5

18
\$\begingroup\$

This seems extra complexity with no purpose.

You take any type variable and automatically convert it to a parameter (this is good).

But then something strange happens, you look at the type of the variable and convert that to a string so you can call a function named after the type to do a standard set of options that only change based on the type.

Why have all these functions -- you don't use them anywhere else in your design. Create a function that makes a parameter based on type -- this is what you are actually doing.

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

If you feel the function is getting "to long", then make a helper function that sets direction, type and value on a new ADODB.Parameter and re-factor all those lines out.

I'm fairly sure you don't need to cast "value" to the type as you do, you have already checked its type and you are not changing the type.

Remember, unless there is a reason to do something all the extra stuff is just extra stuff.

\$\endgroup\$
4
  • 1
    \$\begingroup\$ +1 for the casting which is effectively redundant. However the functions specifically fulfill the purpose of replacing a Select..Case block like you're suggesting. Extracting that AdoValueConverter type also allows extending the type with further refinements, such as configurable type mappings; sometimes a Byte value will need to be passed as a smallint, other times as an int - converting a value to an ADODB.Parameter can become quite complex with tons of edge cases (how about a string that contains a GUID, do I pass it as a String or a GUID?), I find it's a concern of its own. \$\endgroup\$ Apr 5, 2014 at 3:08
  • \$\begingroup\$ I see that they replace the Select but the "dynamically named call" is going to be slow so I don't see an advantage to replacing it in this way just a dis-advantage. To solve the edge case a cast will work there like ToParameter(CByte(aParm),... vs ToParameter(CShort(aParm),... \$\endgroup\$
    – Hogan
    Apr 5, 2014 at 3:14
  • \$\begingroup\$ Indeed, I just benchmarked adding 10000 items to a Collection, direct calls: 0-15 ticks, indirect calls: 16-94 ticks. With 100000 items I see a bigger difference: 47 ticks for direct calls vs 180 ticks for indirect calls. I think it's premature optimization to presume there's a massive performance hit with CallByName, the number of parameters of any possible query is way below anything that will make a significant difference in performance. \$\endgroup\$ Apr 5, 2014 at 3:24
  • \$\begingroup\$ Very good point, the performance effect is basically zero for all use cases. \$\endgroup\$
    – Hogan
    Apr 5, 2014 at 3:38
12
\$\begingroup\$

AdoConverter

For better extensibility, the methods in that class shouldn't be calling each others the way ToLongParameter is calling ToIntegerParameter. Also instead of hard-coding the type

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

The class can then expose a [Type]Mapping property for each [Type]Map member of mappings, and then the client code can control the type of ADODB parameter getting created.

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

Passing in a Connection is a great idea: it enables wrapping these database operations in a transaction. However the interface of SqlCommand isn't consistent about it: there's no reason why SelectSingleValue shouldn't be taking a Connection parameter as well. Doing that will enable reusing an existing connection instead of creating a new one every time, on top of improving usage consistency.

Also each exposed method creates a Command object, and that code is duplicated every time. You could factor it into its own private factory method:

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

This turns the Execute method into:

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

And then you could add an ExecuteStoredProc method just as easily, without duplicating all the command-creating code:

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

Some Opportunities

This "wrapper" doesn't really abstract away the syntax for parameterized queries; if a value is needed twice, it needs to be specified twice; also the values must be specified in the same order they're replacing question marks.

You could implement something similar to this StringFormat code (taking a bit of a performance hit though), and enable named parameters, and a formatting syntax that would allow specifying Precision and Size for any parameter, or even a specific mapping for a given parameter (say Integer parameter 1 is mapped to a smallint and Integer parameter 2 maps to an int, both in the same query), and one could specify parameters' direction, enabling support for output parameters (then you'd need a way to return the parameter values) - and the order of parameters could be specified as well.

The flipside is that this would make a new syntax to learn, which somewhat defeats the purpose of making things simpler for inexperienced programmers.

\$\endgroup\$
11
\$\begingroup\$

I would opt for strict type checking here. It seems a bit lazy to force it to a single when implicit in the function name. No need to use a variant and force it to a Single via a cast.

IMHO, if the function ToSingleParameter is expecting a Single, then it should get a Single value and complain with a type mismatch error if it doesn't receive it.

I've also added optional parameters for the Precision and the NumericScale with default values. The ToDoubleParameter, ToCurrencyParameter should also be modified as well.

Keep in mind that Precision is the number of digits in a number. NumericScale is the number of digits to the right of the decimal point in a number. Where a number like 99999999.99 has a Precision of 10 and a NumericScale of 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
\$\endgroup\$
1
  • \$\begingroup\$ Nice catch! Welcome to CR! \$\endgroup\$
    – RubberDuck
    Mar 2, 2015 at 19:33
5
\$\begingroup\$

You felt the need to go through great lengths in your post here to explain that the client code owns and is responsible for opening/closing connections and closing the returned recordsets, yet I see no comments mentioning this in the code. I would add some proper documentation for something you see as being this important.

\$\endgroup\$
1
  • \$\begingroup\$ Could use method attributes for documentation, indeed... \$\endgroup\$ Apr 9, 2015 at 19:31
3
\$\begingroup\$

Waking this one up...

ExecuteNonQuery

Return value never assigned

ExecuteNonQuery never has its return value assigned.

Return value type

You have an opportunity here to return a richer value than a Boolean. Very often when executing a command, you're interested in the number of records affected. You can return the number of records affected, or -1 if there is an error.

Execution Options

You're not explicitly setting any Options on the ADODB.Command.Execute. As per MSDN:

Use the ExecuteOptionEnum value adExecuteNoRecords to improve performance by minimizing internal processing.

Assigning ActiveConnection

ActiveConnection is an object whose default property is ConnectionString. When assigning the ActiveConnection property, it is better practice to always use Set, although ADODB will manage things behind the scenes if you forget and just assign the ConnectionString property.

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 factory method

Checking for valid ParamArray arguments

As per MSDN

If IsMissing is used on a ParamArray argument, it always returns False. To detect an empty ParamArray, test to see if the array's upper bound is less than its lower bound.

Despite the documentation above, IsMissing does actually seem to return True when the ParamArray argument is missing, but it's still safer to check the array bounds.

You obviously have a private helper function in IsArrayInitialized, but it is not necessary - if the ParamArray variable is "missing", it will be an array, but its upperbound will be -1, and its lowerbound will be 0, so the For statement is sufficient.

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

Having said that, you're going through some variable gymnastics to pass a ParamArray argument to a private method. You can avoid that by declaring the helper function's parameterValues parameter as ByVal parameterValues As Variant, but then you do need to check that it is an array before enumerating it.

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

Then, you can simplify a public method like ExecuteStoredProc to:

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
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.