Saturday 2 June 2018

JSON Parser in VB6 (Fast & Efficient)

'Please read disclaimer before using this code.

Option Explicit

Dim que As String

Public Sub Add(s As String)
    que = que & s
End Sub

Public Function Remove() As String
    Remove = que
    que = ""
End Function

Public Function parseJSONArray(json As String) As Collection
    Dim col As New Collection
    Dim i As Long
    Dim start As Boolean
    Dim start1 As Integer
    Dim start2 As Boolean
    Dim start3 As Boolean
    Dim c As String * 1
    i = 1
    Do While i <= Len(json)
        c = Mid(json, i, 1)
        If start = False Then
            If c = " " Then
                'Ignore
            ElseIf c = "[" Then
                start = True
            Else
                Set parseJSONArray = Nothing
            End If
        Else
            If ((start1 = 0 And start2 = False) Or start3 = True) And (c = "," Or c = "]") Then
                col.Add Remove
            ElseIf start1 = 0 And start2 = False And start3 = False Then
                If c = "{" Then
                    start1 = start1 + 1
                    Add c
                ElseIf c = """" Then
                    start2 = True
                ElseIf start2 = True And c = "\" Then           'Convert \" to "
                    c = Mid(json, i + 1, 1)
                    If c = """" Then
                        Add c: i = i + 1
                    Else
                        Add "\"
                    End If
                ElseIf c = " " Then
                    'Skip
                Else
                    start3 = True
                    Add c
                End If
            ElseIf start1 > 0 Then
                If c = "{" Then start1 = start1 + 1
                If c = "}" Then start1 = start1 - 1
                Add c
            ElseIf start2 = True And c = """" Then
                start2 = False
            Else
                Add c
            End If
        End If
        i = i + 1
    Loop
    Set parseJSONArray = col
End Function

Public Function parseJSONObject(ByVal json As String) As Collection
    Dim start As Boolean
    Dim start1 As Boolean
    Dim start2 As Boolean
    Dim start22 As Boolean
    Dim col  As New Collection
    Dim code As String
    Dim arStart As Integer
    Dim obStart As Integer
    Dim loc As Integer
    Dim i As Long
    loc = 2
    arStart = 0: obStart = 0
   
        Dim s As String
        Dim c As String
        s = json
        i = 1
        Do While i <= Len(s)
            c = Mid(s, i, 1)
            If start = False Then
                If c = " " Then
                    'Ignore
                ElseIf c = "{" Then
                    start = True
                Else
                    Set parseJSONObject = Nothing
                End If
            Else
                If start2 = True And arStart > 0 Then
                    If c = "[" Then arStart = arStart + 1
                    If c = "]" Then arStart = arStart - 1
                    Add c
                ElseIf start2 = True And obStart > 0 Then
                    If c = "{" Then obStart = obStart + 1
                    If c = "}" Then obStart = obStart - 1
                    Add c
                ElseIf start2 = True And c = "[" Then
                    arStart = arStart + 1               'Value part is an Array
                    Add c
                ElseIf start2 = True And c = "{" Then
                    obStart = obStart + 1               'Value part is an Object
                    Add c
                ElseIf start2 = True And c = "\" Then   'Convert \" to "
                    c = Mid(s, i + 1, 1)
                    If c = """" Then
                        Add c: i = i + 1
                    Else
                        Add "\"
                    End If
                ElseIf start1 = False And start2 = False And c = """" Then
                    start1 = True                       'Name part start
                ElseIf start1 = True And c = """" Then
                    code = Remove                       'Name part end
                    start1 = False
                ElseIf start1 = False And start2 = False And c = ":" Then
                    start2 = True                       'Value part start
                ElseIf start2 = True And start22 = False And arStart = 0 And obStart = 0 And (c = "," Or c = "}") Then
                    col.Add Remove, code                'Value part end
                    start2 = False
                ElseIf start2 = True And c = """" Then
                    If start22 = True Then
                        start22 = False
                    Else
                        start22 = True
                    End If
                Else
                    Add c
                End If
                If start2 = False Then start22 = False
            End If
            i = i + 1
        Loop
        Set parseJSONObject = col
End Function

Public Function stringToDate(dt As String, Optional splitSymbl As String = "-") As Date
    Dim a() As String
    a = Strings.Split(dt, splitSymbl)
    If UBound(a) = 2 Then
        stringToDate = DateSerial(a(2), a(1), a(0))
    Else
        Err.Raise 9999, "StringToDate Function", "Invalid Date!"
    End If
End Function


No comments:

Post a Comment