Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Close RubberDuck Issues #171

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Close RubberDuck Issues #171

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
83 changes: 43 additions & 40 deletions JsonConverter.bas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Comment on lines +120 to +135
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

These must stay as Integer types; changing them to Long will break them and they will not contain the correct data.

Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

https://docs.microsoft.com/en-us/windows/win32/api/minwinbase/ns-minwinbase-systemtime for reference; the Word type is two bytes wide, and will result in incorrect handling otherwise.

utc_DaylightDate As utc_SYSTEMTIME
utc_DaylightBias As Long
End Type
Expand Down Expand Up @@ -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 '['")
Expand Down Expand Up @@ -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"
Expand All @@ -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"
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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"
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand All @@ -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 "{"
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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)

Expand Down Expand Up @@ -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:
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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")
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand All @@ -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