Public Enum json_type As Integer null = 0 numeric text bool array End Enum Public Class json_value Public ID As String Public TYPE As json_type Public VALUE As Object Public VALUES() As json_value End Class Public Class json Private Class json_content Dim varText As String = "" Dim varOffset As Integer = 0 Public Sub SkipSpace() While Not IsEnd() If varText.Substring(varOffset, 1) <> " " Then Exit Sub End If varOffset += 1 End While End Sub Public Property Text As String Get Return varText End Get Set(value As String) varText = value.Trim End Set End Property Public Property Offset As Integer Get Return varOffset End Get Set(value As Integer) varOffset = value End Set End Property Public ReadOnly Property Length As Integer Get Return varText.Length End Get End Property Public Function IsEnd() As Boolean Return Not (varOffset < varText.Length) End Function Public Function GetChar(Optional ByVal Seek As Integer = 1) As String SkipSpace() If varOffset < Length Then Dim Result As String = varText.Substring(varOffset, 1) varOffset += Seek Return Result Else Return "" End If End Function Public Function GetWord() As String Dim key As String = "" Dim result As String = "" SkipSpace() If varText.StartsWith(Chr(34)) Then key = Chr(34) result = Chr(34) varOffset += 1 End If While Not IsEnd() Dim code As String = varText.Substring(varOffset, 1) If ((key = Chr(34)) And (code = Chr(34))) Then result &= Chr(34) varOffset += 1 Exit While Else If InStr(",:{}[]" & vbCr & vbLf, code) > 0 Then Exit While End If End If result &= code varOffset += 1 End While Return result End Function End Class Private varValue() As json_value Private varContent As New json_content Private Function __parser_value(Optional OnlyValue As Boolean = False) As json_value Dim value As json_value = New json_value Select Case varContent.GetChar(0) Case "{" varContent.Offset += 1 value.ID = "" value.TYPE = json_type.array value.VALUES = __parser_list() Case "[" varContent.Offset += 1 value.ID = "" value.TYPE = json_type.array value.VALUES = __parser_array() Case Else If (OnlyValue) Then value.ID = "" Select Case varContent.GetChar(0) Case "{" varContent.Offset += 1 value.TYPE = json_type.array value.VALUES = __parser_list() Case "[" varContent.Offset += 1 value.TYPE = json_type.array value.VALUES = __parser_array() Case Else Dim temp As String = varContent.GetWord() If (temp <> "") Then If temp.StartsWith(Chr(34)) Then value.TYPE = json_type.text If temp.Length > 2 Then value.VALUE = temp.Substring(1, temp.Length - 2) Else value.VALUE = CStr("") End If ElseIf temp.ToUpper = "TRUE" Then value.TYPE = json_type.bool value.VALUE = True ElseIf temp.ToUpper = "FALSE" Then value.TYPE = json_type.bool value.VALUE = False Else value.TYPE = json_type.numeric value.VALUE = CDbl(temp) End If Else Return Nothing End If End Select Else value.ID = varContent.GetWord().Replace(Chr(34), "") If (varContent.GetChar(0) = ":") Then varContent.Offset += 1 Select Case varContent.GetChar(0) Case "{" varContent.Offset += 1 value.TYPE = json_type.array value.VALUES = __parser_list() Case "[" varContent.Offset += 1 value.TYPE = json_type.array value.VALUES = __parser_array() Case Else Dim temp As String = varContent.GetWord() If temp.StartsWith(Chr(34)) Then value.TYPE = json_type.text If temp.Length > 2 Then value.VALUE = temp.Substring(1, temp.Length - 2) Else value.VALUE = CStr("") End If ElseIf temp.ToUpper = "TRUE" Then value.TYPE = json_type.bool value.VALUE = True ElseIf temp.ToUpper = "FALSE" Then value.TYPE = json_type.bool value.VALUE = False Else value.TYPE = json_type.numeric value.VALUE = CDbl(temp) End If End Select End If End If End Select Return value End Function Private Function __parser_array() As json_value() Dim values() As json_value = Nothing While Not varContent.IsEnd() Dim rst As json_value = __parser_value(True) Dim code As String = varContent.GetChar(0) Select Case code Case "]", "," varContent.Offset += 1 If (values Is Nothing) Then ReDim values(0) Else ReDim Preserve values(values.Length) End If values(values.Length - 1) = rst If (code = "]") Then Exit While End If Case Else Exit While End Select End While If (values IsNot Nothing) Then For Index As Integer = 0 To values.Count - 1 If values(Index) IsNot Nothing Then values(Index).ID = Index.ToString End If Next End If Return values End Function Private Function __parser_list() As json_value() Dim values() As json_value = Nothing While Not varContent.IsEnd() Dim rst As json_value = __parser_value() Dim code As String = varContent.GetChar(0) Select Case code Case "}", "," varContent.Offset += 1 If (values Is Nothing) Then ReDim values(0) Else ReDim Preserve values(values.Length) End If values(values.Length - 1) = rst If (code = "}") Then Exit While End If Case Else Exit While End Select End While Return values End Function Public Property Text As String Get Return varContent.Text End Get Set(value As String) varContent.Text = value.Trim varContent.Offset = 0 Select Case varContent.GetChar(0) Case "{" varContent.Offset += 1 varValue = __parser_list() Case "[" varContent.Offset += 1 varValue = __parser_array() Case Else ReDim varValue(0) varValue(0) = __parser_value() End Select End Set End Property Public Function Count() As Integer If varValue Is Nothing Then Return 0 End If Return varValue.Count End Function Public Function Value() As json_value() Return varValue End Function Public Function Value(path() As String, Optional IgnoreCase As Boolean = False) As json_value If (path IsNot Nothing) Then Dim v() As json_value = varValue For Level As Integer = 0 To path.Length - 2 If v IsNot Nothing Then Dim P As String = If(IgnoreCase, path(Level).ToUpper, path(Level)) For Index As Integer = 0 To v.Length - 1 Dim K As String = If(IgnoreCase, v(Index).ID.ToUpper, v(Index).ID) If (P = K) Then If v(Index).TYPE = json_type.array Then v = v(Index).VALUES Else v = New json_value() {v(Index)} End If Exit For End If Next Else Return Nothing End If Next If (v IsNot Nothing) Then Dim P As String = If(IgnoreCase, path(path.Length - 1).ToUpper, path(path.Length - 1)) For Index As Integer = 0 To v.Length - 1 Dim K As String = If(IgnoreCase, v(Index).ID.ToUpper, v(Index).ID) If (P = K) Then Return v(Index) End If Next End If End If Return Nothing End Function End Class