diff --git a/Source/Simba.lpi b/Source/Simba.lpi index abed44d0b..0d896d431 100644 --- a/Source/Simba.lpi +++ b/Source/Simba.lpi @@ -580,364 +580,364 @@ - + - - - - + + + + - + - - - - + + + + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - - - - + + + + - + - + - + - + - + - - - - + + + + - + - + - + - + - + - + - + - + - + - + - + - + - - - - + + + + - + - + - + - - - - + + + + - + - + - - - - + + + + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - - - - + + + + diff --git a/Source/script/imports/simbaclasses/simba.import_class_json.pas b/Source/script/imports/simbaclasses/simba.import_class_json.pas index 849680fa9..2c4e5e7c1 100644 --- a/Source/script/imports/simbaclasses/simba.import_class_json.pas +++ b/Source/script/imports/simbaclasses/simba.import_class_json.pas @@ -14,499 +14,234 @@ implementation uses lptypes, - simba.jsonparser; + simba.json; -type - PStringList = ^TStringList; - -procedure _LapeJSONArray_create(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PJSONArray(Params^[0])^ := TJSONArray.Create(); -end; - -procedure _LapeJSONArray_createExExEx(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PJSONArray(Params^[0])^ := TJSONArray.Create(PString(Params^[1])^); -end; - -procedure _LapeJSONArray_get(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PZAbstractObject(Result)^ := PJSONArray(Params^[0])^.get(Pinteger(Params^[1])^); -end; - -procedure _LapeJSONArray_getBoolean(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - Pboolean(Result)^ := PJSONArray(Params^[0])^.getBoolean(Pinteger(Params^[1])^); -end; - -procedure _LapeJSONArray_getDouble(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - Pdouble(Result)^ := PJSONArray(Params^[0])^.getDouble(Pinteger(Params^[1])^); -end; - -procedure _LapeJSONArray_getInt(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - Pinteger(Result)^ := PJSONArray(Params^[0])^.getInt(Pinteger(Params^[1])^); -end; - -procedure _LapeJSONArray_getJSONArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PJSONArray(Result)^ := PJSONArray(Params^[0])^.getJSONArray(Pinteger(Params^[1])^); -end; - -procedure _LapeJSONArray_getJSONObject(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PJSONObject(Result)^ := PJSONArray(Params^[0])^.getJSONObject(Pinteger(Params^[1])^); -end; - -procedure _LapeJSONArray_getString(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PString(Result)^ := PJSONArray(Params^[0])^.getString(Pinteger(Params^[1])^); -end; - -procedure _LapeJSONArray_isNull(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - Pboolean(Result)^ := PJSONArray(Params^[0])^.isNull(Pinteger(Params^[1])^); -end; - -procedure _LapeJSONArray_join(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PString(Result)^ := PJSONArray(Params^[0])^.join(PString(Params^[1])^); -end; - -procedure _LapeJSONArray_length(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - Pinteger(Result)^ := PJSONArray(Params^[0])^.length(); -end; - -procedure _LapeJSONArray_opt(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PZAbstractObject(Result)^ := PJSONArray(Params^[0])^.opt(Pinteger(Params^[1])^); -end; - -procedure _LapeJSONArray_optBoolean(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - Pboolean(Result)^ := PJSONArray(Params^[0])^.optBoolean(Pinteger(Params^[1])^); -end; - -procedure _LapeJSONArray_optBooleanEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - Pboolean(Result)^ := PJSONArray(Params^[0])^.optBoolean(Pinteger(Params^[1])^, Pboolean(Params^[2])^); -end; - -procedure _LapeJSONArray_optDouble(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - Pdouble(Result)^ := PJSONArray(Params^[0])^.optDouble(Pinteger(Params^[1])^); -end; - -procedure _LapeJSONArray_optDoubleEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - Pdouble(Result)^ := PJSONArray(Params^[0])^.optDouble(Pinteger(Params^[1])^, Pdouble(Params^[2])^); -end; - -procedure _LapeJSONArray_optInt(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - Pinteger(Result)^ := PJSONArray(Params^[0])^.optInt(Pinteger(Params^[1])^); -end; - -procedure _LapeJSONArray_optIntEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - Pinteger(Result)^ := PJSONArray(Params^[0])^.optInt(Pinteger(Params^[1])^, Pinteger(Params^[2])^); -end; - -procedure _LapeJSONArray_optJSONArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PJSONArray(Result)^ := PJSONArray(Params^[0])^.optJSONArray(Pinteger(Params^[1])^); -end; - -procedure _LapeJSONArray_optJSONObject(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PJSONObject(Result)^ := PJSONArray(Params^[0])^.optJSONObject(Pinteger(Params^[1])^); -end; - -procedure _LapeJSONArray_optString(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PString(Result)^ := PJSONArray(Params^[0])^.optString(Pinteger(Params^[1])^); -end; - -procedure _LapeJSONArray_optStringEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PString(Result)^ := PJSONArray(Params^[0])^.optString(Pinteger(Params^[1])^, PString(Params^[2])^); -end; - -procedure _LapeJSONArray_put(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PJSONArray(Result)^ := PJSONArray(Params^[0])^.put(Pboolean(Params^[1])^); -end; - -procedure _LapeJSONArray_putEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PJSONArray(Result)^ := PJSONArray(Params^[0])^.put(Pdouble(Params^[1])^); -end; - -procedure _LapeJSONArray_putExEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PJSONArray(Result)^ := PJSONArray(Params^[0])^.put(Pinteger(Params^[1])^); -end; - -procedure _LapeJSONArray_putExExEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PJSONArray(Result)^ := PJSONArray(Params^[0])^.put(PZAbstractObject(Params^[1])^); -end; - -procedure _LapeJSONArray_putExExExEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PJSONArray(Result)^ := PJSONArray(Params^[0])^.put(PString(Params^[1])^); -end; - -procedure _LapeJSONArray_putExExExExEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PJSONArray(Result)^ := PJSONArray(Params^[0])^.put(Pinteger(Params^[1])^, Pboolean(Params^[2])^); -end; - -procedure _LapeJSONArray_putExExExExExEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PJSONArray(Result)^ := PJSONArray(Params^[0])^.put(Pinteger(Params^[1])^, Pdouble(Params^[2])^); -end; - -procedure _LapeJSONArray_putExExExExExExEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PJSONArray(Result)^ := PJSONArray(Params^[0])^.put(Pinteger(Params^[1])^, Pinteger(Params^[2])^); -end; - -procedure _LapeJSONArray_putExExExExExExExEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PJSONArray(Result)^ := PJSONArray(Params^[0])^.put(Pinteger(Params^[1])^, PZAbstractObject(Params^[2])^); -end; - -procedure _LapeJSONArray_putExExExExExExExExEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PJSONArray(Result)^ := PJSONArray(Params^[0])^.put(Pinteger(Params^[1])^, PString(Params^[2])^); -end; - -procedure _LapeJSONArray_toJSONObject(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PJSONObject(Result)^ := PJSONArray(Params^[0])^.toJSONObject(PJSONArray(Params^[1])^); -end; - -procedure _LapeJSONArray_toString(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PString(Result)^ := PJSONArray(Params^[0])^.toString(); -end; - -procedure _LapeJSONArray_toStringEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PString(Result)^ := PJSONArray(Params^[0])^.toString(Pinteger(Params^[1])^); -end; - -procedure _LapeJSONArray_toStringExEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PString(Result)^ := PJSONArray(Params^[0])^.toString(Pinteger(Params^[1])^, Pinteger(Params^[2])^); -end; - -procedure _LapeJSONArray_Init(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PJSONArray(Params^[0])^ := TJSONArray.Create(); -end; - -procedure _LapeJSONArray_Free(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PJSONArray(Params^[0])^.Free(); -end; - -procedure _LapeJSONObject_create(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PJSONObject(Params^[0])^ := TJSONObject.Create(); -end; - -procedure _LapeJSONObject_createExExExEx(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PJSONObject(Params^[0])^ := TJSONObject.Create(PString(Params^[1])^); -end; - -procedure _LapeJSONObject_clean(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PJSONObject(Params^[0])^.clean(); -end; - -procedure _LapeJSONObject_clone(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PZAbstractObject(Result)^ := PJSONObject(Params^[0])^.clone(); -end; - -procedure _LapeJSONObject_accumulate(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PJSONObject(Result)^ := PJSONObject(Params^[0])^.accumulate(PString(Params^[1])^, PZAbstractObject(Params^[2])^); -end; - -procedure _LapeJSONObject_get(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PZAbstractObject(Result)^ := PJSONObject(Params^[0])^.get(PString(Params^[1])^); -end; - -procedure _LapeJSONObject_getBoolean(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - Pboolean(Result)^ := PJSONObject(Params^[0])^.getBoolean(PString(Params^[1])^); -end; - -procedure _LapeJSONObject_getDouble(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONElement_Keys(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - Pdouble(Result)^ := PJSONObject(Params^[0])^.getDouble(PString(Params^[1])^); + PStringArray(Result)^ := PSimbaJSONElement(Params^[0])^.Keys; end; -procedure _LapeJSONObject_getInt(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONElement_Count(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - Pinteger(Result)^ := PJSONObject(Params^[0])^.getInt(PString(Params^[1])^); + PInteger(Result)^ := PSimbaJSONElement(Params^[0])^.Count; end; -procedure _LapeJSONObject_getJSONArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONElement_GetItem(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PJSONArray(Result)^ := PJSONObject(Params^[0])^.getJSONArray(PString(Params^[1])^); + PSimbaJSONElement(Result)^ := PSimbaJSONElement(Params^[0])^.Items[PInteger(Params^[1])^]; end; -procedure _LapeJSONObject_getJSONObject(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONElement_AddValue(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PJSONObject(Result)^ := PJSONObject(Params^[0])^.getJSONObject(PString(Params^[1])^); + PSimbaJSONElement(Params^[0])^.AddValue(PString(Params^[1])^, PVariant(Params^[2])^); end; -procedure _LapeJSONObject_getString(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONElement_AddArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PString(Result)^ := PJSONObject(Params^[0])^.getString(PString(Params^[1])^); + PSimbaJSONElement(Result)^ := PSimbaJSONElement(Params^[0])^.AddArray(PString(Params^[1])^); end; -procedure _LapeJSONObject_has(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONElement_AddObject(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - Pboolean(Result)^ := PJSONObject(Params^[0])^.has(PString(Params^[1])^); + PSimbaJSONElement(Result)^ := PSimbaJSONElement(Params^[0])^.AddObject(PString(Params^[1])^); end; -procedure _LapeJSONObject_isNull(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONElement_AddElement(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - Pboolean(Result)^ := PJSONObject(Params^[0])^.isNull(PString(Params^[1])^); + PSimbaJSONElement(Params^[0])^.AddElement(PString(Params^[1])^, PSimbaJSONElement(Params^[2])^); end; -procedure _LapeJSONObject_keys(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONElement_ValueType(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PStringList(Result)^ := PJSONObject(Params^[0])^.keys(); + ESimbaJSONValueType(Result^) := PSimbaJSONElement(Params^[0])^.ValueType; end; -procedure _LapeJSONObject_length(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONElement_GetValue(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - Pinteger(Result)^ := PJSONObject(Params^[0])^.length(); + PVariant(Result)^ := PSimbaJSONElement(Params^[0])^.Value; end; -procedure _LapeJSONObject_names(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONElement_SetValue(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PJSONArray(Result)^ := PJSONObject(Params^[0])^.names(); + PSimbaJSONElement(Params^[0])^.Value := PVariant(Params^[1])^; end; -procedure _LapeJSONObject_opt(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONElement_AsString(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PZabstractObject(Result)^ := PJSONObject(Params^[0])^.opt(PString(Params^[1])^); + PString(Result)^ := PSimbaJSONElement(Params^[0])^.AsString; end; -procedure _LapeJSONObject_optBoolean(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONElement_Clone(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - Pboolean(Result)^ := PJSONObject(Params^[0])^.optBoolean(PString(Params^[1])^); + PSimbaJSONElement(Result)^ := PSimbaJSONElement(Params^[0])^.Clone(); end; -procedure _LapeJSONObject_optBooleanEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONElement_IsValue(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - Pboolean(Result)^ := PJSONObject(Params^[0])^.optBoolean(PString(Params^[1])^, Pboolean(Params^[2])^); + PBoolean(Result)^ := PSimbaJSONElement(Params^[0])^.IsValue; end; -procedure _LapeJSONObject_optDouble(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONElement_IsArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - Pdouble(Result)^ := PJSONObject(Params^[0])^.optDouble(PString(Params^[1])^); + PBoolean(Result)^ := PSimbaJSONElement(Params^[0])^.IsArray; end; -procedure _LapeJSONObject_optDoubleEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONElement_IsObject(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - Pdouble(Result)^ := PJSONObject(Params^[0])^.optDouble(PString(Params^[1])^, Pdouble(Params^[2])^); + PBoolean(Result)^ := PSimbaJSONElement(Params^[0])^.IsObject; end; -procedure _LapeJSONObject_optInt(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONElement_Delete1(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - Pinteger(Result)^ := PJSONObject(Params^[0])^.optInt(PString(Params^[1])^); + PSimbaJSONElement(Params^[0])^.Delete(PString(Params^[1])^); end; -procedure _LapeJSONObject_optIntEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONElement_Delete2(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - Pinteger(Result)^ := PJSONObject(Params^[0])^.optInt(PString(Params^[1])^, Pinteger(Params^[2])^); + PSimbaJSONElement(Params^[0])^.Delete(PInteger(Params^[1])^); end; -procedure _LapeJSONObject_optString(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONElement_Clear(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PString(Result)^ := PJSONObject(Params^[0])^.optString(PString(Params^[1])^); + PSimbaJSONElement(Params^[0])^.Clear(); end; -procedure _LapeJSONObject_optStringEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONElement_Find(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PString(Result)^ := PJSONObject(Params^[0])^.optString(PString(Params^[1])^, PString(Params^[2])^); + PBoolean(Result)^ := PSimbaJSONElement(Params^[0])^.Find(PString(Params^[1])^, PSimbaJSONElement(Params^[2])^); end; -procedure _LapeJSONObject_optJSONArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONParser_Create(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PJSONArray(Result)^ := PJSONObject(Params^[0])^.optJSONArray(PString(Params^[1])^); + PSimbaJSONParser(Result)^ := TSimbaJSONParser.Create(PString(Params^[0])^); end; -procedure _LapeJSONObject_optJSONObject(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONParser_CreateFromFile(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PJSONObject(Result)^ := PJSONObject(Params^[0])^.optJSONObject(PString(Params^[1])^); + PSimbaJSONParser(Result)^ := TSimbaJSONParser.Create(PString(Params^[0])^); end; -procedure _LapeJSONObject_put(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONParser_SaveToFile(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PJSONObject(Result)^ := PJSONObject(Params^[0])^.put(PString(Params^[1])^, Pboolean(Params^[2])^); + PBoolean(Result)^ := PSimbaJSONParser(Params^[0])^.SaveToFile(PString(Params^[1])^); end; -procedure _LapeJSONObject_putEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONParser_Clear(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PJSONObject(Result)^ := PJSONObject(Params^[0])^.put(PString(Params^[1])^, Pdouble(Params^[2])^); + PSimbaJSONParser(Params^[0])^.Clear(); end; -procedure _LapeJSONObject_putExEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONParser_AddValue(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PJSONObject(Result)^ := PJSONObject(Params^[0])^.put(PString(Params^[1])^, Pinteger(Params^[2])^); + PSimbaJSONParser(Params^[0])^.AddValue(PString(Params^[1])^, PVariant(Params^[2])^); end; -procedure _LapeJSONObject_putExExEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONParser_AddArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PJSONObject(Result)^ := PJSONObject(Params^[0])^.put(PString(Params^[1])^, PString(Params^[2])^); + PSimbaJSONElement(Result)^ := PSimbaJSONParser(Params^[0])^.AddArray(PString(Params^[1])^); end; -procedure _LapeJSONObject_putExExExEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONParser_AddObject(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PJSONObject(Result)^ := PJSONObject(Params^[0])^.put(PString(Params^[1])^, PZAbstractObject(Params^[2])^); + PSimbaJSONElement(Result)^ := PSimbaJSONParser(Params^[0])^.AddObject(PString(Params^[1])^); end; -procedure _LapeJSONObject_putOpt(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONParser_AddElement(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PJSONObject(Result)^ := PJSONObject(Params^[0])^.putOpt(PString(Params^[1])^, PZAbstractObject(Params^[2])^); + PSimbaJSONParser(Params^[0])^.AddElement(PString(Params^[1])^, PSimbaJSONElement(Params^[2])^); end; -procedure _LapeJSONObject_remove(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONParser_Count(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PZAbstractObject(Result)^ := PJSONObject(Params^[0])^.remove(PString(Params^[1])^); + PInteger(Result)^ := PSimbaJSONParser(Params^[0])^.Count; end; -procedure _LapeJSONObject_assignTo(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONParser_GetItem(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PJSONObject(Params^[0])^.assignTo(PJSONObject(Params^[1])^); + PSimbaJSONElement(Result)^ := PSimbaJSONParser(Params^[0])^.Items[PInteger(Params^[1])^]; end; -procedure _LapeJSONObject_toJSONArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONParser_AsString(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PJSONArray(Result)^ := PJSONObject(Params^[0])^.toJSONArray(PJSONArray(Params^[1])^); + PString(Result)^ := PSimbaJSONParser(Params^[0])^.AsString; end; -procedure _LapeJSONObject_toString(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONParser_Find(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PString (Result)^ := PJSONObject(Params^[0])^.toString(); + PBoolean(Result)^ := PSimbaJSONParser(Params^[0])^.Find(PString(Params^[1])^, PSimbaJSONElement(Params^[2])^); end; -procedure _LapeJSONObject_toStringEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONParser_Delete1(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PString(Result)^ := PJSONObject(Params^[0])^.toString(Pinteger(Params^[1])^); + PSimbaJSONParser(Params^[0])^.Delete(PString(Params^[1])^); end; -procedure _LapeJSONObject_toStringExEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONParser_Delete2(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PString(Result)^ := PJSONObject(Params^[0])^.toString(Pinteger(Params^[1])^, Pinteger(Params^[2])^); + PSimbaJSONParser(Params^[0])^.Delete(PInteger(Params^[1])^); end; -procedure _LapeJSONObject_Init(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONParser_FindPath(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PJSONObject(Params^[0])^ := TJSONObject.Create(); + PBoolean(Result)^ := PSimbaJSONParser(Params^[0])^.FindPath(PString(Params^[1])^, PSimbaJSONElement(Params^[2])^); end; -procedure _LapeJSONObject_Free(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV +procedure _LapeJSONParser_Keys(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PJSONObject(Params^[0])^.Free(); + PStringArray(Result)^ := PSimbaJSONParser(Params^[0])^.Keys; end; procedure ImportJSON(Compiler: TSimbaScript_Compiler); begin with Compiler do begin - addClass('TJSONObject', 'TObject'); - addClass('TJSONArray', 'TObject'); - addGlobalFunc('procedure TJSONArray.Init(); overload', @_LapeJSONArray_create); - addGlobalFunc('procedure TJSONArray.Init(s : string); overload', @_LapeJSONArray_createExExEx); - addGlobalFunc('function TJSONArray.get(index : integer): Pointer;', @_LapeJSONArray_get); - addGlobalFunc('function TJSONArray.getBoolean(index : integer): boolean;', @_LapeJSONArray_getBoolean); - addGlobalFunc('function TJSONArray.getDouble(index : integer): double;', @_LapeJSONArray_getDouble); - addGlobalFunc('function TJSONArray.getInt(index : integer): integer;', @_LapeJSONArray_getInt); - addGlobalFunc('function TJSONArray.getJSONArray(index : integer): TJSONArray;', @_LapeJSONArray_getJSONArray); - addGlobalFunc('function TJSONArray.getJSONObject(index : integer): TJsonObject;', @_LapeJSONArray_getJSONObject); - addGlobalFunc('function TJSONArray.getString(index : integer): string;', @_LapeJSONArray_getString); - addGlobalFunc('function TJSONArray.isNull(index : integer): boolean;', @_LapeJSONArray_isNull); - addGlobalFunc('function TJSONArray.join(separator : string): string;', @_LapeJSONArray_join); - addGlobalFunc('function TJSONArray.length: integer;', @_LapeJSONArray_length); - addGlobalFunc('function TJSONArray.opt(index : integer): Pointer;', @_LapeJSONArray_opt); - addGlobalFunc('function TJSONArray.optBoolean(index : integer): boolean;', @_LapeJSONArray_optBoolean); - addGlobalFunc('function TJSONArray.optBoolean(index : integer; defaultValue : boolean): boolean; overload', @_LapeJSONArray_optBooleanEx); - addGlobalFunc('function TJSONArray.optDouble(index : integer): double;', @_LapeJSONArray_optDouble); - addGlobalFunc('function TJSONArray.optDouble(index : integer; defaultValue :double ): double; overload', @_LapeJSONArray_optDoubleEx); - addGlobalFunc('function TJSONArray.optInt(index : integer): integer;', @_LapeJSONArray_optInt); - addGlobalFunc('function TJSONArray.optInt(index : integer; defaultValue : integer): integer; overload', @_LapeJSONArray_optIntEx); - addGlobalFunc('function TJSONArray.optJSONArray(index : integer): TJSONArray;', @_LapeJSONArray_optJSONArray); - addGlobalFunc('function TJSONArray.optJSONObject(index : integer): TJSONObject;', @_LapeJSONArray_optJSONObject); - addGlobalFunc('function TJSONArray.optString(index : integer): string;', @_LapeJSONArray_optString); - addGlobalFunc('function TJSONArray.optString(index : integer; defaultValue : string): string; overload', @_LapeJSONArray_optStringEx); - addGlobalFunc('function TJSONArray.put(value : boolean): TJSONArray; overload', @_LapeJSONArray_put); - addGlobalFunc('function TJSONArray.put(value : double ): TJSONArray; overload', @_LapeJSONArray_putEx); - addGlobalFunc('function TJSONArray.put(value : integer): TJSONArray; overload', @_LapeJSONArray_putExEx); - addGlobalFunc('function TJSONArray.put(value : pointer): TJSONArray; overload', @_LapeJSONArray_putExExEx); - addGlobalFunc('function TJSONArray.put(value: string): TJSONArray; overload', @_LapeJSONArray_putExExExEx); - addGlobalFunc('function TJSONArray.put(index : integer ; value : boolean): TJSONArray; overload', @_LapeJSONArray_putExExExExEx); - addGlobalFunc('function TJSONArray.put(index : integer ; value : double): TJSONArray; overload', @_LapeJSONArray_putExExExExExEx); - addGlobalFunc('function TJSONArray.put(index : integer ; value : integer): TJSONArray; overload', @_LapeJSONArray_putExExExExExExEx); - addGlobalFunc('function TJSONArray.put(index : integer ; value : pointer): TJSONArray; overload', @_LapeJSONArray_putExExExExExExExEx); - addGlobalFunc('function TJSONArray.put(index: integer; value: string): TJSONArray; overload', @_LapeJSONArray_putExExExExExExExExEx); - addGlobalFunc('function TJSONArray.toJSONObject(names :TJSONArray ): TJsonObject ; overload', @_LapeJSONArray_toJSONObject); - addGlobalFunc('function TJSONArray.toString: string; overload; override', @_LapeJSONArray_toString); - addGlobalFunc('function TJSONArray.toString(indentFactor : integer): string; overload', @_LapeJSONArray_toStringEx); - addGlobalFunc('function TJSONArray.toString(indentFactor, indent : integer): string; overload', @_LapeJSONArray_toStringExEx); - - addGlobalFunc('procedure TJSONObject.Init(); overload', @_LapeJSONObject_create); - addGlobalFunc('procedure TJSONObject.Init(s : string); overload', @_LapeJSONObject_createExExExEx); - addGlobalFunc('procedure TJSONObject.clean;', @_LapeJSONObject_clean); - addGlobalFunc('function TJSONObject.accumulate(key : string; value : pointer): TJSONObject;', @_LapeJSONObject_accumulate); - addGlobalFunc('function TJSONObject.get(key : string): pointer;', @_LapeJSONObject_get); - addGlobalFunc('function TJSONObject.getBoolean(key : string): boolean;', @_LapeJSONObject_getBoolean); - addGlobalFunc('function TJSONObject.getDouble(key : string): double;', @_LapeJSONObject_getDouble); - addGlobalFunc('function TJSONObject.getInt(key : string): integer;', @_LapeJSONObject_getInt); - addGlobalFunc('function TJSONObject.getJSONArray(key : string): TJSONArray;', @_LapeJSONObject_getJSONArray); - addGlobalFunc('function TJSONObject.getJSONObject(key : string): TJSONObject;', @_LapeJSONObject_getJSONObject); - addGlobalFunc('function TJSONObject.getString(key : string): string;', @_LapeJSONObject_getString); - addGlobalFunc('function TJSONObject.has(key : string): boolean;', @_LapeJSONObject_has); - addGlobalFunc('function TJSONObject.isNull(key : string): boolean;', @_LapeJSONObject_isNull); - addGlobalFunc('function TJSONObject.keys: TStringList;', @_LapeJSONObject_keys); - addGlobalFunc('function TJSONObject.length: integer;', @_LapeJSONObject_length); - addGlobalFunc('function TJSONObject.names: TJSONArray;', @_LapeJSONObject_names); - addGlobalFunc('function TJSONObject.opt(key : string): pointer;', @_LapeJSONObject_opt); - addGlobalFunc('function TJSONObject.optBoolean(key : string): boolean;', @_LapeJSONObject_optBoolean); - addGlobalFunc('function TJSONObject.optBoolean(key : string; defaultValue : boolean): boolean; overload', @_LapeJSONObject_optBooleanEx); - addGlobalFunc('function TJSONObject.optDouble(key : string): double;', @_LapeJSONObject_optDouble); - addGlobalFunc('function TJSONObject.optDouble(key : string; defaultValue : double): double; overload', @_LapeJSONObject_optDoubleEx); - addGlobalFunc('function TJSONObject.optInt(key : string): integer;', @_LapeJSONObject_optInt); - addGlobalFunc('function TJSONObject.optInt(key : string; defaultValue : integer): integer; overload', @_LapeJSONObject_optIntEx); - addGlobalFunc('function TJSONObject.optString(key : string): string;', @_LapeJSONObject_optString); - addGlobalFunc('function TJSONObject.optString(key : string; defaultValue : string): string; overload', @_LapeJSONObject_optStringEx); - addGlobalFunc('function TJSONObject.optJSONArray(key : string): TJSONArray;', @_LapeJSONObject_optJSONArray); - addGlobalFunc('function TJSONObject.optJSONObject(key : string): TJSONObject;', @_LapeJSONObject_optJSONObject); - addGlobalFunc('function TJSONObject.put(key : string; value : boolean): TJSONObject;', @_LapeJSONObject_put); - addGlobalFunc('function TJSONObject.put(key : string; value : double): TJSONObject; overload', @_LapeJSONObject_putEx); - addGlobalFunc('function TJSONObject.put(key : string; value : integer): TJSONObject; overload', @_LapeJSONObject_putExEx); - addGlobalFunc('function TJSONObject.put(key : string; value : string): TJSONObject; overload', @_LapeJSONObject_putExExEx); - addGlobalFunc('function TJSONObject.put(key : string; value : pointer): TJSONObject; overload', @_LapeJSONObject_putExExExEx); - addGlobalFunc('function TJSONObject.putOpt(key : string; value : pointer): TJSONObject;', @_LapeJSONObject_putOpt); - addGlobalFunc('function TJSONObject.remove(key : string): pointer;', @_LapeJSONObject_remove); - addGlobalFunc('procedure TJSONObject.assignTo(json: TJSONObject);', @_LapeJSONObject_assignTo); - addGlobalFunc('function TJSONObject.toJSONArray(names : TJSONArray): TJSONArray;', @_LapeJSONObject_toJSONArray); - addGlobalFunc('function TJSONObject.toString: string ; overload; override', @_LapeJSONObject_toString); - addGlobalFunc('function TJSONObject.toString(indentFactor : integer): string; overload', @_LapeJSONObject_toStringEx); - addGlobalFunc('function TJSONObject.toString(indentFactor, indent : integer): string; overload', @_LapeJSONObject_toStringExEx); + ImportingSection := 'TJSONParser'; + + addGlobalType('enum(UNKNOWN, NULL, INT, FLOAT, STR, BOOL)', 'EJSONValueType'); + addGlobalType('record {%CODETOOLS OFF}InternalData: Pointer;{%CODETOOLS ON} end', 'TJSONElement'); + if (getGlobalType('TJSONElement').Size <> SizeOf(TSimbaJSONParser)) then + raise Exception.Create('SizeOf(TJSONElement) is wrong!'); + + addGlobalFunc('function TJSONElement.Keys: TStringArray', @_LapeJSONElement_Keys); + addGlobalFunc('function TJSONElement.Count: Integer', @_LapeJSONElement_Count); + addGlobalFunc('function TJSONElement.GetItem(Index: Integer): TJSONElement', @_LapeJSONElement_GetItem); + addGlobalFunc('procedure TJSONElement.AddValue(Key: String; Value: Variant)', @_LapeJSONElement_AddValue); + addGlobalFunc('function TJSONElement.AddArray(Key: String): TJSONElement', @_LapeJSONElement_AddArray); + addGlobalFunc('function TJSONElement.AddObject(Key: String): TJSONElement', @_LapeJSONElement_AddObject); + addGlobalFunc('procedure TJSONElement.AddElement(Key: String; Element: TJSONElement)', @_LapeJSONElement_AddElement); + addGlobalFunc('function TJSONElement.ValueType: EJSONValueType', @_LapeJSONElement_ValueType); + addGlobalFunc('function TJSONElement.GetValue: Variant', @_LapeJSONElement_GetValue); + addGlobalFunc('procedure TJSONElement.SetValue(NewValue: Variant);', @_LapeJSONElement_SetValue); + addGlobalFunc('function TJSONElement.AsString: String', @_LapeJSONElement_SetValue); + addGlobalFunc('function TJSONElement.Clone: TJSONElement', @_LapeJSONElement_Clone); + addGlobalFunc('function TJSONElement.IsValue: Boolean', @_LapeJSONElement_IsValue); + addGlobalFunc('function TJSONElement.IsArray: Boolean', @_LapeJSONElement_IsArray); + addGlobalFunc('function TJSONElement.IsObject: Boolean', @_LapeJSONElement_IsObject); + addGlobalFunc('procedure TJSONElement.Clear', @_LapeJSONElement_Clear); + addGlobalFunc('procedure TJSONElement.Delete(Key: String); overload', @_LapeJSONElement_Delete1); + addGlobalFunc('procedure TJSONElement.Delete(Index: Integer); overload', @_LapeJSONElement_Delete2); + addGlobalFunc('function TJSONElement.Find(Key: String; out Element: TJSONElement): Boolean;', @_LapeJSONElement_Find); + + addClass('TJSONParser'); + + addGlobalFunc('function TJSONParser.Create(Str: String = ""): TJSONParser; static;', @_LapeJSONParser_Create); + addGlobalFunc('function TJSONParser.CreateFromFile(FileName: String): TJSONParser; static', @_LapeJSONParser_CreateFromFile); + addGlobalFunc('function TJSONParser.SaveToFile(FileName: String): Boolean', @_LapeJSONParser_SaveToFile); + addGlobalFunc('function TJSONParser.Keys: TStringArray', @_LapeJSONParser_Keys); + addGlobalFunc('procedure TJSONParser.Clear;', @_LapeJSONParser_Clear); + addGlobalFunc('procedure TJSONParser.AddValue(Key: String; Value: Variant);', @_LapeJSONParser_AddValue); + addGlobalFunc('function TJSONParser.AddArray(Key: String): TJSONElement;', @_LapeJSONParser_AddArray); + addGlobalFunc('function TJSONParser.AddObject(Key: String): TJSONElement;', @_LapeJSONParser_AddObject); + addGlobalFunc('procedure TJSONParser.AddElement(Key: String; Element: TJSONElement)', @_LapeJSONParser_AddElement); + addGlobalFunc('function TJSONParser.Count: Integer', @_LapeJSONParser_Count); + addGlobalFunc('function TJSONParser.GetItem(Index: Integer): TJSONElement', @_LapeJSONParser_GetItem); + addGlobalFunc('function TJSONParser.AsString: String', @_LapeJSONParser_AsString); + addGlobalFunc('function TJSONParser.Find(Key: String; out Element: TJSONElement): Boolean;', @_LapeJSONParser_Find); + addGlobalFunc('procedure TJSONParser.Delete(Key: String); overload;', @_LapeJSONParser_Delete1); + addGlobalFunc('procedure TJSONParser.Delete(Index: Integer); overload;', @_LapeJSONParser_Delete2); + addGlobalFunc('function TJSONParser.FindPath(Path: String; out Element: TJSONElement): Boolean;', @_LapeJSONParser_FindPath); + + ImportingSection := ''; end; end; diff --git a/Source/script/imports/simbaclasses/simba.import_class_xml.pas b/Source/script/imports/simbaclasses/simba.import_class_xml.pas deleted file mode 100644 index 709b24599..000000000 --- a/Source/script/imports/simbaclasses/simba.import_class_xml.pas +++ /dev/null @@ -1,296 +0,0 @@ -unit simba.import_class_xml; - -{$i simba.inc} - -interface - -uses - Classes, SysUtils, - simba.mufasatypes, simba.script_compiler; - -procedure ImportXML(Compiler: TSimbaScript_Compiler); - -implementation - -uses - lptypes, - simba.xmlparser; - -type - PStream = ^TStream; - -procedure _LapeXmlNode_Init(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PXmlNode(Params^[0])^ := TXmlNode.Create(); -end; - -procedure _LapeXmlNode_Find(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PXmlNode(Result)^ := PXmlNode(Params^[0])^.Find(PString(Params^[1])^); -end; - -procedure _LapeXmlNode_GetParent(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PXmlNode(Result)^ := PXmlNode(Params^[0])^.Parent; -end; - -procedure _LapeXmlNode_GetNodeName(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PString(Result)^ := PXmlNode(Params^[0])^.NodeName; -end; - -procedure _LapeXmlNode_GetText(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PString(Result)^ := PXmlNode(Params^[0])^.Text; -end; - -procedure _LapeXmlNode_SetNodeName(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PXmlNode(Params^[0])^.NodeName := PString(Params^[1])^; -end; - -procedure _LapeXmlNode_SetParent(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PXmlNode(Params^[0])^.Parent := PXMLNode(Params^[1])^; -end; - -procedure _LapeXmlNode_GetChildNodes(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PXMLNodeList(Result)^ := PXmlNode(Params^[0])^.ChildNodes; -end; - -procedure _LapeXmlNode_FindEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PXmlNode(Result)^ := PXmlNode(Params^[0])^.Find(PString(Params^[1])^, PString(Params^[2])^); -end; - -procedure _LapeXmlNode_FindExEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PXmlNode(Result)^ := PXmlNode(Params^[0])^.Find(PString(Params^[1])^, PString(Params^[2])^, PString(Params^[3])^); -end; - -procedure _LapeXmlNode_FindNodes(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PXmlNodeList(Result)^ := PXmlNode(Params^[0])^.FindNodes(PString(Params^[1])^); -end; - -procedure _LapeXmlNode_HasAttribute(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PBoolean(Result)^ := PXmlNode(Params^[0])^.HasAttribute(PString(Params^[1])^); -end; - -procedure _LapeXmlNode_AddChild(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PXmlNode(Result)^ := PXmlNode(Params^[0])^.AddChild(PString(Params^[1])^); -end; - -procedure _LapeXmlNode_SetText(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PXmlNode(Result)^ := PXmlNode(Params^[0])^.SetText(PString(Params^[1])^); -end; - -procedure _LapeXmlNode_SetAttribute(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PXmlNode(Result)^ := PXmlNode(Params^[0])^.SetAttribute(PString(Params^[1])^, PString(Params^[2])^); -end; - -procedure _LapeXmlNode_Free(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PXmlNode(Params^[0])^.Free(); -end; - -procedure _LapeXmlNode_GetAttribute(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PString(Result)^ := PXmlNode(Params^[0])^[PString(Params^[1])^]; -end; - -procedure _LapeXMLNodeList_Init(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PXMLNodeList(Params^[0])^ := TXMLNodeList.Create(); -end; - -procedure _LapeXMLNodeList_Clear(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PXMLNodeList(Params^[0])^.Clear(); -end; - -procedure _LapeXMLNodeList_Assign(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PXMLNodeList(Params^[0])^.Assign(PXMLNodeList(Params^[1])^); -end; - -procedure _LapeXMLNodeList_Add(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PXMLNodeList(Params^[0])^.Add(PXMLNode(Params^[1])^); -end; - -procedure _LapeXMLNodeList_AddEx(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PXMLNodeList(Params^[0])^.Add(PXMLNodeList(Params^[1])^); -end; - -procedure _LapeXMLNodeList_IndexOf(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PInteger(Result)^ := PXMLNodeList(Params^[0])^.IndexOf(PXMLNode(Params^[1])^); -end; - -procedure _LapeXMLNodeList_IndexOfEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PInteger(Result)^ := PXMLNodeList(Params^[0])^.IndexOf(PString(Params^[1])^); -end; - -procedure _LapeXMLNodeList_Delete(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PXMLNodeList(Params^[0])^.Delete(PXMLNode(Params^[1])^); -end; - -procedure _LapeXMLNodeList_DeleteEx(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PXMLNodeList(Params^[0])^.Delete(PInteger(Params^[1])^); -end; - -procedure _LapeXMLNodeList_Count_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PInteger(Result)^ := PXMLNodeList(Params^[0])^.Count; -end; - -procedure _LapeXMLNodeList_Item(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PXMLNode(Result)^ := PXMLNodeList(Params^[0])^.Item[PInteger(Params^[1])^]; -end; - -procedure _LapeXMLNodeList_Free(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PXMLNodeList(Params^[0])^.Free(); -end; - -procedure _LapeVerySimpleXml_Init(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PVerySimpleXml(Params^[0])^ := TVerySimpleXml.Create(); -end; - -procedure _LapeVerySimpleXml_Clear(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PVerySimpleXml(Params^[0])^.Clear(); -end; - -procedure _LapeVerySimpleXml_LoadFromFile(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PVerySimpleXml(Params^[0])^.LoadFromFile(PString(Params^[1])^); -end; - -procedure _LapeVerySimpleXml_LoadFromStream(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PVerySimpleXml(Params^[0])^.LoadFromStream(PStream(Params^[1])^); -end; - -procedure _LapeVerySimpleXml_LoadFromString(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PVerySimpleXml(Params^[0])^.LoadFromString(PString(Params^[1])^); -end; - -procedure _LapeVerySimpleXml_SaveToStream(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PVerySimpleXml(Params^[0])^.SaveToStream(PStream(Params^[1])^); -end; - -procedure _LapeVerySimpleXml_SaveToFile(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PVerySimpleXml(Params^[0])^.SaveToFile(PString(Params^[1])^); -end; - -procedure _LapeVerySimpleXml_SaveToString(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PVerySimpleXml(Params^[0])^.SaveToString(PString(Params^[1])^); -end; - -procedure _LapeVerySimpleXml_Root_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PXMLNode(Result)^ := PVerySimpleXml(Params^[0])^.Root; -end; - -procedure _LapeVerySimpleXml_Root_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PVerySimpleXml(Params^[0])^.Root := PXMLNode(Params^[1])^; -end; - -procedure _LapeVerySimpleXml_Header_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PXMLNode(Result)^ := PVerySimpleXml(Params^[0])^.Header; -end; - -procedure _LapeVerySimpleXml_Header_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PVerySimpleXml(Params^[0])^.Header := PXMLNode(Params^[1])^; -end; - -procedure _LapeVerySimpleXml_Ident_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PString(Result)^ := PVerySimpleXml(Params^[0])^.Ident; -end; - -procedure _LapeVerySimpleXml_Ident_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PVerySimpleXml(Params^[0])^.Ident := PString(Params^[1])^; -end; - -procedure _LapeVerySimpleXml_Free(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PVerySimpleXml(Params^[0])^.Free(); -end; - -procedure ImportXML(Compiler: TSimbaScript_Compiler); -begin - with Compiler do - begin - addClass('TXmlNode', 'TObject'); - addClass('TXMLNodeList', 'TObject'); - addGlobalFunc('procedure TXmlNode.Init()', @_LapeXmlNode_Init); - addGlobalFunc('function TXmlNode.GetChildNodes: TXMLNodeList;', @_LapeXMLNode_GetChildNodes); - addGlobalFunc('function TXmlNode.GetNodeName: string;', @_LapeXmlNode_GetNodeName); - addGlobalFunc('function TXmlNode.GetText: string;', @_LapeXmlNode_GetText); - addGlobalFunc('procedure TXmlNode.SetNodeName(const Name: string);', @_LapeXmlNode_SetNodeName); - addGlobalFunc('procedure TXmlNode.SetParent(const Node: TXMLNode);', @_LapeXmlNode_SetParent); - addGlobalFunc('function TXmlNode.GetAttribute(const Name: string): string;', @_LapeXmlNode_GetAttribute); - addGlobalFunc('function TXmlNode.GetParent: TXMLNode;', @_LapeXmlNode_GetParent); - addGlobalFunc('function TXmlNode.Find(Name: String): TXmlNode; overload', @_LapeXmlNode_Find); - addGlobalFunc('function TXmlNode.Find(Name, Attribute: String): TXmlNode; overload', @_LapeXmlNode_FindEx); - addGlobalFunc('function TXmlNode.Find(Name, Attribute, Value: String): TXmlNode; overload', @_LapeXmlNode_FindExEx); - addGlobalFunc('function TXmlNode.FindNodes(Name: String): TXmlNodeList;', @_LapeXmlNode_FindNodes); - addGlobalFunc('function TXmlNode.HasAttribute(const Name: String): Boolean;', @_LapeXmlNode_HasAttribute); - addGlobalFunc('function TXmlNode.AddChild(const Name: String): TXmlNode;', @_LapeXmlNode_AddChild); - addGlobalFunc('function TXmlNode.SetText(Value: String): TXmlNode;', @_LapeXmlNode_SetText); - addGlobalFunc('function TXmlNode.SetAttribute(AttrName: String;Value: String): TXmlNode;', @_LapeXmlNode_SetAttribute); - //addGlobalFunc('procedure TXmlNode.Free;', @_LapeXmlNode_Free); - - addGlobalFunc('procedure TXMLNodeList.Init()', @_LapeXMLNodeList_Init); - addGlobalFunc('procedure TXMLNodeList.Clear;', @_LapeXMLNodeList_Clear); - addGlobalFunc('procedure TXMLNodeList.Assign(Src: TXMLNodeList);', @_LapeXMLNodeList_Assign); - addGlobalFunc('procedure TXMLNodeList.Add(aXMLNode: TXMLNode); overload', @_LapeXMLNodeList_Add); - addGlobalFunc('procedure TXMLNodeList.Add(aXMLNodes: TXMLNodeList); overload', @_LapeXMLNodeList_AddEx); - addGlobalFunc('function TXMLNodeList.IndexOf(aXMLNode: TXMLNode): Integer; overload', @_LapeXMLNodeList_IndexOf); - addGlobalFunc('function TXMLNodeList.IndexOf(NodeName: string): Integer; overload', @_LapeXMLNodeList_IndexOfEx); - addGlobalFunc('procedure TXMLNodeList.Delete(aXMLNode: TXMLNode); overload', @_LapeXMLNodeList_Delete); - addGlobalFunc('procedure TXMLNodeList.Delete(Index: Integer); overload', @_LapeXMLNodeList_DeleteEx); - addClassVar('TXMLNodeList', 'Count', 'Integer', @_LapeXMLNodeList_Count_Read, nil); - addGlobalFunc('function TXMLNodeList.Item(Index: Integer): TXMLNode;', @_LapeXMLNodeList_Item); - //addGlobalFunc('procedure TXMLNodeList.Free;', @_LapeXMLNodeList_Free); - - addClass('TXml', 'TObject'); - addGlobalFunc('procedure TXml.Init()', @_LapeVerySimpleXml_Init); - addGlobalFunc('procedure TXml.Clear()', @_LapeVerySimpleXml_Clear); - addGlobalFunc('procedure TXml.LoadFromFile(const FileName: String)', @_LapeVerySimpleXml_LoadFromFile); - addGlobalFunc('procedure TXml.LoadFromStream(const Stream: TStream)', @_LapeVerySimpleXml_LoadFromStream); - addGlobalFunc('procedure TXml.LoadFromString(const Str: String)', @_LapeVerySimpleXml_LoadFromString); - addGlobalFunc('procedure TXml.SaveToStream(const Stream: TStream)', @_LapeVerySimpleXml_SaveToStream); - addGlobalFunc('procedure TXml.SaveToFile(const FileName: String)', @_LapeVerySimpleXml_SaveToFile); - addGlobalFunc('procedure TXml.SaveToString(var Str: String)', @_LapeVerySimpleXml_SaveToString); - addClassVar('TXml', 'Root', 'TXMLNode', @_LapeVerySimpleXml_Root_Read, @_LapeVerySimpleXml_Root_Write); - addClassVar('TXml', 'Header', 'TXMLNode', @_LapeVerySimpleXml_Header_Read, @_LapeVerySimpleXml_Header_Write); - addClassVar('TXml', 'Ident', 'string', @_LapeVerySimpleXml_Ident_Read, @_LapeVerySimpleXml_Ident_Write); - //addGlobalFunc('procedure TXml.Free()', @_LapeVerySimpleXml_Free); - end; -end; - -end. - diff --git a/Source/script/simba.script_imports.pas b/Source/script/simba.script_imports.pas index c1a5c56f6..48e190425 100644 --- a/Source/script/simba.script_imports.pas +++ b/Source/script/simba.script_imports.pas @@ -29,8 +29,7 @@ implementation // Simba classes simba.import_class_bitmap, simba.import_class_dtm, simba.import_matchtemplate, - simba.import_class_xml, simba.import_class_json, - simba.import_class_imagebox, simba.import_class_shapebox, + simba.import_class_json, simba.import_class_imagebox, simba.import_class_shapebox, // Simba simba.import_timing, simba.import_tpa, simba.import_atpa, @@ -66,7 +65,6 @@ procedure AddSimbaImports(Compiler: TSimbaScript_Compiler); ImportSimbaImage(Compiler); ImportDTM(Compiler); ImportMatchTemplate(Compiler); - ImportXML(Compiler); ImportJSON(Compiler); ImportSimbaImageBox(Compiler); ImportSimbaShapeBox(Compiler); diff --git a/Source/simba.json.pas b/Source/simba.json.pas new file mode 100644 index 000000000..ea50caadf --- /dev/null +++ b/Source/simba.json.pas @@ -0,0 +1,433 @@ +{ + Author: Raymond van VenetiĆ« and Merlijn Wajer + Project: Simba (https://github.com/MerlijnWajer/Simba) + License: GNU General Public License (https://www.gnu.org/licenses/gpl-3.0) + + Wraps FPC's json parser in a more scripting like way. +} +unit simba.json; + +{$i simba.inc} + +interface + +uses + Classes, SysUtils, + fpjson, + simba.mufasatypes, simba.baseclass; + +type + ESimbaJSONValueType = (UNKNOWN, NULL, INT, FLOAT, STR, BOOL); + + PSimbaJSONElement = ^TSimbaJSONElement; + TSimbaJSONElement = record + private + FData: TJSONData; + + function GetAsString: String; + function GetValue: Variant; + function GetCount: Integer; + function GetIsArray: Boolean; + function GetIsObject: Boolean; + function GetIsValue: Boolean; + function GetItems(Index: Integer): TSimbaJSONElement; + function GetKeys: TStringArray; + function GetValueType: ESimbaJSONValueType; + + procedure SetValue(Value: Variant); + public + class operator := (Right: TJSONData): TSimbaJSONElement; + class operator := (Right: TSimbaJSONElement): TJSONData; + + function Clone: TSimbaJSONElement; + + function Find(Key: String; out Element: TSimbaJSONElement): Boolean; + function FindPath(Path: String; out Element: TSimbaJSONElement): Boolean; + + function AddArray(Key: String): TSimbaJSONElement; + function AddObject(Key: String): TSimbaJSONElement; + procedure AddValue(Key: String; Value: Variant); + procedure AddElement(Key: String; Element: TSimbaJSONElement); + + procedure Clear; + procedure Delete(Key: String); overload; + procedure Delete(Index: Integer); overload; + + property IsValue: Boolean read GetIsValue; + property IsArray: Boolean read GetIsArray; + property IsObject: Boolean read GetIsObject; + + property ValueType: ESimbaJSONValueType read GetValueType; + property Value: Variant read GetValue write SetValue; + + property Keys: TStringArray read GetKeys; + property Count: Integer read GetCount; + property Items[Index: Integer]: TSimbaJSONElement read GetItems; + + property AsString: String read GetAsString; + end; + + PSimbaJSONParser = ^TSimbaJSONParser; + TSimbaJSONParser = class(TSimbaBaseClass) + protected + FRoot: TSimbaJSONElement; + + function GetKeys: TStringArray; + function GetAsString: String; + function GetCount: Integer; + function GetItems(Index: Integer): TSimbaJSONElement; + public + constructor Create(Str: String); + constructor CreateFromFile(FileName: String); + destructor Destroy; override; + + function SaveToFile(FileName: String): Boolean; + + // These just wrap FRoot.XXX + function Find(Key: String; out Element: TSimbaJSONElement): Boolean; + function FindPath(Path: String; out Element: TSimbaJSONElement): Boolean; + + function AddArray(Key: String): TSimbaJSONElement; + function AddObject(Key: String): TSimbaJSONElement; + procedure AddValue(Key: String; Value: Variant); + procedure AddElement(Key: String; Element: TSimbaJSONElement); + + procedure Clear; + procedure Delete(Key: String); overload; + procedure Delete(Index: Integer); overload; + + property Keys: TStringArray read GetKeys; + property Count: Integer read GetCount; + property Items[Index: Integer]: TSimbaJSONElement read GetItems; + + property AsString: String read GetAsString; + end; + +implementation + +uses + JsonParser, Variants; + +function TSimbaJSONElement.GetAsString: String; +begin + Result := FData.FormatJSON(); +end; + +function TSimbaJSONElement.GetValue: Variant; +begin + Result := FData.Value; +end; + +function TSimbaJSONElement.GetCount: Integer; +begin + Result := FData.Count; +end; + +function TSimbaJSONElement.GetIsArray: Boolean; +begin + Result := FData is TJSONArray; +end; + +function TSimbaJSONElement.GetIsObject: Boolean; +begin + Result := FData is TJSONObject; +end; + +function TSimbaJSONElement.GetIsValue: Boolean; +begin + Result := (not IsArray) and (not IsObject); +end; + +function TSimbaJSONElement.GetItems(Index: Integer): TSimbaJSONElement; +begin + Result := FData.Items[Index]; +end; + +function TSimbaJSONElement.GetKeys: TStringArray; +var + I: Integer; +begin + Result := []; + + if (FData is TJSONObject) then + begin + SetLength(Result, FData.Count); + for I := 0 to FData.Count - 1 do + Result[I] := TJsonObject(FData).Names[I]; + end; +end; + +function TSimbaJSONElement.GetValueType: ESimbaJSONValueType; +begin + case FData.JSONType of + jtNumber: + begin + if (TJSONNumber(FData).NumberType = ntFloat) then + Result := ESimbaJSONValueType.FLOAT + else + Result := ESimbaJSONValueType.INT; + end; + jtString: Result := ESimbaJSONValueType.STR; + jtBoolean: Result := ESimbaJSONValueType.BOOL; + jtNull: Result := ESimbaJSONValueType.NULL; + else + Result := ESimbaJSONValueType.UNKNOWN; + end; +end; + +procedure TSimbaJSONElement.SetValue(Value: Variant); +begin + FData.Value := Value; +end; + +class operator TSimbaJSONElement.:=(Right: TJSONData): TSimbaJSONElement; +begin + Result.FData := Right; +end; + +class operator TSimbaJSONElement.:=(Right: TSimbaJSONElement): TJSONData; +begin + Result := Right.FData; +end; + +procedure TSimbaJSONElement.AddValue(Key: String; Value: Variant); +begin + if IsValue then + raise Exception.Create('Element is not json object or array'); + + if VarIsStr(Value) then + if IsArray then + TJSONArray(FData).Add(TJSONStringType(Value)) + else + TJSONObject(FData).Add(Key, TJSONStringType(Value)) + else + if VarIsOrdinal(Value) then + if IsArray then + TJSONArray(FData).Add(TJSONLargeInt(Value)) + else + TJSONObject(FData).Add(Key, TJSONLargeInt(Value)) + else + if VarIsFloat(Value) then + if IsArray then + TJSONArray(FData).Add(TJSONFloat(Value)) + else + TJSONObject(FData).Add(Key, TJSONFloat(Value)) + else + if VarIsBool(Value) then + if IsArray then + TJSONArray(FData).Add(Boolean(Value)) + else + TJSONObject(FData).Add(Key, Boolean(Value)) + else + raise Exception.Create('Invalid JSON variant type: ' + VarTypeAsText(VarType(Value))); +end; + +function TSimbaJSONElement.AddArray(Key: String): TSimbaJSONElement; +begin + if IsValue then + raise Exception.Create('Element is not json object or array'); + + if (FData is TJSONArray) then + Result := FData.Items[TJSONArray(FData).Add(TJSONArray.Create())] + else + if (FData is TJSONObject) then + Result := FData.Items[TJSONObject(FData).Add(Key, TJSONArray.Create())]; +end; + +function TSimbaJSONElement.AddObject(Key: String): TSimbaJSONElement; +begin + if IsValue then + raise Exception.Create('Element is not json object or array'); + + if (FData is TJSONArray) then + Result := FData.Items[TJSONArray(FData).Add(TJSONObject.Create())] + else + if (FData is TJSONObject) then + Result := FData.Items[TJSONObject(FData).Add(Key, TJSONObject.Create())]; +end; + +procedure TSimbaJSONElement.AddElement(Key: String; Element: TSimbaJSONElement); +begin + if IsValue then + raise Exception.Create('Element is not json object or array'); + + if (FData is TJSONArray) then + TJSONArray(FData).Add(Element) + else + if (FData is TJSONObject) then + TJSONObject(FData).Add(Key, Element); +end; + +procedure TSimbaJSONElement.Clear; +begin + FData.Clear(); +end; + +procedure TSimbaJSONElement.Delete(Key: String); +begin + if not IsObject then + raise Exception.Create('Element is not a json object'); + + TJSONObject(FData).Delete(Key); +end; + +procedure TSimbaJSONElement.Delete(Index: Integer); +begin + if IsValue then + raise Exception.Create('Element is not json object or array'); + + if (FData is TJSONArray) then + TJSONArray(FData).Delete(Index) + else + if (FData is TJSONObject) then + TJSONObject(FData).Delete(Index); +end; + +function TSimbaJSONElement.Find(Key: String; out Element: TSimbaJSONElement): Boolean; +var + Data: TJSONData; +begin + if not IsObject then + raise Exception.Create('Element is not json object'); + + Result := TJSONObject(FData).Find(Key, Data); + if Result then + Element := Data; +end; + +function TSimbaJSONElement.FindPath(Path: String; out Element: TSimbaJSONElement): Boolean; +var + Data: TJSONData; +begin + Data := FData.FindPath(Path); + Result := Assigned(Data); + if Result then + Element := Data; +end; + +function TSimbaJSONElement.Clone: TSimbaJSONElement; +begin + Result := FData.Clone; +end; + +constructor TSimbaJSONParser.Create(Str: String); +begin + inherited Create(); + + FRoot := GetJSON(Str); + if (FRoot.FData = nil) then + FRoot := TJSONObject.Create(); +end; + +constructor TSimbaJSONParser.CreateFromFile(FileName: String); +var + Stream: TFileStream; +begin + inherited Create(); + + Stream := TFileStream.Create(FileName, fmOpenRead); + try + FRoot := GetJSON(Stream); + finally + Stream.Free(); + end; +end; + +destructor TSimbaJSONParser.Destroy; +begin + if (FRoot.FData <> nil) then + FreeAndNil(FRoot.FData); + + inherited Destroy(); +end; + +function TSimbaJSONParser.SaveToFile(FileName: String): Boolean; +var + Stream: TFileStream; + Str: String; +begin + Result := False; + + Stream := nil; + try + Str := AsString; + if FileExists(FileName) then + Stream := TFileStream.Create(FileName, fmOpenReadWrite or fmShareDenyWrite) + else + Stream := TFileStream.Create(FileName, fmCreate or fmShareDenyWrite); + + Stream.WriteBuffer(Str[1], Length(Str)); + except + end; + + if (Stream <> nil) then + Stream.Free(); +end; + +procedure TSimbaJSONParser.Clear; +begin + FRoot.Clear(); +end; + +procedure TSimbaJSONParser.AddElement(Key: String; Element: TSimbaJSONElement); +begin + FRoot.AddElement(Key, Element); +end; + +procedure TSimbaJSONParser.AddValue(Key: String; Value: Variant); +begin + FRoot.AddValue(Key, Value); +end; + +function TSimbaJSONParser.AddArray(Key: String): TSimbaJSONElement; +begin + Result := FRoot.AddArray(Key); +end; + +function TSimbaJSONParser.AddObject(Key: String): TSimbaJSONElement; +begin + Result := FRoot.AddObject(Key); +end; + +procedure TSimbaJSONParser.Delete(Key: String); +begin + FRoot.Delete(Key); +end; + +procedure TSimbaJSONParser.Delete(Index: Integer); +begin + FRoot.Delete(Index); +end; + +function TSimbaJSONParser.Find(Key: String; out Element: TSimbaJSONElement): Boolean; +begin + Result := FRoot.Find(Key, Element); +end; + +function TSimbaJSONParser.FindPath(Path: String; out Element: TSimbaJSONElement): Boolean; +begin + Result := FRoot.FindPath(Path, Element); +end; + +function TSimbaJSONParser.GetCount: Integer; +begin + Result := FRoot.Count; +end; + +function TSimbaJSONParser.GetKeys: TStringArray; +begin + Result := FRoot.Keys; +end; + +function TSimbaJSONParser.GetAsString: String; +begin + Result := FRoot.AsString; +end; + +function TSimbaJSONParser.GetItems(Index: Integer): TSimbaJSONElement; +begin + Result := FRoot.Items[Index]; +end; + +end. + diff --git a/Source/simba.jsonparser.pas b/Source/simba.jsonparser.pas deleted file mode 100644 index 20028358e..000000000 --- a/Source/simba.jsonparser.pas +++ /dev/null @@ -1,3184 +0,0 @@ -{ - Author: Raymond van VenetiĆ« and Merlijn Wajer - Project: Simba (https://github.com/MerlijnWajer/Simba) - License: GNU General Public License (https://www.gnu.org/licenses/gpl-3.0) -} -unit simba.jsonparser; -{ - Copyright (C) 2005 Fabio Almeida - fabiorecife@yahoo.com.br - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. - - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA - -} -{ Modified for Simba project: Cynic - CynicRus@gmail.com} -{$mode Delphi} - -interface - -uses - SysUtils, Classes, TypInfo; - -Type - { @abstract(Classe pai de todas as classes em uJSON , resolve o problema de - impedŠ²ncia entre a classe java Object e a classe delphi TObject) - } - PZAbstractObject = ^TZAbstractObject; - TZAbstractObject = class - { retorna true se value Š¹ igual ao objeto } - function equals(const Value: TZAbstractObject): Boolean; virtual; - { cуdigo hash do objeto , usa-se o endereŠ·o de memуria } - function hash: LongInt; - { clona o objeto - @return ( um TZAbstractObject ) } - function Clone: TZAbstractObject; virtual; - { retorna a representaŠ·Š³o com string do objeto - @return (uma string) } - function toString: string; virtual; - { retorna true se o parŠ²metro Value Š¹ uma instŠ²ncia de TZAbstractObject } - function instanceOf(const Value: TZAbstractObject): Boolean; - end; - - { @abstract(wrapper para ClassCastException do java) } - ClassCastException = class(Exception) - end; - - { @abstract(wrapper para NoSuchElementException do java) } - NoSuchElementException = class(Exception) - end; - - { @abstract(wrapper para NumberFormatException do java) } - NumberFormatException = class(Exception) - end; - - { @abstract(wrapper para NullPointerException do java) } - NullPointerException = class(Exception) - end; - - { @abstract(as features nŠ³o implementadas geram esta exception) } - NotImplmentedFeature = class(Exception) - end; - - PJSONArray = ^TJSONArray; - TJSONArray = class; - _Number = class; - _String = class; - _Double = class; - NULL = class; - - { @abstract(exception gerada quando ocorre um erro de parsing) } - ParseException = class(Exception) - constructor create(_message: string; index: integer); - end; - - (* * - @abstract(ResponsŠ±vel por auxiliar na anŠ±lise LŠ¹xica de uma string que representa um JSON.) - *) - JSONTokener = class(TZAbstractObject) - public - (* * - Construct a JSONTokener from a string. - @param(s A source string.) *) - constructor create(s: string); - - (* * - Back up one character. This provides a sort of lookahead capability, - so that you can test for a digit or letter before attempting to parse - the next number or identifier. - *) - procedure back(); - (* * - Get the hex value of a character (base16). - @param(c A character between '0' and '9' or between 'A' and 'F' or - between 'a' and 'f'.) - @return(An int between 0 and 15, or -1 if c was not a hex digit.) - *) - class function dehexchar(c: char): integer; - function more: Boolean; - function next(): char; overload; - function next(c: char): char; overload; - function next(n: integer): string; overload; - function nextClean(): char; - function nextString(quote: char): string; - function nextTo(d: char): string; overload; - function nextTo(delimiters: string): char; overload; - function nextValue(): TZAbstractObject; - procedure skipPast(_to: string); - function skipTo(_to: char): char; - function syntaxError(_message: string): ParseException; - function toString: string; override; - function unescape(s: string): string; - private - myIndex: integer; - mySource: string; - end; - - { @abstract(Classe que representa um objeto JSON) } - PJSONObject = ^TJSONObject; - TJSONObject = class(TZAbstractObject) - private - myHashMap: TStringList; - public - (* * - Construct an empty TJSONObject. - *) - constructor create; overload; - - (* * - Construct a TJSONObject from a subset of another TJSONObject. - An array of strings is used to identify the keys that should be copied. - Missing keys are ignored. - @param(jo A TJSONObject.) - @param(sa An array of strings). - *) - constructor create(jo: TJSONObject; sa: array of string); overload; - (* * - Construct a TJSONObject from a JSONTokener. - @param(x A JSONTokener object containing the source string.) - @raises(ParseException if there is a syntax error in the source string.) - *) - constructor create(x: JSONTokener); overload; - (* * - Construct a TJSONObject from a TStringList. - @param(map A map object that can be used to initialize the contents of - the TJSONObject.) - *) - constructor create(map: TStringList); overload; - (* * - Construct a TJSONObject from a string. - This is the most commonly used TJSONObject constructor. - @param(s @html(A string beginning - with { (left brace) and ending - with } (right brace).)) - @raises(ParseException The string must be properly formatted.) - *) - constructor create(s: string); overload; - - (* * - remove todos os menbros de um objeto JSON . - *) - procedure clean; - (* * - sobreescreve o metodo clone de TZAbstractObject - *) - function Clone: TZAbstractObject; override; - function accumulate(key: string; Value: TZAbstractObject): TJSONObject; - function get(key: string): TZAbstractObject; - function getBoolean(key: string): Boolean; - function getDouble(key: string): double; - function getInt(key: string): integer; - function getJSONArray(key: string): TJSONArray; - function getJSONObject(key: string): TJSONObject; - function getString(key: string): string; - function has(key: string): Boolean; - function isNull(key: string): Boolean; - (* * - retorna um TStringList com todos os nomes dos atributos do TJSONObject - *) - function keys: TStringList; - (* * - Retorna quantos atributos tem o TJSONObject - *) - function length: integer; - (* * - Produce a TJSONArray containing the names of the elements of this - TJSONObject. - @return(A TJSONArray containing the key strings, or null if the TJSONObject - is empty). - *) - function names: TJSONArray; - (* * - transforma uma class wrapper _Number (Number em java) em AnsiString - *) - class function numberToString(n: _Number): string; - (* * - Make JSON string of an object value. - @html(

- Warning: This method assumes that the data structure is acyclical. - ) - @param(value The value to be serialized.) - @return( @html(a printable, displayable, transmittable - representation of the object, beginning - with { (left brace) and ending - with } (right brace).)) - *) - class function valueToString(Value: TZAbstractObject): string; overload; - (* * - Make a prettyprinted JSON text of an object value. - @html( -

- Warning: This method assumes that the data structure is acyclical. - ) - @param(value The value to be serialized.) - @param(indentFactor The number of spaces to add to each level of - indentation.) - @param(indent The indentation of the top level.) - @return(@html(a printable, displayable, transmittable - representation of the object, beginning - with { (left brace) and ending - with } (right brace).)) - *) - class function valueToString(Value: TZAbstractObject; - indentFactor, indent: integer): string; overload; - (* * - Get an optional value associated with a key. - @param(key A key string.) - @return(An object which is the value, or null if there is no value.) - @raises(NullPointerException caso key = '') - *) - function opt(key: string): TZAbstractObject; - function optBoolean(key: string): Boolean; overload; - function optBoolean(key: string; defaultValue: Boolean): Boolean; overload; - function optDouble(key: string): double; overload; - function optDouble(key: string; defaultValue: double): double; overload; - function optInt(key: string): integer; overload; - function optInt(key: string; defaultValue: integer): integer; overload; - function optString(key: string): string; overload; - function optString(key: string; defaultValue: string): string; overload; - - function optJSONArray(key: string): TJSONArray; overload; - function optJSONObject(key: string): TJSONObject; overload; - - function put(key: string; Value: Boolean): TJSONObject; overload; - function put(key: string; Value: double): TJSONObject; overload; - function put(key: string; Value: integer): TJSONObject; overload; - function put(key: string; Value: string): TJSONObject; overload; - - (* * - Put a key/value pair in the TJSONObject. If the value is null, - then the key will be removed from the TJSONObject if it is present. - @param(key A key string.) - @param(value An object which is the value. It should be of one of these - types: Boolean, Double, Integer, TJSONArray, TJSONObject, String, or the - TJSONObject.NULL object.) - @return(this.) - @raises(NullPointerException The key must be non-null.) - *) - function put(key: string; Value: TZAbstractObject): TJSONObject; overload; - (* * - Put a key/value pair in the TJSONObject, but only if the - value is non-null. - @param(key A key string.) - @param(value An object which is the value. It should be of one of these - types: Boolean, Double, Integer, TJSONArray, TJSONObject, String, or the - TJSONObject.NULL object.) - @return(this.) - @raises(NullPointerException The key must be non-null.) - *) - function putOpt(key: string; Value: TZAbstractObject): TJSONObject; - class function quote(s: string): string; - function remove(key: string): TZAbstractObject; - procedure assignTo(json: TJSONObject); - - function toJSONArray(names: TJSONArray): TJSONArray; - function toString(): string; overload; override; - function toString(indentFactor: integer): string; overload; - function toString(indentFactor, indent: integer): string; overload; - - destructor destroy; override; - class function NULL: NULL; - end; - - { @abstract(Trata um array JSON = [...]) } - TJSONArray = class(TZAbstractObject) - public - destructor destroy; override; - constructor create; overload; - constructor create(collection: TList); overload; - constructor create(x: JSONTokener); overload; - constructor create(s: string); overload; - function get(index: integer): TZAbstractObject; - function getBoolean(index: integer): Boolean; - function getDouble(index: integer): double; - function getInt(index: integer): integer; - { - Get the TJSONArray associated with an index. - @param(index The index must be between 0 and length() - 1.) - @return(A TJSONArray value.) - @raises(NoSuchElementException if the index is not found or if the - value is not a TJSONArray) } - function getJSONArray(index: integer): TJSONArray; - function getJSONObject(index: integer): TJSONObject; - function getString(index: integer): string; - function isNull(index: integer): Boolean; - function join(separator: string): string; - function length: integer; - function opt(index: integer): TZAbstractObject; - function optBoolean(index: integer): Boolean; overload; - function optBoolean(index: integer; defaultValue: Boolean) - : Boolean; overload; - function optDouble(index: integer): double; overload; - function optDouble(index: integer; defaultValue: double): double; overload; - function optInt(index: integer): integer; overload; - function optInt(index: integer; defaultValue: integer): integer; overload; - function optJSONArray(index: integer): TJSONArray; overload; - function optJSONObject(index: integer): TJSONObject; overload; - function optString(index: integer): string; overload; - function optString(index: integer; defaultValue: string): string; overload; - function put(Value: Boolean): TJSONArray; overload; - function put(Value: double): TJSONArray; overload; - function put(Value: integer): TJSONArray; overload; - function put(Value: TZAbstractObject): TJSONArray; overload; - function put(Value: string): TJSONArray; overload; - function put(index: integer; Value: Boolean): TJSONArray; overload; - function put(index: integer; Value: double): TJSONArray; overload; - function put(index: integer; Value: integer): TJSONArray; overload; - function put(index: integer; Value: TZAbstractObject): TJSONArray; overload; - function put(index: integer; Value: string): TJSONArray; overload; - function toJSONObject(names: TJSONArray): TJSONObject; overload; - function toString: string; overload; override; - function toString(indentFactor: integer): string; overload; - function toString(indentFactor, indent: integer): string; overload; - function toList(): TList; - private - myArrayList: TList; - end; - - (* * @abstract(wrapper da classe Number do java) *) - _Number = class(TZAbstractObject) - function doubleValue: double; virtual; abstract; - function intValue: integer; virtual; abstract; - end; - - (* * @abstract(wrapper da classe Boolean do java) *) - _Boolean = class(TZAbstractObject) - class function _TRUE(): _Boolean; - class function _FALSE(): _Boolean; - class function valueOf(b: Boolean): _Boolean; - constructor create(b: Boolean); - function toString(): string; override; - function Clone: TZAbstractObject; override; - private - fvalue: Boolean; - end; - - (* * @abstract(wrapper da classe Double do java) *) - _Double = class(_Number) - constructor create(s: string); overload; - constructor create(s: _String); overload; - constructor create(d: double); overload; - function doubleValue: double; override; - function intValue: integer; override; - function toString(): string; override; - class function NaN: double; - function Clone: TZAbstractObject; override; - private - fvalue: double; - end; - - (* * @abstract(wrapper da classe Integer do java) *) - _Integer = class(_Number) - class function parseInt(s: string; i: integer): integer; overload; - class function parseInt(s: _String): integer; overload; - class function toHexString(c: char): string; - constructor create(i: integer); overload; - constructor create(s: string); overload; - function doubleValue: double; override; - function intValue: integer; override; - function toString(): string; override; - function Clone: TZAbstractObject; override; - private - fvalue: integer; - end; - - (* * @abstract(wrapper da classe String do java) *) - _String = class(TZAbstractObject) - constructor create(s: string); - function equalsIgnoreCase(s: string): Boolean; - function equals(const Value: TZAbstractObject): Boolean; override; - function toString(): string; override; - function Clone: TZAbstractObject; override; - private - fvalue: string; - end; - - (* * @abstract(utilizado quando se deseja representar um valor NULL ) *) - NULL = class(TZAbstractObject) - function equals(const Value: TZAbstractObject): Boolean; override; - function toString(): string; override; - end; - -var - (* * constante para representar um objeto null *) - CNULL: NULL; - -implementation - -const - CROTINA_NAO_IMPLEMENTADA: string = 'Not implemented feature!'; - -procedure newNotImplmentedFeature(); -begin - raise NotImplmentedFeature.create(CROTINA_NAO_IMPLEMENTADA); -end; - -function getFormatSettings: TFormatSettings; -begin - result := SysUtils.FormatSettings; -end; - -function HexToInt(s: String): integer; -var - i, E, F, G: integer; - - function DigitValue(c: char): integer; - begin - case c of - 'A': - result := 10; - 'B': - result := 11; - 'C': - result := 12; - 'D': - result := 13; - 'E': - result := 14; - 'F': - result := 15; - else - result := StrToInt(c); - end; - end; - -begin - s := UpperCase(s); - if s[1] = '$' then - Delete(s, 1, 1); - if s[2] = 'X' then - Delete(s, 1, 2); - E := -1; - result := 0; - for i := length(s) downto 1 do - begin - G := 1; - for F := 0 to E do - G := G * 16; - result := result + (DigitValue(s[i]) * G); - Inc(E); - end; -end; - -{ JSONTokener } - -constructor JSONTokener.create(s: string); -begin - self.myIndex := 1; - self.mySource := s; -end; - -procedure JSONTokener.back; -begin - if (self.myIndex > 1) then - begin - self.myIndex := self.myIndex - 1; - end; -end; - -class function JSONTokener.dehexchar(c: char): integer; -begin - if ((c >= '0') and (c <= '9')) then - begin - result := (ord(c) - ord('0')); - exit; - end; - if ((c >= 'A') and (c <= 'F')) then - begin - result := (ord(c) + 10 - ord('A')); - exit; - end; - if ((c >= 'a') and (c <= 'f')) then - begin - result := ord(c) + 10 - ord('a'); - exit; - end; - result := -1; -end; - -(* * - * Determine if the source string still contains characters that next() - * can consume. - * @return true if not yet at the end of the source. -*) -function JSONTokener.more: Boolean; -begin - result := self.myIndex <= System.length(self.mySource) + 1; -end; - -function JSONTokener.next: char; -begin - if (more()) then - begin - result := self.mySource[self.myIndex]; - self.myIndex := self.myIndex + 1; - exit; - end; - result := chr(0); -end; - -(* * - * Consume the next character, and check that it matches a specified - * character. - * @param c The character to match. - * @return The character. - * @throws ParseException if the character does not match. -*) -function JSONTokener.next(c: char): char; -begin - result := next(); - if (result <> c) then - begin - raise syntaxError('Expected ' + c + ' and instead saw ' + result + '.'); - end; -end; - -(* * - * Get the next n characters. - * - * @param n The number of characters to take. - * @return A string of n characters. - * @raises (ParseException - * Substring bounds error if there are not - * n characters remaining in the source string.) -*) -function JSONTokener.next(n: integer): string; -var - i, j: integer; -begin - i := self.myIndex; - j := i + n; - if (j > System.length(self.mySource)) then - begin - raise syntaxError('Substring bounds error'); - end; - self.myIndex := self.myIndex + n; - result := copy(self.mySource, i, n); // substring(i, j) -end; - -(* * - * Get the next char in the string, skipping whitespace - * and comments (slashslash, slashstar, and hash). - * @throws ParseException - * @return A character, or 0 if there are no more characters. -*) -function JSONTokener.nextClean: char; -var - c: char; - -begin - while (true) do - begin - c := next(); - if (c = '/') then - begin - case (next()) of - '/': - begin - repeat - c := next(); - until (not((c <> #10) and (c <> #13) and (c <> #0))); - end; - '*': - begin - while (true) do - begin - c := next(); - if (c = #0) then - begin - raise syntaxError('Unclosed comment.'); - end; - if (c = '*') then - begin - if (next() = '/') then - begin - break; - end; - back(); - end; - end; - end - else - begin - back(); - result := '/'; - exit; - end; - end; - end - else if (c = '#') then - begin - repeat - c := next(); - until (not((c <> #10) and (c <> #13) and (c <> #0))); - end - else if ((c = #0) or (c > ' ')) then - begin - result := c; - exit; - end; - end; // while -end; - -(* * - * Return the characters up to the next close quote character. - * Backslash processing is done. The formal JSON format does not - * allow strings in single quotes, but an implementation is allowed to - * accept them. - * @param quote The quoting character, either - * " (double quote) or - * ' (single quote). - * @return A String. - * @raises (ParseException Unterminated string.) -*) -function JSONTokener.nextString(quote: char): string; -var - c: char; - sb: string; -begin - sb := ''; - while (true) do - begin - c := next(); - case (c) of - #0, #10, #13: - begin - raise syntaxError('Unterminated string'); - end; - '\': - begin - c := next(); - case (c) of - 'b': - sb := sb + #8; - 't': - sb := sb + #9; - 'n': - sb := sb + #10; - 'f': - sb := sb + #12; - 'r': - sb := sb + #13; - 'u': - sb := sb + WideChar(StrToInt('$' + next(4))); - { case 'u': - sb.append((char)Integer.parseInt(next(4), 16)); - break; - case 'x' : \cx The control character corresponding to x - sb.append((char) Integer.parseInt(next(2), 16)); - break; } - else - sb := sb + c - end; - end - else - begin - if (c = quote) then - begin - result := sb; - exit; - end; - sb := sb + c - end; - end; - end; -end; - -(* * - * Get the text up but not including the specified character or the - * end of line, whichever comes first. - * @param d A delimiter character. - * @return A string. -*) -function JSONTokener.nextTo(d: char): string; -var - sb: string; - c: char; -begin - c := #0; - sb := ''; - while (true) do - begin - c := next(); - if ((c = d) or (c = #0) or (c = #10) or (c = #13)) then - begin - if (c <> #0) then - begin - back(); - end; - result := trim(sb); - exit; - end; - sb := sb + c; - end; -end; - -(* * - * Get the text up but not including one of the specified delimeter - * characters or the end of line, whichever comes first. - * @param delimiters A set of delimiter characters. - * @return A string, trimmed. -*) -function JSONTokener.nextTo(delimiters: string): char; -var - c: char; - sb: string; -begin - c := #0; - sb := ''; - while (true) do - begin - c := next(); - if ((pos(c, delimiters) > 0) or (c = #0) or (c = #10) or (c = #13)) then - begin - if (c <> #0) then - begin - back(); - end; - sb := trim(sb); - if (System.length(sb) > 0) then - result := sb[1]; - exit; - end; - sb := sb + c; - end; -end; - -(* * - * Get the next value. The value can be a Boolean, Double, Integer, - * TJSONArray, TJSONObject, or String, or the TJSONObject.NULL object. - * @raises (ParseException The source does not conform to JSON syntax.) - * - * @return An object. -*) -function JSONTokener.nextValue: TZAbstractObject; -var - c, b: char; - s, sb: string; -begin - c := nextClean(); - - case (c) of - '"', #39: - begin - result := _String.create(nextString(c)); - exit; - end; - '{': - begin - back(); - result := TJSONObject.create(self); - exit; - end; - '[': - begin - back(); - result := TJSONArray.create(self); - exit; - end; - end; - - (* - * Handle unquoted text. This could be the values true, false, or - * null, or it can be a number. An implementation (such as this one) - * is allowed to also accept non-standard forms. - * - * Accumulate characters until we reach the end of the text or a - * formatting character. - *) - - sb := ''; - b := c; - while ((ord(c) >= ord(' ')) and (pos(c, ',:]}/\\\"[{;=#') = 0)) do - begin - sb := sb + c; - c := next(); - end; - back(); - - (* - * If it is true, false, or null, return the proper value. - *) - - s := trim(sb); - if (s = '') then - begin - raise syntaxError('Missing value.'); - end; - if (AnsiLowerCase(s) = 'true') then - begin - result := _Boolean._TRUE; - exit; - end; - - if (AnsiLowerCase(s) = 'false') then - begin - result := _Boolean._FALSE; - exit; - end; - if (AnsiLowerCase(s) = 'null') then - begin - result := TJSONObject.NULL; - exit; - end; - - (* - * If it might be a number, try converting it. We support the 0- and 0x- - * conventions. If a number cannot be produced, then the value will just - * be a string. Note that the 0-, 0x-, plus, and implied string - * conventions are non-standard. A JSON parser is free to accept - * non-JSON forms as long as it accepts all correct JSON forms. - *) - - if (((b >= '0') and (b <= '9')) or (b = '.') or (b = '-') or (b = '+')) then - begin - if (b = '0') then - begin - if ((System.length(s) > 2) and ((s[2] = 'x') or (s[2] = 'X'))) then - begin - try - result := _Integer.create - (_Integer.parseInt(copy(s, 3, System.length(s)), 16)); - exit; - Except - on E: Exception do - begin - /// * Ignore the error */ - end; - end; - end - else - begin - try - result := _Integer.create(_Integer.parseInt(s, 8)); - exit; - Except - on E: Exception do - begin - /// * Ignore the error */ - end; - end; - end; - end; - try - result := _Integer.create(s); - exit; - Except - on E: Exception do - begin - /// * Ignore the error */ - end; - end; - - try - result := _Double.create(s); - exit; - Except - on E: Exception do - begin - /// * Ignore the error */ - end; - end; - end; - result := _String.create(s); -end; - -(* * - * Skip characters until the next character is the requested character. - * If the requested character is not found, no characters are skipped. - * @param to A character to skip to. - * @return The requested character, or zero if the requested character - * is not found. -*) -function JSONTokener.skipTo(_to: char): char; -var - c: char; - index: integer; -begin - c := #0; - index := self.myIndex; - repeat - c := next(); - if (c = #0) then - begin - self.myIndex := index; - result := c; - exit; - end; - until (not(c <> _to)); - back(); - result := c; - exit; -end; - -(* * - * Skip characters until past the requested string. - * If it is not found, we are left at the end of the source. - * @param to A string to skip past. -*) -procedure JSONTokener.skipPast(_to: string); -begin - self.myIndex := pos(_to, copy(mySource, self.myIndex, - System.length(mySource))); - if (self.myIndex < 0) then - begin - self.myIndex := System.length(self.mySource) + 1; - end - else - begin - self.myIndex := self.myIndex + System.length(_to); - end; -end; - -(* * - * Make a ParseException to signal a syntax error. - * - * @param message The error message. - * @return A ParseException object, suitable for throwing -*) -function JSONTokener.syntaxError(_message: string): ParseException; -begin - result := ParseException.create(_message + toString() + ' prуximo a : ' + - copy(toString(), self.myIndex, 10), self.myIndex); -end; - -(* * - * Make a printable string of this JSONTokener. - * - * @return " at character [this.myIndex] of [this.mySource]" -*) -function JSONTokener.toString: string; -begin - result := ' at character ' + intToStr(self.myIndex) + ' of ' + self.mySource; -end; - -(* * - * Convert %hh sequences to single characters, and - * convert plus to space. - * @param s A string that may contain - * + (plus) and - * %hh sequences. - * @return The unescaped string. -*) -function JSONTokener.unescape(s: string): string; -var - len, i, d, E: integer; - b: string; - c: char; -begin - len := System.length(s); - b := ''; - i := 1; - while (i <= len) do - begin - c := s[i]; - if (c = '+') then - begin - c := ' '; - end - else if ((c = '%') and ((i + 2) <= len)) then - begin - d := dehexchar(s[i + 1]); - E := dehexchar(s[i + 2]); - if ((d >= 0) and (E >= 0)) then - begin - c := chr(d * 16 + E); - i := i + 2; - end; - end; - b := b + c; - i := i + 1; - end; - result := b; -end; - -{ TJSONObject } - -constructor TJSONObject.create; -begin - myHashMap := TStringList.create; -end; - -constructor TJSONObject.create(jo: TJSONObject; sa: array of string); -var - i: integer; -begin - create(); - for i := low(sa) to high(sa) do - begin - putOpt(sa[i], jo.opt(sa[i]).Clone); - end; -end; - -constructor TJSONObject.create(x: JSONTokener); -var - c: char; - key: string; -begin - create; - c := #0; - key := ''; - - if (x.nextClean() <> '{') then - begin - raise x.syntaxError('A TJSONObject must begin with "{"'); - end; - while (true) do - begin - c := x.nextClean(); - case (c) of - #0: - raise x.syntaxError('A TJSONObject must end with "}"'); - '}': - begin - exit; - end - else - begin - x.back(); - with x.nextValue() do - begin - key := toString(); - Free; // Fix memory leak. By creation_zy - end; - end - end; // fim do case - - (* - * The key is followed by ':'. We will also tolerate '=' or '=>'. - *) - - c := x.nextClean(); - if (c = '=') then - begin - if (x.next() <> '>') then - begin - x.back(); - end; - end - else if (c <> ':') then - begin - raise x.syntaxError('Expected a ":" after a key'); - end; - self.myHashMap.AddObject(key, x.nextValue()); - - (* - * Pairs are separated by ','. We will also tolerate ';'. - *) - - case (x.nextClean()) of - ';', ',': - begin - if (x.nextClean() = '}') then - begin - exit; - end; - x.back(); - end; - '}': - begin - exit; - end - else - begin - raise x.syntaxError('Expected a "," or "}"'); - end - end; - end; // while - -end; - -constructor TJSONObject.create(map: TStringList); -var - i: integer; -begin - self.myHashMap := TStringList.create; - for i := 0 to map.Count - 1 do - begin - self.myHashMap.AddObject(map[i], map.Objects[i]); - end; -end; - -constructor TJSONObject.create(s: string); -var - token: JSONTokener; -begin - token := JSONTokener.create(s); - create(token); - token.Free; -end; - -(* * - * Accumulate values under a key. It is similar to the put method except - * that if there is already an object stored under the key then a - * TJSONArray is stored under the key to hold all of the accumulated values. - * If there is already a TJSONArray, then the new value is appended to it. - * In contrast, the put method replaces the previous value. - * @param key A key string. - * @param value An object to be accumulated under the key. - * @return this. - * @throws NullPointerException if the key is null -*) -function TJSONObject.accumulate(key: string; Value: TZAbstractObject) - : TJSONObject; -var - a: TJSONArray; - o: TZAbstractObject; -begin - a := nil; - o := opt(key); - if (o = nil) then - begin - put(key, Value); - end - else if (o is TJSONArray) then - begin - a := TJSONArray(o); - a.put(Value); - end - else - begin - a := TJSONArray.create; - a.put(o.Clone); - a.put(Value); - put(key, a); - end; - result := self; -end; - -(* * - * Get the value object associated with a key. - * - * @param key A key string. - * @return The object associated with the key. - * @raises (NoSuchElementException if the key is not found.) -*) -function TJSONObject.get(key: string): TZAbstractObject; -var - o: TZAbstractObject; -begin - o := opt(key); - if (o = nil) then - begin - raise NoSuchElementException.create('TJSONObject[' + quote(key) + - '] not found.'); - end; - result := o; -end; - -(* * - * Get the boolean value associated with a key. - * - * @param key A key string. - * @return The truth. - * @raises (NoSuchElementException if the key is not found.) - * @raises (ClassCastException - * if the value is not a Boolean or the String "true" or "false".) -*) -function TJSONObject.getBoolean(key: string): Boolean; -var - o: TZAbstractObject; -begin - o := get(key); - if (o.equals(_Boolean._FALSE) or ((o is _String) and (_String(o)) - .equalsIgnoreCase('false'))) then - begin - result := false; - exit; - end - else if (o.equals(_Boolean._TRUE) or ((o is _String) and (_String(o)) - .equalsIgnoreCase('true'))) then - begin - result := true; - exit; - end; - raise ClassCastException.create('TJSONObject[' + quote(key) + - '] is not a Boolean.'); -end; - -function TJSONObject.getDouble(key: string): double; -var - o: TZAbstractObject; -begin - o := get(key); - if (o is _Number) then - begin - result := _Number(o).doubleValue(); - exit; - end; - if (o is _String) then - begin - result := StrToFloat(_String(o).toString(), getFormatSettings()); - exit; - end; - raise NumberFormatException.create('TJSONObject[' + quote(key) + - '] is not a number.'); -end; - -(* * - * Get the int value associated with a key. - * - * @param key A key string. - * @return The integer value. - * @raises (NoSuchElementException if the key is not found) - * @raises (NumberFormatException - * if the value cannot be converted to a number.) -*) -function TJSONObject.getInt(key: string): integer; -var - o: TZAbstractObject; -begin - o := get(key); - if (o is _Number) then - begin - result := _Number(o).intValue(); - end - else - begin - result := Round(getDouble(key)); - end; - -end; - -(* * - * Get the TJSONArray value associated with a key. - * - * @param key A key string. - * @return A TJSONArray which is the value. - * @raises (NoSuchElementException if the key is not found or - * if the value is not a TJSONArray.) -*) -function TJSONObject.getJSONArray(key: string): TJSONArray; -var - o: TZAbstractObject; -begin - o := opt(key); - if (o is TJSONArray) then - begin - result := TJSONArray(o); - end - else - begin - raise NoSuchElementException.create('TJSONObject[' + quote(key) + - '] is not a TJSONArray.'); - end; -end; - -(* * - * Get the TJSONObject value associated with a key. - * - * @param key A key string. - * @return A TJSONObject which is the value. - * @raises (NoSuchElementException if the key is not found or - * if the value is not a TJSONObject.) -*) -function TJSONObject.getJSONObject(key: string): TJSONObject; -var - o: TZAbstractObject; -begin - o := get(key); - if (o is TJSONObject) then - begin - result := TJSONObject(o); - end - else - begin - raise NoSuchElementException.create('TJSONObject[' + quote(key) + - '] is not a TJSONObject.'); - end; -end; - -(* * - * Get the string associated with a key. - * - * @param key A key string. - * @return A string which is the value. - * @raises (NoSuchElementException if the key is not found.) -*) -function TJSONObject.getString(key: string): string; -begin - result := get(key).toString(); -end; - -(* * - * Determine if the TJSONObject contains a specific key. - * @param key A key string. - * @return true if the key exists in the TJSONObject. -*) -function TJSONObject.has(key: string): Boolean; -begin - result := self.myHashMap.IndexOf(key) >= 0; -end; - -(* * - * Determine if the value associated with the key is null or if there is - * no value. - * @param key A key string. - * @return true if there is no value associated with the key or if - * the value is the TJSONObject.NULL object. -*) -function TJSONObject.isNull(key: string): Boolean; -begin - result := NULL.equals(opt(key)); -end; - -function TJSONObject.keys: TStringList; -var - i: integer; -begin - result := TStringList.create; - for i := 0 to myHashMap.Count - 1 do - begin - result.add(myHashMap[i]); - end; -end; - -function TJSONObject.length: integer; -begin - result := myHashMap.Count; -end; - -(* * - * Produce a TJSONArray containing the names of the elements of this - * TJSONObject. - * @return A TJSONArray containing the key strings, or null if the TJSONObject - * is empty. -*) -function TJSONObject.names: TJSONArray; -var - ja: TJSONArray; - i: integer; - k: TStringList; -begin - ja := TJSONArray.create; - k := keys; - try - for i := 0 to k.Count - 1 do - begin - ja.put(_String.create(k[i])); - end; - if (ja.length = 0) then - begin - result := nil; - end - else - begin - result := ja; - end; - finally - k.Free; - end; -end; - -class function TJSONObject.numberToString(n: _Number): string; -begin - if (n = nil) then - begin - result := ''; - end - else - begin - result := n.toString(); - end; -end; - -function TJSONObject.opt(key: string): TZAbstractObject; -begin - if (key = '') then - begin - raise NullPointerException.create('Null key'); - end - else - begin - if myHashMap.IndexOf(key) < 0 then - begin - result := nil; - end - else - begin - result := TZAbstractObject(myHashMap.Objects[myHashMap.IndexOf(key)]); - end; - end; -end; - -(* * - * Get an optional boolean associated with a key. - * It returns false if there is no such key, or if the value is not - * Boolean.TRUE or the String "true". - * - * @param key A key string. - * @return The truth. -*) -function TJSONObject.optBoolean(key: string): Boolean; -begin - result := optBoolean(key, false); -end; - -(* * - * Get an optional boolean associated with a key. - * It returns the defaultValue if there is no such key, or if it is not - * a Boolean or the String "true" or "false" (case insensitive). - * - * @param key A key string. - * @param defaultValue The default. - * @return The truth. -*) -function TJSONObject.optBoolean(key: string; defaultValue: Boolean): Boolean; -var - o: TZAbstractObject; -begin - o := opt(key); - if (o <> nil) then - begin - if (o.equals(_Boolean._FALSE) or ((o is _String) and - (_String(o).equalsIgnoreCase('false')))) then - begin - result := false; - exit; - end - else if (o.equals(_Boolean._TRUE) or - ((o is _String) and (_String(o).equalsIgnoreCase('true')))) then - begin - result := true; - exit; - end; - end; - result := defaultValue; -end; - -(* * - * Get an optional double associated with a key, - * or NaN if there is no such key or if its value is not a number. - * If the value is a string, an attempt will be made to evaluate it as - * a number. - * - * @param key A string which is the key. - * @return An object which is the value. -*) -function TJSONObject.optDouble(key: string): double; -begin - result := optDouble(key, _Double.NaN); -end; - -(* * - * Get an optional double associated with a key, or the - * defaultValue if there is no such key or if its value is not a number. - * If the value is a string, an attempt will be made to evaluate it as - * a number. - * - * @param key A key string. - * @param defaultValue The default. - * @return An object which is the value. -*) -function TJSONObject.optDouble(key: string; defaultValue: double): double; -var - o: TZAbstractObject; -begin - o := opt(key); - if (o <> nil) then - begin - if (o is _Number) then - begin - result := (_Number(o)).doubleValue(); - exit; - end; - try - result := _Double.create(_String(o)).doubleValue(); - exit; - except - on E: Exception do - begin - result := defaultValue; - exit; - end; - end; - end; - result := defaultValue; -end; - -(* * - * Get an optional int value associated with a key, - * or zero if there is no such key or if the value is not a number. - * If the value is a string, an attempt will be made to evaluate it as - * a number. - * - * @param key A key string. - * @return An object which is the value. -*) -function TJSONObject.optInt(key: string): integer; -begin - result := optInt(key, 0); -end; - -(* * - * Get an optional int value associated with a key, - * or the default if there is no such key or if the value is not a number. - * If the value is a string, an attempt will be made to evaluate it as - * a number. - * - * @param key A key string. - * @param defaultValue The default. - * @return An object which is the value. -*) -function TJSONObject.optInt(key: string; defaultValue: integer): integer; -var - o: TZAbstractObject; -begin - o := opt(key); - if (o <> NULL) then - begin - if (o is _Number) then - begin - result := (_Number(o)).intValue(); - exit; - end; - try - result := _Integer.parseInt(_String(o)); - exit; - except - on E: Exception do - begin - result := defaultValue; - exit; - end; - end; - end; - result := defaultValue; -end; - -(* * - * Get an optional TJSONArray associated with a key. - * It returns null if there is no such key, or if its value is not a - * TJSONArray. - * - * @param key A key string. - * @return A TJSONArray which is the value. -*) -function TJSONObject.optJSONArray(key: string): TJSONArray; -var - o: TZAbstractObject; -begin - o := opt(key); - if (o is TJSONArray) then - begin - result := TJSONArray(o); - end - else - begin - result := nil; - end; -end; - -(* * - * Get an optional TJSONObject associated with a key. - * It returns null if there is no such key, or if its value is not a - * TJSONObject. - * - * @param key A key string. - * @return A TJSONObject which is the value. -*) -function TJSONObject.optJSONObject(key: string): TJSONObject; -var - o: TZAbstractObject; -begin - o := opt(key); - if (o is TJSONObject) then - begin - result := TJSONObject(o); - end - else - begin - result := nil; - end; -end; - -(* * - * Get an optional string associated with a key. - * It returns an empty string if there is no such key. If the value is not - * a string and is not null, then it is coverted to a string. - * - * @param key A key string. - * @return A string which is the value. -*) -function TJSONObject.optString(key: string): string; -begin - result := optString(key, ''); -end; - -(* * - * Get an optional string associated with a key. - * It returns the defaultValue if there is no such key. - * - * @param key A key string. - * @param defaultValue The default. - * @return A string which is the value. -*) -function TJSONObject.optString(key, defaultValue: string): string; -var - o: TZAbstractObject; -begin - o := opt(key); - if (o <> nil) then - begin - result := o.toString(); - end - else - begin - result := defaultValue; - end; -end; - -(* * - * Put a key/boolean pair in the TJSONObject. - * - * @param key A key string. - * @param value A boolean which is the value. - * @return this. -*) -function TJSONObject.put(key: string; Value: Boolean): TJSONObject; -begin - put(key, _Boolean.valueOf(Value)); - result := self; -end; - -(* * - * Put a key/double pair in the TJSONObject. - * - * @param key A key string. - * @param value A double which is the value. - * @return this. -*) -function TJSONObject.put(key: string; Value: double): TJSONObject; -begin - put(key, _Double.create(Value)); - result := self; -end; - -(* * - * Put a key/int pair in the TJSONObject. - * - * @param key A key string. - * @param value An int which is the value. - * @return this. -*) -function TJSONObject.put(key: string; Value: integer): TJSONObject; -begin - put(key, _Integer.create(Value)); - result := self; -end; - -(* * - * Put a key/value pair in the TJSONObject. If the value is null, - * then the key will be removed from the TJSONObject if it is present. - * @param key A key string. - * @param value An object which is the value. It should be of one of these - * types: Boolean, Double, Integer, TJSONArray, TJSONObject, String, or the - * TJSONObject.NULL object. - * @return this. - * @raises (NullPointerException The key must be non-null.) -*) -function TJSONObject.put(key: string; Value: TZAbstractObject): TJSONObject; -var - temp: TObject; - i: integer; -begin - if (key = '') then - begin - raise NullPointerException.create('Null key.'); - end; - if (Value <> nil) then - begin - i := self.myHashMap.IndexOf(key); - if (i >= 0) then - begin - temp := self.myHashMap.Objects[i]; - self.myHashMap.Objects[i] := Value; - temp.Free; - end - else - begin - self.myHashMap.AddObject(key, Value); - end; - end - else - begin - temp := remove(key); - if (temp <> nil) then - begin - temp.Free; - end; - end; - result := self; -end; - -function TJSONObject.put(key, Value: string): TJSONObject; -begin - put(key, _String.create(Value)); - result := self; -end; - -function TJSONObject.putOpt(key: string; Value: TZAbstractObject): TJSONObject; -begin - if (Value <> nil) then - begin - put(key, Value); - end; - result := self; -end; - -(* * - * Produce a string in double quotes with backslash sequences in all the - * right places. - * @param string A String - * @return A String correctly formatted for insertion in a JSON message. -*) -class function TJSONObject.quote(s: string): string; -var - b, c: char; - i, len: integer; - sb, t: string; -const - NoConversion = ['A' .. 'Z', 'a' .. 'z', '*', '@', '.', '_', '-', '0' .. '9', - '$', '!', '''', '(', ')']; -begin - if ((s = '') or (System.length(s) = 0)) then - begin - result := '""'; - end; - - b := #0; - c := #0; - i := 0; - len := System.length(s); - // SetLength (s, len+4); - t := ''; - - sb := sb + '"'; - for i := 1 to len do - begin - b := c; - c := s[i]; - case (c) of - '\', '"': - begin - sb := sb + '\'; - sb := sb + c; - end; - '/': - begin - if (b = '<') then - begin - sb := sb + '\'; - end; - sb := sb + c; - end; - #8: - begin - sb := sb + '\b'; - end; - #9: - begin - sb := sb + '\t'; - end; - #10: - begin - sb := sb + '\n'; - end; - #12: - begin - sb := sb + '\f'; - end; - #13: - begin - sb := sb + '\r'; - end; - else - begin - if (not(c in NoConversion)) then - begin - t := '000' + _Integer.toHexString(c); - sb := sb + '\u' + copy(t, System.length(t) - 3, 4); - end - else - begin - sb := sb + c; - end; - end; - end; - end; - sb := sb + '"'; - result := sb; -end; - -(* * - * Remove a name and its value, if present. - * @param key The name to be removed. - * @return The value that was associated with the name, - * or null if there was no value. -*) -function TJSONObject.remove(key: string): TZAbstractObject; -begin - if (myHashMap.IndexOf(key) < 0) then - begin - result := nil - end - else - begin - result := TZAbstractObject(myHashMap.Objects[myHashMap.IndexOf(key)]); - self.myHashMap.Delete(myHashMap.IndexOf(key)); - end; -end; - -(* * - * Produce a TJSONArray containing the values of the members of this - * TJSONObject. - * @param names A TJSONArray containing a list of key strings. This - * determines the sequence of the values in the result. - * @return A TJSONArray of values. -*) -function TJSONObject.toJSONArray(names: TJSONArray): TJSONArray; -var - i: integer; - ja: TJSONArray; -begin - if ((names = nil) or (names.length() = 0)) then - begin - result := nil; - exit; - end; - ja := TJSONArray.create; - for i := 0 to names.length - 1 { ; i < names.length(); i += 1) } do - begin - ja.put(self.opt(names.getString(i))); - end; - result := ja; -end; - -(* * - * Make an JSON external form string of this TJSONObject. For compactness, no - * unnecessary whitespace is added. - *

- * Warning: This method assumes that the data structure is acyclical. - * - * @return a printable, displayable, portable, transmittable - * representation of the object, beginning - * with { (left brace) and ending - * with } (right brace). -*) -function TJSONObject.toString: string; -var - _keys: TStringList; - sb: string; - o: string; - i: integer; -begin - _keys := keys(); - try - sb := '{'; - - for i := 0 to _keys.Count - 1 do - begin - if (System.length(sb) > 1) then - begin - sb := sb + ','; - end; - o := _keys[i]; - sb := sb + quote(o); - sb := sb + ':'; - sb := sb + valueToString - (TZAbstractObject(myHashMap.Objects[myHashMap.IndexOf(o)])); - end; - sb := sb + '}'; - result := sb; - finally - _keys.Free; - end; -end; - -(* * - * Make a prettyprinted JSON external form string of this TJSONObject. - *

- * Warning: This method assumes that the data structure is acyclical. - * @param indentFactor The number of spaces to add to each level of - * indentation. - * @return a printable, displayable, portable, transmittable - * representation of the object, beginning - * with { (left brace) and ending - * with } (right brace). -*) -function TJSONObject.toString(indentFactor: integer): string; -begin - result := toString(indentFactor, 0); -end; - -(* * - * Make a prettyprinted JSON string of this TJSONObject. - *

- * Warning: This method assumes that the data structure is acyclical. - * @param indentFactor The number of spaces to add to each level of - * indentation. - * @param indent The indentation of the top level. - * @return a printable, displayable, transmittable - * representation of the object, beginning - * with { (left brace) and ending - * with } (right brace). -*) -function TJSONObject.toString(indentFactor, indent: integer): string; -var - j, i, n, newindent: integer; - _keys: TStringList; - o, sb: string; -begin - i := 0; - n := length(); - if (n = 0) then - begin - result := '{}'; - exit; - end; - _keys := keys(); - try - sb := sb + '{'; - newindent := indent + indentFactor; - if (n = 1) then - begin - o := _keys[0]; - sb := sb + quote(o); - sb := sb + ': '; - sb := sb + valueToString - (TZAbstractObject(myHashMap.Objects[myHashMap.IndexOf(o)]), - indentFactor, indent); - end - else - begin - for j := 0 to _keys.Count - 1 do - begin - o := _keys[j]; - if (System.length(sb) > 1) then - begin - sb := sb + ',' + #10; - end - else - begin - sb := sb + #10; - end; - for i := 0 to newindent - 1 do - begin - sb := sb + ' '; - end; - sb := sb + quote(o); - sb := sb + ': '; - sb := sb + valueToString - (TZAbstractObject(myHashMap.Objects[myHashMap.IndexOf(o)]), - indentFactor, newindent); - end; - if (System.length(sb) > 1) then - begin - sb := sb + #10; - for i := 0 to indent - 1 do - begin - sb := sb + ' '; - end; - end; - end; - sb := sb + '}'; - result := sb; - finally - _keys.Free; - end; -end; - -class function TJSONObject.NULL: NULL; -begin - result := CNULL; -end; - -class function TJSONObject.valueToString(Value: TZAbstractObject): string; -begin - if ((Value = nil) or (Value.equals(NULL))) then - begin - result := 'null'; - exit; - end; - if (Value is _Number) then - begin - result := numberToString(_Number(Value)); - exit; - end; - if ((Value is _Boolean) or (Value is TJSONObject) or (Value is TJSONArray)) - then - begin - result := Value.toString(); - exit; - end; - result := quote(Value.toString()); -end; - -(* * - * Make a prettyprinted JSON string of an object value. - *

- * Warning: This method assumes that the data structure is acyclical. - * @param value The value to be serialized. - * @param indentFactor The number of spaces to add to each level of - * indentation. - * @param indent The indentation of the top level. - * @return a printable, displayable, transmittable - * representation of the object, beginning - * with { (left brace) and ending - * with } (right brace). -*) -class function TJSONObject.valueToString(Value: TZAbstractObject; - indentFactor, indent: integer): string; -begin - if ((Value = nil) or (Value.equals(nil))) then - begin - result := 'null'; - exit; - end; - if (Value is _Number) then - begin - result := numberToString(_Number(Value)); - exit; - end; - if (Value is _Boolean) then - begin - result := Value.toString(); - exit; - end; - if (Value is TJSONObject) then - begin - result := ((TJSONObject(Value)).toString(indentFactor, indent)); - exit; - end; - if (Value is TJSONArray) then - begin - result := ((TJSONArray(Value)).toString(indentFactor, indent)); - exit; - end; - result := quote(Value.toString()); -end; - -{ _Boolean } - -function _Boolean.Clone: TZAbstractObject; -begin - result := _Boolean.create(self.fvalue); -end; - -constructor _Boolean.create(b: Boolean); -begin - fvalue := b; -end; - -var - CONST_FALSE: _Boolean; - CONST_TRUE: _Boolean; - -function _Boolean.toString: string; -begin - if fvalue then - begin - result := 'true'; - end - else - begin - result := 'false'; - end; -end; - -class function _Boolean.valueOf(b: Boolean): _Boolean; -begin - if (b) then - begin - result := _TRUE; - end - else - begin - result := _FALSE; - end; -end; - -class function _Boolean._FALSE: _Boolean; -begin - result := CONST_FALSE; -end; - -class function _Boolean._TRUE: _Boolean; -begin - result := CONST_TRUE; -end; - -{ _String } - -function _String.Clone: TZAbstractObject; -begin - result := _String.create(self.fvalue); -end; - -constructor _String.create(s: string); -begin - fvalue := s; -end; - -function _String.equals(const Value: TZAbstractObject): Boolean; -begin - result := (Value is _String) and (_String(Value).fvalue = fvalue); -end; - -function _String.equalsIgnoreCase(s: string): Boolean; -begin - result := AnsiLowerCase(s) = AnsiLowerCase(fvalue); -end; - -function _String.toString: string; -begin - result := fvalue; -end; - -{ ParseException } - -constructor ParseException.create(_message: string; index: integer); -begin - inherited createFmt(_message + #10#13' erro no caracter : %d', [index]); -end; - -{ _Integer } - -constructor _Integer.create(i: integer); -begin - fvalue := i; -end; - -function _Integer.Clone: TZAbstractObject; -begin - result := _Integer.create(self.fvalue); -end; - -constructor _Integer.create(s: string); -begin - fvalue := StrToInt(s); -end; - -function _Integer.doubleValue: double; -begin - result := fvalue; -end; - -function _Integer.intValue: integer; -begin - result := fvalue; -end; - -class function _Integer.parseInt(s: string; i: integer): integer; -begin - - case i of - 10: - begin - result := StrToInt(s); - end; - 16: - begin - result := HexToInt(s); - end; - 8: - begin - if (s = '0') then - begin - result := 0 - end - else - begin - newNotImplmentedFeature(); - end; - end; - end; -end; - -class function _Integer.parseInt(s: _String): integer; -begin - result := _Integer.parseInt(s.toString, 10); -end; - -class function _Integer.toHexString(c: char): string; -begin - result := IntToHex(ord(c), 2); -end; - -function _Integer.toString: string; -begin - result := intToStr(fvalue); -end; - -{ _Double } - -constructor _Double.create(s: string); -begin - fvalue := StrToFloat(s, getFormatSettings); -end; - -constructor _Double.create(s: _String); -begin - create(s.toString); -end; - -function _Double.Clone: TZAbstractObject; -begin - result := _Double.create(self.fvalue); -end; - -constructor _Double.create(d: double); -begin - fvalue := d; -end; - -function _Double.doubleValue: double; -begin - result := fvalue; -end; - -function _Double.intValue: integer; -begin - result := trunc(fvalue); -end; - -class function _Double.NaN: double; -begin - result := 3.6E-4951; -end; - -function _Double.toString: string; -begin - result := '"' + StringReplace(formatFloat('######0.00', fvalue), ',', '.', - [rfReplaceAll]) + '"'; -end; - -{ TJSONArray } - -(* * - * Construct a TJSONArray from a JSONTokener. - * @param x A JSONTokener - * @raises (ParseException A TJSONArray must start with '[') - * @raises (ParseException Expected a ',' or ']') -*) -constructor TJSONArray.create(x: JSONTokener); -begin - create; - if (x.nextClean() <> '[') then - begin - raise x.syntaxError('A TJSONArray must start with "["'); - end; - if (x.nextClean() = ']') then - begin - exit; - end; - x.back(); - while (true) do - begin - if (x.nextClean() = ',') then - begin - x.back(); - myArrayList.add(nil); - end - else - begin - x.back(); - myArrayList.add(x.nextValue()); - end; - case (x.nextClean()) of - ';', ',': - begin - if (x.nextClean() = ']') then - begin - exit; - end; - x.back(); - end; - ']': - begin - exit; - end - else - begin - raise x.syntaxError('Expected a "," or "]"'); - end - end; - end; -end; - -destructor TJSONObject.destroy; -begin - clean; - myHashMap.Free; - inherited; -end; - -(* * - * Construct a TJSONArray from a Collection. - * @param collection A Collection. -*) -constructor TJSONArray.create(collection: TList); -var - i: integer; -begin - myArrayList := TList.create(); - for i := 0 to collection.Count - 1 do - begin - myArrayList.add(collection[i]); - end; -end; - -(* * - * Construct an empty TJSONArray. -*) -constructor TJSONArray.create; -begin - myArrayList := TList.create; -end; - -(* * - * Construct a TJSONArray from a source string. - * @param string A string that begins with - * [ (left bracket) - * and ends with ] (right bracket). - * @raises (ParseException The string must conform to JSON syntax.) -*) -constructor TJSONArray.create(s: string); -begin - create(JSONTokener.create(s)); -end; - -destructor TJSONArray.destroy; -var - obj: TObject; -begin - while myArrayList.Count > 0 do - begin - obj := myArrayList[0]; - myArrayList[0] := nil; - if (obj <> CONST_FALSE) and (obj <> CONST_TRUE) and (obj <> CNULL) then - obj.Free; - myArrayList.Delete(0); - end; - myArrayList.Free; - inherited; -end; - -(* * - * Get the object value associated with an index. - * @param index - * The index must be between 0 and length() - 1. - * @return An object value. - * @raises (NoSuchElementException) -*) -function TJSONArray.get(index: integer): TZAbstractObject; -var - o: TZAbstractObject; -begin - o := opt(index); - if (o = nil) then - begin - raise NoSuchElementException.create('TJSONArray[' + intToStr(index) + - '] not found.'); - end; - result := o; -end; - -(* * - * Get the boolean value associated with an index. - * The string values "true" and "false" are converted to boolean. - * - * @param index The index must be between 0 and length() - 1. - * @return The truth. - * @raises (NoSuchElementException if the index is not found) - * @raises (ClassCastException) -*) -function TJSONArray.getBoolean(index: integer): Boolean; -var - o: TZAbstractObject; -begin - o := get(index); - if ((o.equals(_Boolean._FALSE) or ((o is _String) and (_String(o)) - .equalsIgnoreCase('false')))) then - begin - result := false; - exit; - end - else if ((o.equals(_Boolean._TRUE) or ((o is _String) and (_String(o)) - .equalsIgnoreCase('true')))) then - begin - result := true; - exit; - end; - raise ClassCastException.create('TJSONArray[' + intToStr(index) + - '] not a Boolean.'); -end; - -(* * - * Get the double value associated with an index. - * - * @param index The index must be between 0 and length() - 1. - * @return The value. - * @raises (NoSuchElementException if the key is not found) - * @raises (NumberFormatException - * if the value cannot be converted to a number.) -*) -function TJSONArray.getDouble(index: integer): double; -var - o: TZAbstractObject; - d: _Double; -begin - o := get(index); - if (o is _Number) then - begin - result := (_Number(o)).doubleValue(); - exit; - end; - if (o is _String) then - begin - d := _Double.create(_String(o)); - try - result := d.doubleValue(); - exit; - finally - d.Free; - end; - end; - raise NumberFormatException.create('TJSONObject[' + intToStr(index) + - '] is not a number.'); -end; - -(* * - * Get the int value associated with an index. - * - * @param index The index must be between 0 and length() - 1. - * @return The value. - * @raises (NoSuchElementException if the key is not found) - * @raises (NumberFormatException - * if the value cannot be converted to a number.) -*) -function TJSONArray.getInt(index: integer): integer; -var - o: TZAbstractObject; -begin - o := get(index); - if (o is _Number) then - begin - result := _Number(o).intValue(); - end - else - begin - result := trunc(getDouble(index)); - end; -end; - -{ - * Get the TJSONArray associated with an index. - * @param index The index must be between 0 and length() - 1. - * @return A TJSONArray value. - * @raises (NoSuchElementException if the index is not found or if the - * value is not a TJSONArray) } -function TJSONArray.getJSONArray(index: integer): TJSONArray; -var - o: TZAbstractObject; -begin - o := get(index); - if (o is TJSONArray) then - begin - result := TJSONArray(o); - exit; - end; - raise NoSuchElementException.create('TJSONArray[' + intToStr(index) + - '] is not a TJSONArray.'); -end; - -(* * - * Get the TJSONObject associated with an index. - * @param index subscript - * @return A TJSONObject value. - * @raises (NoSuchElementException if the index is not found or if the - * value is not a TJSONObject) -*) -function TJSONArray.getJSONObject(index: integer): TJSONObject; -var - o: TZAbstractObject; - s: string; -begin - o := get(index); - if (o is TJSONObject) then - begin - result := TJSONObject(o); - end - else - begin - if o <> nil then - begin - s := o.ClassName; - end - else - begin - s := 'nil'; - end; - raise NoSuchElementException.create('TJSONArray[' + intToStr(index) + - '] is not a TJSONObject is ' + s); - end; -end; - -(* * - * Get the string associated with an index. - * @param index The index must be between 0 and length() - 1. - * @return A string value. - * @raises (NoSuchElementException) -*) -function TJSONArray.getString(index: integer): string; -begin - result := get(index).toString(); -end; - -(* * - * Determine if the value is null. - * @param index The index must be between 0 and length() - 1. - * @return true if the value at the index is null, or if there is no value. -*) - -function TJSONArray.isNull(index: integer): Boolean; -var - o: TZAbstractObject; -begin - o := opt(index); - result := (o = nil) or (o.equals(nil)); -end; - -(* * - * Make a string from the contents of this TJSONArray. The separator string - * is inserted between each element. - * Warning: This method assumes that the data structure is acyclical. - * @param separator A string that will be inserted between the elements. - * @return a string. -*) -function TJSONArray.join(separator: string): string; -var - len, i: integer; - sb, s: string; -begin - len := length(); - sb := ''; - for i := 0 to len - 1 do - begin - if (i > 0) then - begin - sb := sb + separator; - end; - s := TJSONObject.valueToString(TZAbstractObject(myArrayList[i])); - sb := sb + s; - end; - result := sb; -end; - -(* * - * Get the length of the TJSONArray. - * - * @return The length (or size). -*) -function TJSONArray.length: integer; -begin - result := myArrayList.Count; -end; - -{ - Get the optional object value associated with an index. - @param index The index must be between 0 and length() - 1. - @return An object value, or null if there is no - object at that index. -} -function TJSONArray.opt(index: integer): TZAbstractObject; -begin - if ((index < 0) or (index >= length())) then - begin - result := nil; - end - else - begin - result := TZAbstractObject(myArrayList[index]); - end; -end; - -(* * - * Get the optional boolean value associated with an index. - * It returns false if there is no value at that index, - * or if the value is not Boolean.TRUE or the String "true". - * - * @param index The index must be between 0 and length() - 1. - * @return The truth. -*) -function TJSONArray.optBoolean(index: integer): Boolean; -begin - result := optBoolean(index, false); -end; - -(* * - * Get the optional boolean value associated with an index. - * It returns the defaultValue if there is no value at that index or if it is not - * a Boolean or the String "true" or "false" (case insensitive). - * - * @param index The index must be between 0 and length() - 1. - * @param defaultValue A boolean default. - * @return The truth. -*) -function TJSONArray.optBoolean(index: integer; defaultValue: Boolean): Boolean; -var - o: TZAbstractObject; -begin - o := opt(index); - if (o <> nil) then - begin - if ((o.equals(_Boolean._FALSE) or ((o is _String) and (_String(o)) - .equalsIgnoreCase('false')))) then - begin - result := false; - exit; - end - else if ((o.equals(_Boolean._TRUE) or ((o is _String) and (_String(o)) - .equalsIgnoreCase('true')))) then - begin - result := true; - exit; - end; - end; - result := defaultValue; -end; - -(* * - * Get the optional double value associated with an index. - * NaN is returned if the index is not found, - * or if the value is not a number and cannot be converted to a number. - * - * @param index The index must be between 0 and length() - 1. - * @return The value. -*) -function TJSONArray.optDouble(index: integer): double; -begin - result := optDouble(index, _Double.NaN); -end; - -(* * - * Get the optional double value associated with an index. - * The defaultValue is returned if the index is not found, - * or if the value is not a number and cannot be converted to a number. - * - * @param index subscript - * @param defaultValue The default value. - * @return The value. -*) -function TJSONArray.optDouble(index: integer; defaultValue: double): double; -var - o: TZAbstractObject; - d: _Double; -begin - o := opt(index); - if (o <> nil) then - begin - if (o is _Number) then - begin - result := (_Number(o)).doubleValue(); - exit; - end; - try - d := _Double.create(_String(o)); - result := d.doubleValue; - d.Free; - exit; - except - on E: Exception do - begin - result := defaultValue; - end; - end; - end; - result := defaultValue; -end; - -(* * - * Get the optional int value associated with an index. - * Zero is returned if the index is not found, - * or if the value is not a number and cannot be converted to a number. - * - * @param index The index must be between 0 and length() - 1. - * @return The value. -*) -function TJSONArray.optInt(index: integer): integer; -begin - result := optInt(index, 0); -end; - -(* * - * Get the optional int value associated with an index. - * The defaultValue is returned if the index is not found, - * or if the value is not a number and cannot be converted to a number. - * @param index The index must be between 0 and length() - 1. - * @param defaultValue The default value. - * @return The value. -*) -function TJSONArray.optInt(index, defaultValue: integer): integer; -var - o: TZAbstractObject; -begin - o := opt(index); - if (o <> nil) then - begin - if (o is _Number) then - begin - result := (_Number(o)).intValue(); - exit; - end; - try - result := _Integer.parseInt(_String(o)); - exit; - except - on E: Exception do - begin - result := defaultValue; - exit; - end; - end; - end; - result := defaultValue; -end; - -(* * - * Get the optional TJSONArray associated with an index. - * @param index subscript - * @return A TJSONArray value, or null if the index has no value, - * or if the value is not a TJSONArray. -*) -function TJSONArray.optJSONArray(index: integer): TJSONArray; -var - o: TZAbstractObject; -begin - o := opt(index); - if (o is TJSONArray) then - begin - result := TJSONArray(o); - end - else - begin - result := nil; - end; -end; - -(* * - * Get the optional TJSONObject associated with an index. - * Null is returned if the key is not found, or null if the index has - * no value, or if the value is not a TJSONObject. - * - * @param index The index must be between 0 and length() - 1. - * @return A TJSONObject value. -*) -function TJSONArray.optJSONObject(index: integer): TJSONObject; -var - o: TZAbstractObject; -begin - o := opt(index); - if (o is TJSONObject) then - begin - result := TJSONObject(o); - end - else - begin - result := nil; - end; -end; - -(* * - * Get the optional string value associated with an index. It returns an - * empty string if there is no value at that index. If the value - * is not a string and is not null, then it is coverted to a string. - * - * @param index The index must be between 0 and length() - 1. - * @return A String value. -*) -function TJSONArray.optString(index: integer): string; -begin - result := optString(index, ''); -end; - -(* * - * Get the optional string associated with an index. - * The defaultValue is returned if the key is not found. - * - * @param index The index must be between 0 and length() - 1. - * @param defaultValue The default value. - * @return A String value. -*) -function TJSONArray.optString(index: integer; defaultValue: string): string; -var - o: TZAbstractObject; -begin - o := opt(index); - if (o <> nil) then - begin - result := o.toString(); - end - else - begin - result := defaultValue; - end; -end; - -(* * - * Append a boolean value. - * - * @param value A boolean value. - * @return this. -*) -function TJSONArray.put(Value: Boolean): TJSONArray; -begin - put(_Boolean.valueOf(Value)); - result := self; -end; - -(* * - * Append a double value. - * - * @param value A double value. - * @return this. -*) -function TJSONArray.put(Value: double): TJSONArray; -begin - put(_Double.create(Value)); - result := self; -end; - -(* * - * Append an int value. - * - * @param value An int value. - * @return this. -*) -function TJSONArray.put(Value: integer): TJSONArray; -begin - put(_Integer.create(Value)); - result := self; -end; - -function TJSONArray.put(Value: string): TJSONArray; -begin - put(_String.create(Value)); - result := self; -end; - -(* * - * Append an object value. - * @param value An object value. The value should be a - * Boolean, Double, Integer, TJSONArray, JSObject, or String, or the - * TJSONObject.NULL object. - * @return this. -*) -function TJSONArray.put(Value: TZAbstractObject): TJSONArray; -begin - myArrayList.add(Value); - result := self; -end; - -(* * - * Put or replace a boolean value in the TJSONArray. - * @param index subscript The subscript. If the index is greater than the length of - * the TJSONArray, then null elements will be added as necessary to pad - * it out. - * @param value A boolean value. - * @return this. - * @raises (NoSuchElementException The index must not be negative.) -*) -function TJSONArray.put(index: integer; Value: Boolean): TJSONArray; -begin - put(index, _Boolean.valueOf(Value)); - result := self; -end; - -function TJSONArray.put(index, Value: integer): TJSONArray; -begin - put(index, _Integer.create(Value)); - result := self; -end; - -function TJSONArray.put(index: integer; Value: double): TJSONArray; -begin - put(index, _Double.create(Value)); - result := self; -end; - -function TJSONArray.put(index: integer; Value: string): TJSONArray; -begin - put(index, _String.create(Value)); - result := self; -end; - -(* * - * Put or replace an object value in the TJSONArray. - * @param index The subscript. If the index is greater than the length of - * the TJSONArray, then null elements will be added as necessary to pad - * it out. - * @param value An object value. - * @return this. - * @raises (NoSuchElementException The index must not be negative.) - * @raises (NullPointerException The index must not be null.) -*) -function TJSONArray.put(index: integer; Value: TZAbstractObject): TJSONArray; -begin - if (index < 0) then - begin - raise NoSuchElementException.create('TJSONArray[' + intToStr(index) + - '] not found.'); - end - else if (Value = nil) then - begin - raise NullPointerException.create(''); - end - else if (index < length()) then - begin - myArrayList[index] := Value; - end - else - begin - while (index <> length()) do - begin - put(nil); - end; - put(Value); - end; - result := self; -end; - -(* * - * Produce a TJSONObject by combining a TJSONArray of names with the values - * of this TJSONArray. - * @param names A TJSONArray containing a list of key strings. These will be - * paired with the values. - * @return A TJSONObject, or null if there are no names or if this TJSONArray - * has no values. -*) -function TJSONArray.toJSONObject(names: TJSONArray): TJSONObject; -var - jo: TJSONObject; - i: integer; -begin - if ((names = nil) or (names.length() = 0) or (length() = 0)) then - begin - result := nil; - end; - jo := TJSONObject.create(); - for i := 0 to names.length() do - begin - jo.put(names.getString(i), self.opt(i)); - end; - result := jo; -end; - -(* * - * Make an JSON external form string of this TJSONArray. For compactness, no - * unnecessary whitespace is added. - * Warning: This method assumes that the data structure is acyclical. - * - * @return a printable, displayable, transmittable - * representation of the array. -*) -function TJSONArray.toString: string; -begin - result := '[' + join(',') + ']'; -end; - -(* * - * Make a prettyprinted JSON string of this TJSONArray. - * Warning: This method assumes that the data structure is non-cyclical. - * @param indentFactor The number of spaces to add to each level of - * indentation. - * @return a printable, displayable, transmittable - * representation of the object, beginning - * with [ (left bracket) and ending - * with ] (right bracket). -*) -function TJSONArray.toString(indentFactor: integer): string; -begin - result := toString(indentFactor, 0); -end; - -(* * - * Make a TList of TJSONArray; - * @return a TList object -*) -function TJSONArray.toList: TList; -begin - result := TList.create; - result.Assign(myArrayList, laCopy); -end; - -(* * - * Make a prettyprinted string of this TJSONArray. - * Warning: This method assumes that the data structure is non-cyclical. - * @param indentFactor The number of spaces to add to each level of - * indentation. - * @param indent The indention of the top level. - * @return a printable, displayable, transmittable - * representation of the array. -*) -function TJSONArray.toString(indentFactor, indent: integer): string; -var - len, i, j, newindent: integer; - sb: string; -begin - len := length(); - if (len = 0) then - begin - result := '[]'; - exit; - end; - i := 0; - sb := '['; - if (len = 1) then - begin - sb := sb + TJSONObject.valueToString(TZAbstractObject(myArrayList[0]), - indentFactor, indent); - end - else - begin - newindent := indent + indentFactor; - sb := sb + #10; - for i := 0 to len - 1 do - begin - if (i > 0) then - begin - sb := sb + ',' + #10; - end; - for j := 0 to newindent - 1 do - begin - sb := sb + ' '; - end; - sb := sb + (TJSONObject.valueToString(TZAbstractObject(myArrayList[i]), - indentFactor, newindent)); - end; - sb := sb + #10; - for i := 0 to indent - 1 do - begin - sb := sb + ' '; - end; - end; - sb := sb + ']'; - result := sb; -end; - -{ _NULL } - -function NULL.equals(const Value: TZAbstractObject): Boolean; -begin - if (Value = nil) then - begin - result := true; - end - else - begin - result := (Value is NULL); - end; -end; - -function NULL.toString: string; -begin - result := 'null'; -end; - -{ TZAbstractObject } - -function TZAbstractObject.Clone: TZAbstractObject; -begin - newNotImplmentedFeature(); -end; - -function TZAbstractObject.equals(const Value: TZAbstractObject): Boolean; -begin - result := (Value <> nil) and (Value = self); -end; - -function TZAbstractObject.hash: LongInt; -begin - result := integer(addr(self)); -end; - -function TZAbstractObject.instanceOf(const Value: TZAbstractObject): Boolean; -begin - result := Value is TZAbstractObject; -end; - -function TZAbstractObject.toString: string; -begin - result := Format('%s <%p>', [ClassName, addr(self)]); -end; - -procedure TJSONObject.clean; -begin - while myHashMap.Count > 0 do - begin - if (myHashMap.Objects[0] <> CONST_FALSE) and - (myHashMap.Objects[0] <> CONST_TRUE) and (myHashMap.Objects[0] <> CNULL) - then - begin - myHashMap.Objects[0].Free; - end; - myHashMap.Objects[0] := nil; - myHashMap.Delete(0); - end; -end; - -(* * - * Assign the values to other json Object. - * @param TJSONObject objeto to assign Values -*) -procedure TJSONObject.assignTo(json: TJSONObject); -var - _keys: TStringList; - i: integer; -begin - _keys := keys; - try - for i := 0 to _keys.Count - 1 do - begin - json.put(_keys[i], get(_keys[i]).Clone); - end; - finally - _keys.Free; - end; -end; - -function TJSONObject.Clone: TZAbstractObject; -var - json: TJSONObject; -begin - json := TJSONObject.create(self.toString()); - result := json; -end; - -{ _Number } - -initialization - -CONST_FALSE := _Boolean.create(false); -CONST_TRUE := _Boolean.create(true); -CNULL := NULL.create; - -finalization - -CONST_FALSE.Free; -CONST_TRUE.Free; -CNULL.Free; - -end. diff --git a/Source/simba.xmlparser.pas b/Source/simba.xmlparser.pas deleted file mode 100644 index 93baf058e..000000000 --- a/Source/simba.xmlparser.pas +++ /dev/null @@ -1,761 +0,0 @@ -{ - Author: Raymond van VenetiĆ« and Merlijn Wajer - Project: Simba (https://github.com/MerlijnWajer/Simba) - License: GNU General Public License (https://www.gnu.org/licenses/gpl-3.0) -} -unit simba.xmlparser; - -{ VerySimpleXML v1.1 - a lightweight, one-unit XML reader/writer - by Dennis Spreen - http://blog.spreendigital.de/2011/11/10/verysimplexml-a-lightweight-delphi-xml-reader-and-writer/ - - (c) Copyrights 2011 Dennis D. Spreen - This unit is free and can be used for any needs. The introduction of - any changes and the use of those changed library is permitted without - limitations. Only requirement: - This text must be present without changes in all modifications of library. - - * The contents of this file are used with permission, subject to - * the Mozilla Public License Version 1.1 (the "License"); you may * - * not use this file except in compliance with the License. You may * - * obtain a copy of the License at * - * http: www.mozilla.org/MPL/MPL-1.1.html * - * * - * Software distributed under the License is distributed on an * - * "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or * - * implied. See the License for the specific language governing * - * rights and limitations under the License. * -} - -{Modified for Lazarus and Simba by Cynic - CynicRus@gmail.com} -{$ifdef FPC} -{$mode delphi} -{$endif} -interface - -uses - Classes, Generics.Collections; - -type - TXmlNodeList = class; - - TXmlAttribute = class(TObject) - public - Name: String; // Attribute name - Value: String; // Attribute value (always as String) - end; - - TXmlAttributeList = class(TObjectList) - public - function Find(AttrName: String): TXmlAttribute; - // Find an Attribute by Name (not case sensitive) - end; - - PXMLNode = ^TXMLNode; - TXmlNode = class(TObject) - private - FAttributes: TXmlAttributeList; - function GetAttribute(const AttrName: String): String; - procedure SetAttr(const AttrName: String; const Value: String); - public - Parent: TXmlNode; // NIL only for Root-Node - NodeName: String; // Node name - Text: String; // Node text - ChildNodes: TXmlNodeList; // Child nodes, never NIL - constructor Create; virtual; - destructor Destroy; override; - // Find a childnode by its name - function Find(Name: String): TXmlNode; overload; - // Find a childnode by Name/Attribute - function Find(Name, Attribute: String): TXmlNode; overload; - // Find a childnode by Name/Attribute/Value - function Find(Name, Attribute, Value: String): TXmlNode; overload; - // Return a list of childodes with given Name - function FindNodes(Name: String): TXmlNodeList; virtual; - // Returns True if the Attribute exits - function HasAttribute(const Name: String): Boolean; virtual; - // Add a child node and return it - function AddChild(const Name: String): TXmlNode; virtual; - function SetText(Value: String): TXmlNode; virtual; - function SetAttribute(const AttrName: String; - const Value: String): TXmlNode; virtual; - property Attribute[const AttrName: String]: String read GetAttribute - write SetAttr; default;// Attributes of a Node, accessible by attribute name - end; - - PXMLNodeList = ^TXmlNodeList; - TXMLNodeList = class - private - FItems: TList; - function GetCount: Integer; - function GetItem(Index: Integer): TXMLNode; - public - constructor Create; - destructor Destroy; override; - procedure Clear; - procedure Assign(Src: TXMLNodeList); - procedure Add(aXMLNode: TXMLNode); overload; - procedure Add(aXMLNodes: TXMLNodeList); overload; - function IndexOf(aXMLNode: TXMLNode): Integer; overload; - function IndexOf(NodeName: string): Integer; overload; - procedure Delete(aXMLNode: TXMLNode); overload; - procedure Delete(Index: Integer); overload; - property Count: Integer read GetCount; - property Item[Index: Integer]: TXMLNode read GetItem; default; - end; - - { TVerySimpleXml } - - PVerySimpleXml = ^TVerySimpleXml; - TVerySimpleXml = class(TObject) - private - FRoot: TXMLNode; - FHeader: TXMLNode; - FIdent: string; - Lines: TStringList; - function GetHeader: TXMLNode; - function GetIdent: string; - function GetRoot: TXMLNode; - procedure Parse; - procedure SetHeader(AValue: TXMLNode); - procedure SetIdent(AValue: string); - procedure SetRoot(AValue: TXMLNode); - function Escape(Value: String): String; - function UnEscape(Value: String): String; - procedure Walk(Lines: TStringList; Prefix: String; Node: TXmlNode); - procedure OnNodeSetText(Sender: TObject; Node: TXmlNode; Text: String); inline; - procedure OnNodeSetName(Sender: TObject; Node: TXmlNode; Name: String); inline; - public - constructor Create; virtual; - destructor Destroy; override; - procedure Clear; virtual; - // Load XML from a file - procedure LoadFromFile(const FileName: String); - // Load XML for a stream - procedure LoadFromStream(const Stream: TStream); - // Load XML from string - procedure LoadFromString(const Str: String); - // Encoding is specified in Header-Node - procedure SaveToString(var Str: String); - procedure SaveToStream(const Stream: TStream); - procedure SaveToFile(const FileName: String); - property Root: TXMLNode read GetRoot write SetRoot; - property Header: TXMLNode read GetHeader write SetHeader; - property Ident: string read GetIdent write SetIdent; - end; -const - ErrItemNotFound = 'Item not found!'; -implementation - -uses - SysUtils, StrUtils; - -constructor TXMLNodeList.Create; -begin - FItems := TList.Create; -end; - -destructor TXMLNodeList.Destroy; -begin - Clear; - if FItems <> nil then - FItems.Free; - inherited; -end; - -procedure TXMLNodeList.Add(aXMLNode: TXMLNode); -begin - FItems.Add(aXMLNode); -end; - -procedure TXMLNodeList.Add(aXMLNodes: TXMLNodeList); -var - I: Integer; -begin - for I := 0 to aXMLNodes.Count - 1 do - Add(aXMLNodes[I]); -end; - -procedure TXMLNodeList.Assign(Src: TXMLNodeList); -begin - Clear; - Add(Src); -end; - -procedure TXMLNodeList.Clear; -var - I: Integer; -begin - for I := 0 to Count - 1 do - Item[I].Free; - FItems.Clear; -end; - -procedure TXMLNodeList.Delete(Index: Integer); -begin - if (Index < 0) or (Index >= Count) then - raise Exception.Create(ErrItemNotFound); - - Item[Index].Free; - FItems.Delete(Index); -end; - -procedure TXMLNodeList.Delete(aXMLNode: TXMLNode); -begin - Delete(IndexOf(aXMLNode)); -end; - - -function TXMLNodeList.GetCount: Integer; -begin - Result := FItems.Count; -end; - -function TXMLNodeList.GetItem(Index: Integer): TXMLNode; -begin - if (Index >= 0) and (Index < Count) then - Result := TXMLNode(FItems[Index]) - else - Result := nil; -end; - -function TXMLNodeList.IndexOf(NodeName: string): Integer; -var - I: Integer; -begin - for I := 0 to Count - 1 do - if Item[I].NodeName = NodeName then - begin - Result := I; - Exit; - end; - Result := -1; -end; - - -function TXMLNodeList.IndexOf(aXMLNode: TXMLNode): Integer; -begin - Result := FItems.IndexOf(aXMLNode); -end; - -{ TVerySimpleXml } - -procedure TVerySimpleXml.Clear; -begin - Root.Free; - Header.Free; - Root := TXmlNode.Create; - Header := TXmlNode.Create; - Header.NodeName := '?xml'; // Default XML Header - Header.Attribute['version'] := '1.0'; // Default XML Version - Ident := ' '; // Set Ident:='' if you want a compact output - Lines.Clear; -end; - -constructor TVerySimpleXml.Create; -begin - inherited; - Lines := TStringList.Create; - Clear; -end; - -destructor TVerySimpleXml.Destroy; -begin - Root.Free; - Header.Free; - Lines.Free; - inherited; -end; - -procedure TVerySimpleXml.LoadFromFile(const FileName: String); -begin - Clear; - Lines.LoadFromFile(FileName); - Parse; - Lines.Clear; -end; - -procedure TVerySimpleXml.LoadFromStream(const Stream: TStream); -begin - Clear; - Stream.Position:=0; - Lines.LoadFromStream(Stream); - Parse; - Lines.Clear; -end; - -procedure TVerySimpleXml.LoadFromString(const Str: String); -var - Stream: TStringStream; -begin - Stream := TStringStream.Create(Str); - - try - LoadFromStream(Stream); - finally - Stream.Free(); - end; -end; - -procedure TVerySimpleXml.Parse; -var - Line: String; - IsTag, IsText: Boolean; - Tag, Text: String; - Parent, Node: TXmlNode; - I: Integer; - Attribute: TXmlAttribute; - ALine, Attr, AttrText: String; - P: Integer; - IsSelfClosing: Boolean; - IsQuote: Boolean; - - // Return a text ended by StopChar, respect quotation marks - function GetText(var Line: String; StartStr: String; StopChar: Char): String; - var - Chr: Char; - begin - while (Length(Line) > 0) and ((Line[1] <> StopChar) or (IsQuote)) do - begin - Chr := Line[1]; - if Chr = '"' then - IsQuote := Not IsQuote; - StartStr := StartStr + Chr; - delete(Line, 1, 1); - end; - Result := StartStr; - end; - -begin - if assigned(Root) then // Release previous nodes (if set) - Root.Free; - - IsTag := False; - IsText := False; - IsQuote := False; - Node := NIL; - - for I := 0 to Lines.Count - 1 do - begin - Line := Lines[I]; - - while (Length(Line) > 0) do - begin - if (not IsTag) and (not IsText) then - begin - while (Length(Line) > 0) and (Line[1] <> '<') do - delete(Line, 1, 1); - - if Length(Line) > 0 then - begin - IsTag := True; - delete(Line, 1, 1); // Delete openining tag - Tag := ''; - end; - end; - - if IsTag then - begin - Tag := GetText(Line, Tag, '>'); - - if (Length(Line) > 0) and (Line[1] = '>') then - begin - delete(Line, 1, 1); - IsTag := False; - - if (Length(Tag) > 0) and (Tag[1] = '/') then - Node := Node.Parent - else - begin - Parent := Node; - IsText := True; - IsQuote := False; - - Node := TXmlNode.Create; - if lowercase(copy(Tag, 1, 4)) = '?xml' then // check for xml header - begin - Header.Free; - Header := Node; - end; - - // Self-Closing Tag - if (Length(Tag) > 0) and (Tag[Length(Tag)] = '/') then - begin - IsSelfClosing := True; - delete(Tag, Length(Tag), 1); - end - else - IsSelfClosing := False; - - P := pos(' ', Tag); - if P <> 0 then // Tag name has attributes - begin - ALine := Tag; - delete(Tag, P, Length(Tag)); - delete(ALine, 1, P); - - while Length(ALine) > 0 do - begin - Attr := GetText(ALine, '', '='); // Get Attribute Name - AttrText := GetText(ALine, '', ' '); // Get Attribute Value - - if Length(AttrText) > 0 then - begin - delete(AttrText, 1, 1); // Remove blank - - if AttrText[1] = '"' then // Remove start/end quotation marks - begin - delete(AttrText, 1, 1); - if AttrText[Length(AttrText)] = '"' then - delete(AttrText, Length(AttrText), 1); - end; - end; - - if Length(ALine) > 0 then - delete(ALine, 1, 1); - - // Header node (Attr='?') does not support Attributes - if not((Node = Header) and (Attr = '?')) then - begin - Attribute := TXmlAttribute.Create; - Attribute.Name := Attr; - Attribute.Value := AttrText; - Node.FAttributes.Add(Attribute); - end; - IsQuote := False; - end; - end; - - OnNodeSetName(Self, Node, Tag); - Node.Parent := Parent; - if assigned(Parent) then - Parent.ChildNodes.Add(Node) - else if Node = Header then - begin - IsText := False; - Node := NIL; - end - else - Root := Node; - - Text := ''; - if IsSelfClosing then - Node := Node.Parent; - end; - end; - end; - - if IsText then - begin - Text := GetText(Line, Text, '<'); - if (Length(Line) > 0) and (Line[1] = '<') then - begin - IsText := False; - while (Length(Text) > 0) and (Text[1] = ' ') do - delete(Text, 1, 1); - OnNodeSetText(Self, Node, UnEscape(Text)); - end; - end; - - end; - end; -end; - -function TVerySimpleXml.GetHeader: TXMLNode; -begin - result := FHeader; -end; - -function TVerySimpleXml.GetIdent: string; -begin - Result:= FIdent; -end; - -function TVerySimpleXml.GetRoot: TXMLNode; -begin - Result := FRoot; -end; - -procedure TVerySimpleXml.SetHeader(AValue: TXMLNode); -begin - FHeader := AValue; -end; - -procedure TVerySimpleXml.SetIdent(AValue: string); -begin - FIdent := AValue; -end; - -procedure TVerySimpleXml.SetRoot(AValue: TXMLNode); -begin - FRoot := AValue; -end; - -function TVerySimpleXml.Escape(Value: String): String; -begin - Result := ReplaceStr(Value, '&', '&'); - Result := ReplaceStr(Result, '<', '<'); - Result := ReplaceStr(Result, '>', '>'); - Result := ReplaceStr(Result, chr(39), '''); - Result := ReplaceStr(Result, '"', '"'); -end; - -function TVerySimpleXml.UnEscape(Value: String): String; -begin - Result := ReplaceStr(Value, '<', '<' ); - Result := ReplaceStr(Result, '>', '>'); - Result := ReplaceStr(Result, ''', chr(39)); - Result := ReplaceStr(Result, '"', '"'); - Result := ReplaceStr(Result, '&', '&'); -end; - - -procedure TVerySimpleXml.SaveToFile(const FileName: String); -var - Stream: TFileStream; -begin - Stream := TFileStream.Create(FileName, fmCreate); - SaveToStream(Stream); - Stream.Free; -end; - -procedure TVerySimpleXml.SaveToStream(const Stream: TStream); -var - Lines: TStringList; -begin - Lines := TStringList.Create; - // Create XML introduction - Walk(Lines, '', Header); - - // Create nodes representation - Walk(Lines, '', Root); - - Lines.SaveToStream(Stream); - Lines.Free; -end; - -procedure TVerySimpleXml.SaveToString(var Str: String); -var - Stream: TStringStream; -begin - Stream := TStringStream.Create(Str); - - try - SaveToStream(Stream); - - Str := Stream.DataString; - finally - Stream.Free(); - end; -end; - -procedure TVerySimpleXml.Walk(Lines: TStringList; Prefix: String; - Node: TXmlNode); -var - // Child: TXmlNode; - Attribute: TXmlAttribute; - OriginalPrefix: String; - S: String; - IsSelfClosing: Boolean; - i: integer; -begin - S := Prefix + '<' + Node.NodeName; - for Attribute in Node.FAttributes do - S := S + ' ' + Attribute.Name + '="' + Attribute.Value + '"'; - - if Node = Header then - S := S + ' ?'; - - IsSelfClosing := (Length(Node.Text) = 0) and (Node.ChildNodes.Count = 0) and - (Node <> Header); - if IsSelfClosing then - S := S + ' /'; - - S := S + '>'; - if Length(Node.Text) > 0 then - S := S + Escape(Node.Text); - - if (Node.ChildNodes.Count = 0) and (Length(Node.Text) > 0) then - begin - S := S + ''; - Lines.Add(S); - end - else - begin - Lines.Add(S); - OriginalPrefix := Prefix; - Prefix := Prefix + Ident; - for i := 0 to Node.ChildNodes.Count - 1 do - Walk(Lines, Prefix,Node.ChildNodes[i]); - if (Node <> Header) and (not IsSelfClosing) then - Lines.Add(OriginalPrefix + ''); - end; -end; - -procedure TVerySimpleXml.OnNodeSetText(Sender: TObject; Node: TXmlNode; - Text: String); -begin - Node.Text := Text; -end; - -procedure TVerySimpleXml.OnNodeSetName(Sender: TObject; Node: TXmlNode; - Name: String); -begin - Node.NodeName := Name; -end; - -{ TXmlNode } - -function TXmlNode.AddChild(const Name: String): TXmlNode; -begin - Result := TXmlNode.Create; - Result.NodeName := Name; - Result.Parent := Self; - ChildNodes.Add(Result); -end; - -constructor TXmlNode.Create; -begin - ChildNodes := TXmlNodeList.Create; - Parent := NIL; - FAttributes := TXmlAttributeList.Create; -end; - -destructor TXmlNode.Destroy; -begin - FAttributes.Free; - ChildNodes.Free; - inherited; -end; - -function TXmlNode.Find(Name: String): TXmlNode; -var - Node: TXmlNode; - i: integer; -begin - Result := NIL; - Name := lowercase(Name); - for i := 0 to ChildNodes.Count - 1 do - begin - Node := ChildNodes[i]; - if lowercase(Node.NodeName) = Name then - begin - Result := Node; - Break; - end; - end; -end; - -function TXmlNode.Find(Name, Attribute, Value: String): TXmlNode; -var - Node: TXmlNode; - i: integer; -begin - Result := NIL; - Name := lowercase(Name); - for i := 0 to ChildNodes.Count - 1 do - begin - Node := ChildNodes[i]; - if (lowercase(Node.NodeName) = Name) and (Node.HasAttribute(Attribute)) and - (Node.Attribute[Attribute] = Value) then - begin - Result := Node; - Break; - end; - end; -end; - -function TXmlNode.Find(Name, Attribute: String): TXmlNode; -var - Node: TXmlNode; - i: integer; -begin - Result := NIL; - Name := lowercase(Name); - for i := 0 to ChildNodes.Count - 1 do - begin - Node := ChildNodes[i]; - if (lowercase(Node.NodeName) = Name) and (Node.HasAttribute(Attribute)) then - begin - Result := Node; - Break; - end; - end; -end; - -function TXmlNode.FindNodes(Name: String): TXmlNodeList; -var - Node: TXmlNode; - i: integer; -begin - Result := TXmlNodeList.Create(); - Name := lowercase(Name); - for i := 0 to ChildNodes.Count - 1 do - begin - Node := ChildNodes[i]; - if (lowercase(Node.NodeName) = Name) then - Result.Add(Node); - end; -end; - -function TXmlNode.GetAttribute(const AttrName: String): String; -var - Attribute: TXmlAttribute; -begin - Attribute := FAttributes.Find(AttrName); - if assigned(Attribute) then - Result := Attribute.Value - else - Result := ''; -end; - -function TXmlNode.HasAttribute(const Name: String): Boolean; -begin - Result := assigned(FAttributes.Find(Name)); -end; - -procedure TXmlNode.SetAttr(const AttrName, Value: String); -begin - SetAttribute(AttrName, Value); -end; - -function TXmlNode.SetAttribute(const AttrName, Value: String): TXmlNode; -var - Attribute: TXmlAttribute; -begin - Attribute := FAttributes.Find(AttrName); // Search for given name - if not assigned(Attribute) then // If attribute is not found, create one - begin - Attribute := TXmlAttribute.Create; - FAttributes.Add(Attribute); - end; - Attribute.Name := AttrName; // this allows "name-style" rewriting - Attribute.Value := Value; - Result := Self; -end; - -function TXmlNode.SetText(Value: String): TXmlNode; -begin - Text := Value; - Result := Self; -end; - -{ TXmlAttributeList } - -function TXmlAttributeList.Find(AttrName: String): TXmlAttribute; -var - Attribute: TXmlAttribute; -begin - Result := NIL; - AttrName := lowercase(AttrName); - for Attribute in Self do - if lowercase(Attribute.Name) = AttrName then - begin - Result := Attribute; - Break; - end; -end; - -end. - diff --git a/Tests/json.simba b/Tests/json.simba new file mode 100644 index 000000000..6dee0aabf --- /dev/null +++ b/Tests/json.simba @@ -0,0 +1,76 @@ +{$assertions on} + +const + TEST = '{' + LINE_SEP + + ' "ThisIsAInteger" : 1,' + LINE_SEP + + ' "ThisIsALargeInteger" : 9223372036854775807,' + LINE_SEP + + ' "ThisIsAFloat" : 1.5000000000000000E+000,' + LINE_SEP + + ' "ThisIsAString" : "HelloWorld",' + LINE_SEP + + ' "ThisIsTrue" : -1,' + LINE_SEP + + ' "ThisIsFalse" : 0,' + LINE_SEP + + ' "ThisIsAObject" : {' + LINE_SEP + + ' "ObjectKey" : "ObjectValue"' + LINE_SEP + + ' },' + LINE_SEP + + ' "ThisIsAArray" : [' + LINE_SEP + + ' 1,' + LINE_SEP + + ' "2",' + LINE_SEP + + ' 3.0000000000000000E+000,' + LINE_SEP + + ' {' + LINE_SEP + + ' "Key" : "Value"' + LINE_SEP + + ' }' + LINE_SEP + + ' ]' + LINE_SEP + + '}'; + + TEST2 = '{' + LINE_SEP + + ' "fruits_clone" : {' + LINE_SEP + + ' "apple" : "red",' + LINE_SEP + + ' "bananna" : "yellow"' + LINE_SEP + + ' },' + LINE_SEP + + ' "apple_clone" : "red"' + LINE_SEP + + '}'; + +var + Parser: TJSONParser; + Element: TJSONElement; +begin + Parser := TJSONParser.Create(''); + Parser.AddValue('ThisIsAInteger', 1); + Parser.AddValue('ThisIsALargeInteger', High(Int64)); + Parser.AddValue('ThisIsAFloat', 1.5); + Parser.AddValue('ThisIsAString', 'HelloWorld'); + Parser.AddValue('ThisIsTrue', True); + Parser.AddValue('ThisIsFalse', False); + Parser.AddObject('ThisIsAObject').AddValue('ObjectKey', 'ObjectValue'); + + Element := Parser.AddArray('ThisIsAArray'); + Element.AddValue('', 1); + Element.AddValue('', '2'); + Element.AddValue('', 3.0); + + Element := Element.AddObject('ArrayObject'); + Element.AddValue('Key', 'Value'); + + Assert(Parser.AsString() = TEST); + + Assert(Parser.FindPath('ThisIsAArray[1]', Element)); + Assert(Element.IsValue()); + Assert(Element.GetValue() = '2'); + + Assert(Parser.FindPath('ThisIsAObject.ObjectKey', Element)); + Assert(Element.IsValue()); + Assert(Element.ValueType = EJSONValueType.STR); + Assert(Element.GetValue() = 'ObjectValue'); + + Parser.Clear(); + Parser.AddObject('fruits').AddValue('apple', 'red'); + Assert(Parser.Find('fruits', Element)); + Element.AddValue('bananna', 'yellow'); + + Parser.AddElement('fruits_clone', Element.Clone()); + Parser.AddElement('apple_clone', Element.GetItem(0).Clone()); + Parser.Delete('fruits'); + + Assert(Parser.AsString = TEST2); + + Parser.Free(); +end;