34
\$\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.

asked Apr 4, 2014 at 18:44
\$\endgroup\$
2
  • \$\begingroup\$ There is already a way to create parameterized queries in ADO.NET: support.microsoft.com/kb/200190 \$\endgroup\$ Commented Mar 2, 2015 at 17:44
  • 5
    \$\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\$ Commented 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.

answered Apr 5, 2014 at 2:59
\$\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\$ Commented 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\$ Commented 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\$ Commented Apr 5, 2014 at 3:24
  • \$\begingroup\$ Very good point, the performance effect is basically zero for all use cases. \$\endgroup\$ Commented 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.

answered Apr 5, 2014 at 15:52
\$\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
answered Mar 2, 2015 at 17:31
\$\endgroup\$
1
  • \$\begingroup\$ Nice catch! Welcome to CR! \$\endgroup\$ Commented 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.

answered Apr 9, 2015 at 18:06
\$\endgroup\$
1
  • \$\begingroup\$ Could use method attributes for documentation, indeed... \$\endgroup\$ Commented 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
answered Jan 6, 2017 at 3:01
\$\endgroup\$

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.