+
+
+
+
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 + '' + Node.NodeName + '>';
- 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 + '' + Node.NodeName + '>');
- 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;