VB6.0 Dictionary转Json高效处理方式

Option Explicit

Private Sub Form_Load()
Dim lastStr As String
    Dim arr(2) As Dictionary, resStr As String
    
    
    Dim dictA As New Dictionary, dictB As New Dictionary
    dictA.Add "A1", "呵呵"
    dictB.Add "A2", "哈哈"
    
    Set arr(0) = dictA
    Set arr(1) = dictB

   Dim dict As New Dictionary
'    Dim dict1 As New Dictionary
'    dict1.Add "uniqueCode", "E211610003001001"
'    dict1.Add "jfCode", "0103027601"
'
'    dict.Add "patientId", 1027
'    dict.Add "list", dict1

    dict.Add "array", arr
    lastStr = GetJsonByDictionary(dict)

End Sub

Public Function GetJsonByDictionary(ByVal dict As Dictionary) As String
'==================================================================================================
'=功能：将Dict转为String
'=入参：
'=  dict 字典
'= 出参：Json换行字符串
'-------------------------
'作者: 王大聖
'时间: 2021-06-20
'==================================================================================================
'demo
'    Dim arr(1 To 2) As Dictionary, arr1(1 To 1) As Dictionary, jsonStr As String
'
'    Dim dict As New Dictionary, dict1 As New Dictionary, dict2 As New Dictionary, dict3 As New Dictionary
'    dict3.Add "uniqueCode", "E3"
'    dict3.Add "jfCode", "j3"
'    dict3.Add "patientId", 13
'    Set arr1(1) = dict3
'
'    dict1.Add "uniqueCode", "E211610003001001"
'    dict1.Add "jfCode", "0103027601"
'    dict1.Add "patientId", 1021
'
'    dict2.Add "uniqueCode", "E211610003001002"
'    dict2.Add "jfCode", "0103027602"
'    dict2.Add "patientId", arr1
'
'    Set arr(1) = dict1
'    Set arr(2) = dict2
'
'    dict.Add "name", "测试"
'    dict.Add "author", "WSF"
'    dict.Add "array", arr
'    jsonStr = GetJsonByDictionary(dict)
On Error GoTo ErrH
    Dim tmpStr As String: tmpStr = "{"
    Dim vKey As Variant
    Dim YH As String, MH As String, DH As String
    Dim tmpArrayStr  As String
    Dim i As Integer
    
    MH = Chr(58)
    YH = Chr(34)
    DH = Chr(44)

    For Each vKey In dict
        If TypeName(dict.Item(vKey)) = "Dictionary" Then
            tmpStr = tmpStr & YH & vKey & YH & MH & GetJsonByDictionary(dict.Item(vKey)) & DH
            
        ElseIf IsArray(dict.Item(vKey)) Or TypeName(dict.Item(vKey)) = "Object()" Then '字典里面放数组
            tmpArrayStr = "["
             
            For i = LBound(dict.Item(vKey)) To UBound(dict.Item(vKey)) Step 1 '数组里面放字典
                If TypeName(dict.Item(vKey)) = "Dictionary" Or TypeName(dict.Item(vKey)) = "Object()" Then
                     tmpArrayStr = tmpArrayStr & GetJsonByDictionary(dict.Item(vKey)(i)) & DH
                Else
                    tmpArrayStr = tmpArrayStr & YH & Nvl(dict.Item(vKey)(i), "") & YH & DH
                End If
                
            Next i
            
            '取消最后的,号
            If Right(tmpArrayStr, 1) = DH Then
                tmpArrayStr = Left(tmpArrayStr, Len(tmpArrayStr) - 1)
            End If
            tmpArrayStr = tmpArrayStr & "]"
            
            '数组数据串串
            tmpStr = tmpStr & YH & vKey & YH & MH & tmpArrayStr & DH
        Else
            tmpStr = tmpStr & YH & vKey & YH & MH & YH & dict.Item(vKey) & YH & DH
        End If
         
    Next
    
    '取消最后一个逗号
    If Right(tmpStr, 1) = DH Then
        tmpStr = Left(tmpStr, Len(tmpStr) - 1)
    End If
    
    GetJsonByDictionary = tmpStr & "}"
    'Debug.Print GetJsonByDictionary
    Exit Function
ErrH:
    Err.Clear
    GetJsonByDictionary = ""
End Function

Public Function Nvl(ByVal varValue As Variant, Optional DefaultValue As Variant = "") As Variant
'功能：相当于Oracle的NVL，将Null值改成另外一个预设值
    Nvl = IIf(IsNull(varValue), DefaultValue, varValue)
End Function