从 JSON 字符串中提取键/值对并在值中保留特殊字符

Question

我有一个包含各种 JSON 数组的 Html 页面。我正在使用 HTML Agility Pack 从页面中获取 innerText，它隔离了页面中的一些剩余文本和 JSON 数组（页面中有许多复杂的对象）。然后我将文本传递给正则表达式，如下所示，它解析键/值对；但是它停在撇号处；但是我需要它并希望保留特殊字符以支持其他功能。

我从互联网上获取 RegEx，我确信它需要调整以允许特殊字符。我尝试了各种方法；但不是正则表达式的专家，我无法提出解决方案。有人对如何修复 RegEx 有一些建议吗？

Dim some_json As String = """{""request"":""Over the last 25 years, I've worked with most of the world’s leading selling strategy systems and built sales training used by companies on six continents. Two years ago, I teamed up with other sales strategy experts to merge our combined experience, wisdom and knowledge into an artificial intelligence system. We worked with expert neuroscientists, behavioral economists, psychologists, and AI programmers to develop JOY, the world’s first emotionally intelligent and sales-savvy artificial intelligence system for sales.  Now I focus on helping companies implement JOY to instantly increase sales and dominate markets.  \n "",""status"":200}"""

        some_json = some_json.Replace("\n", " ")

        Dim r As Regex = New Regex("""(?<Key>[\w]*)"":""?(?<Value>([\s\w\d\.\\\-/:_\+]+(,[,\s\w\d\.\\\-/:_\+]*)?)*)""?")
        Dim mc As MatchCollection = r.Matches(some_json)

        'regex returns summary: Over the last 25 years, I
        'how do I return the entire value with the apostrophe's, special characters?

        For Each k As Match In mc
            Try
                If (k.Groups("Value").Value.Length > 0 And k.Groups("Key").Value = "request") Then
                    m = m & k.Groups("Key").Value & ":" & k.Groups("Value").Value.ToString & "<br/><br/>"
                End If

            Catch ex As Exception
                Dim se As String = ex.Message
            End Try
        Next
        Response.Write(m)

Answer 1

通过丢弃 RegEx 并使用递归函数从任何深度的 json 中提取任何内容来解决它。它输出名称/值对。如果有一个深层对象，它会堆叠键名（例如 depth4.depth3.depth2），然后跟随值。所以一个简单的字符串比较键（组合），你可以拉出值。

Private Shared Function ParseJson(ByVal token As JToken, ByVal nodes As Dictionary(Of String, String), ByVal Optional parentLocation As String = "") As Boolean
    If token.HasValues Then

        For Each child As JToken In token.Children()

            If token.Type = JTokenType.[Property] Then

                If parentLocation = "" Then
                    parentLocation = (CType(token, JProperty)).Name
                Else
                    parentLocation += "." & (CType(token, JProperty)).Name
                End If
            End If

            ParseJson(child, nodes, parentLocation)
        Next

        Return True
    Else

        If nodes.ContainsKey(parentLocation) Then
            nodes(parentLocation) += "|" & token.ToString()
        Else
            nodes.Add(parentLocation, token.ToString())
        End If

        Return False
    End If
End Function

用法：

Private Sub Test_Load(sender As Object, e As EventArgs) Handles Me.Load

    Dim ServerPath As String = HttpRuntime.AppDomainAppPath
    Dim left_overs As String = String.Empty

    'download web page
    Dim html = New HtmlDocument()
    html.LoadHtml(New WebClient().DownloadString(ServerPath & "files/somefile.htm"))

    Dim txt As String = html.DocumentNode.InnerText, m As String = String.Empty

    Try
        Dim ndes As Array = html.DocumentNode.SelectNodes("//cde").ToArray
        For Each item As HtmlNode In ndes

            Dim s As String = item.InnerText.Trim
            'Response.Write(s)
            Try

                Dim nodes As Dictionary(Of String, String) = New Dictionary(Of String, String)()
                Dim rootObject As JObject = JObject.Parse(s)
                ParseJson(rootObject, nodes)

                For Each key As String In nodes.Keys
                    If key = "included.summary" Then

                        left_overs = AlphaNumericOnly(nodes(key))
                        m = m & key & " = " & left_overs & "<br/><br/>"
                        Response.Write(m)
                    End If
                Next

            Catch ex As Exception
                Dim err As String = ex.Message
            End Try

        Next
    Catch ex As Exception
    End Try

End Sub

还有一点清理功能。

Public Shared Function AlphaNumericOnly(strSource As String) As String
    Dim i As Integer
    Dim strResult As String = String.Empty

    For i = 1 To Len(strSource)
        Select Case Asc(Mid(strSource, i, 1))
            Case 32 To 91, 93 To 126 'include 32 if you want to include space
                strResult = strResult & Mid(strSource, i, 1)
        End Select
    Next
    AlphaNumericOnly = strResult
End Function