65.9K
CodeProject 正在变化。 阅读更多。
Home

VB-JSON 解析器 - 性能改进

Sam Gerené
starIconstarIconstarIconstarIcon
emptyStarIcon
starIcon

4.61/5 (13投票s)

2014年2月3日

BSD

6分钟阅读

viewsIcon

138390

VB-JSON 解析器的性能提高了 2 倍。

引言

我在我的一个项目 (VB6/VBA) 中使用了 VB-JSON 解析器库来解析 JSON Web 服务的 JSON 响应。该 Web 服务返回的数据可能达到几十兆字节。VB-JSON 解析器可以完成它的工作，但对于这种消息来说会变得相当慢。是时候彻底检查代码并实施潜在的改进了。我不居功 VB-JSON 解析器库，那份出色的代码可以在这里找到，并以 BSD 许可证发布，而该许可证又基于这个项目，同样以 BSD 许可证发布。优化后的解析器只包含解析 JSON 的方法，不包含生成 JSON 的方法。如果需要，可以从原始项目中获取。

源代码在 GitHub 上维护。

背景

VB-JSON 解析器通过一个字符串来查找表示数组的特定标记（使用[ ]）、表示对象的特定标记（使用{ }）以及表示找到的对象的属性的键值对。这其中还有更多内容，如需更详细的解释，请访问 json.org。该页面还包含许多与 JSON 相关的软件列表。

一个表示Person的 JSON 对象的示例如下

{ "name" : "Billy Joe", "surname" : "Jim-Bob",
"email" : [ "billy@jim-bob.com", "billyjoe@jim-bob.com" ],
"age" : 42, "married" : true, weight : "150.63" }

想象一下您有大量这样的列表，并且知道 VB6/VBA 在处理字符串和进行字符串比较方面速度不是很快，那么解析 15 兆字节的人员数据可能会变得很慢……慢到 10 秒！但是，我们可以避免使用字符串和字符串比较。阅读了关于 VB6字符串处理的注意事项的页面后，我成功地将 VB-JSON 的性能提高了 2.5 到 3 倍。

在通过一些直接的改进实现了这一目标后，我想与 CodeProject 社区分享，以表明 VB6/VBA 和 JSON 即使对于大型字符串、文件和 Web 响应也能完美匹配。

我主要关注大型 JSON 字符串，尚未检查小型 JSON 字符串的性能，也许那里的性能比以前更差。我将其留给读者检查。

改进

在以下章节中，我将介绍一些我重构的函数和方法，以提高性能并阐明思想。bas 模块的源代码已包含在文章中。原始版本可从 VB-JSON 网站下载。

解析

解析器的入口方法如下

Public Function parse(ByRef str As String) As Object

   m_decSep = ModLocale.GetRegionalSettings(LOCALE_SDECIMAL)
   m_groupSep = ModLocale.GetRegionalSettings(LOCALE_SGROUPING)

   Dim index As Long
   index = 1
   psErrors = ""
   On Error Resume Next
   Call skipChar(str, index)
   Select Case Mid(str, index, 1)
      Case "{"
         Set parse = parseObject(str, index)
      Case "["
         Set parse = parseArray(str, index)
      Case Else
         psErrors = "Invalid JSON"
   End Select

End Function

parse函数接收一个（JSON）字符串作为输入，需要注意的是，这个字符串是ByRef传递的，而不是ByVal。ByVal传递字符串会创建一个字符串的副本，在这种情况下这是不需要的，因为字符串可能非常大。到目前为止一切都很好，没有什么可改变的，原始代码以我认为在这种特定情况下应该采用的方式处理了这一点。

第一个被调用的方法是 skipChar，它在字符串中向前移动索引，直到找到一个“有趣”的字符，即 JSON 指定的标记之一。在我介绍 skipChar 方法（这是调用次数最多的方法）之前，我将首先改进 parse 方法。诚然，这是一个小小的改进，但它符合我用于改进整个模块性能的模式。

我没有使用 VB6 的 Mid() 函数进行比较（该函数返回一个字符串），而是将整个输入字符串转换为一个整数数组，其中我存储了字符串中每个字符的 Unicode 值，并且我将这个数组用于几乎所有的解析。改进后的 parse 函数变为

Public Function parse(ByRef str As String) As Object

Dim index As Long
index = 1

Call GenerateStringArray(str)

psErrors = vbNullString
On Error Resume Next

Call skipChar(index)

Select Case m_str(index)
Case A_SQUARE_BRACKET_OPEN
    Set parse = parseArray(str, index)
Case A_CURLY_BRACKET_OPEN
    Set parse = parseObject(str, index)
Case Else
    psErrors = "Invalid JSON"
End Select

'clean array
Erase m_str

End Function

您会注意到，我有一个名为 GenerateStringArray 的额外方法，它将 JSON 字符串转换为一个名为 m_str 的整数数组。Select Case 在 m_str(index) 上操作，并且对于每个 Case 语句，都有一个常量定义，该常量是对应字符的 Unicode 值。模块顶部定义了以下常量

Private Const A_CURLY_BRACKET_OPEN As Integer = 123  ' AscW("{")
Private Const A_CURLY_BRACKET_CLOSE As Integer = 125 ' AscW("}")
Private Const A_SQUARE_BRACKET_OPEN As Integer = 91  ' AscW("[")
Private Const A_SQUARE_BRACKET_CLOSE As Integer = 93 ' AscW("]")
Private Const A_BRACKET_OPEN As Integer = 40         ' AscW("(")
Private Const A_BRACKET_CLOSE As Integer = 41        ' AscW(")")
Private Const A_COMMA As Integer = 44                ' AscW(",")
Private Const A_DOUBLE_QUOTE As Integer = 34         ' AscW("""")
Private Const A_SINGLE_QUOTE As Integer = 39         ' AscW("'")
Private Const A_BACKSLASH As Integer = 92            ' AscW("\")
Private Const A_FORWARDSLASH As Integer = 47         ' AscW("/")
Private Const A_COLON As Integer = 58                ' AscW(":")
Private Const A_SPACE As Integer = 32                ' AscW(" ")
Private Const A_ASTERIX As Integer = 42              ' AscW("*")
Private Const A_VBCR As Integer = 13                 ' AscW("vbcr")
Private Const A_VBLF As Integer = 10                 ' AscW("vblf")
Private Const A_VBTAB As Integer = 9                 ' AscW("vbTab")
Private Const A_VBCRLF As Integer = 13               ' AscW("vbcrlf")

Private Const A_b As Integer = 98                    ' AscW("b")
Private Const A_f As Integer = 102                   ' AscW("f")
Private Const A_n As Integer = 110                   ' AscW("n")
Private Const A_r As Integer = 114                   ' AscW("r"
Private Const A_t As Integer = 116                   ' AscW("t"))
Private Const A_u As Integer = 117                   ' AscW("u")

生成字符串数组

GenerateStringArray 方法将 JSON 字符串的长度存储在一个私有变量中，以供后续使用（而不是在每个方法中重新计算 JSON 字符串的长度），并将每个字符的 Unicode 值存储在 m_str 数组中。

Private Sub GenerateStringArray(ByRef str As String)

Dim i As Long

m_length = Len(str)
ReDim m_str(1 To m_length)

For i = 1 To m_length
    m_str(i) = AscW(Mid$(str, i, 1))
Next i

End Sub

skipChar

skipChar 方法是一个在 JSON 字符串中向前移动索引或光标的方法。以下是原始方法

Private Sub skipChar(ByRef str As String, ByRef index As Long)
   Dim bComment As Boolean
   Dim bStartComment As Boolean
   Dim bLongComment As Boolean
   Do While index > 0 And index <= Len(str)
      Select Case Mid(str, index, 1)
      Case vbCr, vbLf
         If Not bLongComment Then
            bStartComment = False
            bComment = False
         End If

      Case vbTab, " ", "(", ")"

      Case "/"
         If Not bLongComment Then
            If bStartComment Then
               bStartComment = False
               bComment = True
            Else
               bStartComment = True
               bComment = False
               bLongComment = False
            End If
         Else
            If bStartComment Then
               bLongComment = False
               bStartComment = False
               bComment = False
            End If
         End If

      Case "*"
         If bStartComment Then
            bStartComment = False
            bComment = True
            bLongComment = True
         Else
            bStartComment = True
         End If

      Case Else
         If Not bComment Then
            Exit Do
         End If
      End Select

      index = index + 1
   Loop

End Sub

它再次使用了字符串比较，我通过使用m_str数组、m_length变量和模块中声明的常量对其进行了改进。请注意，str不再作为参数传递给skipChar方法

Private Sub skipChar(ByRef index As Long)

Dim bComment As Boolean
Dim bStartComment As Boolean
Dim bLongComment As Boolean

Do While index > 0 And index <= m_length

    Select Case m_str(index)
    Case A_VBCR, A_VBLF
        If Not bLongComment Then
            bStartComment = False
            bComment = False
        End If

    Case A_VBTAB, A_SPACE, A_BRACKET_OPEN, A_BRACKET_CLOSE
        'do nothing

    Case A_FORWARDSLASH
        If Not bLongComment Then
            If bStartComment Then
                bStartComment = False
                bComment = True
            Else
                bStartComment = True
                bComment = False
                bLongComment = False
            End If
        Else
            If bStartComment Then
                bLongComment = False
                bStartComment = False
                bComment = False
            End If
        End If
    Case A_ASTERIX
        If bStartComment Then
            bStartComment = False
            bComment = True
            bLongComment = True
        Else
            bStartComment = True
        End If
    Case Else
        If Not bComment Then
            Exit Do
        End If
    End Select

    index = index + 1
Loop

End Sub

解析数字

原始的parseNumber方法对于小数分隔符是句号的区域设置工作良好，但对于小数分隔符是逗号的区域设置则不行。通过在区域设置中小数分隔符是逗号的情况下，将本地Value变量中的“.”替换为“,”来解决此问题。这些设置存储在两个变量中，名为m_decSep和m_groupSep，并在解析函数中设置。

parseNumber(ByRef str As String, ByRef index As Long)

Dim Value   As String
Dim Char    As String

Call skipChar(index)

Do While index > 0 And index <= m_length
    Char = Mid$(str, index, 1)
    If InStr("+-0123456789.eE", Char) Then
        Value = Value & Char
        index = index + 1
    Else
        'check what is the grouping seperator
        If Not m_decSep = "." Then
            Value = Replace(Value, ".", m_decSep)
        End If
     
        If m_groupSep = "." Then
            Value = Replace(Value, ".", m_decSep)
        End If
     
        parseNumber = CDec(Value)
        Exit Function
    End If
Loop

End Function

解析字符串

最后一个介绍的方法是 parseString 方法。在原始代码中，您可以看到正在使用在 vbaccelerator.com 上找到的 cStringBuilder 类。该类非常适合连接大型字符串。请记住，每次 VB6 连接两个字符串时，它都会创建一个新字符串，因此它并没有真正将第二个字符串附加到第一个字符串。cStringBuilder 类为此目的使用了 CopyMemory API 函数。我发现，在解析 JSON 字符串并创建字典和集合的情况下，使用 cStringBuilder 类意义不大。在解析过程中，需要多次连接字符串，而创建的字符串是字典的键和值，对于这种情况，使用它成本相当高。对于我的用例，这些字符串很小，特别是属性名，值可能更大，但绝不会达到 cStringBuilder 类会产生很大影响的程度。

Private Function parseString(ByRef str As String, ByRef index As Long) As String

   Dim quote   As String
   Dim Char    As String
   Dim Code    As String

   Dim SB As New cStringBuilder

   Call skipChar(str, index)
   quote = Mid(str, index, 1)
   index = index + 1

   Do While index > 0 And index <= Len(str)
      Char = Mid(str, index, 1)
      Select Case (Char)
         Case "\"
            index = index + 1
            Char = Mid(str, index, 1)
            Select Case (Char)
               Case """", "\", "/", "'"
                  SB.Append Char
                  index = index + 1
               Case "b"
                  SB.Append vbBack
                  index = index + 1
               Case "f"
                  SB.Append vbFormFeed
                  index = index + 1
               Case "n"
                  SB.Append vbLf
                  index = index + 1
               Case "r"
                  SB.Append vbCr
                  index = index + 1
               Case "t"
                  SB.Append vbTab
                  index = index + 1
               Case "u"
                  index = index + 1
                  Code = Mid(str, index, 4)
                  SB.Append ChrW(Val("&h" + Code))
                  index = index + 4
            End Select
         Case quote
            index = index + 1

            parseString = SB.ToString
            Set SB = Nothing

            Exit Function

         Case Else
            SB.Append Char
            index = index + 1
      End Select
   Loop

   parseString = SB.ToString
   Set SB = Nothing

End Function

重构后的方法不使用cStringBuilder类。这已经提高了性能。主要的重构是在前面已经讨论过的行中完成的。需要记住的一点是，m_str()数组是使用AscW()函数创建的。请注意W。

  • AscW(S) 返回 S 中第一个字符的 Unicode 值
  • Asc(S) 返回 S 中第一个字符的 ANSI 值

所以，我们这里处理的是 Unicode，而不是 ANSI。因此，在将生成的 parseString 与当前索引（光标）处的字符连接时，我们也必须使用 Chr 函数的 Unicode 版本。

parseString = parseString & ChrW$(charint)

完整函数如下所示

Private Function parseString(Byref str As string, ByRef index As Long) As String

   Dim quoteint As Integer
   Dim charint As Integer
   Dim Code    As String

   Call skipChar(index)

   quoteint = m_str(index)

   index = index + 1

   Do While index > 0 And index <= m_length

      charint = m_str(index)

      Select Case charint
        Case A_BACKSLASH

            index = index + 1
            charint = m_str(index)

            Select Case charint
            Case A_DOUBLE_QUOTE, A_BACKSLASH, A_FORWARDSLASH, A_SINGLE_QUOTE
                parseString = parseString & ChrW$(charint)
                index = index + 1
            Case A_b
                parseString = parseString & vbBack
                index = index + 1
            Case A_f
                parseString = parseString & vbFormFeed
                index = index + 1
            Case A_n
                    parseString = parseString & vbLf
                  index = index + 1
            Case A_r
                parseString = parseString & vbCr
                index = index + 1
            Case A_t
                parseString = parseString & vbTab
                  index = index + 1
            Case A_u
                index = index + 1
                Code = Mid$(str, index, 4)

                parseString = parseString & ChrW$(Val("&h" + Code))
                index = index + 4
            End Select

        Case quoteint

            index = index + 1
            Exit Function

         Case Else
            parseString = parseString & ChrW$(charint)
            index = index + 1
      End Select
   Loop

End Function

改进

  • 将字符串函数替换为其带有$的对应函数，最常用的是：Mid() -> Mid$()
  • 重构了 Mid()$ 的使用，并尽可能将其替换为从解析器开头生成的 m_str 数组中返回值
  • 不要重新计算 Len(jsonstring)，计算一次并重复使用私有变量。
  • 使用 Unicode 字符串函数：AscW(S) 和 ChrW$(U)，不要与 ANSI 对应函数混用。ANSI 对应函数也较慢。

关注点

历史

  • 版本 1: 2014-02-03
  • 版本 2: 2014-02-08
© . All rights reserved.