PureBasic Forums - English

Posted: **Fri Feb 04, 2011 11:05 pm**

I doesn't know why i have done it, i think because i needed
something small to create in a few hours ... and this topic is
currently really interesting for me. Additional Kukulkan has inspired me.
So the uncommented testcode, äh i mean the json-string i have used
to test my code is from him

I use maps and arrays, so you have direct access to all elements
without an additional procedure call. You can use the struc "jsonObj"
or use the procedure JSON_decode() if you have the json-string.
I have made it to make a "fast" json-decoder/ -encoder and i
think i have done it well.

It could be, that there are some more
optimizations possible and to tell the truth, i have not tested it how
fast/ slow it is.

If the type of an element isn't known, you can use *jsonObj\type.
There are floats (Double), integer, strings, objects (Map) und arrays.
False, True und Null are special cases with special type-constants, but
the values are stored in the number-attributes, too. If some one has
wishes or ideas, feel free to write it down.

Of course, you are
allowed to report bugs, too.

The structure contains a whole map. If you doesn't want this,
define the constant #JSON_UseObjectPointer to change the map to
a pointer. Then the map will only be initialized, if it is really needed.
But then you need to call JSON_newObject() for every new object
and JSON_newPair() for every new name/value-pair. Normally, it is
not needed to switch to it, only if you are going to create big
JSON objects.

One hind: If you write a "jsonObj" by yourself, you doesn't need to set
the right type *jsonObj\type = #JSON_Type_XXX, now JSON_encode()
and JSON_Debug() are able to see, what type it is.

For more information please read the commends in code.

update 24.02.2011
+ add: JSON_free(*jsonObj.jsonObj)

update 30.04.2011
+ add: switch #JSON_UseObjectPointer
+ add: JSON_dimArray(*jsonObj, Size.i)
+ add: JSON_create()
+ add: JSON_newObject(*jsonObj, Name.s) [only needed with #JSON_UseObjectPointer]
+ change: JSON_encode() and JSON_debug() are able to handle not manually set types

update 03.05.2011
+ bugfix: JSON_encode() returned #False, if a number was followed by a brace "}"
+ improved: now, all local variables are declared

update 15.10.2011
+ bugfix: empty arrays "[]" are possible, now
+ bugfix: backslashes in strings doesn't crash the program any more
+ change: now JSON_newObject() is only to initialize a new Json-Objekts
+ change: now JSON_free() is a macro
+ add: Macro JSON_newPair() (in past JSON_newObject(), see example)
+ add: JSON_clear()
+ improved: JSON_dimArray() and JSON_newObject() will reset the structure if used before

update 05.04.2012
+ bugfix: JSON_encode() returned #False, if a number was followed by square bracket "]"

update 17.07.2012
+ add: JSON_freeStringBuffer() to be used if JSON_encode() has created very big strings and after that you dosn't need this function any longer.
+ add: additional parameter "initialize" for JSON_clear(), can set to #False to disable automatic initialization of the given object (behavior as before).
+ improved: memory-managmend for JSON_encode(), results in a much more faster then before
+ improved: JSON_clear() is calling InitializeStructure() automatically, to make the given object usable again after call

update 19.04.2013
+ bugfix: encoding for unicode escaped characters (\u) failed
+ bugfix: map keys were not escaped
+ improved: escaping of strings in JSON_encode() now faster
+ improved: test code uses new possibility of CompilerIf #IsMain

update: 01.08.2013
+ bufix: string creation for unicode escaped characters (tab, linebreak, slash, ...) failed

Code: Select all

; -:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-
;
;         JSON decoder & encoder
;                                 for PureBasic v4.51+
;
; -:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-
;
; from:  01.08.2013
; version: 0.7.2
;
; {|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}
;
;
; © 2011-2013 by PMV 
; 
;
; {|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}
;
;
; syntax:
; *jsonObj.jsonObj = JSON_decode(string.s)
;
; description:
; The return value contains the new data created from a json-string.
; If it is #False, there is an error in the given json-string.
;
; *jsonObj\type will return what type it is
; *jsonObj\o("Key") is a map, used if it is a #JSON_Type_Object
; *jsonObj\a(3)     is an array, used if it is a #JSON_Type_Array
;     *jsonObj\length contains the length of this array
;     you need to call JSON_dimArray(jsonObj, Size) to create it
; *jsonObj\s        is a string, used if it is a #JSON_Type_String
; *jsonObj\i        is an integer, used if it is a #JSON_Type_Integer
; *jsonObj\f        is an doublefloat, used if it is a #JSON_Type_Float
; special handling: #JSON_Type_Null, #JSON_Type_True, #JSON_Type_False
;     additional #False, #True, #Null are set for \i and \f
;
; ----
;
; syntax:
; string.s = JSON_encode(*jsonObj.jsonObj)
;
; description:
; returns an ready to write json-string
; hint: this function uses a threaded string-buffer to be very fast.
; You can call this function with a huge amount of data and it is
; still threadsafe. But if the string-buffer is not needed any longer,
; please use JSON_freeStringBuffer() to free this huge amount of memory.
;
;
; ----
;
; syntax:
; JSON_freeStringBuffer()
;
; description:
; The string-buffer for JSON_encode() is not freeed automatically after
; use. If you have a huge amount of data (like 100 MByte), and you know
; you will not need this again, call this function to free the string-buffer.
; hint: The string-buffer is threaded, so this function is needed to be
; called in the same thread as the JSON_encode() function!
;
;
; ----;
; syntax:
; JSON_clear(*jsonObj.jsonObj, initialize.i = #True)
;
; description:
; resets the whole json object, it will be as it was at the beginning.
;
;
; ----
;
; syntax:
; JSON_free(*jsonObj.jsonObj)
;
; description:
; frees the whole json object
;
;
; ----
;
; syntax:
; JSON_dimArray(*jsonObj.jsonObj, Size.i)
;
; description:
; To create an array in your JSON-Object, you need to call this to dim
; the array. After this call, you can use the array like normal.
;
;
; ----
;
; syntax:
; JSON_newPair(*jsonObj.jsonObj, Name.s)
;
; description:
; If you use #JSON_UseObjectPointer, you need this, to create a new
; name/value pair in your JSON-Object, After this call, you can use
; the name/ value pair like normal. If it is used on a not created
; object, it will initialize the object like JSON_newObject() would
; do. So, you can skip the call to JSON_newObject().
;
;
; ----
;
; syntax:
; JSON_newObject(*jsonObj.jsonObj)
;
; description:
; If you use #JSON_UseObjectPointer, you need this, to create a blank
; new object in your JSON-Object, After this call, you will have a
; empty object. To get name/ value pairs use JSON_newPair() and to
; get an array use JSON_dimArray().
; hint: JSON_newPair() has implemented the same functionality 
;
;
; ----
;
; syntax:
; JSON_create()
;
; description:
; This is needed, if your root object is a pointer and not a normal
; structured variable. With this, you can initialize the root element.
;
;
; ----
;
; for debugging: you can call JSON_Debug(*jsonObj.jsonObj) to print all
; elements to the debugger. This procedure is ignored if debugger
; is deactivated, so you doesn't need to uncommend it for final releases.
;
; ----
;
; special features: you can uncommend the first line of code to define
; the #JSON_UseObjectPonter constant. At default, the jsonObj structure
; containts always a whole map. So it will need much memory and the
; creation of a new object is a little bit slower as it could. If you
; create really big JSON objects, you will need this to minimize the
; memory usage and to speed up the initialization of every object.
;
; -|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-
EnableExplicit
;#JSON_UseObjectPointer = #True

#JSON_DefaultMapSlots = 10   ;-change default map-slots if needed!
#JSON_parseArraySteps = 10   ;used in internal procedure JSON_parseArray()
#JSON_StringBufferSize = 256 ;start-size of return-string from JSON_encode()

;-
; ---------------------------------------------
;- internal functions
;----------------------------------------------

Threaded *json_string_buffer
Threaded *json_string_next
Threaded json_string_space.i

Declare.i JSON_parseObject(*c, *out, nullByte.i)
Structure jsonObj
  type.i
  CompilerIf Defined(JSON_UseObjectPointer, #PB_Constant)
    Map *o.jsonObj(#JSON_DefaultMapSlots) 
  CompilerElse
    Map o.jsonObj(#JSON_DefaultMapSlots)
  CompilerEndIf
  Array *a.jsonObj(1)
  StructureUnion
    length.i   ;if it is an array
    i.i
  EndStructureUnion
  f.d
  s.s
EndStructure


Enumeration
  #JSON_Type_Undefined
  #JSON_Type_String
  #JSON_Type_Object
  #JSON_Type_Null
  #JSON_Type_True
  #JSON_Type_False
  #JSON_Type_Array
  #JSON_Type_Integer
  #JSON_Type_Float
EndEnumeration

Macro JSON_readChar(CHAR)
  Repeat
    If *c >= nullByte : ProcedureReturn #False : EndIf
    Select *c\c
      Case ' ', 9, 10, 13 ;whitespaces
        *c + SizeOf(CHARACTER)
      Case CHAR
        Break
      Default
        ProcedureReturn #False
    EndSelect
  ForEver
  *c + SizeOf(CHARACTER)
EndMacro

Macro JSON_readWhitespaces()
  While *c\c = ' ' Or *c\c = 9 Or *c\c = 10 Or *c\c = 13
    If *c >= nullByte : ProcedureReturn #False : EndIf
    *c + SizeOf(CHARACTER)
  Wend
EndMacro

Procedure.i JSON_getType(*obj.jsonObj)
  If *obj\type <> #JSON_Type_Undefined
    ProcedureReturn *obj\type
  EndIf 
  
CompilerIf Defined(JSON_UseObjectPointer, #PB_Constant)
  If *obj\s
CompilerElse
  If MapSize(*obj\o())  
    ProcedureReturn #JSON_Type_Object
  ElseIf *obj\s
CompilerEndIf
    ProcedureReturn #JSON_Type_String
  ElseIf *obj\f
    ProcedureReturn #JSON_Type_Float
  Else ;If *obj\i
    ProcedureReturn #JSON_Type_Integer
  EndIf
EndProcedure

Procedure.s JSON_parseString(*c.CHARACTER, nullByte.i, *result.INTEGER)
  Protected i.i, hexDigit.s
  Protected string.s = ""
  
  Repeat
    Select *c\c
      Case '"'
        Break
      Case '\'
        *c + SizeOf(CHARACTER)
        
        Select *c\c
          Case '"', '\', '/'
            string + PeekS(*c, 1)
          Case 'n' ; new line
            string + Chr(10)
          Case 'r' ; carriage return
            string + Chr(13)
          Case 't' ; tabulator
            string + Chr(9)
          Case 'u' ; 4 hex digits
            *c + SizeOf(CHARACTER)
            If nullByte - *c > 4 * SizeOf(CHARACTER)
              hexDigit = "$" + PeekS(*c, 4)
              *c + SizeOf(CHARACTER) * 3
              string + Chr(Val(hexDigit))
            Else
              ; unexpected end of string, returns the string up to the
              ; end, *result\i is set to #False to indicate the error state
              *result\i = #False
              ProcedureReturn string
            EndIf
          Case 'b' ; backspace
            string + Chr(8)
          Case 'f' ; formfeed
            string + Chr(14)
          Default ;not allowed! But this will tolerate a single
            ; backslash without above following char by ignoring it
            *c - SizeOf(CHARACTER)
        EndSelect
      Default
        string + PeekS(*c, 1)
    EndSelect
    *c + SizeOf(CHARACTER)
    If *c >= nullByte
      ; unexpected end of string, returns the string up to the
      ; end, *result\i is set to #False to indicate the error state
      *result\i = #False
      ProcedureReturn string
    EndIf
  ForEver
  ;Debug "String: " + string
  
  *result\i =  *c + SizeOf(CHARACTER)
  ProcedureReturn string
EndProcedure

Procedure.i JSON_parseNumber(*c.CHARACTER, *out.jsonObj, nullByte)
  Protected string.s, e.s
  Protected *first = *c

  If LCase(PeekS(*c, 4)) = "null"
    *out\f = #Null
    *out\i = #Null
    *out\type = #JSON_Type_Null
    ;Debug "Number: null"
    ProcedureReturn *c + SizeOf(CHARACTER) * 4
  ElseIf LCase(PeekS(*c, 5)) = "false"
    *out\f = #False
    *out\i = #False
    *out\type = #JSON_Type_False
    ;Debug "Number: false"
    ProcedureReturn *c + SizeOf(CHARACTER) * 5
  ElseIf LCase(PeekS(*c, 4)) = "true"
    *out\f = #True
    *out\i = #True
    *out\type = #JSON_Type_True
    ;Debug "Number: true"
    ProcedureReturn *c + SizeOf(CHARACTER) * 4
  EndIf
   
  If *c\c = '-' : *c + SizeOf(CHARACTER) : EndIf
  Repeat
    Select *c\c
      Case '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '.'
        
      Case 'e', 'E'
        *c\c = 'e'
        *c + SizeOf(CHARACTER)
        If *c\c <> '-' And *c\c <> '+' : *c - SizeOf(CHARACTER) : EndIf
      Case ' ', 9, 10, 13, ',', ']', '}'
        Break
      Default
        ProcedureReturn #False
    EndSelect
        
    *c + SizeOf(CHARACTER)
    If *c >= nullByte : ProcedureReturn #False : EndIf
  ForEver 
  
  string = PeekS(*first, (*c - *first) / SizeOf(CHARACTER))
  If FindString(string, ".", 1)
    *out\s = string  ; used for JSON_encode()
    *out\f = ValD(string)
    *out\i = *out\f
    *out\type = #JSON_Type_Float
    ;Debug "Float: " + StrD(*out\f)
  ElseIf FindString(string, "e", 1)
    *out\s = string  ; used for JSON_encode()
    e = StringField(string, 2, "e")
    string = StringField(string, 1, "e")
    
    *out\f = ValD(string) * Pow(10, Val(e))
    *out\i = *out\f
    *out\type = #JSON_Type_Float
    ;Debug "Float: " + StrD(*out\f)
  Else
    *out\i = Val(string)
    *out\f = *out\i
    *out\type = #JSON_Type_Integer
    ;Debug "Integer: " + Str(*out\i)
  EndIf
  
  ProcedureReturn *c
EndProcedure
  
Procedure.i JSON_parseArray(*c.CHARACTER, *out.jsonObj, nullByte.i)
  Protected string.s, i.i = 0, result.i
  Protected arrayLength.i = #JSON_parseArraySteps
  *out\type = #JSON_Type_Array
  
  JSON_readWhitespaces()
  If *c\c = ']' : ProcedureReturn *c + SizeOf(CHARACTER) : EndIf
  
  ReDim *out\a.jsonObj(arrayLength)
  Repeat
    *out\a(i) = AllocateMemory(SizeOf(jsonObj))
    
    ; read the value
    Select *c\c
      Case '{'
        InitializeStructure(*out\a(i), jsonObj)
        result = JSON_parseObject(*c + SizeOf(CHARACTER), *out\a(i), nullByte)
        
      Case '['
        InitializeStructure(*out\a(i), jsonObj)
        result = JSON_parseArray(*c + SizeOf(CHARACTER), *out\a(i), nullByte)
        
      Case '"'
        string = JSON_parseString(*c + SizeOf(CHARACTER), nullByte, @result)
        *out\a(i)\s = string
        *out\a(i)\type = #JSON_Type_String
        
      Default ;Number
        result = JSON_parseNumber(*c, *out\a(i), nullByte)
    
    EndSelect
    ; --------
    
    If Not result : ProcedureReturn #False : EndIf
    *c = result
    JSON_readWhitespaces()
    If *c\c = ','
      i + 1
      If i > arrayLength
        arrayLength + #JSON_parseArraySteps
        ReDim *out\a.jsonObj(arrayLength)
      EndIf
      *c + SizeOf(CHARACTER)
      JSON_readWhitespaces() 
    ElseIf *c\c = ']'
      Break
    EndIf 
  ForEver
  ReDim *out\a.jsonObj(i)
  *out\length = i + 1
  
  ProcedureReturn *c + SizeOf(CHARACTER)
EndProcedure

Procedure.i JSON_parseObject(*c.CHARACTER, *out.jsonObj, nullByte.i)
  Protected result.i, string.s, key.s
  *out\type = #JSON_Type_Object
  
  
  JSON_readWhitespaces()
  If *c\c = '}' : ProcedureReturn *c + SizeOf(CHARACTER) : EndIf
  
  Repeat 
    ; read the string-key at first
    If *c\c <> '"' : ProcedureReturn #False : EndIf
    *c + SizeOf(CHARACTER)
    key = JSON_parseString(*c, nullByte, @result)
    If Not result : ProcedureReturn #False : EndIf
    *c = result
    ; -----------
    
    JSON_readChar(':')
    JSON_readWhitespaces()
    
    *out\o(key) 
    CompilerIf Defined(JSON_UseObjectPointer, #PB_Constant)
      *out\o() = AllocateMemory(SizeOf(jsonObj))
    CompilerEndIf
      
    ; read the value
    Select *c\c
      Case '{'
        CompilerIf Defined(JSON_UseObjectPointer, #PB_Constant)
          InitializeStructure(*out\o(), jsonObj)
        CompilerEndIf
        result = JSON_parseObject(*c + SizeOf(CHARACTER), *out\o(), nullByte)
        
      Case '['
        CompilerIf Defined(JSON_UseObjectPointer, #PB_Constant)
          InitializeStructure(*out\o(), jsonObj)
        CompilerEndIf
        result = JSON_parseArray(*c + SizeOf(CHARACTER), *out\o(), nullByte)
        
      Case '"'
        string = JSON_parseString(*c + SizeOf(CHARACTER), nullByte, @result)
        *out\o(key)\s = string
        *out\o()\type = #JSON_Type_String
        
      Default ;Number
        result = JSON_parseNumber(*c, *out\o(), nullByte)
    
    EndSelect
    ; --------
    
    If Not result : ProcedureReturn #False : EndIf
    *c = result
    JSON_readWhitespaces()
    If *c\c = ','
      *c + SizeOf(CHARACTER)
      JSON_readWhitespaces() 
    ElseIf *c\c = '}'
      Break
    EndIf
    
    If *c\c = '}' : ProcedureReturn #False : EndIf
 ForEver
  
  ProcedureReturn *c + SizeOf(CHARACTER)
EndProcedure

Procedure JSON_addString(string.s)
  Protected size.i = StringByteLength(string)
  Protected used.i = *json_string_next - *json_string_buffer
  
  While json_string_space - used <= size
    json_string_space = json_string_space * 2
    *json_string_buffer = ReAllocateMemory(*json_string_buffer, json_string_space)
    *json_string_next = *json_string_buffer + used
  Wend
  CopyMemoryString(@string, @*json_string_next)
EndProcedure


Procedure JSON_addEscapedString(string.s)
  Protected *c.CHARACTER = @string
  Protected last.i = *c + StringByteLength(string)
  Protected *start = *c
  Protected i.i = 0
  
  While  *c < last
    If *c\c = '\' Or *c\c = '/' Or *c\c = '"' Or *c\c = 10 Or *c\c = 13 Or *c\c = 9 Or *c\c = 8 Or *c\c = 14
      ;  8 = backspace
      ;  9 = tabulator
      ; 10 = new line
      ; 13 = carriage return
      ; 14 = formfeed
      
      If i
        JSON_addString(PeekS(*start, i))
      EndIf
      Select *c\c
        Case '\', '/', '"'
          JSON_addString("\")
          JSON_addString(PeekS(*c, 1))
        Case 10 ; new line
          JSON_addString("\n")
        Case 13 ; carriage return
          JSON_addString("\r")
        Case 9 ; tabulator
          JSON_addString("\t")
        Case 8 ; backspace
          JSON_addString("\b")
        Case 14 ; formfeed
          JSON_addString("\f")
      EndSelect
      *c + SizeOf(CHARACTER)
      *start = *c
      i = 0
    Else
      *c + SizeOf(CHARACTER)
      i + 1
    EndIf
  Wend
  If i
    JSON_addString(PeekS(*start, i))
  EndIf
EndProcedure



;-
; ---------------------------------------------
;- public functions
;----------------------------------------------

Procedure JSON_freeStringBuffer()
  *json_string_buffer = FreeMemory(*json_string_buffer)
  *json_string_next = #Null
  *json_string_buffer = #Null
EndProcedure

Procedure.i JSON_decode(inpString.s)
  inpString = Trim(inpString)
  Protected *c.CHARACTER = @inpString
  Protected result.i
  
  
  Protected *out.jsonObj = AllocateMemory(SizeOf(jsonObj))
  InitializeStructure(*out, jsonObj)
  If *c\c = '{'
    *c + SizeOf(CHARACTER)
    result = JSON_parseObject(*c, *out, @inpString + StringByteLength(inpString))
  ElseIf *c\c = '['
    *c + SizeOf(CHARACTER)
    result = JSON_parseArray(*c, *out, @inpString + StringByteLength(inpString))
  EndIf
  If result
    ProcedureReturn *out
  Else  
    ProcedureReturn #False
  EndIf
EndProcedure

Procedure.s JSON_encode(*obj.jsonObj, spaces.i = 0, type.i = #JSON_Type_Undefined)
  Protected tmpString.s
  Protected i.i
  Protected size.i
  Protected returnString.i = #False
  
  If Not *json_string_next
    If Not *json_string_buffer
      json_string_space = #JSON_StringBufferSize
      *json_string_buffer = AllocateMemory(json_string_space)
    EndIf
    *json_string_next = *json_string_buffer
    returnString = #True
  EndIf
  
  
  If type = #JSON_Type_Undefined
    type = *obj\type
  EndIf
  Select type
    Case #JSON_Type_False
      JSON_addString("false")
    Case #JSON_Type_True
      JSON_addString("true")
    Case #JSON_Type_Null
      JSON_addString("null")
    Case #JSON_Type_Float
      If *obj\s
        JSON_addString(*obj\s)
      Else
        JSON_addString(StrD(*obj\f))
      EndIf
    Case #JSON_Type_Integer
      JSON_addString(Str(*obj\i))
    Case #JSON_Type_String
      JSON_addString(Chr(34))
      JSON_addEscapedString(*obj\s)
      JSON_addString(Chr(34))
    Case #JSON_Type_Array
      JSON_addString("[")
      For i = 0 To *obj\length - 1
        JSON_addString(Chr(13))
        JSON_addString(Chr(10))
        JSON_addString(Space(spaces + 2))
        JSON_addString(JSON_encode(*obj\a(i), spaces + 2))
        If i = *obj\length - 1 
          JSON_addString(Chr(13))
          JSON_addString(Chr(10))
        Else
          JSON_addString(",")
        EndIf
      Next
      JSON_addString(Space(spaces))
      JSON_addString("]")
    Case #JSON_Type_Object
      JSON_addString("{")
      ResetMap(*obj\o())
      size = MapSize(*obj\o())
      For i = 1 To size
        JSON_addString(Chr(13))
        JSON_addString(Chr(10))
        NextMapElement(*obj\o())
        JSON_addString(Space(spaces + 2))
        JSON_addString(Chr(34))
        JSON_addEscapedString(MapKey(*obj\o()))
        JSON_addString(Chr(34))
        JSON_addString(" : ")
        CompilerIf Defined(JSON_UseObjectPointer, #PB_Constant)
          JSON_addString(JSON_encode(*obj\o(), spaces + 2))
        CompilerElse
          JSON_addString(JSON_encode(@*obj\o(), spaces + 2))
        CompilerEndIf
        If i = size
          JSON_addString(Chr(13))
          JSON_addString(Chr(10))
        Else
          JSON_addString(",")
        EndIf
      Next
      JSON_addString(Space(spaces))
      JSON_addString("}")
    Case #JSON_Type_Undefined
      JSON_addString(JSON_encode(*obj, spaces, JSON_getType(*obj)))
  EndSelect 
  
  If returnString
    size = (*json_string_next - *json_string_buffer) / SizeOf(CHARACTER)
    *json_string_next = #Null
    ProcedureReturn PeekS(*json_string_buffer, size)
  EndIf
  ProcedureReturn ""
EndProcedure

Macro JSON_free(pJsonObj)
  JSON_clear(pJsonObj, #False)
  FreeMemory(pJsonObj)
EndMacro

Procedure JSON_clear(*obj.jsonObj, initialize.i = #True)
  Protected last.i = *obj\length - 1
  Protected i.i
  Protected type.i = *obj\type
  
  If type = #JSON_Type_Undefined
    type = JSON_getType(*obj)
  EndIf  
  Select type
    Case #JSON_Type_Object
      ResetMap(*obj\o())
      While NextMapElement(*obj\o())
        CompilerIf Defined(JSON_UseObjectPointer, #PB_Constant)
          JSON_free(*obj\o())  
        CompilerElse
          JSON_clear(@*obj\o(), #False)
        CompilerEndIf
      Wend
      FreeMap(*obj\o())
      
    Case #JSON_Type_Array
      For i = 0 To last
        JSON_free(*obj\a(i))
      Next
      Dim *obj\a(0)
  EndSelect
  
  ClearStructure(*obj, jsonObj)
  ;*obj\type = #JSON_Type_Undefined  ;operated by ClearStructure()
  If initialize
    InitializeStructure(*obj, jsonObj)
  EndIf
EndProcedure


CompilerIf Defined(JSON_UseObjectPointer, #PB_Constant)
  Macro JSON_create()
    AllocateMemory(SizeOf(jsonObj))
  EndMacro
  Procedure JSON_newObject(*obj.jsonObj)
    If *obj\type <> #JSON_Type_Undefined
      JSON_clear(*obj)
    ElseIf *obj\s ;only if it is a string
      ClearStructure(*obj, jsonObj)
    EndIf
    *obj\type = #JSON_Type_Object
    InitializeStructure(*obj, jsonObj)
  EndProcedure
  Macro JSON_newPair(pJsonObj, strName)
    ;JSON_newObject(pJsonObj)
    pJsonObj\o(strName) = AllocateMemory(SizeOf(jsonObj))
  EndMacro

CompilerEndIf


Procedure.i JSON_dimArray(*obj.jsonObj, Size.i)
  Protected i.i
  If *obj\type <> #JSON_Type_Undefined
    JSON_clear(*obj, #False)
  ElseIf *obj\s ;only if it is a string
    ClearStructure(*obj, jsonObj)
  EndIf    
  
  If Size > 0
    *obj\length = Size
    Size - 1
    Dim *obj\a(Size)
    For i = 0 To Size
      *obj\a(i) = AllocateMemory(SizeOf(jsonObj))
      CompilerIf Defined(JSON_UseObjectPointer, #PB_Constant) = #False
        InitializeStructure(*obj\a(i), jsonObj)
      CompilerEndIf
    Next
  Else
    *obj\length = 0
  EndIf
  *obj\type = #JSON_Type_Array
EndProcedure

CompilerIf #PB_Compiler_Debugger
Procedure JSON_Debug(*obj.jsonObj, key.s, type.i = #JSON_Type_Undefined)
  Protected i.i
  
  If type = #JSON_Type_Undefined
    type = *obj\type
  EndIf
  Select type
    Case #JSON_Type_False
      Debug key + " (false)"
    Case #JSON_Type_True
      Debug key + " (true)"
    Case #JSON_Type_Null
      Debug key + " (null)"
    Case #JSON_Type_Float
      Debug key + " (float) : " + StrD(*obj\f)
    Case #JSON_Type_Integer
      Debug key + "(int) : " + Str(*obj\i)
    Case #JSON_Type_String
      Debug key + " (string) : " + *obj\s
    Case #JSON_Type_Array
      Debug key + " (array) : ["
      For i = 0 To *obj\length - 1
        JSON_Debug(*obj\a(i), Str(i+1) + ".")
      Next
      Debug "]"
    Case #JSON_Type_Object
      Debug key + " (object) : {"
      ResetMap(*obj\o())
      While NextMapElement(*obj\o())
        JSON_Debug(*obj\o(), MapKey(*obj\o()))
      Wend
      Debug "}"
      
    Case #JSON_Type_Undefined
      JSON_Debug(*obj, key, JSON_getType(*obj))
  EndSelect   
EndProcedure
CompilerElse
Macro JSON_Debug(BLA, BLA2, BLA3=bla4)
EndMacro
CompilerEndIf


; ---------------------------------------------
;       test code
; ---------------------------------------------

CompilerIf Defined(PB_Compiler_IsMainFile, #PB_Constant) = #False
  ; new compiler constant since PB v5.10
  ; to run test with older version just set constant to #True
  #PB_Compiler_IsMainFile = #False
CompilerEndIf
CompilerIf  #PB_Compiler_IsMainFile
  Define strTest.s = ""
  strTest + "{"
    strTest + Chr(34) + "Kreditkarte" + Chr(34) + " : " + Chr(34) + "Xema" + Chr(34) + "," 
    strTest + Chr(34) + "Nummer" + Chr(34) + "      : " + Chr(34) + "1234-5678-9012-3456" + Chr(34) + ","
    strTest + Chr(34) + "Inhaber" + Chr(34) + "     : {" 
      strTest + Chr(34) + "Name" + Chr(34) + "      : " + Chr(34) + "Reich" + Chr(34) + "," 
      strTest + Chr(34) + "Vorname" + Chr(34) + "   : " + Chr(34) + "Rainer" + Chr(34) + "," 
      strTest + Chr(34) + "Geschlecht" + Chr(34) + ": " + Chr(34) + "männlich" + Chr(34) + "," 
      strTest + Chr(34) + "Vorlieben" + Chr(34) + " : [ " + Chr(34) + "Reiten" + Chr(34) + ", " + Chr(34) + "Schwimmen" + Chr(34) + ", " + Chr(34) + "Lesen" + Chr(34) + " ]," 
      strTest + Chr(34) + "Alter" + Chr(34) + "     : null,"
      strTest + Chr(34) + "Schufa" + Chr(34) + "    : {}, " 
      strTest + Chr(34) + "Verdienst" + Chr(34) + " : [5000, 10000] " 
    strTest + "}," 
    strTest + Chr(34) + "Deckung" + Chr(34) + "     : 2e+6,"
    strTest + Chr(34) + "Währung" + Chr(34) + "     : " + Chr(34) + "EURO" + Chr(34) + ", " 
    strTest + Chr(34) + "Abzüge" + Chr(34) + "      : [], "
    strTest + Chr(34) + "Online Konto" + Chr(34) + ": " + Chr(34) + "http:\/\/www.meinekreditkarte.com\/meinkonto" + Chr(34)
  strTest + "}"
  Define *out.jsonObj
  Define strResult.s
  
  
  *out = JSON_decode(strTest)
  
  Debug "direct Access:"
  Debug "Nummer: " + *out\o("Nummer")\s
  Debug "Vorname: " + *out\o("Inhaber")\o("Vorname")\s
  Debug "Vorliebe 2: " + *out\o("Inhaber")\o("Vorlieben")\a(2)\s
  Debug " "
  
  Debug "JSON content:"
  JSON_Debug(*out, "")
  JSON_free(*out)
  
  Debug ""
  Debug "myJSON content:"
  CompilerIf Defined(JSON_UseObjectPointer, #PB_Constant)
    ; this code demonstrates the use of this JSON-Object, if
    ; you have defined the #JSON_UseObjectPointer constant.
    ; It is more complexe, but then the Map is only initialized
    ; if you really need them, less memory usage per object
    ; and faster in use.
    Define *myJSON.jsonObj = JSON_create()
    JSON_newObject(*myJSON)
    JSON_newPair(*myJSON, "Name")
    *myJSON\o("Name")\s = "Müller"
    JSON_newPair(*myJSON, "Beruf")
    *myJSON\o("Beruf")\s = "Dichter"
    JSON_newPair(*myJSON, "Alter")
    *myJSON\o("Alter")\i = 49
    JSON_newPair(*myJSON, "Verheiratet")
    *myJSON\o("Verheiratet")\type = #JSON_Type_False
    JSON_newPair(*myJSON, "Kinder")
    JSON_dimArray(*myJSON\o("Kinder"), 2)
    JSON_newObject(*myJSON\o("Kinder")\a(0))
    JSON_newPair(*myJsON\o("Kinder")\a(0), "Name")
    *myJSON\o("Kinder")\a(0)\o("Name")\s = "Martin"
    JSON_newPair(*myJsON\o("Kinder")\a(0), "Alter")
    *myJSON\o("Kinder")\a(0)\o("Alter")\i = 20
    JSON_newObject(*myJSON\o("Kinder")\a(1))
    JSON_newPair(*myJsON\o("Kinder")\a(1), "Name")
    *myJSON\o("Kinder")\a(1)\o("Name")\s = "Katja"
    JSON_newPair(*myJsON\o("Kinder")\a(1), "Alter")
    *myJSON\o("Kinder")\a(1)\o("Alter")\i = 15
    JSON_newPair(*myJSON, "Erkrankungen")
    JSON_dimArray(*myJSON\o("Erkrankungen"), 0)
    JSON_newPair(*myJSON, "Empty")
    JSON_newObject(*myJSON\o("Empty"))
    JSON_newPair(*myJSON, "")
    *myJSON\o("")\s = "No Name"
    *myJSON\o("/\")\s = "Back" + Chr(34) + "Slash"
    
    JSON_Debug(*myJSON, "")
    strResult = JSON_encode(*myJSON)
  CompilerElse
    ; this code demonstrates the use of the JSON-Object, if
    ; you doesn't have defined the #JSON_UseObjectPointer
    ; constant. Now every object containts an initialized
    ; Map, but now you are able to easily create data
    Define myJSON.jsonObj
    myJSON\o("Name")\s = "Müller"
    myJSON\o("Beruf")\s = "Dichter"
    myJSON\o("Alter")\i = 49
    myJSON\o("Verheiratet")\type = #JSON_Type_False
    JSON_dimArray(@myJSON\o("Kinder"), 2)
    myJSON\o("Kinder")\a(0)\o("Name")\s = "Martin"
    myJSON\o("Kinder")\a(0)\o("Alter")\i = 20
    myJSON\o("Kinder")\a(1)\o("Name")\s = "Katja"
    myJSON\o("Kinder")\a(1)\o("Alter")\i = 15
    JSON_dimArray(@myJSON\o("Erkrankungen"), 0)
    myJSON\o("Empty")\type = #JSON_Type_Object
    myJSON\o("")\s = "No Name"
    myJSON\o("/\")\s = "Back" + Chr(34) + "Slash"
    
    JSON_Debug(@myJSON, "")
    strResult = JSON_encode(@myJSON)
  CompilerEndIf
  
  ; creates a new file in tempdir and opens it with standard-program for *.txt files!
  Define file.s =  GetTemporaryDirectory() + "json.txt"
  If CreateFile(0, file)
    WriteString(0, strResult)
    CloseFile(0)
    RunProgram(file)
  EndIf
CompilerEndIf

MFG PMV

Posted: **Mon Feb 07, 2011 3:29 am**

Thanks for this, PMV. I can see myself finding this very useful in the future!

Posted: **Mon Feb 07, 2011 5:45 am**

many thanks for sharing this.

Very handy.

cheers

Posted: **Mon Feb 07, 2011 4:00 pm**

This is very usefull for me.
Thanks for sharing ..

Posted: **Thu Feb 24, 2011 5:35 pm**

+ add: JSON_free(*jsonObj.jsonObj)

Posted: **Sat Apr 30, 2011 12:54 pm**

+ add: switch #JSON_UseObjectPointer
+ add: JSON_dimArray(*jsonObj, Size.i)
+ add: JSON_create()
+ add: JSON_newObject(*jsonObj, Name.s) [only needed with #JSON_UseObjectPointer]
+ change: JSON_encode() and JSON_debug() are able to handle not manually set types

please read the commends in code for full description of the (new) functionality.

(abstract of the example code above for creating a new object)

Code: Select all

IncludeFile "JSON_Parser.pbi"

Define myJSON.jsonObj
myJSON\o("Name")\s = "Müller"
myJSON\o("Beruf")\s = "Dichter"
myJSON\o("Alter")\i = 49
myJSON\o("Verheiratet")\type = #JSON_Type_False
JSON_dimArray(@myJSON\o("Kinder"), 2)
myJSON\o("Kinder")\a(0)\o("Name")\s = "Martin"
myJSON\o("Kinder")\a(0)\o("Alter")\i = 20
myJSON\o("Kinder")\a(1)\o("Name")\s = "Katja"
myJSON\o("Kinder")\a(1)\o("Alter")\i = 15

Posted: **Tue May 03, 2011 10:25 pm**

+ bugfix: JSON_encode() returned #False, if a number was followed by a brace "}"
+ improved: now, all local variables are declared

Posted: **Fri Oct 07, 2011 12:28 pm**

I add my sincere thanks to JMV for this code - it's been very helpful.

Posted: **Thu Oct 13, 2011 11:21 am**

Thank's but there seem to be an error. If I try with this JSON, it crashes:

Code: Select all

// to get rid of problems with " I replaced all " with #HK#
Json.s = "{#HK#IMAGE_URL#HK#:#HK#http:\/\/someurl.com\/images\/ad_horses.jpg#HK#,#HK#LINKS#HK#:[{#HK#URL#HK#:#HK#www.amazon.com#HK#,#HK#X#HK#:10,#HK#Y#HK#:10,#HK#W#HK#:400,#HK#H#HK#:40},{#HK#URL#HK#:#HK#www.google.com#HK#,#HK#X#HK#:10,#HK#Y#HK#:50,#HK#W#HK#:400,#HK#H#HK#:40}]}"
Json.s = ReplaceString(Json.s, "#HK#", Chr(34))

Define *out.jsonObj
*out = JSON_decode(strTest.s)

Debug "JSON content:"
JSON_Debug(*out, "")
JSON_free(*out)

{"IMAGE_URL":"http:\/\/someurl.com\/images\/ad_horses.jpg","LINKS":[{"URL":"www.amazon.com","X":10,"Y":10,"W":400,"H":40},{"URL":"www.google.com","X":10,"Y":50,"W":400,"H":40}]}

http://jsonlint.com/ says, this is a valid JSON string.

This crashes using PB 4.51 32 Bit.

Did I miss something?

Kukulkan

Posted: **Thu Oct 13, 2011 7:59 pm**

I don't know how tired i was when i have done that ...
but there is a big bug ... thanks for report. I will look
and fix it in the next days

MFG PMV

Posted: **Sat Oct 15, 2011 7:00 pm**

update 15.10.2011
+ bugfix: empty arrays "[]" are possible, now
+ bugfix: backslashes in strings doesn't crash the program any more
+ change: now JSON_newObject() is only to initialize a new Json-Objekts
+ change: now JSON_free() is a macro
+ add: Macro JSON_newPair() (in past JSON_newObject(), see example)
+ add: JSON_clear()
+ improved: JSON_dimArray() and JSON_newObject() will reset the structure if used before

JSON_dimArray() and JSON_newObject() call JSON_clear() if the given
structure is used before. But please note, i doesn't have tested this much.
I doesn't have the time and still no use for JSON, sorry. Please test this
as much as possible and report any problem.

Important:
Information for anybody, who uses JSON_newObject with an old include
(up to 03.05.2011) and wants to upgrade to the newest version (till 15.10.2011).
The change i have done is to get better readable code. JSON_newObject()
has created name/value-pairs in most cases and just the first call as initialized
the object itself. If you have big code, you can easily get the old style
back. At first, in your code, just replace any call to JSON_newObject() with
JSON_newPair(). JSON_newPair() is defined in line 601. There is outcommented
the line "602: ;JSON_newObject()". Please commend it in, and now
JSON_newPair() is doing the same as JSON_newObject() does in earlier
includes. But if you want to get a better readable code (or you doesn't have so
many lines of code by now, just look at the example to get a feeling for the
new behavior.

(example for JSON_newObject() and JSON_newPair())

Code: Select all

#JSON_UseObjectPointer = #True
IncludeFile "JSON_Parser.pbi"

Define *myJSON.jsonObj = JSON_create()
JSON_newObject(*myJSON)
JSON_newPair(*myJSON, "myString")
*myJSON\o("myString")\s = "text"
JSON_newPair(*myJSON, "myObject")

JSON_newObject(*myJSON\o("myObject"))
JSON_newPair(*myJSON\o("myObject"),  "value")
             *myJSON\o("myObject")\o("value")\i = 49
JSON_newPair(*myJSON\o("myObject"),  "nullValue")
             *myJSON\o("myObject")\o("nullValue")\type = #JSON_Type_Null
             
JSON_Debug(*myJSON, "")
JSON_free(*myJSON)

Posted: **Mon Oct 17, 2011 7:48 am**

Hi PMV,

I will check this in the next days. Thank you!

Best,

Kukulkan

Posted: **Tue Oct 18, 2011 9:49 am**

Seems to work perfectly so far. Thank you!

Kukulkan

Posted: **Mon Oct 24, 2011 3:11 pm**

I don't know if it is a bug or my fault. How to read such JSON structure with this decoder?

Code: Select all

{
  "Test 1":
  {
    "url":"https://test1.com",
    "logo":"",
    "logoname":"prov_1.jpg"
  },
  "Test 2":
  {
    "url":"https://test2.com",
    "logo":"",
    "logoname":"prov_2.jpg"
  },
  "Test 3":
  {
    "url":"https://test3.com",
    "logo":"",
    "logoname":"prov_3.jpg"
  }
}

This are mostly arrays and I fail directly on the first try to get the number of entries on the first level ("Test x"). How to use the json decoder on this kind of data?

Code: Select all

Define *out.jsonObj
*out = JSON_decode(Json.s)
Debug *out\length ; ->fails...

Kukulkan

Posted: **Mon Oct 24, 2011 9:23 pm**

This isn't a array, it is just two levels of objects.

This code will read your example as "JSON.txt"
and display it in debugger window.

Code: Select all

IncludeFile "JSON_Parser.pbi"

Define File.i = OpenFile(#PB_Any, "JSON.txt")
Define String.s = ""
Define Format.i = ReadStringFormat(File)
While Eof(File) = #False
  String + ReadString(File, Format) + Chr(13) + Chr(10)
Wend
CloseFile(File)

Debug String
Debug ""
Debug ""
Define *out.jsonObj = JSON_decode(String)
JSON_Debug(*out, "")


Debug "Test 1\url = " + *out\o("Test 1")\o("url")\s
Debug "Test 1\logo = " + *out\o("Test 1")\o("logo")\s
Debug "Test 1\logoname = " + *out\o("Test 1")\o("logoname")\s

A little hint that could be your problem:
My JSON-Parser can not handle errors properly, that means if it
gets a false character at the beginning or end of the JSON-String,
JSON_decode() will return #False. That means, the file-boom isn't
allowed to be inside of this string and will lead to *out = #False,
too.

Edit: an example with a real array
JSON.txt

Code: Select all

[
  {
    "url":"https://test1.com",
    "logo":"",
    "logoname":"prov_1.jpg"
  },
  {
    "url":"https://test2.com",
    "logo":"",
    "logoname":"prov_2.jpg"
  },
  {
    "url":"https://test3.com",
    "logo":"",
    "logoname":"prov_3.jpg"
  }
]

Code: Select all

IncludeFile "JSON_Parser.pbi"

Define File.i = OpenFile(#PB_Any, "JSON.txt")
Define String.s = ""
Define Format.i = ReadStringFormat(File)
While Eof(File) = #False
  String + ReadString(File, Format) + Chr(13) + Chr(10)
Wend
CloseFile(File)

Debug String
Debug ""
Debug ""
Define *out.jsonObj = JSON_decode(String)
Define i.i
For i = 0 To *out\length - 1
  Debug "Test " + Str(i) + "\url = " + *out\a(i)\o("url")\s
  Debug "Test " + Str(i) + "\logo = " + *out\a(i)\o("logo")\s
  Debug "Test " + Str(i) + "\logoname = " + *out\a(i)\o("logoname")\s
Next

MFG PMV

PureBasic Forums - English

JSON encoder and decoder

JSON encoder and decoder

Re: JSON encoder and decoder

Re: JSON encoder and decoder

Re: JSON encoder and decoder

Re: JSON encoder and decoder

Re: JSON encoder and decoder

Re: JSON encoder and decoder

Re: JSON encoder and decoder

Re: JSON encoder and decoder

Re: JSON encoder and decoder

Re: JSON encoder and decoder

Re: JSON encoder and decoder

Re: JSON encoder and decoder

Re: JSON encoder and decoder

Re: JSON encoder and decoder