|
|
//
//-------------------------------------------------------------------------
//
// QuickBurro Middleware Application Development Package for Lazarus
//
// Version 4.28
// Update Date: 2013.8.5.
// QQ: 779545524
// QQ groups: 79114999,33286656,116166458,84945607,18594635
// Email: Jopher@189.cn or wpy020327@163.com
// Homepage: http://www.quickburro.com/
//
//-------------------------------------------------------------------------
//
unit lazjson;
interface
Uses
Windows,
SysUtils,
Classes;
Type
TLazJsonAbstractObject = class
function equals(const Value: TLazJsonAbstractObject): Boolean; virtual;
function hash: LongInt;
function Clone: TLazJsonAbstractObject; virtual;
function toString: string; virtual;
function instanceOf(const Value: TLazJsonAbstractObject): Boolean;
end;
ClassCastException = class (Exception);
NoSuchElementException = class (Exception);
NumberFormatException = class (Exception);
NullPointerException = class (Exception);
NotImplmentedFeature = class (Exception);
TLazJsonArray = class;
_Number = class;
_String = class;
_Double = class;
_NULL = class;
ParseException = class (Exception)
constructor create (_message : string ; index : integer);
end;
TLazJsonTokener = class (TLazJsonAbstractObject)
public
constructor create (s: string) ;
procedure back();
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 () : TLazJsonAbstractObject ;
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;
TLazJson = class (TLazJsonAbstractObject)
private
myHashMap : TStringList;
function GetPropValues(const Key: string): string;
procedure SetPropValues(const Key: string; const Value: string);
procedure SetAsString(const Value: string);
function GetKeyByIndex(index: Integer): string;
procedure SetCascadeValueEx(const Value: string; const Keys: array of string;
StartIdx: Integer);
function GetValByIndex(index: Integer): string;
procedure UpdateByTokener(x: TLazJsonTokener);
public
constructor Create; overload;
constructor Create (jo : TLazJson; sa : array of string); overload;
constructor Create (x : TLazJsonTokener); overload;
constructor Create (map : TStringList); overload;
constructor Create (s : string); overload;
constructor Create (aStream: TStream; Bytes: integer); overLoad;
constructor Create (aFilename: string; FailIfNoFile: boolean); overload;
procedure Clean;
function Clone : TLazJsonAbstractObject; override;
function Accumulate (key : string; value : TLazJsonAbstractObject): TLazJson;
function Get (key : string) : TLazJsonAbstractObject;
function GetBoolean (key : string): boolean;
function GetDouble (key : string): double;
function GetInt (key : string): integer;
function GetJSonArray (key : string) : TLazJsonArray;
function GetJSon (key : string) : TLazJson;
function GetString (key : string): string;
function Has (key : string) : boolean;
function IsNull (key : string) : boolean;
function Keys : TStringList ;
function Length : integer;
function Names : TLazJsonArray;
class function NumberToString (n: _Number): string;
class function ValueToString(value : TLazJsonAbstractObject) : string; overload;
class function ValueToString(value : TLazJsonAbstractObject; indentFactor, indent : integer) : string; overload;
function Opt (key : string) : TLazJsonAbstractObject;
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): TLazJsonArray; overload;
function OptJSon (key : string): TLazJson; overload;
procedure Put(key: string; value: boolean); overload;
procedure Put(key: string; value: double); overload;
procedure Put(key: string; value: integer); overload;
procedure Put(key: string; value: string); overload;
procedure Put(key: string; value: TLazJsonAbstractObject); overload;
procedure PutOpt (key : string; value : TLazJsonAbstractObject);
class function quote (s : string): string;
function Remove (key : string): TLazJsonAbstractObject;
procedure AssignTo(JSon: TLazJson);
function ToJSonArray (namelist : TLazJsonArray) : TLazJsonArray;
function ToString (): string ; overload; override;
function ToString2 (indentFactor : integer): string; overload;
function ToString3 (indentFactor, indent : integer): string; overload;
property PropValues[const Key: string]: string read GetPropValues write SetPropValues; default;
property KeyByIndex[index: Integer]: string read GetKeyByIndex;
property ValByIndex[index: Integer]: string read GetValByIndex;
property AsString: string read ToString write SetAsString;
procedure Assign(Source: TLazJson);
function GetCascadeValue(const KeyList: array of string): string;
procedure SetCascadeValue(const Value: string; const KeyList: array of string);
function GetDiffFrom(Source: TLazJson): TLazJson;
procedure RemoveByKeyHeader(const Header: string='~');
procedure CleanKey(const Key: string);
function PropCount:Integer;
function KeyByVal(const Value: string): string;
destructor Destroy;override;
class function JNULL : _NULL;
function SaveToStream(aStream: TStream; OutFormat: integer): boolean;
function SaveToFile(aFilename: string; OutFormat: integer): boolean;
end;
TLazJsonArray = class (TLazJsonAbstractObject)
public
destructor destroy ; override;
constructor create ; overload;
constructor create (collection : TList); overload;
constructor create (x : TLazJsonTokener); overload;
constructor create (s : string); overload;
constructor Create (aStream: TStream; Bytes: integer); overLoad;
constructor Create (aFilename: string; FailIfNoFile: boolean); overload;
function Clone : TLazJsonAbstractObject; override;
function get (index : integer) : TLazJsonAbstractObject;
function getBoolean (index : integer) : boolean;
function getDouble (index : integer) : double;
function getInt (index : integer): integer;
function getJSonArray (index : integer) : TLazJsonArray;
function getJSon (index : integer) : TLazJson;
function getString (index : integer) : string;
function isNull (index : integer): boolean;
function join (separator : string) : string;
function length : integer;
function opt (index : integer) : TLazJsonAbstractObject;
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) : TLazJsonArray ; overload;
function optJSon (index : integer) : TLazJson ; overload;
function optString (index : integer) : string; overload;
function optString (index : integer; defaultValue : string) : string; overload;
procedure put ( value : boolean); overload ;
procedure put ( value : double ); overload ;
procedure put ( value : integer); overload ;
procedure put ( value : TLazJsonAbstractObject); overload ;
procedure put ( value: string); overload;
procedure put ( index : integer ; value : boolean); overload ;
procedure put ( index : integer ; value : double); overload ;
procedure put ( index : integer ; value : integer); overload ;
procedure put ( index : integer ; value : TLazJsonAbstractObject); overload ;
procedure put ( index: integer; value: string); overload;
function toJSon (names : TLazJsonArray ) : TLazJson ; overload ;
function toString : string; overload; override;
function toString2 (indentFactor : integer) : string; overload;
function toString3 (indentFactor, indent : integer) : string; overload;
function appendJSonArray( value : TLazJsonArray): Integer ;
function SaveToSteam(aStream: TStream; OutFormat: integer): boolean;
function SaveToFile(aFilename: string; OutFormat: integer): boolean;
private
myArrayList : TList;
end;
_Number = class (TLazJsonAbstractObject)
function doubleValue : double; virtual; abstract;
function intValue : integer; virtual; abstract;
end;
_Boolean = class (TLazJsonAbstractObject)
class function _TRUE () : _Boolean;
class function _FALSE () : _Boolean;
class function valueOf (b : boolean) : _Boolean;
constructor create (b : boolean);
function boolValue : Boolean;
function toString () : string; override;
function clone :TLazJsonAbstractObject; override;
private
fvalue : boolean;
end;
_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 :TLazJsonAbstractObject; override;
private
fvalue : double;
end;
_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 :TLazJsonAbstractObject; override;
private
fvalue : integer;
end;
_String = class (TLazJsonAbstractObject)
constructor create (s : string);
function equalsIgnoreCase (s: string) : boolean;
function Equals(const Value: TLazJsonAbstractObject): Boolean; override;
function toString() : string; override;
function clone :TLazJsonAbstractObject; override;
private
fvalue : string;
end;
_NULL = class (TLazJsonAbstractObject)
function Equals(const Value: TLazJsonAbstractObject): Boolean; override;
function toString() : string; override;
end;
var
gcLista : TList;
CNULL : _NULL;
implementation
const
CROTINA_NAO_IMPLEMENTADA: string = 'Not imp';
var
CONST_FALSE : _Boolean ;
CONST_TRUE : _Boolean;
function IsSimpString(const Str: string):Boolean;
var
i:Integer;
begin
Result:=true;
for i:=1 to Length(Str) do
begin
Result:=Str in ['0'..'9','a'..'z','A'..'Z','_'];
if not Result then
exit;
end;
end;
procedure newNotImplmentedFeature () ;
begin
raise NotImplmentedFeature.create(string(CROTINA_NAO_IMPLEMENTADA));
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;
constructor TLazJsonTokener.create(s: string);
begin
self.myIndex := 1;
self.mySource := s;
end;
procedure TLazJsonTokener.back;
begin
if (self.myIndex > 1) then
self.myIndex := self.myIndex - 1;
end;
class function TLazJsonTokener.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;
function TLazJsonTokener.more: boolean;
begin
Result := (self.myIndex <= System.length(self.mySource)+1);
end;
function TLazJsonTokener.next: char;
begin
if more() then
begin
Result := self.mySource[self.myIndex];
self.myIndex := self.myIndex + 1;
exit;
end;
Result := chr(0);
end;
function TLazJsonTokener.next(c: char): char;
begin
Result := next();
if Result <> c then
raise syntaxError(string('Expected ') + c + string(' and instead saw ') + Result + string('.'));
end;
function TLazJsonTokener.next(n: integer): string;
var
i,j : integer;
begin
i := self.myIndex;
j := i + n;
if (j > System.length(self.mySource)) then
raise syntaxError('Substring bounds error');
self.myIndex := self.myIndex + n;
Result := copy (self.mySource,i,n);
end;
function TLazJsonTokener.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
raise syntaxError('Unclosed comment.');
if (c = '*') then
begin
if (next() = '/') then
break;
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
begin
if ((c = #0) or (c > ' ')) then
begin
Result := c;
exit;
end;
end;
end;
end;
function TLazJsonTokener.nextString (quote : char): string;
var
c : char;
sb : string;
begin
sb := '';
while (true) do
begin
c := next();
case (c) of
#0, #10, #13: continue;
'\': begin
c := next();
case (c) of
't': sb := sb + #9;
'n': sb := sb + #10;
'f': sb := sb + #12;
'r': sb := sb + #13;
else
sb := sb + c
end;
end;
else
begin
if (c = quote) then
begin
Result := sb;
exit;
end;
sb := sb + c
end;
end;
end;
end;
function TLazJsonTokener.nextTo(d: char): string;
var
sb : string;
c : char;
begin
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
back();
Result := trim (sb);
exit;
end;
sb := sb + c;
end;
end;
function TLazJsonTokener.nextTo(delimiters: string): char;
var
c : char;
sb : string;
begin
Result:=#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
back();
sb := trim(sb);
if (System.length(sb) > 0) then
Result := sb[1];
exit;
end;
sb := sb + c;
end;
end;
function TLazJsonTokener.nextValue: TLazJsonAbstractObject;
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 := TLazJson.create(self);
exit;
end;
'[': begin
back();
Result := TLazJsonArray.create(self);
exit;
end;
end;
sb := '';
b := c;
while ((ord(c) >= ord(' ')) and (pos (c,string(',:]}/\\\"[{;=#')) = 0)) do
begin
sb := sb + c;
c := next();
end;
back();
s := trim (sb);
if (s = '') then
raise syntaxError('Missing value.');
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 := TLazJson.JNULL;
exit;
end;
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
end;
end;
end
else
begin
try
Result := _Integer.create(_Integer.parseInt(s, 8));
exit;
Except
on e:Exception do
begin
end;
end;
end;
end;
if Pos(string('.'),s)<0 then
try
Result := _Integer.create(s);
exit;
Except
on e:Exception do
begin
end;
end;
try
Result := _Double.create(s);
exit;
Except
on e:Exception do
begin
end;
end;
end;
Result := _String.create(s);
end;
function TLazJsonTokener.skipTo(_to: char): char;
var
c : char;
index : integer;
begin
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;
end;
procedure TLazJsonTokener.skipPast(_to: string);
begin
self.myIndex := pos(_to, copy(mySource, self.myIndex, System.length(mySource)));
if (self.myIndex < 0) then
self.myIndex := System.length(self.mySource)+1
else
self.myIndex := self.myIndex + System.length(_to);
end;
function TLazJsonTokener.syntaxError(_message: string): ParseException;
begin
Result := ParseException.create (_message + toString()+' syntax error : ' + copy (toString(),self.myIndex,10), self.myIndex);
end;
function TLazJsonTokener.toString: string;
begin
Result := ' at character ' + string(intToStr(self.myIndex)) + ' of ' + self.mySource;
end;
function TLazJsonTokener.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;
if (c = '+') then
c := ' '
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 := char(d * 16 + e);
i := i + 2;
end;
end;
b := b + c;
i := i + 1;
end;
Result := b ;
end;
constructor TLazJson.create;
begin
myHashMap := TStringList.create;
end;
constructor TLazJson.create(jo: TLazJson; sa: array of string);
var
i : integer;
begin
create();
for i :=low(sa) to high(sa) do
putOpt(sa, jo.opt(sa).Clone);
end;
constructor TLazJson.create(x: TLazJsonTokener);
begin
create;
UpdateByTokener(x);
end;
constructor TLazJson.create(map: TStringList);
var
i : integer;
begin
self.myHashMap := TStringlist.create;
for i := 0 to map.Count -1 do
self.myHashMap.AddObject(map,map.Objects);
end;
constructor TLazJson.create(s: string);
var
Tokener : TLazJsonTokener;
begin
if s='' then
begin
create();
exit;
end;
Tokener := TLazJsonTokener.create(s);
try
create(Tokener);
finally
FreeAndNil(Tokener);
end;
end;
constructor TLazJson.Create(aStream: TStream; Bytes: integer);
var
str: string;
begin
setlength(str,bytes);
aStream.ReadBuffer(str[1],bytes);
create(str);
end;
constructor TLazJson.Create(aFilename:string; FailIfNoFile: boolean);
var
Stream: TMemoryStream;
begin
if not fileexists(aFileName) then
begin
if FailIfNoFile then
raise Exception.create('File not found!')
else
Create;
end
else
begin
Stream:=TMemoryStream.Create;
try
try
Stream.LoadFromFile(aFileName);
Stream.Position:=0;
Create(Stream,Stream.Size);
except
raise Exception.create('Read from file error!');
end;
finally
FreeAndNil(Stream);
end;
end;
end;
function TLazJson.accumulate(key: string; value: TLazJsonAbstractObject): TLazJson;
var
a : TLazJsonArray;
o : TLazJsonAbstractObject;
begin
o := opt(key);
if (o = nil) then
put(key, value)
else
if (o is TLazJsonArray) then
begin
a := TLazJsonArray(o);
a.put(value);
end
else
begin
a := TLazJsonArray.create;
a.put(o.clone);
a.put(value);
put(key, a);
end;
Result := self;
end;
function TLazJson.get(key: string): TLazJsonAbstractObject;
var
o : TLazJsonAbstractObject;
begin
o := opt(key);
if (o = nil) then
raise NoSuchElementException.create('TLazJson[' + string(quote(key)) + '] not found.');
Result := o;
end;
function TLazJson.getBoolean(key: string): boolean;
var
o : TLazJsonAbstractObject;
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('TLazJson[' + string(quote(key)) + '] is not a Boolean.');
end;
function TLazJson.getDouble(key: string): double;
var
o : TLazJsonAbstractObject;
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(_String(o).toString()));
exit;
end;
raise NumberFormatException.create('TLazJson[' + string(quote(key)) + '] is not a number.');
end;
function TLazJson.getInt(key: string): integer;
var
o : TLazJsonAbstractObject;
begin
o := get(key);
if (o is _Number) then
Result := _Number(o).intValue()
else
Result := Round(getDouble(key));
end;
function TLazJson.getJSonArray(key: string): TLazJsonArray;
var
o : TLazJsonAbstractObject;
begin
o := get(key);
if (o is TLazJsonArray) then
Result := TLazJsonArray(o)
else
raise NoSuchElementException.create('TLazJson[' + string(quote(key)) + '] is not a TLazJsonArray.');
end;
function TLazJson.getJSon(key: string): TLazJson;
var
o : TLazJsonAbstractObject;
begin
o := get(key);
if (o is TLazJson) then
Result := TLazJson(o)
else
raise NoSuchElementException.create('TLazJson[' + string(quote(key)) + '] is not a TLazJson.');
end;
function TLazJson.getString(key: string): string;
begin
Result := get(key).toString();
end;
function TLazJson.has(key: string): boolean;
begin
Result := (self.myHashMap.IndexOf(string(key)) >= 0);
end;
function TLazJson.isNull(key: string): boolean;
begin
Result := JNULL.equals(opt(key));
end;
function TLazJson.keys: TStringList;
var
i : integer;
begin
Result := TStringList.Create;
for i := 0 to myHashMap.Count -1 do begin
Result.add (myHashMap);
end;
end;
function TLazJson.Length: integer;
begin
Result := myHashMap.Count;
end;
function TLazJson.names: TLazJsonArray;
var
ja : TLazJsonArray;
i : integer;
k : TStringList;
begin
ja := TLazJsonArray.create;
k := keys;
try
for i := 0 to k.Count -1 do
ja.put(_String.create(string(k)));
if (ja.length = 0) then
Result := nil
else
Result := ja;
finally
FreeAndNil(k);
end;
end;
class function TLazJson.numberToString(n: _Number): string;
begin
if (n = nil) then
Result := ''
else
begin
if (n is _Integer) then
Result := string(IntToStr(n.intValue))
else
Result := string(FloatToStr(n.doubleValue));
end;
end;
function TLazJson.opt(key: string): TLazJsonAbstractObject;
begin
if (key = '') then
raise NullPointerException.create('Null key')
else
begin
if myHashMap.IndexOf(string(key)) < 0 then
Result := nil
else
Result := TLazJsonAbstractObject(myHashMap.Objects[myHashMap.IndexOf(string(key))]);
end;
end;
function TLazJson.optBoolean(key: string): boolean;
begin
Result := optBoolean(key, false);
end;
function TLazJson.optBoolean(key: string; defaultValue: boolean): boolean;
var
o : TLazJsonAbstractObject;
begin
o := opt(key);
if (o <> nil) then
begin
if o.ClassType=_Boolean then
begin
Result:=_Boolean(o).fvalue;
exit;
end
else
if ((o is _String) and (_String(o).equalsIgnoreCase('false'))) then
begin
Result := false;
exit;
end
else
if ((o is _String) and (_String(o).equalsIgnoreCase('true'))) then
begin
Result := true;
exit;
end;
end;
Result := defaultValue;
end;
function TLazJson.optDouble(key: string): double;
begin
Result := optDouble(key, _Double.NaN);
end;
function TLazJson.optDouble(key: string; defaultValue: double): double;
var
o: TLazJsonAbstractObject;
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;
function TLazJson.optInt(key: string): integer;
begin
Result := optInt (key, 0);
end;
function TLazJson.optInt(key: string; defaultValue: integer): integer;
var
o : TLazJsonAbstractObject;
begin
o := opt(key);
if (o <> jnull) and ( o <> nil ) then
begin
if (o is _Number) then
begin
Result := (_Number(o)).intValue();
exit;
end;
try
Result := _Integer.parseInt(_String(o));
except
on e:Exception do
Result := defaultValue;
end;
end
else
Result := defaultValue;
end;
function TLazJson.optJSonArray(key: string): TLazJsonArray;
var
o : TLazJsonAbstractObject ;
begin
o := opt(key);
if (o is TLazJsonArray) then
Result := TLazJsonArray(o)
else
Result := nil;
end;
function TLazJson.optJSon(key: string): TLazJson;
var
o : TLazJsonAbstractObject ;
begin
o := opt(key);
if (o is TLazJson) then
Result := TLazJson(o)
else
Result := nil;
end;
function TLazJson.optString(key: string): string;
begin
Result := optString(key, '');
end;
function TLazJson.optString(key, defaultValue: string): string;
var
o : TLazJsonAbstractObject ;
begin
o := opt(key);
if (o <> nil) then
Result := o.toString()
else
Result := defaultValue;
end;
procedure TLazJson.put(key: string; value: boolean);
begin
put(key, _Boolean.valueOf(value));
end;
procedure TLazJson.put(key: string; value: double);
begin
put(key, _Double.create(value));
end;
procedure TLazJson.put(key: string; value: integer);
begin
put(key, _Integer.create(value));
end;
procedure TLazJson.put(key: string; value: TLazJsonAbstractObject);
var
temp : TObject;
i : integer;
begin
if (key = '') then
raise NullPointerException.create('Null key.');
if (value <> nil) then
begin
i := self.myHashMap.IndexOf(string(key));
if ( i >= 0) then
begin
temp := self.myHashMap.Objects ;
self.myHashMap.Objects := value;
FreeAndNil(temp);
end
else
self.myHashMap.AddObject(string(key), value);
end
else
begin
temp := remove(key);
if (temp <> nil) then
FreeAndNil(temp);
end;
end;
procedure TLazJson.put(key, value: string);
begin
put(key, _String.create(value));
end;
procedure TLazJson.putOpt(key: string; value: TLazJsonAbstractObject);
begin
if (value <> nil) then
put(key, value);
end;
class function TLazJson.quote(s: string): string;
var
b,c : char;
i, len : integer;
sb, t : string;
begin
if ((s = '') or (System.Length(s) = 0)) then
begin
Result := '""';
exit;
end;
c := #0;
len := System.length(s);
t := '';
sb := sb +'"';
for i := 1 to len do
begin
b := c;
c := s;
case (c) of
'\', '"':
begin
sb := sb + '\';
sb := sb + c;
end;
'/':
begin
if (b = '<') then
sb := sb + '\';
sb := sb + c;
end;
#8, #9, #10, #12, #13:
sb := sb + c;
else
begin
if (c < ' ') then
begin
t := string('000') + _Integer.toHexString(c);
sb := sb + '\u' + copy (t,System.length(t)-3,4);
end
else
sb := sb + c;
end;
end;
end;
sb := sb + '"';
Result := sb;
end;
function TLazJson.remove(key: string): TLazJsonAbstractObject;
var
i:Integer;
begin
i:=myHashMap.IndexOf(string(key));
if ( i < 0) then
Result:=nil
else
begin
Result:=TLazJsonAbstractObject(myHashMap.Objects );
self.myHashMap.delete(i);
end;
end;
function TLazJson.toJSonArray(namelist: TLazJsonArray): TLazJsonArray;
var
i : integer;
ja : TLazJsonArray ;
begin
if ((namelist = nil) or (names.length() = 0)) then
begin
Result := nil;
exit;
end;
ja := TLazJsonArray.create;
for i := 0 to namelist.length -1 do
ja.put(self.opt(namelist.getString(i)));
Result := ja;
end;
function TLazJson.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 := string(_keys);
if IsSimpString(o) then
sb := sb + o
else
sb := sb + quote(o);
sb := sb + ':';
sb:= sb + valueToString(TLazJsonAbstractObject(myHashMap.Objects[myHashMap.IndexOf(string(o))]));
end;
sb := sb + '}';
Result := sb;
finally
FreeAndNil(_keys);
end;
end;
function TLazJson.toString2(indentFactor: integer): string;
begin
Result := toString3(indentFactor, 0);
end;
function TLazJson.toString3(indentFactor, indent: integer): string;
var
j , i , n , newindent: integer;
_keys : TStringList;
o, sb : string;
begin
n := length();
if (n = 0) then
begin
Result := '';
exit;
end;
_keys := keys();
sb := sb + '{';
newindent := indent + indentFactor;
if (n = 1) then
begin
o := string(_keys[0]);
sb:= sb + quote(o);
sb:= sb + ': ';
sb:= sb + valueToString(TLazJsonAbstractObject(myHashMap.Objects[myHashMap.IndexOf(string(o))]), indentFactor, indent);
end
else
begin
for j := 0 to _keys.count -1 do
begin
o := string(_keys[j]);
if (system.length(sb) > 1) then
sb := sb + ','+ #13#10
else
sb:= sb + #13#10;
for i := 0 to newindent -1 do
sb:= sb + ' ';
sb:= sb + quote(o);
sb:= sb + ': ';
sb:= sb + valueToString(TLazJsonAbstractObject(myHashMap
.Objects[myHashMap.IndexOf(string(o))])
, indentFactor, newindent);
end;
if (System.length(sb) > 1) then
begin
sb := sb + #13#10;
for i := 0 to indent -1 do
begin
sb:= sb + ' ';
end;
end;
end;
FreeAndNil(_keys);
sb:= sb + '}';
Result := sb;
end;
class function TLazJson.JNULL: _NULL;
begin
Result := CNULL;
end;
class function TLazJson.valueToString(value: TLazJsonAbstractObject): string;
begin
if ((value = nil) or (value.equals(jnull))) 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 TLazJson) or (value is TLazJsonArray)) then
begin
Result := value.toString();
exit;
end;
Result := quote(value.toString());
end;
class function TLazJson.valueToString(value: TLazJsonAbstractObject; 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 TLazJson) then
begin
Result := ((TLazJson(value)).toString3(indentFactor, indent));
exit;
end;
if (value is TLazJsonArray) then
begin
Result := ((TLazJsonArray(value)).toString3(indentFactor, indent));
exit;
end;
Result := quote(value.toString());
end;
procedure TLazJson.clean;
var
sl : TStringList;
i : integer;
obj : TObject;
begin
sl := keys;
for i := 0 to sl.count -1 do
begin
obj := remove(string(sl));
if (obj <> nil) then
FreeAndNil (obj);
end;
FreeAndNil(sl);
end;
procedure TLazJson.assignTo (JSon: TLazJson) ;
var
_keys : TStringList;
i : integer;
begin
_keys := keys;
try
for i := 0 to _keys.Count -1 do
begin
JSon.put (string(_keys),get(string(_keys)).clone);
end;
finally
FreeAndNil(_keys);
end;
end;
function TLazJson.clone: TLazJsonAbstractObject;
begin
Result := TLazJson.create(self.toString());
end;
function TLazJson.GetPropValues(const Key: string): string;
begin
Result:=OptString(Key);
end;
procedure TLazJson.SetPropValues(const Key: string; const Value: string);
begin
Put(Key, Value);
end;
function TLazJson.GetCascadeValue(const KeyList: array of string): string;
var
i:Integer;
TmpProp:TLazJson;
begin
Result:='';
TmpProp:=Self;
for i:=Low(KeyList) to High(KeyList) do
begin
if i=High(KeyList) then
begin
Result:=TmpProp.PropValues[KeyList];
exit;
end;
TmpProp:=TmpProp.OptJSon(KeyList);
if TmpProp=nil then
exit;
end;
end;
procedure TLazJson.SetAsString(const Value: string);
var
Tokener: TLazJsonTokener;
i : integer;
MyObj: TObject;
begin
for i:=Pred(myHashMap.Count) downto 0 do
begin
MyObj:=myHashMap.Objects;
if (MyObj <> CONST_FALSE) and (MyObj <> CONST_TRUE) and (MyObj <> CNULL) then
FreeAndNil(MyObj);
end;
myHashMap.Clear;
if System.Length(Value)<=2 then
exit;
Tokener:=TLazJsonTokener.create(Value);
try
UpdateByTokener(Tokener);
finally
FreeAndNil(Tokener);
end;
end;
function TLazJson.GetDiffFrom(Source: TLazJson): TLazJson;
var
i:Integer;
begin
Result:=TLazJson.Create;
with Source.Keys do
begin
for i:=0 to Pred(Count) do
begin
if Source.PropValues[string(Strings)]=PropValues[string(Strings)] then
continue;
Result.PropValues[string(Strings)]:=Source.PropValues[string(Strings)];
end;
Free;
end;
end;
procedure TLazJson.RemoveByKeyHeader(const Header: string);
var
i:Integer;
begin
with Keys do
begin
for i:=Pred(Count) downto 0 do
begin
if Pos(Header,string(Strings))=1 then
CleanKey(string(Strings));
end;
Free;
end;
end;
function TLazJson.PropCount: Integer;
begin
Result:=myHashMap.Count;
end;
function TLazJson.KeyByVal(const Value: string): string;
var
i:Integer;
begin
for i:=0 to Pred(myHashMap.Count) do
begin
with TLazJsonAbstractObject(myHashMap.Objects) do
begin
if toString=Value then
begin
Result:=string(myHashMap);
exit;
end;
end;
end;
Result:='';
end;
procedure TLazJson.Assign(Source: TLazJson);
begin
if Source=nil then
Clean
else
AsString:=Source.AsString;
end;
function TLazJson.GetKeyByIndex(index: Integer): string;
begin
Result:=string(myHashMap[index]);
end;
procedure TLazJson.SetCascadeValue(const Value: string; const KeyList: array of string);
begin
SetCascadeValueEx(Value,KeyList,0);
end;
procedure TLazJson.SetCascadeValueEx(const Value: string; const Keys: array of string; StartIdx: Integer);
var
JObj:TLazJson;
begin
if High(Keys)<StartIdx then
exit;
if High(Keys)=StartIdx then
begin
Self.Put(Keys[StartIdx],Value);
exit;
end;
JObj:=OptJSon(Keys[StartIdx]);
if JObj=nil then
begin
JObj:=TLazJson.Create;
Self.Put(Keys[StartIdx],JObj);
end;
JObj.SetCascadeValueEx(Value,Keys,StartIdx+1);
end;
function TLazJson.GetValByIndex(index: Integer): string;
begin
Result:=TLazJsonAbstractObject(myHashMap.Objects[index]).toString;
end;
procedure TLazJson.CleanKey(const Key: string);
var
i:Integer;
begin
i:=myHashMap.IndexOf(string(key));
if i<0 then
exit;
TLazJsonAbstractObject(myHashMap.Objects).Free;
myHashMap.delete(i);
end;
procedure TLazJson.UpdateByTokener(x: TLazJsonTokener);
var
c : char;
key : string;
begin
key := '';
if (x.nextClean() <> '{') then
raise x.syntaxError('A TLazJson must begin with "{"');
while (true) do
begin
c := x.nextClean();
case (c) of
#0:
raise x.syntaxError('A TLazJson must end with "}"');
'}':
exit;
else
begin
x.back();
with x.nextValue() do
begin
key := toString();
Free;
end;
end
end;
c := x.nextClean();
if (c = '=') then
begin
if (x.next() <> '>') then
x.back();
end
else
begin
if (c <> ':') then
raise x.syntaxError('Expected a ":" after a key');
end;
self.myHashMap.AddObject(string(key), x.nextValue());
case (x.nextClean()) of
';', ',':
begin
if (x.nextClean() = '}') then
exit;
x.back();
end;
'}':
exit;
else
raise x.syntaxError('Expected a "," or "}"');
end;
end;
end;
function TLazJson.SaveToStream(aStream: TStream; OutFormat: integer): boolean;
var
Str: string;
begin
if OutFormat=1 then
Str:=Self.ToString
else
begin
if OutFormat=2 then
Str:=Self.ToString2(3)
else
Str:=Self.ToString3(3,3);
end;
aStream.WriteBuffer(Str[1],System.Length(Str));
result:=true;
end;
function TLazJson.SaveToFile(aFilename: String; OutFormat: integer): boolean;
var
Stream: TMemoryStream;
begin
Stream:=TMemoryStream.Create;
try
Self.SaveToStream(Stream,OutFormat);
Stream.Position:=0;
Stream.SaveToFile(string(aFileName));
result:=true;
finally
FreeAndNil(Stream);
end;
end;
function _Boolean.boolValue: Boolean;
begin
Result := fvalue;
end;
function _Boolean.clone: TLazJsonAbstractObject;
begin
Result := _Boolean.create(Self.fvalue);
end;
constructor _Boolean.create(b: boolean);
begin
fvalue := b;
end;
function _Boolean.toString: string;
begin
if fvalue then
Result := 'true'
else
Result := 'false';
end;
class function _Boolean.valueOf(b: boolean): _Boolean;
begin
if (b) then
Result := _TRUE
else
Result := _FALSE;
end;
class function _Boolean._FALSE: _Boolean;
begin
Result := CONST_FALSE;
end;
class function _Boolean._TRUE: _Boolean;
begin
Result := CONST_TRUE;
end;
function _String.clone: TLazJsonAbstractObject;
begin
Result := _String.create (self.fvalue);
end;
constructor _String.create(s: string);
begin
fvalue := s;
end;
function _String.equals(const Value: TLazJsonAbstractObject): 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;
constructor ParseException.create(_message: string; index: integer);
begin
inherited createFmt(string(_message)+#13#10' error no caracter : %d',[index]);
end;
constructor _Integer.create(i: integer);
begin
fvalue := i;
end;
function _Integer.clone: TLazJsonAbstractObject;
begin
Result := _Integer.create (self.fvalue);
end;
constructor _Integer.create(s: string);
begin
fvalue := strToInt(string(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
Result:=0;
case i of
10: Result := strToInt(string(s));
16: Result := hexToInt(string(s));
8: begin
if s='0' then
exit;
newNotImplmentedFeature () ;
end;
else
newNotImplmentedFeature () ;
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 := string(IntToHex(ord(c),2));
end;
function _Integer.toString: string;
begin
Result := string(intToStr (fvalue));
end;
constructor _Double.create(s: string);
begin
fvalue := StrToFloat(string(s));
end;
constructor _Double.create(s: _String);
begin
create (s.toString);
end;
function _Double.clone: TLazJsonAbstractObject;
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 := string(floatToStr(fvalue));
end;
constructor TLazJsonArray.create(x: TLazJsonTokener);
begin
create;
if (x.nextClean() <> '[') then
raise x.syntaxError('A TLazJsonArray must start with "["');
if (x.nextClean() = ']') then
exit;
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
exit;
x.back();
end;
']':
exit;
else
raise x.syntaxError('Expected a "," or "]"');
end;
end;
end;
destructor TLazJson.destroy;
var
i :integer;
MyObj:TObject;
begin
for i:=Pred(myHashMap.Count) downto 0 do
begin
MyObj:=myHashMap.Objects;
if (MyObj <> CONST_FALSE) and (MyObj <> CONST_TRUE) and (MyObj <> CNULL) then
FreeAndNil(MyObj);
end;
FreeAndNil(myHashMap);
inherited;
end;
constructor TLazJsonArray.create(collection: TList);
var
i : integer;
begin
myArrayList := TList.create ();
for i := 0 to collection.count -1 do
myArrayList.add (collection);
end;
constructor TLazJsonArray.create;
begin
myArrayList := TList.create;
end;
constructor TLazJsonArray.create(s: string);
var
token: TLazJsonTokener;
begin
token:=TLazJsonTokener.create(s);
try
create(token);
finally
FreeAndNil(token);
end;
end;
constructor TLazJsonArray.Create(aStream: TStream; Bytes: integer);
var
str: string;
begin
setlength(str,bytes);
aStream.ReadBuffer(str[1],bytes);
create(str);
end;
constructor TLazJsonArray.Create (aFilename: String; FailIfNoFile: boolean);
var
Stream: TMemoryStream;
begin
if not fileexists(aFileName) then
begin
if FailIfNoFile then
raise Exception.create('File not found!')
else
Create;
end
else
begin
Stream:=TMemoryStream.Create;
try
try
Stream.LoadFromFile(aFileName);
Stream.Position:=0;
Create(Stream,Stream.Size);
except
raise Exception.create('Read from file error!');
end;
finally
FreeAndNil(Stream);
end;
end;
end;
destructor TLazJsonArray.destroy;
var
i : integer;
obj : TObject;
begin
for i:=Pred(myArrayList.Count) downto 0 do
begin
obj:=TObject(myArrayList);
if (obj <> CONST_FALSE) and (obj <> CONST_TRUE) and (obj <> CNULL) then
FreeAndNil(obj);
end;
FreeAndNil(myArrayList);
inherited;
end;
function TLazJsonArray.Clone: TLazJsonAbstractObject;
begin
Result:=TLazJsonArray.create(Self.toString);
end;
function TLazJsonArray.appendJSonArray(value: TLazJsonArray): Integer;
var
i:Integer;
begin
if value=nil then
begin
Result:=0;
exit;
end;
Result:=value.length;
for i:=0 to Pred(Result) do
put(value.get(i).Clone);
end;
function TLazJsonArray.get(index: integer): TLazJsonAbstractObject;
var
o : TLazJsonAbstractObject;
begin
o := opt(index);
if (o = nil) then
raise NoSuchElementException.create('TLazJsonArray[' + intToStr(index) + '] not found.');
Result := o;
end;
function TLazJsonArray.getBoolean(index: integer): boolean;
var
o : TLazJsonAbstractObject;
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('TLazJsonArray[' + intToStr(index) + '] not a Boolean.');
end;
function TLazJsonArray.getDouble(index: integer): double;
var
o : TLazJsonAbstractObject;
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
FreeAndNil(d);
end;
end;
raise NumberFormatException.create('TLazJson[' + intToStr(index) + '] is not a number.');
end;
function TLazJsonArray.getInt(index: integer): integer;
var
o : TLazJsonAbstractObject;
begin
o := get(index);
if (o is _Number) then
Result := _Number(o).intValue()
else
Result := trunc (getDouble (index));
end;
function TLazJsonArray.getJSonArray(index: integer): TLazJsonArray;
var
o: TLazJsonAbstractObject;
begin
o := get(index);
if (o is TLazJsonArray) then
begin
Result := TLazJsonArray(o);
exit;
end;
raise NoSuchElementException.create('TLazJsonArray[' + intToStr(index) + '] is not a TLazJsonArray.');
end;
function TLazJsonArray.getJSon(index: integer): TLazJson;
var
o : TLazJsonAbstractObject;
s : string;
begin
o := get(index);
if (o is TLazJson) then
Result := TLazJson(o)
else
begin
if o <> nil then
s := string(o.ClassName)
else
s := 'nil';
raise NoSuchElementException.create('TLazJsonArray[' + intToStr(index) + '] is not a TLazJson is ' + string(s));
end;
end;
function TLazJsonArray.getString(index: integer): string;
begin
Result := get(index).toString();
end;
function TLazJsonArray.isNull(index: integer): boolean;
var
o : TLazJsonAbstractObject;
begin
o := opt(index);
Result := (o = nil) or (o.equals(nil));
end;
function TLazJsonArray.join(separator: string): string;
var
len, i : integer;
sb : string ;
begin
len := length();
sb := '';
for i := 0 to len -1 do
begin
if (i > 0) then
sb := sb + separator;
sb:= sb + TLazJson.valueToString(TLazJsonAbstractObject(myArrayList));
end;
Result := sb;
end;
function TLazJsonArray.length: integer;
begin
Result := myArrayList.Count ;
end;
function TLazJsonArray.opt(index: integer): TLazJsonAbstractObject;
begin
if ((index < 0) or (index >= length()) ) then
Result := nil
else
Result := TLazJsonAbstractObject (myArrayList[index]);
end;
function TLazJsonArray.optBoolean(index: integer): boolean;
begin
Result := optBoolean(index, false);
end;
function TLazJsonArray.optBoolean(index: integer; defaultValue: boolean): boolean;
var
o : TLazJsonAbstractObject;
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;
function TLazJsonArray.optDouble(index: integer): double;
begin
Result := optDouble(index, _Double.NaN);
end;
function TLazJsonArray.optDouble(index: integer; defaultValue :double): double;
var
o : TLazJsonAbstractObject;
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 ;
FreeAndNil(d);
exit;
except
on e:Exception do
begin
Result := defaultValue;
exit;
end;
end;
end;
Result := defaultValue;
end;
function TLazJsonArray.optInt(index: integer): integer;
begin
Result := optInt(index, 0);
end;
function TLazJsonArray.optInt(index, defaultValue: integer): integer;
var
o : TLazJsonAbstractObject;
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;
function TLazJsonArray.optJSonArray(index: integer): TLazJsonArray;
var
o: TLazJsonAbstractObject;
begin
o := opt(index);
if (o is TLazJsonArray) then
Result := TLazJsonArray (o)
else
Result := nil;
end;
function TLazJsonArray.optJSon(index: integer): TLazJson;
var
o: TLazJsonAbstractObject;
begin
o:= opt(index);
if (o is TLazJson) then
Result := TLazJson (o)
else
Result := nil;
end;
function TLazJsonArray.optString(index: integer): string;
begin
Result := optString(index, '');
end;
function TLazJsonArray.optString(index: integer; defaultValue: string): string;
var
o : TLazJsonAbstractObject;
begin
o := opt(index);
if (o <> nil) then begin
Result := o.toString();
end else begin
Result := defaultValue;
end;
end;
procedure TLazJsonArray.put(value: boolean);
begin
put(_Boolean.valueOf(value));
end;
procedure TLazJsonArray.put(value: double);
begin
put(_Double.create(value));
end;
procedure TLazJsonArray.put(value: integer);
begin
put(_Integer.create(value));
end;
procedure TLazJsonArray.put(value: string);
begin
put(_String.create (value));
end;
procedure TLazJsonArray.put(value: TLazJsonAbstractObject);
begin
myArrayList.add(value);
end;
procedure TLazJsonArray.put(index: integer; value: boolean);
begin
put(index, _Boolean.valueOf(value));
end;
procedure TLazJsonArray.put(index, value: integer);
begin
put(index, _Integer.create(value));
end;
procedure TLazJsonArray.put(index: integer; value: double);
begin
put(index, _Double.create(value));
end;
procedure TLazJsonArray.put(index: integer; value: string);
begin
put (index,_String.create (value));
end;
procedure TLazJsonArray.put(index: integer; value: TLazJsonAbstractObject);
begin
if (index < 0) then
raise NoSuchElementException.create('TLazJsonArray[' + intToStr(index) + '] not found.')
else
begin
if (value = nil) then
raise NullPointerException.create('')
else
if (index < length()) then
myArrayList[index] := value
else
begin
while (index <> length()) do
put(nil);
put(value);
end;
end;
end;
function TLazJsonArray.toJSon(names :TLazJsonArray): TLazJson;
var
jo : TLazJson ;
i : integer;
begin
if ((names = nil) or (names.length() = 0) or (length() = 0)) then
begin
Result := nil;
exit;
end;
jo:= TLazJson.create();
for i := 0 to names.length() do
jo.put(names.getString(i), self.opt(i));
Result := jo;
end;
function TLazJsonArray.toString: string;
begin
Result := '['+join(',')+']';
end;
function TLazJsonArray.toString2(indentFactor: integer): string;
begin
Result := toString3(indentFactor, 0);
end;
function TLazJsonArray.toString3(indentFactor, indent: integer): string;
var
len, i, j, newindent : integer;
sb : string;
begin
len := length();
if (len = 0) then
begin
Result := '[]';
exit;
end;
sb:= '[';
if (len = 1) then
sb := sb + TLazJson.valueToString(TLazJsonAbstractObject( myArrayList[0]),indentFactor, indent)
else
begin
newindent := indent + indentFactor;
sb := sb + #13#10 ;
for i := 0 to len -1 do
begin
if (i > 0) then
sb := sb +',' + #13#10;
for j := 0 to newindent-1 do
sb := sb + ' ';
sb := sb + (TLazJson.valueToString(TLazJsonAbstractObject(myArrayList), indentFactor, newindent));
end;
sb := sb + #13#10;
for i := 0 to indent-1 do
sb := sb + ' ';
end;
sb:= sb + ']';
Result := sb;
end;
function TLazJsonArray.SaveToSteam(aStream: TStream; OutFormat: integer): boolean;
var
Str: string;
begin
if OutFormat=1 then
Str:=Self.ToString
else
begin
if OutFormat=2 then
Str:=Self.ToString2(3)
else
Str:=Self.ToString3(3,3);
end;
aStream.WriteBuffer(Str[1],System.Length(Str)*sizeof(char));
result:=true;
end;
function TLazJsonArray.SaveToFile(aFilename: string; OutFormat: integer): boolean;
var
Stream: TMemoryStream;
begin
Stream:=TMemoryStream.Create;
try
Self.SaveToSteam(Stream,OutFormat);
Stream.Position:=0;
Stream.SaveToFile(string(aFileName));
result:=true;
finally
FreeAndNil(Stream);
end;
end;
function _NULL.Equals(const Value: TLazJsonAbstractObject): Boolean;
begin
if (value = nil) then
Result := true
else
Result := (value is _NULL) ;
end;
function _NULL.toString: string;
begin
Result := 'null';
end;
function TLazJsonAbstractObject.Clone: TLazJsonAbstractObject;
begin
Result:=nil;
newNotImplmentedFeature();
end;
function TLazJsonAbstractObject.Equals(const Value: TLazJsonAbstractObject): Boolean;
begin
Result := ((value <> nil) and (value = self));
end;
function TLazJsonAbstractObject.Hash: LongInt;
begin
Result := integer(addr(self));
end;
function TLazJsonAbstractObject.InstanceOf(const Value: TLazJsonAbstractObject): Boolean;
begin
Result := (value is TLazJsonAbstractObject);
end;
function TLazJsonAbstractObject.ToString: string;
begin
Result := string(Format('%s <%p>', [ClassName, addr(Self)]));
end;
initialization
CONST_FALSE := _Boolean.create (false);
CONST_TRUE := _Boolean.create (true);
CNULL := _NULL.create;
finalization
FreeAndNil(CONST_FALSE);
FreeAndNil(CONST_TRUE);
FreeAndNil(CNULL);
end.
|
|
|手机版|小黑屋|Lazarus中国|Lazarus中文社区
( 鄂ICP备16006501号-1 )
发表于 2013-8-6 10:39:08
楼主