Results 1 to 15 of 15

Thread: JSON to XDocument converter

  1. #1

    Thread Starter
    Super Moderator dday9's Avatar
    Join Date
    Mar 2011
    Location
    South Louisiana
    Posts
    11,715

    JSON to XDocument converter

    The following code converts JSON data into an XDocument:
    Code:
    Option Strict On
    
    Imports System
    Imports System.Collections.Generic
    Imports System.Linq
    Imports System.Text.RegularExpressions
    Imports System.Xml
    Imports System.Xml.Linq
    Public Module JSON
    
        Private Function Scan(ByVal source As String) As Token()
            Dim tempSource As String = source
            Dim lexedTokens As New List(Of Token)
            Dim scanDelegates() As Scan_NonTerminal = {New Scan_NonTerminal(AddressOf Scan_String), New Scan_NonTerminal(AddressOf Scan_Number), New Scan_NonTerminal(AddressOf Scan_Boolean), New Scan_NonTerminal(AddressOf Scan_Literal), New Scan_NonTerminal(AddressOf Scan_Whitespace)}
            Dim index As Integer = 0
            Dim t As Token
            Do
                index = 0
                Do
                    t = scanDelegates(index).Invoke(tempSource)
                    If t IsNot Nothing Then
                        lexedTokens.Add(t)
                    End If
    
                    index += 1
                Loop Until tempSource.Length = 0 OrElse index = scanDelegates.Length
            Loop Until tempSource.Length = 0
    
            Return lexedTokens.ToArray()
        End Function
    
        Private Delegate Function Scan_NonTerminal(ByRef source As String) As Token
    
        Private Function Scan_String(ByRef source As String) As Token
            Dim m As Match = Regex.Match(source, """([^""\\]|\\[""\\\/bfnrt])*""")
            Dim t As Token = Nothing
    
            If m.Success AndAlso m.Index = 0 Then
                Dim literal As String = m.Value.Remove(0, 1)
                literal = literal.Remove(literal.Length - 1)
                t = New Token("string", literal)
                source = source.Substring(m.Value.Length)
            End If
    
            Return t
        End Function
    
        Private Function Scan_Number(ByRef source As String) As Token
            Dim m As Match = Regex.Match(source, "\d+((\.\d+)?((e|E)[+-]?\d+)?)")
            Dim t As Token = Nothing
    
            If m.Success AndAlso m.Index = 0 Then
                t = New Token("number", m.Value)
                source = source.Substring(m.Value.Length)
            End If
    
            Return t
        End Function
    
        Private Function Scan_Boolean(ByRef source As String) As Token
            Dim t As Token = Nothing
    
            If source.StartsWith("true", StringComparison.OrdinalIgnoreCase) OrElse source.StartsWith("null", StringComparison.OrdinalIgnoreCase) Then
                t = New Token("boolean", source.Substring(0, 4))
                source = source.Substring(4)
            ElseIf source.StartsWith("false", StringComparison.OrdinalIgnoreCase) Then
                t = New Token("boolean", source.Substring(0, 5))
                source = source.Substring(5)
            End If
    
            Return t
        End Function
    
        Private Function Scan_Literal(ByRef source As String) As Token
            Dim literals() As Char = "[]{}:,".ToCharArray()
            Dim t As Token = Nothing
    
            If Array.IndexOf(literals, source(0)) <> -1 Then
                t = New Token("literal", source(0))
                source = source.Remove(0, 1)
            End If
    
            Return t
        End Function
    
        Private Function Scan_Whitespace(ByRef source As String) As Token
            Dim m As Match = Regex.Match(source, "\s+")
            Dim t As Token = Nothing
    
            If m.Success AndAlso m.Index = 0 Then
                source = source.Substring(m.Value.Length)
            End If
    
            Return t
        End Function
    
        Public Function Parse(ByVal source As String) As XDocument
            Dim doc As XDocument = Nothing
            Dim tokens() As Token = Scan(source)
            Dim json As XElement = Parse_Object(tokens)
    
            If json IsNot Nothing Then
                json.Name = "json"
                doc = New XDocument(New XDeclaration("1.0", "utf-8", "yes"), json)
            End If
    
            Return doc
        End Function
    
        Private Function Parse_Object(ByRef tokens() As Token) As XElement
            Dim x As XElement = Nothing
            Dim tempTokens As New Queue(Of Token)(tokens)
    
            If tempTokens.Count >= 2 AndAlso tempTokens.Dequeue().Value = "{" Then
                If tempTokens.Peek().Value <> "}" Then
                    Dim pairs As New List(Of XElement)
                    Dim key As XElement = Nothing
                    Dim value As XElement = Nothing
    
                    Do
                        If tempTokens.Peek().Category = "string" Then
                            key = New XElement("key", tempTokens.Dequeue().Value)
                            If tempTokens.Peek().Value = ":" Then
                                tempTokens.Dequeue()
                                value = Parse_Value(tempTokens)
                                If value IsNot Nothing Then
                                    pairs.Add(New XElement("pair", {key, value}))
                                End If
                            End If
                        End If
                    Loop While value IsNot Nothing AndAlso tempTokens.Count > 0 AndAlso tempTokens.Peek.Value <> "}" AndAlso tempTokens.Dequeue.Value = ","
    
                    If tempTokens.Peek().Value = "}" Then
                        tempTokens.Dequeue()
                        x = New XElement("object")
                        For Each item As XElement In pairs
                            value = item.Descendants.ElementAt(1)
                            value.SetAttributeValue("key", item.Descendants.ElementAt(0).Value)
                            x.Add(value)
                        Next
                        tokens = tempTokens.ToArray()
                    End If
                Else
                    tempTokens.Dequeue()
                    x = New XElement("object")
                    tokens = tempTokens.ToArray()
                End If
            End If
    
            Return x
        End Function
    
        Private Function Parse_Array(ByRef tokens As Queue(Of Token)) As XElement
            Dim x As XElement = Nothing
            Dim tempTokens As New Queue(Of Token)(tokens)
    
            If tempTokens.Count >= 2 AndAlso tempTokens.Dequeue().Value = "[" Then
                If tempTokens.Peek().Value <> "]" Then
                    Dim pairs As New List(Of XElement)
                    Dim value As XElement = Nothing
    
                    Do
                        value = Parse_Value(tempTokens)
                        If value IsNot Nothing Then
                            pairs.Add(New XElement("item", value))
                        End If
                    Loop While value IsNot Nothing AndAlso tempTokens.Count > 0 AndAlso tempTokens.Peek.Value <> "]" AndAlso tempTokens.Dequeue.Value = ","
    
                    If tempTokens.Peek().Value = "]" Then
                        tempTokens.Dequeue()
                        x = New XElement("array", pairs)
                        tokens = tempTokens
                    End If
                Else
                    tempTokens.Dequeue()
                    x = New XElement("array")
                    tokens = tempTokens
                End If
            End If
    
            Return x
        End Function
    
        Private Function Parse_Value(ByRef tokens As Queue(Of Token)) As XElement
            Dim x As XElement = Nothing
            Dim firstToken As Token = tokens.Peek
            Dim category As String = firstToken.Category
            Dim value As String = firstToken.Value
    
            If category = "number" OrElse category = "boolean" OrElse category = "string" Then
                x = New XElement(category, tokens.Dequeue.Value)
            Else
                Dim tempTokens() As Token = tokens.ToArray()
                If value = "{" Then
                    x = Parse_Object(tempTokens)
                    If x IsNot Nothing Then
                        tokens = New Queue(Of Token)(tempTokens)
                    End If
                ElseIf value = "[" Then
                    x = Parse_Array(tokens)
                End If
            End If
    
            Return x
        End Function
    
    End Module
    
    Public Class Token
    
        Private _category As String
        Public Property Category As String
            Get
                Return _category
            End Get
            Set(ByVal value As String)
                If Not String.Equals(_category, value) Then
                    _category = value
                End If
            End Set
        End Property
    
        Private _value As String
        Public Property Value As String
            Get
                Return _value
            End Get
            Set(ByVal value As String)
                If Not String.Equals(_value, value) Then
                    _value = value
                End If
            End Set
        End Property
    
        Protected Overridable Sub OnCategoryChanged()
            RaiseEvent CategoryChanged(Me, EventArgs.Empty)
        End Sub
    
        Protected Overridable Sub OnValueChanged()
            RaiseEvent ValueChanged(Me, EventArgs.Empty)
        End Sub
    
        Public Event CategoryChanged(ByVal sender As Object, ByVal e As EventArgs)
        Public Event ValueChanged(ByVal sender As Object, ByVal e As EventArgs)
    
        Public Sub New()
            _category = String.Empty
            _value = String.Empty
        End Sub
    
        Public Sub New(ByVal category As String, ByVal value As String)
            _category = category
            _value = value
        End Sub
    
    End Class
    Fiddle: https://dotnetfiddle.net/xjykxk

    Basically the way that it works is that it first scans the source code using a lexical analyzer to return a collection of Tokens and then uses a recursive descent parser to validate that the tokens are syntactically correct all while building the XDocument.

    I hope you enjoy and please let me know if you find a source code that gives an error.

    For a scannerless parser see post #11 & #12.

    For most up-to-date code, see post #15
    Last edited by dday9; Aug 23rd, 2018 at 01:33 PM.
    "Code is like humor. When you have to explain it, it is bad." - Cory House
    VbLessons | Code Tags | Sword of Fury - Jameram

  2. #2
    MS SQL Powerposter szlamany's Avatar
    Join Date
    Mar 2004
    Location
    Connecticut
    Posts
    18,263

    Re: JSON to XDocument converter

    Very nice.

    I've tested it with a bunch of JSON - it's slow with large sets of data.

    Here's an example of a nice complicated JSON. I've got a couple of questions on why some things are going on - posted right into the XML - just scroll down...

    Code:
    {
    	"boottab": ["run"],
    	"operators": [],
    	"editkey": "RealParameter",
    	"awcoptions": {
    		"nosort": true,
    		"awcdisplay": true
    	},
    	"heading": "Bid Activity (enter Selections below and click the RUN icon to the left)",
    	"tabcaption": "Bid Activity",
    	"acs-work": "slickgrid",
    	"options": {
    		"editable": true,
    		"enableAddRow": false,
    		"enableCellNavigation": true,
    		"asyncEditorLoading": false
    	},
    	"columns": [{
    		"id": "Parameter",
    		"name": "Display Parameters",
    		"field": "Parameter",
    		"width": "225",
    		"sortable": "false",
    		"unselectable": "true",
    		"unfocusable": "true",
    		"cssClass": "cell-title"
    	}, {
    		"id": "Selection",
    		"name": "Selection",
    		"field": "Selection",
    		"width": "225",
    		"sortable": "false",
    		"cssClass": "cell-title",
    		"editor": "eval('ReportCellEditor')"
    	}, {
    		"id": "Validation",
    		"name": "Validation",
    		"field": "Validation",
    		"width": "120",
    		"sortable": "false",
    		"unselectable": "true",
    		"unfocusable": "true",
    		"cssClass": "cell-title"
    	}],
    	"rowcount": "1",
    	"source": [{
    		"Parameter": "BidId",
    		"Selection": "",
    		"DataType": "varchar",
    		"ParamMode": "IN",
    		"MaxLen": "100",
    		"RealParameter": "@BidId",
    		"Validation": ""
    	}]
    }
    Turns into this XML

    Code:
    <json>
      <object>
        <key>boottab</key>
        <array>
          <item>
            <string>"run"</string>   <------ Why retain those quotes??
          </item>
        </array>
      </object>
      <object>
        <key>operators</key>
        <array />
      </object>
      <object>
        <key>editkey</key>
        <string>"RealParameter"</string>
      </object>
      <object>
        <key>awcoptions</key>
        <object>                   <------ why OBJECT and then another OBJECT?
          <object>
            <key>nosort</key>
            <boolean>true</boolean>
          </object>
          <object>
            <key>awcdisplay</key>
            <boolean>true</boolean>
          </object>
        </object>
      </object>
      <object>
        <key>heading</key>
        <string>"Bid Activity (enter Selections below and click the RUN icon to the left)"</string>
      </object>
      <object>
        <key>tabcaption</key>
        <string>"Bid Activity"</string>
      </object>
      <object>
        <key>acs-work</key>
        <string>"slickgrid"</string>
      </object>
      <object>
        <key>options</key>
        <object>
          <object>
            <key>editable</key>
            <boolean>true</boolean>
          </object>
          <object>
            <key>enableAddRow</key>
            <boolean>false</boolean>
          </object>
          <object>
            <key>enableCellNavigation</key>
            <boolean>true</boolean>
          </object>
          <object>
            <key>asyncEditorLoading</key>
            <boolean>false</boolean>
          </object>
        </object>
      </object>
      <object>
        <key>columns</key>
        <array>
          <item>
            <object>
              <object>
                <key>id</key>
                <string>"Parameter"</string>
              </object>
              <object>
                <key>name</key>
                <string>"Display Parameters"</string>
              </object>
              <object>
                <key>field</key>
                <string>"Parameter"</string>
              </object>
              <object>
                <key>width</key>
                <string>"225"</string>
              </object>
              <object>
                <key>sortable</key>
                <string>"false"</string>
              </object>
              <object>
                <key>unselectable</key>
                <string>"true"</string>
              </object>
              <object>
                <key>unfocusable</key>
                <string>"true"</string>
              </object>
              <object>
                <key>cssClass</key>
                <string>"cell-title"</string>
              </object>
            </object>
          </item>
          <item>
            <object>
              <object>
                <key>id</key>
                <string>"Selection"</string>
              </object>
              <object>
                <key>name</key>
                <string>"Selection"</string>
              </object>
              <object>
                <key>field</key>
                <string>"Selection"</string>
              </object>
              <object>
                <key>width</key>
                <string>"225"</string>
              </object>
              <object>
                <key>sortable</key>
                <string>"false"</string>
              </object>
              <object>
                <key>cssClass</key>
                <string>"cell-title"</string>
              </object>
              <object>
                <key>editor</key>
                <string>"eval('ReportCellEditor')"</string>
              </object>
            </object>
          </item>
          <item>
            <object>
              <object>
                <key>id</key>
                <string>"Validation"</string>
              </object>
              <object>
                <key>name</key>
                <string>"Validation"</string>
              </object>
              <object>
                <key>field</key>
                <string>"Validation"</string>
              </object>
              <object>
                <key>width</key>
                <string>"120"</string>
              </object>
              <object>
                <key>sortable</key>
                <string>"false"</string>
              </object>
              <object>
                <key>unselectable</key>
                <string>"true"</string>
              </object>
              <object>
                <key>unfocusable</key>
                <string>"true"</string>
              </object>
              <object>
                <key>cssClass</key>
                <string>"cell-title"</string>
              </object>
            </object>
          </item>
        </array>
      </object>
      <object>
        <key>rowcount</key>
        <string>"1"</string>
      </object>
      <object>
        <key>source</key>
        <array>
          <item>
            <object>
              <object>
                <key>Parameter</key>
                <string>"BidId"</string>
              </object>
              <object>
                <key>Selection</key>
                <string>""</string>
              </object>
              <object>
                <key>DataType</key>
                <string>"varchar"</string>
              </object>
              <object>
                <key>ParamMode</key>
                <string>"IN"</string>
              </object>
              <object>
                <key>MaxLen</key>
                <string>"100"</string>
              </object>
              <object>
                <key>RealParameter</key>
                <string>"@BidId"</string>
              </object>
              <object>
                <key>Validation</key>
                <string>""</string>
              </object>
            </object>
          </item>
        </array>
      </object>
    </json>

    *** Read the sticky in the DB forum about how to get your question answered quickly!! ***

    Please remember to rate posts! Rate any post you find helpful - even in old threads! Use the link to the left - "Rate this Post".

    Some Informative Links:
    [ SQL Rules to Live By ] [ Reserved SQL keywords ] [ When to use INDEX HINTS! ] [ Passing Multi-item Parameters to STORED PROCEDURES ]
    [ Solution to non-domain Windows Authentication ] [ Crazy things we do to shrink log files ] [ SQL 2005 Features ] [ Loading Pictures from DB ]

    MS MVP 2006, 2007, 2008

  3. #3
    MS SQL Powerposter szlamany's Avatar
    Join Date
    Mar 2004
    Location
    Connecticut
    Posts
    18,263

    Re: JSON to XDocument converter

    This one seems to make it blow up

    Code:
    {
    	"username": "szlamany",
    	"toddtype": "misctables",
    	"choice": 0,
    	"id": "btn-misctables",
    	"objReturn": {
    		"fiscalyr": "2016",
    		"pp": "2016019",
    		"reason": "All",
    		"doctype": "Vendor"
    	},
    	"fromddtype": "misc",
    	"fromwho": "AWCMiscTables_T",
    	"newkeys": [],
    	"updkeys": [],
    	"reload": false,
    	"editkey": "RowKey",
    	"addkey": "",
    	"popupkey": "",
    	"sguid": "9b11f14b-eb5b-467a-b752-16a21d2a5bf9",
    	"extrakeys": {},
    	"source": [{
    		"MTDescription": "Acctfiles_T",
    		"MTTable": "Acctfiles_T",
    		"AllowAdds": "",
    		"SystemTable": "Y",
    		"Flag1": "x",
    		"Flag2": "",
    		"RowKey": "Acctfiles_T",
    		"awcRowDirty": "Y"
    	}]
    }

    *** Read the sticky in the DB forum about how to get your question answered quickly!! ***

    Please remember to rate posts! Rate any post you find helpful - even in old threads! Use the link to the left - "Rate this Post".

    Some Informative Links:
    [ SQL Rules to Live By ] [ Reserved SQL keywords ] [ When to use INDEX HINTS! ] [ Passing Multi-item Parameters to STORED PROCEDURES ]
    [ Solution to non-domain Windows Authentication ] [ Crazy things we do to shrink log files ] [ SQL 2005 Features ] [ Loading Pictures from DB ]

    MS MVP 2006, 2007, 2008

  4. #4

    Thread Starter
    Super Moderator dday9's Avatar
    Join Date
    Mar 2011
    Location
    South Louisiana
    Posts
    11,715

    Re: JSON to XDocument converter

    It should not have kept the double quotes in:
    Code:
    <string>"run"</string>
    I located the problem though, in my ParseValue method I am not removing the double quotes if the token is a String. I will be sure to fix that.

    However, I do not know why it adds the extra <object> tag for the object with the key awcoptions. That is very odd. I will be sure to step through the code and see what is causing it.

    As far as your 3rd post, it is because of this line:
    Code:
    "extrakeys": {}
    I did not know that you have have an object in JSON without a key/value pair. Could you confirm this and if so then I'll correct it.
    "Code is like humor. When you have to explain it, it is bad." - Cory House
    VbLessons | Code Tags | Sword of Fury - Jameram

  5. #5
    MS SQL Powerposter szlamany's Avatar
    Join Date
    Mar 2004
    Location
    Connecticut
    Posts
    18,263

    Re: JSON to XDocument converter

    Quote Originally Posted by dday9 View Post
    As far as your 3rd post, it is because of this line:
    Code:
    "extrakeys": {}
    I did not know that you have have an object in JSON without a key/value pair. Could you confirm this and if so then I'll correct it.
    That is correct. Both OBJECTS and ARRAYS (which are really objects internally in JavaScript anyway) can be EMPTY.

    These are real back and forth AJAX posts from one of my database clients. And you can always go to JSONLINT.COM to verify the JSON.

    *** Read the sticky in the DB forum about how to get your question answered quickly!! ***

    Please remember to rate posts! Rate any post you find helpful - even in old threads! Use the link to the left - "Rate this Post".

    Some Informative Links:
    [ SQL Rules to Live By ] [ Reserved SQL keywords ] [ When to use INDEX HINTS! ] [ Passing Multi-item Parameters to STORED PROCEDURES ]
    [ Solution to non-domain Windows Authentication ] [ Crazy things we do to shrink log files ] [ SQL 2005 Features ] [ Loading Pictures from DB ]

    MS MVP 2006, 2007, 2008

  6. #6
    MS SQL Powerposter szlamany's Avatar
    Join Date
    Mar 2004
    Location
    Connecticut
    Posts
    18,263

    Re: JSON to XDocument converter

    You use <JSON> as the PARENT to the initial OBJECT - and then list KVP's (key-value pairs) and put them in <Object> wrappers.

    Then you get another OBJECT you make the PARENT be another <OBJECT> and then those children KVP's appear in additional <Object> wrappers.

    Is this the reason for <OBJECT> appearing twice like that?

    *** Read the sticky in the DB forum about how to get your question answered quickly!! ***

    Please remember to rate posts! Rate any post you find helpful - even in old threads! Use the link to the left - "Rate this Post".

    Some Informative Links:
    [ SQL Rules to Live By ] [ Reserved SQL keywords ] [ When to use INDEX HINTS! ] [ Passing Multi-item Parameters to STORED PROCEDURES ]
    [ Solution to non-domain Windows Authentication ] [ Crazy things we do to shrink log files ] [ SQL 2005 Features ] [ Loading Pictures from DB ]

    MS MVP 2006, 2007, 2008

  7. #7

    Thread Starter
    Super Moderator dday9's Avatar
    Join Date
    Mar 2011
    Location
    South Louisiana
    Posts
    11,715

    Re: JSON to XDocument converter

    Alright, so I have optimized the lexical analyzer phase to not only be faster than what it previously was but I also remove the opening/closing quotes from string values.

    I have also fixed it to accept blank objects/arrays.

    The way that objects are handled is that it will create:
    Code:
    <object>
      <pair>
        <key>...</key>
        <...>...</...>
      </pair>
    </object>
    "Code is like humor. When you have to explain it, it is bad." - Cory House
    VbLessons | Code Tags | Sword of Fury - Jameram

  8. #8
    MS SQL Powerposter szlamany's Avatar
    Join Date
    Mar 2004
    Location
    Connecticut
    Posts
    18,263

    Re: JSON to XDocument converter

    If it's like a legit XML shouldn't it be

    { "test": "value" }

    Code:
    <object>
       <key name="test">value</key>
    </object>
    If you think of the railroad diagram which is JSON - the { you represent as <Object> then the next item is some arbitrary key with a name. And that key has data which is the value.

    That seems like cleaner one-to-one matching of the JSON to some XML attribute.

    As your <item>'s might also want to be <item slot="0">, then <item slot="1"> and <item slot="2"> and so on (although I'm less convinced this is proper)
    Last edited by szlamany; May 7th, 2016 at 05:24 AM.

    *** Read the sticky in the DB forum about how to get your question answered quickly!! ***

    Please remember to rate posts! Rate any post you find helpful - even in old threads! Use the link to the left - "Rate this Post".

    Some Informative Links:
    [ SQL Rules to Live By ] [ Reserved SQL keywords ] [ When to use INDEX HINTS! ] [ Passing Multi-item Parameters to STORED PROCEDURES ]
    [ Solution to non-domain Windows Authentication ] [ Crazy things we do to shrink log files ] [ SQL 2005 Features ] [ Loading Pictures from DB ]

    MS MVP 2006, 2007, 2008

  9. #9

    Thread Starter
    Super Moderator dday9's Avatar
    Join Date
    Mar 2011
    Location
    South Louisiana
    Posts
    11,715

    Re: JSON to XDocument converter

    I did change it to where it keeps the value type as the element name but it adds the key as an attribute.

    However, I did not add the slot attribute to the array. I don't think that I like that.
    "Code is like humor. When you have to explain it, it is bad." - Cory House
    VbLessons | Code Tags | Sword of Fury - Jameram

  10. #10
    MS SQL Powerposter szlamany's Avatar
    Join Date
    Mar 2004
    Location
    Connecticut
    Posts
    18,263

    Re: JSON to XDocument converter

    Sounds great.

    Check out this link - interesting read...

    http://www.json.org/fatfree.html

    *** Read the sticky in the DB forum about how to get your question answered quickly!! ***

    Please remember to rate posts! Rate any post you find helpful - even in old threads! Use the link to the left - "Rate this Post".

    Some Informative Links:
    [ SQL Rules to Live By ] [ Reserved SQL keywords ] [ When to use INDEX HINTS! ] [ Passing Multi-item Parameters to STORED PROCEDURES ]
    [ Solution to non-domain Windows Authentication ] [ Crazy things we do to shrink log files ] [ SQL 2005 Features ] [ Loading Pictures from DB ]

    MS MVP 2006, 2007, 2008

  11. #11

    Thread Starter
    Super Moderator dday9's Avatar
    Join Date
    Mar 2011
    Location
    South Louisiana
    Posts
    11,715

    Re: JSON to XDocument converter

    The following is a scannerless parser implementation of the transformer:

    Code:
    Code:
    Option Strict On
    
    Imports System
    Imports System.Collections.Generic
    Imports System.Linq
    Imports System.Text.RegularExpressions
    Imports System.Xml
    Imports System.Xml.Linq
    Public Module JSON
    	
    	Public Sub Main()
    		Console.WriteLine(Parse(Console.REadLine()))
    	ENd Sub
    
        Public Function Parse(ByVal source As String) As XDocument
            Dim d As XDocument = Nothing
            Dim t As XElement = Parse_Value(source)
    
            If t IsNot Nothing Then
                d = New XDocument(New XDeclaration("1.0", "utf-8", "yes"), t)
            End If
    
            Return d
        End Function
    
        Private Function Parse_Object(ByRef source As String) As XElement
            Dim t As XElement = Nothing
            Dim tempSource As String = source.Trim()
    
            If tempSource.Length >= 2 AndAlso tempSource.StartsWith("{") Then
                tempSource = tempSource.Remove(0, 1).Trim()
    
                If tempSource.StartsWith("}") Then
                    t = New XElement("object")
                    source = tempSource.Remove(0, 1).Trim()
                Else
                    Dim values As New List(Of XElement)
                    Dim key As XElement = Parse_String(tempSource)
                    tempSource = tempSource.Trim()
    
                    If tempSource.StartsWith(":") Then
                        tempSource = tempSource.Remove(0, 1).Trim()
    
                        Dim value As XElement = Parse_Value(tempSource)
                        If value IsNot Nothing Then
                            value.SetAttributeValue("key", key.Value)
                            values.Add(value)
                            tempSource = tempSource.Trim()
                            Do While value IsNot Nothing AndAlso tempSource.Length > 0 AndAlso Not tempSource.StartsWith("}") AndAlso tempSource.StartsWith(",")
                                tempSource = tempSource.Remove(0, 1).Trim()
                                key = Parse_String(tempSource)
                                tempSource = tempSource.Trim()
                                If tempSource.StartsWith(":") Then
                                    tempSource = tempSource.Remove(0, 1).Trim()
                                    value = Parse_Value(tempSource)
                                    If value IsNot Nothing Then
                                        value.SetAttributeValue("key", key.Value)
                                        values.Add(value)
                                        tempSource = tempSource.Trim()
                                    End If
                                End If
                            Loop
    
                            tempSource = tempSource.Trim()
                            If value IsNot Nothing AndAlso tempSource.StartsWith("}") Then
                                tempSource = tempSource.Remove(0, 1).Trim()
                                t = New XElement("object", values)
                                source = New String(tempSource.ToArray())
                            End If
                        End If
                    End If
                End If
            End If
    
            Return t
        End Function
    
        Private Function Parse_Array(ByRef source As String) As XElement
            Dim t As XElement = Nothing
            Dim tempSource As String = source.Trim()
    
            If tempSource.Length >= 2 AndAlso tempSource.StartsWith("[") Then
                tempSource = tempSource.Remove(0, 1).Trim()
    
                If tempSource.StartsWith("]") Then
                    t = New XElement("array")
                    source = tempSource.Remove(0, 1).Trim()
                Else
                    Dim values As New List(Of XElement)
                    Dim value As XElement = Parse_Value(tempSource)
    
                    If value IsNot Nothing Then
                        values.Add(value)
                        tempSource = tempSource.Trim()
                        Do While value IsNot Nothing AndAlso tempSource.Length > 0 AndAlso Not tempSource.StartsWith("]") AndAlso tempSource.StartsWith(",")
                            tempSource = tempSource.Remove(0, 1).Trim()
                            value = Parse_Value(tempSource)
                            tempSource = tempSource.Trim()
                            If value IsNot Nothing Then
                                values.Add(value)
                            End If
                        Loop
    
                        tempSource = tempSource.Trim()
                        If value IsNot Nothing AndAlso tempSource.StartsWith("]") Then
                            tempSource = tempSource.Remove(0, 1).Trim()
                            t = New XElement("array", values)
                            source = New String(tempSource.ToArray())
                        End If
                    End If
                End If
            End If
    
            Return t
        End Function
    
        Private Function Parse_Value(ByRef source As String) As XElement
            Dim t As XElement = Parse_String(source)
    
            If t Is Nothing Then
                t = Parse_Number(source)
    
                If t Is Nothing Then
                    t = Parse_Boolean(source)
    
                    If t Is Nothing Then
                        t = Parse_Array(source)
    
                        If t Is Nothing Then
                            t = Parse_Object(source)
                        End If
                    End If
                End If
            End If
    
            Return t
        End Function
    
        Private Function Parse_String(ByRef source As String) As XElement
            Dim m As Match = Regex.Match(source, """([^""\\]|\\[""\\\/bfnrt])*""")
            Dim t As XElement = Nothing
    
            If m.Success AndAlso m.Index = 0 Then
                Dim literal As String = m.Value.Remove(0, 1)
                literal = literal.Remove(literal.Length - 1)
                t = New XElement("string", literal)
                source = source.Substring(m.Value.Length)
            End If
    
            Return t
        End Function
    
        Private Function Parse_Number(ByRef source As String) As XElement
            Dim m As Match = Regex.Match(source, "-?\d+((\.\d+)?((e|E)[+-]?\d+)?)")
            Dim t As XElement = Nothing
    
            If m.Success AndAlso m.Index = 0 Then
                t = New XElement("number", m.Value)
                source = source.Substring(m.Value.Length)
            End If
    
            Return t
        End Function
    
        Private Function Parse_Boolean(ByRef source As String) As XElement
            Dim t As XElement = Nothing
    
            If source.StartsWith("true", StringComparison.OrdinalIgnoreCase) OrElse source.StartsWith("null", StringComparison.OrdinalIgnoreCase) Then
                t = New XElement("boolean", source.Substring(0, 4))
                source = source.Substring(4)
            ElseIf source.StartsWith("false", StringComparison.OrdinalIgnoreCase) Then
                t = New XElement("boolean", source.Substring(0, 5))
                source = source.Substring(5)
            End If
    
            Return t
        End Function
    
        Private Function RemoveWhitespace(ByVal value As String) As String
            Do While value.Length > 0 AndAlso String.IsNullOrWhiteSpace(value(0))
                value = value.Remove(0, 1)
            Loop
    
            Return value
        End Function
    End Module
    Fiddle: https://dotnetfiddle.net/ijk2ud

    Example:
    Code:
    {"keyString": "value", "keyNumber": 1.0, "keyBoolean": true, "keyArray": [1, 2, null], "keyObject": {"emptyArray": []}}
    
    <object>
      <string key="keyString">value</string>
      <number key="keyNumber">1.0</number>
      <boolean key="keyBoolean">true</boolean>
      <array key="keyArray">
        <number>1</number>
        <number>2</number>
        <boolean>null</boolean>
      </array>
      <object key="keyObject">
        <array key="emptyArray" />
      </object>
    </object>
    I have started a github project for the scannerless parser too: https://github.com/dday9/.NET-JSON-Transformer
    Last edited by dday9; May 25th, 2016 at 06:02 PM.
    "Code is like humor. When you have to explain it, it is bad." - Cory House
    VbLessons | Code Tags | Sword of Fury - Jameram

  12. #12

    Thread Starter
    Super Moderator dday9's Avatar
    Join Date
    Mar 2011
    Location
    South Louisiana
    Posts
    11,715

    Re: JSON to XDocument converter

    Edit made to the JSON.vb file:
    • Edited the code to make much less String manipulations since .NET strings are immutable.
    • Heavily commented the code so that it is easier for programmers to follow the logic.


    Code:
    Option Strict On
    
    Imports System
    Imports System.Collections.Generic
    Imports System.Text.RegularExpressions
    Imports System.Xml
    Imports System.Xml.Linq
    Public Module JSON
    
    	''' <summary>Converts a JSON literal into an XDocument.</summary>
    	''' <param name="literal">The JSON literal to convert.</param>
    	''' <value>XDocument</value>
    	''' <returns>XDocument of parsed JSON literal.</returns>
    	''' <remarks>Returns Nothing if the conversion fails.</remarks>
    	Public Function Parse(ByVal literal As String) As XDocument
    		If String.IsNullOrWhitespace(literal) Then Return Nothing
    
    		'Declare a document to return
    		Dim document As XDocument = Nothing
    
    		'Declare a value that will make up the document
    		Dim value As XElement = Parse_Value(literal, 0)
    		If value IsNot Nothing Then
    			document = New XDocument(New XDeclaration("1.0", "utf-8", "yes"), value)
    		End If
    
    		Return document
    	End Function
    
    	Private Function Parse_Value(ByVal source As String, ByRef index As Integer) As XElement
    		'Skip any whitespace
    		index = JSON.SkipWhitespace(source, index)
    
    		'Go through each available value until one returns something that ain't nothing
    		Dim node As XElement = JSON.Parse_Null(source, index)
    		If node Is Nothing Then
    			node = JSON.Parse_Boolean(source, index)
    			If node Is Nothing Then
    				node = JSON.Parse_Number(source, index)
    				If node Is Nothing Then
    					node = JSON.Parse_String(source, index)
    					If node Is Nothing Then
    						node = JSON.Parse_Array(source, index)
    						If node Is Nothing Then
    							node = JSON.Parse_Object(source, index)
    						End If
    					End If
    				End If
    			End If
    		End If
    
    		Return node
    	End Function
    
    	Private Function Parse_Object(ByVal source As String, ByRef index As Integer) As XElement
    		'Declare a value to return (default is Nothing)
    		Dim node As XElement = Nothing
    
    		'Match the opening curly bracket
    		If source(index) = "{"c Then	
    			'Declare collections that will make up the node's key:value
    			Dim keys,values As New List(Of XElement)
    
    			'Declare a temporary index placeholder in case the parsing fails
    			Dim tempIndex As Integer = JSON.SkipWhitespace(source, index + 1)
    
    			'Declare a String which would represent the key of key/value pair
    			Dim key As XElement = Nothing
    
    			'Declare an XElement which would represent the value of the key/value pair
    			Dim item As XElement = Nothing
    
    			'Loop until there is a closing curly bracket
    			Do While tempIndex < source.Length AndAlso source(tempIndex) <> "}"c
    				'Match a String which should be the key
    				key = Parse_String(source, tempIndex)
    
    				'Ensure that there was a valid key
    				If key IsNot Nothing Then
    					'Add the item to the collection that will ultimately represent the key of the key/value pair
    					keys.Add(key)
    
    					'Skip any whitespace
    					tempIndex = JSON.SkipWhitespace(source, tempIndex)
    
    					'Ensure a separator
    					If source(tempIndex) = ":"c Then
    						'Skip any whitespace
    						tempIndex = JSON.SkipWhitespace(source, tempIndex + 1)
    
    						item = Parse_Value(source, tempIndex)
    
    						'Ensure that there was a valid item
    						If item IsNot Nothing Then
    							'Add the item to the collection that will ultimately represent the value of the key/value pair
    							values.Add(item)
    
    							'Skip any whitespace
    							tempIndex = JSON.SkipWhitespace(source, tempIndex)
    
    							'Ensure a separator or ending bracket
    							If source(tempIndex) = ","c Then
    								tempIndex = JSON.SkipWhitespace(source, tempIndex + 1)
    							ElseIf source(tempIndex) <> ","c AndAlso source(tempIndex) <> "}"c Then
    								Throw New Exception("Unexpected token at position: " & tempIndex + 1 & ". Expected a comma to separate Object items.")
    							End If
    						Else
    							Throw New Exception("Invalid item in array at position: " & tempIndex + 1)
    						End If
    					Else
    						Throw New Exception("Unexpected token at position: " & tempIndex + 1 & ". Expected a colon to separate Array items.")
    					End If
    				Else
    					Throw New Exception("Unexpected token at position: " & tempIndex + 1 & ". Expected a String to represent the key/value pair of an Object.")
    				End If
    			Loop
    
    			'Valid parse
    			If tempIndex < source.Length AndAlso source(tempIndex) = "}"c Then
    				node = New XElement("object")
    				For i As Integer = 0 To keys.Count - 1
    					node.Add(New XElement(keys.Item(i).Value, values.Item(i)))
    				Next
    				index = tempIndex + 1
    			End If
    		End If
    		
    		Return node
    	End Function
    
    	Private Function Parse_Array(ByVal source As String, ByRef index As Integer) As XElement
    		'Declare a value to return (default is Nothing)
    		Dim node As XElement = Nothing
    
    		'Match the opening square bracket
    		If source(index) = "["c Then	
    			'Declare a collection that will make up the node's value
    			Dim nodes As List(Of XElement) = New List(Of XElement)
    
    			'Declare a temporary index placeholder in case the parsing fails
    			Dim tempIndex As Integer = JSON.SkipWhitespace(source, index + 1)
    
    			'Declare an XElement which would represent an item in the array
    			Dim item As XElement = Nothing
    
    			'Loop until there is a closing square bracket
    			Do While tempIndex < source.Length AndAlso source(tempIndex) <> "]"c
    				item = Parse_Value(source, tempIndex)
    
    				'Ensure that there was a valid item
    				If item IsNot Nothing Then
    					'Add the item to the collection that will ultimately represent the node's value
    					nodes.Add(item)
    
    					'Skip any whitespace
    					tempIndex = JSON.SkipWhitespace(source, tempIndex)
    
    					'Ensure a separator or ending bracket
    					If source(tempIndex) = ","c Then
    						tempIndex = JSON.SkipWhitespace(source, tempIndex + 1)
    					ElseIf source(tempIndex) <> ","c AndAlso source(tempIndex) <> "]"c Then
    						Throw New Exception("Unexpected token at position: " & tempIndex + 1 & ". Expected a comma to separate Array items.")
    					End If
    				Else
    					Throw New Exception("Invalid item in array at position: " & tempIndex + 1)
    				End If
    			Loop
    
    			'Valid parse
    			If tempIndex < source.Length AndAlso source(tempIndex) = "]"c Then
    				node = New XElement("array", nodes)
    				index = tempIndex + 1
    			End If
    		End If
    
    		Return node
    	End Function
    
    	Private Function Parse_String(ByVal source As String, ByRef index As Integer) As XElement
    		'Declare a value to return (default is Nothing)
    		Dim node As XElement = Nothing
    
    		'The pattern to match a number is:
    		'Double-Quote
    		'Any unicode character except for (\ or ") or an escaped character zero or more times
    		'Double-Quote
    		Dim pattern As Regex = New Regex("""([^""\\]|\\[""\\\/bfnrt])*""", RegexOptions.IgnoreCase)
    		Dim m As Match = pattern.Match(source, index)
    
    		'A match will only be valid if it matches at the beginning of the string
    		If m.Success AndAlso m.Index = index Then
    			node = New XElement("string", m.Value.Substring(1, m.Value.Length - 2))
    			index += m.Value.Length
    		End If
    
    		Return node
    	End Function
    
    	Private Function Parse_Number(ByVal source As String, ByRef index As Integer) As XElement
    		'Declare a value to return (default is Nothing)
    		Dim node As XElement = Nothing
    
    		'The pattern to match a number is:
    		'Optional unary negative
    		'0 or 1-9 followed by zero or more digits
    		'Optional mantissa followed by one or more digits
    		'Optional euler's number followed by optional unary operator followed by one or more digits
    		Dim pattern As Regex = New Regex("-?([1-9]\d*|0)(.\d+)?([eE][-+]?\d+)?")
    		Dim m As Match = pattern.Match(source, index)
    
    		'A match will only be valid if it matches at the beginning of the string
    		If m.Success AndAlso m.Index = index Then
    			node = New XElement("number", m.Value)
    			index += m.Value.Length
    		End If
    
    		Return Node
    	End Function
    
    	Private Function Parse_Boolean(ByVal source As String, ByRef index As Integer) As XElement
    		'Declare a value to return (default is Nothing)
    		Dim node As XElement = Nothing
    
    		'Literally match 'true' or 'false'
    		Dim startSubstring As String = source.Substring(index)
    
    		If startSubstring.IndexOf("true", StringComparison.OrdinalIgnoreCase) = 0 Then
    			node = New XElement("boolean", startSubstring.Substring(0, 4))
    			index += 4
    		ElseIf startSubstring.IndexOf("false", StringComparison.OrdinalIgnoreCase) = 0 Then
    			node = New XElement("boolean", startSubstring.Substring(0, 5))
    			index += 5
    		End If
    
    		Return node
    	End Function
    
    	Private Function Parse_Null(ByVal source As String, ByRef index As Integer) As XElement
    		'Declare a value to return (default is Nothing)
    		Dim node As XElement = Nothing
    
    		'Literally match 'null'
    		If source.Substring(index).IndexOf("null", StringComparison.OrdinalIgnoreCase) = 0 Then
    			node = New XElement("null")
    			index += 4
    		End If
    
    		Return node
    	End Function
    
    	Private Function SkipWhitespace(ByVal source As String, ByVal index As Integer) As Integer
    		Do While index < source.Length AndAlso Char.IsWhiteSpace(source(index))
    			index += 1
    		Loop
    		
    		Return index
    	End Function
    End Module
    Fiddle: https://dotnetfiddle.net/jlZ85u
    "Code is like humor. When you have to explain it, it is bad." - Cory House
    VbLessons | Code Tags | Sword of Fury - Jameram

  13. #13

    Thread Starter
    Super Moderator dday9's Avatar
    Join Date
    Mar 2011
    Location
    South Louisiana
    Posts
    11,715

    Re: JSON to XDocument converter

    Edit made to the JSON.vb file:
    • Replaced [string].Substring with [string].IndexOf to improve performance.
    • Removed the RegEx from Parse_Number to improve performance.


    Code:
    Public Module JSON
    
        ''' <summary>Converts a JSON literal into an XDocument.</summary>
        ''' <param name="literal">The JSON literal to convert.</param>
        ''' <returns>XDocument of parsed JSON literal.</returns>
        ''' <remarks>Returns Nothing if the conversion fails.</remarks>
        Public Function Parse(ByVal literal As String) As XDocument
            If String.IsNullOrWhiteSpace(literal) Then Return Nothing
    
            'Declare a document to return
            Dim document As XDocument = Nothing
    
            'Declare a value that will make up the document
            Dim value As XElement = Nothing
            If Parse_Value(literal, 0, value) Then
                document = New XDocument(New XDeclaration("1.0", "utf-8", "yes"), value)
            End If
    
            Return document
        End Function
    
        Private Function Parse_Value(ByVal source As String, ByRef index As Integer, ByRef value As XElement) As Boolean
            'Skip any whitespace
            index = JSON.SkipWhitespace(source, index)
    
            'Go through each available value until one returns something that ain't nothing
            If Not Parse_String(source, index, value) AndAlso
                    Not Parse_Number(source, index, value) AndAlso
                    Not Parse_Object(source, index, value) AndAlso
                    Not Parse_Array(source, index, value) AndAlso
                    Not Parse_Boolean(source, index, value) AndAlso
                    Not Parse_Null(source, index, value) Then
            End If
    
            Return value IsNot Nothing
        End Function
    
        Private Function Parse_Object(ByVal source As String, ByRef index As Integer, ByRef value As XElement) As Boolean
            'Match the opening curly bracket
            If source(index) = "{"c Then
                'Declare collections that will make up the node's key:value
                Dim keys, values As New List(Of XElement)
    
                'Declare a temporary index placeholder in case the parsing fails
                Dim tempIndex As Integer = JSON.SkipWhitespace(source, index + 1)
    
                'Declare a String which would represent the key of key/value pair
                Dim key As XElement = Nothing
    
                'Declare an XElement which would represent the value of the key/value pair
                Dim item As XElement = Nothing
    
                'Loop until there is a closing curly bracket
                Do While tempIndex < source.Length AndAlso source(tempIndex) <> "}"c
                    'Reset the key
                    key = Nothing
    
                    'Match a String which should be the key
                    If Parse_String(source, tempIndex, key) Then
                        'Add the item to the collection that will ultimately represent the key of the key/value pair
                        keys.Add(key)
    
                        'Skip any whitespace
                        tempIndex = JSON.SkipWhitespace(source, tempIndex)
    
                        'Ensure a separator
                        If source(tempIndex) = ":"c Then
                            'Skip any whitespace
                            tempIndex = JSON.SkipWhitespace(source, tempIndex + 1)
    
                            'Reset the value
                            item = Nothing
    
                            If Parse_Value(source, tempIndex, item) Then
                                'Add the item to the collection that will ultimately represent the value of the key/value pair
                                values.Add(item)
    
                                'Skip any whitespace
                                tempIndex = JSON.SkipWhitespace(source, tempIndex)
    
                                'Ensure a separator or ending bracket
                                If source(tempIndex) = ","c Then
                                    tempIndex = JSON.SkipWhitespace(source, tempIndex + 1)
                                ElseIf source(tempIndex) <> "}"c Then
                                    Return False
                                End If
                            Else
                                Return False
                            End If
                        Else
                            Return False
                        End If
                    End If
    
                Loop
    
                'Valid parse
                If tempIndex < source.Length AndAlso source(tempIndex) = "}"c Then
                    value = New XElement("object")
                    For i As Integer = 0 To keys.Count - 1
                        value.Add(New XElement(keys.Item(i).Value, values.Item(i)))
                    Next
                    index = tempIndex + 1
                End If
            End If
    
            Return value IsNot Nothing
        End Function
    
        Private Function Parse_Array(ByVal source As String, ByRef index As Integer, ByRef value As XElement) As Boolean
            'Match the opening square bracket
            If source(index) = "["c Then
                'Declare a collection that will make up the node's value
                Dim nodes As List(Of XElement) = New List(Of XElement)
    
                'Declare a temporary index placeholder in case the parsing fails
                Dim tempIndex As Integer = JSON.SkipWhitespace(source, index + 1)
    
                'Declare an XElement which would represent an item in the array
                Dim item As XElement = Nothing
    
                'Loop until there is a closing square bracket
                Do While tempIndex < source.Length AndAlso source(tempIndex) <> "]"c
                    'Reset the value
                    item = Nothing
    
                    If Parse_Value(source, tempIndex, item) Then
                        'Add the item to the collection that will ultimately represent the node's value
                        nodes.Add(item)
    
                        'Skip any whitespace
                        tempIndex = JSON.SkipWhitespace(source, tempIndex)
    
                        'Ensure a separator or ending bracket
                        If source(tempIndex) = ","c Then
                            tempIndex = JSON.SkipWhitespace(source, tempIndex + 1)
                        ElseIf source(tempIndex) <> "]"c Then
                            Return False
                        End If
                    Else
                        Return False
                    End If
                Loop
    
                'Valid parse
                If tempIndex < source.Length AndAlso source(tempIndex) = "]"c Then
                    value = New XElement("array", nodes)
                    index = tempIndex + 1
                End If
            End If
    
            Return value IsNot Nothing
        End Function
    
        Private Function Parse_String(ByVal source As String, ByRef index As Integer, ByRef value As XElement) As Boolean
            'The pattern to match a number is:
            'Double-Quote
            'Any unicode character except for (\ or ") or an escaped character zero or more times
            'Double-Quote
            Dim pattern As Regex = New Regex("""([^""\\]|\\[""\\\/bfnrt])*""", RegexOptions.IgnoreCase)
            Dim m As Match = pattern.Match(source, index)
    
            'A match will only be valid if it matches at the beginning of the string
            If m.Success AndAlso m.Index = index Then
                value = New XElement("string", m.Value.Substring(1, m.Value.Length - 2))
                index += m.Value.Length
            End If
    
            Return value IsNot Nothing
        End Function
    
        Private Function Parse_Number(ByVal source As String, ByRef index As Integer, ByRef value As XElement) As Boolean
            'Get the current culture information
            Dim culture As Globalization.CultureInfo = Globalization.CultureInfo.CurrentCulture
    
            'Declare a temporary placeholder
            Dim temp_index As Integer = index
    
            'Check for the optional unary operator
            If source.IndexOf(culture.NumberFormat.NegativeSign, temp_index, StringComparison.OrdinalIgnoreCase) = temp_index OrElse
                source.IndexOf(culture.NumberFormat.PositiveSign, temp_index, StringComparison.OrdinalIgnoreCase) = temp_index Then
                temp_index += 1
            End If
    
            'Match one or more digits
            If temp_index < source.Length AndAlso Char.IsDigit(source(temp_index)) Then
                Do While temp_index < source.Length AndAlso Char.IsDigit(source(temp_index))
                    temp_index += 1
                Loop
            Else
                Return False
            End If
    
            'Optionally match a mantissa followed by one or more digits
            If temp_index + 1 < source.Length AndAlso
                source.IndexOf(culture.NumberFormat.NumberDecimalSeparator, temp_index, StringComparison.OrdinalIgnoreCase) = temp_index AndAlso
                Char.IsDigit(source(temp_index + 1)) Then
    
                temp_index += 1
                Do While temp_index < source.Length AndAlso Char.IsDigit(source(temp_index))
                    temp_index += 1
                Loop
            End If
    
            'Optionally match an exponent, followed by an optional unary operator, followed by 1 or more digits
            If temp_index + 1 < source.Length AndAlso
                source.IndexOf("e", temp_index, StringComparison.OrdinalIgnoreCase) = temp_index Then
    
                If temp_index + 2 < source.Length AndAlso
                    (source.IndexOf(culture.NumberFormat.NegativeSign, temp_index + 1, StringComparison.OrdinalIgnoreCase) = temp_index + 1 OrElse
                    source.IndexOf(culture.NumberFormat.PositiveSign, temp_index + 1, StringComparison.OrdinalIgnoreCase) = temp_index + 1) AndAlso
                    Char.IsDigit(source(temp_index + 2)) Then
    
                    temp_index += 2
                    Do While temp_index < source.Length AndAlso Char.IsDigit(source(temp_index))
                        temp_index += 1
                    Loop
                ElseIf temp_index + 1 < source.Length AndAlso Char.IsDigit(source(temp_index + 1)) Then
                    temp_index += 1
                    Do While temp_index < source.Length AndAlso Char.IsDigit(source(temp_index))
                        temp_index += 1
                    Loop
                End If
            End If
    
            'Convert everything up to the index
            value = New XElement("number", source.Substring(index, temp_index - index))
            index = temp_index
    
            Return value IsNot Nothing
        End Function
    
        Private Function Parse_Boolean(ByVal source As String, ByRef index As Integer, ByRef value As XElement) As Boolean
            'Literally match 'true' or 'false'
            If source.IndexOf("true", index, StringComparison.OrdinalIgnoreCase) = index Then
                value = New XElement("boolean", True)
                index += 4
            ElseIf source.IndexOf("false", index, StringComparison.OrdinalIgnoreCase) = index Then
                value = New XElement("boolean", False)
                index += 5
            End If
    
            Return value IsNot Nothing
        End Function
    
        Private Function Parse_Null(ByVal source As String, ByRef index As Integer, ByRef value As XElement) As Boolean
            'Literally match 'null' in the source starting at the index
            If source.IndexOf("null", index, StringComparison.OrdinalIgnoreCase) = index Then
                value = New XElement("null")
                index += 4
            End If
    
            Return value IsNot Nothing
        End Function
    
        Private Function SkipWhitespace(ByVal source As String, ByVal index As Integer) As Integer
            Do While index < source.Length AndAlso Char.IsWhiteSpace(source(index))
                index += 1
            Loop
    
            Return index
        End Function
    End Module
    Fiddle: https://dotnetfiddle.net/Gui2tq
    "Code is like humor. When you have to explain it, it is bad." - Cory House
    VbLessons | Code Tags | Sword of Fury - Jameram

  14. #14

    Thread Starter
    Super Moderator dday9's Avatar
    Join Date
    Mar 2011
    Location
    South Louisiana
    Posts
    11,715

    Re: JSON to XDocument converter

    Edit made to the JSON.vb file:
    • Removed the RegEx from Parse_String to improve performance.
    • Methods return an XElement rather than a Boolean which in turn removes the ByRef parameter


    Code:
    Public Module JSON
    
        Public Function Parse(ByVal source As String) As XDocument
            'Remove any whitespace
            source = source.Trim()
            If String.IsNullOrWhiteSpace(source) Then Return Nothing
    
            'Declare a document to return
            Dim document As XDocument = Nothing
    
            'Declare a value that will make up the document
            Dim value As XElement = Parse_Value(source, 0)
            If value IsNot Nothing Then
                document = New XDocument(New XDeclaration("1.0", "utf-8", "yes"), value)
            End If
    
            Return document
        End Function
    
        Private Function Parse_Value(ByVal source As String, ByRef index As Integer) As XElement
            'Declare a value to return
            Dim value As XElement = Nothing
    
            'Declare a temporary placeholder and skip any whitespace
            Dim temp_index As Integer = SkipWhitespace(source, index)
    
            'Go through each available value until one returns something that isn't null
            value = Parse_Object(source, temp_index)
            If value Is Nothing Then
                value = Parse_Array(source, temp_index)
                If value Is Nothing Then
                    value = Parse_String(source, temp_index)
                    If value Is Nothing Then
                        value = Parse_Number(source, temp_index)
                        If value Is Nothing Then
                            value = Parse_Boolean(source, temp_index)
                            If value Is Nothing Then
                                value = Parse_Null(source, temp_index)
                            End If
                        End If
                    End If
                End If
            End If
    
            'Change the index
            index = temp_index
    
            'Return the value
            Return value
        End Function
    
        Private Function Parse_Object(ByVal source As String, ByRef index As Integer) As XElement
            'Declare a value to return
            Dim value As XElement = Nothing
    
            'Declare a temporary placeholder
            Dim temp_index As Integer = index
    
            'Check for the starting opening curly bracket
            If source(temp_index).Equals("{"c) Then
                'Increment the index
                temp_index += 1
    
                'Declare a collection that will make up the nodes' value
                Dim nodes As List(Of Tuple(Of String, XElement)) = New List(Of Tuple(Of String, XElement))
    
                'Declare an XElement to store the key (aka - name) of the KeyValuePair
                Dim key As XElement = Nothing
    
                'Declare an XElement which will represent the value of the KeyValuePair
                Dim item As XElement = Nothing
    
                'Loop until we've reached the end of the source or until we've hit the ending bracket
                Do While temp_index < source.Length AndAlso Not source(temp_index).Equals("}"c)
                    'Attempt to parse the String
                    key = Parse_String(source, temp_index)
    
                    'Check if the parse was successful
                    If key Is Nothing Then
                        Throw New Exception($"Expected a String instead of a '{source(temp_index)}' at position: {temp_index}.")
                    Else
                        'Skip any unneeded whitespace
                        temp_index = SkipWhitespace(source, temp_index)
    
                        If temp_index < source.Length Then
                            'Check if the currently iterated character is a object separator ':'
                            If source(temp_index) = ":"c Then
                                'Increment the index and skip any unneeded whitespace
                                temp_index = SkipWhitespace(source, temp_index + 1)
    
                                If temp_index < source.Length Then
                                    'Assign the item to the parsed value
                                    item = Parse_Value(source, temp_index)
    
                                    'Check if the parse was successful
                                    If item Is Nothing Then
                                        Throw New Exception($"Unexpected character '{source(temp_index)}' at position: {temp_index}.")
                                    Else
                                        'Add the item to the collection
                                        nodes.Add(New Tuple(Of String, XElement)(key.Value, item))
    
                                        'Skip any unneeded whitespace
                                        temp_index = SkipWhitespace(source, temp_index)
    
                                        'Check if we can continue
                                        If temp_index < source.Length Then
                                            'Check if the currently iterated character is either a item separator (comma) or ending curly bracket
                                            If source(temp_index).Equals(","c) Then
                                                'Increment the index and skip any unneeded whitespace
                                                temp_index = SkipWhitespace(source, temp_index + 1)
                                            ElseIf source(temp_index) <> "}"c Then
                                                Throw New Exception($"Expected a ',' instead of a '{source(temp_index)}' at position: {temp_index}.")
                                            End If
                                        End If
                                    End If
                                Else
                                    Throw New Exception("Expected an Object, Array, String, Number, Boolean, or Null instead I reached the end of the source code.")
                                End If
                            Else
                                Throw New Exception($"Expected a ':' instead of a '{source(temp_index)}' at position: {temp_index}.")
                            End If
                        Else
                            Throw New Exception("Expected a ',' instead I reached the end of the source code.")
                        End If
                    End If
                Loop
    
                'Check if the currently iterated value is an ending curly bracket
                If temp_index < source.Length AndAlso source(temp_index) = "}"c Then
                    'Increment the index
                    temp_index += 1
    
                    'Set the new index
                    index = temp_index
    
                    'Create the Object
                    value = New XElement("object")
    
                    'Iterate through each item in the nodes
                    For Each n As Tuple(Of String, XElement) In nodes
                        'Set the name attribute and then add the element to the Object
                        n.Item2.SetAttributeValue("name", n.Item1)
                        value.Add(n.Item2)
                    Next
                End If
            End If
    
            'Return the value
            Return value
        End Function
    
        Private Function Parse_Array(ByVal source As String, ByRef index As Integer) As XElement
            'Declare a value to return
            Dim value As XElement = Nothing
    
            'Declare a temporary placeholder
            Dim temp_index As Integer = index
    
            'Check for the starting opening bracket
            If source(temp_index).Equals("["c) Then
                'Increment the index
                temp_index += 1
    
                'Declare a collection that will make up the nodes' value
                Dim nodes As List(Of XElement) = New List(Of XElement)
    
                'Declare an XElement which will represent the currently iterated item in the array
                Dim item As XElement = Nothing
    
                'Loop until we've reached the end of the source or until we've hit the ending bracket
                Do While temp_index < source.Length AndAlso Not source(temp_index).Equals("]"c)
                    'Assign the item to the parsed value
                    item = Parse_Value(source, temp_index)
    
                    'Check if the parse was successful
                    If item Is Nothing Then
                        Throw New Exception($"Unexpected character '{source(temp_index)}' at position: {temp_index}.")
                    Else
                        'Add the item to the collection
                        nodes.Add(item)
    
                        'Skip any unneeded whitespace
                        temp_index = SkipWhitespace(source, temp_index)
    
                        'Check if we can continue
                        If temp_index < source.Length Then
                            'Check if the currently iterated character is either a item separator (comma) or ending bracket
                            If source(temp_index).Equals(","c) Then
                                'Increment the index and skip any unneeded whitespace
                                temp_index = SkipWhitespace(source, temp_index + 1)
                            ElseIf source(temp_index) <> "]"c Then
                                Throw New Exception($"Expected a ',' instead of a '{source(temp_index)}' at position: {temp_index}.")
                            End If
                        End If
                    End If
                Loop
    
                'Check if the currently iterated value is an ending bracket
                If temp_index < source.Length AndAlso source(temp_index) = "]"c Then
                    'Increment the index
                    temp_index += 1
    
                    'Set the new index
                    index = temp_index
    
                    'Create the Array
                    value = New XElement("array", nodes)
                End If
            End If
    
            Return value
        End Function
    
        Private Function Parse_String(ByVal source As String, ByRef index As Integer) As XElement
            'Declare a value to return
            Dim value As XElement = Nothing
    
            'Declare a CONST to store the double-quote character and escaped characters
            Const double_quote As Char = """"c
            Const escaped_characters As String = double_quote & "\/bfnrt"
    
            'Declare a temporary placeholder
            Dim temp_index As Integer = index
    
            'Check for the starting double-quote
            If source(temp_index).Equals(double_quote) Then
                'Increment the index
                temp_index += 1
    
                'Loop until we've reached the end of the source or until we've hit the ending double-quote
                Do While temp_index < source.Length AndAlso Not source(temp_index).Equals(double_quote)
                    'Check if we're at an escaped character
                    If source(temp_index) = "\"c AndAlso
                        temp_index + 1 < source.Length AndAlso
                        escaped_characters.IndexOf(source(temp_index + 1)) <> -1 Then
                        temp_index += 1
                    ElseIf source(temp_index) = "\"c Then
                        Throw New Exception("Unescaped backslash in a String. Position: " & index)
                    End If
    
                    'Increment the index
                    temp_index += 1
                Loop
    
                'Check if the currently iterated character is a double-quote
                If temp_index < source.Length AndAlso source(temp_index).Equals(double_quote) Then
                    'Increment the index
                    temp_index += 1
    
                    'Create the String
                    value = New XElement("string", source.Substring(index + 1, temp_index - index - 2))
    
                    'Set the new index
                    index = temp_index
                End If
            End If
    
            Return value
        End Function
    
        Private Function Parse_Number(ByVal source As String, ByRef index As Integer) As XElement
            'Get the current culture information
            Dim culture As Globalization.CultureInfo = Globalization.CultureInfo.CurrentCulture
    
            'Declare a temporary placeholder
            Dim temp_index As Integer = index
    
            'Check for the optional unary operator
            If source.IndexOf(culture.NumberFormat.NegativeSign, temp_index, StringComparison.OrdinalIgnoreCase) = temp_index OrElse
                source.IndexOf(culture.NumberFormat.PositiveSign, temp_index, StringComparison.OrdinalIgnoreCase) = temp_index Then
                temp_index += 1
            End If
    
            'Match one or more digits
            If temp_index < source.Length AndAlso Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index).ToString()) <> -1 Then
                Do While temp_index < source.Length AndAlso Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index).ToString()) <> -1
                    temp_index += 1
                Loop
            Else
                Return Nothing
            End If
    
            'Optionally match a decimal separator followed by one or more digits
            If temp_index + 1 < source.Length AndAlso
                source.IndexOf(culture.NumberFormat.NumberDecimalSeparator, temp_index, StringComparison.OrdinalIgnoreCase) = temp_index AndAlso
                Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index + 1).ToString()) <> -1 Then
    
                temp_index += 1
                Do While temp_index < source.Length AndAlso Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index).ToString()) <> -1
                    temp_index += 1
                Loop
            End If
    
            'Optionally match an exponent, followed by an optional unary operator, followed by 1 or more digits
            If temp_index + 1 < source.Length AndAlso
                source.IndexOf("e", temp_index, StringComparison.OrdinalIgnoreCase) = temp_index Then
    
                If temp_index + 2 < source.Length AndAlso
                    (source.IndexOf(culture.NumberFormat.NegativeSign, temp_index + 1, StringComparison.OrdinalIgnoreCase) = temp_index + 1 OrElse
                    source.IndexOf(culture.NumberFormat.PositiveSign, temp_index + 1, StringComparison.OrdinalIgnoreCase) = temp_index + 1) AndAlso
                    Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index + 2).ToString()) <> -1 Then
                    temp_index += 2
                ElseIf temp_index + 1 < source.Length AndAlso Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index + 1).ToString()) <> -1 Then
                    temp_index += 1
                End If
    
                Do While temp_index < source.Length AndAlso Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index).ToString()) <> -1
                    temp_index += 1
                Loop
            End If
    
            'Create the number
            Dim value As XElement = New XElement("number", source.Substring(index, temp_index - index))
            index = temp_index
    
            Return value
        End Function
    
        Private Function Parse_Boolean(ByVal source As String, ByRef index As Integer) As XElement
            Dim value As XElement = Nothing
    
            'Literally match 'true' or 'false'
            If source.IndexOf("true", index, StringComparison.OrdinalIgnoreCase) = index Then
                value = New XElement("boolean", True)
                index += 4
            ElseIf source.IndexOf("false", index, StringComparison.OrdinalIgnoreCase) = index Then
                value = New XElement("boolean", False)
                index += 5
            End If
    
            Return value
        End Function
    
        Private Function Parse_Null(ByVal source As String, ByRef index As Integer) As XElement
            Dim value As XElement = Nothing
    
            'Literally match 'null' in the source starting at the index
            If source.IndexOf("null", index, StringComparison.OrdinalIgnoreCase) = index Then
                value = New XElement("null")
                index += 4
            End If
    
            Return value
        End Function
    
        Private Function SkipWhitespace(ByVal source As String, ByVal index As Integer) As Integer
            Do While index < source.Length AndAlso Char.IsWhiteSpace(source(index))
                index += 1
            Loop
    
            Return index
        End Function
    
    End Module
    Fiddle: https://dotnetfiddle.net/G707RC
    "Code is like humor. When you have to explain it, it is bad." - Cory House
    VbLessons | Code Tags | Sword of Fury - Jameram

  15. #15

    Thread Starter
    Super Moderator dday9's Avatar
    Join Date
    Mar 2011
    Location
    South Louisiana
    Posts
    11,715

    Re: JSON to XDocument converter

    Edit made to the JSON.vb file:
    • Removed the RegEx from Parse_String to improve performance.
    • Methods return an XElement rather than a Boolean which in turn removes the ByRef parameter


    Code:
    Public Module JSON
    
        Public Function Parse(ByVal source As String) As XDocument
            'Remove any whitespace
            source = source.Trim()
            If String.IsNullOrWhiteSpace(source) Then Return Nothing
    
            'Declare a document to return
            Dim document As XDocument = Nothing
    
            'Declare a value that will make up the document
            Dim value As XElement = Parse_Value(source, 0)
            If value IsNot Nothing Then
                document = New XDocument(New XDeclaration("1.0", "utf-8", "yes"), value)
            End If
    
            Return document
        End Function
    
        Private Function Parse_Value(ByVal source As String, ByRef index As Integer) As XElement
            'Declare a value to return
            Dim value As XElement = Nothing
    
            'Declare a temporary placeholder and skip any whitespace
            Dim temp_index As Integer = SkipWhitespace(source, index)
    
            'Go through each available value until one returns something that isn't null
            value = Parse_Object(source, temp_index)
            If value Is Nothing Then
                value = Parse_Array(source, temp_index)
                If value Is Nothing Then
                    value = Parse_String(source, temp_index)
                    If value Is Nothing Then
                        value = Parse_Number(source, temp_index)
                        If value Is Nothing Then
                            value = Parse_Boolean(source, temp_index)
                            If value Is Nothing Then
                                value = Parse_Null(source, temp_index)
                            End If
                        End If
                    End If
                End If
            End If
    
            'Change the index
            index = temp_index
    
            'Return the value
            Return value
        End Function
    
        Private Function Parse_Object(ByVal source As String, ByRef index As Integer) As XElement
            'Declare a value to return
            Dim value As XElement = Nothing
    
            'Declare a temporary placeholder
            Dim temp_index As Integer = index
    
            'Check for the starting opening curly bracket
            If source(temp_index).Equals("{"c) Then
                'Increment the index
                temp_index += 1
    
                'Declare a collection that will make up the nodes' value
                Dim nodes As List(Of Tuple(Of String, XElement)) = New List(Of Tuple(Of String, XElement))
    
                'Declare an XElement to store the key (aka - name) of the KeyValuePair
                Dim key As XElement = Nothing
    
                'Declare an XElement which will represent the value of the KeyValuePair
                Dim item As XElement = Nothing
    
                'Loop until we've reached the end of the source or until we've hit the ending bracket
                Do While temp_index < source.Length AndAlso Not source(temp_index).Equals("}"c)
                    'Attempt to parse the String
                    key = Parse_String(source, temp_index)
    
                    'Check if the parse was successful
                    If key Is Nothing Then
                        Throw New Exception($"Expected a String instead of a '{source(temp_index)}' at position: {temp_index}.")
                    Else
                        'Skip any unneeded whitespace
                        temp_index = SkipWhitespace(source, temp_index)
    
                        If temp_index < source.Length Then
                            'Check if the currently iterated character is a object separator ':'
                            If source(temp_index) = ":"c Then
                                'Increment the index and skip any unneeded whitespace
                                temp_index = SkipWhitespace(source, temp_index + 1)
    
                                If temp_index < source.Length Then
                                    'Assign the item to the parsed value
                                    item = Parse_Value(source, temp_index)
    
                                    'Check if the parse was successful
                                    If item Is Nothing Then
                                        Throw New Exception($"Unexpected character '{source(temp_index)}' at position: {temp_index}.")
                                    Else
                                        'Add the item to the collection
                                        nodes.Add(New Tuple(Of String, XElement)(key.Value, item))
    
                                        'Skip any unneeded whitespace
                                        temp_index = SkipWhitespace(source, temp_index)
    
                                        'Check if we can continue
                                        If temp_index < source.Length Then
                                            'Check if the currently iterated character is either a item separator (comma) or ending curly bracket
                                            If source(temp_index).Equals(","c) Then
                                                'Increment the index and skip any unneeded whitespace
                                                temp_index = SkipWhitespace(source, temp_index + 1)
                                            ElseIf source(temp_index) <> "}"c Then
                                                Throw New Exception($"Expected a ',' instead of a '{source(temp_index)}' at position: {temp_index}.")
                                            End If
                                        End If
                                    End If
                                Else
                                    Throw New Exception("Expected an Object, Array, String, Number, Boolean, or Null instead I reached the end of the source code.")
                                End If
                            Else
                                Throw New Exception($"Expected a ':' instead of a '{source(temp_index)}' at position: {temp_index}.")
                            End If
                        Else
                            Throw New Exception("Expected a ',' instead I reached the end of the source code.")
                        End If
                    End If
                Loop
    
                'Check if the currently iterated value is an ending curly bracket
                If temp_index < source.Length AndAlso source(temp_index) = "}"c Then
                    'Increment the index
                    temp_index += 1
    
                    'Set the new index
                    index = temp_index
    
                    'Create the Object
                    value = New XElement("object")
    
                    'Iterate through each item in the nodes
                    For Each n As Tuple(Of String, XElement) In nodes
                        'Set the name attribute and then add the element to the Object
                        n.Item2.SetAttributeValue("name", n.Item1)
                        value.Add(n.Item2)
                    Next
                End If
            End If
    
            'Return the value
            Return value
        End Function
    
        Private Function Parse_Array(ByVal source As String, ByRef index As Integer) As XElement
            'Declare a value to return
            Dim value As XElement = Nothing
    
            'Declare a temporary placeholder
            Dim temp_index As Integer = index
    
            'Check for the starting opening bracket
            If source(temp_index).Equals("["c) Then
                'Increment the index
                temp_index += 1
    
                'Declare a collection that will make up the nodes' value
                Dim nodes As List(Of XElement) = New List(Of XElement)
    
                'Declare an XElement which will represent the currently iterated item in the array
                Dim item As XElement = Nothing
    
                'Loop until we've reached the end of the source or until we've hit the ending bracket
                Do While temp_index < source.Length AndAlso Not source(temp_index).Equals("]"c)
                    'Assign the item to the parsed value
                    item = Parse_Value(source, temp_index)
    
                    'Check if the parse was successful
                    If item Is Nothing Then
                        Throw New Exception($"Unexpected character '{source(temp_index)}' at position: {temp_index}.")
                    Else
                        'Add the item to the collection
                        nodes.Add(item)
    
                        'Skip any unneeded whitespace
                        temp_index = SkipWhitespace(source, temp_index)
    
                        'Check if we can continue
                        If temp_index < source.Length Then
                            'Check if the currently iterated character is either a item separator (comma) or ending bracket
                            If source(temp_index).Equals(","c) Then
                                'Increment the index and skip any unneeded whitespace
                                temp_index = SkipWhitespace(source, temp_index + 1)
                            ElseIf source(temp_index) <> "]"c Then
                                Throw New Exception($"Expected a ',' instead of a '{source(temp_index)}' at position: {temp_index}.")
                            End If
                        End If
                    End If
                Loop
    
                'Check if the currently iterated value is an ending bracket
                If temp_index < source.Length AndAlso source(temp_index) = "]"c Then
                    'Increment the index
                    temp_index += 1
    
                    'Set the new index
                    index = temp_index
    
                    'Create the Array
                    value = New XElement("array", nodes)
                End If
            End If
    
            Return value
        End Function
    
        Private Function Parse_String(ByVal source As String, ByRef index As Integer) As XElement
            'Declare a value to return
            Dim value As XElement = Nothing
    
            'Declare a CONST to store the double-quote character and escaped characters
            Const double_quote As Char = """"c
            Const escaped_characters As String = double_quote & "\/bfnrt"
    
            'Declare a temporary placeholder
            Dim temp_index As Integer = index
    
            'Check for the starting double-quote
            If source(temp_index).Equals(double_quote) Then
                'Increment the index
                temp_index += 1
    
                'Loop until we've reached the end of the source or until we've hit the ending double-quote
                Do While temp_index < source.Length AndAlso Not source(temp_index).Equals(double_quote)
                    'Check if we're at an escaped character
                    If source(temp_index) = "\"c AndAlso
                        temp_index + 1 < source.Length AndAlso
                        escaped_characters.IndexOf(source(temp_index + 1)) <> -1 Then
                        temp_index += 1
                    ElseIf source(temp_index) = "\"c Then
                        Throw New Exception("Unescaped backslash in a String. Position: " & index)
                    End If
    
                    'Increment the index
                    temp_index += 1
                Loop
    
                'Check if the currently iterated character is a double-quote
                If temp_index < source.Length AndAlso source(temp_index).Equals(double_quote) Then
                    'Increment the index
                    temp_index += 1
    
                    'Create the String
                    value = New XElement("string", source.Substring(index + 1, temp_index - index - 2))
    
                    'Set the new index
                    index = temp_index
                End If
            End If
    
            Return value
        End Function
    
        Private Function Parse_Number(ByVal source As String, ByRef index As Integer) As XElement
            'Get the current culture information
            Dim culture As Globalization.CultureInfo = Globalization.CultureInfo.CurrentCulture
    
            'Declare a temporary placeholder
            Dim temp_index As Integer = index
    
            'Check for the optional unary operator
            If source.IndexOf(culture.NumberFormat.NegativeSign, temp_index, StringComparison.OrdinalIgnoreCase) = temp_index OrElse
                source.IndexOf(culture.NumberFormat.PositiveSign, temp_index, StringComparison.OrdinalIgnoreCase) = temp_index Then
                temp_index += 1
            End If
    
            'Match one or more digits
            If temp_index < source.Length AndAlso Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index).ToString()) <> -1 Then
                Do While temp_index < source.Length AndAlso Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index).ToString()) <> -1
                    temp_index += 1
                Loop
            Else
                Return Nothing
            End If
    
            'Optionally match a decimal separator followed by one or more digits
            If temp_index + 1 < source.Length AndAlso
                source.IndexOf(culture.NumberFormat.NumberDecimalSeparator, temp_index, StringComparison.OrdinalIgnoreCase) = temp_index AndAlso
                Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index + 1).ToString()) <> -1 Then
    
                temp_index += 1
                Do While temp_index < source.Length AndAlso Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index).ToString()) <> -1
                    temp_index += 1
                Loop
            End If
    
            'Optionally match an exponent, followed by an optional unary operator, followed by 1 or more digits
            If temp_index + 1 < source.Length AndAlso
                source.IndexOf("e", temp_index, StringComparison.OrdinalIgnoreCase) = temp_index Then
    
                If temp_index + 2 < source.Length AndAlso
                    (source.IndexOf(culture.NumberFormat.NegativeSign, temp_index + 1, StringComparison.OrdinalIgnoreCase) = temp_index + 1 OrElse
                    source.IndexOf(culture.NumberFormat.PositiveSign, temp_index + 1, StringComparison.OrdinalIgnoreCase) = temp_index + 1) AndAlso
                    Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index + 2).ToString()) <> -1 Then
                    temp_index += 2
                ElseIf temp_index + 1 < source.Length AndAlso Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index + 1).ToString()) <> -1 Then
                    temp_index += 1
                End If
    
                Do While temp_index < source.Length AndAlso Array.IndexOf(culture.NumberFormat.NativeDigits, source(temp_index).ToString()) <> -1
                    temp_index += 1
                Loop
            End If
    
            'Create the number
            Dim value As XElement = New XElement("number", source.Substring(index, temp_index - index))
            index = temp_index
    
            Return value
        End Function
    
        Private Function Parse_Boolean(ByVal source As String, ByRef index As Integer) As XElement
            Dim value As XElement = Nothing
    
            'Literally match 'true' or 'false'
            If source.IndexOf("true", index, StringComparison.OrdinalIgnoreCase) = index Then
                value = New XElement("boolean", True)
                index += 4
            ElseIf source.IndexOf("false", index, StringComparison.OrdinalIgnoreCase) = index Then
                value = New XElement("boolean", False)
                index += 5
            End If
    
            Return value
        End Function
    
        Private Function Parse_Null(ByVal source As String, ByRef index As Integer) As XElement
            Dim value As XElement = Nothing
    
            'Literally match 'null' in the source starting at the index
            If source.IndexOf("null", index, StringComparison.OrdinalIgnoreCase) = index Then
                value = New XElement("null")
                index += 4
            End If
    
            Return value
        End Function
    
        Private Function SkipWhitespace(ByVal source As String, ByVal index As Integer) As Integer
            Do While index < source.Length AndAlso Char.IsWhiteSpace(source(index))
                index += 1
            Loop
    
            Return index
        End Function
    
    End Module
    Fiddle: https://dotnetfiddle.net/G707RC
    "Code is like humor. When you have to explain it, it is bad." - Cory House
    VbLessons | Code Tags | Sword of Fury - Jameram

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width