-
Feb 22nd, 2019, 09:38 AM
#1
[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>
Last edited by wqweto; May 26th, 2022 at 10:06 AM.
-
Feb 27th, 2019, 09:07 AM
#2
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>
Last edited by wqweto; Feb 19th, 2022 at 10:34 AM.
-
May 12th, 2020, 07:31 AM
#3
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>
Last edited by wqweto; May 12th, 2020 at 07:40 AM.
-
May 25th, 2020, 01:08 PM
#4
Re: [VB6/VBA] JSON parsing to built-in VBA.Collections
Last edited by xiaoyao; May 25th, 2020 at 01:26 PM.
-
May 26th, 2020, 02:24 AM
#5
Re: [VB6/VBA] JSON parsing to built-in VBA.Collections
Originally Posted by xiaoyao
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
-
May 26th, 2020, 12:43 PM
#6
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
-
Mar 31st, 2021, 12:50 PM
#7
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!
Last edited by shagratt; Mar 31st, 2021 at 12:56 PM.
-
Mar 31st, 2021, 01:02 PM
#8
Re: [VB6/VBA] JSON parsing to built-in VBA.Collections
Originally Posted by shagratt
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>
Last edited by wqweto; Mar 31st, 2021 at 01:48 PM.
-
Mar 31st, 2021, 01:10 PM
#9
Re: [VB6/VBA] JSON parsing to built-in VBA.Collections
Originally Posted by wqweto
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.
-
Mar 31st, 2021, 01:14 PM
#10
Re: [VB6/VBA] JSON parsing to built-in VBA.Collections
Originally Posted by dilettante
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>
-
Apr 9th, 2021, 09:33 AM
#11
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>
Last edited by wqweto; Feb 19th, 2022 at 10:49 AM.
-
Feb 19th, 2022, 10:57 AM
#12
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>
-
Feb 19th, 2022, 12:18 PM
#13
Hyperactive Member
Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support
-
Oct 11th, 2023, 03:12 AM
#14
New Member
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}]
}
-
Oct 11th, 2023, 04:19 AM
#15
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>
Last edited by wqweto; Oct 11th, 2023 at 04:23 AM.
-
Oct 11th, 2023, 08:42 AM
#16
New Member
Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support
Thank You Sir.
Originally Posted by wqweto
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>
-
Oct 18th, 2023, 07:38 AM
#17
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.
-
Oct 18th, 2023, 08:33 AM
#18
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.
-
Oct 18th, 2023, 09:33 AM
#19
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.
-
Oct 18th, 2023, 02:21 PM
#20
Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support
Originally Posted by xiaoyao
how to get typename for json item?
There is JsonObjectType function in mdJson which returns “object” vs “array”
-
Oct 18th, 2023, 06:38 PM
#21
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
-
Oct 18th, 2023, 06:46 PM
#22
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.
-
Oct 19th, 2023, 02:27 AM
#23
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.
-
Oct 19th, 2023, 02:39 AM
#24
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"
}
}
-
Oct 19th, 2023, 09:00 AM
#25
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
-
Oct 19th, 2023, 10:15 AM
#26
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.
-
Oct 19th, 2023, 10:17 AM
#27
Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support
Originally Posted by xiaoyao
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>
-
Oct 19th, 2023, 10:41 AM
#28
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.
-
Oct 19th, 2023, 11:13 AM
#29
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.
-
Oct 19th, 2023, 11:16 AM
#30
Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support
Originally Posted by xiaoyao
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.
Originally Posted by xiaoyao
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>
Last edited by wqweto; Oct 19th, 2023 at 11:19 AM.
-
Oct 19th, 2023, 12:20 PM
#31
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.
-
Oct 19th, 2023, 01:03 PM
#32
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.
-
Oct 19th, 2023, 08:54 PM
#33
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.
-
Oct 19th, 2023, 09:19 PM
#34
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.
-
Oct 19th, 2023, 10:50 PM
#35
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")
-
Oct 20th, 2023, 12:20 AM
#36
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:
Last edited by xiaoyao; Oct 20th, 2023 at 01:39 AM.
-
Oct 20th, 2023, 12:27 AM
#37
Re: [VB6/VBA] JSON parsing to built-in VBA.Collections with JSON Path support
Originally Posted by xiaoyao
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>
-
Oct 20th, 2023, 01:43 AM
#38
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.
-
Oct 20th, 2023, 03:14 AM
#39
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)
-
Oct 20th, 2023, 08:36 AM
#40
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
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|