Results 1 to 40 of 40

Thread: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

  1. #1

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    mdJson.bas (github too) is an x64 and 32-bit implementation of JSON parsing/dumping functions that are using instances of built-in VBA.Collection to represent both composite JSON objects and arrays. The module allows to switch to alternative internal representation using Scripting.Dictionary for the JSON objects/arrays although these usually require more memory and are slower for data above certain size.

    To remain agnostic to this dual internal representation the module implements an accessor property JsonValue for getting and modifying JSON object properties (e.g. JsonValue(oJson, "path/to/key") = 42) and JsonKeys to enumerate JSON object keys (this works for arrays too).

    JsonValue can be used with "wildcard" accessor expression like this vArray = JsonValue(oJson, "receiver/phones/*/number") to return array of numbers from all entries in the phones JSON array.

    JsonValue and JsonKeys support JSON Path expressions too (except some advanced features like deep scan, array slices and functions). More info on JSON Path Expressions (SQL Server) too.

    JSON Path expressions can use the dot–notation

    JsonValue(oJson, "$.store.book[0].title")


    or the bracket–notation

    JsonValue(oJson, "$['store']['book'][0]['title']")


    Another set of helper functions are JsonTo/FromXmlDocument which as the names suggest can be used to transcode to/from XML (e.g. when accessing SOAP services).

    Code:
    '--- mdJson.bas
    Option Explicit
    DefObj A-Z
    Private Const MODULE_NAME As String = "mdJson"
    
    #Const ImplScripting = JSON_USE_SCRIPTING <> 0
    #Const ImplUseShared = DebugMode <> 0
    
    #Const HasPtrSafe = (VBA7 <> 0)
    #Const LargeAddressAware = (Win64 = 0 And VBA7 = 0 And VBA6 = 0 And VBA5 = 0)
    
    '--- See gist in link above
    '--- https://gist.github.com/wqweto/e92dce63a68cd3ff9ca91b053b9510c9
    cheers,
    </wqw>

  2. #2

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections

    Sample code on using JsonKeys and JsonValue to extract and modify properties based on JSON Path

    Code:
    Option Explicit
     
    Sub Main()
        '--- 1. Never explicitly set oJson references to New instances when
        '---    `JsonValue` can create JSON objects for you
        
            Dim oJson As Object
            JsonValue(oJson, "$.path.to.prop") = 42     '--- Dot-notated child
            JsonValue(oJson, "$.path.to['prop']") = 42  '--- Bracket-notated child
            Debug.Print JsonDump(oJson)
            ' -> { "path": { "to": { "prop": 42 } } }
        
        '--- 2. Simple way to get an empty JSON object w/ no properties
        
            Dim oEmpty As Object
            JsonValue(oEmpty, vbNullString) = Empty
            Debug.Print JsonDump(oEmpty)
            ' -> { }
     
        '--- 3. Simple way to get an empty JSON array
        
            Set oEmpty = Nothing
            JsonValue(oEmpty, -1) = Empty
            Debug.Print JsonDump(oEmpty)
            ' -> [ ]
        
        '--- 4. Easily append items to a JSON array by assign to -1 index
        
            JsonValue(oJson, "$.path.to.array[-1]") = 5
            JsonValue(oJson, "$.path.to.array[-1]") = 10
            JsonValue(oJson, "$.path.to.array[-1]") = 42
            Debug.Print JsonDump(JsonValue(oJson, "path/to/array"))
            ' -> [ 5, 10, 42 ]
        
        '--- 5. Convert JSON array to VB6 array by using * index
        
            JsonValue(oJson, "$.path.to.array[-1]") = 2
            JsonValue(oJson, "$.path.to.array[-1]") = 3
            Debug.Print Join(JsonValue(oJson, "$.path.to.array[*]"), ", ")
            ' -> 5, 10, 42, 2, 3
        
        '--- 6. Create JSON array of JSON objects and assign `number` property in one statement
        
            JsonValue(oJson, "$.path.to.array[*].number") = Array(1, 2, 3, 4, 5)
            Debug.Print JsonDump(JsonValue(oJson, "$.path.to.array"))
            ' -> [ { "number": 1 }, { "number": 2 }, { "number": 3 }, { "number": 4 }, { "number": 5 } ]
        
            Debug.Print JsonDump(oJson)
            ' -> {
            '        "path": {
            '            "to": {
            '                "prop": 42,
            '                "array": [ { "number": 1 }, { "number": 2 }, { "number": 3 }, { "number": 4 }, { "number": 5 } ]
            '            }
            '        }
            '    }
            
        '--- 7. Get JSON object keys as a VB6 array (works for JSON arrays too)
        
            JsonValue(oJson, "$.path.to.test") = "Now is " & Now
            Debug.Print Join(JsonKeys(oJson, "$.path.to"), ", ")
            ' -> prop, array, test
        
        '--- 8. Remove an item by assigning `Empty`
            
            JsonValue(oJson, "$.path.to.test") = Empty
            Debug.Print Join(JsonKeys(oJson, "$.path.to"), ", ")
            ' -> prop, array
        
        '--- 9. Test item for existence w/ `IsEmpty`
            
            Debug.Print IsEmpty(JsonValue(oJson, "$.path.to.nothing"))
            ' -> True
        
        '--- 10. Reference an item as a separate JSON object and dump its keys
            
            Dim oItem As Object
            Set oItem = JsonValue(oJson, "$.path.to")
            Debug.Print Join(JsonKeys(oItem), ", ")
            ' -> prop, array
            
        '--- 11. Get JSON array elements count
            
            Debug.Print JsonValue(oJson, "$.path.to.array[-1]")
            ' -> 5
            
        '--- 12. Get JSON array elements count alternative
        
            Debug.Print UBound(JsonKeys(oJson, "$.path.to.array")) + 1
            ' -> 5
            
        '--- 13. Enumerate JSON array elements
        
            Dim vElem As Variant
            For Each vElem In JsonKeys(oJson, "$.path.to.array")
                Debug.Print "[" & vElem & "]: " & JsonValue(oJson, "$.path.to.array[" & vElem & "].number") & ", ";
            Next
            ' -> [0]: 1, [1]: 2, [2]: 3, [3]: 4, [4]: 5,
    End Sub
    cheers,
    </wqw>

  3. #3

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections

    I put a direct link to github in first post above.

    Try this link too: https://dl.unicontsoft.com/upload/mdJson.zip

    cheers,
    </wqw>

  4. #4
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections

    Json-SpeedTest(Time:ms)1.3M Size data
    why ChilkatJsonObject quickly than cConstructor(rc5json)?
    Json-AB :Json Load string(parsing)+stringify
    Action Chilkat Rc5Json Json2.js
    JsonLoad 20.09 48.37 25.53
    stringify 12.04 35.75 171.96
    Json-AB 32.13 84.12 197.48


    Code:
    Sub Test_ChilkatJsonObject()
    'Visual Basic 6.0 Load JSON Data at Path
    'https://www.example-code.com/vb6/json_load_to_path.asp
    
    Dim p As String
    p = "{""a"": 'sssss', ""b"": 2, ""c"": { ""x"": 1, ""y"": 2 } }"
    
    Dim json As New ChilkatJsonObject
    Dim success As Long
    success = json.Load(p)
    json.EmitCompact = 0
    Debug.Print json.Emit()
    
    Dim q As String
    q = "{""mm"": 11, ""nn"": 22}"
    
    Dim c As ChilkatJsonObject
    Set c = json.ObjectOf("c")
    success = c.Load(q)
    
    '  See that x and y are replaced with mm and nn.
    Debug.Print json.Emit()
    
    End Sub
    Attached Images Attached Images  
    Last edited by xiaoyao; May 25th, 2020 at 01:26 PM.

  5. #5
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections

    Quote Originally Posted by xiaoyao View Post
    Json-SpeedTest(Time:ms)1.3M Size data
    why ChilkatJsonObject quickly than cConstructor(rc5json)?
    Json-AB :Json Load string(parsing)+stringify
    Action Chilkat Rc5Json Json2.js
    JsonLoad 20.09 48.37 25.53
    stringify 12.04 35.75 171.96
    Json-AB 32.13 84.12 197.48
    There's basically two types of parsing-approaches:
    1) constructing the DOM(Object)-Hierarchy immediately (whilst parsing, with a lot of Object-instancing involved)
    2) delayed DOM(Object)-construction (after "pure-parsing" was done, members of the DOM-Tree are constructed "on access")

    The chilkat-parser is of Type #2 above, whilst wqwetos and my approach follow approach #1.

    So, to see which one is better in "real-world-scenarios", the timing will have to include "accessing DOM-Objects" -
    (e.g. when you want to import stuff from a parsed JSON-Object into a DB or something):

    Here is some Test-Code, which does such a real-world-scenario (accessing Data-Members of the parsed DOM).

    Code:
    Option Explicit
    
    Private sJSONinp As String
    
    Private Sub Form_Load()
      Dim D As cDownloads
      Set D = New_c.Downloads 'download a larger JSON-file into an inp-string first
      With D.Download("https://www.sba.gov/sites/default/files/data.json")
        If .WaitForCompletion(15) Then sJSONinp = New_c.Crypt.UTF8ToVBString(.GetContentData)
      End With
    End Sub
    
    Private Sub Form_Click()
      AutoRedraw = True: Cls: FontName = "Arial"
      
      '------------------------ RC5-JSON-stuff -----------------------
      New_c.Timing True
        Dim oJson As cCollection, oData As cCollection, Key$, Value, i&, j&, Tmp$
        Set oJson = New_c.JSONDecodeToCollection(sJSONinp)  'decode the JSON-string to Object
        Tmp = New_c.Timing
        
        For Each oData In oJson("dataset")
            For i = 0 To oData.Count - 1
                Key = oData.KeyByIndex(i)
                Select Case IsObject(oData.ItemByIndex(i))
                  Case True: Set Value = oData.ItemByIndex(i)
                  Case Else:     Value = oData.ItemByIndex(i)
                End Select
            Next
        Next
      Print "RC5-JSON-decode took:" & Tmp; vbLf; "RC5-JSON-decode + enum took:" & New_c.Timing; vbLf
      
     
      New_c.Timing True
        Dim oCKJson As ChilkatJsonObject, oCKArr As ChilkatJsonArray, oCKObj As ChilkatJsonObject
        Set oCKJson = New ChilkatJsonObject
            oCKJson.Load sJSONinp   'decode the JSON-string to Object
        Tmp = New_c.Timing
      
        Set oCKArr = oCKJson.ArrayOf("dataset")
        For i = 0 To oCKArr.Size - 1
            Set oCKObj = oCKArr.ObjectAt(i)
            For j = 0 To oCKObj.Size - 1
                Key = oCKObj.NameAt(j)
                Select Case oCKObj.TypeAt(j)
                  Case 3: Set Value = oCKObj.ObjectAt(j)
                  Case 4: Set Value = oCKObj.ArrayAt(j)
                  Case Else:  Value = oCKObj.StringAt(j)
                End Select
            Next
        Next
      Print "ChilKat-JSON-decode took:" & Tmp; vbLf; "ChilKat-JSON-decode + enum took:" & New_c.Timing; vbLf
    End Sub
    And here is the result (timings for "pure parsing", as well as the total time of "parsing + DOM-member-access"):


    So one has to be careful with "too synthetic performance-tests", which leave important parts of "real-world-usage" out.
    (in case of JSON, you parse a JSON-string for a reason... to get convenient access to the DOM-Objects and -Values).

    HTH

    Olaf

  6. #6
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections

    Thanks for your answers, I have thought about this question before, but I didn't pay attention this time. Some methods are really just loading for the first time, for example, just putting the JSON code into memory, and even without syntax check, you need to get the first level data, and then process them one by one, without even calculating the quantity first. If you give him a wrong JSON code, and then directly convert the object back to the JSON string, will he detect it, and what will it become in the end?

    There are too few users of VB6. You masters, top programmers are so rare. After a few years, you are all retired. It is estimated that no one can answer the questions. Sad about the future of VB6

  7. #7
    Addicted Member shagratt's Avatar
    Join Date
    Jul 2019
    Location
    Argentina
    Posts
    198

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections

    Hi wqweto! What will be the right way to detect if a key in the json is an array of results or a simple value? because from what I understand a simple value is retrieved with JsonItem(JS, "Record/data") and an array of values with JsonItem(JS, "Record/dataarray/*") so I need to know in advance what type of data I need to retrieve.

    PS: I found a way to do it checking the ubound of the JsonKeys (wich is -1 for simple values), but im pretty sure is not the right way.


    NEVERMIND!!! I have missed
    JsonObjectType function!


  8. #8

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections

    Quote Originally Posted by shagratt View Post
    What will be the right way to detect if a key in the json is an array of results or a simple value?
    JSON arrays and JSON objects are represented as VBA.Collections so easiest would be to just check with something like If IsObject(JsonItem(oRoot, "path/to/propery")) Then

    Usually the exact keys to the interesting values are known in advance from the Web Service documentation so these get hardcoded in the VB6 source.

    For debugging purposes I just use JsonDump like Debug.Print JsonDump(JsonItem(oRoot, "path/to/array"))

    cheers,
    </wqw>

  9. #9
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections

    Quote Originally Posted by wqweto View Post
    JSON arrays and JSON objects are represented as VBA.Collections...
    One snag with this is that Collection keys are case-insensitive, but JSON property names are case-sensitive. The same JSON object can have a property named "abc" and another named "Abc" which causes a collision in a Collection.

  10. #10

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections

    Quote Originally Posted by dilettante View Post
    One snag with this is that Collection keys are case-insensitive, but JSON property names are case-sensitive. The same JSON object can have a property named "abc" and another named "Abc" which causes a collision in a Collection.
    True but there is no API interface designer in his right mind that would distinguish object keys of the API structures on case, so I really like how JsonItem is forgiving on case-sensitivity. It just works even when you are sloppy with the keys or the documentation is slightly wrong!

    And then SQL and COBOL developers just like to type all JSON keys in uppercase -- go figure :-))

    cheers,
    </wqw>

  11. #11

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections

    Here is how to use JsonDump, JsonKeys and JsonValue functions to "explore" the contents of a JSON file. First here is the final code:

    Code:
    Private Sub Form_Load()
        Dim oJson As Object
        
        Set oJson = JsonParseObject(ReadTextFile("D:\TEMP\rpms.json"))
        Clipboard.Clear
        Clipboard.SetText JsonDump(JsonValue(oJson, "payload/rpms/BaseOS/x86_64/*/*/path"))
    End Sub
    and here is the research that went into Immediate Window finding the exact JSON keys to query:


    ? JsonDump(JsonKeys(oJson))
    [ "header", "payload" ]

    ? JsonDump(JsonKeys(oJson, "payload"))
    [ "compose", "rpms" ]

    ? JsonDump(JsonKeys(oJson, "payload/rpms"))
    [ "AppStream", "BaseOS", "HighAvailability", "PowerTools", "extras" ]

    ? JsonDump(JsonKeys(oJson, "payload/rpms/BaseOS"))
    [ "x86_64" ]

    ? JsonDump(JsonKeys(oJson, "payload/rpms/BaseOS/x86_64"))
    [
    "ModemManager-0:1.10.8-2.el8.src",
    "NetworkManager-1:1.26.0-13.el8_3.src",
    "OpenIPMI-0:2.0.27-1.el8.src",
    ...
    "zlib-0:1.2.11-16.el8_2.src",
    "zsh-0:5.5.1-6.el8_1.2.src",
    "zstd-0:1.4.4-1.el8.src"
    ]


    ? JsonDump(JsonKeys(oJson, "payload/rpms/BaseOS/x86_64/ModemManager-0:1.10.8-2.el8.src"))
    [
    "ModemManager-0:1.10.8-2.el8.src",
    "ModemManager-0:1.10.8-2.el8.x86_64",
    "ModemManager-debuginfo-0:1.10.8-2.el8.i686",
    "ModemManager-debuginfo-0:1.10.8-2.el8.x86_64",
    "ModemManager-debugsource-0:1.10.8-2.el8.i686",
    "ModemManager-debugsource-0:1.10.8-2.el8.x86_64",
    "ModemManager-glib-0:1.10.8-2.el8.i686",
    "ModemManager-glib-0:1.10.8-2.el8.x86_64",
    "ModemManager-glib-debuginfo-0:1.10.8-2.el8.i686",
    "ModemManager-glib-debuginfo-0:1.10.8-2.el8.x86_64"
    ]


    ? JsonDump(JsonKeys(oJson, "payload/rpms/BaseOS/x86_64/ModemManager-0:1.10.8-2.el8.src/ModemManager-0:1.10.8-2.el8.src"))
    [ "category", "path", "sigkey" ]

    ? JsonDump(JsonValue(oJson, "payload/rpms/BaseOS/x86_64/ModemManager-0:1.10.8-2.el8.src/*/path"))
    [
    "BaseOS/source/tree/Packages/ModemManager-1.10.8-2.el8.src.rpm",
    "BaseOS/x86_64/os/Packages/ModemManager-1.10.8-2.el8.x86_64.rpm",
    "BaseOS/x86_64/debug/tree/Packages/ModemManager-debuginfo-1.10.8-2.el8.i686.rpm",
    "BaseOS/x86_64/debug/tree/Packages/ModemManager-debuginfo-1.10.8-2.el8.x86_64.rpm",
    "BaseOS/x86_64/debug/tree/Packages/ModemManager-debugsource-1.10.8-2.el8.i686.rpm",
    "BaseOS/x86_64/debug/tree/Packages/ModemManager-debugsource-1.10.8-2.el8.x86_64.rpm",
    "BaseOS/x86_64/os/Packages/ModemManager-glib-1.10.8-2.el8.i686.rpm",
    "BaseOS/x86_64/os/Packages/ModemManager-glib-1.10.8-2.el8.x86_64.rpm",
    "BaseOS/x86_64/debug/tree/Packages/ModemManager-glib-debuginfo-1.10.8-2.el8.i686.rpm",
    "BaseOS/x86_64/debug/tree/Packages/ModemManager-glib-debuginfo-1.10.8-2.el8.x86_64.rpm"
    ]


    ? JsonDump(JsonValue(oJson, "payload/rpms/BaseOS/x86_64/*/*/path"))
    [
    [
    "BaseOS/source/tree/Packages/ModemManager-1.10.8-2.el8.src.rpm",
    "BaseOS/x86_64/os/Packages/ModemManager-1.10.8-2.el8.x86_64.rpm",
    "BaseOS/x86_64/debug/tree/Packages/ModemManager-debuginfo-1.10.8-2.el8.i686.rpm",
    "BaseOS/x86_64/debug/tree/Packages/ModemManager-debuginfo-1.10.8-2.el8.x86_64.rpm",
    "BaseOS/x86_64/debug/tree/Packages/ModemManager-debugsource-1.10.8-2.el8.i686.rpm",
    "BaseOS/x86_64/debug/tree/Packages/ModemManager-debugsource-1.10.8-2.el8.x86_64.rpm",
    "BaseOS/x86_64/os/Packages/ModemManager-glib-1.10.8-2.el8.i686.rpm",
    "BaseOS/x86_64/os/Packages/ModemManager-glib-1.10.8-2.el8.x86_64.rpm",
    "BaseOS/x86_64/debug/tree/Packages/ModemManager-glib-debuginfo-1.10.8-2.el8.i686.rpm",
    "BaseOS/x86_64/debug/tree/Packages/ModemManager-glib-debuginfo-1.10.8-2.el8.x86_64.rpm"
    ],
    ...
    [
    "BaseOS/x86_64/os/Packages/libzstd-1.4.4-1.el8.i686.rpm",
    "BaseOS/x86_64/os/Packages/libzstd-1.4.4-1.el8.x86_64.rpm",
    "BaseOS/x86_64/debug/tree/Packages/libzstd-debuginfo-1.4.4-1.el8.i686.rpm",
    "BaseOS/x86_64/debug/tree/Packages/libzstd-debuginfo-1.4.4-1.el8.x86_64.rpm",
    "BaseOS/x86_64/os/Packages/libzstd-devel-1.4.4-1.el8.i686.rpm",
    "BaseOS/x86_64/os/Packages/libzstd-devel-1.4.4-1.el8.x86_64.rpm",
    "BaseOS/source/tree/Packages/zstd-1.4.4-1.el8.src.rpm",
    "BaseOS/x86_64/debug/tree/Packages/zstd-debuginfo-1.4.4-1.el8.x86_64.rpm",
    "BaseOS/x86_64/debug/tree/Packages/zstd-debugsource-1.4.4-1.el8.x86_64.rpm"
    ]
    ]


    cheers,
    </wqw>

  12. #12

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections

    mdJson.bas now supports (partial) JSON Path expressions on JsonValue and JsonKeys properties, e.g. "$.store.book[0].title" or "$['store']['book'][0]['title']".

    Old XPath inspired syntax is still valid (and somewhat faster), e.g. "store/book/0/title".

    cheers,
    </wqw>

  13. #13
    Hyperactive Member
    Join Date
    Jun 2016
    Location
    España
    Posts
    506

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    good job wqweto

  14. #14
    New Member
    Join Date
    Oct 2023
    Posts
    2

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    Hi wqweto, thank you for sharing the mdJson.bas, it's working fine.
    but I have an issue when I try to build this Json
    it removes the duplicates Parameters under "InvoiceLine"
    {
    "ApplicationIdentifier" : "ERP",
    "InvoiceNum" : "6",
    "InvoiceDateTime" : "2023-01-01 12:00:00",
    "CustomerName" : "TEST",
    "StandardRateSales" : 400,
    "StandardRateVat" : 60,
    "StandardVatRate" : 15,
    "NetAmnt" : 400,
    "TotalVatAmnt" : 60,
    "NetAmntWithVat" : 460,
    "InvoiceLine":[{
    "Quantity" : 1,
    "LineNetAmnt" : 300,
    "LineVatAmnt" : 45,
    "LineNetAmntWithVat" : 345,
    "ItemName" : "CONSULTANT 1",
    "ItemCode" : "RC01",
    "VatRate" : 15,
    "ItemPrice" : 300
    },
    {
    "Quantity" : 1,
    "LineNetAmnt" : 100,
    "LineVatAmnt" : 15,
    "LineNetAmntWithVat" : 115,
    "ItemName" : "CONSULTANT 2",
    "ItemCode" : "RC02",
    "VatRate" : 15,
    "ItemPrice" : 100}]
    }

  15. #15

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    Here is some sample code how to populate your data using JSON Path syntax

    Code:
    Option Explicit
    
    Private Sub Form_Load()
        Dim oJson As Object
        Dim oItem As Object
        
        JsonValue(oJson, "$.ApplicationIdentifier") = "ERP"
        JsonValue(oJson, "$.InvoiceNum") = "6"
        JsonValue(oJson, "$.InvoiceDateTime") = "2023-01-01 12:00:00"
        JsonValue(oJson, "$.CustomerName") = "TEST"
        JsonValue(oJson, "$.StandardRateSales") = 400
        JsonValue(oJson, "$.StandardRateVat") = 60
        JsonValue(oJson, "$.StandardVatRate") = 15
        JsonValue(oJson, "$.NetAmnt") = 400
        JsonValue(oJson, "$.TotalVatAmnt") = 60
        JsonValue(oJson, "$.NetAmntWithVat") = 460
        JsonValue(oJson, "$.InvoiceLine[0].Quantity") = 1
        JsonValue(oJson, "$.InvoiceLine[0].LineNetAmnt") = 300
        JsonValue(oJson, "$.InvoiceLine[0].LineVatAmnt") = 45
        JsonValue(oJson, "$.InvoiceLine[0].LineNetAmntWithVat") = 345
        JsonValue(oJson, "$.InvoiceLine[0].ItemName") = "CONSULTANT 1"
        JsonValue(oJson, "$.InvoiceLine[0].ItemCode") = "RC01"
        JsonValue(oJson, "$.InvoiceLine[0].VatRate") = 15
        JsonValue(oJson, "$.InvoiceLine[0].ItemPrice") = 300
        JsonValue(oJson, "$.InvoiceLine[1].Quantity") = 1
        JsonValue(oJson, "$.InvoiceLine[1].LineNetAmnt") = 100
        JsonValue(oJson, "$.InvoiceLine[1].LineVatAmnt") = 15
        JsonValue(oJson, "$.InvoiceLine[1].LineNetAmntWithVat") = 115
        JsonValue(oJson, "$.InvoiceLine[1].ItemName") = "CONSULTANT 2"
        JsonValue(oJson, "$.InvoiceLine[1].ItemCode") = "RC02"
        JsonValue(oJson, "$.InvoiceLine[1].VatRate") = 15
        JsonValue(oJson, "$.InvoiceLine[1].ItemPrice") = 100
        Debug.Print JsonDump(oJson)
        
        '--- start all over
        Set oJson = Nothing
        JsonValue(oJson, "$.ApplicationIdentifier") = "ERP"
        JsonValue(oJson, "$.InvoiceNum") = "6"
        JsonValue(oJson, "$.InvoiceDateTime") = "2023-01-01 12:00:00"
        JsonValue(oJson, "$.CustomerName") = "TEST"
        JsonValue(oJson, "$.StandardRateSales") = 400
        JsonValue(oJson, "$.StandardRateVat") = 60
        JsonValue(oJson, "$.StandardVatRate") = 15
        JsonValue(oJson, "$.NetAmnt") = 400
        JsonValue(oJson, "$.TotalVatAmnt") = 60
        JsonValue(oJson, "$.NetAmntWithVat") = 460
        
        '--- prepare first line item
        Set oItem = Nothing
        JsonValue(oItem, "$.Quantity") = 1
        JsonValue(oItem, "$.LineNetAmnt") = 300
        JsonValue(oItem, "$.LineVatAmnt") = 45
        JsonValue(oItem, "$.LineNetAmntWithVat") = 345
        JsonValue(oItem, "$.ItemName") = "CONSULTANT 1"
        JsonValue(oItem, "$.ItemCode") = "RC01"
        JsonValue(oItem, "$.VatRate") = 15
        JsonValue(oItem, "$.ItemPrice") = 300
        JsonValue(oJson, "$.InvoiceLine[-1]") = oItem   '--- use -1 index to append to array
        
        '--- prepare second line item
        Set oItem = Nothing
        JsonValue(oItem, "$.Quantity") = 1
        JsonValue(oItem, "$.LineNetAmnt") = 100
        JsonValue(oItem, "$.LineVatAmnt") = 15
        JsonValue(oItem, "$.LineNetAmntWithVat") = 115
        JsonValue(oItem, "$.ItemName") = "CONSULTANT 2"
        JsonValue(oItem, "$.ItemCode") = "RC02"
        JsonValue(oItem, "$.VatRate") = 15
        JsonValue(oItem, "$.ItemPrice") = 100
        JsonValue(oJson, "$.InvoiceLine[-1]") = oItem   '--- use -1 index to append to array
        Debug.Print JsonDump(oJson)
    End Sub
    cheers,
    </wqw>

  16. #16
    New Member
    Join Date
    Oct 2023
    Posts
    2

    Thumbs up Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    Thank You Sir.

    Quote Originally Posted by wqweto View Post
    Here is some sample code how to populate your data using JSON Path syntax

    Code:
    Option Explicit
    
    Private Sub Form_Load()
        Dim oJson As Object
        Dim oItem As Object
        
        JsonValue(oJson, "$.ApplicationIdentifier") = "ERP"
        JsonValue(oJson, "$.InvoiceNum") = "6"
        JsonValue(oJson, "$.InvoiceDateTime") = "2023-01-01 12:00:00"
        JsonValue(oJson, "$.CustomerName") = "TEST"
        JsonValue(oJson, "$.StandardRateSales") = 400
        JsonValue(oJson, "$.StandardRateVat") = 60
        JsonValue(oJson, "$.StandardVatRate") = 15
        JsonValue(oJson, "$.NetAmnt") = 400
        JsonValue(oJson, "$.TotalVatAmnt") = 60
        JsonValue(oJson, "$.NetAmntWithVat") = 460
        JsonValue(oJson, "$.InvoiceLine[0].Quantity") = 1
        JsonValue(oJson, "$.InvoiceLine[0].LineNetAmnt") = 300
        JsonValue(oJson, "$.InvoiceLine[0].LineVatAmnt") = 45
        JsonValue(oJson, "$.InvoiceLine[0].LineNetAmntWithVat") = 345
        JsonValue(oJson, "$.InvoiceLine[0].ItemName") = "CONSULTANT 1"
        JsonValue(oJson, "$.InvoiceLine[0].ItemCode") = "RC01"
        JsonValue(oJson, "$.InvoiceLine[0].VatRate") = 15
        JsonValue(oJson, "$.InvoiceLine[0].ItemPrice") = 300
        JsonValue(oJson, "$.InvoiceLine[1].Quantity") = 1
        JsonValue(oJson, "$.InvoiceLine[1].LineNetAmnt") = 100
        JsonValue(oJson, "$.InvoiceLine[1].LineVatAmnt") = 15
        JsonValue(oJson, "$.InvoiceLine[1].LineNetAmntWithVat") = 115
        JsonValue(oJson, "$.InvoiceLine[1].ItemName") = "CONSULTANT 2"
        JsonValue(oJson, "$.InvoiceLine[1].ItemCode") = "RC02"
        JsonValue(oJson, "$.InvoiceLine[1].VatRate") = 15
        JsonValue(oJson, "$.InvoiceLine[1].ItemPrice") = 100
        Debug.Print JsonDump(oJson)
        
        '--- start all over
        Set oJson = Nothing
        JsonValue(oJson, "$.ApplicationIdentifier") = "ERP"
        JsonValue(oJson, "$.InvoiceNum") = "6"
        JsonValue(oJson, "$.InvoiceDateTime") = "2023-01-01 12:00:00"
        JsonValue(oJson, "$.CustomerName") = "TEST"
        JsonValue(oJson, "$.StandardRateSales") = 400
        JsonValue(oJson, "$.StandardRateVat") = 60
        JsonValue(oJson, "$.StandardVatRate") = 15
        JsonValue(oJson, "$.NetAmnt") = 400
        JsonValue(oJson, "$.TotalVatAmnt") = 60
        JsonValue(oJson, "$.NetAmntWithVat") = 460
        
        '--- prepare first line item
        Set oItem = Nothing
        JsonValue(oItem, "$.Quantity") = 1
        JsonValue(oItem, "$.LineNetAmnt") = 300
        JsonValue(oItem, "$.LineVatAmnt") = 45
        JsonValue(oItem, "$.LineNetAmntWithVat") = 345
        JsonValue(oItem, "$.ItemName") = "CONSULTANT 1"
        JsonValue(oItem, "$.ItemCode") = "RC01"
        JsonValue(oItem, "$.VatRate") = 15
        JsonValue(oItem, "$.ItemPrice") = 300
        JsonValue(oJson, "$.InvoiceLine[-1]") = oItem   '--- use -1 index to append to array
        
        '--- prepare second line item
        Set oItem = Nothing
        JsonValue(oItem, "$.Quantity") = 1
        JsonValue(oItem, "$.LineNetAmnt") = 100
        JsonValue(oItem, "$.LineVatAmnt") = 15
        JsonValue(oItem, "$.LineNetAmntWithVat") = 115
        JsonValue(oItem, "$.ItemName") = "CONSULTANT 2"
        JsonValue(oItem, "$.ItemCode") = "RC02"
        JsonValue(oItem, "$.VatRate") = 15
        JsonValue(oItem, "$.ItemPrice") = 100
        JsonValue(oJson, "$.InvoiceLine[-1]") = oItem   '--- use -1 index to append to array
        Debug.Print JsonDump(oJson)
    End Sub
    cheers,
    </wqw>

  17. #17
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    Can provide json access in the same format as JS?

    scriptcontrol and javascript use [n] for arrays,
    For example,

    Code:
     json("[0].key1.key2.[3].[/abc]")
    json("[0].key1").item("key2")
    json("['data/gps']")
     json("['data\cf']")
    
    JsonObj.data.cf
    Code:
    var JsonObj={
        "abc": [
            "item1",
            "item2",
            "item3"
        ],
        "KKK": 333,
        "data": {
            "cf": "cf value",
            "denominazione": "value2"
        },
        "Key1": "new Value4",
        "Key2": "new \" Value2",
        "key2": "new Value3",
        "Key3": {
            "age": 19,
            "discipline": "computer"
        },
        "data/gps": {
            "age": 19,
            "discipline": "computer"
        },
        "key4.a": "abc",
        "datacf": 3,
        "data\\cf2": 4,
        "Key4": {
            "age": 20,
            "discipline": "computer2"
        }
    }
    Last edited by xiaoyao; Oct 18th, 2023 at 07:55 AM.

  18. #18
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    I wrote a VB6 CLASS (JsonLib.cls) to wrap mdJson.bas
    Code:
    Sub mdJsonTest()
     Dim Json As New JsonLib
     'JsonParseObject
     Json.JsonStr = "{""abc"":[""item1"",""item2"",""item3""] ,""KKK"":333 ,""data"":{""cf"":""cf value"",""arr2"":[1,2], ""denominazione"":""value2""}   }"
    
     Json("a") = 3
     Json("b.c") = "kk"
     Debug.Print Json("a")
     Debug.Print Json("b.c")
     Debug.Print Json("abc[0]")
     
     'Set Json.ItemObj("dd") = JsonParseObject("{""d1"":""v1"",""d2"":[1,2,3]}")
     Set Json.ItemObj("dd") = Json.NewJsonObject("{""d1"":""v1"",""d2"":[1,2,3]}")
     Json("e") = Array("e1", "e2")
     Debug.Print Json.JsonStr 'JsonDump
    End Sub
    {
    "abc": [ "item1", "item2", "item3" ],
    "KKK": 333,
    "data": { "cf": "cf value", "denominazione": "value2" },
    "a": 3,
    "b": { "c": "kk" }
    }



    Code:
    VERSION 1.0 CLASS
    BEGIN
      MultiUse = -1  'True
      Persistable = 0  'NotPersistable
      DataBindingBehavior = 0  'vbNone
      DataSourceBehavior  = 0  'vbNone
      MTSTransactionMode  = 0  'NotAnMTSObject
    END
    Attribute VB_Name = "JsonLib"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = True
    Attribute VB_PredeclaredId = False
    Attribute VB_Exposed = False
    Option Explicit
    Public oJson As Object
    
    Public Property Get Item(Key As Variant) As Variant
    Attribute Item.VB_UserMemId = 0
        On Error Resume Next
         Item = JsonValue(oJson, "$." & Key)
         If err.Number <> 0 Then
          Set Item = JsonValue(oJson, "$." & Key)
         End If
    End Property
    Public Property Let Item(Key As Variant, ByVal vNewValue As Variant)
        JsonValue(oJson, "$." & Key) = vNewValue
    End Property
    
    Public Property Set ItemObj(Key As String, ByVal vNewValue As Variant)
        Set JsonValue(oJson, "$." & Key) = vNewValue
    End Property
    Public Property Get ItemObj(Key As String) As Object
        Set ItemObj = JsonValue(oJson, "$." & Key)
    End Property
    
    Public Property Get JsonStr() As String
        JsonStr = JsonDump(oJson)
    End Property
    Public Property Let JsonStr(ByVal AllJsonStr As String)
         Set oJson = JsonParseObject(AllJsonStr)
    End Property
     
    Public Property Get NewJsonObject(ByVal AllJsonStr As String) As Object
         Set NewJsonObject = JsonParseObject(AllJsonStr)
    End Property
     
    Function CollectionToArr(C1 As Collection) As Variant()
     Dim V() As Variant, ub As Long, I As Long
     ub = C1.Count - 1
     If ub = -1 Then
        ReDim V(-1 To -1)
     Else
     ReDim V(ub)
     For I = 1 To ub + 1
        If TypeName(C1(I)) = "Collection" Then
            Set V(I - 1) = C1(I)
        Else
            V(I - 1) = C1(I)
        End If
     Next
     End If
     CollectionToArr = V
    End Function
    
    
    Function CollectionToStrArr(C1 As Collection) As String()
     Dim V() As String, ub As Long, I As Long
     ub = C1.Count - 1
     If ub = -1 Then
        ReDim V(-1 To -1)
     Else
     ReDim V(ub)
     For I = 1 To ub + 1
        If TypeName(C1(I)) = "Collection" Then
             V(I - 1) = "[Item " & I & " is Collection]"
        Else
            V(I - 1) = C1(I)
        End If
     Next
     End If
     CollectionToStrArr = V
    End Function
    
    Function GetAllKeys(Optional Key As String) As String()
        GetAllKeys = JsonKeys(oJson, IIf(Key <> "", "$." & Key, ""))
    End Function
    Last edited by xiaoyao; Oct 18th, 2023 at 09:42 AM.

  19. #19
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    Json("data") is jsobject
    Json("data.arr2") is jsarray
    how to get typename for json item?

    Code:
    {
        "abc": [ "item1", "item2", "item3" ],
        "KKK": 333,
        "data": { "cf": "cf value", "arr2": [ 1, 2 ], "denominazione": "value2" },
        "a": 3,
        "b": { "c": "kk" },
        "dd": { "d1": "v1", "d2": [ 1, 2, 3 ] },
        "e": [ "e1", "e2" ]
    }
    Code:
     Dim ARR1() As Variant
     ARR1 = Json.CollectionToArr(Json("data"))
     Debug.Print Join(Json.CollectionToStrArr(Json("data")), vbCrLf)
    result string array is:
    Code:
    cf value
    [Item 2 is Collection]
    value2

    Code:
    Sub mdJsonTest()
     Dim Json As New JsonLib
     'JsonParseObject
     Json.JsonStr = "{""abc"":[""item1"",""item2"",""item3""] ,""KKK"":333 ,""data"":{""cf"":""cf value"",""arr2"":[1,2], ""denominazione"":""value2""}   }"
     Json("a") = 3
     Json("b.c") = "kk"
     Debug.Print Json("a")
     Debug.Print Json("b.c")
     Debug.Print Json("abc[0]")
     
     
     Set Json.ItemObj("dd") = Json.NewJsonObject("{""d1"":""v1"",""d2"":[1,2,3]}")
     Json("e") = Array("e1", "e2")
     Dim V As Variant
     Dim C As Collection
      Debug.Print TypeName(Json("e"))
      
      
     Set C = Json.ItemObj("e")
      Set C = Json.ItemObj("abc")
     Debug.Print Json.ItemObj("abc")(1)
    Debug.Print Join(JsonKeys(Json.oJson, "$.data"), vbCrLf)
    Debug.Print Join(Json.GetAllKeys(), ",")
    Debug.Print Join(Json.GetAllKeys("data"), ",")
     Debug.Print TypeName(Json("data"))
    Set C = Json("data")
     
      Debug.Print C(1)
      Debug.Print TypeName(C(2))
     Debug.Print C(2).Count
     Debug.Print C(2)(1)
     
     Debug.Print Json.JsonStr 'JsonDump
     Dim ARR1() As Variant
     ARR1 = Json.CollectionToArr(Json("data"))
     Debug.Print Join(Json.CollectionToStrArr(Json("data")), vbCrLf)
     
    End Sub
    Last edited by xiaoyao; Oct 18th, 2023 at 09:43 AM.

  20. #20

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    Quote Originally Posted by xiaoyao View Post
    how to get typename for json item?
    There is JsonObjectType function in mdJson which returns “object” vs “array”

  21. #21
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    I want to know every node, every object, and what data type it is. The main thing is whether it is an object or a host or a common data.

    I don't know the internal details of how to get the keys and get the data.

    I think the best way is to use the dictionary object.
    In this way, each object attribute has a key. In the case of an array, each of its keys is a numeric value.

    Ordinary keys are strings, so they can solve this problem perfectly.
    Code:
    Json("e") = Array("e1 "," e2 ")
    
    dim dc as new dictionary
    dim dc2 as new dictionary
    dc2.add 0,"e1"
    dc2.add 1,"e2"
    
    dc("e")=dc2

  22. #22
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    dictionaryEx \n CollectionEx
    If you write a simple module to implement this object.
    There are only two types of key names: string and numeric.

    Maybe you can use dictionaryEx.cls to implement JSON functionality directly.
    A file is enough, and there is no need for modules.

  23. #23
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    dim c as Collection
    set c=json("data")
    how to get childobject typename()??

    typename(c(0)) 'jsobject
    typename(c(2)) 'jsarray

    data.ob1
    data.arr2
    Code:
     Json.JsonStr = "{""abc"":[""item1"",""item2"",""item3""] ,""KKK"":333 ,""data"":{""ob1"":{""a"":""aaa""},""arr2"":[1,2],""cf"":""cf value""} ,""keyx"":""xxx""   }"
      Debug.Print Json.JsonStr 'JsonDump
    Debug.Print "AllKeys:" & Join(Json.AllKeyStrArr(""), ",")
    Debug.Print "TypeName:Allitem(0,1,2):"
    
    Debug.Print Json.JsTypeName("", 0)
    Debug.Print Json.JsTypeName("", 1)
    Debug.Print Json.JsTypeName("", 2)
    Debug.Print Json.JsTypeName("", 3)
    Debug.Print "TypeName:data(0,1,2):"
    Debug.Print Json.JsTypeName("data", 0)
    Debug.Print Json.JsTypeName("data", 1)
    Debug.Print Json.JsTypeName("data", 2)
    {
    "abc": [ "item1", "item2", "item3" ],
    "KKK": 333,
    "data": { "ob1": { "a": "aaa" }, "arr2": [ 1, 2 ], "cf": "cf value" },
    "keyx": "xxx"
    }
    AllKeys:abc,KKK,data,keyx

    TypeName:Allitem(0,1,2):
    array
    Double
    object
    String

    TypeName:data(0,1,2):
    object
    array
    String

    Code:
    Public Function JsTypeName(Key As String, Optional ChildID As Long = -1) As String
        Dim TypeNameA As String
        On Error Resume Next
                TypeNameA = JsonObjectType(oJson, "$." & Key)
            If ChildID = -1 Then
                If TypeNameA = "" Then TypeNameA = TypeName(Item(Key))
                
            Else
                If TypeNameA = "array" Then
                    JsTypeName = TypeName(Item("$." & Key)(ChildID))
                ElseIf TypeNameA = "object" Then
                    Dim allKeys As Variant, Key2 As String
                    allKeys = JsonKeys(oJson, IIf(Key <> "", "$." & Key, ""))
                    Key2 = allKeys(ChildID)
                    If Key2 <> "" Then
                        TypeNameA = JsonObjectType(oJson, "$." & IIf(Key <> "", Key & ".", "") & Key2)
                        If TypeNameA = "" Then
            
                            TypeNameA = TypeName(Item(IIf(Key <> "", Key & ".", "") & Key2))
                        End If
                    End If
                    
                End If
            End If
            If TypeNameA = "" Then TypeNameA = "data"
        JsTypeName = TypeNameA
    End Function
    Last edited by xiaoyao; Oct 19th, 2023 at 08:57 AM.

  24. #24
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    Json.JsonStr = "{""abc"":[""item1"",""item2"",""item3""] ,""KKK"":333 ,""data"":{""ob1"":{""a"":""aaa""},""arr2"":[1,2],""cf"":""cf value"", ""denominazione"":""value2""} }"
    Debug.Print Json.JsonStr 'JsonDump



    Code:
    {
        "abc": [ "item1", "item2", "item3" ],
        "KKK": 333,
        "data": { "ob1": { "a": "aaa" }, "arr2": [ 1, 2 ], "cf": "cf value", "denominazione": "value2" }
    }

    Can I expand the data and indent for each level?
    like this:
    Code:
     {
        "abc": [
            "item1",
            "item2",
            "item3"
        ],
        "KKK": 333,
        "data": {
            "ob1": {
                "a": "aaa"
            },
            "arr2": [
                1,
                2
            ],
            "cf": "cf value",
            "denominazione": "value2"
        }
    }

  25. #25
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    It would be convenient if you could support single quotes

    Json.JsonStr = "{'abc':['item1','item2','item3'] ,'KKK':333 ,'data':{'ob1':{'a':'aaa'} , 'cf':'cf value','arr2':[1,2], 'denominazione':'value2'} }"


    Code:
    Private Function pvJsonParse(uCtx As JsonContext) As Variant
    
    With uCtx
            Fh = pvJsonGetChar(uCtx)
            Select Case Fh
            Case 34, 39 '--- "
                pvJsonParse = pvJsonGetString(uCtx, Fh)
    
    *****
    case 123
      Fh = pvJsonGetChar(uCtx)
                    'If Fh <> 34 then 'abcd
                    If Not (Fh = 34 Or Fh = 39) Then '--- ""  '
    ******
     sKey = pvJsonGetString(uCtx, Fh)
    Code:
    Private Function pvJsonGetString(uCtx As JsonContext, YH3439 As Integer) As String
    
    Case 0, 34, 39, 92 '--- " \
                    sText = Space$(lIdx)
                    Call CopyMemory(ByVal StrPtr(sText), .Text(.Pos), LenB(sText))
                    pvJsonGetString = pvJsonGetString & sText
    
                    If nChar = YH3439 Then '--- "
                        
                        .Pos = .Pos + lIdx + 1
                        Exit For

  26. #26
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    I made a code fix and update, and now I can output full formatted JSON strings as well as JS
    -------------------------------
    mdJson.bas key name and data, some need to escape character processing,
    it is estimated that it has not been implemented, there is a plan to develop and upgrade?
    You want to be as consistent as possible with the way ScriptControl or JS handles Json and the resulting data.
    -------------------------
    old data:
    Code:
     {
        "abc": [ "item1","item2","item3",{ "b": 4 } ],
        "KKK": 333,
        "data": { "ob1": { "a": "aaa" },"arr2": [ 1,2 ],"cf": "cf value" }
    }

    Public Function JsonDump(


    If lSize > MaxWidth And Not Minimize Then
    ***
    ELSE
    'change code here:
    Code:
                    Dim Fg As String, Fg2 As String
                    If Not Minimize Then
                        Fg = vbCrLf & String((Level + 1) * 4, sSpace)
                        Fg2 = vbCrLf & String(Level * 4, sSpace)
                    End If
                    JsonDump = Left$(CompoundChars, 1) & Fg & Join(vItems, "," & Fg) & Fg2 & Right$(CompoundChars, 1)

    new data is:
    Code:
    {
        "abc": [
            "item1",
            "item2",
            "item3",
            {
                "b": 4
            }
        ],
        "KKK": 333,
        "data": {
            "ob1": {
                "a": "aaa"
            },
            "arr2": [
                1,
                2
            ],
            "cf": "cf value"
        }
    }
    Last edited by xiaoyao; Oct 19th, 2023 at 09:24 PM.

  27. #27

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    Quote Originally Posted by xiaoyao View Post
    It would be convenient if you could support single quotes
    I was surprised to find out that Newtonsoft.JSON in .Net supports single quotes convention out of the box. To me it sounds like a feature creep they couldn't remove when their library became popular.

    I'm refraining from supporting comments and other JSON5 goodness in mdJson just for the sake of staying (somewhat) compatibile to original spec.

    Btw, here is a real world JSON5 used in Chrome which looks very decent: runtime_enabled_features.json5

    cheers,
    </wqw>

  28. #28
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    Single quotes JSON, perhaps mainly to facilitate the VB6 quick input JSON string, because double quotes will become double the string, affecting the code reading.

    Single quotes support, the text has a full corner of the space, the output JSON formatted text, these three points I have done repair, people in need can refer to the next.
    I think the best way is probably to use Script.dictionary instead of Collection objects, so that the number of code can be minimized, but i can't do this new module, can only imagine.
    Last edited by xiaoyao; Oct 19th, 2023 at 10:56 AM.

  29. #29
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    Private Function CollectionIndexByKey(oCol As VBA.Collection, ByVal sKey As String, Optional ByVal IgnoreCase As Boolean = True) As Long
    Dim lItemPtr As LongPtr


    Collection also can list all keys? and find key Exists?

    Collection can't edit data,only remove it ,and re add it again ?

    Code:
    #If ImplScripting Then
        Private Function pvJsonCreateObject(ByVal lCompareMode As VbCompareMethod) As Scripting.Dictionary
            Set pvJsonCreateObject = New Scripting.Dictionary
    #Else
        Private Function pvJsonCreateObject(ByVal lCompareMode As VbCompareMethod) As VBA.Collection
            Set pvJsonCreateObject = New VBA.Collection
    Why do you support 2 objects: Maybe which one runs faster?

    Dictionary object, using more memory is acceptable.
    A long time ago, we used the memory version of the OS, which is to install the operating system on the memory, which needs to occupy 4-8G more memory.
    Solid-state drives now reach read speeds of 2,000 megabits per second, and hard drives and memory are cheap.

    In the case of large amounts of data, it is possible that dictionary objects are faster, and this speed test has been done long ago.
    The amount of data is small, so maybe the Collection object is faster
    Which is faster on JSON, I don't know.
    Last edited by xiaoyao; Oct 19th, 2023 at 11:31 AM.

  30. #30

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    Quote Originally Posted by xiaoyao View Post
    I think the best way is probably to use Script.dictionary instead of Collection objects, so that the number of code can be minimized, but i can't do this new module, can only imagine.
    There is #Const ImplScripting = False at the beginning of the source code. Setting this to True and adding reference to Microsoft Scripting Runtime forces the module to use Scripting.Dictionary internally.

    This is something I don't recommend as everything becomes slower and Scripting.Dictionary based JSON documents consume orders of magnitute more memory than VBA.Collections based ones.

    Also the newer code is not well tested (at all) with Scripting.Dictionary internal representation.

    Quote Originally Posted by xiaoyao View Post
    Collection also can list all keys? and find key Exists?
    You finally found out about the hot water! :-)) Yes, it's possible both in x86 and x64 impl using their internals (private data).

    cheers,
    </wqw>

  31. #31
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    JsonValue(oJson, "$['store']['book'][0]['title']")
    JsonValue(oJson, "$.store.book[0].title")
    JsonValue(oJson, "$.payload/rpms/BaseOS/x86_64/*/*/path")

    If multiple parsing formats are supported, the running speed will be slower?

    The second format is read in the same way as JS and Json


    JsonStr = "{""ab.c"": [""item1"",""item2"",""item3"",{""b"":4}] ,""KKK"":333 ,""data"":{""ob1"":{""a"":""aaa""},""arr2"":[1,2],""cf"":""cf value""} }"

    in scriptcontrol:
    MsgBox Json("['ab.c'][3].b")

    how to call by mdjson?

    how to split this?
    ['a.b'][0].b to a.b--0--b

    ['a.b']['0'].b to a.b--'0'-b

    JSON key names and data, if there are special characters, serializing objects into json strings also need to escape, this I do not know to consider?
    Last edited by xiaoyao; Oct 19th, 2023 at 12:52 PM.

  32. #32
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    how to do this?
    how to get value?
    MsgBox Json("[a""b.'c][3].b")
    MsgBox Json("['a""b.\'c'][3].b")
    MsgBox Json("['5']")
    Code:
    {
        "a\"b.'c": [
            "item1",
            "item2",
            "item3",
            {
                "b": 4
            }
        ],
        "KKK": 333,
        "data": {
            "ob1": {
                "a": "aaa"
            },
            "arr2": [
                1,
                2
            ],
            "cf": "cf value"
        },
        "5": "dd"
    }
    Last edited by xiaoyao; Oct 19th, 2023 at 08:06 PM.

  33. #33
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    Code:
    JsonStr = "{'a':{'b':[0,1,{'3':{'c':{'d':{'e\'2':'vv'}}}}]}}"
    Json.PutJsonStr JsonStr
    
    how go split this keys?
    
    MsgBox Json("a.b[2]['3'].c.d['e\'2']")
    The main challenge is to match 100% of the expression syntax used by JS to manipulate JSON
    
    Why do I dare not use pure VB6/VBA code to do JSON modules?
    1, the parsing speed is too slow (Efficiency should be highest when the data volume is small)
    
    2. Some special key names cannot be resolved
    3, each data obtained may be wrong
    4. How can all key names and data match 100% with JS
    Code:
    {
        "a": {
            "b": [
                0,
                1,
                {
                    "3": {
                        "c": {
                            "d": {
                                "e'2": "vv"
                            }
                        }
                    }
                }
            ]
        }
    }
    It would be nice if you could add a look-up data function and then get a key-value expression
    GetKeyPathByValue("vv"), json key path=
    a.b[2]['3'].c.d['e\'2']

    Code:
    function GetKeyPathByValue(value) as string
    ***
    end function
    Last edited by xiaoyao; Oct 19th, 2023 at 09:11 PM.

  34. #34
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    It would be nice if there was a similar way to dynamically parse JSON text
    Sometimes you just need to press A.B.C[3] to access a fixed multilevel key path expression
    You don't need to parse the entire JSON text, it's just too hard to do with VB6, right?

    I don't know of any existing open source json component projects that implement this functionality.
    c:\windows\system32
    Just like the multilevel folder path, the current path windows directory has 300 folders and 500 files,
    Use the Dir function multiple times to list all files/folders and stop when you find system32.

  35. #35
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    VBA-JSON
    https://github.com/VBA-tools/VBA-JSON
    What a strange syntax expression
    Code:
    JsonStr = "{'k1':'v1' , 'a':{'b':[0,1,{'55':{'c1':'v1' ,'c':{'d':{""d1"":""v2"", " & Chr(34) & "e\" & Chr(34) & "2" & Chr(34) & ":'vv'}}}}]}}"
    JsonStr = Replace(JsonStr, "'", Chr(34))
    
    
    MsgBox Json!a!b!(3)("55")!c!d!("d1")
    MsgBox Json!a!b!(3)("55")!c!d!("e""2")

  36. #36
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    This function is designed to 100% match the json path expression in Javascript,
    parse it into an array of strings, and then get the value of the multilevel object


    Code:
    Sub test()
        Dim JsonPath As String
        Dim result() As String
        
      JsonPath = "a.b.c[2]['3'].d['e\""2'].['k[']"
      JsonPath = "['e\[2']['k['].b.c[2]['3'].e"
        result = JsonPathToStrArray(JsonPath)
        
       Debug.Print "Keys:【" & Join(result, "--") & "】"
       Debug.Print "Keys:---------" & vbCrLf & Join(result, vbCrLf)
    End Sub
    Function JsonPathToStrArray(str As String) As String()
        Dim arr() As String, ID As Integer, Key As String
        Dim i As Integer, B As Integer, C As Integer, Max As Long
        Dim StartID As Integer, EndId As Integer, Str1 As String
        
        ReDim arr(100)
        ID = -1
        Max = Len(str)
        Str1 = Left(str, 1)
        If Str1 <> "[" Then
            StartID = 1
        End If
        For i = 1 To Max
            Str1 = Mid(str, i, 1)
            'Debug.Print "i=" & i & ",字符:" & Str1
            If Str1 = "[" Then
                
                If StartID <> 0 Then
                    EndId = i - 1
                    GoSub GetKey
                End If
                StartID = i + 1
                
                For B = i + 1 To Max
                    Str1 = Mid(str, B, 1)
                    'Debug.Print "b=" & B & ",字符:" & Str1
                    If Str1 = "'" Then
                        StartID = B
                        
                        For C = B + 1 To Max
                            Str1 = Mid(str, C, 1)
                            'Debug.Print "c=" & C & ",字符:" & Str1
                            If Str1 = "\" Then
                                C = C + 1
                            ElseIf Str1 = "'" Then
                                EndId = C
                                B = C
                                Exit For
                            End If
                        Next
                    ElseIf Str1 = "]" Then
                        If EndId = 0 Then
                            EndId = B - 1
                        End If
                        GoSub GetKey
                        StartID = 0
                        i = B
                        Exit For
                    End If
                    
                Next
            ElseIf Str1 = "." Then
                If StartID = 0 Then
                    StartID = i + 1
                    EndId = 0
                Else
                    EndId = i - 1
                    GoSub GetKey
                    StartID = i + 1
                End If
                
            End If
        Next i
        If StartID <> 0 Then
            EndId = Max
            GoSub GetKey
        End If
        
        If ID = -1 Then
            ReDim arr(-1 To -1)
        Else
            ReDim Preserve arr(ID)
        End If
        
        JsonPathToStrArray = arr
        Exit Function
    GetKey:
        
        If EndId >= StartID Then
            ID = ID + 1
            Key = Mid(str, StartID, EndId - StartID + 1)
            Key = Replace(Key, "\", "")
            Debug.Print "key=[" & Key & "]"
            Dim Key2 As String
    '        If IsNumeric(Key) Then
    '            Key = "[" & Key & "]"
    '        End If
            If Left(Key, 1) = "'" Then
                Key2 = Mid(Key, 2, Len(Key) - 2)
    
                Key = Key2
            End If
    
            
            arr(ID) = Key
        End If
        EndId = 0
        Return
    End Function

    Json.JsonStr = "{""a""b.'c"":[""item1"",""item2"",""item3"",{""b"":4}] ,""KKK"":333 ,""data"":{""ob1"":{""a"":""aaa""},""arr2"":[1,2],""cf"":""cf value""} }"

    Json.Item2("['a""b.\'c'][3].b") = "bstr1" 'Dictionary mode is supported
    MsgBox Json.Item2("['a""b.\'c']")(3)!b

    This thing has a big head, and the benefits of using a dictionary are limitless:

    Code:
    a!b!c!d(2)!e
    Last edited by xiaoyao; Oct 20th, 2023 at 01:39 AM.

  37. #37

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    Quote Originally Posted by xiaoyao View Post
    how to do this?
    how to get value?
    MsgBox Json("[a""b.'c][3].b")
    Escaping JSON Path keys is fixed in latest revision.

    Try escaping the single quote in the key with \ (backslash) i.e. ['a"b.\'c'] like this

    Debug.Print JsonValue(oJson, "$['a""b.\'c'][3].b")

    Note that " doubles to "" because of VB6 string escape.

    cheers,
    </wqw>

  38. #38
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    Unfortunately, I didn't know there was a new version, and it took more than half a day to support Javascript multi-level directories
    key=abc'd"
    Do I need to escape both single and double quotes in strings like ['abc\'d"']?
    vb string="['abc\'d""']"

    More and more easy to use, thank you very much, optimized closer to JAVASCRIPT json path way to use.

    Code:
     Dim b
    MsgBox Json.Item2("['a\""b.\'c']")(3)!b
    
     Dim B
    MsgBox Json.Item2("['a\""b.\'c']")(3)!B
    Can the dictionary be used to ignore case? Otherwise, a case error will result in an item of an item

    "b": "bstr1",
    "B": empty

    Code:
    【{
        "a\"b.'c": [
            "item1",
            "item2",
            "item3",
            {
                "b": "bstr1",
                "B": empty
            }
        ],
        "KKK": 333,
        "data": {
            "ob1": {
                "a": "aaa"
            },
            "arr2": [
                1,
                2
            ],
            "cf": "cf value"
        }
    }】
    Last edited by xiaoyao; Oct 20th, 2023 at 01:48 AM.

  39. #39
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    https://github.com/Unicontsoft/UcsFi...red/mdJson.bas

    line 607 can change for json format

    Code:
     If lSize > MaxWidth And Not Minimize Then
                    JsonDump = Left$(CompoundChars, 1) & vbCrLf & _
                        Space$(IIf(Level > -1, Level + 1, 0) * IndentSize) & Join(vItems, "," & vbCrLf & Space$(IIf(Level > -1, Level + 1, 0) * IndentSize)) & vbCrLf & _
                        Space$(IIf(Level > 0, Level, 0) * IndentSize) & Right$(CompoundChars, 1)
                Else
                   'aaaaaaa
                    JsonDump = Left$(CompoundChars, 1) & sSpace & Join(vItems, "," & sSpace) & sSpace & Right$(CompoundChars, 1)
                End If
    
    
    to 
      'aaaaaaa
    Dim Fg As String, Fg2 As String
    
                    If Not Minimize Then
                        Fg = vbCrLf & String((Level + 1) * 4, sSpace)
                        Fg2 = vbCrLf & String(Level * 4, sSpace)
                    End If
                    JsonDump = Left$(CompoundChars, 1) & Fg & Join(vItems, "," & Fg) & Fg2 & Right$(CompoundChars, 1)

  40. #40
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support

    I feel using gosub, return Goto, resume, these things are very comfortable to use Do you support VB. Net?
    I didn't even know there was a gosub return.

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