Open jinex91 opened 2 months ago
json_Encode
gets called for every character of a string (including keys). So a long list of character translations is going to give a performance hit. You could have avoided this by using a range test and moving the translations to a function:
Case 1025 To 1105
json_Char = Cyrillic(json_AscCode)
Case …
However, you missed thatjson_Char
is already the character that you need:
Case 1025 To 1105
Case …
But this is a long-standing issue - see issues #238 and #37 and pull request https://github.com/VBA-tools/VBA-JSON/pull/168.
============= if the above solves your problem, please close your issue here.
Correction 1:json_Encode
is not currently called for keys. It clearly should be and pull request #122 covers that.
Correction 2:json_Encode
is not called for every string character. It is the loop inside which goes one by one.
My comment about a long list of Cases can also be applied to the current code. Several optimisations are possible.
If implemented on top of pull request #168, the function becomes:
Private Function json_Encode(ByRef json_Text As Variant) As String
' Reference: http://www.ietf.org/rfc/rfc4627.txt
' Escape: ", \, /, backspace, form feed, line feed, carriage return, tab
Dim json_Index As Long
Dim json_Char As String
Dim json_AscCode As Long
Dim json_Buffer As String
Dim json_BufferPosition As Long
Dim json_BufferLength As Long
Dim json_CodeLimit As Long
Dim json_Escapes As String
Const HasNonASCgraphic As String = "*[! -~]*"
' Control escaping
' backspace -> 8 -> \b
' tab -> 9 -> \t
' line feed -> 10 -> \n
' (vert tab -> 11 -> \v - not in standard)
' form feed -> 12 -> \f
' carriage return -> 13 -> \r
' DEL and C1 controls (rarely used) are treated like other high Unicode characters
Const ControlXlate = "btnvfr"
' Check if any encoding needed
json_Escapes = """\" & IIf(JsonOptions.EscapeSolidus, "/", vbNullString)
If Not (json_Text Like HasNonASCgraphic Or json_Text Like "*[" & json_Escapes & "]*") Then
json_Encode = json_Text
Exit Function
End If
' We have to scan the text and encode (expand) one or more characters.
' We already know the minimum size of the buffer required.
' Guess that the expansion will be less than 20 characters.
' Pre-allocate the buffer.
json_BufferLength = VBA.Len(json_Text) + 20
json_Buffer = VBA.Space$(json_BufferLength)
json_CodeLimit = IIf(JsonOptions.AllowUnicodeChars, 65535, 126)
For json_Index = 1 To VBA.Len(json_Text)
json_Char = VBA.Mid$(json_Text, json_Index, 1)
json_AscCode = VBA.AscW(json_Char)
' When AscW returns a negative number, it returns the twos complement form of that number.
' To convert the twos complement notation into normal binary notation, add 0xFFF to the return result.
' https://support.microsoft.com/en-us/kb/272138
If json_AscCode < 0 Then
json_AscCode = json_AscCode + 65536
End If
' From spec, ", \, and control characters must be escaped (solidus is optional)
Select Case json_AscCode
' No special action for UTF-16 surrogate pairs (&HDB00 To &HDFFF)
Case 32 To json_CodeLimit
If VBA.InStr(json_Escapes, json_Char) <> 0 Then json_Char = "\" & json_Char
Case 8 To 10, 12 To 13
json_Char = "\" & VBA.Mid$(ControlXlate, json_AscCode - 7, 1)
Case Else
' Non-ascii characters etc -> convert to 4-digit hex
json_Char = "\u" & VBA.Right$("0000" & VBA.Hex$(json_AscCode), 4)
End Select
json_BufferAppend json_Buffer, json_Char, json_BufferPosition, json_BufferLength
Next json_Index
json_Encode = json_BufferToString(json_Buffer, json_BufferPosition)
End Function
Private Function json_Encode(ByVal json_Text As Variant) As String ' Reference: http://www.ietf.org/rfc/rfc4627.txt ' Escape: ", \, /, backspace, form feed, line feed, carriage return, tab Dim json_Index As Long Dim json_Char As String Dim json_AscCode As Long Dim json_Buffer As String Dim json_BufferPosition As Long Dim json_BufferLength As Long
End Function