First, be sure to note that my TreeView example is incomplete.
You have to consider that both property name values and string type data values can contain characters that are incompatible with an ANSI TreeView control. Any characters outside the printable 7-bit ASCII range can be problematic, even if some ANSI printables might come out acceptably depending on the locale settings when your program gets run.
So you really need to escape funky characters or at least zap them to ? or some other place-filler symbol.
As for color-coding formatted JSON goes, no I do not have anything on hand for that.
But it seems simple enough to copy and hack JsonBag's Property Get JSON() serialization to create a Property Get JSONRTF() or a Property Get JSONHTML() that returns marked up JSON with colors. It is just a matter of doing the necessary busy work.
First, be sure to note that my TreeView example is incomplete.
You have to consider that both property name values and string type data values can contain characters that are incompatible with an ANSI TreeView control. Any characters outside the printable 7-bit ASCII range can be problematic, even if some ANSI printables might come out acceptably depending on the locale settings when your program gets run.
So you really need to escape funky characters or at least zap them to ? or some other place-filler symbol.
As for color-coding formatted JSON goes, no I do not have anything on hand for that.
But it seems simple enough to copy and hack JsonBag's Property Get JSON() serialization to create a Property Get JSONRTF() or a Property Get JSONHTML() that returns marked up JSON with colors. It is just a matter of doing the necessary busy work.
Hi dilettante. tks for reply. I will look in to hacking the JSON() and see if poss to create JSONRTF.
I think a Rich TextBox could be more appropriate for this.
Hi Eduardo. Yes i have used this before to display VB6 code and works very well. However i dont know how to modify the existing code to take care of Json / Javascript
as above post , i will see about modifying the JsonBag to create a JsonRTF as that would be quite good as i use JsonBag to show in a textbox and nicely spaced out.
maybe i can take it a step closer to use a RichtextBox to display data. would be a good addition to JsonBag.
If i try to create a JsonRTF would i create a string that contains the Json and the richtext code and then apply to the richtextbox
or once text is on the Richtextbox loop through and colour code the text accordingly.
I am thinking option one as it goes through the serailisation to add richtext formatting as we go.
Hi
I am using JSONBag 2.5 with VB6 to try and create a series of Json messages. I have managed to write working procedures for all the messages bar one. This one needs an array within it. I don't seem to be able to grasp the way to contruct this code. Can somebody give me a few pointers?
So the complete message should look like this:
'---------------------------------------------------------------------------------------
' Method : CFXMaintenancePerformed
' Author : Simon Smith
' Date : 07/12/2016
' Purpose: Create CFX.ResourcePerformance.MaintenancePerformed message
' Updated: 13/12/2018
'---------------------------------------------------------------------------------------
Public Sub CFXMaintenancePerformed()
CFXEnvelope ' Add envelope data
With JB
![MessageName] = "CFX.ResourcePerformance.MaintenancePerformed"
With .AddNewObject("MessageBody") ' Add Message Body specifics
.Item("MaintenanceType") = "Preventive"
.Item("MaintenanceOrderNumber") = "MO676578576"
.Item("MaintenanceJobCode") = "MNT113334"
With .AddNewArray("Tasks")
With .AddNewArray()
.Item("Task") = "Changed hydraulic fluid in resovoir 1"
.Item("TaskId") = "HYD233432432"
With .AddNewObject("Operator")
.Item("OperatorIdentifier") = "BADGE489435"
.Item("ActorType") = "Human"
.Item("LastName") = "Smith"
.Item("FirstName") = "Joseph"
.Item("LoginName") = "joseph.smith@abcdrepairs.com"
End With
.Item("ManHoursConsumed") = 0.75
End With
With .AddNewArray()
.Item("Task") = "Checked torque on main mount bolts"
.Item("TaskId") = "CHK3432434"
With .AddNewObject("Operator")
.Item("OperatorIdentifier") = "UID235434324"
.Item("ActorType") = "Human"
.Item("LastName") = "Smith"
.Item("FirstName") = "Joseph"
.Item("LoginName") = "joseph.smith@abcdrepairs.com"
End With
.Item("ManHoursConsumed") = "0.25"
End With
End With
End With
End With
SendSmartMessage JB.JSON
End Sub
The issue is to do with the array formation I think.
hi I can get the json report of the products between the date I want on my opencart site but how to write this incoming data in a text file with 6.0 etc. thanks
sample:
[{"UrunKodu":"7209","UrunAdi":"Apple phone 7 Plus Dolu Kasa Jet Black","Ucret":"35.0000"}]
write txt sample data
UrunKodu=7209,UrunAdi=Apple phone 7 Plus Dolu Kasa Jet Black,Ucret=35.0000
orjinal file:
[{"UrunKodu":"7209","UrunAdi":"Apple \u0130phone 7 Plus Dolu Kasa- Jet Black","Ucret":"35.0000","StokMiktari":"7"},{"UrunKodu":"7206","UrunAdi":"Apple \u0130phone 6S Plus Dolu Kasa- Gold","Ucret":"40.5000","StokMiktari":"7"},{"UrunKodu":"11821","UrunAdi":"Huawei GR5 \u015earj Ve Mikrofon Bordu","Ucret":"8.0000","StokMiktari":"2"},{"UrunKodu":"11765","UrunAdi":"Apple Iphone 8 \u00d6n Kamera+Sens\u00f6r Filmi","Ucret":"15.0000","StokMiktari":"8"},{"UrunKodu":"7230","UrunAdi":"Samsung Galaxy J2 Pro (J250) Kasa+ Kapak- Silver","Ucret":"10.0000","StokMiktari":"12"},{"UrunKodu":"7204","UrunAdi":"Apple \u0130phone 6S Plus Dolu Kasa- Beyaz","Ucret":"30.0000","StokMiktari":"7"},................]
i test json2.js is the best(used time :16 ms,JsonBag,38ms)
---------------------------
In the case of large files, I eventually lost to the JS object
After all, that is native JS, VB still has to parse
50K JSON string to object, object to character
Json1, time: 18.162882
Json2, time: 16.407462
Json3, time: 41.214192
vbjson, time: 125.604048
JsonConverter, time: 40.81495
cDataJSON, time: 48.869498
JsonBag, time: 38.097204
---------------------------
i test json2.js is the best(used time :16 ms,JsonBag,38ms)
---------------------------
In the case of large files, I eventually lost to the JS object...
Your results are not really meaningfull, unless you include:
- the data you did use
- and your test-code
Here is an example, which shows, where the (JSON-)data came from (a Download-URL),
and it includes the complete test-code as well (based on the RC5-JSON-functions).
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()
New_c.Timing True
Dim oJSON As cCollection
Set oJSON = New_c.JSONDecodeToCollection(sJSONinp) 'decode the JSON-string to Object
Debug.Print "JSON-decoding of " & Len(sJSONinp) & " Chars took:" & New_c.Timing
New_c.Timing True
Dim sJSONout As String
sJSONout = oJSON.SerializeToJSONString 'serialize the Object back into a JSON-string
Debug.Print "JSON-encoding to " & Len(sJSONout) & " Chars took:" & New_c.Timing
End Sub
Here the results on the quite large (1.3MB, not 50kB) test-input:
Code:
JSON-decoding of 1342902 Chars took: 43.84msec
JSON-encoding to 1321953 Chars took: 26.87msec
Searched the thread but couldn't find the fact that you need a reference to "OLE Automation" in your project, if you intend on using this class outside of the test project, otherwise you'll get compile errors of "User-defined type not defined" regarding "IUnknown" as used in at least one of the functions.
I'll also add that this is the best and easiest to use JSON parser I've tried for VB, and I've tried them all. I was able to rewrite a custom DLL that interfaces with a web API that switched over from XML to JSON, with minimal work. Changed a few object declarations and re-wrote how to reference the data in the collections, and this just works, allowing me to reference the JSON data as a VB collection, like I had been with MS' XML parser. That made the transition a lot less work for me.
One thing to be careful of is not to ask for keys that may not be present (depending on the data you're getting from your source). The .exists function, however, makes that a cinch.
I wish the documentation was a little clearer on the various functions, as I had to dig through the sample code a bit to figure out how to do some things, but, like I said -- it just plain works.
Well done and kudos to the author.
Last edited by Montclair; Jan 3rd, 2021 at 06:44 PM.
Searched the thread but couldn't find the fact that you need a reference to "OLE Automation" in your project, if you intend on using this class outside of the test project, otherwise you'll get compile errors of "User-defined type not defined" regarding "IUnknown" as used in at least one of the functions.
I'll also add that this is the best and easiest to use JSON parser I've tried for VB, and I've tried them all. I was able to rewrite a custom DLL that interfaces with a web API that switched over from XML to JSON, with minimal work. Changed a few object declarations and re-wrote how to reference the data in the collections, and this just works, allowing me to reference the JSON data as a VB collection, like I had been with MS' XML parser. That made the transition a lot less work for me.
One thing to be careful of is not to ask for keys that may not be present (depending on the data you're getting from your source). The .exists function, however, makes that a cinch.
I wish the documentation was a little clearer on the various functions, as I had to dig through the sample code a bit to figure out how to do some things, but, like I said -- it just plain works.
Well done and kudos to the author.
I've also been using it for a long time and it's one of the best.
You could pass your dll or the part of the code to convert to xml and if you can xml to json
I've also been using it for a long time and it's one of the best.
You could pass your dll or the part of the code to convert to xml and if you can xml to json
a greeting
Yeah, I tried some of the JSON to XML converters I found, and they pretty much don't work for my needs. Plus, the vendor changed the names of many of the fields, and it's just easier to rewrite (now) thanks to JsonBag.
If I'm misunderstanding and you're asking for code that I used when I switched from my vendor's XML API to their JSON API, it really wouldn't be much help as it's pretty vendor specific.
Public Property Get ItemSafe(ByVal Key As Variant) As Variant
If Me.Exists(Key) Then ItemSafe = Me.Item(Key)
End Property
Public Property Get ArraySafe(ByVal Key As Variant) As Variant
If Me.Exists(Key) Then
If IsNull(Key) Then Error9904
If VarType(Key) = vbString Then
If mIsArray Then Error9908
If ExistsStr(Key) Then
If IsObject(Values.Item(PrefixedKey)) Then
Set ArraySafe = Values.Item(PrefixedKey)
Else
ArraySafe = Values.Item(PrefixedKey)
End If
Else
Error990C
End If
Else
If IsObject(Values.Item(Key)) Then
Set ArraySafe = Values.Item(Key)
Else
ArraySafe = Values.Item(Key)
End If
End If
Else
Set ArraySafe = New Collection
End If
End Property
Allowing to decrease the size of production code from this:
Example:
Code:
Private Sub JSON_ParseOzonAttrib(JB As JsonBag)
Dim i As Long
If JB.Exists("result") Then
If JB.ItemIsJSON("result") Then
For i = 1 To JB.Item("result").Count
With JB.Item("result")(i)
If .Exists("name") Then
Debug.Print .Item("name")
End If
End With
Next
End If
End If
End Sub
to this:
Code:
Private Sub JSON_ParseOzonAttrib2(JB As JsonBag)
Dim i As Long
For i = 1 To JB.ArraySafe("result").Count
With JB.Item("result")(i)
Debug.Print .ItemSafe("name")
End With
Next
End Sub
.ItemSafe / .ArraySafe - is a shortcut for .Item (not Object) / .Item (Object / Array) with additional check for .Exist( Key )
allowing to use them in-place without throwing the error exception.
PS. Yeah, better to merge both methods in one. Just my quick 5 cents.
Last edited by Dragokas; Feb 13th, 2021 at 07:07 AM.
trying to decide how useful a GetPath("obj1.obj2.obj3.value") function is. and maybe adding a .dumpKeys() method (from elroys CollectionEx class) for when you get lost in the hierarchy
the ability to handle single quoted strings would be great as well.
Code:
'quick external to class version todo: support element array indexes?
Function GetPath(o As JsonBag, path As String) As Variant
Dim tmp() As String, o2 As JsonBag, isLast As Boolean
If InStr(path, ".") < 1 Then
If o.ItemIsJSON(path) Then
Set GetPath = o.Item(path)
Else
GetPath = o.Item(path)
End If
Exit Function
End If
Set o2 = o
tmp = Split(path, ".")
For i = 0 To UBound(tmp)
If i = UBound(tmp) Then isLast = True
If o2.ItemIsJSON(tmp(i)) Then
Set o2 = o2.Item(tmp(i))
If isLast Then Set GetPath = o2
Else
If Not isLast Then Err.Raise 2121, "GetPath", "Object path terminates at " & tmp(i)
GetPath = o2.Item(tmp(i))
End If
Next
End Function
Option Explicit
Private Sub Main()
With New JsonBag
.Whitespace = True
.Item("projectCode") = "xel0010"
.Item("productCode") = "121"
.Item("plannedNum") = 100
.Item("planStartTime") = "2021-09-08 00:00:00"
.Item("planEndTime") = "2021-09-08 23:59:59"
With .AddNewArray("workOrderCustomFieldsValue")
With .AddNewObject()
.Item("name") = "key1"
.Item("value") = "v1"
End With
With .AddNewObject()
.Item("name") = "key2"
.Item("value") = "v2"
End With
End With
MsgBox .JSON
End With
End Sub
Option Explicit
Private Sub Main()
With New JsonBag
.Whitespace = True
.Item("projectCode") = "xel0010"
.Item("productCode") = "121"
.Item("plannedNum") = 100
.Item("planStartTime") = "2021-09-08 00:00:00"
.Item("planEndTime") = "2021-09-08 23:59:59"
With .AddNewArray("workOrderCustomFieldsValue")
With .AddNewObject()
.Item("name") = "key1"
.Item("value") = "v1"
End With
With .AddNewObject()
.Item("name") = "key2"
.Item("value") = "v2"
End With
End With
MsgBox .JSON
End With
End Sub
I couldn't find another reference to a "Subscript out of range" error, except for this post...
Originally Posted by dilettante
[*]Bug fix: Replacing an "array" item at the end of the "array" caused "Subscript out of range" error 9.
I have been successfully using JSON Bag version 2.4 for a long time, but just recently I'm running into this error. I updated to 2.6 and am still getting the error here:
Public Property Get ItemIsJSON(ByVal Key As Variant) As Boolean
'Reports True if an item is a JSON "array" or "object" and False
'if a simple value.
If IsNull(Key) Then Error9904
If VarType(Key) = vbString Then
If mIsArray Then Error9908
If ExistsStr(Key) Then
ItemIsJSON = IsObject(Values.Item(PrefixedKey))
Else
Error990C
End If
Else ItemIsJSON = IsObject(Values.Item(Key)) 'out of range here!
End If
End Property
I'm testing to see if a sub-item is a JSON collection also, so I can pick and choose a few values out if it is.
A quick glance at the code and it appears that ExistsStr(Key) is the way to see if there is a Value before actually trying to use it. Since I just need a TRUE or FALSE telling me if the subitem is JSON, I changed the code to below:
Public Property Get ItemIsJSON(ByVal Key As Variant) As Boolean
'Reports True if an item is a JSON "array" or "object" and False
'if a simple value.
If IsNull(Key) Then Error9904
If VarType(Key) = vbString Then
If mIsArray Then Error9908
If ExistsStr(Key) Then
ItemIsJSON = IsObject(Values.Item(PrefixedKey))
Else
Error990C
End If
Else If ExistsStr(Key) Then
ItemIsJSON = IsObject(Values.Item(Key)) 'out of range here!
Else
'no way item could be JSON if error getting Values
ItemIsJSON = False
End If End If
End Property
Using ExistsStr() there makes no sense. It has already been established that Key is numeric (not String), and thus an index. So using ExistsStr() there is invalid.
What your hack does is coerce the numeric Key to a String and then look for a child node that happens to match (by luck?) this String. Most of the time this won't be true, so you have basically turned ItemIsJSON() into a random-usually-False generator when Key is numeric.
Frankly I don't see a bug at all there. An error 9 exception should be raised when a numeric Key value out of range is supplied.
Perhaps I'm not seeing it? A small test case demonstrating the problem would help clarify the issue if it exists.
Using ExistsStr() there makes no sense. It has already been established that Key is numeric (not String), and thus an index. So using ExistsStr() there is invalid.
What your hack does is coerce the numeric Key to a String and then look for a child node that happens to match (by luck?) this String. Most of the time this won't be true, so you have basically turned ItemIsJSON() into a random-usually-False generator when Key is numeric.
Frankly I don't see a bug at all there. An error 9 exception should be raised when a numeric Key value out of range is supplied.
Perhaps I'm not seeing it? A small test case demonstrating the problem would help clarify the issue if it exists.
So, I un-did the changes I made and let it run through the JSON file again to see where it was breaking.
Unfortunately, it looks like I should've looked at the JSON source before reacting. For some reason, 1 record out of over 3,500 was passing in some invalid JSON characters. I contacted the external source of the JSON and they fixed the problem on their end. I re-ran the data through again without any issues.
Sorry for the trouble... looks like a false alarm!
For now, all I need is to extract the price located after the "c":.
However, I figured I'd try to learn something about JSON and parsing in the event I need to pull in a large amount of data to grab multiple items from it.
I notice that Parse/Reser button just makes a copy to the other textbox. Not sure how that is parsing. What am I missing?
And checking off 'Add Whitespace':
So it formats it nicely. But exactly how does one use this to retrieve specific data values from the JSON based on the key?
I guess I misunderstand what JSON code parsing is.
Is there any parsing code for JSON where you supply the key name and get the data value back?
Obviously there is much I need to learn about this format.
Dim p As Object, sError As String
Set p = mdjson.JsonParseObject("{"c":165.35, "d":-0.23, "dp":-0.1389, "h":165.85, "l":163, "o":163.21, "pc":165.58, "t":1659729604}", sError, StrictMode:=False)
If p Is Nothing Then
Debug.Print "Error parsing JSON: " & sError, Timer
Exit Sub
End If
msgbox JsonValue(p, "c")
Last edited by k_zeon; Mar 16th, 2024 at 09:25 AM.