Parser le json (javascript object notation) en vb.net

Commenter

Contenu du snippet

Voici un exemple de module simple qui permet de parser une chaine JSON (JavaScript Object Notation) en VB.NET

Cela traduit simplement l’algorithme qu'on trouve sur http://www.json.org/

Voici les équivalants VB.NET choisis pour les objects JavaScript:

object: Dictionary
array: ArrayList
value: Object
string: String
number: Double

Bien sûr d'autre choix était possible...
Mais au moins c'est simple et ça fonctionne.
A vous de l'adapter comme vous voulez.

Exemple pour l'utiliser:
dim obj as Object = decode("{""test"":true}"")

Ou avec un fichier au format json:
dim obj as Object = decode(IO.File.ReadAllText("example.json"))

Source / Exemple : 


Module JSON

    Public Function decode(ByVal json As String) As Object
        Dim obj As Object = Nothing
        If jsonValue(json, obj) AndAlso json.Length = 0 Then Return obj
        Return Nothing
    End Function

    Dim whiteSpace As Char() = (vbCrLf & vbTab & " " & Chr(160)).ToCharArray
    Private Sub trim(ByRef s As String)
        s = s.Trim(whiteSpace)
    End Sub

    Private Sub substring(ByRef s As String, ByVal startIndex As Integer)
        s = s.Substring(startIndex)
    End Sub

    Private Function jsonValue(ByRef json As String, ByRef o As Object) As Boolean
        If jsonString(json, o) Then Return True
        If jsonNumber(json, o) Then Return True
        If jsonObject(json, o) Then Return True
        If jsonArray(json, o) Then Return True
        trim(json)
        If json.StartsWith("true") Then o = True : substring(json, 4) : Return True
        If json.StartsWith("false") Then o = False : substring(json, 5) : Return True
        If json.StartsWith("null") Then o = Nothing : substring(json, 4) : Return True
        Return False
    End Function

    Private escapeChar As String = """\/" & vbCrLf & vbTab & vbBack & vbFormFeed
    Private Function jsonString(ByRef json As String, ByRef o As Object) As Boolean
        trim(json)
        If Not json.StartsWith("""") Then Return False
        Dim a As String = ""
        Dim escape As Boolean = False
        Dim unicode As Integer = 0
        Dim hex As String = ""
        Dim index As Integer = 0
        While True
            index += 1
            If index >= json.Length Then
                json = "ERROR-STRING-LENGTH"
                o = ""
                Return True
            End If
            Dim c As Char = json(index)
            If escape AndAlso unicode > 0 Then
                unicode -= 1
                hex &= c
                If unicode = 0 Then
                    escape = False
                    c = ChrW(Val(hex))
                    a &= c
                End If
            ElseIf escape Then
                escape = False
                If escapeChar.Contains(c) Then
                    a &= c
                ElseIf c = "u" Then
                    unicode = 4
                    hex = "&h"
                Else
                    json = "ERROR-STRING-ESCAPE"
                    o = ""
                    Return True
                End If
            ElseIf c = """" Then
                substring(json, index + 1)
                o = a
                Return True
            Else
                a &= c
            End If
        End While
    End Function

    Private Function jsonNumber(ByRef json As String, ByRef o As Object) As Boolean
        Dim index As Integer = 0
        If json(index) = "-" Then index += 1
        If json(index) = "0" Then : index += 1
        ElseIf "123456789".Contains(json(index)) Then : index += 1
            While "0123456789".Contains(json(index)) : index += 1 : End While
        Else : Return False : End If
        If json(index) = "." Then : index += 1
            If "0123456789".Contains(json(index)) Then : index += 1
                While "0123456789".Contains(json(index)) : index += 1 : End While
            Else : Return False : End If
        End If
        If json(index) = "e" Or json(index) = "E" Then : index += 1
            If json(index) = "+" Or json(index) = "-" Then index += 1
            If "0123456789".Contains(json(index)) Then : index += 1
                While "0123456789".Contains(json(index)) : index += 1 : End While
            Else : Return False : End If
        End If
        o = Val(json.Substring(0, index))
        substring(json, index)
        Return True
    End Function

    Private Function jsonObject(ByRef json As String, ByRef o As Object) As Boolean
        Dim key As Object = Nothing
        Dim value As Object = Nothing
        trim(json)
        If Not json.StartsWith("{") Then Return False
        Dim a As New Dictionary(Of String, Object)
        o = a
        substring(json, 1)
        While True
            trim(json)
            If json.StartsWith("}") Then
                substring(json, 1)
                Return True
            ElseIf a.Count > 0 Then
                If json.StartsWith(",") Then
                    substring(json, 1)
                Else
                    json = "ERROR-OBJECT-VIRGULE"
                    Return True
                End If
            End If
            If Not jsonString(json, key) Then
                json = "ERROR-OBJECT-KEY"
                Return True
            End If
            trim(json)
            If json.StartsWith(":") Then
                substring(json, 1)
            Else
                json = "ERROR-OBJECT-DOT"
                Return True
            End If
            If Not jsonValue(json, value) Then
                json = "ERROR-OBJECT-VALUE"
                Return True
            End If
            a.Add(key, value)
        End While
    End Function

    Private Function jsonArray(ByRef json As String, ByRef o As Object) As Boolean
        Dim value As Object = Nothing
        trim(json)
        If Not json.StartsWith("[") Then Return False
        Dim a As New ArrayList
        o = a
        substring(json, 1)
        While True
            trim(json)
            If json.StartsWith("]") Then
                substring(json, 1)
                Return True
            ElseIf a.Count > 0 Then
                If json.StartsWith(",") Then
                    substring(json, 1)
                Else
                    json = "ERROR-ARRAY-VIRGULE"
                    Return True
                End If
            End If
            If Not jsonValue(json, value) Then
                json = "ERROR-ARRAY-VALUE"
                Return True
            End If
            a.Add(value)
        End While
    End Function

End Module

Conclusion :


Bon code...

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (zbabug)