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.

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

Reset to default
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\$ 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.

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

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

You must log in to answer this question.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.