Ich brauchte die Tage einen JSON Parser für Language und Config Files.
Das ganze funktioniert soweit recht gut nur bin ich mir nicht sicher ob ich was beim JSON vergessen habe,
der soll wiederverwendbar sein daher lieber gleich ans Wichtigste denken
Wäre nett wen ihr ihn mal testen würden und schaut ob was wichtiges fehlt
Hier mal der Code & mein test JSON File
Sorry für den augenkrebs
Code: Alles auswählen
;- Constant Enumeration
Enumeration
#JS_T_Object
#JS_T_Array
#JS_T_String
#JS_T_Integer
#JS_T_Float
#JS_T_True
#JS_T_False
EndEnumeration
;- jsonObject Structure
Structure jsonObject
type.b
*parent.jsonObject
string.s
Map *obj.jsonObject()
Array *arr.jsonObject(0)
StructureUnion
integer.i
length.i
float.d
EndStructureUnion
EndStructure
;----------------------------------------------
; String pointer auswerten
Procedure.s getString(String.s)
Protected *p
If PeekC(@String) = 42
*p = Val(PeekS(@String + SizeOf(Character), (Len(String) * SizeOf(Character)) - SizeOf(Character)))
ProcedureReturn PeekS(*p, MemorySize(*p))
Else
ProcedureReturn String
EndIf
EndProcedure
; Value auswerten
Procedure setValue(*myObj.jsonObject, value.s)
Select PeekC(@value)
Case 42
*myObj\string = getString(value)
*myObj\type = #JS_T_String
; True/false auslesen
Case 84, 116
*myObj\Type = #JS_T_True
Case 70, 102
*myObj\Type = #JS_T_False
Case 36, 48 To 57
; Float auslesen
If Mod(ValF(value), 1)
*myObj\Type = #JS_T_Float
*myObj\float = ValF(value)
; Integer auslesen
Else
*myObj\Type = #JS_T_Integer
*myObj\integer = Val(value)
EndIf
EndSelect
EndProcedure
; Array erweitern
Procedure ReDimObjArray(*myObj.jsonObject)
ReDim *myObj\arr(*myObj\length)
*myObj\arr(*myObj\length) = AllocateMemory(SizeOf(jsonObject))
InitializeStructure(*myObj\arr(*myObj\length), jsonObject)
*myObj\arr(*myObj\length)\parent = *myObj
*myObj\length + 1
*myObj = *myObj\arr(*myObj\length - 1)
ProcedureReturn *myObj
EndProcedure
; Object erstellen
Procedure CreateNewObject(*myObj.jsonObject, key.s)
*myObj\obj(key) = AllocateMemory(SizeOf(jsonObject))
InitializeStructure(*myObj\obj(key), jsonObject)
*myObj\obj(key)\parent = *myObj
*myObj = *myObj\obj(key)
ProcedureReturn *myObj
EndProcedure
;----------------------------------------------
; Strings in den Speicher laden und durch Pointer ersetzen
; und überflüssige zeichen entfernen
Procedure.s Prepare_JSON_String(json_string.s)
Protected x.i, myChar.c, lastChar1.c, lastChar2.c, readPos.i, cl.i = SizeOf(Character)
Protected outStr.s, Stop.b, length.i = Len(json_string) * cl, tmpLength.i, *tmpPtr, check.i
For x = 0 To length - cl Step SizeOf(Character)
myChar = PeekC(@json_string + x)
If x > SizeOf(Character) : lastChar1 = PeekC(@json_string + x - cl) : EndIf
If myChar = 34 And Not lastChar1 = 92
y = x + cl
While Stop = 0
If PeekC(@json_string + y) = 34 And Not PeekC(@json_string + y - cl) = 92 : Stop = 1 : EndIf
y + cl
Wend
Stop = 0
tmpLength = y - x - cl
If tmpLength > 0
*tmpPtr = AllocateMemory(tmpLength)
CopyMemory(@json_string + x + cl, *tmpPtr, tmpLength - cl)
outStr + "*" + Str(*tmpPtr)
i + Len("*" + Str(*tmpPtr))
x + tmpLength + cl
EndIf
EndIf
myChar = PeekC(@json_string + x)
Select myChar
Case 34, 36, 42, 44, 46, 48 To 58, 65 To 91, 93, 95, 97 To 123, 125
outStr + Chr(myChar)
If myChar = 91 Or myChar = 123 : check + 1 : EndIf
If myChar = 93 Or myChar = 125 : check - 1 : EndIf
i + 1
EndSelect
Next
If check
MessageRequester("Error", "JSON Syntax Error! Unresolved {} or []")
End
EndIf
ProcedureReturn outStr
EndProcedure
; JSON String auswerten
Procedure Parse_JSON_String(*myObj.jsonObject, jsonString.s)
Protected x.i, myChar.c, charLen.i = SizeOf(Character), stringLen.i = Len(jsonString) * charLen, field.s
Protected key.s, realKey.s, value.s, *currentObj.jsonObject, addToArray.b = #False
*currentObj = *myObj
*currentObj\parent = *myObj
For x = charLen To stringLen - charLen Step SizeOf(Character)
myChar = PeekC(@jsonString + x)
Select myChar
Case 36, 42, 46, 48 To 58, 65 To 90, 95, 97 To 122
field + Chr(myChar)
Case 44, 91, 93, 123, 125
realKey = StringField(field, 1, ":")
key = getString(realKey)
value = StringField(field, 2, ":")
; Array Field
If key And Not value And myChar = 44
*currentObj = ReDimObjArray(*currentObj)
setValue(*currentObj, realKey)
*currentObj = *currentObj\parent
EndIf
; Namenloses Object (Array field)
If Not key And Not value And myChar = 123
*currentObj = ReDimObjArray(*currentObj)
*currentObj\type = #JS_T_Object
EndIf
;Namenloser Array (Array field)
If Not key And Not value And myChar = 91
*currentObj = ReDimObjArray(*currentObj)
*currentObj\type = #JS_T_Array
EndIf
; Neuer Array
If key And Not value And myChar = 91
*currentObj = CreateNewObject(*currentObj, key)
*currentObj\type = #JS_T_Array
addToArray = #True
EndIf
; Neues Object
If key And Not value And myChar = 123
If addToArray
*currentObj = ReDimObjArray(*currentObj)
*currentObj\type = #JS_T_Object
EndIf
*currentObj = CreateNewObject(*currentObj, key)
*currentObj\type = #JS_T_Object
EndIf
; Object ende
If myChar = 125
If key And value
*currentObj = CreateNewObject(*currentObj, key)
setValue(*currentObj, value)
*currentObj = *currentObj\parent
EndIf
*currentObj = *currentObj\parent
EndIf
; Array ende
If myChar = 93
If key And Not value
*currentObj = ReDimObjArray(*currentObj)
setValue(*currentObj, realKey)
*currentObj = *currentObj\parent
EndIf
*currentObj = *currentObj\parent
addToArray = #False
EndIf
; Neues Daten Object
If key And value And myChar = 44
*currentObj = CreateNewObject(*currentObj, key)
setValue(*currentObj, value)
*currentObj = *currentObj\parent
EndIf
field = ""
EndSelect
;
Next
EndProcedure
If OpenFile(0, "test.json")
length.i = Lof(0)
*new_data = AllocateMemory(length)
ReadData(0, *new_data, length)
cleanStr.s = Prepare_JSON_String(PeekS(*new_data , length, #PB_Ascii))
Parse_JSON_String(@test.jsonObject, cleanStr)
CloseFile(0)
EndIf
Debug test\obj("name")\string
Debug test\obj("alter")\integer
Debug test\obj("hobbies")\arr(0)\string
Debug test\obj("hobbies")\arr(1)\obj("Autofahren")\obj("anzahl")\integer
Debug test\obj("hobbies")\arr(1)\obj("Autofahren")\obj("anzahl")\parent\parent\parent\parent\obj("name")\string
Debug test\obj("hobbies")\arr(1)\obj("Autofahren")\obj("typen")\arr(0)\obj("test123")\integer
Debug test\obj("hobbies")\arr(1)\obj("Autofahren")\obj("typen")\arr(0)\obj("blub")\string
Debug test\obj("hobbies")\arr(1)\obj("Autofahren")\obj("typen")\arr(1)\string
Debug test\obj("hobbies")\arr(1)\obj("Autofahren")\obj("typen")\arr(2)\arr(0)\integer
Debug test\obj("hobbies")\arr(1)\obj("Autofahren")\obj("typen")\arr(2)\arr(1)\integer
Debug test\obj("hobbies")\arr(1)\obj("Autofahren")\obj("typen")\arr(3)\obj("Trabi")\obj("farbe")\string
Debug test\obj("hobbies")\arr(1)\obj("Autofahren")\obj("typen")\arr(3)\obj("Trabi")\obj("fahrbereit")\type
Debug test\obj("hobbies")\arr(1)\obj("Autofahren")\obj("typen")\arr(3)\obj("Trabi")\obj("tank_fuellung")\integer
Debug test\obj("hobbies")\arr(1)\obj("Autofahren")\obj("typen")\arr(3)\obj("Trabi")\obj("reifen_druck")\arr(0)\integer
Debug test\obj("hobbies")\arr(1)\obj("Autofahren")\obj("typen")\arr(3)\obj("Trabi")\obj("reifen_druck")\arr(1)\integer
Debug test\obj("hobbies")\arr(1)\obj("Autofahren")\obj("typen")\arr(3)\obj("Trabi")\obj("reifen_druck")\arr(2)\integer
Debug test\obj("hobbies")\arr(1)\obj("Autofahren")\obj("typen")\arr(3)\obj("Trabi")\obj("reifen_druck")\arr(3)\integer
Debug test\obj("hobbies")\arr(1)\obj("Autofahren")\obj("typen")\arr(3)\obj("Trabi")\obj("kilometer")\float
Code: Alles auswählen
{
"name": "Hans",
nachname: {
test: {
sub_test: 123,
sub_str: "abc"
}
},
alter: 30,
hobbies: [
"Schach spielen",
Autofahren: {
anzahl: 33,
"typen": [{test123: 123, blub: "asd"}, "Mercedes", [123,456],
{Trabi: {
farbe: "schwarz",
fahrbereit: true,
tank_fuellung: 50,
reifen_druck: [100, 90, 100, 100],
kilometer: 300000.45
}}]
}
]
}
