来源：经典 ASP 社区常用 JSON 解析库，适配 IIS + ASP，兼容 ip9 接口返回的 JSON 格式，可直接解析{"ret":200,"data":{...}}结构 

保存为 JSON.asp 文件，用<!--#include file="JSON.asp" -->引入

<%
' JSON.asp - Classic ASP JSON Parser (VBScript)
' 支持：解析JSON字符串转ASP对象(字典+数组)，仅用于经典ASP
Class JSON
    Private m_str
    Private m_pos
    Private m_len
    
    Public Function Parse(strJSON)
        m_str = strJSON
        m_pos = 1
        m_len = Len(m_str)
        Set Parse = ParseValue
    End Function
    
    Private Function Peek()
        If m_pos <= m_len Then Peek = Mid(m_str, m_pos, 1) Else Peek = ""
    End Function
    
    Private Function NextCh()
        Dim c
        c = Peek()
        If m_pos <= m_len Then m_pos = m_pos + 1
        NextCh = c
    End Function
    
    Private Sub SkipWhitespace()
        Dim c
        Do While m_pos <= m_len
            c = Peek()
            If c = " " Or c = vbCr Or c = vbLf Or c = vbTab Then
                Call NextCh()
            Else
                Exit Do
            End If
        Loop
    End Sub
    
    Private Function ParseValue()
        Call SkipWhitespace()
        Dim c
        c = Peek()
        Select Case c
            Case "{"
                Call NextCh()
                Set ParseValue = ParseObject()
            Case "["
                Call NextCh()
                Set ParseValue = ParseArray()
            Case """", "'"
                ParseValue = ParseString()
            Case "-", "0","1","2","3","4","5","6","7","8","9"
                ParseValue = ParseNumber()
            Case "t"
                Call MatchToken("true")
                ParseValue = True
            Case "f"
                Call MatchToken("false")
                ParseValue = False
            Case "n"
                Call MatchToken("null")
                ParseValue = Null
            Case Else
                Err.Raise 1000, "JSON", "Unexpected char: " & c
        End Select
    End Function
    
    Private Function ParseObject()
        Dim obj, key, val, c
        Set obj = Server.CreateObject("Scripting.Dictionary")
        Call SkipWhitespace()
        Do While True
            c = Peek()
            If c = "}" Then
                Call NextCh()
                Exit Do
            End If
            Call SkipWhitespace()
            key = ParseString()
            Call SkipWhitespace()
            If Peek() <> ":" Then Err.Raise 1000, "JSON", "Expected colon"
            Call NextCh()
            Call SkipWhitespace()
            Set val = ParseValue()
            obj(key) = val
            Call SkipWhitespace()
            c = Peek()
            If c = "," Then
                Call NextCh()
            ElseIf c = "}" Then
            Else
                Err.Raise 1000, "JSON", "Expected comma or }"
            End If
        Loop
        Set ParseObject = obj
    End Function
    
    Private Function ParseArray()
        Dim arr, val, c
        Set arr = Server.CreateObject("Scripting.Dictionary")
        Dim idx : idx = 0
        Call SkipWhitespace()
        Do While True
            c = Peek()
            If c = "]" Then
                Call NextCh()
                Exit Do
            End If
            Call SkipWhitespace()
            Set val = ParseValue()
            arr(CStr(idx)) = val
            idx = idx + 1
            Call SkipWhitespace()
            c = Peek()
            If c = "," Then
                Call NextCh()
            ElseIf c = "]" Then
            Else
                Err.Raise 1000, "JSON", "Expected comma or ]"
            End If
        Loop
        Set ParseArray = arr
    End Function
    
    Private Function ParseString()
        Dim quote, s, c, esc
        quote = NextCh()
        s = ""
        Do While m_pos <= m_len
            c = NextCh()
            If c = quote Then
                Exit Do
            ElseIf c = "\" Then
                esc = NextCh()
                Select Case esc
                    Case """", "\", "/" : s = s & esc
                    Case "b" : s = s & Chr(8)
                    Case "f" : s = s & Chr(12)
                    Case "n" : s = s & vbLf
                    Case "r" : s = s & vbCr
                    Case "t" : s = s & vbTab
                    Case Else : s = s & esc
                End Select
            Else
                s = s & c
            End If
        Loop
        ParseString = s
    End Function
    
    Private Function ParseNumber()
        Dim s, c
        s = ""
        Do While m_pos <= m_len
            c = Peek()
            If InStr("-0123456789.eE", c) > 0 Then
                s = s & c
                Call NextCh()
            Else
                Exit Do
            End If
        Loop
        If InStr(s,".")>0 Or InStr(s,"e")>0 Or InStr(s,"E")>0 Then
            ParseNumber = CDbl(s)
        Else
            ParseNumber = CLng(s)
        End If
    End Function
    
    Private Sub MatchToken(token)
        Dim i, c
        For i = 1 To Len(token)
            c = NextCh()
            If c <> Mid(token,i,1) Then
                Err.Raise 1000, "JSON", "Token mismatch " & token
            End If
        Next
    End Sub
End Class
' 全局快捷函数，直接 JSON.parse("json文本")
Function JSON
    Set JSON = New JSON
End Function
%>

使用示例（结合前面 IP 归属地代码）

修改GetIpLocation函数，替换原来正则解析部分，使用 JSON.asp 解析：

<!--#include file="JSON.asp"-->
<%
Function GetIpLocation(ByVal ip)
    Dim objHttp, url, strJson, dic, jsonObj
    Set dic = Server.CreateObject("Scripting.Dictionary")
    dic("ret") = 0
    dic("ip") = ip
    dic("country") = ""
    dic("prov") = ""
    dic("city") = ""
    dic("area") = ""
    dic("isp") = ""
    
    If Trim(ip) = "" Then
        Set GetIpLocation = dic
        Exit Function
    End If
    
    url = "https://ip9.com.cn/get?ip=" & Server.URLEncode(ip)
    
    On Error Resume Next
    Set objHttp = Server.CreateObject("WinHttp.WinHttpRequest.5.1")
    If Err.Number<>0 Then
        Err.Clear
        Set objHttp = Server.CreateObject("MSXML2.XMLHTTP.6.0")
    End If
    On Error GoTo 0
    
    objHttp.SetTimeouts 5000,5000,5000,5000
    objHttp.Open "GET", url, False
    objHttp.Send
    
    If objHttp.Status = 200 Then
        strJson = objHttp.ResponseText
        Set jsonObj = JSON.parse(strJson)
        dic("ret") = jsonObj("ret")
        If jsonObj.Exists("data") Then
            Dim data
            Set data = jsonObj("data")
            dic("ip") = data("ip")
            dic("country") = data("country")
            dic("prov") = data("prov")
            dic("city") = data("city")
            dic("area") = data("area")
            dic("isp") = data("isp")
        End If
    End If
    
    Set objHttp = Nothing
    Set GetIpLocation = dic
End Function
%>

注意事项

1. 该解析库只做 JSON 读取，不支持复杂中文转码（ip9 接口返回 UTF8，经典 ASP 页面建议设置Session.CodePage=65001）
   

2. <%
   Session.CodePage=65001
   Response.Charset="UTF-8"
   %>
   

3. 数组在解析后也是 Dictionary，key 是数字字符串 "0","1"
4. 错误处理：接口返回异常 JSON 会抛出错误，建议外层加On Error Resume Next捕获