Добавил (если не против конечно
методы toJsonString к обоим классам и в JSONObject скорректировал функцию AddItem:
Visual Basic:
// в класс JSONObject
Public Function toJsonString() As String
GoTo begin
errors:Error Err, Error & " |" & GetThreadInfo(1) & " in Line:" & Erl & "|"
begin:On Error GoTo errors
Dim k As Integer
Dim ret() As String
Dim tname$
If me.m_size=0 Then
toJsonString=|{}|
Else
ReDim ret(me.m_size-1) As String
ForAll m In m_items
tname=TypeName(m)
Select Case tName
Case "JSONARRAY", "JSONOBJECT"
ret(k)=|"|+ListTag(m)+|":|+m.toJsonString()
Case "STRING"
ret(k)=|"|+ListTag(m)+|":"|+JSON_EscapeString(m)+|"|
Case "DOUBLE","INTEGER"
ret(k)=|"|+ListTag(m)+|":|+CStr(m)
Case "NOTESDATETIME","DATE"
ret(k)=|"|+ListTag(m)+|":|+Format(m_items(k),DDS_JSON_DT_FORMAT)
Case "BOOLEAN"
If m=True Then ret(k)=|"|+ListTag(m)+|":true| Else ret(k)=|"|+ListTag(m)+|":false|
Case Else
Error 1001," Error type of object:" & tname
End Select
k=k+1
End ForAll
toJsonString="{"+Join(ret,",")+"}"
End If
End Function
// в класс JSONArray
Public Function toJsonString() As String
GoTo begin
errors:Error Err, Error & " |" & GetThreadInfo(1) & " in Line:" & Erl & "|"
begin:On Error GoTo errors
Dim k As Integer
Dim ret() As String
Dim tname$
If me.m_size=0 Then
toJsonString=|[]|
Else
ReDim ret(me.m_size-1) As string
For k=0 To me.m_size-1
tname=TypeName(m_items(k))
Select Case tName
Case "JSONARRAY","JSONOBJECT"
ret(k)=m_items(k).toJsonString()
Case "STRING"
ret(k)=|"|+JSON_EscapeString(m_items(k))+|"|
Case "DOUBLE","INTEGER"
ret(k)=CStr(m_items(k))
Case "NOTESDATETIME","DATE"
ret(k)=Format(m_items(k),DDS_JSON_DT_FORMAT)
Case "BOOLEAN"
If m_items(k)=True Then ret(k)="true" Else m_items(k)="false"
Case Else
Error 1001," Error type of object"
End Select
Next
toJsonString="["+Join(ret,",")+"]"
End If
End Function
%REM
'' Изменен оригинальняй метод. Если itemName уже есть, то счетчик не увеличивать
%END REM
Public Sub AddItem(itemName As String, itemVal As Variant)
If Not me.HasItem(itemName) Then m_size = m_size + 1
If IsObject(itemVal) Then
Set Me.m_items(itemName) = itemVal
Else
Me.m_items(itemName) = itemVal
End If
End Sub
%REM
Function JSON_EscapeString
Description: Общая ф-ция для экранирования в JSON
%END REM
Private Function JSON_EscapeString(jsonstr)
GoTo begin
errors:Error Err, Error & " |" & GetThreadInfo(1) & " in Line:" & Erl & "|"
begin:On Error GoTo errors
jsonstr=Replace(jsonstr,"\","\\")
jsonstr=Replace(jsonstr,{"},{\"})
jsonstr=Replace(jsonstr,Chr(1),{\u0001})
jsonstr=Replace(jsonstr,Chr(2),{\u0002})
jsonstr=Replace(jsonstr,Chr(8),{\b})
jsonstr=Replace(jsonstr,Chr(9),{\t})
jsonstr=Replace(jsonstr,Chr(13),{\r})
jsonstr=Replace(jsonstr,Chr(10),{\n})
jsonstr=Replace(jsonstr,Chr(12),{\f})
jsonstr=Replace(jsonstr,Chr(19),{})
JSON_EscapeString=Replace(jsonstr,Chr(26),{\u001a})
End Function
