{ 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 Autor : Jose Fabio Nascimento de Almeida Data : 7/11/2005 } unit uJSON; interface uses Windows,SysUtils, Classes, TypInfo; Type TZAbstractObject = class function Equals(const Value: TZAbstractObject): Boolean; virtual; function Hash: LongInt; function Clone: TZAbstractObject; virtual; function ToString: string; virtual; function InstanceOf(const Value: TZAbstractObject): Boolean; end; ClassCastException = class (Exception) end; NoSuchElementException = class (Exception) end; NumberFormatException = class (Exception) end; NullPointerException = class (Exception) end; NotImplmentedFeature = class (Exception) end; JSONArray = class ; _Number = class ; _String = class; _Double = class; NULL = class ; ParseException = class (Exception) constructor create (_message : string ; index : integer); end; JSONTokener = class (TZAbstractObject) 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 () : 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; JSONObject = class (TZAbstractObject) private myHashMap : TStringList; public constructor create; overload; constructor create (jo : JSONObject; sa : array of string); overload; constructor create (x : JSONTokener); overload; constructor create (map : TStringList); overload; constructor create (s : string); overload; function accumulate (key : string; value : TZAbstractObject): JSONObject; function get (key : string) : TZAbstractObject; function getBoolean (key : string): boolean; function getDouble (key : string): double; function getInt (key : string): integer; function getJSONArray (key : string) :JSONArray; function getJSONObject (key : string) : JSONObject; function getString (key : string): string; function has (key : string) : boolean; function isNull (key : string) : boolean; function keys : TStringList ; function length : integer; function names : JSONArray; class function numberToString (n: _Number): string; class function valueToString(value : TZAbstractObject) : string; overload; class function valueToString(value : TZAbstractObject; indentFactor , indent : integer) : string; overload; 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): JSONArray; overload; function optJSONObject (key : string): JSONObject; overload; function put (key : string; value : boolean): JSONObject; overload; function put (key : string; value : double): JSONObject; overload; function put (key : string; value : integer): JSONObject; overload; function put (key : string; value : string): JSONObject; overload; function put (key : string; value : TZAbstractObject): JSONObject; overload; function putOpt (key : string; value : TZAbstractObject): JSONObject; class function quote (s : string): string; function remove (key : string): TZAbstractObject; function toJSONArray (names : JSONArray) : JSONArray; 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; JSONArray = 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; function getJSONArray (index : integer) : JSONArray; function getJSONObject (index : integer) : JSONObject; 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) : JSONArray ; overload; function optJSONObject (index : integer) : JSONObject ; overload; function optString (index : integer) : string; overload; function optString (index : integer; defaultValue : string) : string; overload; function put ( value : boolean) : JSONArray; overload ; function put ( value : double ) : JSONArray; overload ; function put ( value : integer) : JSONArray; overload ; function put ( value : TZAbstractObject) : JSONArray; overload ; function put ( value: string): JSONArray; overload; function put ( index : integer ; value : boolean): JSONArray; overload ; function put ( index : integer ; value : double) : JSONArray; overload ; function put ( index : integer ; value : integer) : JSONArray; overload ; function put ( index : integer ; value : TZAbstractObject) : JSONArray; overload ; function put ( index: integer; value: string): JSONArray; overload; function toJSONObject (names :JSONArray ) : JSONObject ; 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; _Number = class (TZAbstractObject) function doubleValue : double; virtual; abstract; function intValue : integer; virtual; abstract; end; _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; 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; 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; private fvalue : integer; end; _String = class (TZAbstractObject) constructor create (s : string); function equalsIgnoreCase (s: string) : boolean; function Equals(const Value: TZAbstractObject): Boolean; override; function toString() : string; override; private fvalue : string; end; NULL = class (TZAbstractObject) function Equals(const Value: TZAbstractObject): Boolean; override; function toString() : string; override; end; var gcLista : TList; CNULL : NULL; implementation const CROTINA_NAO_IMPLEMENTADA :string = 'Rotina Não Implementada'; procedure newNotImplmentedFeature () ; begin raise NotImplmentedFeature.create (CROTINA_NAO_IMPLEMENTADA); end; function getFormatSettings : TFormatSettings ; var f : TFormatSettings; begin {$IFDEF MSWINDOWS} SysUtils.GetLocaleFormatSettings (Windows.GetThreadLocale,f); {$ELSE} newNotImplmentedFeature(); {$ENDIF} result := f; result.DecimalSeparator := '.'; result.ThousandSeparator := ','; 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 } (** * Construct a JSONTokener from a string. * * @param s A source string. *) constructor JSONTokener.create(s: string); begin self.myIndex := 1; self.mySource := s; end; (** * 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 JSONTokener.back; begin if (self.myIndex > 1) then begin self.myIndex := self.myIndex - 1; end; end; (** * 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 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. * @exception 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. * @exception 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': // é o backspace = #8 sb.append('\b'); break;} 't': sb := sb + #9; 'n': sb := sb + #10; 'f': sb := sb + #12; 'r': sb := sb + #13; {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, * JSONArray, JSONObject, or String, or the JSONObject.NULL object. * @exception 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 := JSONObject.create(self); exit; end; '[': begin back(); result := JSONArray.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 := JSONObject.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; { JSONObject } (** * Construct an empty JSONObject. *) constructor JSONObject.create; begin myHashMap := TStringList.create; end; (** * Construct a JSONObject from a subset of another JSONObject. * An array of strings is used to identify the keys that should be copied. * Missing keys are ignored. * @param jo A JSONObject. * @param sa An array of strings. *) constructor JSONObject.create(jo: JSONObject; sa: array of string); var i : integer; begin create(); for i :=0 to high(sa)-1 do begin putOpt(sa[i], jo.opt(sa[i])); end; end; (** * Construct a JSONObject from a JSONTokener. * @param x A JSONTokener object containing the source string. * @throws ParseException if there is a syntax error in the source string. *) constructor JSONObject.create(x: JSONTokener); var c : char; key : string; begin create ; c := #0; key := ''; if (x.nextClean() <> '{') then begin raise x.syntaxError('A JSONObject must begin with "{"'); end; while (true) do begin c := x.nextClean(); case (c) of #0: raise x.syntaxError('A JSONObject must end with "}"'); '}': begin exit; end else begin x.back(); key := x.nextValue().toString(); 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; (** * Construct a JSONObject from a Map. * @param map A map object that can be used to initialize the contents of * the JSONObject. *) constructor JSONObject.create(map: TStringList); begin self.myHashMap := TStringlist.create; self.myHashMap.Text := map.Text; end; (** * Construct a JSONObject from a string. * This is the most commonly used JSONObject constructor. * @param string A string beginning * with { (left brace) and ending * with } (right brace). * @exception ParseException The string must be properly formatted. *) constructor JSONObject.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 * JSONArray is stored under the key to hold all of the accumulated values. * If there is already a JSONArray, 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 JSONObject.accumulate(key: string; value: TZAbstractObject): JSONObject; var a : JSONArray; o : TZAbstractObject; begin a := nil; o := opt(key); if (o = nil) then begin put(key, value); end else if (o is JSONArray) then begin a := JSONArray(o); a.put(value); end else begin a := JSONArray.create; a.put(o); 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. * @exception NoSuchElementException if the key is not found. *) function JSONObject.get(key: string): TZAbstractObject; var o : TZAbstractObject; begin o := opt(key); if (o = nil) then begin raise NoSuchElementException.create('JSONObject[' + quote(key) + '] not found.'); end; result := o; end; (** * Get the boolean value associated with a key. * * @param key A key string. * @return The truth. * @exception NoSuchElementException if the key is not found. * @exception ClassCastException * if the value is not a Boolean or the String "true" or "false". *) function JSONObject.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('JSONObject[' + quote(key) + '] is not a Boolean.'); end; function JSONObject.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('JSONObject[' + quote(key) + '] is not a number.'); end; (** * Get the int value associated with a key. * * @param key A key string. * @return The integer value. * @exception NoSuchElementException if the key is not found * @exception NumberFormatException * if the value cannot be converted to a number. *) function JSONObject.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 JSONArray value associated with a key. * * @param key A key string. * @return A JSONArray which is the value. * @exception NoSuchElementException if the key is not found or * if the value is not a JSONArray. *) function JSONObject.getJSONArray(key: string): JSONArray; var o : TZAbstractObject; begin o := get(key); if (o is JSONArray) then begin result := JSONArray(o); end else begin raise NoSuchElementException.create('JSONObject[' + quote(key) + '] is not a JSONArray.'); end; end; (** * Get the JSONObject value associated with a key. * * @param key A key string. * @return A JSONObject which is the value. * @exception NoSuchElementException if the key is not found or * if the value is not a JSONObject. *) function JSONObject.getJSONObject(key: string): JSONObject; var o : TZAbstractObject; begin o := get(key); if (o is JSONObject) then begin result := JSONObject(o); end else begin raise NoSuchElementException.create('JSONObject[' + quote(key) + '] is not a JSONObject.'); end; end; (** * Get the string associated with a key. * * @param key A key string. * @return A string which is the value. * @exception NoSuchElementException if the key is not found. *) function JSONObject.getString(key: string): string; begin result := get(key).toString(); end; (** * Determine if the JSONObject contains a specific key. * @param key A key string. * @return true if the key exists in the JSONObject. *) function JSONObject.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 JSONObject.NULL object. *) function JSONObject.isNull(key: string): boolean; begin result := NULL.equals(opt(key)); end; function JSONObject.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 JSONObject.length: integer; begin result := myHashMap.Count; end; (** * Produce a JSONArray containing the names of the elements of this * JSONObject. * @return A JSONArray containing the key strings, or null if the JSONObject * is empty. *) function JSONObject.names: JSONArray; var ja :JSONArray; i : integer; k : TStringList; begin ja := JSONArray.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 JSONObject.numberToString(n: _Number): string; begin if (n = nil) then begin result := ''; end else if (n is _Integer) then begin result := IntToStr(n.intValue) end else begin result := FloatToStr (n.doubleValue, getFormatSettings()); end; end; (** * 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. * @exception NullPointerException The key must not be null. *) function JSONObject.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 JSONObject.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 JSONObject.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 JSONObject.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 JSONObject.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 JSONObject.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 JSONObject.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)); except on e:Exception do begin result := defaultValue; exit; end; end; end; result := defaultValue; end; (** * Get an optional JSONArray associated with a key. * It returns null if there is no such key, or if its value is not a * JSONArray. * * @param key A key string. * @return A JSONArray which is the value. *) function JSONObject.optJSONArray(key: string): JSONArray; var o : TZAbstractObject ; begin o := opt(key); if (o is JSONArray) then begin result := JSONArray(o); end else begin result := nil; end; end; (** * Get an optional JSONObject associated with a key. * It returns null if there is no such key, or if its value is not a * JSONObject. * * @param key A key string. * @return A JSONObject which is the value. *) function JSONObject.optJSONObject(key: string): JSONObject; var o : TZAbstractObject ; begin o := opt(key); if (o is JSONObject) then begin result := JSONObject(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 JSONObject.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 JSONObject.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 JSONObject. * * @param key A key string. * @param value A boolean which is the value. * @return this. *) function JSONObject.put(key: string; value: boolean): JSONObject; begin put(key, _Boolean.valueOf(value)); result := self; end; (** * Put a key/double pair in the JSONObject. * * @param key A key string. * @param value A double which is the value. * @return this. *) function JSONObject.put(key: string; value: double): JSONObject; begin put(key, _Double.create(value)); result := self; end; (** * Put a key/int pair in the JSONObject. * * @param key A key string. * @param value An int which is the value. * @return this. *) function JSONObject.put(key: string; value: integer): JSONObject; begin put(key, _Integer.create(value)); result := self; end; (** * Put a key/value pair in the JSONObject. If the value is null, * then the key will be removed from the JSONObject 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, JSONArray, JSONObject, String, or the * JSONObject.NULL object. * @return this. * @exception NullPointerException The key must be non-null. *) function JSONObject.put(key: string; value: TZAbstractObject): JSONObject; 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 remove(key); end; result := self; end; function JSONObject.put(key, value: string): JSONObject; begin put(key, _String.create(value)); result := self; end; (** * Put a key/value pair in the JSONObject, 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, JSONArray, JSONObject, String, or the * JSONObject.NULL object. * @return this. * @exception NullPointerException The key must be non-null. *) function JSONObject.putOpt(key: string; value: TZAbstractObject): JSONObject; 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 JSONObject.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 := '""'; 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, #9, #10, #12, #13: begin sb := sb + c; end; else begin if (c < ' ') 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 JSONObject.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 JSONArray containing the values of the members of this * JSONObject. * @param names A JSONArray containing a list of key strings. This * determines the sequence of the values in the result. * @return A JSONArray of values. *) function JSONObject.toJSONArray(names: JSONArray): JSONArray; var i : integer; ja : JSONArray ; begin if ((names = nil) or (names.length() = 0)) then begin result := nil; exit; end; ja := JSONArray.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 JSONObject. 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 JSONObject.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 JSONObject. *

* 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 JSONObject.toString(indentFactor: integer): string; begin result := toString(indentFactor, 0); end; (** * Make a prettyprinted JSON string of this JSONObject. *

* 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 JSONObject.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(); 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; end; class function JSONObject.NULL: NULL; begin result := CNULL; end; (** * Make JSON string of an object value. *

* Warning: This method assumes that the data structure is acyclical. * @param value The value to be serialized. * @return a printable, displayable, transmittable * representation of the object, beginning * with { (left brace) and ending * with } (right brace). *) class function JSONObject.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 JSONObject) or (value is JSONArray)) 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 JSONObject.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 JSONObject) then begin result := ((JSONObject(value)).toString(indentFactor, indent)); exit; end; if (value is JSONArray) then begin result := ((JSONArray(value)).toString(indentFactor, indent)); exit; end; result := quote(value.toString()); end; { _Boolean } 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 } 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; 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 newNotImplmentedFeature () ; 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; 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 := floatToStr (fvalue, getFormatSettings); end; { JSONArray } (** * Construct a JSONArray from a JSONTokener. * @param x A JSONTokener * @exception ParseException A JSONArray must start with '[' * @exception ParseException Expected a ',' or ']' *) constructor JSONArray.create(x: JSONTokener); begin create; if (x.nextClean() <> '[') then begin raise x.syntaxError('A JSONArray 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 JSONObject.destroy; var i :integer; 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; myHashMap.Free; inherited; end; (** * Construct a JSONArray from a Collection. * @param collection A Collection. *) constructor JSONArray.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 JSONArray. *) constructor JSONArray.create; begin myArrayList := TList.create; end; (** * Construct a JSONArray from a source string. * @param string A string that begins with * [ (left bracket) * and ends with ] (right bracket). * @exception ParseException The string must conform to JSON syntax. *) constructor JSONArray.create(s: string); begin create (JSONTokener.create(s)); end; destructor JSONArray.destroy; var i : integer; 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 begin obj.Free; end; 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. * @exception NoSuchElementException *) function JSONArray.get(index: integer): TZAbstractObject; var o : TZAbstractObject; begin o := opt(index); if (o = nil) then begin raise NoSuchElementException.create('JSONArray[' + 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. * @exception NoSuchElementException if the index is not found * @exception ClassCastException *) function JSONArray.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('JSONArray[' + 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. * @exception NoSuchElementException if the key is not found * @exception NumberFormatException * if the value cannot be converted to a number. *) function JSONArray.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('JSONObject[' + 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. * @exception NoSuchElementException if the key is not found * @exception NumberFormatException * if the value cannot be converted to a number. *) function JSONArray.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 JSONArray associated with an index. * @param index The index must be between 0 and length() - 1. * @return A JSONArray value. * @exception NoSuchElementException if the index is not found or if the * value is not a JSONArray *) function JSONArray.getJSONArray(index: integer): JSONArray; var o : TZAbstractObject; begin o := get(index); if (o is JSONArray) then begin result := JSONArray(o); exit; end; raise NoSuchElementException.create('JSONArray[' + intToStr(index) + '] is not a JSONArray.'); end; (** * Get the JSONObject associated with an index. * @param index subscript * @return A JSONObject value. * @exception NoSuchElementException if the index is not found or if the * value is not a JSONObject *) function JSONArray.getJSONObject(index: integer): JSONObject; var o : TZAbstractObject; begin o := get(index); if (o is JSONObject) then begin result := JSONObject(o); exit; end; raise NoSuchElementException.create('JSONArray[' + intToStr(index) + '] is not a JSONObject.'); end; (** * Get the string associated with an index. * @param index The index must be between 0 and length() - 1. * @return A string value. * @exception NoSuchElementException *) function JSONArray.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 JSONArray.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 JSONArray. 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 JSONArray.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 begin sb := sb + separator; end; sb:= sb + JSONObject.valueToString(TZAbstractObject( myArrayList[i])); end; result := sb; end; (** * Get the length of the JSONArray. * * @return The length (or size). *) function JSONArray.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 JSONArray.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 JSONArray.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 JSONArray.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 JSONArray.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 JSONArray.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 JSONArray.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 JSONArray.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(); end; try result := _Integer.parseInt(_String(o)); exit; except on e: exception do begin result := defaultValue; end; end; end; result := defaultValue; end; (** * Get the optional JSONArray associated with an index. * @param index subscript * @return A JSONArray value, or null if the index has no value, * or if the value is not a JSONArray. *) function JSONArray.optJSONArray(index: integer): JSONArray; var o : TZAbstractObject; begin o := opt(index); if (o is JSONArray) then begin result := JSONArray (o) ; end else begin result := nil; end; end; (** * Get the optional JSONObject 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 JSONObject. * * @param index The index must be between 0 and length() - 1. * @return A JSONObject value. *) function JSONArray.optJSONObject(index: integer): JSONObject; var o : TZAbstractObject; begin o := opt(index); if (o is JSONObject) then begin result := JSONObject (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 JSONArray.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 JSONArray.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 JSONArray.put(value: boolean): JSONArray; begin put(_Boolean.valueOf(value)); result := self; end; (** * Append a double value. * * @param value A double value. * @return this. *) function JSONArray.put(value: double): JSONArray; begin put(_Double.create(value)); result := self; end; (** * Append an int value. * * @param value An int value. * @return this. *) function JSONArray.put(value: integer): JSONArray; begin put(_Integer.create(value)); result := self; end; function JSONArray.put(value: string): JSONArray; 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, JSONArray, JSObject, or String, or the * JSONObject.NULL object. * @return this. *) function JSONArray.put(value: TZAbstractObject): JSONArray; begin myArrayList.add(value); result := self; end; (** * Put or replace a boolean value in the JSONArray. * @param index subscript The subscript. If the index is greater than the length of * the JSONArray, then null elements will be added as necessary to pad * it out. * @param value A boolean value. * @return this. * @exception NoSuchElementException The index must not be negative. *) function JSONArray.put(index: integer; value: boolean): JSONArray; begin put(index, _Boolean.valueOf(value)); result := self; end; function JSONArray.put(index, value: integer): JSONArray; begin put(index, _Integer.create(value)); result := self; end; function JSONArray.put(index: integer; value: double): JSONArray; begin put(index, _Double.create(value)); result := self; end; function JSONArray.put(index: integer; value: string): JSONArray; begin put (index,_String.create (value)); result := self; end; (** * Put or replace an object value in the JSONArray. * @param index The subscript. If the index is greater than the length of * the JSONArray, then null elements will be added as necessary to pad * it out. * @param value An object value. * @return this. * @exception NoSuchElementException The index must not be negative. * @exception NullPointerException The index must not be null. *) function JSONArray.put(index: integer; value: TZAbstractObject): JSONArray; begin if (index < 0) then begin raise NoSuchElementException.create('JSONArray[' + 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 JSONObject by combining a JSONArray of names with the values * of this JSONArray. * @param names A JSONArray containing a list of key strings. These will be * paired with the values. * @return A JSONObject, or null if there are no names or if this JSONArray * has no values. *) function JSONArray.toJSONObject(names :JSONArray): JSONObject; var jo : JSONObject ; i : integer; begin if ((names = nil) or (names.length() = 0) or (length() = 0)) then begin result := nil; end; jo := JSONObject.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 JSONArray. 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 JSONArray.toString: string; begin result := '[' + join(',') + ']'; end; (** * Make a prettyprinted JSON string of this JSONArray. * 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 JSONArray.toString(indentFactor: integer): string; begin result := toString(indentFactor, 0); end; (** * Make a prettyprinted string of this JSONArray. * 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 JSONArray.toList: TList; begin result := TList.create ; result.Assign(myArrayList,laCopy); end; function JSONArray.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 + JSONObject .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 + (JSONObject .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; initialization CONST_FALSE := _Boolean.create (false); CONST_TRUE := _Boolean.create (true); CNULL := NULL.create; finalization CONST_FALSE.free; CONST_TRUE.Free; CNULL.free; end.