调用函数主要用这两个就行了，默认都是包了双引号的，如果数字不需要引号，可设置类中的quota=true

'将一个字典或数组打印为jsonstr
Function aspjsonPrint(objs)
    dim json:Set json = new aspjsonClass
    aspjsonPrint = json.print(objs)
    set json=nothing
End Function

'将一个jsonstr转换为字典对象
Function aspjsonParse(strng)
    dim json:Set json = new aspjsonClass
    if left(strng,1)="[" then
        aspjsonParse = json.parse(strng)
    ElseIf Left(strng,1)="{" Then
        set aspjsonParse = json.parse(strng)
    Else
        Set aspjsonparse = CreateObject("scripting.dictionary")
    end if
    set json=nothing
End Function

Function NewOption()
　　Dim oDic : Set oDic = CreateObject("scripting.dictionary")
　　Set NewOption = oDic
End Function




Class aspjsonClass
    Dim isencode
    Dim quota

    Private Sub Class_Initialize()
        quota = True
    End Sub

    Function parse(objs)
        Dim J,isrearr,retobj
        If TypeName(objs)="String" Then
            If Left(objs,1)="[" Then isrearr = "1":objs = "{""_vbarray_"":" & objs & "}"
            Set J = parsejson(objs)
        Else
            Set J = objs
        End If
        Set retobj = json_to_dict(J)
        If isrearr = "1" Then
            parse = retobj("_vbarray_")
        Else
            Set parse = retobj
        End If
    End Function

    Function parsejson(strjson)
        On Error Resume Next : Err.clear
        Dim obj:Set obj = CreateObject("MSScriptControl.ScriptControl")
        obj.Language = "JScript"
        obj.ExecuteStatement "var result=" & strjson & ";"
        Set parsejson = obj.CodeObject.result
        Set obj=Nothing
        If Err.number <> 0 Then Set parsejson=Nothing
    End Function

    Function print(objs)
        Dim result,line(),ix, oo,vbtp,jstp,vbtpid :ix=0 : oo=""""
        vbtpid = VarType(objs)
        If vbtpid=14 Then
            vbtp = "Numeric"
        Else
            vbtp = TypeName(objs)
        End If

        If vbtp = "JScriptTypeInfo" Then
            jstp = "object"
            If isJsArray(objs) Then jstp = "array"
        End If

        If vbtp="Nothing" Then
            result = oo & "Null" & oo
        ElseIf jstp = "object" Then
            result = print_json(objs)
        ElseIf vbtp="Dictionary" Then
            For Each strKey In objs.Keys
                redim preserve line(ix)
                line(ix) = oo & strKey & oo & ":" & print(objs(strKey)):ix=ix+1
            Next
            result = "{" & Join(line,",") & "}"
        ElseIf vbtp = "Variant()" Or jstp = "array" Then
            For Each strVal In objs
                redim preserve line(ix)
                line(ix) = print(strVal):ix=ix+1
            Next
            result = "[" & Join(line,",") & "]"
        ElseIf vbtp = "String" Or vbtp="Date" Then
            result = oo & encode(objs) & oo
        ElseIf quota=False And vbtp="Null" Then
            result = "null"
        ElseIf quota=False And inArray(Array("Boolean","Integer","Double","Float","Long","Single","Numeric","Currency"),vbtp ) Then
            If vbtp="Boolean" Then objs=LCase(objs)
            result = objs
        Else
            'If vbtp="Boolean" Then objs=LCase(objs)
            result = oo & objs  & oo              
        End If
        print = result
    End Function

    Private Function json_to_dict(jsjson) 'json对象转字典
        Dim str,obj : Set obj = CreateObject("MSScriptControl.ScriptControl")
        str = str & "function json_to_dict(J){"
        str = str & "var dic = new ActiveXObject('Scripting.Dictionary'),ipos = 0;"
        str = str & "if( Object.prototype.toString.call(J) === '[object Array]' ){"
        str = str & "   for(var cur in J){"
        str = str & "   if(typeof J[cur]=='object'){"
        str = str & "       dic.add(ipos,json_to_dict(J[cur]));"
        str = str & "   }else{"
        str = str & "       dic.add(ipos,J[cur]);"
        str = str & "   }ipos++}dic = dic.Items();"
        str = str & "}else{"
        str = str & "   for (var strkey in J){"
        str = str & "   if(J[strkey]===null){"
        str = str & "       dic.add(strkey, '')"
        str = str & "   }else if(typeof J[strkey]=='object'){"
        str = str & "       dic.add(strkey, json_to_dict(J[strkey]));"
        str = str & "   }else{"
        str = str & "       dic.add(strkey, J[strkey])"
        str = str & "   }}"
        str = str & "}return dic;}"
        obj.Language = "JScript"
        obj.AddCode str
        Set json_to_dict = obj.Run("json_to_dict", jsjson)
        Set obj=Nothing
    End Function

    Private Function isJsArray(objarr)
        On Error Resume Next
        Dim str,obj : Set obj = CreateObject("MSScriptControl.ScriptControl")
        str = str & "function isArray(obj){"
        str = str & "  return Object.prototype.toString.call(obj) === '[object Array]';"
        str = str & "}"   
        obj.Language = "JScript"
        obj.AddCode str
        isJsArray = obj.Run("isArray", objarr)
        Set obj=Nothing
    End Function

    Private Function print_json(jsjson)
        On Error Resume Next : Err.clear
        Dim str,obj : Set obj = CreateObject("MSScriptControl.ScriptControl")
        str = str & "function print_json(objs){"
        str = str & "   var line = [], oo='\""',result='';"
        str = str & "   if(!objs){"
        str = str & "       result = oo + 'Null' + oo;"
        str = str & "   }else if(Object.prototype.toString.call(objs) === '[object Array]'){"
        str = str & "         for (var i in objs) {"
        str = str & "             line.push( print_json( objs[i] ) );"
        str = str & "         }result = '[' + line.join(',') + ']';"
        str = str & "   }else if(typeof(objs)=='object'){"
        str = str & "       for (var obj in objs) {"
        str = str & "           line.push(oo + obj + oo + ':' + print_json( objs[obj] ));"
        str = str & "       }result = '{' + line.join(',') + '}';"
        str = str & "   }else{"
        str = str & "       result = oo + encode(objs) + oo;"
        str = str & "   }return result;"
        str = str & "}"
        str = str & "function encode(value){"
        str = str & "   value = value.replace(/\f/g,'\\f');"
        str = str & "   value = value.replace(/\n/g,'\\n');"
        str = str & "   value = value.replace(/\r/g,'\\r');"
        str = str & "   value = value.replace(/\t/g,'\\t');"
        str = str & "   value = value.replace(/\p/g,'\\p');"
        str = str & "   value = value.replace(/""/g,'\\""');"
        str = str & "   return value;"
        str = str & "}"
        obj.Language = "JScript"
        obj.AddCode str
        print_json = obj.Run("print_json", jsjson)
        Set obj=Nothing
    End Function

    Private Function encode(ByVal value)
        value = Trim(value & "")
        value = Replace(value, "\", "\\")
        value = Replace(value, """", "\""")
        value = Replace(value, Chr(8), "\b")
        value = Replace(value, Chr(12), "\f")
        value = Replace(value, Chr(10), "\n")
        value = Replace(value, Chr(13), "\r")
        encode = Replace(value, Chr(9), "\t")
    End Function
End Class