From 64ebf002574d1a0aef5341e33263e81bc0bd336a Mon Sep 17 00:00:00 2001 From: A9G-Data-Droid Date: Mon, 1 Jun 2020 12:10:48 -0700 Subject: [PATCH] Close RubberDuck Issues Replace generic functions with typed functions `$ for String` Use VBNullString instead of "" json_ParseErrorMessage returns a string Pass parameters ByVal unless assigned a value ByRef Always use Long instead of Integer. This prevents overflows on 64-bit systems and is better handled by modern CPUs. --- JsonConverter.bas | 83 ++++++++++++++++++++++++----------------------- 1 file changed, 43 insertions(+), 40 deletions(-) diff --git a/JsonConverter.bas b/JsonConverter.bas index 876b865..3783f7c 100644 --- a/JsonConverter.bas +++ b/JsonConverter.bas @@ -117,22 +117,22 @@ End Type #Else Private Type utc_SYSTEMTIME - utc_wYear As Integer - utc_wMonth As Integer - utc_wDayOfWeek As Integer - utc_wDay As Integer - utc_wHour As Integer - utc_wMinute As Integer - utc_wSecond As Integer - utc_wMilliseconds As Integer + utc_wYear As Long + utc_wMonth As Long + utc_wDayOfWeek As Long + utc_wDay As Long + utc_wHour As Long + utc_wMinute As Long + utc_wSecond As Long + utc_wMilliseconds As Long End Type Private Type utc_TIME_ZONE_INFORMATION utc_Bias As Long - utc_StandardName(0 To 31) As Integer + utc_StandardName(0 To 31) As Long utc_StandardDate As utc_SYSTEMTIME utc_StandardBias As Long - utc_DaylightName(0 To 31) As Integer + utc_DaylightName(0 To 31) As Long utc_DaylightDate As utc_SYSTEMTIME utc_DaylightBias As Long End Type @@ -174,14 +174,15 @@ Public Function ParseJson(ByVal JsonString As String) As Object json_Index = 1 ' Remove vbCr, vbLf, and vbTab from json_String - JsonString = VBA.Replace(VBA.Replace(VBA.Replace(JsonString, VBA.vbCr, ""), VBA.vbLf, ""), VBA.vbTab, "") - - json_SkipSpaces JsonString, json_Index - Select Case VBA.Mid$(JsonString, json_Index, 1) + Dim cleanString As String + cleanString = VBA.Replace(VBA.Replace(VBA.Replace(JsonString, VBA.vbCr, vbNullString), VBA.vbLf, vbNullString), VBA.vbTab, vbNullString) + + json_SkipSpaces cleanString, json_Index + Select Case VBA.Mid$(cleanString, json_Index, 1) Case "{" - Set ParseJson = json_ParseObject(JsonString, json_Index) + Set ParseJson = json_ParseObject(cleanString, json_Index) Case "[" - Set ParseJson = json_ParseArray(JsonString, json_Index) + Set ParseJson = json_ParseArray(cleanString, json_Index) Case Else ' Error: Invalid JSON string Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(JsonString, json_Index, "Expecting '{' or '['") @@ -293,7 +294,7 @@ Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitesp json_Converted = ConvertToJson(JsonValue(json_Index, json_Index2D), Whitespace, json_CurrentIndentation + 2) ' For Arrays/Collections, undefined (Empty/Nothing) is treated as null - If json_Converted = "" Then + If json_Converted = vbNullString Then ' (nest to only check if converted = "") If json_IsUndefined(JsonValue(json_Index, json_Index2D)) Then json_Converted = "null" @@ -318,7 +319,7 @@ Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitesp json_Converted = ConvertToJson(JsonValue(json_Index), Whitespace, json_CurrentIndentation + 1) ' For Arrays/Collections, undefined (Empty/Nothing) is treated as null - If json_Converted = "" Then + If json_Converted = vbNullString Then ' (nest to only check if converted = "") If json_IsUndefined(JsonValue(json_Index)) Then json_Converted = "null" @@ -366,7 +367,7 @@ Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitesp For Each json_Key In JsonValue.Keys ' For Objects, undefined (Empty/Nothing) is not added to object json_Converted = ConvertToJson(JsonValue(json_Key), Whitespace, json_CurrentIndentation + 1) - If json_Converted = "" Then + If json_Converted = vbNullString Then json_SkipItem = json_IsUndefined(JsonValue(json_Key)) Else json_SkipItem = False @@ -414,7 +415,7 @@ Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitesp json_Converted = ConvertToJson(json_Value, Whitespace, json_CurrentIndentation + 1) ' For Arrays/Collections, undefined (Empty/Nothing) is treated as null - If json_Converted = "" Then + If json_Converted = vbNullString Then ' (nest to only check if converted = "") If json_IsUndefined(json_Value) Then json_Converted = "null" @@ -458,7 +459,7 @@ End Function ' Private Functions ' ============================================= ' -Private Function json_ParseObject(json_String As String, ByRef json_Index As Long) As Dictionary +Private Function json_ParseObject(ByVal json_String As String, ByRef json_Index As Long) As Dictionary Dim json_Key As String Dim json_NextChar As String @@ -490,7 +491,7 @@ Private Function json_ParseObject(json_String As String, ByRef json_Index As Lon End If End Function -Private Function json_ParseArray(json_String As String, ByRef json_Index As Long) As Collection +Private Function json_ParseArray(ByVal json_String As String, ByRef json_Index As Long) As Collection Set json_ParseArray = New Collection json_SkipSpaces json_String, json_Index @@ -514,7 +515,7 @@ Private Function json_ParseArray(json_String As String, ByRef json_Index As Long End If End Function -Private Function json_ParseValue(json_String As String, ByRef json_Index As Long) As Variant +Private Function json_ParseValue(ByVal json_String As String, ByRef json_Index As Long) As Variant json_SkipSpaces json_String, json_Index Select Case VBA.Mid$(json_String, json_Index, 1) Case "{" @@ -541,7 +542,7 @@ Private Function json_ParseValue(json_String As String, ByRef json_Index As Long End Select End Function -Private Function json_ParseString(json_String As String, ByRef json_Index As Long) As String +Private Function json_ParseString(ByVal json_String As String, ByRef json_Index As Long) As String Dim json_Quote As String Dim json_Char As String Dim json_Code As String @@ -587,7 +588,7 @@ Private Function json_ParseString(json_String As String, ByRef json_Index As Lon ' Unicode character escape (e.g. \u00a9 = Copyright) json_Index = json_Index + 1 json_Code = VBA.Mid$(json_String, json_Index, 4) - json_BufferAppend json_Buffer, VBA.ChrW(VBA.Val("&h" + json_Code)), json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, VBA.ChrW$(VBA.Val("&h" + json_Code)), json_BufferPosition, json_BufferLength json_Index = json_Index + 4 End Select Case json_Quote @@ -601,7 +602,7 @@ Private Function json_ParseString(json_String As String, ByRef json_Index As Lon Loop End Function -Private Function json_ParseNumber(json_String As String, ByRef json_Index As Long) As Variant +Private Function json_ParseNumber(ByVal json_String As String, ByRef json_Index As Long) As Variant Dim json_Char As String Dim json_Value As String Dim json_IsLargeNumber As Boolean @@ -634,7 +635,7 @@ Private Function json_ParseNumber(json_String As String, ByRef json_Index As Lon Loop End Function -Private Function json_ParseKey(json_String As String, ByRef json_Index As Long) As String +Private Function json_ParseKey(ByVal json_String As String, ByRef json_Index As Long) As String ' Parse key with single or double quotes If VBA.Mid$(json_String, json_Index, 1) = """" Or VBA.Mid$(json_String, json_Index, 1) = "'" Then json_ParseKey = json_ParseString(json_String, json_Index) @@ -736,20 +737,21 @@ Private Function json_Encode(ByVal json_Text As Variant) As String json_Encode = json_BufferToString(json_Buffer, json_BufferPosition) End Function -Private Function json_Peek(json_String As String, ByVal json_Index As Long, Optional json_NumberOfCharacters As Long = 1) As String +Private Function json_Peek(ByVal json_String As String, ByVal json_Index As Long, Optional ByVal json_NumberOfCharacters As Long = 1) As String ' "Peek" at the next number of characters without incrementing json_Index (ByVal instead of ByRef) json_SkipSpaces json_String, json_Index json_Peek = VBA.Mid$(json_String, json_Index, json_NumberOfCharacters) End Function -Private Sub json_SkipSpaces(json_String As String, ByRef json_Index As Long) +' TODO: json_SkipSpaces should be written as a Function that returns the new Index +Private Sub json_SkipSpaces(ByVal json_String As String, ByRef json_Index As Long) ' Increment index to skip over spaces Do While json_Index > 0 And json_Index <= VBA.Len(json_String) And VBA.Mid$(json_String, json_Index, 1) = " " json_Index = json_Index + 1 Loop End Sub -Private Function json_StringIsLargeNumber(json_String As Variant) As Boolean +Private Function json_StringIsLargeNumber(ByVal json_String As Variant) As Boolean ' Check if the given string is considered a "large number" ' (See json_ParseNumber) @@ -777,7 +779,7 @@ Private Function json_StringIsLargeNumber(json_String As Variant) As Boolean End If End Function -Private Function json_ParseErrorMessage(json_String As String, ByRef json_Index As Long, ErrorMessage As String) +Private Function json_ParseErrorMessage(ByVal json_String As String, ByVal json_Index As Long, ByVal ErrorMessage As String) As String ' Provide detailed parse error message, including details of where and what occurred ' ' Example: @@ -890,7 +892,7 @@ End Function ' @return {Date} Local date ' @throws 10011 - UTC parsing error '' -Public Function ParseUtc(utc_UtcDate As Date) As Date +Public Function ParseUtc(ByVal utc_UtcDate As Date) As Date On Error GoTo utc_ErrorHandling #If Mac Then @@ -919,7 +921,7 @@ End Function ' @return {Date} UTC date ' @throws 10012 - UTC conversion error '' -Public Function ConvertToUtc(utc_LocalDate As Date) As Date +Public Function ConvertToUtc(ByVal utc_LocalDate As Date) As Date On Error GoTo utc_ErrorHandling #If Mac Then @@ -948,7 +950,7 @@ End Function ' @return {Date} Local date ' @throws 10013 - ISO 8601 parsing error '' -Public Function ParseIso(utc_IsoString As String) As Date +Public Function ParseIso(ByVal utc_IsoString As String) As Date On Error GoTo utc_ErrorHandling Dim utc_Parts() As String @@ -966,7 +968,7 @@ Public Function ParseIso(utc_IsoString As String) As Date If UBound(utc_Parts) > 0 Then If VBA.InStr(utc_Parts(1), "Z") Then - utc_TimeParts = VBA.Split(VBA.Replace(utc_Parts(1), "Z", ""), ":") + utc_TimeParts = VBA.Split(VBA.Replace(utc_Parts(1), "Z", vbNullString), ":") Else utc_OffsetIndex = VBA.InStr(1, utc_Parts(1), "+") If utc_OffsetIndex = 0 Then @@ -1026,7 +1028,7 @@ End Function ' @return {Date} ISO 8601 string ' @throws 10014 - ISO 8601 conversion error '' -Public Function ConvertToIso(utc_LocalDate As Date) As String +Public Function ConvertToIso(ByVal utc_LocalDate As Date) As String On Error GoTo utc_ErrorHandling ConvertToIso = VBA.Format$(ConvertToUtc(utc_LocalDate), "yyyy-mm-ddTHH:mm:ss.000Z") @@ -1043,7 +1045,7 @@ End Function #If Mac Then -Private Function utc_ConvertDate(utc_Value As Date, Optional utc_ConvertToUtc As Boolean = False) As Date +Private Function utc_ConvertDate(ByVal utc_Value As Date, Optional ByVal utc_ConvertToUtc As Boolean = False) As Date Dim utc_ShellCommand As String Dim utc_Result As utc_ShellResult Dim utc_Parts() As String @@ -1074,7 +1076,7 @@ Private Function utc_ConvertDate(utc_Value As Date, Optional utc_ConvertToUtc As End If End Function -Private Function utc_ExecuteInShell(utc_ShellCommand As String) As utc_ShellResult +Private Function utc_ExecuteInShell(ByVal utc_ShellCommand As String) As utc_ShellResult #If VBA7 Then Dim utc_File As LongPtr Dim utc_Read As LongPtr @@ -1105,7 +1107,7 @@ End Function #Else -Private Function utc_DateToSystemTime(utc_Value As Date) As utc_SYSTEMTIME +Private Function utc_DateToSystemTime(ByVal utc_Value As Date) As utc_SYSTEMTIME utc_DateToSystemTime.utc_wYear = VBA.Year(utc_Value) utc_DateToSystemTime.utc_wMonth = VBA.Month(utc_Value) utc_DateToSystemTime.utc_wDay = VBA.Day(utc_Value) @@ -1115,9 +1117,10 @@ Private Function utc_DateToSystemTime(utc_Value As Date) As utc_SYSTEMTIME utc_DateToSystemTime.utc_wMilliseconds = 0 End Function -Private Function utc_SystemTimeToDate(utc_Value As utc_SYSTEMTIME) As Date +Private Function utc_SystemTimeToDate(ByRef utc_Value As utc_SYSTEMTIME) As Date utc_SystemTimeToDate = DateSerial(utc_Value.utc_wYear, utc_Value.utc_wMonth, utc_Value.utc_wDay) + _ TimeSerial(utc_Value.utc_wHour, utc_Value.utc_wMinute, utc_Value.utc_wSecond) End Function #End If +