JSON reader & writer

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
milan1612
Beiträge: 810
Registriert: 15.04.2007 17:58

JSON reader & writer

Beitrag von milan1612 »

Das ist die erste Version einer JSON (http://www.json.org) Include fuer Purebasic 4.5+.
Sie wurde nur wenig getestet, es ist also durchaus wahrscheinlich dass es noch Bugs gibt.
Auch gefallen mir einige Sachen noch nicht, die werd ich bei Gelegenheit noch verbessern.

Hier mal ein kleines Beispiel:

Code: Alles auswählen

XIncludeFile "PureJSON.pbi"
DisableExplicit

; wir erstellen ein json dokument:
root = JObject()

; hier fuegen wir ein Key/Value Paar dem Objekt hinzu:
JObjectAdd(root, JString("Purebasic"), "Name")

; noch ein Beispiel, wobei der Wert jetzt ein Double ist
JObjectAdd(root, JDouble(4.50), "Version")

; wir erstellen ein leeres array:
arr = JArray()

; ...und fuegen mehrere strings hinzu
JArrayAdd(arr, JString("MacOS"))
JArrayAdd(arr, JString("Linux"))
JArrayAdd(arr, JString("Windows"))

; jetzt fuegen wir das array in root ein:
JObjectAdd(root, arr, "Supported OS")

; hier serialisieren wir root in einen String:
json.s = JToString(root)
Debug json ; {"Version": 4.5000000000, "Name": "Purebasic", "Supported OS": ["MacOS", "Linux", "Windows"]}
Debug ""

; wir geben das objekt frei:
JFree(root) ; JFree loescht alle assozierten Objekte gleich mit, arr muessen wir also z.B. nicht mehr freigeben

; ...und lesen den json string wieder ein:
root = JFromString(json)

; jetzt haben wir das Ganze wieder deserialisiert und haben unser root Objekt wieder

Debug JAsString(JObjectGet(root, "Name")) ; Purebasic
Debug JAsDouble(JObjectGet(root, "Version")) ; 4.5
Debug JAsString(JArrayGet(JObjectGet(root, "Supported OS"), 2)) ; Windows

JFree(root)
Hier noch ein Beispiel um folgendes JSON Dokument auszulesen:
JSON:
{"menu": {
"id": "file",
"value": "File",
"popup": {
"menuitem": [
{"value": "New", "onclick": "CreateNewDoc()"},
{"value": "Open", "onclick": "OpenDoc()"},
{"value": "Close", "onclick": "CloseDoc()"}
]
}
}}
Code (wichtig: der JSON String muss in der Zwischenablage sein!):

Code: Alles auswählen

XIncludeFile "PureJSON.pbi"
DisableExplicit

json.s = GetClipboardText()

root = JFromString(json)
If root
  menu = JObjectGet(root, "menu")
  If menu
    popup = JObjectGet(menu, "popup")
    If popup
      menuitems = JObjectGet(popup, "menuitem")
      If menuitems
        first = JArrayGet(menuitems, 0)
        If first
          onclick = JObjectGet(first, "onclick")
          If onclick
            Debug JAsString(onclick) ; "CreateNewDoc()"
          EndIf
        EndIf
      EndIf
    EndIf
  EndIf
  JFree(root)
EndIf
PureJSON.pbi:

Code: Alles auswählen

; (c) 2010 Milan Schoemig <entity64@gmail.com>
; free software: give credit to the author and you're good to go
EnableExplicit

; types of json values. returned by JGetType()
Enumeration
  #JNull
  #JTrue
  #JFalse
  #JInteger
  #JDouble
  #JString
  #JObject
  #JArray
EndEnumeration

; INTERNAL
Structure JSON
  Type.i
  StructureUnion
    *val_int.Integer
    *val_double.Double
    *val_string.String
    *val_object._JSONObj
    *val_array._JSONArr
  EndStructureUnion
EndStructure

; INTERNAL
Structure _JSONObj
  Map Values.JSON()
EndStructure

; INTERNAL
Structure _JSONArr
  List Values.JSON()
EndStructure

;- START OF PUBLIC FUNCTIONS

; the prototype for JForEachs callback
Prototype cbproto(Key.s, Value.i, UserParam.i)

; frees any underlying json memory. the second parameter is for internal use only!
DeclareDLL JFree(*Json.JSON, Free = 1)

; dumps the json object to a string
DeclareDLL.s JToString(*Json.JSON)

; parses a json string and returns the object/array. returns 0 if it failes
DeclareDLL JFromString(Str.s)

; returns a new json object
DeclareDLL JObject()

; returns a new json array
DeclareDLL JArray()

; returns a json string representing the Str.s string parameter
DeclareDLL JString(Str.s)

; returns a JInteger with value Int.i
DeclareDLL JInteger(Int.i)

; returns a JDouble with value Dou.d
DeclareDLL JDouble(Dou.d)

; returns a json null literal
DeclareDLL JNull()

; returns a json true literal
DeclareDLL JTrue()

; returns a json false literal
DeclareDLL JFalse()

; adds *Json to *Object forming a key/value pair with key Key.s
DeclareDLL JObjectAdd(*Object.JSON, *Json.JSON, Key.s)

; adds *Json to *Array
DeclareDLL JArrayAdd(*Array.JSON, *Json.JSON)

; returns the arrays size
DeclareDLL JArraySize(*Array.JSON)

; returns the json value at the specified index (base 0!)
DeclareDLL JArrayGet(*Array.JSON, Index.i)

; returns the json value at key Key.s
DeclareDLL JObjectGet(*Object.JSON, Key.s)

; calls the *Callback for each json value in the object. UserParam can pass anything to the function
DeclareDLL JForEach(*Obj.JSON, *Callback.cbproto, UserParam.i = 0)

; returns the type of the json value. see enumeration on top of this file
DeclareDLL JGetType(*Json.JSON)

; returns the associated integer value of *Json
DeclareDLL JAsInteger(*Json.JSON)

; returns the associated double value of *Json
DeclareDLL.d JAsDouble(*Json.JSON)

; returns the associated string of *Json
DeclareDLL.s JAsString(*Json.JSON)

; END OF PUBLIC FUNCTIONS

;- START OF IMPLEMENTATION
Declare.s NextToken(peek = 0, str.s = "")
Declare ParseJSON()
Declare ParseNumber(token.s)

ProcedureDLL JFree(*Json.JSON, Free = 1)
  Select *Json\Type
    Case #JInteger
      FreeMemory(*Json\val_int)
    Case #JDouble
      FreeMemory(*Json\val_double)
    Case #JString
      ClearStructure(*Json\val_string, String)
      FreeMemory(*Json\val_string)
    Case #JObject
      ForEach *Json\val_object\Values()
        JFree(@*Json\val_object\Values(), 0)
      Next
      ClearMap(*Json\val_object\Values())
      ClearStructure(*Json\val_object, _JSONObj)
      FreeMemory(*Json\val_object)
    Case #JArray
      ForEach *Json\val_array\Values()
        JFree(@*Json\val_array\Values(), 0)
      Next
      ClearList(*Json\val_array\Values())
      ClearStructure(*Json\val_array, _JSONArr)
      FreeMemory(*Json\val_array)
  EndSelect
  If Free
    FreeMemory(*Json)
  EndIf
EndProcedure

ProcedureDLL.s JToString(*Json.JSON)
  Protected res.s = ""
  Select *Json\Type
    Case #JNull
      res = "null"
    Case #JTrue
      res = "true"
    Case #JFalse
      res = "false"
    Case #JInteger
      res = Str(*Json\val_int\i)
    Case #JDouble
      res = StrD(*Json\val_double\d)
    Case #JString
      res = Chr('"') + *Json\val_string\s + Chr('"')
    Case #JObject
      res = "{"
      ForEach *Json\val_object\Values()
        res + Chr('"') + MapKey(*Json\val_object\Values()) + Chr('"') + ": " + JToString(@*Json\val_object\Values()) + ", "
      Next
      If Len(res) > 2 And Right(res, 2) = ", "
        res = Left(res, Len(res) - 2)
      EndIf
      res + "}"
    Case #JArray
      res = "["
      ForEach *Json\val_array\Values()
        res + JToString(@*Json\val_array\Values()) + ", "
      Next
      If Len(res) > 2 And Right(res, 2) = ", "
        res = Left(res, Len(res) - 2)
      EndIf
      res + "]"
  EndSelect
  ProcedureReturn res
EndProcedure

ProcedureDLL JFromString(Str.s)
  Protected tmp.s = NextToken(1, Str)
  If tmp <> "{" And tmp <> "["
    Debug "json: document must start with either an object or an array"
    ProcedureReturn 0
  EndIf
  ProcedureReturn ParseJSON()
EndProcedure

ProcedureDLL JObject()
  Protected *obj.JSON = AllocateMemory(SizeOf(JSON))
  *obj\Type = #JObject
  *obj\val_object = AllocateMemory(SizeOf(_JSONObj))
  InitializeStructure(*obj\val_object, _JSONObj)
  ProcedureReturn *obj
EndProcedure

ProcedureDLL JArray()
  Protected *arr.JSON = AllocateMemory(SizeOf(JSON))
  *arr\Type = #JArray
  *arr\val_array = AllocateMemory(SizeOf(_JSONArr))
  InitializeStructure(*arr\val_array, _JSONArr)
  ProcedureReturn *arr
EndProcedure

ProcedureDLL JString(Str.s)
  Protected *str.JSON = AllocateMemory(SizeOf(JSON))
  *str\Type = #JString
  *str\val_string = AllocateMemory(SizeOf(String))
  InitializeStructure(*str\val_string, String)
  *str\val_string\s = Str
  ProcedureReturn *str
EndProcedure

ProcedureDLL JInteger(Int.i)
  Protected *int.JSON = AllocateMemory(SizeOf(JSON))
  *int\Type = #JInteger
  *int\val_int = AllocateMemory(SizeOf(Integer))
  *int\val_int\i = Int
  ProcedureReturn *int
EndProcedure

ProcedureDLL JDouble(Dou.d)
  Protected *dou.JSON = AllocateMemory(SizeOf(JSON))
  *dou\Type = #JDouble
  *dou\val_double = AllocateMemory(SizeOf(Double))
  *dou\val_double\d = Dou
  ProcedureReturn *dou
EndProcedure

ProcedureDLL JNull()
  Protected *j.JSON = AllocateMemory(SizeOf(JSON))
  *j\Type = #JNull
  ProcedureReturn *j
EndProcedure

ProcedureDLL JTrue()
  Protected *j.JSON = AllocateMemory(SizeOf(JSON))
  *j\Type = #JTrue
  ProcedureReturn *j
EndProcedure

ProcedureDLL JFalse()
  Protected *j.JSON = AllocateMemory(SizeOf(JSON))
  *j\Type = #JFalse
  ProcedureReturn *j
EndProcedure

ProcedureDLL JObjectAdd(*Object.JSON, *Json.JSON, Key.s)
  If FindMapElement(*Object\val_object\Values(), Key)
    JFree(@*Object\val_object\Values(), 0)
  EndIf
  AddMapElement(*Object\val_object\Values(), Key)
  CopyMemory(*Json, *Object\val_object\Values(), SizeOf(JSON))
  FreeMemory(*Json)
EndProcedure

ProcedureDLL JArrayAdd(*Array.JSON, *Json.JSON)
  AddElement(*Array\val_array\Values())
  CopyMemory(*Json, *Array\val_array\Values(), SizeOf(JSON))
  FreeMemory(*Json)
EndProcedure

ProcedureDLL JArraySize(*Array.JSON)
  ProcedureReturn ListSize(*Array\val_array\Values())
EndProcedure

ProcedureDLL JArrayGet(*Array.JSON, Index.i)
  SelectElement(*Array\val_array\Values(), Index)
  ProcedureReturn *Array\val_array\Values()
EndProcedure

ProcedureDLL JObjectGet(*Object.JSON, Key.s)
  ProcedureReturn *Object\val_object\Values(Key)
EndProcedure

ProcedureDLL JForEach(*Obj.JSON, *Callback.cbproto, UserParam.i = 0)
  If *Obj\Type = #JObject
    ForEach *Obj\val_object\Values()
      *Callback(MapKey(*Obj\val_object\Values()), *Obj\val_object\Values(), UserParam)
    Next
  EndIf
EndProcedure

ProcedureDLL JGetType(*Json.JSON)
  ProcedureReturn *Json\Type
EndProcedure

ProcedureDLL JAsInteger(*Json.JSON)
  ProcedureReturn *Json\val_int\i
EndProcedure

ProcedureDLL.d JAsDouble(*Json.JSON)
  ProcedureReturn *Json\val_double\d
EndProcedure

ProcedureDLL.s JAsString(*Json.JSON)
  ProcedureReturn *Json\val_string\s
EndProcedure

;- INTERNAL FUNCTIONS

Procedure.s NextToken(peek = 0, string.s = "")
  Static s.s
  Static *c.Character
  If string <> ""
    s = string
    *c = @s
  EndIf
  Protected old = *c
  Protected buff.s = ""
  Protected instr = 0
  Protected wasesc = 0
  While *c\c <> 0
    If instr
      If *c\c = '\'
        If wasesc
          wasesc = 0
        Else
          wasesc = 1
        EndIf
      ElseIf *c\c = '"' And wasesc = 0
        buff + Chr('"')
        *c + SizeOf(Character)
        Break
      Else
        wasesc = 0
      EndIf
      buff + Chr(*c\c)
    ElseIf *c\c = '"'
      instr = 1
      buff + Chr('"')
    Else
      Select *c\c
        Case ' ', 9, 13, 10
          If Len(buff) > 0
            *c + SizeOf(Character)
            Break
          EndIf
        Case ':', '{', '}', '[', ']', ','
          If Len(buff) > 0
            Break
          EndIf
          buff = Chr(*c\c)
          *c + SizeOf(Character)
          Break
        Default
          buff + Chr(*c\c)
      EndSelect
    EndIf
    *c + SizeOf(Character)
  Wend

  If peek
    *c = old
  EndIf
  ProcedureReturn buff
EndProcedure

Procedure ParseJSON()
  Protected token.s = NextToken()
  Protected str.s, *tmp.JSON
  Protected *value.JSON
  
  If token = "{"
    *value = JObject()
    If NextToken(1) <> "}"
      Repeat
        token = NextToken()
        If Left(token, 1) = Chr(34) And Right(token, 1) = Chr(34)
          str = Mid(token, 2, Len(token) - 2)
          token = NextToken()
          If token = ":"
            *tmp = ParseJSON()
            If *tmp <> 0
              AddMapElement(*value\val_object\Values(), str)
              CopyMemory(*tmp, @*value\val_object\Values(), SizeOf(JSON))
              FreeMemory(*tmp)
            Else
              JFree(*value) : ProcedureReturn 0
            EndIf
          Else
            Debug "json: expected colon, got " + token
            JFree(*value) : ProcedureReturn 0
          EndIf
        Else
          Debug "json: expected string, got " + token
          JFree(*value) : ProcedureReturn 0
        EndIf
        
        token = NextToken()
        If token = ","
          Continue
        ElseIf token = "}"
          Break
        Else
          Debug "json: expected ',' or '}', got " + token
          JFree(*value) : ProcedureReturn 0
        EndIf
      ForEver
    EndIf
  ElseIf token = "["
    *value = JArray()
    If NextToken(1) <> "]"
      Repeat
        *tmp = ParseJSON()
        If *tmp <> 0
          AddElement(*value\val_array\Values())
          CopyMemory(*tmp, @*value\val_array\Values(), SizeOf(JSON))
          FreeMemory(*tmp)
        Else
          JFree(*value) : ProcedureReturn 0
        EndIf
        
        token = NextToken()
        If token = ","
          Continue
        ElseIf token = "]"
          Break
        Else
          Debug "json: expected ',' or ']', got " + token
          JFree(*value) : ProcedureReturn 0
        EndIf
      ForEver
    EndIf
  ElseIf Left(token, 1) = Chr(34) And Right(token, 1) = Chr(34)
    *value = JString(Mid(token, 2, Len(token) - 2))
  ElseIf token = "null"
    *value = JNull()
  ElseIf token = "true"
    *value = JTrue()
  ElseIf token = "false"
    *value = JFalse()
  Else
    *value = ParseNumber(token)
    If *value = 0
      Debug "json: unknown token " + token
    EndIf
  EndIf
  
  ProcedureReturn *value
EndProcedure

Procedure ParseNumber(token.s)
  If Str(Val(token)) = token
    ProcedureReturn JInteger(Val(token))
  ElseIf StrD(ValD(token)) = token
    ProcedureReturn JDouble(ValD(token))
  EndIf
EndProcedure
Am Anfang der Include findet ihr fuer jede Funktion eine kleine Beschreibung was sie tut.
Bin fuer Fragen und Anregungen aber immer zu haben :wink:
Bin nur noch sehr selten hier, bitte nur noch per PN kontaktieren
Kaeru Gaman
Beiträge: 17389
Registriert: 10.11.2004 03:22

Re: JSON reader & writer

Beitrag von Kaeru Gaman »

zu Anfang eine Anregung für deinen Thread: du solltest erklären oder zumindest direkt verlinken, wer JaSON eigentlich ist...
Der Narr denkt er sei ein weiser Mann.
Der Weise weiß, dass er ein Narr ist.
Benutzeravatar
milan1612
Beiträge: 810
Registriert: 15.04.2007 17:58

Re: JSON reader & writer

Beitrag von milan1612 »

Kaeru Gaman hat geschrieben:zu Anfang eine Anregung für deinen Thread: du solltest erklären oder zumindest direkt verlinken, wer JaSON eigentlich ist...
Guckst du in die erste Zeile meines Threads...
Bin nur noch sehr selten hier, bitte nur noch per PN kontaktieren
Benutzeravatar
CSHW89
Beiträge: 489
Registriert: 14.12.2008 12:22

Re: JSON reader & writer

Beitrag von CSHW89 »

*rausgrab*

Hi milan,

erstmal klasse Include :allright:
hatte mich vor kurzem mit JSON beschäftigt. hatte sogar kurz überlegt einen eigenen interpreter zu schreiben, bis ich deinen gefunden hatte. und nun hab ich ein projekt angefangen, in dem ich sowas auch noch brauche. hatte mir auch xml angesehen, wollt mich da aber nicht wirklich reinlesen, und deine include ist ja sehr einfach aufgebaut ;).

jetzt hab ich aber auch was zu meckern. hab nämlich ein kleinen bug gefunden. das parsen von leeren objekten und leeren arrays hat nicht funktioniert. hab den fehler aber gefunden und korrigiert

dazu hab ich noch 2 kleine dinge geändert. sie sind nicht wirklich zwingend notwendig, is aber für mich ganz hilfreich gewesen:
- da ich die erstellten JSON-Strings in einer datei speichere, hab ich bei objekten ein zeilenumbruch hinzugefügt ('JToString'). is denk ich übersichtlicher. der zusätzliche parameter wird nur intern benutzt.
- beim lesen eines JSON-Strings können IMA's vorkommen. insbesondere wenn es in einem objekt ein schlüssel nicht gibt. ich hab bei 'JGetObject' und 'JGetArray' ein paar kontrollen eingeführt, und bei den 'JAs..'-Methoden ein default-Parameter hinzugefügt (ahnlich wie bei den ReadPreference-Methoden)

hier noch ein kleines beispiel zu den 'JAs..'-Methoden:

Code: Alles auswählen

*root = JFromString("{"+Chr(34)+"key"+Chr(34)+" : 1}")
Debug JAsInteger(JObjectGet(*root, "key"), 42) ; key ist bekannt, es wird 1 zurückgeben
Debug JAsInteger(JObjectGet(*root, "optional"), 42) ; optional ist nicht drin, es wird 42 zurückgegeben
damit es hier nicht zu unübersichtlich wird, hab ich den code upgeloadet:
http://cshw89.mevedia.de/JSON.pb

lg kevin
Zuletzt geändert von CSHW89 am 07.04.2012 15:52, insgesamt 1-mal geändert.
Bild Bild Bild
http://www.jasik.de - Windows Hilfe Seite
padawan hat geschrieben:Ich liebe diese von hinten über die Brust ins Auge Lösungen
Benutzeravatar
Didelphodon
Beiträge: 360
Registriert: 18.12.2004 13:03
Wohnort: Wien
Kontaktdaten:

Re: JSON reader & writer

Beitrag von Didelphodon »

Coole und nutzvolle Erweiterung. Bitte auch gleich sowas für SOAP machen, dann wären die aktuellen Datenkommunikationsframeworks über Web in PB endlich "umgehend" verfügbar/abgedeckt, wenn man sie braucht.

LG D.
Das Leben ist ein sch*** Spiel, aber die Grafik ist irre!
Fighting for peace is like fuc*ing for virginity!
marco2007
Beiträge: 906
Registriert: 26.10.2006 13:19
Kontaktdaten:

Re: JSON reader & writer

Beitrag von marco2007 »

Bin via http://www.purebasic.fr/english/viewtop ... =3&t=44796 hier herkommen.
Ich kenne JSON gar nicht, sieht mich aber gut an :-)

Auf jeden Fall Danke für die Include, werde ich ehest testen :-)
Windows 11 - PB 6.03 x64
_________________________________
Benutzeravatar
milan1612
Beiträge: 810
Registriert: 15.04.2007 17:58

Re: JSON reader & writer

Beitrag von milan1612 »

Danke Kevin, schön dass du was damit anfangen kannst.

JSON ist ein sehr nützliches und einfaches Format, wenn ich mal wieder Zeit habe,
mache ich das Ganze vielleicht noch mal neu.

Auch wenn mittlerweile eigentlich nur noch C++ u. Java nutze...
Bin nur noch sehr selten hier, bitte nur noch per PN kontaktieren
oO0XX0Oo
Beiträge: 55
Registriert: 21.07.2017 22:36

Re: JSON reader & writer

Beitrag von oO0XX0Oo »

@CSHW89
damit es hier nicht zu unübersichtlich wird, hab ich den code upgeloadet:
Ich weiß, das Ganze hier ist schon sehr alt, aber könntest du die Datei noch mal irgendwo zur Verfügung stellen?

Danke!
Benutzeravatar
Kiffi
Beiträge: 10621
Registriert: 08.09.2004 08:21
Wohnort: Amphibios 9

Re: JSON reader & writer

Beitrag von Kiffi »

oO0XX0Oo hat geschrieben: 01.12.2021 11:55Ich weiß, das Ganze hier ist schon sehr alt, aber könntest du die Datei noch mal irgendwo zur Verfügung stellen?
seit Version 5.30 (23th July 2014) gibt's die JSON-Library.
Hygge
Benutzeravatar
CSHW89
Beiträge: 489
Registriert: 14.12.2008 12:22

Re: JSON reader & writer

Beitrag von CSHW89 »

Wie Kiffi sagt, sollte die interne Library verwendet werden. Aber hier nochmal meine überarbeitete Version:

Code: Alles auswählen

; (c) 2010 Milan Schoemig <entity64@gmail.com>
; free software: give credit to the author and you're good to go

; types of json values. returned by JGetType()
Enumeration
  #JNull
  #JTrue
  #JFalse
  #JInteger
  #JDouble
  #JString
  #JObject
  #JArray
EndEnumeration

; INTERNAL
Structure JSON
  Type.i
  StructureUnion
    *val_int.Integer
    *val_double.Double
    *val_string.String
    *val_object._JSONObj
    *val_array._JSONArr
  EndStructureUnion
EndStructure

; INTERNAL
Structure _JSONObj
  Map Values.JSON()
EndStructure

; INTERNAL
Structure _JSONArr
  List Values.JSON()
EndStructure

;- START OF PUBLIC FUNCTIONS

; the prototype for JForEachs callback
Prototype cbproto(Key.s, Value.i, UserParam.i)

; frees any underlying json memory. the second parameter is for internal use only!
DeclareDLL JFree(*Json.JSON, Free = 1)

; dumps the json object to a string
DeclareDLL.s JToString(*Json.JSON, spaces = 0)

; parses a json string and returns the object/array. returns 0 if it failes
DeclareDLL JFromString(Str.s)

; returns a new json object
DeclareDLL JObject()

; returns a new json array
DeclareDLL JArray()

; returns a json string representing the Str.s string parameter
DeclareDLL JString(Str.s)

; returns a JInteger with value Int.i
DeclareDLL JInteger(Int.i)

; returns a JDouble with value Dou.d
DeclareDLL JDouble(Dou.d)

; returns a json null literal
DeclareDLL JNull()

; returns a json true literal
DeclareDLL JTrue()

; returns a json false literal
DeclareDLL JFalse()

; adds *Json to *Object forming a key/value pair with key Key.s
DeclareDLL JObjectAdd(*Object.JSON, *Json.JSON, Key.s)

; adds *Json to *Array
DeclareDLL JArrayAdd(*Array.JSON, *Json.JSON)

; returns the arrays size
DeclareDLL JArraySize(*Array.JSON)

; returns the json value at the specified index (base 0!)
DeclareDLL JArrayGet(*Array.JSON, Index.i)

; returns the json value at key Key.s
DeclareDLL JObjectGet(*Object.JSON, Key.s)

; calls the *Callback for each json value in the object. UserParam can pass anything to the function
DeclareDLL JForEach(*Obj.JSON, *Callback.cbproto, UserParam.i = 0)

; returns the type of the json value. see enumeration on top of this file
DeclareDLL JGetType(*Json.JSON)

; returns the associated integer value of *Json
DeclareDLL JAsInteger(*Json.JSON, defaultint.i = 0)

; returns the associated double value of *Json
DeclareDLL.d JAsDouble(*Json.JSON, defaultdouble.d = 0)

; returns the associated string of *Json
DeclareDLL.s JAsString(*Json.JSON, defaultstring.s = "")

; END OF PUBLIC FUNCTIONS

;- START OF IMPLEMENTATION
Declare.s NextToken(peek = 0, str.s = "")
Declare ParseJSON()
Declare ParseNumber(token.s)

ProcedureDLL JFree(*Json.JSON, Free = 1)
  Select *Json\Type
    Case #JInteger
      FreeMemory(*Json\val_int)
    Case #JDouble
      FreeMemory(*Json\val_double)
    Case #JString
      ClearStructure(*Json\val_string, String)
      FreeMemory(*Json\val_string)
    Case #JObject
      ForEach *Json\val_object\Values()
        JFree(@*Json\val_object\Values(), 0)
      Next
      ClearMap(*Json\val_object\Values())
      ClearStructure(*Json\val_object, _JSONObj)
      FreeMemory(*Json\val_object)
    Case #JArray
      ForEach *Json\val_array\Values()
        JFree(@*Json\val_array\Values(), 0)
      Next
      ClearList(*Json\val_array\Values())
      ClearStructure(*Json\val_array, _JSONArr)
      FreeMemory(*Json\val_array)
  EndSelect
  If Free
    FreeMemory(*Json)
  EndIf
EndProcedure

ProcedureDLL.s JToString(*Json.JSON, spaces = 0)
  Protected res.s = ""
  Select *Json\Type
    Case #JNull
      res = "null"
    Case #JTrue
      res = "true"
    Case #JFalse
      res = "false"
    Case #JInteger
      res = Str(*Json\val_int\i)
    Case #JDouble
      res = StrD(*Json\val_double\d)
    Case #JString
      res = *Json\val_string\s
      res = ReplaceString(res, "\", "\\")
      res = ReplaceString(res, #DQUOTE$, "\"+#DQUOTE$)
      res = Chr('"') + res + Chr('"')
    Case #JObject
      res = #LF$ + Space(spaces) + "{" + #LF$
      spaces + 2
      ForEach *Json\val_object\Values()
        res + Space(spaces) + Chr('"') + MapKey(*Json\val_object\Values()) + Chr('"') + ": " + JToString(@*Json\val_object\Values(), spaces) + ", "+#LF$
      Next
      If Len(res) > 2 And Right(res, 3) = ", "+#LF$
        res = Left(res, Len(res) - 3)
      EndIf
      spaces - 2
      res + #LF$ + Space(spaces) + "}"
    Case #JArray
      res = "["
      ForEach *Json\val_array\Values()
        res + JToString(@*Json\val_array\Values(), spaces) + ", "
      Next
      If Len(res) > 2 And Right(res, 2) = ", "
        res = Left(res, Len(res) - 2)
      EndIf
      res + "]"
  EndSelect
  ProcedureReturn res
EndProcedure

ProcedureDLL JFromString(Str.s)
  Protected tmp.s = NextToken(1, Str)
;   Repeat
;     tmp = NextToken()
;     Debug tmp
;   Until (tmp = "")
;   End
  If tmp <> "{" And tmp <> "["
    Debug "json: document must start with either an object or an array"
    ProcedureReturn 0
  EndIf
  ProcedureReturn ParseJSON()
EndProcedure

ProcedureDLL JObject()
  Protected *obj.JSON = AllocateMemory(SizeOf(JSON))
  *obj\Type = #JObject
  *obj\val_object = AllocateMemory(SizeOf(_JSONObj))
  InitializeStructure(*obj\val_object, _JSONObj)
  ProcedureReturn *obj
EndProcedure

ProcedureDLL JArray()
  Protected *arr.JSON = AllocateMemory(SizeOf(JSON))
  *arr\Type = #JArray
  *arr\val_array = AllocateMemory(SizeOf(_JSONArr))
  InitializeStructure(*arr\val_array, _JSONArr)
  ProcedureReturn *arr
EndProcedure

ProcedureDLL JString(Str.s)
  Protected *str.JSON = AllocateMemory(SizeOf(JSON))
  *str\Type = #JString
  *str\val_string = AllocateMemory(SizeOf(String))
  InitializeStructure(*str\val_string, String)
  *str\val_string\s = Str
  ProcedureReturn *str
EndProcedure

ProcedureDLL JInteger(Int.i)
  Protected *int.JSON = AllocateMemory(SizeOf(JSON))
  *int\Type = #JInteger
  *int\val_int = AllocateMemory(SizeOf(Integer))
  *int\val_int\i = Int
  ProcedureReturn *int
EndProcedure

ProcedureDLL JDouble(Dou.d)
  Protected *dou.JSON = AllocateMemory(SizeOf(JSON))
  *dou\Type = #JDouble
  *dou\val_double = AllocateMemory(SizeOf(Double))
  *dou\val_double\d = Dou
  ProcedureReturn *dou
EndProcedure

ProcedureDLL JNull()
  Protected *j.JSON = AllocateMemory(SizeOf(JSON))
  *j\Type = #JNull
  ProcedureReturn *j
EndProcedure

ProcedureDLL JTrue()
  Protected *j.JSON = AllocateMemory(SizeOf(JSON))
  *j\Type = #JTrue
  ProcedureReturn *j
EndProcedure

ProcedureDLL JFalse()
  Protected *j.JSON = AllocateMemory(SizeOf(JSON))
  *j\Type = #JFalse
  ProcedureReturn *j
EndProcedure

ProcedureDLL JObjectAdd(*Object.JSON, *Json.JSON, Key.s)
  If FindMapElement(*Object\val_object\Values(), Key)
    JFree(@*Object\val_object\Values(), 0)
  EndIf
  AddMapElement(*Object\val_object\Values(), Key)
  CopyMemory(*Json, *Object\val_object\Values(), SizeOf(JSON))
  FreeMemory(*Json)
EndProcedure

ProcedureDLL JArrayAdd(*Array.JSON, *Json.JSON)
  AddElement(*Array\val_array\Values())
  CopyMemory(*Json, *Array\val_array\Values(), SizeOf(JSON))
  FreeMemory(*Json)
EndProcedure

ProcedureDLL JArraySize(*Array.JSON)
  If (*Array = #Null)
    ProcedureReturn -1
  ElseIf (*Array\Type <> #JArray)
    ProcedureReturn -1
  EndIf
  ProcedureReturn ListSize(*Array\val_array\Values())
EndProcedure

ProcedureDLL JArrayGet(*Array.JSON, Index.i)
  If (*Array = #Null)
    ProcedureReturn #Null
  ElseIf (*Array\Type <> #JArray)
    ProcedureReturn #Null
  ElseIf (Index < 0) Or (Index >= ListSize(*Array\val_array\Values()))
    ProcedureReturn #Null
  EndIf
  SelectElement(*Array\val_array\Values(), Index)
  ProcedureReturn *Array\val_array\Values()
EndProcedure

ProcedureDLL JObjectGet(*Object.JSON, Key.s)
  If (*Object = #Null)
    ProcedureReturn #Null
  ElseIf (*Object\Type <> #JObject)
    ProcedureReturn #Null
  ElseIf (FindMapElement(*Object\val_object\Values(), Key) = #Null)
    ProcedureReturn #Null
  EndIf
  ProcedureReturn *Object\val_object\Values(Key)
EndProcedure

ProcedureDLL JForEach(*Obj.JSON, *Callback.cbproto, UserParam.i = 0)
  If *Obj\Type = #JObject
    ForEach *Obj\val_object\Values()
      *Callback(MapKey(*Obj\val_object\Values()), *Obj\val_object\Values(), UserParam)
    Next
  EndIf
EndProcedure

ProcedureDLL JGetType(*Json.JSON)
  ProcedureReturn *Json\Type
EndProcedure

ProcedureDLL JAsInteger(*Json.JSON, defaultint.i = 0)
  If (*Json = #Null)
    ProcedureReturn defaultint
  EndIf
  ProcedureReturn *Json\val_int\i
EndProcedure

ProcedureDLL.d JAsDouble(*Json.JSON, defaultdouble.d = 0)
  If (*Json = #Null)
    ProcedureReturn defaultdouble
  EndIf
  ProcedureReturn *Json\val_double\d
EndProcedure

ProcedureDLL.s JAsString(*Json.JSON, defaultstring.s = "")
  If (*Json = #Null)
    ProcedureReturn defaultstring
  EndIf
  ProcedureReturn *Json\val_string\s
EndProcedure

;- INTERNAL FUNCTIONS

Procedure.s NextToken(peek = 0, string.s = "")
  Static s.s
  Static *c.Character
  If string <> ""
    s = string
    *c = @s
  EndIf
  Protected old = *c
  Protected buff.s = ""
  Protected instr = 0
  Protected wasesc = 0
  While *c\c <> 0
    If instr
      If *c\c = '\'
        If wasesc
          wasesc = 0
        Else
          wasesc = 1
        EndIf
      ElseIf *c\c = '"' And wasesc = 0
        buff + Chr('"')
        *c + SizeOf(Character)
        Break
      Else
        wasesc = 0
      EndIf
      If wasesc = 0
        buff + Chr(*c\c)
      EndIf
    ElseIf *c\c = '"'
      instr = 1
      buff + Chr('"')
    Else
      Select *c\c
        Case ' ', 9, 13, 10
          If Len(buff) > 0
            *c + SizeOf(Character)
            Break
          EndIf
        Case ':', '{', '}', '[', ']', ','
          If Len(buff) > 0
            Break
          EndIf
          buff = Chr(*c\c)
          *c + SizeOf(Character)
          Break
        Default
          buff + Chr(*c\c)
      EndSelect
    EndIf
    *c + SizeOf(Character)
  Wend

  If peek
    *c = old
  EndIf
  ProcedureReturn buff
EndProcedure

Procedure ParseJSON()
  Protected token.s = NextToken()
  Protected str.s, *tmp.JSON
  Protected *value.JSON
 
  If token = "{"
    *value = JObject()
    If NextToken(1) <> "}"
      Repeat
        token = NextToken()
        
;         Debug token
        If Left(token, 1) = Chr(34) And Right(token, 1) = Chr(34)
          str = Mid(token, 2, Len(token) - 2)
          token = NextToken()
          If token = ":"
            *tmp = ParseJSON()
            If *tmp <> 0
              AddMapElement(*value\val_object\Values(), str)
              CopyMemory(*tmp, @*value\val_object\Values(), SizeOf(JSON))
              FreeMemory(*tmp)
            Else
              JFree(*value) : ProcedureReturn 0
            EndIf
          Else
            Debug "json: expected colon, got " + token
            JFree(*value) : ProcedureReturn 0
          EndIf
        Else
          Debug "json: expected string, got " + token
          JFree(*value) : ProcedureReturn 0
        EndIf
        
        token = NextToken()
        If token = ","
          Continue
        ElseIf token = "}"
          Break
        Else
          Debug "json: expected ',' or '}', got " + token
          JFree(*value) : ProcedureReturn 0
        EndIf
      ForEver
    Else
      NextToken()
    EndIf
  ElseIf token = "["
    *value = JArray()
    If NextToken(1) <> "]"
      Repeat
        *tmp = ParseJSON()
        If *tmp <> 0
          AddElement(*value\val_array\Values())
          CopyMemory(*tmp, @*value\val_array\Values(), SizeOf(JSON))
          FreeMemory(*tmp)
        Else
          JFree(*value) : ProcedureReturn 0
        EndIf
       
        token = NextToken()
        If token = ","
          Continue
        ElseIf token = "]"
          Break
        Else
          Debug "json: expected ',' or ']', got " + token
          JFree(*value) : ProcedureReturn 0
        EndIf
      ForEver
    Else
      NextToken()
    EndIf
  ElseIf Left(token, 1) = Chr(34) And Right(token, 1) = Chr(34)
    *value = JString(Mid(token, 2, Len(token) - 2))
  ElseIf token = "null"
    *value = JNull()
  ElseIf token = "true"
    *value = JTrue()
  ElseIf token = "false"
    *value = JFalse()
  Else
    *value = ParseNumber(token)
    If *value = 0
      Debug "json: unknown token " + token
    EndIf
  EndIf
 
  ProcedureReturn *value
EndProcedure

Procedure ParseNumber(token.s)
  If Str(Val(token)) = token
    ProcedureReturn JInteger(Val(token))
  ElseIf StrD(ValD(token)) = token
    ProcedureReturn JDouble(ValD(token))
  EndIf
EndProcedure


Procedure JReadFile(file.s)
  Protected idx, format, size, *mem, *root
  
  idx = ReadFile(#PB_Any, file)
  If (idx <> 0)
    format = ReadStringFormat(idx)
    size = Lof(idx) - Loc(idx)
    *mem = AllocateMemory(size+1)
    ReadData(idx, *mem, size)
    CloseFile(idx)
    *root = JFromString(PeekS(*mem, -1, format))
    FreeMemory(*mem)
    ProcedureReturn *root
  EndIf
EndProcedure


Procedure JWriteFile(file.s, *root)
  Protected json.s, idx
  
  json = JToString(*root)
  JFree(*root)
  
  idx = CreateFile(#PB_Any, file)
  If (idx <> 0)
    WriteStringFormat(idx, #PB_UTF8)
    WriteString(idx, json, #PB_UTF8)
    CloseFile(idx)
  EndIf
EndProcedure
Bild Bild Bild
http://www.jasik.de - Windows Hilfe Seite
padawan hat geschrieben:Ich liebe diese von hinten über die Brust ins Auge Lösungen
Antworten