JSON coder/decoder.
You must to patch Visual Basic 6 with Service Pack 6 before compiling with this TLB!
The ToJSON function can parse data with all kinds of errors, but parsing the JSON comments is not implemented.
The JSON comments are not part of the standard and slow down the parsing.
Also in the project you can find:
Type library with sources (Usable VB and Windows API declarations are added during the programming from December 1, 2011)
Function to detect is file exists
Functions for reading and writing the whole binary and text files
Functions for reading and writing the file times
Function to detect is current thread active (IsAppActive)
Function to get window class
Last edited by Bonnie West; Feb 2nd, 2014 at 06:34 PM.
On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
Function JsonParse parses JSON objects and JSON arrays to Scripting.Dictionary objects. Object properties can be accessed with oResult!myproperty, array elements with oResult!myarray(0).
Function JsonDump in reverse converts Scripting.Dictionary objects to valid JSON string.
cheers,
</wqw>
Last edited by wqweto; Jul 11th, 2012 at 03:15 AM.
Yes, your code is clearly very well tuned. I'm not using StrPBrkW or any API calls at all, nor are any additional project references needed.
My primary goal was to "make it simple" -- a single (or two) self-containing functions anyone can paste in his project. Simple to use too -- something like parsedObject!printers(0)!capabilities!width to traverse nested arrays/objects. I'll see what can be tweaked performance wise without bloating the code.
Btw, why are you comparing JsonParse with ToJSON? JsonParse is equivalent to FromJSON, JsonDump is equivalent to ToJSON. Why are you including JsonDump in LOC measurement? It's a simple 65 lines of code dumping function that is not related to parsing.
Sorry, for hijacking your theme. The typelib looks very good, lots of clever hacks (can't fathom how CallProc5 does not corrupt the stack though).
Conforming implementations MUST treat procedure and parameter names as being case-sensitive such the names bar and BAR would be seen as two distinct entities.
So I think there must be BinaryCompare.
Originally Posted by wqweto
Yes, your code is clearly very well tuned. I'm not using StrPBrkW or any API calls at all, nor are any additional project references needed.
Btw, why are you comparing JsonParse with ToJSON? JsonParse is equivalent to FromJSON, JsonDump is equivalent to ToJSON. Why are you including JsonDump in LOC measurement? It's a simple 65 lines of code dumping function that is not related to parsing.
Sorry, for hijacking your theme. The typelib looks very good, lots of clever hacks (can't fathom how CallProc5 does not corrupt the stack though).
I'm confused with the functions names. I compared the FromJSON and JsonParse functions.
CallProc*(ProcAddres,*) works only with replaced function msvbvm60.rtcCallByName by this:
Code:
pop eax ;pop return_address
pop ecx ;pop proc_address
push eax ;push return_address
jmp ecx ;jmp proc_address
Originally Posted by wqweto
My primary goal was to "make it simple" -- a single (or two) self-containing functions anyone can paste in his project. Simple to use too -- something like parsedObject!printers(0)!capabilities!width to traverse nested arrays/objects. I'll see what can be tweaked performance wise without bloating the code.
This is awesome construction with default string params! I didn't know about it ten years of my programming in the VB 6.0...
My code can work with "parsedObject!printers(0)!capabilities!width" like expressions too, and I WILL NOT change my code because adding item to the collection is much faster than it is for the dictionary:
Code:
Set c = New Collection
Set d = New Dictionary
t = Tick
For i = 1 To 100000
c.Add i '16(100000) 47(500000) 109(1000000)
'd.Add i, i '140(100000) 5242(500000) 20794(1000000)
Next i
Debug.Print Tick - t
t = Tick
'For i = 1 To 100000
'For Each v In d '16(500000) 32(1000000)
For Each v In c '15(500000) 32(1000000)
'n = c.Item(i) '12761(100000)
'n = d(i) '125(100000)
Next
Debug.Print Tick - t
Code:
Set c = New Collection
Set d = New Dictionary
For i = 1 To 20
'c.Add i
d.Add i, i
Next i
t = Tick
For i = 1 To 5000000
'n = c(5) '109(1'000'000) 546(5'000'000)
n = d(5) '78(1'000'000) 406(5'000'000)
Next i
Debug.Print Tick - t
Yes, Dictionary is slower that Collection *and* uses much more memory.
For instance this large json file can not be parsed with dictionaries because parsed object uses more that 2GB or RAM.
Same file with collections uses 287MB of RAM.
I did some research on my sample and the performance penalty turned out to be with late-bound calls on dictionaries (adding entries). Early-bound version is about 20% slower (not 20 times) than yours.
Here is the modified version
VB Code:
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Type JsonContext
Text() As Integer
Pos As Long
Error As String
LastChar As Integer
End Type
Public Function JsonParse(sText As String, vResult As Variant, Optional Error As String) As Boolean
Private Function pvJsonMissing(Optional vMissing As Variant) As Variant
pvJsonMissing = vMissing
End Function
Private Function pvJsonParse(uCtx As JsonContext, vResult As Variant, oResult As Dictionary) As Boolean
'--- note: when using collections change type of parameter oResult to Collection
#Const USE_COLLECTION = False
Dim lIdx As Long
Dim vKey As Variant
Dim vValue As Variant
Dim oValue As Object
Dim sText As String
vValue = pvJsonMissing
With uCtx
Select Case pvJsonGetChar(uCtx)
Case 34 ' "
vResult = pvJsonGetString(uCtx)
Case 91 ' [
#If USE_COLLECTION Then
Set oResult = New Collection
#Else
Set oResult = CreateObject("Scripting.Dictionary")
#End If
Do
Select Case pvJsonGetChar(uCtx)
Case 0, 44, 93 ' , ]
If Not oValue Is Nothing Then
#If USE_COLLECTION Then
oResult.Add oValue
#Else
oResult.Add lIdx, oValue
#End If
ElseIf Not IsMissing(vValue) Then
#If USE_COLLECTION Then
oResult.Add vValue
#Else
oResult.Add lIdx, vValue
#End If
End If
If .LastChar <> 44 Then ' ,
Exit Do
End If
lIdx = lIdx + 1
vValue = pvJsonMissing
Set oValue = Nothing
Case Else
.Pos = .Pos - 1
If Not pvJsonParse(uCtx, vValue, oValue) Then
GoTo QH
End If
End Select
Loop
Case 123 ' {
#If USE_COLLECTION Then
Set oResult = New Collection
#Else
Set oResult = CreateObject("Scripting.Dictionary")
oResult.CompareMode = 1 ' TextCompare
#End If
Do
Select Case pvJsonGetChar(uCtx)
Case 34 ' "
vKey = pvJsonGetString(uCtx)
Case 58 ' :
If Not oValue Is Nothing Then
.Error = "Value already specified at position " & .Pos
GoTo QH
ElseIf Not IsMissing(vValue) Then
vKey = vValue
vValue = pvJsonMissing
End If
lIdx = .Pos
If Not pvJsonParse(uCtx, vValue, oValue) Then
.Pos = lIdx
vValue = Empty
Set oValue = Nothing
End If
Case 0, 44, 125 ' , }
If IsMissing(vValue) And oValue Is Nothing Then
If IsEmpty(vKey) Then
GoTo NoProp
End If
vValue = vKey
vKey = vbNullString
End If
If IsEmpty(vKey) Then
vKey = vbNullString
ElseIf IsNull(vKey) Then
vKey = "null"
End If
If Not oValue Is Nothing Then
#If USE_COLLECTION Then
oResult.Add oValue, vKey & ""
#Else
oResult.Add vKey & "", oValue
#End If
Else
#If USE_COLLECTION Then
oResult.Add vValue, vKey & ""
#Else
oResult.Add vKey & "", vValue
#End If
End If
NoProp:
If .LastChar <> 44 Then ' ,
Exit Do
End If
vKey = Empty
vValue = pvJsonMissing
Set oValue = Nothing
Case Else
.Pos = .Pos - 1
If Not pvJsonParse(uCtx, vValue, oValue) Then
GoTo QH
End If
End Select
Loop
Case 116, 84 ' "t", "T"
If Not ((.Text(.Pos + 0) Or &H20) = 114 And (.Text(.Pos + 1) Or &H20) = 117 And (.Text(.Pos + 2) Or &H20) = 101) Then
GoTo UnexpectedSymbol
End If
.Pos = .Pos + 3
vResult = True
Case 102, 70 ' "f", "F"
If Not ((.Text(.Pos + 0) Or &H20) = 97 And (.Text(.Pos + 1) Or &H20) = 108 And (.Text(.Pos + 2) Or &H20) = 115 And (.Text(.Pos + 3) Or &H20) = 101) Then
GoTo UnexpectedSymbol
End If
.Pos = .Pos + 4
vResult = False
Case 110, 78 ' "n", "N"
If Not ((.Text(.Pos + 0) Or &H20) = 117 And (.Text(.Pos + 1) Or &H20) = 108 And (.Text(.Pos + 2) Or &H20) = 108) Then
GoTo UnexpectedSymbol
End If
.Pos = .Pos + 3
vResult = Null
Case 48 To 57, 43, 45, 46 ' 0-9 + - .
For lIdx = 0 To 1000
Select Case .Text(.Pos + lIdx)
Case 48 To 57, 43, 45, 46, 101, 69, 120, 88, 97 To 102, 65 To 70 ' 0-9 + - . e E x X a-f A-F
Reply With Quote
Originally Posted by wqweto
