Hello to all,
here is my VB.NET class for to parse a JSON text
First, copy this json text example into example.json file:
Then, copy this class into json.vb file:
Now, open a new project in VB.NET, add json.vb file, and then write this code into Sub Main() for to see the example.
Note that the code is the same as this post write by Erel
Many thanks for your "like"
Sergio
here is my VB.NET class for to parse a JSON text
First, copy this json text example into example.json file:
B4X:
{"menu": {
"id": "file",
"value": "File",
"popup": {
"menuitem": [
{"value": "New", "onclick": "CreateNewDoc()"},
{"value": "Open", "onclick": "OpenDoc()"},
{"value": "Close", "onclick": "CloseDoc()"}
]
}
}}Then, copy this class into json.vb file:
B4X:
' JsonParser for VB.NET version 1.0
' this is a VB.NET adaptation of the VBA JSON project at http://code.google.com/p/vba-json/
' by SirJo [email protected]
' BSD Licensed
Public Class JsonParser
Private ReadOnly vbTab As String = Convert.ToChar(9)
Private ReadOnly vbCr As String = Convert.ToChar(13)
Private ReadOnly vbLf As String = Convert.ToChar(10)
Private ReadOnly vbCrLf As String = Convert.ToChar(13) & Convert.ToChar(10)
Private ReadOnly vbBack As String = Convert.ToChar(8)
Private ReadOnly vbFormFeed As String = Convert.ToChar(12)
Private txt As String
Private index As Integer
Public Sub New(ByVal JsonText As String)
txt = JsonText
index = 0
End Sub
Public Function JsonParse() As Object
skipChar()
Select Case txt.Substring(index, 1)
Case "{"
Return NextObject()
Case "["
Return NextArray()
End Select
Throw New ApplicationException("Invalid JSON")
End Function
Public Function NextObject() As Hashtable
Dim po As New Hashtable
Dim sKey As String
' "{"
skipChar()
If index >= txt.Length Then
Throw New ApplicationException("JSON Object not found")
End If
If txt.Substring(index, 1) <> "{" Then
Throw New ApplicationException("Invalid Object at position " & index.ToString & ": " & txt.Substring(index, 20) & "...")
End If
index += 1
Do
skipChar()
If txt.Substring(index, 1) = "}" Then ' fine oggetto
index += 1
Exit Do
End If
If txt.Substring(index, 1) = "," Then
index += 1
skipChar()
ElseIf index >= txt.Length Then
Throw New ApplicationException("Missing '}'")
End If
' add key/value pair
sKey = parseKey()
Try
po.Add(sKey, parseValue)
Catch ex As Exception
Throw New ApplicationException("Error Key " & sKey & " = " & ex.Message)
End Try
Loop
Return po
End Function
Public Function NextArray() As ArrayList
Dim pa = New ArrayList
' "["
skipChar()
If index >= txt.Length Then
Throw New ApplicationException("JSON Array not found")
End If
If txt.Substring(index, 1) <> "[" Then
Throw New ApplicationException("Invalid Array at position " & index.ToString & ": " & txt.Substring(index, 20) & "...")
End If
index += 1
Do
skipChar()
If txt.Substring(index, 1) = "]" Then ' fine array
index += 1
Exit Do
End If
If txt.Substring(index, 1) = "," Then
index += 1
skipChar()
ElseIf index >= txt.Length Then
Throw New ApplicationException("Missing ']'")
End If
' add value
Try
pa.Add(parseValue)
Catch ex As Exception
Throw New ApplicationException("Error at index " & index.ToString & " = " & ex.Message)
End Try
Loop
Return pa
End Function
Private Sub skipChar()
Dim bComment As Boolean = False
Dim bStartComment As Boolean = False
Dim bLongComment As Boolean = False
Do While index > -1 And index < txt.Length
Select Case txt.Substring(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 += 1
Loop
End Sub
Private Function parseKey() As String
Dim dquote As Boolean
Dim squote As Boolean
Dim chr As String
Dim pk As String = ""
skipChar()
Do While index >= 0 And index < txt.Length
chr = txt.Substring(index, 1)
Select Case (chr)
Case """"
dquote = Not dquote
index += 1
If Not dquote Then
skipChar()
If txt.Substring(index, 1) <> ":" Then
Throw New ApplicationException("Invalid Key at position " & index.ToString & " : " & pk)
'Exit Do
End If
End If
Case "'"
squote = Not squote
index += 1
If Not squote Then
skipChar()
If txt.Substring(index, 1) <> ":" Then
Throw New ApplicationException("Invalid Key at position " & index.ToString & " : " & pk)
'Exit Do
End If
End If
Case ":"
index += 1
If Not dquote And Not squote Then
Exit Do
Else
pk &= chr
End If
Case Else
If (vbCr & vbLf & vbTab & " ").IndexOf(chr) < 0 Then
pk &= chr
End If
index += 1
End Select
Loop
Return pk
End Function
Private Function parseValue() As Object
skipChar()
Select Case txt.Substring(index, 1)
Case "{"
Return NextObject()
Case "["
Return NextArray()
Case """", "'"
Return parseString()
Case "t", "f"
Return parseBoolean()
Case "n"
parseNull()
Return Nothing
Case Else
Return parseNumber()
End Select
'Return pv
End Function
Private Function parseString() As String
Dim quote As String
Dim chr As String
Dim Code As String
Dim sb As New System.Text.StringBuilder
skipChar()
quote = txt.Substring(index, 1)
index += 1
Do While index >= 0 And index < txt.Length
chr = txt.Substring(index, 1)
Select Case chr
Case "\"
index += 1
chr = txt.Substring(index, 1)
Select Case chr
Case """", "\", "/", "'"
sb.Append(chr)
index += 1
Case "b"
sb.Append(vbBack)
index += 1
Case "f"
sb.Append(vbFormFeed)
index += 1
Case "n"
sb.Append(vbLf)
index += 1
Case "r"
sb.Append(vbCr)
index += 1
Case "t"
sb.Append(vbTab)
index += 1
Case "u"
index += 1
Code = txt.Substring(index, 4)
sb.Append(Convert.ToChar(Convert.ToInt32(Code, 16)).ToString)
index += 4
End Select
Case quote
index += 1
Return sb.ToString
Case Else
sb.Append(chr)
index += 1
End Select
Loop
Return sb.ToString
End Function
Private Function parseNumber() As Decimal
Dim Value As String = ""
Dim chr As String
skipChar()
Do While index >= 0 And index < txt.Length
chr = txt.Substring(index, 1)
If ("+-0123456789.eE").IndexOf(chr) >= 0 Then
Value &= chr
index += 1
Else
Exit Do
End If
Loop
Return CDec(Value)
End Function
Private Function parseBoolean() As Boolean
skipChar()
If txt.Substring(index, 4) = "true" Then
index += 4
Return True
End If
If txt.Substring(index, 5) = "false" Then
index += 5
Return False
End If
Throw New ApplicationException("Invalid Boolean at position " & index.ToString & ": " & txt.Substring(index, 20) & "...")
End Function
Private Sub parseNull()
skipChar()
If txt.Substring(index, 4) = "null" Then
index += 4
Return
End If
Throw New ApplicationException("Invalid null value at position " & index.ToString & ": " & txt.Substring(index, 20) & "...")
End Sub
End ClassNow, open a new project in VB.NET, add json.vb file, and then write this code into Sub Main() for to see the example.
Note that the code is the same as this post write by Erel
B4X:
Dim JSON As JsonParser
Dim Map1 As Hashtable
JSON = New JsonParser(My.Computer.FileSystem.ReadAllText("example.json"))
Map1 = JSON.NextObject
Dim m As Hashtable 'helper map for navigating
Dim MenuItems As ArrayList
m = CType(Map1.Item("menu"), Hashtable)
m = CType(m.Item("popup"), Hashtable)
MenuItems = CType(m.Item("menuitem"), ArrayList)
For i = 0 To MenuItems.Count - 1
m = CType(MenuItems.Item(i), Hashtable)
Console.WriteLine(m.Item("onclick").ToString & " = " & m.Item("value").ToString)
Next
Console.ReadKey()Many thanks for your "like"
Sergio
