object oriented – SecureADODB library: handling parameterized queries

In the previous post, I presented the DbManager class added to the SecureADODB library. Here, I would like to focus on handling query parameters.

A typical workflow involving the preparation of parameterized queries via the ADODB library can be split into three stages: 1) some kind of input validation, 2) generation of ADODB.Parameter objects, and 3) population of the ADODB.Command.Parameters collection. In SecureADODB, the DbCommandBase class (acting as an abstract factory for the ADODB.Command class) is responsible for stages 1) and 3). The AdoParameterProvider (main) and AdoTypeMappings (supporting) classes implement the stage 2). I made a few changes to the AdoTypeMappings class and replaced AdoParameterProvider with the DbParameters class.

DbParameters

I prefer placing all code dealing with query parameters in one place, so this new class is responsible for all three stages, validation (ValidateParameterValues), generation (CreateParameter & FromValue), and population (IDbParameters_FromValues):

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "DbParameters"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_Description = "Wraps ADODB.Parameters collection"
'@Folder "SecureADODB.DbParameters"
'@ModuleDescription "Wraps ADODB.Parameters collection"
'@PredeclaredId
'@Exposed
Option Explicit

Implements IDbParameters

Private Type TDbParameters
    Factory As ADODB.Command
    TypeMap As ITypeMap
End Type
Private this As TDbParameters

Private Type TAdoParam
    Name As String
    DataType As ADODB.DataTypeEnum
    Direction As ADODB.ParameterDirectionEnum
    Size As Long
    Value As Variant
End Type


Public Function Create(Optional ByVal TypeMap As ITypeMap = Nothing) As IDbParameters
    Dim Instance As DbParameters
    Set Instance = New DbParameters
    Instance.Init TypeMap
    Set Create = Instance
End Function


Friend Sub Init(Optional ByVal TypeMap As ITypeMap = Nothing)
    With this
        Set .Factory = New ADODB.Command
        If TypeMap Is Nothing Then
            Set .TypeMap = AdoTypeMappings.Default
        Else
            Set .TypeMap = TypeMap
        End If
    End With
End Sub


'@Description "Takes parameter value, validates, and returns properties for ADODB.Parameter"
Private Function FromValue(ByVal Value As Variant, _
                  Optional ByVal Name As String = vbNullString, _
                  Optional ByVal DataType As String = vbNullString) As TAdoParam
Attribute FromValue.VB_Description = "Takes parameter value, validates, and returns properties for ADODB.Parameter"
    Dim AdoParam As TAdoParam
    
    Dim DataTypeName As String
    DataTypeName = IIf(DataType <> vbNullString, DataType, TypeName(Value))
    Guard.Expression this.TypeMap.IsMapped(DataTypeName), _
                     Source:="DbParameters", _
                     Message:="The data type '" & DataType _
                              & "' has no ADODB.DataTypeEnum mapping."
    With AdoParam
        .DataType = this.TypeMap.Mapping(DataTypeName)
        .Direction = ADODB.ParameterDirectionEnum.adParamInput
        If AdoTypeMappings.IsCharMapping(.DataType) Then
            '''' For vbNullString and Null set .Size = 1
            .Size = IIf(IsNull(Value), 1, Len(Value) + 1)
        End If
        .Value = IIf(IsEmpty(.DataType), Null, Value)
        .Name = Name
    End With
    
    FromValue = AdoParam
End Function


'@Description "Creates ADODB.Parameter from prepared TAdoParam structure"
Friend Function CreateParameter(ByVal Value As Variant, _
                       Optional ByVal Name As String = vbNullString, _
                       Optional ByVal DataTypeName As String = vbNullString _
                ) As ADODB.Parameter
Attribute CreateParameter.VB_Description = "Creates ADODB.Parameter from prepared TAdoParam structure"
    Dim AdoParam As TAdoParam
    AdoParam = FromValue(Value, Name, DataTypeName)
    
    With AdoParam
        Set CreateParameter = this.Factory.CreateParameter( _
            .Name, .DataType, .Direction, .Size, .Value)
    End With
End Function


'@Description "Validates ValueCount, ParamCount (if >0), and PlaceHolderCount (in SQL)"
Friend Function ValidateParameterValues(ByVal cmd As ADODB.Command, _
                                        ParamArray ADODBParamsValues()) As Long
Attribute ValidateParameterValues.VB_Description = "Validates ValueCount, ParamCount (if >0), and PlaceHolderCount (in SQL)"
    Guard.NullReference cmd
    
    Dim Values() As Variant
    Values = UnfoldParamArray(ADODBParamsValues)

    Dim ValueCount As Long
    ValueCount = UBound(Values) - LBound(Values) + 1
    
    '''' Debug.Assert PlaceHolderCount = ValueCount
    Dim PlaceHolderCount As Long
    Dim SQLQuery As String
    SQLQuery = cmd.CommandText
    If Len(SQLQuery) > 0 Then
        PlaceHolderCount = Len(SQLQuery) - Len(Replace(SQLQuery, "?", vbNullString))
        Guard.Expression PlaceHolderCount = ValueCount, _
                         "DbParameters", _
                         "Number of <?> placeholders does not match parameter value count"
    Else
        Debug.Print "WARNING: AdoCommand.CommandText is not set, skipping check"
    End If

    '''' Debug.Assert ParameterCount = 0 Or ParameterCount = ValueCount
    Dim ParameterCount As Long
    '''' CSV driver may fail here when .Parameters collection is empty
    '''' ErrorCode = &H80040E51
    On Error Resume Next
    '@Ignore AssignmentNotUsed: false positive
    ParameterCount = cmd.Parameters.Count
    With Err
        If .Number = &H80040E51 Then
            .Clear
            ParameterCount = 0
        End If
        If .Number > 0 Then
            .Raise .Number, .Source, .Description, .HelpFile, .HelpContext
        End If
    End With
    On Error GoTo 0
    Guard.Expression ParameterCount = 0 Or ParameterCount = ValueCount, _
                     "DbParameters", _
                     "AdoCommand.Parameters.Count does not match parameter value count"
    
    ValidateParameterValues = ParameterCount
End Function


'@Description "Creates or updates ADODB.Parameters collection in the Command object from an array of values"
Private Sub IDbParameters_FromValues(ByVal cmd As ADODB.Command, _
                                     ParamArray ADODBParamsValues())
Attribute IDbParameters_FromValues.VB_Description = "Creates or updates ADODB.Parameters collection in the Command object from an array of values"
    Dim Values() As Variant
    Values = UnfoldParamArray(ADODBParamsValues)

    Dim ParameterCount As Long
    ParameterCount = ValidateParameterValues(cmd, Values)
    Dim UpdateParams As Boolean
    UpdateParams = ParameterCount > 0
    
    Dim AdoParam As TAdoParam
    Dim Param As ADODB.Parameter
    Dim ValueIndex As Long
    Dim ParameterIndex As Long
    If Not UpdateParams Then
        For ValueIndex = LBound(Values) To UBound(Values)
            cmd.Parameters.Append CreateParameter(Values(ValueIndex))
        Next ValueIndex
    Else
        ParameterIndex = 0
        For ValueIndex = LBound(Values) To UBound(Values)
            AdoParam = FromValue(Values(ValueIndex))
            '@Ignore IndexedDefaultMemberAccess
            Set Param = cmd.Parameters(ParameterIndex)
            With AdoParam
                Param.Type = .DataType
                Param.Size = .Size
                Param.Value = .Value
            End With
            ParameterIndex = ParameterIndex + 1
        Next ValueIndex
    End If
End Sub


'@Description "Generates interpolated SQL query"
Private Function IDbParameters_GetSQL(ByVal AdoCommand As ADODB.Command) As String
    Guard.NullReference AdoCommand

    Dim ParameterCount As Long
    ParameterCount = AdoCommand.Parameters.Count
    Dim SQLQuery As String
    SQLQuery = AdoCommand.CommandText
    
    If Len(SQLQuery) = 0 Or ParameterCount = 0 Then
        IDbParameters_GetSQL = AdoCommand.CommandText
        Exit Function
    End If
    
    Dim ParamValue As Variant
    Dim ParameterIndex As Long
    For ParameterIndex = 0 To ParameterCount - 1
        '@Ignore ImplicitDefaultMemberAccess, IndexedDefaultMemberAccess
        ParamValue = AdoCommand.Parameters(ParameterIndex)
        If Not IsNumeric(ParamValue) Then
            If IsNull(ParamValue) Then
                ParamValue = "Null"
            Else
                ParamValue = "'" & Replace(CStr(ParamValue), "'", "''") & "'"
            End If
        Else
            ParamValue = CStr(ParamValue)
        End If
        SQLQuery = Replace(SQLQuery, "?", ParamValue, Count:=1)
    Next ParameterIndex
    IDbParameters_GetSQL = SQLQuery
End Function

AdoTypeMappings

Since a large part of the code is unchanged, I am only summarizing the changes for this class (the source code is available from the repo, and a more detailed description of the changes is available here):

  1. additional <String → adVarChar> mapping for the CSV backend;
  2. modified mapping for Null/Empty – <Null/Empty → adVarChar>;
  3. Class_Initialize replaced with InitDefault and InitCSV constructors (generally, the use of Class_Initialize in a predeclared class should be avoided).

The primary public API of DbParameters, IDbParameters_FromValues, contains the ParamArray declaration in its signature. ParamArray declaration appears in several places in the SecureADODB library, and, occasionally, it makes sense to pass this argument for further processing to another routine using the ParamArray feature. Unfortunately, VBA does not support such a delegation directly. For this reason, I start every routine accepting a ParamArray argument with the following boilerplate code:

Private Sub IDbParameters_FromValues(ByVal cmd As ADODB.Command, _
                                     ParamArray ADODBParamsValues())
    Dim Values() As Variant
    Values = UnfoldParamArray(ADODBParamsValues)
    ...
End Sub

where UnfoldParamArray function (having one dependency, CPearson’s Array library) is defined as follows:

'''' Unfold if the following conditions are satisfied:
''''     - ParamArrayArg is a 1D array
''''     - UBound(ParamArrayArg, 1) = LBound(ParamArrayArg, 1) = 0
''''     - ParamArrayArg(0) is a 1D 0-based array
''''
'''' Return
''''     - ParamArrayArg(0), if unfolding is necessary
''''     - ParamArrayArg, otherwise
'''' Raise an error if is not an array
'@Description "Unfolds a ParamArray argument when passed from another ParamArray."
Public Function UnfoldParamArray(ByVal ParamArrayArg As Variant) As Variant
    Guard.NotArray ParamArrayArg
    Dim DoUnfold As Boolean
    DoUnfold = (ArrayLib.NumberOfArrayDimensions(ParamArrayArg) = 1) And _
               (LBound(ParamArrayArg) = 0) And _
               (UBound(ParamArrayArg) = 0)
    If DoUnfold Then DoUnfold = IsArray(ParamArrayArg(0))
    If DoUnfold Then
        DoUnfold = ( _
            (ArrayLib.NumberOfArrayDimensions(ParamArrayArg(0)) = 1) And _
            (LBound(ParamArrayArg(0), 1) = 0) _
        )
    End If
    If DoUnfold Then
        UnfoldParamArray = ParamArrayArg(0)
    Else
        UnfoldParamArray = ParamArrayArg
    End If
End Function

I had to split several checks into “cascaded if’s” to avoid the need for error handling (e.g., IsArray(ParamArrayArg(0)) check is only performed if ParamArrayArg is confirmed to be an array). Alternatively, I could combine all conditions in a single conjunctive expression with the On Error Resume Next statement.

With this pattern, a ParamArray argument can be passed to another ParamArray routine any number of times. As a bonus, either a variable-length list

IDbParameters_FromValues(cmd, 23, "ABC", 5.5)

or a 0-based array as the sole argument

IDbParameters_FromValues(cmd, Array(23, "ABC", 5.5))

can now be provided to the ParamArray argument. Importantly, a variable-length argument list cannot be constructed programmatically in VBA, as opposed to the array form (e.g., the list of arguments may come from unrestricted user input).