vb6 json解析器代码

以下是 VB6 中解析 JSON 字符串的示例代码：

Option Explicit

Private Type JsonElement
    Key As String
    Value As Variant
End Type

Private Function ParseJson(ByVal json As String) As Collection
    Dim elements As New Collection
    Dim jsonLen As Long
    Dim i As Long
    
    jsonLen = Len(json)
    i = 1
    
    Do While i <= jsonLen
        Dim c As String
        c = Mid(json, i, 1)
        
        If c = "{" Then ' Object
            Dim obj As New Collection
            i = ParseObject(json, i + 1, obj)
            elements.Add obj
        
        ElseIf c = "[" Then ' Array
            Dim arr As New Collection
            i = ParseArray(json, i + 1, arr)
            elements.Add arr
        
        ElseIf c = """" Then ' String
            Dim value As String
            i = ParseString(json, i + 1, value)
            elements.Add value
        
        ElseIf c Like "[0-9-]" Then ' Number
            Dim value As Variant
            i = ParseNumber(json, i, value)
            elements.Add value
        
        ElseIf c = "t" Or c = "f" Then ' Boolean
            Dim value As Variant
            i = ParseBoolean(json, i, value)
            elements.Add value
        
        ElseIf c = "n" Then ' Null
            Dim value As Variant
            i = ParseNull(json, i, value)
            elements.Add value
        End If
        
        i = i + 1
    Loop
    
    Set ParseJson = elements
End Function

Private Function ParseObject(ByVal json As String, ByVal startIndex As Long, ByRef obj As Collection) As Long
    Dim jsonLen As Long
    Dim i As Long
    
    jsonLen = Len(json)
    i = startIndex
    
    Do While i <= jsonLen
        Dim c As String
        c = Mid(json, i, 1)
        If c = "}" Then ' End of object
            Exit Do
        
        If c = """" Then ' Key
            Dim key As String
            i = ParseString(json, i + 1, key)
            i = SkipWhitespace(json, i)
            If Mid(json, i, 1) <> ":" Then
                Err.Raise 1001, , "Invalid JSON format: expected colon after object key"
            End If
            i = SkipWhitespace(json, i + 1)
            
            Dim value As Variant
            If Mid(json, i, 1) = "{" Then ' Object
                Dim childObj As New Collection
                i = ParseObject(json, i + 1, childObj)
                value = childObj
            
            ElseIf Mid(json, i, 1) = "[" Then ' Array
                Dim arr As New Collection
                i = ParseArray(json, i + 1, arr)
                value = arr
            
            ElseIf Mid(json, i, 1) = """" Then ' String
                i = ParseString(json, i + 1, value)
            
            ElseIf Mid(json, i, 1) Like "[0-9-]" Then ' Number
                i = ParseNumber(json, i, value)
            
            ElseIf Mid(json, i, 1) = "t" Or Mid(json, i, 1) = "f" Then ' Boolean
                i = ParseBoolean(json, i, value)
            
            ElseIf Mid(json, i, 1) = "n" Then ' Null
                i = ParseNull(json, i, value)
            End If
            
            obj.Add value, key
        End If
        
        i = i + 1
    Loop
    
    ParseObject = i
End Function

Private Function ParseArray(ByVal json As String, ByVal startIndex As Long, ByRef arr As Collection) As Long
    Dim jsonLen As Long
    Dim i As Long
    
    jsonLen = Len(json)
    i = startIndex
    
    Do While i <= jsonLen
        Dim c As String
        c = Mid(json, i, 1)
        If c = "]" Then ' End of array
            Exit Do
        
        Dim value As Variant
        If c = "{" Then ' Object
            Dim childObj As New Collection
            i = ParseObject(json, i + 1, childObj)
            value = childObj
        
        ElseIf c = "[" Then ' Array
            Dim childArr As New Collection
            i = ParseArray(json, i + 1, childArr)
            value = childArr
        
        ElseIf c = """" Then ' String
            i = ParseString(json, i + 1, value)
        
        ElseIf c Like "[0-9-]" Then ' Number
            i = ParseNumber(json, i, value)
        
        ElseIf c = "t" Or c = "f" Then ' Boolean
            i = ParseBoolean(json, i, value)
        
        ElseIf c = "n" Then ' Null
            i = ParseNull(json, i, value)
        End If
        
        arr.Add value
        i = SkipWhitespace(json, i)
        If Mid(json, i, 1) = "," Then
            i = i + 1
        ElseIf Mid(json, i, 1) <> "]" Then
            Err.Raise 1002, , "Invalid JSON format: expected comma or end of array"
        End If
    Loop
    
    ParseArray = i
End Function

Private Function ParseString(ByVal json As String, ByVal startIndex As Long, ByRef value As String) As Long
    Dim jsonLen As Long
    Dim i As Long
    
    jsonLen = Len(json)
    i = startIndex
    
    Do While i <= jsonLen
        Dim c As String
        c = Mid(json, i, 1)
        
        If c = """" Then ' End of string
            Exit Do
        
        If c = "\" Then ' Escape sequence
            Dim nextChar As String
            nextChar = Mid(json, i + 1, 1)
            If nextChar = """" Then
                value = value & """"
                i = i + 1
            ElseIf nextChar = "\" Then
                value = value & "\"
                i = i + 1
            ElseIf nextChar = "/" Then
                value = value & "/"
                i = i + 1
            ElseIf nextChar = "b" Then
                value = value & vbBack
                i = i + 1
            ElseIf nextChar = "f" Then
                value = value & vbFormFeed
                i = i + 1
            ElseIf nextChar = "n" Then
                value = value & vbNewLine
                i = i + 1
            ElseIf nextChar = "r" Then
                value = value & vbCr
                i = i + 1
            ElseIf nextChar = "t" Then
                value = value & vbTab
                i = i + 1
            ElseIf nextChar = "u" Then
                Dim hexCode As String
                hexCode = Mid(json, i + 2, 4)
                value = value & ChrW("&H" & hexCode)
                i = i + 5
            Else
                Err.Raise 1003, , "Invalid JSON format: unknown escape sequence"
            End If
        Else
            value = value & c
        End If
        
        i = i + 1
    Loop
    
    ParseString = i
End Function

Private Function ParseNumber(ByVal json As String, ByVal startIndex As Long, ByRef value As Variant) As Long
    Dim jsonLen As Long
    Dim i As Long
    
    jsonLen = Len(json)
    i = startIndex
    
    Do While i <= jsonLen
        Dim c As String
        c = Mid(json, i, 1)
        
        If c Like "[0-9-+eE.]" Then
            value = value & c
        ElseIf c Like "[ },\]]" Then ' End of number
            Exit Do
        Else
            Err.Raise 1004, , "Invalid JSON format: unexpected character in number"
        End If
        
        i = i + 1
    Loop
    
    value = CDbl(value)
    ParseNumber = i - 1
End Function

Private Function ParseBoolean(ByVal json As String, ByVal startIndex As Long, ByRef value As Variant) As Long
    Dim jsonLen As Long
    Dim i As Long
    
    jsonLen = Len(json)
    i = startIndex
    
    If Mid(json, i, 4) = "true" Then
        value = True
        ParseBoolean = i + 3
    ElseIf Mid(json, i, 5) = "false" Then
        value = False
        ParseBoolean = i + 4
    Else
        Err.Raise 1005, , "Invalid JSON format: expected boolean"
    End If
End Function

Private Function ParseNull(ByVal json As String, ByVal startIndex As Long, ByRef value As Variant) As Long
    Dim jsonLen As Long
    Dim i As Long
    
    jsonLen = Len(json)
    i = startIndex
    
    If Mid(json, i, 4) = "null" Then
        value = Null
        ParseNull = i + 3
    Else
        Err.Raise 1006, , "Invalid JSON format: expected null"
    End If
End Function

Private Function SkipWhitespace(ByVal json As String, ByVal startIndex As Long) As Long
    Dim jsonLen As Long
    Dim i As Long
    
    jsonLen = Len(json)
    i = startIndex
    
    Do While i <= jsonLen And Mid(json, i, 1) Like "[ 	]"
        i = i + 1
    Loop
    
    SkipWhitespace = i
End Function

使用示例：

Dim json As String
json = "{""name"":""John"",""age"":30,""city"":""New York"",""pets"":[""dog"",""cat""]}"

Dim elements As Collection
Set elements = ParseJson(json)

Debug.Print elements("name") ' Output: John
Debug.Print elements("age") ' Output: 30
Debug.Print elements("city") ' Output: New York
Debug.Print elements("pets")(1) ' Output: cat