jsondoc.pas
功能:bson序列、还原
开源地址:
https://github.com/stijnsanders/TMongoWire
编程接口:
IJSONDocument = interface(IUnknown) [‘{4A534F4E-0001-0001-C000-000000000001}‘] function Get_Item(const Key: WideString): Variant; stdcall; procedure Set_Item(const Key: WideString; const Value: Variant); stdcall; procedure Parse(const JSONData: WideString); stdcall; function ToString: WideString; stdcall; function ToVarArray: Variant; stdcall; procedure Clear; stdcall; procedure Delete(const Key: WideString); stdcall; property Item[const Key: WideString]: Variant read Get_Item write Set_Item; default; property AsString: WideString read ToString write Parse; end;
{ jsonDoc.pas Copyright 2015-2019 Stijn Sanders Made available under terms described in file "LICENSE" https://github.com/stijnsanders/jsonDoc v1.2.0 } unit jsonDoc; {$WARN SYMBOL_PLATFORM OFF} {$D-} {$L-} { Options: Define here or in the project settings JSONDOC_JSON_STRICT to disallow missing quotes around key names JSONDOC_JSON_LOOSE to allow missing colons and comma‘s JSONDOC_JSON_PASCAL_STRINGS to allow pascal-style strings JSONDOC_P2 to combine JSONDOC_JSON_LOOSE and JSONDOC_JSON_PASCAL_STRINGS JSONDOC_STOREINDENTING to make ToString write indentation EOL‘s and tabs JSONDOC_THREADSAFE to make IJSONDocument instances thread-safe JSONDOC_DEFAULT_USE_IJSONARRAY to set JSON_UseIJSONArray to true by default } interface uses SysUtils; const //COM GUID‘s IID_IJSONDocument : TGUID = ‘{4A534F4E-0001-0001-C000-000000000001}‘; CLASS_JSONDocument : TGUID = ‘{4A534F4E-0001-0002-C000-000000000002}‘; IID_IJSONEnumerator : TGUID = ‘{4A534F4E-0001-0003-C000-000000000003}‘; IID_IJSONEnumerable : TGUID = ‘{4A534F4E-0001-0004-C000-000000000004}‘; IID_IJSONArray : TGUID = ‘{4A534F4E-0001-0005-C000-000000000005}‘; IID_IJSONDocArray : TGUID = ‘{4A534F4E-0001-0006-C000-000000000006}‘; IID_IJSONDocWithReUse : TGUID = ‘{4A534F4E-0001-0007-C000-000000000007}‘; type { IJSONDocument interface the base JSON document interface that provides access to a set of key-value pairs. use AsString and Parse to convert JSON to and from string values. use AsVarArray to access the key-value pairs as a [x,2] variant array. use Clear to re-use a JSON doc for parsing or building a new similar document and keep the allocated memory for keys and values. see also: JSON function } IJSONDocument = interface(IUnknown) [‘{4A534F4E-0001-0001-C000-000000000001}‘] function Get_Item(const Key: WideString): Variant; stdcall; procedure Set_Item(const Key: WideString; const Value: Variant); stdcall; procedure Parse(const JSONData: WideString); stdcall; function ToString: WideString; stdcall; function ToVarArray: Variant; stdcall; procedure Clear; stdcall; procedure Delete(const Key: WideString); stdcall; property Item[const Key: WideString]: Variant read Get_Item write Set_Item; default; property AsString: WideString read ToString write Parse; end; { IJSONEnumerator interface use IJSONEnumerator to enumerate a document‘s key-value pairs see also: JSONEnum function } //TODO: IEnumVariant? IJSONEnumerator = interface(IUnknown) [‘{4A534F4E-0001-0003-C000-000000000003}‘] function EOF: boolean; stdcall; function Next: boolean; stdcall; function Get_Key: WideString; stdcall; function Get_Value: Variant; stdcall; procedure Set_Value(const Value: Variant); stdcall; function v0: pointer; stdcall; property Key: WideString read Get_Key; property Value: Variant read Get_Value write Set_Value; end; { IJSONEnumerable interface used to get a IJSONEnumerable instance for a document see also: JSONEnum function } IJSONEnumerable = interface(IUnknown) [‘{4A534F4E-0001-0004-C000-000000000004}‘] function NewEnumerator: IJSONEnumerator; stdcall; end; { IJSONArray interface When using VarArrayOf (declared in Variants.pas), a SafeArray is used internally for storage, but as a variant value VarCopy is called with each use, creating duplicate (deep) copies of the SafeArray. Use IJSONArray (and the ja function) to create a IJSONArray instance that uses a single copy of the data. It is also reference counted, which automates memory clean-up. } IJSONArray = interface(IUnknown) [‘{4A534F4E-0001-0005-C000-000000000005}‘] function Get_Item(Index: integer): Variant; stdcall; procedure Set_Item(Index: integer; const Value: Variant); stdcall; function Count: integer; stdcall; function ToString: WideString; stdcall; function v0(Index: integer): pointer; stdcall; property Item[Idx: integer]: Variant read Get_Item write Set_Item; default; end; { IJSONDocArray interface use IJSONDocArray to build an array of similar documents, ideally in combination with a single IJSONDocument instance and IJSONDocument.Clear to re-use the memory allocated for keys and values see also: JSONDocArr function } IJSONDocArray = interface(IJSONArray) [‘{4A534F4E-0001-0006-C000-000000000006}‘] function Add(const Doc: IJSONDocument): integer; stdcall; function AddJSON(const Data: WideString): integer; stdcall; procedure LoadItem(Index: integer; const Doc: IJSONDocument); stdcall; procedure Clear; stdcall; function GetJSON(Index: integer): WideString; stdcall; end; { IJSONDocWithReUse interface used internally to enable re-use of allocated keys see also: TJSONDocument Parse and Clear } IJSONDocWithReUse = interface(IUnknown) [‘{4A534F4E-0001-0007-C000-000000000007}‘] function ReUse(const Key: WideString): Variant; stdcall; end; { JSON function: JSON document factory call JSON without parameters do create a new blank document } function JSON: IJSONDocument; overload; { JSON function: JSON document builder pass an array of alternately keys and values, suffix key with opening brace to start an embedded document, and key of a single closing brace to close it. } function JSON(const x: array of Variant): IJSONDocument; overload; { JSON function: JSON document converter pass a single variant to have it converted to an IJSONDocument interface or a string with JSON parsed into a IJSONDocument or nil when VarIsNull } function JSON(const x: Variant): IJSONDocument; overload; { JSONEnum function get a new enumerator to enumeratare the key-value pairs in the document } function JSONEnum(const x: IJSONDocument): IJSONEnumerator; overload; //inline; function JSONEnum(const x: Variant): IJSONEnumerator; overload; function JSON(const x: IJSONEnumerator): IJSONDocument; overload; //inline; function JSONEnum(const x: IJSONEnumerator): IJSONEnumerator; overload; //inline; { ja function create and populate a new IJSONArray instance or cast a Variant holding a JSONArray instance to the interface reference } function ja(const Items:array of Variant): IJSONArray; overload; function ja(const Item:Variant): IJSONArray; overload; { JSONDocArray function get a new IJSONDocArray instance } function JSONDocArray: IJSONDocArray; overload; function JSONDocArray(const Items:array of IJSONDocument): IJSONDocArray; overload; { JSON_UseIJSONArray switch JSON so it will create IJSONArray instances to hold arrays of values instead of VarArrayCreate, default false see also TJSONDocument.UseIJSONArray property } var JSON_UseIJSONArray: boolean; { TJSONImplBaseObj common base object JSON implementation objects inherit don‘t use directly } type {$IFDEF JSONDOC_THREADSAFE} TJSONImplBaseObj = class(TInterfacedObject) protected FLock:TRTLCriticalSection; public procedure AfterConstruction; override; destructor Destroy; override; end; {$ELSE} //thread-unsafe anyway, so avoid locking when reference counting: TJSONImplBaseObj = class(TObject, IInterface) protected FRefCount: Integer; function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; function _AddRef: Integer; stdcall; function _Release: Integer; stdcall; public procedure AfterConstruction; override; procedure BeforeDestruction; override; class function NewInstance: TObject; override; property RefCount: Integer read FRefCount; end; {$ENDIF} { TJSONDocument class the default IJSONDocument implementation see also: JSON function } TJSONDocument = class(TJSONImplBaseObj, IJSONDocument, IJSONEnumerable, IJSONDocWithReUse) private FElementIndex,FElementSize:integer; FElements:array of record SortIndex,LoadIndex:integer; Key:WideString; Value:Variant; end; FLoadIndex:integer; {$IFNDEF JSONDOC_THREADSAFE} FGotIndex,FGotSorted:integer; FGotMatch:boolean; {$ENDIF} FUseIJSONArray:boolean; function GetKeyIndex(const Key: WideString; var GotIndex: integer; var GotSorted: integer): boolean; protected function Get_Item(const Key: WideString): Variant; stdcall; procedure Set_Item(const Key: WideString; const Value: Variant); stdcall; function ReUse(const Key: WideString): Variant; stdcall; public procedure AfterConstruction; override; destructor Destroy; override; procedure Parse(const JSONData: WideString); stdcall; function JSONToString: WideString; stdcall; function IJSONDocument.ToString=JSONToString; function ToVarArray: Variant; stdcall; procedure Clear; stdcall; function NewEnumerator: IJSONEnumerator; stdcall; procedure Delete(const Key: WideString); stdcall; property Item[const Key: WideString]: Variant read Get_Item write Set_Item; default; property AsString: WideString read JSONToString write Parse; property UseIJSONArray:boolean read FUseIJSONArray write FUseIJSONArray; end; { TJSONEnumerator class the default IJSONEnumerator implementation see also: JSONEnum function } TJSONEnumerator = class(TJSONImplBaseObj, IJSONEnumerator) private FData:TJSONDocument; FIndex: integer; public constructor Create(Data: TJSONDocument); destructor Destroy; override; function EOF: boolean; stdcall; function Next: boolean; stdcall; function Get_Key: WideString; stdcall; function Get_Value: Variant; stdcall; procedure Set_Value(const Value: Variant); stdcall; function v0: pointer; stdcall; end; { TJSONArray class Default ILightArray implementation } TJSONArray = class(TJSONImplBaseObj, IJSONArray, IJSONEnumerable) private FData:array of Variant; protected function Get_Item(Index: integer): Variant; stdcall; procedure Set_Item(Index: integer; const Value: Variant); stdcall; function Count: integer; stdcall; function JSONToString: WideString; stdcall; function IJSONArray.ToString=JSONToString; function v0(Index: integer): pointer; stdcall; function NewEnumerator: IJSONEnumerator; stdcall; public constructor Create(Size: integer); end; { TJSONArrayEnumerator an IJSONEnumerator implementation that iterates over a variant array used internally to convert to JSON } TJSONArrayEnumerator= class(TJSONImplBaseObj, IJSONEnumerator) private FData:IJSONArray; FIndex,FMax:integer; public constructor Create(const Data:IJSONArray); destructor Destroy; override; function EOF: boolean; stdcall; function Next: boolean; stdcall; function Get_Key: WideString; stdcall; function Get_Value: Variant; stdcall; procedure Set_Value(const Value: Variant); stdcall; function v0: pointer; stdcall; end; { TJSONDocArray class the default IJSONDocArray implementation see also: JSONDocArray function } TJSONDocArray = class(TJSONImplBaseObj, IJSONArray, IJSONDocArray) private FItems:array of WideString; FItemsCount,FItemsSize,FCurrentIndex:integer; FCurrent:Variant; protected //IJSONArray function Get_Item(Index: integer): Variant; stdcall; procedure Set_Item(Index: integer; const Value: Variant); stdcall; function Count: integer; stdcall; function JSONToString: WideString; stdcall; function IJSONArray.ToString=JSONToString; function v0(Index: integer): pointer; stdcall; //function IJSONArray.ToString=JSONToString; //IJSONDocArray function Add(const Doc: IJSONDocument): integer; stdcall; function AddJSON(const Data: WideString): integer; stdcall; procedure LoadItem(Index: integer; const Doc: IJSONDocument); stdcall; function IJSONDocArray.ToString=JSONToString; procedure Clear; stdcall; function GetJSON(Index: integer): WideString; stdcall; public constructor Create; destructor Destroy; override; end; { TVarArrayEnumerator an IJSONEnumerator implementation that iterates over a variant array used internally to convert to JSON } TVarArrayEnumerator = class(TJSONImplBaseObj, IJSONEnumerator) private FData:PVariant; FCurrent:Variant; FIndex,FMax,FCurrentIndex:integer; public constructor Create(const Data:PVariant); destructor Destroy; override; function EOF: boolean; stdcall; function Next: boolean; stdcall; function Get_Key: WideString; stdcall; function Get_Value: Variant; stdcall; procedure Set_Value(const Value: Variant); stdcall; function v0: pointer; stdcall; end; { TVarJSONArray an IJSONArray implementation that works on an existing variant array used internally by the ja function } TVarJSONArray = class(TJSONImplBaseObj, IJSONArray) private FData,FCurrent:Variant; v1,v2,FCurrentIndex:integer; protected function Get_Item(Index: integer): Variant; stdcall; procedure Set_Item(Index: integer; const Value: Variant); stdcall; function Count: integer; stdcall; function JSONToString: WideString; stdcall; function IJSONArray.ToString=JSONToString; function v0(Index: integer): pointer; stdcall; public constructor Create(const Data: Variant); constructor CreateNoCopy(var Data: Variant); destructor Destroy; override; end; { EJSONException class types exception types thrown from TJSONDocument‘s Parse and ToString } EJSONException=class(Exception); EJSONDecodeException=class(EJSONException); EJSONEncodeException=class(EJSONException); implementation uses Variants{, Windows}; //cxg procedure VarMove(var Dest, Src: Variant); begin //Dest:=Src;VarClear(Src); Move(Src,Dest,SizeOf(TVarData)); FillChar(src, SizeOf(TVarData), 0); //cxg //ZeroMemory(@Src,SizeOf(TVarData)); end; { TJSONImplBaseObj } {$IFDEF JSONDOC_THREADSAFE} procedure TJSONImplBaseObj.AfterConstruction; begin inherited; InitializeCriticalSection(FLock); end; destructor TJSONImplBaseObj.Destroy; begin DeleteCriticalSection(FLock); inherited; end; {$ELSE} procedure TJSONImplBaseObj.AfterConstruction; begin inherited; dec(FRefCount);//see constructor end; procedure TJSONImplBaseObj.BeforeDestruction; begin inherited; if RefCount<>0 then System.Error(reInvalidPtr); end; class function TJSONImplBaseObj.NewInstance: TObject; begin Result:=inherited NewInstance; //see AfterConstruction, prevent detroy while creating TJSONImplBaseObj(Result).FRefCount:=1; end; function TJSONImplBaseObj.QueryInterface(const IID: TGUID; out Obj): HResult; begin if GetInterface(IID,Obj) then Result:=0 else Result:=E_NOINTERFACE; end; function TJSONImplBaseObj._AddRef: Integer; begin inc(FRefCount); Result:=FRefCount; end; function TJSONImplBaseObj._Release: Integer; begin dec(FRefCount); Result:=FRefCount; if Result=0 then Destroy; end; {$ENDIF} { TJSONDocument } procedure TJSONDocument.AfterConstruction; begin inherited; FElementIndex:=0; FElementSize:=0; FLoadIndex:=0; {$IFNDEF JSONDOC_THREADSAFE} FGotIndex:=0; FGotSorted:=0; FGotMatch:=false; {$ENDIF} FUseIJSONArray:=JSON_UseIJSONArray; end; destructor TJSONDocument.Destroy; var i:integer; begin for i:=0 to FElementIndex-1 do VarClear(FElements[i].Value); inherited; end; function TJSONDocument.GetKeyIndex(const Key: WideString; var GotIndex: integer; var GotSorted: integer): boolean; var a,b,c,d,x:integer; begin //case sensitivity? {$IFNDEF JSONDOC_THREADSAFE} //check last getindex, speeds up set right after get if FGotMatch and (CompareStr(Key,FElements[FGotIndex].Key)=0) then begin //assert FGotIndex=FSorted[FGotSorted]; GotIndex:=FGotIndex; GotSorted:=FGotSorted; Result:=true; end else {$ENDIF} begin a:=0; b:=FElementIndex-1; d:=FElementIndex; Result:=false;//default while b>=a do begin c:=(a+b) div 2; d:=FElements[c].SortIndex; //if c=a? c=b? x:=CompareStr(Key,FElements[d].Key); if x=0 then begin a:=c; b:=c-1; Result:=true; end else if x<0 then if b=c then dec(b) else b:=c else if a=c then inc(a) else a:=c; end; GotSorted:=a; GotIndex:=d; {$IFNDEF JSONDOC_THREADSAFE} FGotSorted:=a; FGotIndex:=d; FGotMatch:=Result; {$ENDIF} end; end; function TJSONDocument.Get_Item(const Key: WideString): Variant; var GotIndex,GotSorted:integer; begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FLock); try {$ENDIF} if (Self<>nil) and GetKeyIndex(Key,GotIndex,GotSorted) and (FElements[GotIndex].LoadIndex=FLoadIndex) then Result:=FElements[GotIndex].Value else Result:=Null; {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; function TJSONDocument.ReUse(const Key: WideString): Variant; var GotIndex,GotSorted:integer; begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FLock); try {$ENDIF} if (Self<>nil) and GetKeyIndex(Key,GotIndex,GotSorted) then begin FElements[GotIndex].LoadIndex:=FLoadIndex; Result:=FElements[GotIndex].Value; end else Result:=Null; {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; procedure TJSONDocument.Set_Item(const Key: WideString; const Value: Variant); var i,GotIndex,GotSorted:integer; const GrowStep=$20;//not too much, not too little (?) begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FLock); try {$ENDIF} //if ((VarType(Value) and varArray)<>0) and (VarArrayDimCount(v)>1) then // raise EJSONException.Create( // ‘VarArray: multi-dimensional arrays not supported‘); if not GetKeyIndex(Key,GotIndex,GotSorted) then begin if FElementIndex=FElementSize then begin inc(FElementSize,GrowStep); SetLength(FElements,FElementSize); end; for i:=FElementIndex-1 downto GotSorted do FElements[i+1].SortIndex:=FElements[i].SortIndex; GotIndex:=FElementIndex; inc(FElementIndex); FElements[GotSorted].SortIndex:=GotIndex; FElements[GotIndex].Key:=Key; end; FElements[GotIndex].Value:=Value; FElements[GotIndex].LoadIndex:=FLoadIndex; //FDirty:=true; {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; {$IFDEF JSONDOC_P2} {$DEFINE JSONDOC_JSON_LOOSE} {$DEFINE JSONDOC_JSON_PASCAL_STRINGS} {$ENDIF} procedure TJSONDocument.Parse(const JSONData: WideString); var i,l:integer; function SkipWhiteSpace:WideChar; begin while (i<=l) and (jsonData[i]<=‘ ‘) do inc(i); if i<=l then Result:=jsonData[i] else Result:=#0; end; function ExVicinity(di:integer):WideString; const VicinityExtent=12; var i:integer; begin if di<=VicinityExtent then Result:=#13#10‘(#‘+IntToStr(di)+‘)"‘+Copy(jsonData,1,di-1)+ ‘ >>> ‘+jsonData[di]+‘ <<< ‘+Copy(jsonData,di+1,VicinityExtent)+‘"‘ else Result:=#13#10‘(#‘+IntToStr(di)+‘)"...‘+ Copy(jsonData,di-VicinityExtent,VicinityExtent)+ ‘ >>> ‘+jsonData[di]+‘ <<< ‘+Copy(jsonData,di+1,VicinityExtent)+‘"‘; for i:=1 to Length(Result) do if word(Result[i])<32 then Result[i]:=‘|‘; end; procedure Expect(c:WideChar;const msg:string); begin while (i<=l) and (jsonData[i]<=‘ ‘) do inc(i); if (i<=l) and (jsonData[i]=c) then inc(i) else {$IFDEF JSONDOC_JSON_LOOSE} ; {$ELSE} raise EJSONDecodeException.Create(msg+ExVicinity(i)); {$ENDIF} end; procedure GetStringIndexes(var i1,i2:integer); begin //assert jsonData[i]=‘"‘ i1:=i; inc(i); while (i<=l) and (jsonData[i]<>‘"‘) do begin if jsonData[i]=‘\‘ then inc(i);//just skip all to skip any ‘"‘ inc(i); end; i2:=i; inc(i); end; {$IFDEF JSONDOC_JSON_PASCAL_STRINGS} procedure GetPascalIndexes(var i1,i2:integer); begin i1:=i; while (i<=l) and ((jsonData[i]=‘‘‘‘) or (jsonData[i]=‘#‘)) do if jsonData[i]=‘‘‘‘ then begin inc(i); while (i<=l) and (jsonData[i]<>‘‘‘‘) do inc(i); if i<=l then inc(i); end else begin inc(i); if (i<=l) and (jsonData[i]=‘$‘) then begin inc(i); while (i<=l) and (word(jsonData[i]) in [$30..$39,$41..$5A,$61..$7A]) do inc(i); end else while (i<=l) and (word(jsonData[i]) in [$30..$39]) do inc(i); end; i2:=i; end; {$ENDIF} function GetStringValue(i1,i2:integer):WideString; var ii,di,u,v,w:integer; begin //assert i1<=l //assert i2<=l //assert i1<i2 {$IFDEF JSONDOC_JSON_PASCAL_STRINGS} if (jsonData[i1]=‘‘‘‘) or (jsonData[i1]=‘#‘) then begin SetLength(Result,i2-i1); ii:=1; di:=i1; while di<i2 do begin case AnsiChar(jsonData[di]) of ‘‘‘‘: begin inc(di); u:=0; while (di<i2) and (u=0) do begin if jsonData[di]=‘‘‘‘ then begin inc(di); if (di<=l) and (jsonData[di]=‘‘‘‘) then begin Result[ii]:=‘‘‘‘; inc(ii); inc(di); end else u:=1; end else begin Result[ii]:=jsonData[di]; inc(ii); inc(di); end; end; end; ‘#‘: begin inc(di); if (di<i2) and (jsonData[di]=‘$‘) then begin w:=0; u:=0; inc(di); while (u<4) and (di<i2) and (word(jsonData[di]) in [$30..$39,$41..$5A,$61..$7A]) do begin if di=i2 then raise EJSONDecodeException.Create( ‘JSON Incomplete espace sequence‘+ExVicinity(di)); v:=word(jsonData[di]); case v of $30..$39:w:=(w shl 4) or (v and $F); $41..$5A,$61..$7A:w:=(w shl 4) or ((v and $1F)+9); else raise EJSONDecodeException.Create( ‘JSON Invalid espace sequence‘+ExVicinity(di)); end; inc(di); inc(u); end; Result[ii]:=WideChar(w); inc(ii); end else begin w:=0; u:=0; while (u<5) and (di<i2) and (word(jsonData[di]) in [$30..$39]) do begin if di=i2 then raise EJSONDecodeException.Create( ‘JSON Incomplete espace sequence‘+ExVicinity(di)); w:=w*10+(word(jsonData[di]) and $F); inc(di); inc(u); end; Result[ii]:=WideChar(w); inc(ii); end; end; else raise EJSONDecodeException.Create( ‘JSON Unknown pascal string syntax‘+ExVicinity(di)); end; end; SetLength(Result,ii-1); end else {$ENDIF} begin {$IFDEF JSONDOC_JSON_STRICT} //assert jsonData[i1]=‘"‘ //assert jsonData[i2]=‘"‘; inc(i1); {$ELSE} if jsonData[i1]=‘"‘ then inc(i1); {$ENDIF} SetLength(Result,i2-i1); ii:=1; di:=i1; while di<i2 do begin //assert ii<=Length(Result); if jsonData[di]=‘\‘ then begin inc(di); case AnsiChar(jsonData[di]) of ‘"‘,‘\‘,‘/‘:Result[ii]:=jsonData[di]; ‘b‘:Result[ii]:=#8; ‘t‘:Result[ii]:=#9; ‘n‘:Result[ii]:=#10; ‘f‘:Result[ii]:=#12; ‘r‘:Result[ii]:=#13; ‘x‘: begin inc(di); if di=i2 then raise EJSONDecodeException.Create( ‘JSON Incomplete espace sequence‘+ExVicinity(di)); v:=word(jsonData[di]); case v of $30..$39:w:=(v and $F) shl 4; $41..$5A,$61..$7A:w:=((v and $1F)+9) shl 4; else raise EJSONDecodeException.Create( ‘JSON Invalid espace sequence‘+ExVicinity(di)); end; inc(di); if di=i2 then raise EJSONDecodeException.Create( ‘JSON Incomplete espace sequence‘+ExVicinity(di)); v:=word(jsonData[di]); case v of $30..$39:w:=w or (v and $F); $41..$5A,$61..$7A:w:=w or ((v and $1F)+9); else raise EJSONDecodeException.Create( ‘JSON Invalid espace sequence‘+ExVicinity(di)); end; Result[ii]:=WideChar(w); end; ‘u‘: begin w:=0; for u:=0 to 3 do begin inc(di); if di=i2 then raise EJSONDecodeException.Create( ‘JSON Incomplete espace sequence‘+ExVicinity(di)); v:=word(jsonData[di]); case v of $30..$39:w:=(w shl 4) or (v and $F); $41..$5A,$61..$7A:w:=(w shl 4) or ((v and $1F)+9); else raise EJSONDecodeException.Create( ‘JSON Invalid espace sequence‘+ExVicinity(di)); end; end; Result[ii]:=WideChar(w); end; else raise EJSONDecodeException.Create( ‘JSON Unknown escape sequence‘+ExVicinity(di)); end; end else Result[ii]:=jsonData[di]; inc(di); inc(ii); end; SetLength(Result,ii-1); end; end; const stackGrowStep=$20;//not too much, not too little (?) arrGrowStep=$20; var IsArray:boolean; k1,k2,v1,v2,a1,ai,al:integer; d:IJSONDocument; a:array of Variant; at,vt:TVarType; procedure SetValue(const v:Variant); begin //assert da=nil if IsArray then begin if ai=al then begin inc(al,arrGrowStep);//not too much, not too little (?) SetLength(a,al); end; a[ai]:=v; //detect same type elements array vt:=TVarData(v).VType; case at of varEmpty: at:=vt; varShortInt,varByte://i1,u1 case vt of varSmallInt,varInteger,varSingle,varDouble, varLongWord,varInt64,$0015: at:=vt; varShortInt: ;//at:=varShortInt; else at:=varVariant; end; varSmallint,varWord://i2,u2 case vt of varInteger,varSingle,varDouble,varLongWord,varInt64,$0015: at:=vt; varSmallInt, varShortInt,varByte,varWord: ;//at:=varSmallInt; else at:=varVariant; end; varInteger,varLongWord://i4,u4 case vt of varSingle,varDouble,varInt64,$0015: at:=vt; varSmallInt,varInteger, varShortInt,varByte,varWord,varLongWord: ;//at:=varInteger; else at:=varVariant; end; varInt64,$0015://i8 case vt of varSingle,varDouble: at:=vt; varSmallInt,varInteger, varShortInt,varByte,varWord,varLongWord,varInt64,$0015: ;//at:=varInt64; else at:=varVariant; end; varSingle: case vt of varDouble: at:=vt; varSmallInt,varInteger,varSingle, varShortInt,varByte,varWord,varLongWord: ;//at:=varSingle else at:=varVariant; end; varDouble: case vt of varSmallInt,varInteger,varSingle,varDouble, varShortInt,varByte,varWord,varLongWord: ;//at:=varDouble else at:=varVariant; end; varVariant: ;//Already creating an VarArray of varVariant else if at<>vt then at:=varVariant; end; inc(ai); end else d[GetStringValue(k1,k2)]:=v end; var firstItem,b:boolean; stack:array of record k1,k2:integer; d:IJSONDocument; end; stackIndex,stackSize:integer; ods:char; key:WideString; d1:IJSONDocument; dr:IJSONDocWithReUse; da:IJSONDocArray; aa:TJSONArray; da0,da1:integer; v:Variant; v64:int64; procedure CheckValue; begin //assert da<>nil if stackIndex=da0 then raise EJSONDecodeException.Create(‘IJSONDocArray: non-document element in array‘); end; begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FLock); try {$ENDIF} //Clear;? let caller decide. i:=1; l:=Length(jsonData); //object starts Expect(‘{‘,‘JSON doesn‘‘t define an object, "{" expected.‘); stackSize:=0; stackIndex:=0; ai:=0; a1:=0; al:=0; da:=nil; da0:=0; da1:=0; IsArray:=false; firstItem:=true; {$if CompilerVersion >= 24} ods:=FormatSettings.DecimalSeparator; {$else} ods:=DecimalSeparator; {$ifend} try {$if CompilerVersion >= 24} FormatSettings.DecimalSeparator:=‘.‘; {$else} DecimalSeparator:=‘.‘; {$ifend} d:=Self; //main loop over key/values and nested objects/arrays while (i<=l) and (stackIndex<>-1) do begin if firstItem then firstItem:=false else Expect(‘,‘,‘JSON element not delimited by comma‘); if not(IsArray) and (SkipWhiteSpace<>‘}‘) then begin //key string case AnsiChar(SkipWhiteSpace) of ‘"‘: GetStringIndexes(k1,k2); {$IFDEF JSONDOC_JSON_PASCAL_STRINGS} ‘‘‘‘,‘#‘: GetPascalIndexes(k1,k2); {$ENDIF} else {$IFDEF JSONDOC_JSON_STRICT} raise EJSONDecodeException.Create( ‘JSON key string not enclosed in double quotes‘+ExVicinity(i)); {$ELSE} begin k1:=i; while (i<=l) and (jsonData[i]>‘ ‘) and not( (jsonData[i]=‘:‘) or (jsonData[i]=‘"‘) {$IFDEF JSONDOC_JSON_LOOSE} or (jsonData[i]=‘{‘) or (jsonData[i]=‘[‘) or (jsonData[i]=‘=‘) or (jsonData[i]=‘;‘) {$ENDIF} ) do inc(i); k2:=i; end; {$ENDIF} end; Expect(‘:‘,‘JSON key, value not separated by colon‘); {$IFDEF JSONDOC_JSON_LOOSE} if (i<=l) and (jsonData[i]=‘=‘) then inc(i); {$ENDIF} end; //value case AnsiChar(SkipWhiteSpace) of ‘{‘,‘[‘://object or array begin b:=IsArray; if jsonData[i]=‘{‘ then begin //an object starts if da=nil then if IsArray then begin if ai=al then begin inc(al,arrGrowStep);//not too much, not too little (?) SetLength(a,al); end; v:=JSON; a[ai]:=v; //detect same type elements array if at=varEmpty then at:=varUnknown else if at<>varUnknown then at:=varVariant; inc(ai); end else begin key:=GetStringValue(k1,k2); if d.QueryInterface(IID_IJSONDocWithReUse,dr)=S_OK then begin v:=dr.ReUse(key); dr:=nil; end else v:=Null; if (TVarData(v).VType in [varDispatch,varUnknown]) and (TVarData(v).VUnknown<>nil) and (IUnknown(v).QueryInterface(IID_IJSONDocument,d1)=S_OK) then d1:=nil else begin v:=JSON; d[key]:=v; end; end else if da0=stackIndex then da1:=i; IsArray:=false; end else begin //an array starts if da=nil then if d.QueryInterface(IID_IJSONDocWithReUse,dr)=S_OK then begin key:=GetStringValue(k1,k2); v:=dr.ReUse(key); dr:=nil; if (TVarData(v).VType in [varDispatch,varUnknown]) and (TVarData(v).VUnknown<>nil) and (IUnknown(v).QueryInterface(IID_IJSONDocArray,da)=S_OK) then begin da0:=stackIndex+1; da1:=0;//see first ‘{‘ above end; end; IsArray:=true; end; inc(i); //push onto stack if stackIndex=stackSize then begin inc(stackSize,stackGrowStep); SetLength(stack,stackSize); end; if b then //if WasArray then begin stack[stackIndex].k1:=a1; stack[stackIndex].k2:=at; stack[stackIndex].d:=nil; end else begin stack[stackIndex].k1:=k1; stack[stackIndex].k2:=k2; stack[stackIndex].d:=d; end; inc(stackIndex); firstItem:=true; if da=nil then if IsArray then begin a1:=ai; at:=varEmpty;//used to detect same type elements array end else d:=IUnknown(v) as IJSONDocument; end; ‘}‘,‘]‘:;//empty object or array, drop into close array below ‘"‘://string begin GetStringIndexes(v1,v2); if da=nil then SetValue(GetStringValue(v1,v2)) else CheckValue; end; {$IFDEF JSONDOC_JSON_PASCAL_STRINGS} ‘‘‘‘,‘#‘://pascal-style string begin GetPascalIndexes(v1,v2); if da=nil then SetValue(GetStringValue(v1,v2)) else CheckValue; end; ‘$‘://pascal-style hex digit begin inc(i); v1:=i; v64:=0; while (i<=l) and (word(jsonData[i]) in [$30..$39,$41..$5A,$61..$7A]) do begin case word(jsonData[i]) of $30..$39:v64:=(v64 shl 4) or (word(jsonData[i]) and $F); $41..$5A,$61..$7A:v64:=(v64 shl 4) or ((word(jsonData[i]) and $1F)+9); else raise EJSONDecodeException.Create( ‘JSON Invalid espace sequence‘+ExVicinity(i)); end; inc(i); end; if i=v1 then raise EJSONDecodeException.Create( ‘JSON Unrecognized value type‘+ExVicinity(i)); if v64>=$80000000 then //int64 SetValue(v64) else if v64>=$80 then //int32 SetValue(integer(v64)) else //int8 SetValue(SmallInt(v64)); end; {$ENDIF} ‘0‘..‘9‘,‘-‘://number begin b:=jsonData[i]=‘-‘; v1:=i; if b then inc(i); if da=nil then begin v64:=0; while (i<=l) and (word(jsonData[i]) in [$30..$39]) do begin v64:=v64*10+(word(jsonData[i]) and $F);//TODO: detect overflow inc(i); end; if AnsiChar(jsonData[i]) in [‘.‘,‘e‘,‘E‘] then begin //float inc(i); while (i<=l) and (AnsiChar(jsonData[i]) in [‘0‘..‘9‘,‘-‘,‘+‘,‘e‘,‘E‘]) do inc(i); //try except EConvertError? SetValue(StrToFloat(Copy(jsonData,v1,i-v1))); end else begin //integer if v64>=$80000000 then //int64 if b then SetValue(-v64) else SetValue(v64) else if v64>=$80 then //int32 if b then SetValue(-integer(v64)) else SetValue(integer(v64)) else //int8 if b then SetValue(-SmallInt(v64)) else SetValue(SmallInt(v64)); end; end else begin //skip CheckValue; while (i<=l) and (word(jsonData[i]) in [$30..$39]) do inc(i); if AnsiChar(jsonData[i]) in [‘.‘,‘e‘,‘E‘] then begin inc(i); while (i<=l) and (AnsiChar(jsonData[i]) in [‘0‘..‘9‘,‘-‘,‘+‘,‘e‘,‘E‘]) do inc(i); end; end; end; {$IFDEF JSONDOC_JSON_LOOSE} ‘;‘:inc(i); else begin v1:=i; while (i<=l) and (jsonData[i]>‘ ‘) and not( (jsonData[i]=‘:‘) or (jsonData[i]=‘,‘) or (jsonData[i]=‘"‘) or (jsonData[i]=‘}‘) or (jsonData[i]=‘]‘) {$IFDEF JSONDOC_JSON_PASCAL_STRINGS} or (jsonData[i]=‘‘‘‘) {$ENDIF} ) do inc(i); v2:=i; if v1=v2 then raise EJSONDecodeException.Create( ‘JSON Value expected‘+ExVicinity(i)); if da=nil then if (v2-v1=4) and (jsonData[v1]=‘t‘) and (jsonData[v1+1]=‘r‘) and (jsonData[v1+2]=‘u‘) and (jsonData[v1+3]=‘e‘) then SetValue(true) else if (v2-v1=5) and (jsonData[v1]=‘f‘) and (jsonData[v1+1]=‘a‘) and (jsonData[v1+2]=‘l‘) and (jsonData[v1+3]=‘s‘) and (jsonData[v1+4]=‘e‘) then SetValue(false) else if (v2-v1=4) and (jsonData[v1]=‘n‘) and (jsonData[v1+1]=‘u‘) and (jsonData[v1+2]=‘l‘) and (jsonData[v1+3]=‘l‘) then SetValue(Null) else SetValue(GetStringValue(v1,v2)) else CheckValue; end; {$ELSE} ‘t‘://true begin inc(i); Expect(‘r‘,‘JSON true misspelled‘); Expect(‘u‘,‘JSON true misspelled‘); Expect(‘e‘,‘JSON true misspelled‘); if da=nil then SetValue(true) else CheckValue; end; ‘f‘://false begin inc(i); Expect(‘a‘,‘JSON false misspelled‘); Expect(‘l‘,‘JSON false misspelled‘); Expect(‘s‘,‘JSON false misspelled‘); Expect(‘e‘,‘JSON false misspelled‘); if da=nil then SetValue(false) else CheckValue; end; ‘n‘://null begin inc(i); Expect(‘u‘,‘JSON null misspelled‘); Expect(‘l‘,‘JSON null misspelled‘); Expect(‘l‘,‘JSON null misspelled‘); if da=nil then SetValue(Null) else CheckValue; //TODO: support null in IJSONDocArray end; else raise EJSONDecodeException.Create( ‘JSON Unrecognized value type‘+ExVicinity(i)); {$ENDIF} end; if not firstItem then begin b:=true; while b do begin v:=Null; if IsArray then if SkipWhiteSpace=‘]‘ then begin if da=nil then begin if FUseIJSONArray then begin aa:=TJSONArray.Create(ai-a1); k1:=a1; k2:=0; while k1<ai do begin //aa[k2]:=a[k1];VarClear(a[k1]); VarMove(aa.FData[k2],a[k1]); inc(k1); inc(k2); end; v:=aa as IJSONArray; end else begin if not(VarTypeIsValidArrayType(at)) then at:=varVariant; v:=VarArrayCreate([0,ai-a1-1],at); k1:=a1; k2:=0; while k1<ai do begin v[k2]:=a[k1]; VarClear(a[k1]); inc(k1); inc(k2); end; end; ai:=a1; end; end else b:=false else b:=SkipWhiteSpace=‘}‘; if b then begin inc(i); //pop from stack if stackIndex=0 then begin //EndIndex:=i; dec(stackIndex);//stackindex:=-1; b:=false; end else begin dec(stackIndex); if stack[stackIndex].d=nil then begin a1:=stack[stackIndex].k1; at:=stack[stackIndex].k2; IsArray:=true; end else begin if da=nil then d:=stack[stackIndex].d; k1:=stack[stackIndex].k1; k2:=stack[stackIndex].k2; stack[stackIndex].d:=nil; IsArray:=false; end; if da<>nil then if stackIndex=da0 then da.AddJSON(Copy(jsonData,da1,i-da1)) else if stackIndex=da0-1 then da:=nil;//done end; //set array if (da=nil) and (TVarData(v).VType<>varNull) then SetValue(v); end; end; end; end; {$IFNDEF JSONDOC_JSON_LOOSE} if stackIndex<>-1 then raise EJSONDecodeException.Create( ‘JSON with ‘+IntToStr(stackIndex+1)+‘ objects or arrays not closed‘); {$ENDIF} if (i<=l) and (SkipWhiteSpace<>#0) then raise EJSONDecodeException.Create( ‘JSON has unexpected data after root document ‘+ExVicinity(i)); finally {$if CompilerVersion >= 24} FormatSettings.DecimalSeparator:=ods; {$else} DecimalSeparator:=ods; {$ifend} end; {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; function JSONEncodeStr(const xx:WideString):WideString; const resGrowStep=$100; hex:array[0..15] of WideChar=( ‘0‘,‘1‘,‘2‘,‘3‘,‘4‘,‘5‘,‘6‘,‘7‘, ‘8‘,‘9‘,‘A‘,‘B‘,‘C‘,‘D‘,‘E‘,‘F‘); var i,j,k,l:integer; w:word; begin l:=Length(xx); SetLength(Result,l+2); Result[1]:=‘"‘; i:=1; j:=1; k:=l+2; while i<=l do begin w:=word(xx[i]); case w of 0..31,word(‘"‘),word(‘\‘): begin if j+3>k then begin k:=((k div resGrowStep)+1)*resGrowStep; SetLength(Result,k); end; inc(j); Result[j]:=‘\‘; inc(j); case w of 8:Result[j]:=‘b‘; 9:Result[j]:=‘t‘; 10:Result[j]:=‘n‘; 12:Result[j]:=‘f‘; 13:Result[j]:=‘r‘; word(‘"‘),word(‘\‘):Result[j]:=xx[i]; else begin Result[j]:=‘u‘; if j+4>k then begin k:=((k div resGrowStep)+1)*resGrowStep; SetLength(Result,k); end; inc(j);Result[j]:=hex[w shr 12]; inc(j);Result[j]:=hex[w shr 8 and $F]; inc(j);Result[j]:=hex[w shr 4 and $F]; inc(j);Result[j]:=hex[w and $F]; end; end; end; else begin if j+2>k then begin k:=((k div resGrowStep)+1)*resGrowStep; SetLength(Result,k); end; inc(j); Result[j]:=WideChar(w); end; end; inc(i); end; inc(j); Result[j]:=‘"‘; SetLength(Result,j); end; { function JSONVarToStr(const v: Variant):WideString; begin if (TVarData(v).VType and varArray)=0 then Result:=JSONVarToStr1(v) else ..... end; } function JSONVarToStr1(const v: Variant):WideString; var uu:IUnknown; d:IJSONDocument; da:IJSONArray; begin case TVarData(v).VType and varTypeMask of varNull:Result:=‘null‘; varSmallint,varInteger,varShortInt, varByte,varWord,varLongWord,varInt64: Result:=VarToWideStr(v); varSingle,varDouble,varCurrency: Result:=FloatToStr(v);//? varDate: //Result:=FloatToStr(VarToDateTime(v));//? Result:=‘"‘+FormatDateTime(‘yyyy-mm-dd"T"hh:nn:ss.zzz‘, VarToDateTime(v))+‘"‘; varOleStr,varString,$0102: Result:=JSONEncodeStr(VarToWideStr(v)); varBoolean: if v then Result:=‘true‘ else Result:=‘false‘; varDispatch,varUnknown: begin uu:=IUnknown(v); if uu=nil then Result:=‘null‘ else if uu.QueryInterface(IID_IJSONDocument,d)=S_OK then begin //revert to ToString Result:=d.ToString; d:=nil; end else if uu.QueryInterface(IID_IJSONArray,da)=S_OK then begin //TODO: re-do indenting Result:=da.ToString; da:=nil; end else //IRegExp2? IStream? IPersistStream? raise EJSONEncodeException.Create( ‘No supported interface found on object‘); end; else raise EJSONEncodeException.Create( ‘Unsupported variant type ‘+IntToHex(TVarData(v).VType,4)); end; end; function TJSONDocument.JSONToString: WideString; const stackGrowStep=$20; var e:IJSONEnumerator; IsArray,firstItem:boolean; stack:array of record e:IJSONEnumerator; IsArray:boolean; end; stackLength,stackIndex:integer; function ExTrace:string; var i:integer; begin if IsArray then Result:=‘ #‘+e.Key else Result:=‘ "‘+e.Key+‘"‘; i:=stackIndex; while i<>0 do begin dec(i); if stack[i].IsArray then Result:=‘ #‘+stack[i].e.Key+Result else Result:=‘ "‘+stack[i].e.Key+‘"‘+Result; end; end; const resultGrowStep=$4000; var wi,wl:cardinal; {$IFDEF JSONDOC_STOREINDENTING} const tabs=#13#10#9#9#9#9#9#9#9#9#9#9#9#9#9#9; var tabIndex:integer; procedure wr(const xx,yy,zz:WideString); var xi,xj,xk,xl,yi,yl,zl:cardinal; begin xi:=1; xl:=Length(xx); yl:=Length(yy);//assert <>0 zl:=Length(zz); while xi<=xl do begin xj:=xi; yi:=0; while (xi<=xl) and (yi<yl) do begin if (xx[xi]=yy[1]) and (xi+yl<=xl) then begin while (yi<yl) and (xx[xi+yi]=yy[1+yi]) do inc(yi); if yi<yl then inc(xi); end else inc(xi); end; xk:=xi-xj; while wi+xk>wl do begin //grow inc(wl,resultGrowStep); SetLength(Result,wl); end; Move(xx[xj],Result[wi+1],xk*2); inc(wi,xk); if xi<=xl then begin inc(xi,yl); while wi+zl>wl do begin //grow inc(wl,resultGrowStep); SetLength(Result,wl); end; Move(zz[1],Result[wi+1],zl*2); inc(wi,zl); end; end; end; {$ENDIF} procedure w(const xx:WideString); var xl:cardinal; begin xl:=Length(xx); while wi+xl>wl do begin //grow inc(wl,resultGrowStep); SetLength(Result,wl); end; Move(xx[1],Result[wi+1],xl*2); inc(wi,xl); end; procedure Push(const NewEnum:IJSONEnumerator;NewIsArray:boolean); begin if stackIndex=stackLength then begin inc(stackLength,stackGrowStep); SetLength(stack,stackLength); end; stack[stackIndex].e:=e; stack[stackIndex].IsArray:=IsArray; inc(stackIndex); e:=NewEnum; IsArray:=NewIsArray; if IsArray then w(‘[‘) else w(‘{‘); firstItem:=true; {$IFDEF JSONDOC_STOREINDENTING} inc(tabIndex); {$ENDIF} end; var ods:char; vt:TVarType; uu:IUnknown; d:IJSONDocument; de:IJSONEnumerable; da1:IJSONArray; da:IJSONDocArray; begin if Self=nil then begin Result:=‘null‘; Exit; end; {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FLock); try {$ENDIF} wi:=1; wl:=resultGrowStep; SetLength(Result,wl); Result[1]:=‘{‘; stackLength:=0; stackIndex:=0; e:=TJSONEnumerator.Create(Self); IsArray:=false; {$if CompilerVersion >= 24} ods:= FormatSettings.DecimalSeparator; {$else} ods:=DecimalSeparator; {$ifend} try {$if CompilerVersion >= 24} FormatSettings.DecimalSeparator:=‘.‘; {$else} DecimalSeparator:=‘.‘; {$ifend} //w(‘{‘);//see above firstItem:=true; {$IFDEF JSONDOC_STOREINDENTING} tabIndex:=3; {$ENDIF} while e<>nil do if e.Next then begin if firstItem then firstItem:=false else w(‘,‘); {$IFDEF JSONDOC_STOREINDENTING} w(Copy(tabs,1,tabIndex)); {$ENDIF} if not IsArray then begin w(JSONEncodeStr(e.Key)); {$IFDEF JSONDOC_STOREINDENTING} w(‘: ‘); {$ELSE} w(‘:‘); {$ENDIF} end; //write value vt:=TVarData(PVariant(e.v0)^).VType; //if (vt and varByRef)<>0 then // raise EJSONEncodeException.Create(‘VarByRef: not implemented‘+ExTrace); if (vt and varArray)=0 then begin //not an array, plain value //TODO: deduplicate with JSONVarToStr1(PVariant(e.v0)^); case vt and varTypeMask of varNull:w(‘null‘); varSmallint,varInteger,varShortInt, varByte,varWord,varLongWord,varInt64: w(VarToWideStr(PVariant(e.v0)^)); varSingle,varDouble,varCurrency: w(FloatToStr(PVariant(e.v0)^));//? varDate: begin //w(FloatToStr(VarToDateTime(v)));//? w(‘"‘); //TODO:"yyyy-mm-dd hh:nn:ss.zzz"? $date? w(FormatDateTime(‘yyyy-mm-dd"T"hh:nn:ss.zzz‘,VarToDateTime(PVariant(e.v0)^))); w(‘"‘); end; varOleStr,varString,$0102: w(JSONEncodeStr(VarToWideStr(PVariant(e.v0)^))); varBoolean: if PVariant(e.v0)^ then w(‘true‘) else w(‘false‘); varDispatch,varUnknown: begin uu:=IUnknown(PVariant(e.v0)^); if uu=nil then w(‘null‘) else if uu.QueryInterface(IID_IJSONEnumerable,de)=S_OK then begin Push(de.NewEnumerator,false); de:=nil; end else if uu.QueryInterface(IID_IJSONDocument,d)=S_OK then begin //revert to ToString w(d.ToString); d:=nil; end else if uu.QueryInterface(IID_IJSONDocArray,da)=S_OK then begin {$IFDEF JSONDOC_STOREINDENTING} wr(da.ToString,#13#10,Copy(tabs,1,tabIndex)); {$ELSE} w(da.ToString); {$ENDIF} da:=nil; end else if uu.QueryInterface(IID_IJSONArray,da1)=S_OK then begin Push(TJSONArrayEnumerator.Create(da1),true); da1:=nil; end else //IRegExp2? IStream? IPersistStream? raise EJSONEncodeException.Create( ‘No supported interface found on object‘+ExTrace); end; else raise EJSONEncodeException.Create( ‘Unsupported variant type ‘+IntToHex(vt,4)+ExTrace); end; end else begin //TODO: if (vt and varTypeMask)=varByte then BLOB? Push(TVarArrayEnumerator.Create(e.v0),true); end; end else begin {$IFDEF JSONDOC_STOREINDENTING} dec(tabIndex); if not firstItem then w(Copy(tabs,1,tabIndex)); {$ENDIF} if IsArray then w(‘]‘) else w(‘}‘); firstItem:=false; if stackIndex=0 then e:=nil else begin //pop from stack dec(stackIndex); e:=stack[stackIndex].e; IsArray:=stack[stackIndex].IsArray; stack[stackIndex].e:=nil; end; end; SetLength(Result,wi); finally {$if CompilerVersion >= 24} FormatSettings.DecimalSeparator:=ods; {$else} DecimalSeparator:=ods; {$ifend} end; {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; function TJSONDocument.ToVarArray: Variant; var i,l:integer; begin if Self=nil then begin Result:=Null; Exit; end; {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FLock); try {$ENDIF} l:=0; for i:=0 to FElementIndex-1 do if FElements[i].LoadIndex=FLoadIndex then inc(l); //and not(VarIsNull(FElements[i].Value))? Result:=VarArrayCreate([0,l-1,0,1],varVariant); l:=0; for i:=0 to FElementIndex-1 do if FElements[i].LoadIndex=FLoadIndex then begin Result[l,0]:=FElements[i].Key; Result[l,1]:=FElements[i].Value; inc(l); end; {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; procedure TJSONDocument.Clear; var i:integer; uu:IUnknown; d:IJSONDocument; da:IJSONDocArray; begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FLock); try {$ELSE} FGotMatch:=false; {$ENDIF} //FDirty:=false; for i:=0 to FElementIndex-1 do if TVarData(FElements[i].Value).VType=varUnknown then begin uu:=IUnknown(FElements[i].Value); if uu=nil then VarClear(FElements[i].Value) else if uu.QueryInterface(IID_IJSONDocument,d)=S_OK then begin d.Clear; d:=nil; end else if uu.QueryInterface(IID_IJSONDocArray,da)=S_OK then begin da.Clear; da:=nil; end else VarClear(FElements[i].Value); end else VarClear(FElements[i].Value); inc(FLoadIndex); {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; procedure TJSONDocument.Delete(const Key: WideString); var GotIndex,GotSorted:integer; uu:IUnknown; d:IJSONDocument; da:IJSONDocArray; begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FLock); try {$ENDIF} if GetKeyIndex(Key,GotIndex,GotSorted) then begin if TVarData(FElements[GotIndex].Value).VType=varUnknown then begin uu:=IUnknown(FElements[GotIndex].Value); if uu=nil then VarClear(FElements[GotIndex].Value) else if uu.QueryInterface(IID_IJSONDocument,d)=S_OK then begin d.Clear; d:=nil; end else if uu.QueryInterface(IID_IJSONDocArray,da)=S_OK then begin da.Clear; da:=nil; end else VarClear(FElements[GotIndex].Value); end else VarClear(FElements[GotIndex].Value); FElements[GotIndex].LoadIndex:=FLoadIndex-1; end; //else raise? //FDirty:=true; {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; function TJSONDocument.NewEnumerator: IJSONEnumerator; begin Result:=TJSONEnumerator.Create(Self); end; { TJSONEnumerator } constructor TJSONEnumerator.Create(Data: TJSONDocument); begin inherited Create; FData:=Data; FIndex:=-1; //TODO: hook into TJSONDocument destructor? end; destructor TJSONEnumerator.Destroy; begin FData:=nil; inherited; end; function TJSONEnumerator.EOF: boolean; var i:integer; begin if FData=nil then Result:=true else begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FData.FLock); try {$ENDIF} i:=FIndex; if i=-1 then i:=0; while (i<FData.FElementIndex) and (FData.FElements[i].LoadIndex<>FData.FLoadIndex) do inc(i); Result:=i>=FData.FElementIndex; {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FData.FLock); end; {$ENDIF} end; end; function TJSONEnumerator.Next: boolean; begin if FData=nil then Result:=false else begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FData.FLock); try {$ENDIF} inc(FIndex); while (FIndex<FData.FElementIndex) and (FData.FElements[FIndex].LoadIndex<>FData.FLoadIndex) do inc(FIndex); Result:=FIndex<FData.FElementIndex; {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FData.FLock); end; {$ENDIF} end; end; function TJSONEnumerator.Get_Key: WideString; begin if (FIndex<0) or (FData=nil) or (FIndex>=FData.FElementIndex) then raise ERangeError.Create(‘Out of range‘) else Result:=FData.FElements[FIndex].Key; end; function TJSONEnumerator.Get_Value: Variant; begin if (FIndex<0) or (FData=nil) or (FIndex>=FData.FElementIndex) then raise ERangeError.Create(‘Out of range‘) else Result:=FData.FElements[FIndex].Value; end; procedure TJSONEnumerator.Set_Value(const Value: Variant); begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FData.FLock); try {$ENDIF} if (FIndex<0) or (FData=nil) or (FIndex>=FData.FElementIndex) then raise ERangeError.Create(‘Out of range‘) else FData.FElements[FIndex].Value:=Value; {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FData.FLock); end; {$ENDIF} end; function TJSONEnumerator.v0: pointer; begin if (FIndex<0) or (FData=nil) or (FIndex>=FData.FElementIndex) then raise ERangeError.Create(‘Out of range‘) else Result:=@FData.FElements[FIndex].Value; end; { TVarArrayEnumerator } constructor TVarArrayEnumerator.Create(const Data: PVariant); begin inherited Create; if VarArrayDimCount(Data^)<>1 then raise EJSONException.Create(‘VarArray: multi-dimensional arrays not supported‘); FData:=Data; VarClear(FCurrent); FIndex:=VarArrayLowBound(Data^,1); FMax:=VarArrayHighBound(Data^,1)+1; FCurrentIndex:=FIndex-1; if FIndex<FMax then dec(FIndex);//see Next end; destructor TVarArrayEnumerator.Destroy; begin VarClear(FCurrent); FData:=nil; inherited; end; function TVarArrayEnumerator.EOF: boolean; begin Result:=not(FIndex<FMax); end; function TVarArrayEnumerator.Get_Key: WideString; begin Result:=IntToStr(FIndex); end; function TVarArrayEnumerator.Get_Value: Variant; begin Result:=FData^[FIndex]; end; function TVarArrayEnumerator.Next: boolean; begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FLock); try {$ENDIF} inc(FIndex); Result:=FIndex<FMax; {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; procedure TVarArrayEnumerator.Set_Value(const Value: Variant); begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FLock); try {$ENDIF} FData^[FIndex]:=Value; {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; function TVarArrayEnumerator.v0: pointer; begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FLock); try {$ENDIF} if FCurrentIndex<>FIndex then begin FCurrent:=FData^[FIndex];//TODO: keep SafeArray locked for lifetime of TVarArrayEnumerator instance? FCurrentIndex:=FIndex; end; Result:=@FCurrent; {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; { TVarJSONArray } constructor TVarJSONArray.Create(const Data: Variant); begin inherited Create; if (TVarData(Data).VType and varArray)=0 then raise EJSONException.Create(‘TVarJSONArray: array variant expected‘); if VarArrayDimCount(Data)<>1 then raise EJSONException.Create(‘TVarJSONArray: multi-dimensional arrays not supported‘); FData:=Data; v1:=VarArrayLowBound(FData,1); v2:=VarArrayHighBound(FData,1)+1; VarClear(FCurrent); FCurrentIndex:=-1; end; constructor TVarJSONArray.CreateNoCopy(var Data: Variant); begin inherited Create; if (TVarData(Data).VType and varArray)=0 then raise EJSONException.Create(‘TVarJSONArray: array variant expected‘); if VarArrayDimCount(Data)<>1 then raise EJSONException.Create(‘TVarJSONArray: multi-dimensional arrays not supported‘); VarMove(FData,Data); v1:=VarArrayLowBound(FData,1); v2:=VarArrayHighBound(FData,1)+1; VarClear(FCurrent); FCurrentIndex:=-1; end; destructor TVarJSONArray.Destroy; begin VarClear(FCurrent); VarClear(FData); inherited; end; function TVarJSONArray.Count: integer; begin Result:=v2-v1; end; function TVarJSONArray.Get_Item(Index: integer): Variant; begin if (Index<0) or (Index>=v2-v1) then raise ERangeError.Create(‘Out of range‘); Result:=FData[Index+v1]; end; procedure TVarJSONArray.Set_Item(Index: integer; const Value: Variant); begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FLock); try {$ENDIF} if (Index<0) or (Index>=v2-v1) then raise ERangeError.Create(‘Out of range‘); FData[Index+v1]:=Value; {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; function TVarJSONArray.v0(Index: integer): pointer; begin {$IFDEF JSONDOC_THREADSAFE} Result:=nil;//counter warning EnterCriticalSection(FLock); try {$ENDIF} if FCurrentIndex<>Index then begin if (Index<0) or (Index>=v2-v1) then raise ERangeError.Create(‘Out of range‘); FCurrent:=FData[Index+v1]; FCurrentIndex:=Index; end; Result:=@FCurrent; {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; function TVarJSONArray.JSONToString: WideString; var i:integer; begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FLock); try {$ENDIF} //TODO: indenting? Result:=‘‘; i:=v1; while (i<v2) do begin Result:=Result+‘,‘+JSONVarToStr1(FData[i]); inc(i); end; Result[1]:=‘[‘; Result:=Result+‘]‘; {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; { TJSONArray } constructor TJSONArray.Create(Size: integer); begin inherited Create; SetLength(FData,Size); end; function TJSONArray.Count: integer; begin Result:=Length(FData); end; function TJSONArray.Get_Item(Index: integer): Variant; begin if (Index<0) or (Index>=Length(FData)) then raise ERangeError.Create(‘Out of range‘); Result:=FData[Index]; end; procedure TJSONArray.Set_Item(Index: integer; const Value: Variant); begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FLock); try {$ENDIF} if (Index<0) or (Index>=Length(FData)) then raise ERangeError.Create(‘Out of range‘); FData[Index]:=Value; {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; function TJSONArray.v0(Index: integer): pointer; begin if (Index<0) or (Index>=Length(FData)) then raise ERangeError.Create(‘Out of range‘); Result:=@FData[Index]; end; function TJSONArray.JSONToString: WideString; var i:integer; begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FLock); try {$ENDIF} //TODO: indenting? Result:=‘‘; i:=0; while (i<Length(FData)) do begin Result:=Result+‘,‘+JSONVarToStr1(FData[i]); inc(i); end; Result[1]:=‘[‘; Result:=Result+‘]‘; {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; function TJSONArray.NewEnumerator: IJSONEnumerator; begin Result:=TJSONArrayEnumerator.Create(Self); end; { TJSONArrayEnumerator } constructor TJSONArrayEnumerator.Create(const Data: IJSONArray); begin inherited Create; FData:=Data; FMax:=FData.Count; if FMax=0 then FIndex:=0 else FIndex:=-1;//see Next; end; destructor TJSONArrayEnumerator.Destroy; begin FData:=nil; inherited; end; function TJSONArrayEnumerator.EOF: boolean; begin Result:=not(FIndex<FMax); end; function TJSONArrayEnumerator.Get_Key: WideString; begin Result:=IntToStr(FIndex); end; function TJSONArrayEnumerator.Get_Value: Variant; begin Result:=FData[FIndex]; end; function TJSONArrayEnumerator.Next: boolean; begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FLock); try {$ENDIF} inc(FIndex); Result:=FIndex<FMax; {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; procedure TJSONArrayEnumerator.Set_Value(const Value: Variant); begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FLock); try {$ENDIF} FData[FIndex]:=Value; {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; function TJSONArrayEnumerator.v0: pointer; begin Result:=FData.v0(FIndex); end; { TJSONDocArray } constructor TJSONDocArray.Create; begin inherited Create; FItemsCount:=0; FItemsSize:=0; end; destructor TJSONDocArray.Destroy; begin SetLength(FItems,0); inherited; end; function TJSONDocArray.Get_Item(Index: integer): Variant; begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FLock); try {$ENDIF} if (Index<0) or (Index>=FItemsCount) then raise ERangeError.Create(‘Index out of range‘); //parse from string here assuming this won‘t be needed much if FItems[Index]=‘null‘ then Result:=Null else Result:=JSON(FItems[Index]); {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; function TJSONDocArray.v0(Index: integer): pointer; begin {$IFDEF JSONDOC_THREADSAFE} Result:=nil;//counter warning EnterCriticalSection(FLock); try {$ENDIF} if FCurrentIndex<>Index then begin if (Index<0) or (Index>=FItemsCount) then raise ERangeError.Create(‘Index out of range‘); //parse from string here assuming this won‘t be needed much if FItems[Index]=‘null‘ then FCurrent:=Null else FCurrent:=JSON(FItems[Index]); FCurrentIndex:=Index; end; Result:=@FCurrent; {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; procedure TJSONDocArray.Set_Item(Index: integer; const Value: Variant); var d:IJSONDocument; begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FLock); try {$ENDIF} if (Index<0) or (Index>=FItemsCount) then raise ERangeError.Create(‘Index out of range‘); case TVarData(Value).VType of varNull: FItems[Index]:=‘null‘; varUnknown: if (TVarData(Value).VUnknown<>nil) and (IUnknown(Value).QueryInterface(IID_IJSONDocument,d)=S_OK) then FItems[Index]:=d.ToString else raise EJSONEncodeException.Create( ‘JSONDocArray.Set_Item requires IJSONDocument instances‘); else raise EJSONEncodeException.Create( ‘JSONDocArray.Set_Item requires IJSONDocument instances‘); end; {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; function TJSONDocArray.Count: integer; begin Result:=FItemsCount; end; procedure TJSONDocArray.Clear; var i:integer; begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FLock); try {$ENDIF} for i:=0 to FItemsCount-1 do FItems[i]:=‘‘; FItemsCount:=0; {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; function TJSONDocArray.Add(const Doc: IJSONDocument): integer; begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FLock); try {$ENDIF} if FItemsCount=FItemsSize then begin inc(FItemsSize,$400);//grow SetLength(FItems,FItemsSize); end; //ToString here to save on persisting effort later if Doc=nil then FItems[FItemsCount]:=‘null‘ else FItems[FItemsCount]:=Doc.ToString; Result:=FItemsCount; inc(FItemsCount); {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; function TJSONDocArray.AddJSON(const Data: WideString): integer; begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FLock); try {$ENDIF} if FItemsCount=FItemsSize then begin inc(FItemsSize,$400);//grow SetLength(FItems,FItemsSize); end; //TODO: check valid JSON? FItems[FItemsCount]:=Data; Result:=FItemsCount; inc(FItemsCount); {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; procedure TJSONDocArray.LoadItem(Index: integer; const Doc: IJSONDocument); begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FLock); try {$ENDIF} if (Index<0) or (Index>=FItemsCount) then raise ERangeError.Create(‘Index out of range‘); Doc.Clear; if FItems[Index]<>‘null‘ then Doc.Parse(FItems[Index]); //else? {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; function TJSONDocArray.GetJSON(Index: integer): WideString; stdcall; begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FLock); try {$ENDIF} if (Index<0) or (Index>=FItemsCount) then raise ERangeError.Create(‘Index out of range‘); Result:=FItems[Index]; //else? {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; function TJSONDocArray.JSONToString: WideString; var i,x,l:integer; begin {$IFDEF JSONDOC_THREADSAFE} EnterCriticalSection(FLock); try {$ENDIF} if FItemsCount=0 then Result:=‘[]‘ else begin l:=FItemsCount+1; for i:=0 to FItemsCount-1 do inc(l,Length(FItems[i])); SetLength(Result,l); i:=0; x:=1; while i<FItemsCount do begin Result[x]:=‘,‘; inc(x); l:=Length(FItems[i]); Move(FItems[i][1],Result[x],l*2); inc(x,l); inc(i); end; Result[1]:=‘[‘; Result[x]:=‘]‘; end; {$IFDEF JSONDOC_THREADSAFE} finally LeaveCriticalSection(FLock); end; {$ENDIF} end; { JSON } function JSON:IJSONDocument; //overload; begin Result:=TJSONDocument.Create as IJSONDocument; end; function JSON(const x:array of Variant):IJSONDocument; //overload; var i,l,si,sl:integer; s:array of TJSONDocument; d:TJSONDocument; key:WideString; begin d:=TJSONDocument.Create; si:=0; sl:=0; i:=0; l:=Length(x); while i<l do begin key:=VarToWideStr(x[i]); inc(i); if (key<>‘‘) and (key[1]=‘}‘) then begin while (key<>‘‘) and (key[1]=‘}‘) do begin //pop from stack if si=0 then raise EJSONException.Create(‘JSON builder: closing more embedded documents than opened #‘+IntToStr(i)) else begin dec(si); d:=s[si]; s[si]:=nil; end; key:=Copy(key,2,Length(key)-1); end; if key<>‘‘ then raise EJSONException.Create(‘JSON builder: "}" not allowed as key prefix #‘+IntToStr(i)); end else if (key<>‘‘) and (key[Length(key)]=‘{‘) then begin //push on stack if si=sl then begin inc(sl,8);//growstep SetLength(s,sl); end; s[si]:=d; d:=TJSONDocument.Create; s[si][Copy(key,1,Length(key)-1)]:=d as IJSONDocument; inc(si); end else if i=l then raise EJSONException.Create(‘JSON builder: last key is missing value‘) else begin d[key]:=x[i]; inc(i); end; end; //any left open? if si=0 then Result:=d else Result:=s[si-1]; end; function JSON(const x: Variant): IJSONDocument; overload; begin case TVarData(x).VType of varNull,varEmpty:Result:=nil;//raise? varOleStr,varString,$0102: begin Result:=TJSONDocument.Create as IJSONDocument; Result.Parse(VarToWideStr(x)); end; else Result:=IUnknown(x) as IJSONDocument; end; end; function JSONEnum(const x: IJSONDocument): IJSONEnumerator; var je:IJSONEnumerable; begin if x=nil then Result:=TJSONEnumerator.Create(nil) else //Result:=(x as IJSONEnumerable).NewEnumerator; if x.QueryInterface(IID_IJSONEnumerable,je)=S_OK then Result:=je.NewEnumerator else raise EJSONException.Create(‘IJSONDocument instance doesn‘‘t implement IJSONEnumerable‘); end; function JSONEnum(const x: Variant): IJSONEnumerator; var vt:TVarType; e:IJSONEnumerable; begin vt:=TVarData(x).VType; if (vt and varArray)=0 then case vt of varNull,varEmpty: Result:=TJSONEnumerator.Create(nil);//has .EOF=true varUnknown: if (TVarData(x).VUnknown<>nil) and (IUnknown(x).QueryInterface(IID_IJSONEnumerable,e)=S_OK) then Result:=e.NewEnumerator else raise EJSONException.Create(‘No supported interface found on object‘); else raise EJSONException.Create(‘Unsupported variant type ‘+IntToHex(vt,4)); end else Result:=TVarArrayEnumerator.Create(@x); end; function JSON(const x: IJSONEnumerator): IJSONDocument; begin Result:=IUnknown(x.Value) as IJSONDocument; end; function JSONEnum(const x: IJSONEnumerator): IJSONEnumerator; begin if (x=nil) or VarIsNull(x.Value) then Result:=TJSONEnumerator.Create(nil) else Result:=(IUnknown(x.Value) as IJSONEnumerable).NewEnumerator; end; function ja(const Items:array of Variant): IJSONArray; var a:TJSONArray; i,l:integer; begin l:=Length(Items); a:=TJSONArray.Create(l); i:=0; while i<>l do begin a.FData[i]:=Items[i]; inc(i); end; Result:=a; end; function ja(const Item:Variant): IJSONArray; begin if (TVarData(Item).VType=varUnknown) and (TVarData(Item).VUnknown<>nil) and (IUnknown(Item).QueryInterface(IID_IJSONArray,Result)=S_OK) then //ok! else if (TVarData(Item).VType and varArray)<>0 then Result:=TVarJSONArray.Create(Item) else raise EJSONException.Create(‘Variant is not IJSONArray‘); end; function JSONDocArray: IJSONDocArray; begin Result:=TJSONDocArray.Create; end; function JSONDocArray(const Items:array of IJSONDocument): IJSONDocArray; var i:integer; begin Result:=TJSONDocArray.Create; for i:=0 to Length(Items)-1 do Result.Add(Items[i]); end; initialization {$IFDEF JSONDOC_DEFAULT_USE_IJSONARRAY} JSON_UseIJSONArray:=true; //default, see TJSONDocument.Create {$ELSE} JSON_UseIJSONArray:=false; //default, see TJSONDocument.Create {$ENDIF} end.
原文:https://www.cnblogs.com/hnxxcxg/p/13634001.html