当前位置:主页>仓库管理软件> 列表

谁用过uJSON 找管家婆软件

库存管理软件版1楼: 我在http://sourceforge.net/search/?words=uJson&type_of_search=soft下载了一个uJSON.pas单元,但不知道怎么使用,请诸位大侠告诉我怎么用?
谢谢!

2楼: up 如管家婆软件

3楼: 贴上来看看啊

4楼: 就是那个轻量级的数据交换格式的东西,要用Delphi进行转换.我看了一下,都不知道用哪几个类的哪几个方法进行,请各位大侠帮忙看一下,谢谢!

5楼: {
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鉶 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髕imo 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.

6楼: 接受答案了.