JSON Writer in VB6 (Fast & Efficient)

'Please read disclaimer before using this code.

 Option Explicit
   
    Dim s As String                 ' Used for Storing JSON String
    Dim jsep As String              ' Used for Comma
    Const jencl = """"              ' Used for Double Quotes
    Public Enum JDataTypes
        JString
        JNumber
        JObject
    End Enum
           
   
    Public Sub addJArray(code As String, ar As Collection, JType As JDataTypes)
        Dim obj As Variant
        Dim Count As Integer
        If s <> "" Then jsep = ","
        s = s & jsep & jencl & code & jencl & ":["
        Count = 0
        For Each obj In ar
            If s <> "" Then jsep = ","
            If Count = 0 Then
                Count = 1
            Else
                s = s & jsep
            End If
            If JType = JString Then
                s = s & jencl & obj & jencl
            ElseIf JType = JObject Then
                s = s & obj.generateJSON
            Else
                s = s & obj
            End If
        Next
        s = s & "]"
    End Sub
   
    Public Sub addJString(code As String, value As String)
        If s <> "" Then jsep = ","
        s = s & jsep & jencl & code & jencl & ":" & jencl & Replace(value, """", "\""") & jencl
    End Sub
   
    Public Sub addJInteger(code As String, value As Integer)
        If s <> "" Then jsep = ","
        s = s & jsep & jencl & code & jencl & ":" & value
    End Sub
   
    Public Sub addJDouble(code As String, value As Double)
        If s <> "" Then jsep = ","
        s = s & jsep & jencl & code & jencl & ":" & value
    End Sub
   
    Public Sub addJObject(code As String, value As JSONWriter)
        If s <> "" Then jsep = ","
        s = s & jsep & jencl & code & jencl & ":" & value.generateJSON
    End Sub
   

    Public Function generateJSON() As String
        generateJSON = "{" & s & "}"
    End Function

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

Cricket Scoreboard Project in Java

Click here to download!

Online Material Control System Project File

CLICK HERE TO DOWNLOAD FILES.

Helicopter and Tank Game in VB6

Click here to download game!