VitoshAcademy has the pleasure to welcome its first guest author – Mr. Mathieu Guindon. He is the project manager behind Rubberduck – an open-source COM add-in project written in C#, extending the glorious VBE with modern-day IDE features. On Code Review and Stack Overflow he is closely monitoring the vba tag. Ex-moderator on Code Review (2015-2018), Microsoft Excel MVP (2018). See this 5 question interview with Mathieu here.
One quite common mistake many developers do every day, often without even realizing, is to write code like this:
1 2 |
Dim sql As String sql = "SELECT Value FROM SomeTable WHERE Foo = '" & pFoo & "' AND Bar = " & pBar |
Where pFoo
is some String
value, and pBar
is some number. Concatenating the WHERE clause values like this, regardless of the language, leaves the code wide open to an SQL injection attack. If you hand-wave the issue and pretend it doesn’t apply to you, then you are not understanding the problem.
This vulnerability will invariably cause issues at one point or another – if you’re doing PHP or server-side C# or VB.NET, you need to see this classic XKCD comic:
If you’re writing some in-house desktop application in Java, C#, or VBA, you’ll be writing code to work around the vulnerability (e.g. double up single quotes), and think you’re covered and Mrs. Null and Mr.O’Neil can safely use your application. Until something else breaks, or until you need to maintain these concatenated SQL monstrosities in any way.
Of course there’s a better way. People will tell you to use parameterized queries instead of concatenating your values and properly accounting for single quotes. You’ve done it once or twice, thought something along the lines of “boy that’s a lot of code for so little benefit”, and went back to your old ways. Or, you’re now a convert and use parameters all the time, and you copy/paste big chunks of boilerplate code every time.
What if there was a magic way to deal with all the boilerplate?
Generating ADODB Parameters on the fly
What we need is a class that’s able to take a value, determine its type, and spit out a properly-configured ADODB.Parameter
object for us. Enter AdoValueConverter
:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 |
Private Type TypeMappings OptionAllStrings As Boolean OptionMapGuidString As Boolean StringDateFormat As String BooleanMap As ADODB.DataTypeEnum StringMap As ADODB.DataTypeEnum GuidMap As ADODB.DataTypeEnum DateMap As ADODB.DataTypeEnum ByteMap As ADODB.DataTypeEnum IntegerMap As ADODB.DataTypeEnum LongMap As ADODB.DataTypeEnum DoubleMap As ADODB.DataTypeEnum SingleMap As ADODB.DataTypeEnum CurrencyMap As ADODB.DataTypeEnum End Type Private mappings As TypeMappings Option Explicit Private Sub Class_Initialize() mappings.OptionAllStrings = False mappings.OptionMapGuidString = True mappings.StringDateFormat = "yyyy-MM-dd" mappings.BooleanMap = adBoolean mappings.ByteMap = adInteger mappings.CurrencyMap = adCurrency mappings.DateMap = adDate mappings.DoubleMap = adDouble mappings.GuidMap = adGUID mappings.IntegerMap = adInteger mappings.LongMap = adInteger mappings.SingleMap = adSingle mappings.StringMap = adVarChar End Sub Public Property Get OptionAllStrings() As Boolean OptionAllStrings = mappings.OptionAllStrings End Property Public Property Let OptionAllStrings(ByVal value As Boolean) mappings.OptionAllStrings = value End Property Public Property Get OptionMapGuidStrings() As Boolean OptionMapGuidStrings = mappings.OptionMapGuidString End Property Public Property Let OptionMapGuidStrings(ByVal value As Boolean) mappings.OptionMapGuidString = value End Property Public Property Get StringDateFormat() As String StringDateFormat = mappings.StringDateFormat End Property Public Property Let StringDateFormat(ByVal value As String) mappings.StringDateFormat = value End Property Public Property Get BooleanMapping() As ADODB.DataTypeEnum BooleanMapping = mappings.BooleanMap End Property Public Property Let BooleanMapping(ByVal value As ADODB.DataTypeEnum) mappings.BooleanMap = value End Property Public Property Get ByteMapping() As ADODB.DataTypeEnum ByteMapping = mappings.ByteMap End Property Public Property Let ByteMapping(ByVal value As ADODB.DataTypeEnum) mappings.ByteMap = value End Property Public Property Get CurrencyMapping() As ADODB.DataTypeEnum CurrencyMapping = mappings.CurrencyMap End Property Public Property Let CurrencyMapping(ByVal value As ADODB.DataTypeEnum) mappings.CurrencyMap = value End Property Public Property Get DateMapping() As ADODB.DataTypeEnum DateMapping = mappings.DateMap End Property Public Property Let DateMapping(ByVal value As ADODB.DataTypeEnum) mappings.DateMap = value End Property Public Property Get DoubleMapping() As ADODB.DataTypeEnum DoubleMapping = mappings.DoubleMap End Property Public Property Let DoubleMapping(ByVal value As ADODB.DataTypeEnum) mappings.DoubleMap = value End Property Public Property Get GuidMapping() As ADODB.DataTypeEnum GuidMapping = mappings.GuidMap End Property Public Property Let GuidMapping(ByVal value As ADODB.DataTypeEnum) mappings.GuidMap = value End Property Public Property Get IntegerMapping() As ADODB.DataTypeEnum IntegerMapping = mappings.IntegerMap End Property Public Property Let IntegerMapping(ByVal value As ADODB.DataTypeEnum) mappings.IntegerMap = value End Property Public Property Get LongMapping() As ADODB.DataTypeEnum LongMapping = mappings.LongMap End Property Public Property Let LongMapping(ByVal value As ADODB.DataTypeEnum) mappings.LongMap = value End Property Public Property Get SingleMapping() As ADODB.DataTypeEnum SingleMapping = mappings.SingleMap End Property Public Property Let SingleMapping(ByVal value As ADODB.DataTypeEnum) mappings.SingleMap = value End Property Public Property Get StringMapping() As ADODB.DataTypeEnum StringMapping = mappings.StringMap End Property Public Property Let StringMapping(ByVal value As ADODB.DataTypeEnum) mappings.StringMap = value End Property Public Function ToNamedParameter(ByVal name As String, ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.parameter Dim result As ADODB.parameter Set result = CallByName(Me, "To" & TypeName(value) & "Parameter", VbMethod, value, direction) result.name = name Set ToNamedParameter = result End Function Public Function ToStringParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.parameter Dim stringValue As String stringValue = CStr(value) If Not mappings.OptionAllStrings Then If IsGuidString(stringValue) Then ' split on 2 conditions for performance: evaluating IsGuidString uses regular expressions Set ToStringParameter = ToGuidParameter(value, direction) Exit Function End If End If Dim result As ADODB.parameter Set result = New ADODB.parameter With result .Type = mappings.StringMap .direction = direction .size = Len(stringValue) .value = stringValue End With Set ToStringParameter = result End Function Public Function ToGuidParameter(ByVal value As String, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.parameter If mappings.OptionAllStrings Then Set ToGuidParameter = ToStringParameter(value, direction) Exit Function End If Dim result As ADODB.parameter Set result = New ADODB.parameter With result .Type = mappings.GuidMap .direction = direction .value = value End With Set ToGuidParameter = result End Function Private Function IsGuidString(ByVal value As String) As Boolean Dim regex As New RegExp regex.pattern = "\b[A-F0-9]{8}(?:-[A-F0-9]{4}){3}-[A-F0-9]{12}\b" Dim matches As MatchCollection Set matches = regex.Execute(UCase$(value)) IsGuidString = matches.Count <> 0 Set regex = Nothing Set matches = Nothing End Function Public Function ToIntegerParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.parameter If mappings.OptionAllStrings Then Set ToIntegerParameter = ToStringParameter(value, direction) Exit Function End If Dim integerValue As Long integerValue = CLng(value) Dim result As ADODB.parameter Set result = New ADODB.parameter With result .Type = mappings.IntegerMap .direction = direction .value = integerValue End With Set ToIntegerParameter = result End Function Public Function ToByteParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.parameter If mappings.OptionAllStrings Then Set ToByteParameter = ToStringParameter(value, direction) Exit Function End If Dim byteValue As Byte byteValue = CByte(value) Dim result As ADODB.parameter Set result = New ADODB.parameter With result .Type = mappings.ByteMap .direction = direction .value = byteValue End With Set ToByteParameter = result End Function Public Function ToLongParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.parameter If mappings.OptionAllStrings Then Set ToLongParameter = ToStringParameter(value, direction) Exit Function End If Dim longValue As Long longValue = CLng(value) Dim result As ADODB.parameter Set result = New ADODB.parameter With result .Type = mappings.LongMap .direction = direction .value = longValue End With Set ToLongParameter = result End Function Public Function ToDoubleParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.parameter If mappings.OptionAllStrings Then Set ToDoubleParameter = ToStringParameter(value, direction) Exit Function End If Dim doubleValue As Double doubleValue = CDbl(value) Dim result As ADODB.parameter Set result = New ADODB.parameter With result .Type = mappings.DoubleMap .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 If mappings.OptionAllStrings Then Set ToSingleParameter = ToStringParameter(value, direction) Exit Function End If Dim singleValue As Single singleValue = CSng(value) Dim result As ADODB.parameter Set result = New ADODB.parameter With result .Type = mappings.SingleMap .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 If mappings.OptionAllStrings Then Set ToCurrencyParameter = ToStringParameter(value, direction) Exit Function End If Dim currencyValue As Currency currencyValue = CCur(value) Dim result As ADODB.parameter Set result = New ADODB.parameter With result .Type = mappings.CurrencyMap .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 If mappings.OptionAllStrings Then Set ToBooleanParameter = ToStringParameter(value, direction) Exit Function End If Dim boolValue As Boolean boolValue = CBool(value) Dim result As ADODB.parameter Set result = New ADODB.parameter With result .Type = mappings.BooleanMap .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 If mappings.OptionAllStrings Then Set ToDateParameter = ToStringParameter(Format$(value, mappings.StringDateFormat), direction) Exit Function End If Dim dateValue As Date dateValue = CDate(value) Dim result As ADODB.parameter Set result = New ADODB.parameter With result .Type = mappings.DateMap .direction = direction .value = dateValue End With Set ToDateParameter = result End Function |
Pretty straightforward, boring boilerplate: to each type its own dedicated function. We have an option to make everything convert to a String
parameter, and another to determine whether a GUID string should be converted into a Guid
or a String
parameter, and a Property Let
member allows reconfiguring the mappings at run-time.
A more advanced implementation could perhaps use a keyed collection or a dictionary to store the mappings, instead of spelling them all out.
Next, we need another class – let’s call it SqlCommand
, whose job is to take the SQL string and the parameter values, create the ADODB boilerplate, execute it, and return the results.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 |
Private converter As New AdoValueConverter Option Explicit Public Property Get ParameterFactory() As AdoValueConverter Set ParameterFactory = converter End Property Public Function Execute(ByVal connection As ADODB.connection, ByVal sql As String, ParamArray parameterValues()) As ADODB.Recordset 'Returns a connected ADODB.Recordset that contains the results of the specified parameterized query. Dim parameters() As Variant parameters = parameterValues Set Execute = ExecuteInternal(connection, sql, parameters) End Function Public Function ExecuteNonQuery(ByVal connection As ADODB.connection, ByVal sql As String, ParamArray parameterValues()) As Boolean 'Returns a Boolean that indicates whether the specified parameterized SQL command (update, delete, etc.) executed without throwing an error. Dim parameters() As Variant parameters = parameterValues ExecuteNonQuery = ExecuteNonQueryInternal(connection, sql, parameters) End Function Public Function ExecuteStoredProc(ByVal connection As ADODB.connection, ByVal spName As String, ParamArray parameterValues()) As ADODB.Recordset 'Executes the specified parameterized stored procedure, passing specified parameter values. Dim parameters() As Variant parameters = parameterValues Set ExecuteStoredProc = ExecuteStoredProcInternal(connection, spName, parameters) End Function Public Function SelectSingleValue(ByVal connection As ADODB.connection, ByVal sql As String, ParamArray parameterValues()) As Variant 'Returns the value of the first field of the first record of the results of the specified parameterized SQL query. Dim parameters() As Variant parameters = parameterValues SelectSingleValue = SelectSingleValueInternal(connection, sql, parameters) End Function Private Function CreateCommand(ByVal connection As ADODB.connection, ByVal cmdType As ADODB.CommandTypeEnum, ByVal sql As String, parameterValues() As Variant) As ADODB.Command Dim cmd As ADODB.Command Set cmd = New ADODB.Command cmd.ActiveConnection = connection cmd.CommandType = cmdType cmd.CommandText = sql Dim i As Long Dim value As Variant For i = LBound(parameterValues) To UBound(parameterValues) value = parameterValues(i) If TypeName(value) <> "Variant()" Then cmd.parameters.Append ToSqlInputParameter(value) Next Set CreateCommand = cmd End Function Private Function ToSqlInputParameter(ByVal value As Variant) As ADODB.parameter If IsObject(value) Then Err.Raise vbObjectError + 911, "SqlCommand.ToSqlInputParameter", "Invalid argument, parameter value cannot be an object." Dim result As ADODB.parameter Set result = CallByName(converter, "To" & TypeName(value) & "Parameter", VbMethod, value, ADODB.ParameterDirectionEnum.adParamInput) Set ToSqlInputParameter = result End Function Private Function ExecuteInternal(ByVal connection As ADODB.connection, ByVal sql As String, parameterValues()) As ADODB.Recordset Dim cmd As ADODB.Command Set cmd = CreateCommand(connection, adCmdText, sql, parameterValues) Set ExecuteInternal = cmd.Execute End Function Private Function ExecuteNonQueryInternal(ByVal connection As ADODB.connection, ByVal sql As String, parameterValues()) As Boolean Dim cmd As ADODB.Command Set cmd = CreateCommand(connection, adCmdText, sql, parameterValues) Dim result As Boolean On Error Resume Next cmd.Execute result = (Err.Number = 0) On Error GoTo 0 ExecuteNonQueryInternal = result End Function Private Function ExecuteStoredProcInternal(ByVal connection As ADODB.connection, ByVal spName As String, parameterValues()) As ADODB.Recordset Dim cmd As ADODB.Command Set cmd = CreateCommand(connection, adCmdStoredProc, spName, parameterValues) Set ExecuteStoredProcInternal = cmd.Execute End Function Private Function SelectSingleValueInternal(ByVal connection As ADODB.connection, ByVal sql As String, parameterValues()) As Variant Dim parameters() As Variant parameters = parameterValues Dim cmd As ADODB.Command Set cmd = CreateCommand(connection, adCmdText, sql, parameters) 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 SelectSingleValueInternal = result End Function |
The magic happens in ToSqlInputParameter
:
1 2 3 4 5 6 7 8 9 10 |
Private Function ToSqlInputParameter(ByVal value As Variant) As ADODB.parameter If IsObject(value) Then Err.Raise vbObjectError + 911, "SqlCommand.ToSqlInputParameter", "Invalid argument, parameter value cannot be an object." Dim result As ADODB.parameter Set result = CallByName(converter, "To" & TypeName(value) & "Parameter", VbMethod, value, ADODB.ParameterDirectionEnum.adParamInput) Set ToSqlInputParameter = result End Function |
Using CallByName
against the converter, we invoke the appropriate
To[TypeName]Parameter
and receive an ADODB parameter that's ready to use with an ADODB command - and the command itself is automatically created & wired-up too.
All public methods require an ADODB connection, so you can initiate a transaction and run multiple commands before you commit. The parameters are received with a ParamArray
argument, so the usage would look like this:
1 2 3 4 5 6 7 8 9 10 11 |
Const sql As String = "SELECT Value FROM SomeTable WHERE Foo = ? AND Bar = ?" Dim conn As ADODB.Connection Set conn = New ADODB.Connection conn.ConnectionString = "{connection string}" conn.Open Dim rs As ADODB.Recordset With New SqlCommand Set rs = .Execute(sql, pKey, pIndex) End With '...iterate recordset... conn.Close |
You could then have additional methods that wire up the connection automatically, execute the query, iterate the recordset and return a dictionary of key-value pairs for each record (works great for small result sets), and then this eliminates the connection boilerplate, too, leaving the “client code” with nothing to worry about except passing the parameter values in the correct order, and working with the query results.
You’ll never need to worry about single quotes and SQL injection ever again… and the command & parameterization boilerplate is nicely tucked away in its own dedicated and reusable class.