fpjson.pp 100 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094
  1. {
  2. This file is part of the Free Component Library
  3. JSON Data structures
  4. Copyright (c) 2007 by Michael Van Canneyt [email protected]
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. {$mode objfpc}
  12. {$h+}
  13. unit fpjson;
  14. interface
  15. uses
  16. {$IFNDEF PAS2JS}
  17. variants,
  18. {$ENDIF}
  19. {$IFDEF PAS2JS}
  20. JS, RTLConsts, Types,
  21. {$ENDIF}
  22. SysUtils,
  23. classes,
  24. contnrs;
  25. type
  26. TJSONtype = (jtUnknown, jtNumber, jtString, jtBoolean, jtNull, jtArray, jtObject);
  27. TJSONInstanceType = (
  28. jitUnknown,
  29. jitNumberInteger,
  30. {$IFNDEF PAS2JS}
  31. jitNumberInt64,
  32. jitNumberQWord,
  33. {$ELSE}
  34. jitNumberNativeInt,
  35. {$ENDIF}
  36. jitNumberFloat,
  37. jitString,
  38. jitBoolean,
  39. jitNull,
  40. jitArray,
  41. jitObject);
  42. TJSONFloat = Double;
  43. TJSONStringType = {$IFNDEF PAS2JS}UTF8String{$else}string{$ENDIF};
  44. TJSONUnicodeStringType = Unicodestring;
  45. {$IFNDEF PAS2JS}
  46. TJSONCharType = AnsiChar;
  47. PJSONCharType = ^TJSONCharType;
  48. TJSONVariant = variant;
  49. TFPJSStream = TMemoryStream;
  50. TJSONLargeInt = Int64;
  51. {$else}
  52. TJSONCharType = char;
  53. TJSONVariant = jsvalue;
  54. TFPJSStream = TJSArray;
  55. TJSONLargeInt = NativeInt;
  56. {$ENDIF}
  57. TFormatOption = (foSingleLineArray, // Array without CR/LF : all on one line
  58. foSingleLineObject, // Object without CR/LF : all on one line
  59. foDoNotQuoteMembers, // Do not quote object member names.
  60. foUseTabchar, // Use tab characters instead of spaces.
  61. foSkipWhiteSpace, // Do not use whitespace at all
  62. foSkipWhiteSpaceOnlyLeading // When foSkipWhiteSpace is active, skip whitespace for object members only before :
  63. );
  64. TFormatOptions = set of TFormatOption;
  65. Const
  66. DefaultIndentSize = 2;
  67. DefaultFormat = [];
  68. AsJSONFormat = [foSingleLineArray,foSingleLineObject]; // These options make FormatJSON behave as AsJSON
  69. AsCompressedJSON = [foSingleLineArray,foSingleLineObject,foskipWhiteSpace]; // These options make FormatJSON behave as AsJSON with TJSONData.CompressedJSON=True
  70. AsCompactJSON = [foSingleLineArray,foSingleLineObject,foskipWhiteSpace,foDoNotQuoteMembers]; // These options make FormatJSON behave as AsJSON with TJSONData.CompressedJSON=True and TJSONObject.UnquotedMemberNames=True
  71. ValueJSONTypes = [jtNumber, jtString, jtBoolean, jtNull];
  72. ActualValueJSONTypes = ValueJSONTypes - [jtNull];
  73. StructuredJSONTypes = [jtArray,jtObject];
  74. {$IFDEF PAS2JS}
  75. jitNumberLargeInt = jitNumberNativeInt;
  76. {$ELSE}
  77. jitNumberLargeInt = jitNumberInt64;
  78. {$ENDIF}
  79. Type
  80. TJSONData = Class;
  81. { TBaseJSONEnumerator }
  82. TJSONEnum = Record
  83. Key : TJSONStringType;
  84. KeyNum : Integer;
  85. Value : TJSONData;
  86. end;
  87. TBaseJSONEnumerator = class
  88. public
  89. function GetCurrent: TJSONEnum; virtual; abstract;
  90. function MoveNext : Boolean; virtual; abstract;
  91. property Current: TJSONEnum read GetCurrent;
  92. end;
  93. { TJSONData }
  94. TJSONData = class(TObject)
  95. private
  96. Const
  97. ElementSeps : Array[Boolean] of TJSONStringType = (', ',',');
  98. Class Var FCompressedJSON : Boolean;
  99. Class Var FElementSep : TJSONStringType;
  100. class procedure DetermineElementSeparators;
  101. class function GetCompressedJSON: Boolean; {$IFNDEF PAS2JS}static;{$ENDIF}
  102. class procedure SetCompressedJSON(AValue: Boolean); {$IFNDEF PAS2JS}static;{$ENDIF}
  103. protected
  104. Class Procedure DoError(Const Msg : String);
  105. Class Procedure DoError(Const Fmt : String; const Args : Array of Const);
  106. Function DoFindPath(Const APath : TJSONStringType; Out NotFound : TJSONStringType) : TJSONdata; virtual;
  107. function GetAsBoolean: Boolean; virtual; abstract;
  108. function GetAsFloat: TJSONFloat; virtual; abstract;
  109. function GetAsInteger: Integer; virtual; abstract;
  110. function GetIsNull: Boolean; virtual;
  111. {$IFNDEF PAS2JS}
  112. function GetAsInt64: Int64; virtual; abstract;
  113. function GetAsQWord: QWord; virtual; abstract;
  114. function GetAsUnicodeString: TJSONUnicodeStringType; virtual;
  115. procedure SetAsInt64(const AValue: Int64); virtual; abstract;
  116. procedure SetAsQword(const AValue: QWord); virtual; abstract;
  117. procedure SetAsUnicodeString(const AValue: TJSONUnicodeStringType); virtual;
  118. {$ELSE}
  119. function GetAsNativeInt: NativeInt; virtual; abstract;
  120. procedure SetAsNativeInt(const AValue: NativeInt); virtual; abstract;
  121. {$ENDIF}
  122. procedure SetAsBoolean(const AValue: Boolean); virtual; abstract;
  123. procedure SetAsFloat(const AValue: TJSONFloat); virtual; abstract;
  124. procedure SetAsInteger(const AValue: Integer); virtual; abstract;
  125. function GetAsJSON: TJSONStringType; virtual; abstract;
  126. function GetAsString: TJSONStringType; virtual; abstract;
  127. procedure SetAsString(const AValue: TJSONStringType); virtual; abstract;
  128. function GetValue: TJSONVariant; virtual; abstract;
  129. procedure SetValue(const AValue: TJSONVariant); virtual; abstract;
  130. function GetItem(Index : Integer): TJSONData; virtual;
  131. procedure SetItem(Index : Integer; const AValue: TJSONData); virtual;
  132. Function DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; virtual;
  133. function GetCount: Integer; virtual;
  134. Public
  135. Class function JSONType: TJSONType; virtual;
  136. Class Property CompressedJSON : Boolean Read GetCompressedJSON Write SetCompressedJSON;
  137. public
  138. Constructor Create; virtual;
  139. Procedure Clear; virtual; Abstract;
  140. Procedure DumpJSON(S : TFPJSStream);
  141. // Get enumerator
  142. function GetEnumerator: TBaseJSONEnumerator; virtual;
  143. Function FindPath(Const APath : TJSONStringType) : TJSONdata;
  144. Function GetPath(Const APath : TJSONStringType) : TJSONdata;
  145. Function Clone : TJSONData; virtual; abstract;
  146. Function FormatJSON(Options : TFormatOptions = DefaultFormat; Indentsize : Integer = DefaultIndentSize) : TJSONStringType;
  147. property Count: Integer read GetCount;
  148. property Items[Index: Integer]: TJSONData read GetItem write SetItem;
  149. property Value: TJSONVariant read GetValue write SetValue;
  150. Property AsString : TJSONStringType Read GetAsString Write SetAsString;
  151. {$IFNDEF PAS2JS}
  152. Property AsUnicodeString : TJSONUnicodeStringType Read GetAsUnicodeString Write SetAsUnicodeString;
  153. Property AsInt64 : Int64 Read GetAsInt64 Write SetAsInt64;
  154. Property AsQWord : QWord Read GetAsQWord Write SetAsQword;
  155. Property AsLargeInt : TJSONLargeInt Read GetAsInt64 Write SetAsInt64;
  156. {$ELSE}
  157. Property AsNativeInt : NativeInt Read GetAsNativeInt Write SetAsNativeInt;
  158. Property AsLargeInt : TJSONLargeInt Read GetAsNativeInt Write SetAsNativeInt;
  159. {$ENDIF}
  160. Property AsFloat : TJSONFloat Read GetAsFloat Write SetAsFloat;
  161. Property AsInteger : Integer Read GetAsInteger Write SetAsInteger;
  162. Property AsBoolean : Boolean Read GetAsBoolean Write SetAsBoolean;
  163. Property IsNull : Boolean Read GetIsNull;
  164. Property AsJSON : TJSONStringType Read GetAsJSON;
  165. end;
  166. TJSONDataClass = Class of TJSONData;
  167. TJSONNumberType = (
  168. ntFloat,
  169. ntInteger
  170. {$IFNDEF PAS2JS}
  171. ,ntInt64
  172. ,ntQWord
  173. {$else}
  174. ,ntNativeInt
  175. {$ENDIF}
  176. );
  177. TJSONNumber = class(TJSONData)
  178. protected
  179. public
  180. class function JSONType: TJSONType; override;
  181. class function NumberType : TJSONNumberType; virtual; abstract;
  182. end;
  183. { TJSONFloatNumber }
  184. TJSONFloatNumber = class(TJSONNumber)
  185. Private
  186. FValue : TJSONFloat;
  187. protected
  188. function GetAsBoolean: Boolean; override;
  189. function GetAsFloat: TJSONFloat; override;
  190. function GetAsInteger: Integer; override;
  191. function GetAsJSON: TJSONStringType; override;
  192. function GetAsString: TJSONStringType; override;
  193. function GetValue: TJSONVariant; override;
  194. {$IFNDEF PAS2JS}
  195. function GetAsInt64: Int64; override;
  196. function GetAsQWord: QWord; override;
  197. procedure SetAsInt64(const AValue: Int64); override;
  198. procedure SetAsQword(const AValue: QWord); override;
  199. {$ELSE}
  200. function GetAsNativeInt: NativeInt; override;
  201. procedure SetAsNativeInt(const AValue: NativeInt); override;
  202. {$ENDIF}
  203. procedure SetAsBoolean(const AValue: Boolean); override;
  204. procedure SetAsFloat(const AValue: TJSONFloat); override;
  205. procedure SetAsInteger(const AValue: Integer); override;
  206. procedure SetAsString(const AValue: TJSONStringType); override;
  207. procedure SetValue(const AValue: TJSONVariant); override;
  208. public
  209. Constructor Create(AValue : TJSONFloat); reintroduce;
  210. class function NumberType : TJSONNumberType; override;
  211. Procedure Clear; override;
  212. Function Clone : TJSONData; override;
  213. end;
  214. TJSONFloatNumberClass = Class of TJSONFloatNumber;
  215. { TJSONIntegerNumber }
  216. TJSONIntegerNumber = class(TJSONNumber)
  217. Private
  218. FValue : Integer;
  219. protected
  220. function GetAsBoolean: Boolean; override;
  221. function GetAsFloat: TJSONFloat; override;
  222. function GetAsInteger: Integer; override;
  223. {$IFNDEF PAS2JS}
  224. function GetAsInt64: Int64; override;
  225. function GetAsQWord: QWord; override;
  226. procedure SetAsInt64(const AValue: Int64); override;
  227. procedure SetAsQword(const AValue: QWord); override;
  228. {$ELSE}
  229. function GetAsNativeInt: NativeInt; override;
  230. procedure SetAsNativeInt(const AValue: NativeInt); override;
  231. {$ENDIF}
  232. procedure SetAsBoolean(const AValue: Boolean); override;
  233. procedure SetAsFloat(const AValue: TJSONFloat); override;
  234. procedure SetAsInteger(const AValue: Integer); override;
  235. function GetAsJSON: TJSONStringType; override;
  236. function GetAsString: TJSONStringType; override;
  237. procedure SetAsString(const AValue: TJSONStringType); override;
  238. function GetValue: TJSONVariant; override;
  239. procedure SetValue(const AValue: TJSONVariant); override;
  240. public
  241. Constructor Create(AValue : Integer); reintroduce;
  242. class function NumberType : TJSONNumberType; override;
  243. Procedure Clear; override;
  244. Function Clone : TJSONData; override;
  245. end;
  246. TJSONIntegerNumberClass = Class of TJSONIntegerNumber;
  247. {$IFNDEF PAS2JS}
  248. { TJSONInt64Number }
  249. TJSONInt64Number = class(TJSONNumber)
  250. Private
  251. FValue : Int64;
  252. protected
  253. function GetAsBoolean: Boolean; override;
  254. function GetAsFloat: TJSONFloat; override;
  255. function GetAsInteger: Integer; override;
  256. function GetAsInt64: Int64; override;
  257. function GetAsQWord: QWord; override;
  258. procedure SetAsBoolean(const AValue: Boolean); override;
  259. procedure SetAsFloat(const AValue: TJSONFloat); override;
  260. procedure SetAsInteger(const AValue: Integer); override;
  261. procedure SetAsInt64(const AValue: Int64); override;
  262. procedure SetAsQword(const AValue: QWord); override;
  263. function GetAsJSON: TJSONStringType; override;
  264. function GetAsString: TJSONStringType; override;
  265. procedure SetAsString(const AValue: TJSONStringType); override;
  266. function GetValue: TJSONVariant; override;
  267. procedure SetValue(const AValue: TJSONVariant); override;
  268. public
  269. Constructor Create(AValue : Int64); reintroduce;
  270. class function NumberType : TJSONNumberType; override;
  271. Procedure Clear; override;
  272. Function Clone : TJSONData; override;
  273. end;
  274. TJSONInt64NumberClass = Class of TJSONInt64Number;
  275. TJSONLargeIntNumber = TJSONInt64Number;
  276. TJSONLargeIntNumberClass = TJSONInt64NumberClass;
  277. {$ELSE}
  278. { TJSONNativeIntNumber }
  279. TJSONNativeIntNumber = class(TJSONNumber)
  280. Private
  281. FValue : NativeInt;
  282. protected
  283. function GetAsBoolean: Boolean; override;
  284. function GetAsFloat: TJSONFloat; override;
  285. function GetAsInteger: Integer; override;
  286. function GetAsNativeInt: NativeInt; override;
  287. procedure SetAsBoolean(const AValue: Boolean); override;
  288. procedure SetAsFloat(const AValue: TJSONFloat); override;
  289. procedure SetAsInteger(const AValue: Integer); override;
  290. procedure SetAsNativeInt(const AValue: NativeInt); override;
  291. function GetAsJSON: TJSONStringType; override;
  292. function GetAsString: TJSONStringType; override;
  293. procedure SetAsString(const AValue: TJSONStringType); override;
  294. function GetValue: TJSONVariant; override;
  295. procedure SetValue(const AValue: TJSONVariant); override;
  296. public
  297. Constructor Create(AValue : NativeInt); reintroduce;
  298. class function NumberType : TJSONNumberType; override;
  299. Procedure Clear; override;
  300. Function Clone : TJSONData; override;
  301. end;
  302. TJSONNativeIntNumberClass = Class of TJSONNativeIntNumber;
  303. TJSONLargeIntNumber = TJSONNativeIntNumber;
  304. TJSONLargeIntNumberClass = TJSONNativeIntNumberClass;
  305. {$ENDIF}
  306. {$IFNDEF PAS2JS}
  307. { TJSONQWordNumber }
  308. TJSONQWordNumber = class(TJSONNumber)
  309. Private
  310. FValue : Qword;
  311. protected
  312. function GetAsBoolean: Boolean; override;
  313. function GetAsFloat: TJSONFloat; override;
  314. function GetAsInteger: Integer; override;
  315. function GetAsInt64: Int64; override;
  316. function GetAsQWord: QWord; override;
  317. procedure SetAsBoolean(const AValue: Boolean); override;
  318. procedure SetAsFloat(const AValue: TJSONFloat); override;
  319. procedure SetAsInteger(const AValue: Integer); override;
  320. procedure SetAsInt64(const AValue: Int64); override;
  321. procedure SetAsQword(const AValue: QWord); override;
  322. function GetAsJSON: TJSONStringType; override;
  323. function GetAsString: TJSONStringType; override;
  324. procedure SetAsString(const AValue: TJSONStringType); override;
  325. function GetValue: TJSONVariant; override;
  326. procedure SetValue(const AValue: TJSONVariant); override;
  327. public
  328. Constructor Create(AValue : QWord); reintroduce;
  329. class function NumberType : TJSONNumberType; override;
  330. Procedure Clear; override;
  331. Function Clone : TJSONData; override;
  332. end;
  333. TJSONQWordNumberClass = Class of TJSONQWordNumber;
  334. {$ENDIF}
  335. { TJSONString }
  336. TJSONString = class(TJSONData)
  337. Private
  338. FValue: TJSONStringType;
  339. protected
  340. function GetValue: TJSONVariant; override;
  341. procedure SetValue(const AValue: TJSONVariant); override;
  342. function GetAsBoolean: Boolean; override;
  343. function GetAsFloat: TJSONFloat; override;
  344. function GetAsInteger: Integer; override;
  345. {$IFNDEF PAS2JS}
  346. function GetAsInt64: Int64; override;
  347. function GetAsQWord: QWord; override;
  348. procedure SetAsInt64(const AValue: Int64); override;
  349. procedure SetAsQword(const AValue: QWord); override;
  350. {$ELSE}
  351. function GetAsNativeInt: NativeInt; override;
  352. procedure SetAsNativeInt(const AValue: NativeInt); override;
  353. {$ENDIF}
  354. procedure SetAsBoolean(const AValue: Boolean); override;
  355. procedure SetAsFloat(const AValue: TJSONFloat); override;
  356. procedure SetAsInteger(const AValue: Integer); override;
  357. function GetAsJSON: TJSONStringType; override;
  358. function GetAsString: TJSONStringType; override;
  359. procedure SetAsString(const AValue: TJSONStringType); override;
  360. Public
  361. Class var StrictEscaping : Boolean;
  362. public
  363. Constructor Create(const AValue : TJSONStringType); reintroduce;
  364. {$IFNDEF PAS2JS}
  365. Constructor Create(const AValue : TJSONUnicodeStringType); reintroduce;
  366. {$ENDIF}
  367. class function JSONType: TJSONType; override;
  368. Procedure Clear; override;
  369. Function Clone : TJSONData; override;
  370. end;
  371. TJSONStringClass = Class of TJSONString;
  372. { TJSONBoolean }
  373. TJSONBoolean = class(TJSONData)
  374. Private
  375. FValue: Boolean;
  376. protected
  377. function GetValue: TJSONVariant; override;
  378. procedure SetValue(const AValue: TJSONVariant); override;
  379. function GetAsBoolean: Boolean; override;
  380. function GetAsFloat: TJSONFloat; override;
  381. function GetAsInteger: Integer; override;
  382. {$IFNDEF PAS2JS}
  383. function GetAsInt64: Int64; override;
  384. function GetAsQWord: QWord; override;
  385. procedure SetAsInt64(const AValue: Int64); override;
  386. procedure SetAsQword(const AValue: QWord); override;
  387. {$ELSE}
  388. function GetAsNativeInt: NativeInt; override;
  389. procedure SetAsNativeInt(const AValue: NativeInt); override;
  390. {$ENDIF}
  391. procedure SetAsBoolean(const AValue: Boolean); override;
  392. procedure SetAsFloat(const AValue: TJSONFloat); override;
  393. procedure SetAsInteger(const AValue: Integer); override;
  394. function GetAsJSON: TJSONStringType; override;
  395. function GetAsString: TJSONStringType; override;
  396. procedure SetAsString(const AValue: TJSONStringType); override;
  397. public
  398. Constructor Create(AValue : Boolean); reintroduce;
  399. class function JSONType: TJSONType; override;
  400. Procedure Clear; override;
  401. Function Clone : TJSONData; override;
  402. end;
  403. TJSONBooleanClass = Class of TJSONBoolean;
  404. { TJSONnull }
  405. TJSONNull = class(TJSONData)
  406. protected
  407. Procedure Converterror(From : Boolean);
  408. function GetAsBoolean: Boolean; override;
  409. function GetAsFloat: TJSONFloat; override;
  410. function GetAsInteger: Integer; override;
  411. function GetIsNull: Boolean; override;
  412. function GetAsJSON: TJSONStringType; override;
  413. function GetAsString: TJSONStringType; override;
  414. function GetValue: TJSONVariant; override;
  415. {$IFNDEF PAS2JS}
  416. function GetAsInt64: Int64; override;
  417. function GetAsQWord: QWord; override;
  418. procedure SetAsInt64(const AValue: Int64); override;
  419. procedure SetAsQword(const AValue: QWord); override;
  420. {$ELSE}
  421. function GetAsNativeInt: NativeInt; override;
  422. procedure SetAsNativeInt(const AValue: NativeInt); override;
  423. {$ENDIF}
  424. procedure SetAsBoolean(const AValue: Boolean); override;
  425. procedure SetAsFloat(const AValue: TJSONFloat); override;
  426. procedure SetAsInteger(const AValue: Integer); override;
  427. procedure SetAsString(const AValue: TJSONStringType); override;
  428. procedure SetValue(const AValue: TJSONVariant); override;
  429. public
  430. class function JSONType: TJSONType; override;
  431. Procedure Clear; override;
  432. Function Clone : TJSONData; override;
  433. end;
  434. TJSONNullClass = Class of TJSONNull;
  435. TJSONArrayIterator = procedure(Item: TJSONData; Data: TObject; var Continue: Boolean) of object;
  436. { TJSONArray }
  437. TJSONObject = Class;
  438. TJSONArray = class(TJSONData)
  439. Private
  440. FList : TFPObjectList;
  441. function GetArrays(Index : Integer): TJSONArray;
  442. function GetBooleans(Index : Integer): Boolean;
  443. function GetFloats(Index : Integer): TJSONFloat;
  444. function GetIntegers(Index : Integer): Integer;
  445. function GetNulls(Index : Integer): Boolean;
  446. function GetObjects(Index : Integer): TJSONObject;
  447. function GetStrings(Index : Integer): TJSONStringType;
  448. function GetTypes(Index : Integer): TJSONType;
  449. {$IFNDEF PAS2JS}
  450. function GetInt64s(Index : Integer): Int64;
  451. function GetQWords(Index : Integer): QWord;
  452. function GetUnicodeStrings(Index : Integer): TJSONUnicodeStringType;
  453. procedure SetInt64s(Index : Integer; const AValue: Int64);
  454. procedure SetQWords(Index : Integer; AValue: QWord);
  455. procedure SetUnicodeStrings(Index : Integer; const AValue: TJSONUnicodeStringType);
  456. {$ELSE}
  457. function GetNativeInts(Index : Integer): NativeInt;
  458. procedure SetNativeInts(Index : Integer; AValue: NativeInt);
  459. {$ENDIF}
  460. procedure SetArrays(Index : Integer; const AValue: TJSONArray);
  461. procedure SetBooleans(Index : Integer; const AValue: Boolean);
  462. procedure SetFloats(Index : Integer; const AValue: TJSONFloat);
  463. procedure SetIntegers(Index : Integer; const AValue: Integer);
  464. procedure SetObjects(Index : Integer; const AValue: TJSONObject);
  465. procedure SetStrings(Index : Integer; const AValue: TJSONStringType);
  466. protected
  467. Function DoFindPath(Const APath : TJSONStringType; Out NotFound : TJSONStringType) : TJSONdata; override;
  468. Procedure Converterror(From : Boolean);
  469. function GetAsBoolean: Boolean; override;
  470. function GetAsFloat: TJSONFloat; override;
  471. function GetAsInteger: Integer; override;
  472. {$IFNDEF PAS2JS}
  473. function GetAsInt64: Int64; override;
  474. function GetAsQWord: QWord; override;
  475. procedure SetAsInt64(const AValue: Int64); override;
  476. procedure SetAsQword(const AValue: QWord); override;
  477. {$ELSE}
  478. function GetAsNativeInt: NativeInt; override;
  479. procedure SetAsNativeInt(const AValue: NativeInt); override;
  480. {$ENDIF}
  481. procedure SetAsBoolean(const AValue: Boolean); override;
  482. procedure SetAsFloat(const AValue: TJSONFloat); override;
  483. procedure SetAsInteger(const AValue: Integer); override;
  484. function GetAsJSON: TJSONStringType; override;
  485. function GetAsString: TJSONStringType; override;
  486. procedure SetAsString(const AValue: TJSONStringType); override;
  487. function GetValue: TJSONVariant; override;
  488. procedure SetValue(const AValue: TJSONVariant); override;
  489. function GetCount: Integer; override;
  490. function GetItem(Index : Integer): TJSONData; override;
  491. procedure SetItem(Index : Integer; const AValue: TJSONData); override;
  492. Function DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; override;
  493. public
  494. Constructor Create; overload; reintroduce;
  495. Constructor Create(const Elements : Array of {$IFDEF PAS2JS}jsvalue{$else}Const{$ENDIF}); overload;
  496. Destructor Destroy; override;
  497. class function JSONType: TJSONType; override;
  498. Function Clone : TJSONData; override;
  499. // Examine
  500. procedure Iterate(Iterator : TJSONArrayIterator; Data: TObject);
  501. function IndexOf(obj: TJSONData): Integer;
  502. function GetEnumerator: TBaseJSONEnumerator; override;
  503. // Manipulate
  504. Procedure Clear; override;
  505. function Add(Item : TJSONData): Integer;
  506. function Add(I : Integer): Integer;
  507. {$IFNDEF PAS2JS}
  508. function Add(I : Int64): Int64;
  509. function Add(I : QWord): QWord;
  510. function Add(const S : UnicodeString): Integer;
  511. {$ELSE}
  512. function Add(I : NativeInt): Integer;
  513. {$ENDIF}
  514. function Add(const S : String): Integer;
  515. function Add: Integer;
  516. function Add(F : TJSONFloat): Integer;
  517. function Add(B : Boolean): Integer;
  518. function Add(AnArray : TJSONArray): Integer;
  519. function Add(AnObject: TJSONObject): Integer;
  520. Procedure Delete(Index : Integer);
  521. procedure Exchange(Index1, Index2: Integer);
  522. function Extract(Item: TJSONData): TJSONData;
  523. function Extract(Index : Integer): TJSONData;
  524. procedure Insert(Index: Integer);
  525. procedure Insert(Index: Integer; Item : TJSONData);
  526. procedure Insert(Index: Integer; I : Integer);
  527. {$IFNDEF PAS2JS}
  528. procedure Insert(Index: Integer; I : Int64);
  529. procedure Insert(Index: Integer; I : QWord);
  530. procedure Insert(Index: Integer; const S : UnicodeString);
  531. {$ELSE}
  532. procedure Insert(Index: Integer; I : NativeInt);
  533. {$ENDIF}
  534. procedure Insert(Index: Integer; const S : String);
  535. procedure Insert(Index: Integer; F : TJSONFloat);
  536. procedure Insert(Index: Integer; B : Boolean);
  537. procedure Insert(Index: Integer; AnArray : TJSONArray);
  538. procedure Insert(Index: Integer; AnObject: TJSONObject);
  539. procedure Move(CurIndex, NewIndex: Integer);
  540. Procedure Remove(Item : TJSONData);
  541. Procedure Sort(Compare: TListSortCompare);
  542. // Easy Access Properties.
  543. property Items;default;
  544. Property Types[Index : Integer] : TJSONType Read GetTypes;
  545. Property Nulls[Index : Integer] : Boolean Read GetNulls;
  546. Property Integers[Index : Integer] : Integer Read GetIntegers Write SetIntegers;
  547. {$IFNDEF PAS2JS}
  548. Property Int64s[Index : Integer] : Int64 Read GetInt64s Write SetInt64s;
  549. Property LargeInts[Index : Integer] : TJSONLargeInt Read GetInt64s Write SetInt64s;
  550. Property QWords[Index : Integer] : QWord Read GetQWords Write SetQWords;
  551. Property UnicodeStrings[Index : Integer] : TJSONUnicodeStringType Read GetUnicodeStrings Write SetUnicodeStrings;
  552. {$ELSE}
  553. Property NativeInts[Index : Integer] : NativeInt Read GetNativeInts Write SetNativeInts;
  554. Property LargeInts[Index : Integer] : TJSONLargeInt Read GetNativeInts Write SetNativeInts;
  555. {$ENDIF}
  556. Property Strings[Index : Integer] : TJSONStringType Read GetStrings Write SetStrings;
  557. Property Floats[Index : Integer] : TJSONFloat Read GetFloats Write SetFloats;
  558. Property Booleans[Index : Integer] : Boolean Read GetBooleans Write SetBooleans;
  559. Property Arrays[Index : Integer] : TJSONArray Read GetArrays Write SetArrays;
  560. Property Objects[Index : Integer] : TJSONObject Read GetObjects Write SetObjects;
  561. end;
  562. TJSONArrayClass = Class of TJSONArray;
  563. TJSONObjectIterator = procedure(Const AName : TJSONStringType; Item: TJSONData; Data: TObject; var Continue: Boolean) of object;
  564. { TJSONObject }
  565. TJSONObject = class(TJSONData)
  566. private
  567. Const
  568. ElementStart : Array[Boolean] of TJSONStringType = ('"','');
  569. SpacedQuoted : Array[Boolean] of TJSONStringType = ('" : ',' : ');
  570. UnSpacedQuoted : Array[Boolean] of TJSONStringType = ('":',':');
  571. ObjStartSeps : Array[Boolean] of TJSONStringType = ('{ ','{');
  572. ObjEndSeps : Array[Boolean] of TJSONStringType = (' }','}');
  573. Class var FUnquotedMemberNames: Boolean;
  574. Class var FObjStartSep,FObjEndSep,FElementEnd,FElementStart : TJSONStringType;
  575. function DoAdd(const AName: TJSONStringType; AValue: TJSONData; FreeOnError: Boolean=True): Integer;
  576. Class procedure DetermineElementQuotes;
  577. Private
  578. {$IFDEF PAS2JS}
  579. FCount: integer;
  580. FHash: TJSObject;
  581. FNames: TStringDynArray;
  582. {$else}
  583. FHash : TFPHashObjectList; // Careful : Names limited to 255 chars.
  584. {$ENDIF}
  585. function GetArrays(const AName : String): TJSONArray;
  586. function GetBooleans(const AName : String): Boolean;
  587. function GetElements(const AName: string): TJSONData;
  588. function GetFloats(const AName : String): TJSONFloat;
  589. function GetIntegers(const AName : String): Integer;
  590. function GetIsNull(const AName : String): Boolean; reintroduce;
  591. function GetNameOf(Index : Integer): TJSONStringType;
  592. function GetObjects(const AName : String): TJSONObject;
  593. function GetStrings(const AName : String): TJSONStringType;
  594. function GetTypes(const AName : String): TJSONType;
  595. procedure SetArrays(const AName : String; const AValue: TJSONArray);
  596. procedure SetBooleans(const AName : String; const AValue: Boolean);
  597. procedure SetElements(const AName: string; const AValue: TJSONData);
  598. procedure SetFloats(const AName : String; const AValue: TJSONFloat);
  599. procedure SetIntegers(const AName : String; const AValue: Integer);
  600. {$IFNDEF PAS2JS}
  601. function GetInt64s(const AName : String): Int64;
  602. function GetUnicodeStrings(const AName : String): TJSONUnicodeStringType;
  603. function GetQWords(AName : String): QWord;
  604. procedure SetInt64s(const AName : String; const AValue: Int64);
  605. procedure SetQWords(AName : String; AValue: QWord);
  606. procedure SetUnicodeStrings(const AName : String; const AValue: TJSONUnicodeStringType);
  607. {$ELSE}
  608. function GetNativeInts(const AName : String): NativeInt;
  609. procedure SetNativeInts(const AName : String; const AValue: NativeInt);
  610. {$ENDIF}
  611. procedure SetIsNull(const AName : String; const AValue: Boolean);
  612. procedure SetObjects(const AName : String; const AValue: TJSONObject);
  613. procedure SetStrings(const AName : String; const AValue: TJSONStringType);
  614. class function GetUnquotedMemberNames: Boolean; {$IFNDEF PAS2JS}static;{$ENDIF}
  615. class procedure SetUnquotedMemberNames(AValue: Boolean); {$IFNDEF PAS2JS}static;{$ENDIF}
  616. protected
  617. Function DoFindPath(Const APath : TJSONStringType; Out NotFound : TJSONStringType) : TJSONdata; override;
  618. Procedure Converterror(From : Boolean);
  619. function GetAsBoolean: Boolean; override;
  620. function GetAsFloat: TJSONFloat; override;
  621. function GetAsInteger: Integer; override;
  622. {$IFNDEF PAS2JS}
  623. function GetAsInt64: Int64; override;
  624. function GetAsQWord: QWord; override;
  625. procedure SetAsInt64(const AValue: Int64); override;
  626. procedure SetAsQword(const AValue: QWord); override;
  627. {$ELSE}
  628. function GetAsNativeInt: NativeInt; override;
  629. procedure SetAsNativeInt(const AValue: NativeInt); override;
  630. {$ENDIF}
  631. procedure SetAsBoolean(const AValue: Boolean); override;
  632. procedure SetAsFloat(const AValue: TJSONFloat); override;
  633. procedure SetAsInteger(const AValue: Integer); override;
  634. function GetAsJSON: TJSONStringType; override;
  635. function GetAsString: TJSONStringType; override;
  636. procedure SetAsString(const AValue: TJSONStringType); override;
  637. function GetValue: TJSONVariant; override;
  638. procedure SetValue(const AValue: TJSONVariant); override;
  639. function GetCount: Integer; override;
  640. function GetItem(Index : Integer): TJSONData; override;
  641. procedure SetItem(Index : Integer; const AValue: TJSONData); override;
  642. Function DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; override;
  643. public
  644. constructor Create; reintroduce;
  645. Constructor Create(const Elements : Array of {$IFDEF PAS2JS}jsvalue{$else}Const{$ENDIF}); overload;
  646. destructor Destroy; override;
  647. class function JSONType: TJSONType; override;
  648. Class Property UnquotedMemberNames : Boolean Read GetUnquotedMemberNames Write SetUnquotedMemberNames;
  649. Function Clone : TJSONData; override;
  650. function GetEnumerator: TBaseJSONEnumerator; override;
  651. // Examine
  652. procedure Iterate(Iterator : TJSONObjectIterator; Data: TObject);
  653. function IndexOf(Item: TJSONData): Integer;
  654. Function IndexOfName(const AName: TJSONStringType; CaseInsensitive : Boolean = False): Integer;
  655. Function Find(Const AName : String) : TJSONData; overload;
  656. Function Find(Const AName : String; AType : TJSONType) : TJSONData; overload;
  657. function Find(const key: TJSONStringType; out AValue: TJSONData): boolean;
  658. function Find(const key: TJSONStringType; out AValue: TJSONObject): boolean;
  659. function Find(const key: TJSONStringType; out AValue: TJSONArray): boolean;
  660. function Find(const key: TJSONStringType; out AValue: TJSONString): boolean;
  661. function Find(const key: TJSONStringType; out AValue: TJSONBoolean): boolean;
  662. function Find(const key: TJSONStringType; out AValue: TJSONNumber): boolean;
  663. Function Get(Const AName : String) : TJSONVariant;
  664. Function Get(Const AName : String; ADefault : TJSONFloat) : TJSONFloat;
  665. Function Get(Const AName : String; ADefault : Integer) : Integer;
  666. {$IFNDEF PAS2JS}
  667. Function Get(Const AName : String; ADefault : Int64) : Int64;
  668. Function Get(Const AName : String; ADefault : QWord) : QWord;
  669. Function Get(Const AName : String; ADefault : TJSONUnicodeStringType) : TJSONUnicodeStringType;
  670. {$ENDIF}
  671. Function Get(Const AName : String; ADefault : Boolean) : Boolean;
  672. Function Get(Const AName : String; ADefault : TJSONStringType) : TJSONStringType;
  673. Function Get(Const AName : String; ADefault : TJSONArray) : TJSONArray;
  674. Function Get(Const AName : String; ADefault : TJSONObject) : TJSONObject;
  675. // Manipulate
  676. Procedure Clear; override;
  677. function Add(const AName: TJSONStringType; AValue: TJSONData): Integer; overload;
  678. function Add(const AName: TJSONStringType; AValue: Boolean): Integer; overload;
  679. function Add(const AName: TJSONStringType; AValue: TJSONFloat): Integer; overload;
  680. function Add(const AName, AValue: TJSONStringType): Integer; overload;
  681. {$IFNDEF PAS2JS}
  682. function Add(const AName : String; AValue: TJSONUnicodeStringType): Integer; overload;
  683. function Add(const AName: TJSONStringType; Avalue: Int64): Integer; overload;
  684. function Add(const AName: TJSONStringType; Avalue: QWord): Integer; overload;
  685. {$ELSE}
  686. function Add(const AName: TJSONStringType; Avalue: NativeInt): Integer; overload;
  687. {$ENDIF}
  688. function Add(const AName: TJSONStringType; Avalue: Integer): Integer; overload;
  689. function Add(const AName: TJSONStringType): Integer; overload;
  690. function Add(const AName: TJSONStringType; AValue : TJSONArray): Integer; overload;
  691. procedure Delete(Index : Integer);
  692. procedure Delete(Const AName : string);
  693. procedure Remove(Item : TJSONData);
  694. Function Extract(Index : Integer) : TJSONData;
  695. Function Extract(Const AName : string) : TJSONData;
  696. // Easy access properties.
  697. property Names[Index : Integer] : TJSONStringType read GetNameOf;
  698. property Elements[AName: string] : TJSONData read GetElements write SetElements; default;
  699. Property Types[AName : String] : TJSONType Read GetTypes;
  700. Property Nulls[AName : String] : Boolean Read GetIsNull Write SetIsNull;
  701. Property Floats[AName : String] : TJSONFloat Read GetFloats Write SetFloats;
  702. Property Integers[AName : String] : Integer Read GetIntegers Write SetIntegers;
  703. {$IFNDEF PAS2JS}
  704. Property Int64s[AName : String] : Int64 Read GetInt64s Write SetInt64s;
  705. Property QWords[AName : String] : QWord Read GetQWords Write SetQWords;
  706. Property LargeInts[AName : String] : TJSONLargeInt Read GetInt64s Write SetInt64s;
  707. Property UnicodeStrings[AName : String] : TJSONUnicodeStringType Read GetUnicodeStrings Write SetUnicodeStrings;
  708. {$ELSE}
  709. Property NativeInts[AName : String] : NativeInt Read GetNativeInts Write SetNativeInts;
  710. Property LargeInts[AName : String] : TJSONLargeInt Read GetNativeInts Write SetNativeInts;
  711. {$ENDIF}
  712. Property Strings[AName : String] : TJSONStringType Read GetStrings Write SetStrings;
  713. Property Booleans[AName : String] : Boolean Read GetBooleans Write SetBooleans;
  714. Property Arrays[AName : String] : TJSONArray Read GetArrays Write SetArrays;
  715. Property Objects[AName : String] : TJSONObject Read GetObjects Write SetObjects;
  716. end;
  717. TJSONObjectClass = Class of TJSONObject;
  718. EJSON = Class(Exception);
  719. TJSONParserHandler = Procedure(AStream : TStream; Const AUseUTF8 : Boolean; Out Data : TJSONData);
  720. TJSONStringParserHandler = Procedure(Const aJSON : TJSONStringType; Const AUseUTF8 : Boolean; Out Data : TJSONData);
  721. Function SetJSONInstanceType(AType : TJSONInstanceType; AClass : TJSONDataClass) : TJSONDataClass;
  722. Function GetJSONInstanceType(AType : TJSONInstanceType) : TJSONDataClass;
  723. Function StringToJSONString(const S : TJSONStringType; Strict : Boolean = False) : TJSONStringType;
  724. Function JSONStringToString(const S : TJSONStringType) : TJSONStringType;
  725. Function JSONTypeName(JSONType : TJSONType) : String;
  726. // These functions create JSONData structures, taking into account the instance types
  727. Function CreateJSON : TJSONNull;
  728. Function CreateJSON(Data : Boolean) : TJSONBoolean;
  729. Function CreateJSON(Data : Integer) : TJSONIntegerNumber;
  730. {$IFNDEF PAS2JS}
  731. Function CreateJSON(Data : Int64) : TJSONInt64Number;
  732. Function CreateJSON(Data : QWord) : TJSONQWordNumber;
  733. {$ELSE}
  734. Function CreateJSON(Data : NativeInt) : TJSONNativeIntNumber;
  735. {$ENDIF}
  736. Function CreateJSON(Data : TJSONFloat) : TJSONFloatNumber;
  737. Function CreateJSON(const Data : TJSONStringType) : TJSONString;
  738. {$IFNDEF PAS2JS}
  739. Function CreateJSON(const Data : TJSONUnicodeStringType) : TJSONString;
  740. {$ENDIF}
  741. Function CreateJSONArray(const Data : Array of {$IFDEF PAS2JS}jsvalue{$else}Const{$ENDIF}) : TJSONArray;
  742. Function CreateJSONObject(const Data : Array of {$IFDEF PAS2JS}jsvalue{$else}Const{$ENDIF}) : TJSONObject;
  743. // These functions rely on a callback. If the callback is not set, they will raise an error.
  744. // When the jsonparser unit is included in the project, the callback is automatically set.
  745. Function GetJSON(Const JSON : TJSONStringType; Const UseUTF8 : Boolean = True) : TJSONData;
  746. Function GetJSON(Const JSON : TStream; Const UseUTF8 : Boolean = True) : TJSONData;
  747. Function SetJSONParserHandler(AHandler : TJSONParserHandler) : TJSONParserHandler;
  748. Function SetJSONStringParserHandler(AHandler : TJSONStringParserHandler) : TJSONStringParserHandler;
  749. Function GetJSONParserHandler : TJSONParserHandler;
  750. Function GetJSONStringParserHandler: TJSONStringParserHandler;
  751. implementation
  752. Uses typinfo;
  753. Resourcestring
  754. SErrCannotConvertFromNull = 'Cannot convert data from Null value';
  755. SErrCannotConvertToNull = 'Cannot convert data to Null value';
  756. SErrCannotConvertFromArray = 'Cannot convert data from array value';
  757. SErrCannotConvertToArray = 'Cannot convert data to array value';
  758. SErrCannotConvertFromObject = 'Cannot convert data from object value';
  759. SErrCannotConvertToObject = 'Cannot convert data to object value';
  760. SErrInvalidFloat = 'Invalid float value : %s';
  761. SErrCannotSetNotIsNull = 'IsNull cannot be set to False';
  762. SErrCannotAddArrayTwice = 'Adding an array object to an array twice is not allowed';
  763. SErrCannotAddObjectTwice = 'Adding an object to an array twice is not allowed';
  764. SErrNotJSONData = 'Cannot add object of type %s to TJSON%s';
  765. SErrOddNumber = 'TJSONObject must be constructed with name,value pairs';
  766. SErrNameMustBeString = 'TJSONObject constructor element name at pos %d is not a string';
  767. SErrNonexistentElement = 'Unknown object member: "%s"';
  768. SErrDuplicateValue = 'Duplicate object member: "%s"';
  769. SErrPathElementNotFound = 'Path "%s" invalid: element "%s" not found.';
  770. SErrWrongInstanceClass = 'Cannot set instance class: %s does not descend from %s.';
  771. {$IFNDEF PAS2JS}
  772. SErrPointerNotNil = 'Cannot add non-nil pointer to JSON%s';
  773. SErrUnknownTypeInConstructor = 'Unknown type in JSON%s constructor: %d';
  774. {$ELSE}
  775. SErrUnknownTypeInConstructor = 'Unknown type in JSON%s constructor: %s';
  776. {$ENDIF}
  777. SErrNoParserHandler = 'No JSON parser handler installed. Recompile your project with the jsonparser unit included';
  778. Var
  779. DefaultJSONInstanceTypes :
  780. Array [TJSONInstanceType] of TJSONDataClass = (
  781. TJSONData,
  782. TJSONIntegerNumber,
  783. {$IFNDEF PAS2JS}
  784. TJSONInt64Number,
  785. TJSONQWordNumber,
  786. {$ELSE}
  787. TJSONNativeIntNumber,
  788. {$ENDIF}
  789. TJSONFloatNumber,
  790. TJSONString,
  791. TJSONBoolean,
  792. TJSONNull,
  793. TJSONArray,
  794. TJSONObject);
  795. Const
  796. MinJSONInstanceTypes :
  797. Array [TJSONInstanceType] of TJSONDataClass = (
  798. TJSONData,
  799. TJSONIntegerNumber,
  800. {$IFNDEF PAS2JS}
  801. TJSONInt64Number,
  802. TJSONQWordNumber,
  803. {$else}
  804. TJSONNativeIntNumber,
  805. {$ENDIF}
  806. TJSONFloatNumber,
  807. TJSONString,
  808. TJSONBoolean,
  809. TJSONNull,
  810. TJSONArray,
  811. TJSONObject
  812. );
  813. function SetJSONInstanceType(AType: TJSONInstanceType; AClass: TJSONDataClass): TJSONDataClass;
  814. begin
  815. if AClass=Nil then
  816. TJSONData.DoError(SErrWrongInstanceClass,['Nil',MinJSONInstanceTypes[AType].ClassName]);
  817. if Not AClass.InheritsFrom(MinJSONINstanceTypes[AType]) then
  818. TJSONData.DoError(SErrWrongInstanceClass,[AClass.ClassName,MinJSONInstanceTypes[AType].ClassName]);
  819. Result:=DefaultJSONInstanceTypes[AType];
  820. DefaultJSONINstanceTypes[AType]:=AClass;
  821. end;
  822. function GetJSONInstanceType(AType: TJSONInstanceType): TJSONDataClass;
  823. begin
  824. Result:=DefaultJSONInstanceTypes[AType]
  825. end;
  826. function StringToJSONString(const S: TJSONStringType; Strict : Boolean = False): TJSONStringType;
  827. Var
  828. I,J,L : Integer;
  829. C : Char;
  830. begin
  831. I:=1;
  832. J:=1;
  833. Result:='';
  834. L:=Length(S);
  835. While I<=L do
  836. begin
  837. C:=S[I];
  838. if (C in ['"','/','\',#0..#31]) then
  839. begin
  840. Result:=Result+Copy(S,J,I-J);
  841. Case C of
  842. '\' : Result:=Result+'\\';
  843. '/' : if Strict then
  844. Result:=Result+'\/'
  845. else
  846. Result:=Result+'/';
  847. '"' : Result:=Result+'\"';
  848. #8 : Result:=Result+'\b';
  849. #9 : Result:=Result+'\t';
  850. #10 : Result:=Result+'\n';
  851. #12 : Result:=Result+'\f';
  852. #13 : Result:=Result+'\r';
  853. else
  854. Result:=Result+'\u'+HexStr(Ord(C),4);
  855. end;
  856. J:=I+1;
  857. end;
  858. Inc(I);
  859. end;
  860. Result:=Result+Copy(S,J,I-1);
  861. end;
  862. function JSONStringToString(const S: TJSONStringType): TJSONStringType;
  863. {$IFDEF PAS2JS}
  864. Var
  865. J : JSValue;
  866. OK : Boolean;
  867. begin
  868. OK:=False;
  869. try
  870. J:=TJSJSON.parse('"'+S+'"');
  871. if isString(J) then
  872. begin
  873. Result:=String(J);
  874. OK:=True;
  875. end;
  876. except
  877. OK:=False;
  878. end;
  879. if not OK then
  880. Raise EConvertError.Create('Invalid JSON String:'+S);
  881. end;
  882. {$ELSE}
  883. Var
  884. I,J,L,U1,U2 : Integer;
  885. App,W : String;
  886. Procedure MaybeAppendUnicode;
  887. Var
  888. U : String;
  889. begin
  890. if (U1<>0) then
  891. begin
  892. U:={$IFDEF FPC_HAS_CPSTRING}UTF8Encode(WideChar(U1)){$ELSE}widechar(U1){$ENDIF};
  893. Result:=Result+U;
  894. U1:=0;
  895. end;
  896. end;
  897. begin
  898. I:=1;
  899. J:=1;
  900. L:=Length(S);
  901. Result:='';
  902. U1:=0;
  903. While (I<=L) do
  904. begin
  905. if (S[I]='\') then
  906. begin
  907. Result:=Result+Copy(S,J,I-J);
  908. If I<L then
  909. begin
  910. Inc(I);
  911. App:='';
  912. Case S[I] of
  913. '\','"','/'
  914. : App:=S[I];
  915. 'b' : App:=#8;
  916. 't' : App:=#9;
  917. 'n' : App:=#10;
  918. 'f' : App:=#12;
  919. 'r' : App:=#13;
  920. 'u' : begin
  921. W:=Copy(S,I+1,4);
  922. Inc(I,4);
  923. u2:=StrToInt('$'+W);
  924. if (U1<>0) then
  925. begin
  926. App:={$IFDEF FPC_HAS_CPSTRING}UTF8Encode({$ENDIF}WideChar(U1)+WideChar(U2){$IFDEF FPC_HAS_CPSTRING}){$ENDIF};
  927. writeln('app a: ',L,': ',App);
  928. U2:=0;
  929. end
  930. else
  931. begin
  932. writeln('app b: ',L,': ',WideChar(U2));
  933. U1:=U2;
  934. end;
  935. end;
  936. end;
  937. if App<>'' then
  938. begin
  939. MaybeAppendUnicode;
  940. Result:=Result+App;
  941. end;
  942. end;
  943. J:=I+1;
  944. end
  945. else
  946. MaybeAppendUnicode;
  947. Inc(I);
  948. end;
  949. MaybeAppendUnicode;
  950. Result:=Result+Copy(S,J,I-J+1);
  951. end;
  952. {$ENDIF}
  953. function JSONTypeName(JSONType: TJSONType): String;
  954. begin
  955. Result:=GetEnumName(TypeInfo(TJSONType),Ord(JSONType));
  956. end;
  957. function CreateJSON: TJSONNull;
  958. begin
  959. Result:=TJSONNullClass(DefaultJSONInstanceTypes[jitNull]).Create
  960. end;
  961. function CreateJSON(Data: Boolean): TJSONBoolean;
  962. begin
  963. Result:=TJSONBooleanClass(DefaultJSONInstanceTypes[jitBoolean]).Create(Data);
  964. end;
  965. function CreateJSON(Data: Integer): TJSONIntegerNumber;
  966. begin
  967. Result:=TJSONIntegerNumberCLass(DefaultJSONInstanceTypes[jitNumberInteger]).Create(Data);
  968. end;
  969. {$IFNDEF PAS2JS}
  970. function CreateJSON(Data: Int64): TJSONInt64Number;
  971. begin
  972. Result:=TJSONInt64NumberCLass(DefaultJSONInstanceTypes[jitNumberInt64]).Create(Data);
  973. end;
  974. function CreateJSON(Data: QWord): TJSONQWordNumber;
  975. begin
  976. Result:=TJSONQWordNumberClass(DefaultJSONInstanceTypes[jitNumberQWord]).Create(Data);
  977. end;
  978. {$ELSE}
  979. function CreateJSON(Data: NativeInt): TJSONNativeIntNumber;
  980. begin
  981. Result:=TJSONNativeIntNumberCLass(DefaultJSONInstanceTypes[jitNumberNativeInt]).Create(Data);
  982. end;
  983. {$ENDIF}
  984. function CreateJSON(Data: TJSONFloat): TJSONFloatNumber;
  985. begin
  986. Result:=TJSONFloatNumberCLass(DefaultJSONInstanceTypes[jitNumberFloat]).Create(Data);
  987. end;
  988. function CreateJSON(const Data: TJSONStringType): TJSONString;
  989. begin
  990. Result:=TJSONStringCLass(DefaultJSONInstanceTypes[jitString]).Create(Data);
  991. end;
  992. {$IFNDEF PAS2JS}
  993. function CreateJSON(const Data: TJSONUnicodeStringType): TJSONString;
  994. begin
  995. Result:=TJSONStringCLass(DefaultJSONInstanceTypes[jitString]).Create(Data);
  996. end;
  997. {$ENDIF}
  998. function CreateJSONArray(const Data: array of {$IFDEF PAS2JS}jsvalue{$else}Const{$ENDIF}): TJSONArray;
  999. begin
  1000. Result:=TJSONArrayCLass(DefaultJSONInstanceTypes[jitArray]).Create(Data);
  1001. end;
  1002. function CreateJSONObject(const Data: array of {$IFDEF PAS2JS}jsvalue{$else}Const{$ENDIF}): TJSONObject;
  1003. begin
  1004. Result:=TJSONObjectClass(DefaultJSONInstanceTypes[jitObject]).Create(Data);
  1005. end;
  1006. Var
  1007. JPH : TJSONParserHandler;
  1008. JPSH : TJSONStringParserHandler;
  1009. function GetJSON(const JSON: TJSONStringType; const UseUTF8: Boolean): TJSONData;
  1010. Var
  1011. SS : TStringStream;
  1012. begin
  1013. if Assigned(JPSH) then
  1014. JPSH(JSON,UseUTF8,Result)
  1015. else
  1016. begin
  1017. {$IF FPC_FULLVERSION>30300}
  1018. if UseUTF8 then
  1019. SS:=TStringStream.Create(JSON,TEncoding.UTF8)
  1020. else
  1021. {$ENDIF}
  1022. SS:=TStringStream.Create(JSON);
  1023. try
  1024. Result:=GetJSON(SS,UseUTF8);
  1025. finally
  1026. SS.Free;
  1027. end;
  1028. end;
  1029. end;
  1030. function GetJSON(const JSON: TStream; const UseUTF8: Boolean): TJSONData;
  1031. Var
  1032. SS : TStringStream;
  1033. begin
  1034. Result:=Nil;
  1035. If (JPH<>Nil) then
  1036. JPH(JSON,UseUTF8,Result)
  1037. else if JPSH=Nil then
  1038. TJSONData.DoError(SErrNoParserHandler)
  1039. else
  1040. begin
  1041. {$IFNDEF PAS3JS}
  1042. SS:=TStringStream.Create('');
  1043. {$ELSE}
  1044. if UseUTF8 Then
  1045. SS:=TStringStream.Create('',TENcoding.UTF8)
  1046. else
  1047. SS:=TStringStream.Create('');
  1048. {$ENDIF}
  1049. try
  1050. SS.CopyFrom(JSON,0);
  1051. JPSH(SS.DataString,False,Result);
  1052. finally
  1053. SS.Free;
  1054. end;
  1055. end;
  1056. end;
  1057. Function SetJSONStringParserHandler(AHandler : TJSONStringParserHandler) : TJSONStringParserHandler;
  1058. begin
  1059. Result:=JPSH;
  1060. JPSH:=AHandler;
  1061. end;
  1062. function SetJSONParserHandler(AHandler: TJSONParserHandler): TJSONParserHandler;
  1063. begin
  1064. Result:=JPH;
  1065. JPH:=AHandler;
  1066. end;
  1067. function GetJSONParserHandler: TJSONParserHandler;
  1068. begin
  1069. Result:=JPH;
  1070. end;
  1071. function GetJSONStringParserHandler: TJSONStringParserHandler;
  1072. begin
  1073. Result:=JPSH;
  1074. end;
  1075. Type
  1076. { TJSONEnumerator }
  1077. TJSONEnumerator = class(TBaseJSONEnumerator)
  1078. Private
  1079. FData : TJSONData;
  1080. public
  1081. Constructor Create(AData : TJSONData);
  1082. function GetCurrent: TJSONEnum; override;
  1083. function MoveNext : Boolean; override;
  1084. end;
  1085. { TJSONArrayEnumerator }
  1086. TJSONArrayEnumerator = class(TBaseJSONEnumerator)
  1087. Private
  1088. FData : TJSONArray;
  1089. FCurrent : Integer;
  1090. public
  1091. Constructor Create(AData : TJSONArray);
  1092. function GetCurrent: TJSONEnum; override;
  1093. function MoveNext : Boolean; override;
  1094. end;
  1095. { TJSONObjectEnumerator }
  1096. TJSONObjectEnumerator = class(TBaseJSONEnumerator)
  1097. Private
  1098. FData : TJSONObject;
  1099. FCurrent : Integer;
  1100. public
  1101. Constructor Create(AData : TJSONObject);
  1102. function GetCurrent: TJSONEnum; override;
  1103. function MoveNext : Boolean; override;
  1104. end;
  1105. {$IFNDEF PAS2JS}
  1106. { TJSONQWordNumber }
  1107. function TJSONQWordNumber.GetAsBoolean: Boolean;
  1108. begin
  1109. Result:=FValue<>0;
  1110. end;
  1111. function TJSONQWordNumber.GetAsFloat: TJSONFloat;
  1112. begin
  1113. Result:= FValue;
  1114. end;
  1115. function TJSONQWordNumber.GetAsInteger: Integer;
  1116. begin
  1117. Result := FValue;
  1118. end;
  1119. function TJSONQWordNumber.GetAsInt64: Int64;
  1120. begin
  1121. Result := FValue;
  1122. end;
  1123. function TJSONQWordNumber.GetAsQWord: QWord;
  1124. begin
  1125. Result := FValue;
  1126. end;
  1127. procedure TJSONQWordNumber.SetAsBoolean(const AValue: Boolean);
  1128. begin
  1129. FValue:=Ord(AValue);
  1130. end;
  1131. procedure TJSONQWordNumber.SetAsFloat(const AValue: TJSONFloat);
  1132. begin
  1133. FValue:=Round(AValue);
  1134. end;
  1135. procedure TJSONQWordNumber.SetAsInteger(const AValue: Integer);
  1136. begin
  1137. FValue:=AValue;
  1138. end;
  1139. procedure TJSONQWordNumber.SetAsInt64(const AValue: Int64);
  1140. begin
  1141. FValue := AValue;
  1142. end;
  1143. procedure TJSONQWordNumber.SetAsQword(const AValue: QWord);
  1144. begin
  1145. FValue:=AValue;
  1146. end;
  1147. function TJSONQWordNumber.GetAsJSON: TJSONStringType;
  1148. begin
  1149. Result:=AsString;
  1150. end;
  1151. function TJSONQWordNumber.GetAsString: TJSONStringType;
  1152. begin
  1153. Result:=IntToStr(FValue);
  1154. end;
  1155. procedure TJSONQWordNumber.SetAsString(const AValue: TJSONStringType);
  1156. begin
  1157. FValue:=StrToQWord(AValue);
  1158. end;
  1159. function TJSONQWordNumber.GetValue: TJSONVariant;
  1160. begin
  1161. Result:=FValue;
  1162. end;
  1163. procedure TJSONQWordNumber.SetValue(const AValue: TJSONVariant);
  1164. begin
  1165. FValue:=AValue;
  1166. end;
  1167. constructor TJSONQWordNumber.Create(AValue: QWord);
  1168. begin
  1169. FValue := AValue;
  1170. end;
  1171. class function TJSONQWordNumber.NumberType: TJSONNumberType;
  1172. begin
  1173. Result:=ntQWord;
  1174. end;
  1175. procedure TJSONQWordNumber.Clear;
  1176. begin
  1177. FValue:=0;
  1178. end;
  1179. function TJSONQWordNumber.Clone: TJSONData;
  1180. begin
  1181. Result:=TJSONQWordNumberClass(ClassType).Create(Self.FValue);
  1182. end;
  1183. {$ENDIF}
  1184. { TJSONObjectEnumerator }
  1185. constructor TJSONObjectEnumerator.Create(AData: TJSONObject);
  1186. begin
  1187. FData:=AData;
  1188. FCurrent:=-1;
  1189. end;
  1190. function TJSONObjectEnumerator.GetCurrent: TJSONEnum;
  1191. begin
  1192. Result.KeyNum:=FCurrent;
  1193. Result.Key:=FData.Names[FCurrent];
  1194. Result.Value:=FData.Items[FCurrent];
  1195. end;
  1196. function TJSONObjectEnumerator.MoveNext: Boolean;
  1197. begin
  1198. Inc(FCurrent);
  1199. Result:=FCurrent<FData.Count;
  1200. end;
  1201. { TJSONArrayEnumerator }
  1202. constructor TJSONArrayEnumerator.Create(AData: TJSONArray);
  1203. begin
  1204. FData:=AData;
  1205. FCurrent:=-1;
  1206. end;
  1207. function TJSONArrayEnumerator.GetCurrent: TJSONEnum;
  1208. begin
  1209. Result.KeyNum:=FCurrent;
  1210. Result.Key:=IntToStr(FCurrent);
  1211. Result.Value:=FData.Items[FCurrent];
  1212. end;
  1213. function TJSONArrayEnumerator.MoveNext: Boolean;
  1214. begin
  1215. Inc(FCurrent);
  1216. Result:=FCurrent<FData.Count;
  1217. end;
  1218. { TJSONEnumerator }
  1219. constructor TJSONEnumerator.Create(AData: TJSONData);
  1220. begin
  1221. FData:=AData;
  1222. end;
  1223. function TJSONEnumerator.GetCurrent: TJSONEnum;
  1224. begin
  1225. Result.Key:='';
  1226. Result.KeyNum:=0;
  1227. Result.Value:=FData;
  1228. FData:=Nil;
  1229. end;
  1230. function TJSONEnumerator.MoveNext: Boolean;
  1231. begin
  1232. Result:=FData<>Nil;
  1233. end;
  1234. { TJSONData }
  1235. {$IFNDEF PAS2JS}
  1236. function TJSONData.GetAsUnicodeString: TJSONUnicodeStringType;
  1237. begin
  1238. Result:=UTF8Decode(AsString);
  1239. end;
  1240. procedure TJSONData.SetAsUnicodeString(const AValue: TJSONUnicodeStringType);
  1241. begin
  1242. AsString:=UTF8Encode(AValue);
  1243. end;
  1244. {$ENDIF}
  1245. function TJSONData.GetItem(Index : Integer): TJSONData;
  1246. begin
  1247. Result:=nil;
  1248. if Index>0 then ;
  1249. end;
  1250. function TJSONData.GetCount: Integer;
  1251. begin
  1252. Result:=0;
  1253. end;
  1254. constructor TJSONData.Create;
  1255. begin
  1256. Clear;
  1257. end;
  1258. procedure TJSONData.DumpJSON(S: TFPJSStream);
  1259. Procedure W(T : String);
  1260. begin
  1261. if T='' then exit;
  1262. {$IFDEF PAS2JS}
  1263. S.push(T);
  1264. {$else}
  1265. S.WriteBuffer(T[1],Length(T)*SizeOf(Char));
  1266. {$ENDIF}
  1267. end;
  1268. Var
  1269. I: Integer;
  1270. O : TJSONObject;
  1271. begin
  1272. Case JSONType of
  1273. jtObject :
  1274. begin
  1275. O:=TJSONObject(Self);
  1276. W('{');
  1277. For I:=0 to O.Count-1 do
  1278. begin
  1279. if (I>0) then
  1280. W(',');
  1281. W('"');
  1282. W(StringToJSONString(O.Names[i],False));
  1283. W('":');
  1284. O.Items[I].DumpJSON(S);
  1285. end;
  1286. W('}');
  1287. end;
  1288. jtArray :
  1289. begin
  1290. W('[');
  1291. For I:=0 to Count-1 do
  1292. begin
  1293. if (I>0) then
  1294. W(',');
  1295. Items[I].DumpJSON(S);
  1296. end;
  1297. W(']');
  1298. end
  1299. else
  1300. W(AsJSON)
  1301. end;
  1302. end;
  1303. class function TJSONData.GetCompressedJSON: Boolean; {$IFNDEF PAS2JS}static;{$ENDIF}
  1304. begin
  1305. Result:=FCompressedJSON;
  1306. end;
  1307. class procedure TJSONData.DetermineElementSeparators;
  1308. begin
  1309. FElementSep:=ElementSeps[FCompressedJSON];
  1310. end;
  1311. class procedure TJSONData.SetCompressedJSON(AValue: Boolean); {$IFNDEF PAS2JS}static;{$ENDIF}
  1312. begin
  1313. if AValue=FCompressedJSON then exit;
  1314. FCompressedJSON:=AValue;
  1315. DetermineElementSeparators;
  1316. TJSONObject.DetermineElementQuotes;
  1317. end;
  1318. class procedure TJSONData.DoError(const Msg: String);
  1319. begin
  1320. Raise EJSON.Create(Msg);
  1321. end;
  1322. class procedure TJSONData.DoError(const Fmt: String; const Args: array of Const);
  1323. begin
  1324. Raise EJSON.CreateFmt(Fmt,Args);
  1325. end;
  1326. function TJSONData.DoFindPath(const APath: TJSONStringType; out
  1327. NotFound: TJSONStringType): TJSONdata;
  1328. begin
  1329. If APath<>'' then
  1330. begin
  1331. NotFound:=APath;
  1332. Result:=Nil;
  1333. end
  1334. else
  1335. Result:=Self;
  1336. end;
  1337. function TJSONData.GetIsNull: Boolean;
  1338. begin
  1339. Result:=False;
  1340. end;
  1341. class function TJSONData.JSONType: TJSONType;
  1342. begin
  1343. JSONType:=jtUnknown;
  1344. end;
  1345. function TJSONData.GetEnumerator: TBaseJSONEnumerator;
  1346. begin
  1347. Result:=TJSONEnumerator.Create(Self);
  1348. end;
  1349. function TJSONData.FindPath(const APath: TJSONStringType): TJSONdata;
  1350. Var
  1351. M : TJSONStringType;
  1352. begin
  1353. Result:=DoFindPath(APath,M);
  1354. end;
  1355. function TJSONData.GetPath(const APath: TJSONStringType): TJSONdata;
  1356. Var
  1357. M : TJSONStringType;
  1358. begin
  1359. Result:=DoFindPath(APath,M);
  1360. If Result=Nil then
  1361. DoError(SErrPathElementNotFound,[APath,M]);
  1362. end;
  1363. procedure TJSONData.SetItem(Index : Integer; const AValue:
  1364. TJSONData);
  1365. begin
  1366. // Do Nothing
  1367. if Index>0 then ;
  1368. if AValue<>nil then ;
  1369. end;
  1370. function TJSONData.FormatJSON(Options: TFormatOptions; Indentsize: Integer
  1371. ): TJSONStringType;
  1372. begin
  1373. Result:=DoFormatJSON(Options,0,IndentSize);
  1374. end;
  1375. function TJSONData.DoFormatJSON(Options: TFormatOptions; CurrentIndent,
  1376. Indent: Integer): TJSONStringType;
  1377. begin
  1378. Result:=AsJSON;
  1379. if Options=[] then ;
  1380. if CurrentIndent=0 then ;
  1381. if Indent>0 then ;
  1382. end;
  1383. { TJSONnumber }
  1384. class function TJSONnumber.JSONType: TJSONType;
  1385. begin
  1386. Result:=jtNumber;
  1387. end;
  1388. { TJSONstring }
  1389. class function TJSONString.JSONType: TJSONType;
  1390. begin
  1391. Result:=jtString;
  1392. end;
  1393. procedure TJSONString.Clear;
  1394. begin
  1395. FValue:='';
  1396. end;
  1397. function TJSONString.Clone: TJSONData;
  1398. begin
  1399. Result:=TJSONStringClass(ClassType).Create(Self.FValue);
  1400. end;
  1401. function TJSONString.GetValue: TJSONVariant;
  1402. begin
  1403. Result:=FValue;
  1404. end;
  1405. procedure TJSONString.SetValue(const AValue: TJSONVariant);
  1406. begin
  1407. FValue:={$IFDEF PAS2JS}TJSONStringType(AValue){$else}AValue{$ENDIF};
  1408. end;
  1409. function TJSONString.GetAsBoolean: Boolean;
  1410. begin
  1411. Result:=StrToBool(FValue);
  1412. end;
  1413. function TJSONString.GetAsFloat: TJSONFloat;
  1414. Var
  1415. C : Integer;
  1416. begin
  1417. Val(FValue,Result,C);
  1418. If (C<>0) then
  1419. If Not TryStrToFloat(FValue,Result) then
  1420. Raise EConvertError.CreateFmt(SErrInvalidFloat,[FValue]);
  1421. end;
  1422. function TJSONString.GetAsInteger: Integer;
  1423. begin
  1424. Result:=StrToInt(FValue);
  1425. end;
  1426. {$IFNDEF PAS2JS}
  1427. function TJSONString.GetAsInt64: Int64;
  1428. begin
  1429. Result:=StrToInt64(FValue);
  1430. end;
  1431. function TJSONString.GetAsQWord: QWord;
  1432. begin
  1433. Result:=StrToQWord(FValue);
  1434. end;
  1435. procedure TJSONString.SetAsInt64(const AValue: Int64);
  1436. begin
  1437. FValue:=IntToStr(AValue);
  1438. end;
  1439. procedure TJSONString.SetAsQword(const AValue: QWord);
  1440. begin
  1441. FValue:=IntToStr(AValue);
  1442. end;
  1443. {$ELSE}
  1444. function TJSONString.GetAsNativeInt: NativeInt;
  1445. begin
  1446. Result:=StrToInt64(FValue);
  1447. end;
  1448. procedure TJSONString.SetAsNativeInt(const AValue: NativeInt);
  1449. begin
  1450. FValue:=IntToStr(aValue);
  1451. end;
  1452. {$ENDIF}
  1453. procedure TJSONString.SetAsBoolean(const AValue: Boolean);
  1454. begin
  1455. FValue:=BoolToStr(AValue);
  1456. end;
  1457. procedure TJSONString.SetAsFloat(const AValue: TJSONFloat);
  1458. begin
  1459. FValue:=FloatToStr(AValue);
  1460. end;
  1461. procedure TJSONString.SetAsInteger(const AValue: Integer);
  1462. begin
  1463. FValue:=IntToStr(AValue);
  1464. end;
  1465. function TJSONString.GetAsJSON: TJSONStringType;
  1466. begin
  1467. Result:='"'+StringToJSONString(FValue,StrictEscaping)+'"';
  1468. end;
  1469. function TJSONString.GetAsString: TJSONStringType;
  1470. begin
  1471. Result:=FValue;
  1472. end;
  1473. procedure TJSONString.SetAsString(const AValue: TJSONStringType);
  1474. begin
  1475. FValue:=AValue;
  1476. end;
  1477. constructor TJSONString.Create(const AValue: TJSONStringType);
  1478. begin
  1479. FValue:=AValue;
  1480. end;
  1481. {$IFNDEF PAS2JS}
  1482. constructor TJSONString.Create(const AValue: TJSONUnicodeStringType);
  1483. begin
  1484. FValue:=UTF8Encode(AValue);
  1485. end;
  1486. {$ENDIF}
  1487. { TJSONboolean }
  1488. function TJSONBoolean.GetValue: TJSONVariant;
  1489. begin
  1490. Result:=FValue;
  1491. end;
  1492. class function TJSONBoolean.JSONType: TJSONType;
  1493. begin
  1494. Result:=jtBoolean;
  1495. end;
  1496. procedure TJSONBoolean.Clear;
  1497. begin
  1498. FValue:=False;
  1499. end;
  1500. function TJSONBoolean.Clone: TJSONData;
  1501. begin
  1502. Result:=TJSONBooleanClass(Self.ClassType).Create(Self.Fvalue);
  1503. end;
  1504. procedure TJSONBoolean.SetValue(const AValue: TJSONVariant);
  1505. begin
  1506. FValue:=boolean(AValue);
  1507. end;
  1508. function TJSONBoolean.GetAsBoolean: Boolean;
  1509. begin
  1510. Result:=FValue;
  1511. end;
  1512. function TJSONBoolean.GetAsFloat: TJSONFloat;
  1513. begin
  1514. Result:=Ord(FValue);
  1515. end;
  1516. function TJSONBoolean.GetAsInteger: Integer;
  1517. begin
  1518. Result:=Ord(FValue);
  1519. end;
  1520. {$IFNDEF PAS2JS}
  1521. function TJSONBoolean.GetAsInt64: Int64;
  1522. begin
  1523. Result:=Ord(FValue);
  1524. end;
  1525. function TJSONBoolean.GetAsQWord: QWord;
  1526. begin
  1527. Result:=Ord(FValue);
  1528. end;
  1529. procedure TJSONBoolean.SetAsInt64(const AValue: Int64);
  1530. begin
  1531. FValue:=(AValue<>0)
  1532. end;
  1533. procedure TJSONBoolean.SetAsQword(const AValue: QWord);
  1534. begin
  1535. FValue:=(AValue<>0)
  1536. end;
  1537. {$ELSE}
  1538. function TJSONBoolean.GetAsNativeInt: NativeInt;
  1539. begin
  1540. Result:=Ord(FValue);
  1541. end;
  1542. procedure TJSONBoolean.SetAsNativeInt(const AValue: NativeInt);
  1543. begin
  1544. FValue:=aValue<>0;
  1545. end;
  1546. {$ENDIF}
  1547. procedure TJSONBoolean.SetAsBoolean(const AValue: Boolean);
  1548. begin
  1549. FValue:=AValue;
  1550. end;
  1551. procedure TJSONBoolean.SetAsFloat(const AValue: TJSONFloat);
  1552. begin
  1553. FValue:=(AValue<>0)
  1554. end;
  1555. procedure TJSONBoolean.SetAsInteger(const AValue: Integer);
  1556. begin
  1557. FValue:=(AValue<>0)
  1558. end;
  1559. function TJSONBoolean.GetAsJSON: TJSONStringType;
  1560. begin
  1561. If FValue then
  1562. Result:='true'
  1563. else
  1564. Result:='false';
  1565. end;
  1566. function TJSONBoolean.GetAsString: TJSONStringType;
  1567. begin
  1568. Result:=BoolToStr(FValue, True);
  1569. end;
  1570. procedure TJSONBoolean.SetAsString(const AValue: TJSONStringType);
  1571. begin
  1572. FValue:=StrToBool(AValue);
  1573. end;
  1574. constructor TJSONBoolean.Create(AValue: Boolean);
  1575. begin
  1576. FValue:=AValue;
  1577. end;
  1578. { TJSONnull }
  1579. procedure TJSONNull.Converterror(From: Boolean);
  1580. begin
  1581. If From then
  1582. DoError(SErrCannotConvertFromNull)
  1583. else
  1584. DoError(SErrCannotConvertToNull);
  1585. end;
  1586. {$warnings off}
  1587. function TJSONNull.GetAsBoolean: Boolean;
  1588. begin
  1589. ConvertError(True);
  1590. Result:=false;
  1591. end;
  1592. function TJSONNull.GetAsFloat: TJSONFloat;
  1593. begin
  1594. ConvertError(True);
  1595. Result:=0.0;
  1596. end;
  1597. function TJSONNull.GetAsInteger: Integer;
  1598. begin
  1599. ConvertError(True);
  1600. Result:=0;
  1601. end;
  1602. {$IFNDEF PAS2JS}
  1603. function TJSONNull.GetAsInt64: Int64;
  1604. begin
  1605. ConvertError(True);
  1606. end;
  1607. function TJSONNull.GetAsQWord: QWord;
  1608. begin
  1609. ConvertError(True);
  1610. end;
  1611. procedure TJSONNull.SetAsInt64(const AValue: Int64);
  1612. begin
  1613. ConvertError(False);
  1614. if AValue>0 then ;
  1615. end;
  1616. procedure TJSONNull.SetAsQword(const AValue: QWord);
  1617. begin
  1618. ConvertError(False);
  1619. if AValue>0 then ;
  1620. end;
  1621. {$ELSE}
  1622. function TJSONNull.GetAsNativeInt: NativeInt;
  1623. begin
  1624. ConvertError(True);
  1625. Result:=0;
  1626. end;
  1627. procedure TJSONNull.SetAsNativeInt(const AValue: NativeInt);
  1628. begin
  1629. ConvertError(False);
  1630. if AValue<>0 then ;
  1631. end;
  1632. {$ENDIF}
  1633. function TJSONNull.GetIsNull: Boolean;
  1634. begin
  1635. Result:=True;
  1636. end;
  1637. procedure TJSONNull.SetAsBoolean(const AValue: Boolean);
  1638. begin
  1639. ConvertError(False);
  1640. if AValue then ;
  1641. end;
  1642. procedure TJSONNull.SetAsFloat(const AValue: TJSONFloat);
  1643. begin
  1644. ConvertError(False);
  1645. if AValue>0 then ;
  1646. end;
  1647. procedure TJSONNull.SetAsInteger(const AValue: Integer);
  1648. begin
  1649. ConvertError(False);
  1650. if AValue>0 then ;
  1651. end;
  1652. function TJSONNull.GetAsJSON: TJSONStringType;
  1653. begin
  1654. Result:='null';
  1655. end;
  1656. function TJSONNull.GetAsString: TJSONStringType;
  1657. begin
  1658. ConvertError(True);
  1659. Result:='';
  1660. end;
  1661. procedure TJSONNull.SetAsString(const AValue: TJSONStringType);
  1662. begin
  1663. ConvertError(True);
  1664. if AValue='' then ;
  1665. end;
  1666. function TJSONNull.GetValue: TJSONVariant;
  1667. begin
  1668. Result:={$IFDEF PAS2JS}js.Null{$else}variants.Null{$ENDIF};
  1669. end;
  1670. procedure TJSONNull.SetValue(const AValue: TJSONVariant);
  1671. begin
  1672. ConvertError(False);
  1673. {$IFDEF PAS2JS}
  1674. if AValue=0 then ;
  1675. {$else}
  1676. if VarType(AValue)=0 then ;
  1677. {$ENDIF}
  1678. end;
  1679. class function TJSONNull.JSONType: TJSONType;
  1680. begin
  1681. Result:=jtNull;
  1682. end;
  1683. procedure TJSONNull.Clear;
  1684. begin
  1685. // Do nothing
  1686. end;
  1687. function TJSONNull.Clone: TJSONData;
  1688. begin
  1689. Result:=TJSONNullClass(Self.ClassType).Create;
  1690. end;
  1691. {$warnings on}
  1692. { TJSONFloatNumber }
  1693. function TJSONFloatNumber.GetAsBoolean: Boolean;
  1694. begin
  1695. Result:=(FValue<>0);
  1696. end;
  1697. function TJSONFloatNumber.GetAsFloat: TJSONFloat;
  1698. begin
  1699. Result:=FValue;
  1700. end;
  1701. function TJSONFloatNumber.GetAsInteger: Integer;
  1702. begin
  1703. Result:=Round(FValue);
  1704. end;
  1705. {$IFNDEF PAS2JS}
  1706. function TJSONFloatNumber.GetAsInt64: Int64;
  1707. begin
  1708. Result:=Round(FValue);
  1709. end;
  1710. function TJSONFloatNumber.GetAsQWord: QWord;
  1711. begin
  1712. Result:=Round(FValue);
  1713. end;
  1714. procedure TJSONFloatNumber.SetAsInt64(const AValue: Int64);
  1715. begin
  1716. FValue:=AValue;
  1717. end;
  1718. procedure TJSONFloatNumber.SetAsQword(const AValue: QWord);
  1719. begin
  1720. FValue:=AValue;
  1721. end;
  1722. {$ELSE}
  1723. function TJSONFloatNumber.GetAsNativeInt: NativeInt;
  1724. begin
  1725. Result:=Round(FValue);
  1726. end;
  1727. procedure TJSONFloatNumber.SetAsNativeInt(const AValue: NativeInt);
  1728. begin
  1729. FValue:=aValue;
  1730. end;
  1731. {$ENDIF}
  1732. procedure TJSONFloatNumber.SetAsBoolean(const AValue: Boolean);
  1733. begin
  1734. FValue:=Ord(AValue);
  1735. end;
  1736. procedure TJSONFloatNumber.SetAsFloat(const AValue: TJSONFloat);
  1737. begin
  1738. FValue:=AValue;
  1739. end;
  1740. procedure TJSONFloatNumber.SetAsInteger(const AValue: Integer);
  1741. begin
  1742. FValue:=AValue;
  1743. end;
  1744. function TJSONFloatNumber.GetAsJSON: TJSONStringType;
  1745. begin
  1746. Result:=AsString;
  1747. end;
  1748. function TJSONFloatNumber.GetAsString: TJSONStringType;
  1749. begin
  1750. Str(FValue,Result);
  1751. // Str produces a ' ' in front where the - can go.
  1752. if (Result<>'') and (Result[1]=' ') then
  1753. Delete(Result,1,1);
  1754. end;
  1755. procedure TJSONFloatNumber.SetAsString(const AValue: TJSONStringType);
  1756. Var
  1757. C : Integer;
  1758. begin
  1759. Val(AValue,FValue,C);
  1760. If (C<>0) then
  1761. Raise EConvertError.CreateFmt(SErrInvalidFloat,[AValue]);
  1762. end;
  1763. function TJSONFloatNumber.GetValue: TJSONVariant;
  1764. begin
  1765. Result:=FValue;
  1766. end;
  1767. procedure TJSONFloatNumber.SetValue(const AValue: TJSONVariant);
  1768. begin
  1769. FValue:={$IFDEF PAS2JS}TJSONFloat(AValue){$else}AValue{$ENDIF};
  1770. end;
  1771. constructor TJSONFloatNumber.Create(AValue: TJSONFloat);
  1772. begin
  1773. FValue:=AValue;
  1774. end;
  1775. class function TJSONFloatNumber.NumberType: TJSONNumberType;
  1776. begin
  1777. Result:=ntFloat;
  1778. end;
  1779. procedure TJSONFloatNumber.Clear;
  1780. begin
  1781. FValue:=0;
  1782. end;
  1783. function TJSONFloatNumber.Clone: TJSONData;
  1784. begin
  1785. Result:=TJSONFloatNumberClass(ClassType).Create(Self.FValue);
  1786. end;
  1787. { TJSONIntegerNumber }
  1788. function TJSONIntegerNumber.GetAsBoolean: Boolean;
  1789. begin
  1790. Result:=FValue<>0;
  1791. end;
  1792. function TJSONIntegerNumber.GetAsFloat: TJSONFloat;
  1793. begin
  1794. Result:=FValue;
  1795. end;
  1796. function TJSONIntegerNumber.GetAsInteger: Integer;
  1797. begin
  1798. Result:=FValue;
  1799. end;
  1800. {$IFNDEF PAS2JS}
  1801. function TJSONIntegerNumber.GetAsInt64: Int64;
  1802. begin
  1803. Result:=FValue;
  1804. end;
  1805. function TJSONIntegerNumber.GetAsQWord: QWord;
  1806. begin
  1807. result:=FValue;
  1808. end;
  1809. procedure TJSONIntegerNumber.SetAsInt64(const AValue: Int64);
  1810. begin
  1811. FValue:=AValue;
  1812. end;
  1813. procedure TJSONIntegerNumber.SetAsQword(const AValue: QWord);
  1814. begin
  1815. FValue:=AValue;
  1816. end;
  1817. {$ELSE}
  1818. function TJSONIntegerNumber.GetAsNativeInt: NativeInt;
  1819. begin
  1820. result:=FValue;
  1821. end;
  1822. procedure TJSONIntegerNumber.SetAsNativeInt(const AValue: NativeInt);
  1823. begin
  1824. FValue:=aValue;
  1825. end;
  1826. {$ENDIF}
  1827. procedure TJSONIntegerNumber.SetAsBoolean(const AValue: Boolean);
  1828. begin
  1829. FValue:=Ord(AValue);
  1830. end;
  1831. procedure TJSONIntegerNumber.SetAsFloat(const AValue: TJSONFloat);
  1832. begin
  1833. FValue:=Round(AValue);
  1834. end;
  1835. procedure TJSONIntegerNumber.SetAsInteger(const AValue: Integer);
  1836. begin
  1837. FValue:=AValue;
  1838. end;
  1839. function TJSONIntegerNumber.GetAsJSON: TJSONStringType;
  1840. begin
  1841. Result:=AsString;
  1842. end;
  1843. function TJSONIntegerNumber.GetAsString: TJSONStringType;
  1844. begin
  1845. Result:=IntToStr(FValue)
  1846. end;
  1847. procedure TJSONIntegerNumber.SetAsString(const AValue: TJSONStringType);
  1848. begin
  1849. FValue:=StrToInt(AValue);
  1850. end;
  1851. function TJSONIntegerNumber.GetValue: TJSONVariant;
  1852. begin
  1853. Result:=FValue;
  1854. end;
  1855. procedure TJSONIntegerNumber.SetValue(const AValue: TJSONVariant);
  1856. begin
  1857. FValue:={$IFDEF PAS2JS}Integer(AValue){$else}AValue{$ENDIF};
  1858. end;
  1859. constructor TJSONIntegerNumber.Create(AValue: Integer);
  1860. begin
  1861. FValue:=AValue;
  1862. end;
  1863. class function TJSONIntegerNumber.NumberType: TJSONNumberType;
  1864. begin
  1865. Result:=ntInteger;
  1866. end;
  1867. procedure TJSONIntegerNumber.Clear;
  1868. begin
  1869. FValue:=0;
  1870. end;
  1871. function TJSONIntegerNumber.Clone: TJSONData;
  1872. begin
  1873. Result:=TJSONIntegerNumberClass(ClassType).Create(Self.FValue);
  1874. end;
  1875. {$IFNDEF PAS2JS}
  1876. { TJSONInt64Number }
  1877. function TJSONInt64Number.GetAsInt64: Int64;
  1878. begin
  1879. Result := FValue;
  1880. end;
  1881. function TJSONInt64Number.GetAsQWord: QWord;
  1882. begin
  1883. Result := FValue;
  1884. end;
  1885. procedure TJSONInt64Number.SetAsInt64(const AValue: Int64);
  1886. begin
  1887. FValue := AValue;
  1888. end;
  1889. procedure TJSONInt64Number.SetAsQword(const AValue: QWord);
  1890. begin
  1891. FValue := AValue;
  1892. end;
  1893. function TJSONInt64Number.GetAsBoolean: Boolean;
  1894. begin
  1895. Result:=FValue<>0;
  1896. end;
  1897. function TJSONInt64Number.GetAsFloat: TJSONFloat;
  1898. begin
  1899. Result:= FValue;
  1900. end;
  1901. function TJSONInt64Number.GetAsInteger: Integer;
  1902. begin
  1903. Result := FValue;
  1904. end;
  1905. procedure TJSONInt64Number.SetAsBoolean(const AValue: Boolean);
  1906. begin
  1907. FValue:=Ord(AValue);
  1908. end;
  1909. procedure TJSONInt64Number.SetAsFloat(const AValue: TJSONFloat);
  1910. begin
  1911. FValue:=Round(AValue);
  1912. end;
  1913. procedure TJSONInt64Number.SetAsInteger(const AValue: Integer);
  1914. begin
  1915. FValue:=AValue;
  1916. end;
  1917. function TJSONInt64Number.GetAsJSON: TJSONStringType;
  1918. begin
  1919. Result:=AsString;
  1920. end;
  1921. function TJSONInt64Number.GetAsString: TJSONStringType;
  1922. begin
  1923. Result:=IntToStr(FValue)
  1924. end;
  1925. procedure TJSONInt64Number.SetAsString(const AValue: TJSONStringType);
  1926. begin
  1927. FValue:=StrToInt64(AValue);
  1928. end;
  1929. function TJSONInt64Number.GetValue: TJSONVariant;
  1930. begin
  1931. Result:=FValue;
  1932. end;
  1933. procedure TJSONInt64Number.SetValue(const AValue: TJSONVariant);
  1934. begin
  1935. FValue:=AValue;
  1936. end;
  1937. constructor TJSONInt64Number.Create(AValue: Int64);
  1938. begin
  1939. FValue := AValue;
  1940. end;
  1941. class function TJSONInt64Number.NumberType: TJSONNumberType;
  1942. begin
  1943. Result:=ntInt64;
  1944. end;
  1945. procedure TJSONInt64Number.Clear;
  1946. begin
  1947. FValue:=0;
  1948. end;
  1949. function TJSONInt64Number.Clone: TJSONData;
  1950. begin
  1951. Result:=TJSONInt64NumberClass(ClassType).Create(Self.FValue);
  1952. end;
  1953. {$else}
  1954. { TJSONNativeIntNumber }
  1955. function TJSONNativeIntNumber.GetAsNativeInt: NativeInt;
  1956. begin
  1957. Result := FValue;
  1958. end;
  1959. procedure TJSONNativeIntNumber.SetAsNativeInt(const AValue: NativeInt);
  1960. begin
  1961. FValue := AValue;
  1962. end;
  1963. function TJSONNativeIntNumber.GetAsBoolean: Boolean;
  1964. begin
  1965. Result:=FValue<>0;
  1966. end;
  1967. function TJSONNativeIntNumber.GetAsFloat: TJSONFloat;
  1968. begin
  1969. Result:= FValue;
  1970. end;
  1971. function TJSONNativeIntNumber.GetAsInteger: Integer;
  1972. begin
  1973. Result := FValue;
  1974. end;
  1975. procedure TJSONNativeIntNumber.SetAsBoolean(const AValue: Boolean);
  1976. begin
  1977. FValue:=Ord(AValue);
  1978. end;
  1979. procedure TJSONNativeIntNumber.SetAsFloat(const AValue: TJSONFloat);
  1980. begin
  1981. FValue:=Round(AValue);
  1982. end;
  1983. procedure TJSONNativeIntNumber.SetAsInteger(const AValue: Integer);
  1984. begin
  1985. FValue:=AValue;
  1986. end;
  1987. function TJSONNativeIntNumber.GetAsJSON: TJSONStringType;
  1988. begin
  1989. Result:=AsString;
  1990. end;
  1991. function TJSONNativeIntNumber.GetAsString: TJSONStringType;
  1992. begin
  1993. Result:=IntToStr(FValue)
  1994. end;
  1995. procedure TJSONNativeIntNumber.SetAsString(const AValue: TJSONStringType);
  1996. begin
  1997. FValue:=StrToNativeInt(AValue);
  1998. end;
  1999. function TJSONNativeIntNumber.GetValue: TJSONVariant;
  2000. begin
  2001. Result:=FValue;
  2002. end;
  2003. procedure TJSONNativeIntNumber.SetValue(const AValue: TJSONVariant);
  2004. begin
  2005. FValue:=NativeInt(AValue);
  2006. end;
  2007. constructor TJSONNativeIntNumber.Create(AValue: NativeInt);
  2008. begin
  2009. FValue := AValue;
  2010. end;
  2011. class function TJSONNativeIntNumber.NumberType: TJSONNumberType;
  2012. begin
  2013. Result:=ntNativeInt;
  2014. end;
  2015. procedure TJSONNativeIntNumber.Clear;
  2016. begin
  2017. FValue:=0;
  2018. end;
  2019. function TJSONNativeIntNumber.Clone: TJSONData;
  2020. begin
  2021. Result:=TJSONNativeIntNumberClass(ClassType).Create(Self.FValue);
  2022. end;
  2023. {$ENDIF}
  2024. { TJSONArray }
  2025. function TJSONArray.GetBooleans(Index : Integer): Boolean;
  2026. begin
  2027. Result:=Items[Index].AsBoolean;
  2028. end;
  2029. function TJSONArray.GetArrays(Index : Integer): TJSONArray;
  2030. begin
  2031. Result:=Items[Index] as TJSONArray;
  2032. end;
  2033. function TJSONArray.GetFloats(Index : Integer): TJSONFloat;
  2034. begin
  2035. Result:=Items[Index].AsFloat;
  2036. end;
  2037. function TJSONArray.GetIntegers(Index : Integer): Integer;
  2038. begin
  2039. Result:=Items[Index].AsInteger;
  2040. end;
  2041. {$IFNDEF PAS2JS}
  2042. function TJSONArray.GetInt64s(Index : Integer): Int64;
  2043. begin
  2044. Result:=Items[Index].AsInt64;
  2045. end;
  2046. {$ELSE}
  2047. function TJSONArray.GetNativeInts(Index : Integer): NativeInt;
  2048. begin
  2049. Result:=Items[Index].AsNativeInt;
  2050. end;
  2051. {$ENDIF}
  2052. function TJSONArray.GetNulls(Index : Integer): Boolean;
  2053. begin
  2054. Result:=Items[Index].IsNull;
  2055. end;
  2056. function TJSONArray.GetObjects(Index : Integer): TJSONObject;
  2057. begin
  2058. Result:=Items[Index] as TJSONObject;
  2059. end;
  2060. {$IFNDEF PAS2JS}
  2061. function TJSONArray.GetQWords(Index : Integer): QWord;
  2062. begin
  2063. Result:=Items[Index].AsQWord;
  2064. end;
  2065. {$ENDIF}
  2066. function TJSONArray.GetStrings(Index : Integer): TJSONStringType;
  2067. begin
  2068. Result:=Items[Index].AsString;
  2069. end;
  2070. {$IFNDEF PAS2JS}
  2071. function TJSONArray.GetUnicodeStrings(Index : Integer): TJSONUnicodeStringType;
  2072. begin
  2073. Result:=Items[Index].AsUnicodeString;
  2074. end;
  2075. {$ENDIF}
  2076. function TJSONArray.GetTypes(Index : Integer): TJSONType;
  2077. begin
  2078. Result:=Items[Index].JSONType;
  2079. end;
  2080. procedure TJSONArray.SetArrays(Index : Integer; const AValue: TJSONArray);
  2081. begin
  2082. Items[Index]:=AValue;
  2083. end;
  2084. procedure TJSONArray.SetBooleans(Index : Integer; const AValue: Boolean);
  2085. begin
  2086. Items[Index]:=CreateJSON(AValue);
  2087. end;
  2088. procedure TJSONArray.SetFloats(Index : Integer; const AValue: TJSONFloat);
  2089. begin
  2090. Items[Index]:=CreateJSON(AValue);
  2091. end;
  2092. procedure TJSONArray.SetIntegers(Index : Integer; const AValue: Integer);
  2093. begin
  2094. Items[Index]:=CreateJSON(AValue);
  2095. end;
  2096. {$IFNDEF PAS2JS}
  2097. procedure TJSONArray.SetInt64s(Index : Integer; const AValue: Int64);
  2098. begin
  2099. Items[Index]:=CreateJSON(AValue);
  2100. end;
  2101. {$ELSE}
  2102. procedure TJSONArray.SetNativeInts(Index : Integer; AValue: NativeInt);
  2103. begin
  2104. Items[Index]:=CreateJSON(AValue);
  2105. end;
  2106. {$ENDIF}
  2107. procedure TJSONArray.SetObjects(Index : Integer; const AValue: TJSONObject);
  2108. begin
  2109. Items[Index]:=AValue;
  2110. end;
  2111. {$IFNDEF PAS2JS}
  2112. procedure TJSONArray.SetQWords(Index : Integer; AValue: QWord);
  2113. begin
  2114. Items[Index]:=CreateJSON(AValue);
  2115. end;
  2116. {$ENDIF}
  2117. procedure TJSONArray.SetStrings(Index : Integer; const AValue: TJSONStringType);
  2118. begin
  2119. Items[Index]:=CreateJSON(AValue);
  2120. end;
  2121. {$IFNDEF PAS2JS}
  2122. procedure TJSONArray.SetUnicodeStrings(Index: Integer;
  2123. const AValue: TJSONUnicodeStringType);
  2124. begin
  2125. Items[Index]:=CreateJSON(AValue);
  2126. end;
  2127. {$ENDIF}
  2128. function TJSONArray.DoFindPath(const APath: TJSONStringType; out
  2129. NotFound: TJSONStringType): TJSONdata;
  2130. Var
  2131. P,I : integer;
  2132. E : String;
  2133. begin
  2134. if (APath<>'') and (APath[1]='[') then
  2135. begin
  2136. P:=Pos(']',APath);
  2137. I:=-1;
  2138. If (P>2) then
  2139. I:=StrToIntDef(Copy(APath,2,P-2),-1);
  2140. If (I>=0) and (I<Count) then
  2141. begin
  2142. E:=APath;
  2143. System.Delete(E,1,P);
  2144. Result:=Items[i].DoFindPath(E,NotFound);
  2145. end
  2146. else
  2147. begin
  2148. Result:=Nil;
  2149. If (P>0) then
  2150. NotFound:=Copy(APath,1,P)
  2151. else
  2152. NotFound:=APath;
  2153. end;
  2154. end
  2155. else
  2156. Result:=inherited DoFindPath(APath, NotFound);
  2157. end;
  2158. procedure TJSONArray.Converterror(From: Boolean);
  2159. begin
  2160. If From then
  2161. DoError(SErrCannotConvertFromArray)
  2162. else
  2163. DoError(SErrCannotConvertToArray);
  2164. end;
  2165. {$warnings off}
  2166. function TJSONArray.GetAsBoolean: Boolean;
  2167. begin
  2168. ConvertError(True);
  2169. Result:=false;
  2170. end;
  2171. function TJSONArray.GetAsFloat: TJSONFloat;
  2172. begin
  2173. ConvertError(True);
  2174. Result:=0.0;
  2175. end;
  2176. function TJSONArray.GetAsInteger: Integer;
  2177. begin
  2178. ConvertError(True);
  2179. Result:=0;
  2180. end;
  2181. {$IFNDEF PAS2JS}
  2182. {$ELSE}
  2183. {$ENDIF}
  2184. procedure TJSONArray.SetAsBoolean(const AValue: Boolean);
  2185. begin
  2186. ConvertError(False);
  2187. if AValue then ;
  2188. end;
  2189. procedure TJSONArray.SetAsFloat(const AValue: TJSONFloat);
  2190. begin
  2191. ConvertError(False);
  2192. if AValue>0 then ;
  2193. end;
  2194. procedure TJSONArray.SetAsInteger(const AValue: Integer);
  2195. begin
  2196. ConvertError(False);
  2197. if AValue>0 then ;
  2198. end;
  2199. {$warnings on}
  2200. function TJSONArray.GetAsJSON: TJSONStringType;
  2201. Var
  2202. I : Integer;
  2203. Sep : String;
  2204. D : TJSONData;
  2205. V : TJSONStringType;
  2206. begin
  2207. Sep:=TJSONData.FElementSep;
  2208. Result:='[';
  2209. For I:=0 to Count-1 do
  2210. begin
  2211. D:=Items[i];
  2212. if D<>Nil then
  2213. V:=D.AsJSON
  2214. else
  2215. V:='null';
  2216. Result:=Result+V;
  2217. If (I<Count-1) then
  2218. Result:=Result+Sep;
  2219. end;
  2220. Result:=Result+']';
  2221. end;
  2222. Function IndentString(Options : TFormatOptions; Indent : Integer) : TJSONStringType;
  2223. begin
  2224. If (foUseTabChar in Options) then
  2225. Result:=StringofChar(#9,Indent)
  2226. else
  2227. Result:=StringOfChar(' ',Indent);
  2228. end;
  2229. function TJSONArray.DoFormatJSON(Options: TFormatOptions; CurrentIndent,
  2230. Indent: Integer): TJSONStringType;
  2231. Var
  2232. I : Integer;
  2233. MultiLine : Boolean;
  2234. SkipWhiteSpace : Boolean;
  2235. Ind : String;
  2236. begin
  2237. Result:='[';
  2238. MultiLine:=Not (foSingleLineArray in Options);
  2239. SkipWhiteSpace:=foSkipWhiteSpace in Options;
  2240. Ind:=IndentString(Options, CurrentIndent+Indent);
  2241. if MultiLine then
  2242. Result:=Result+sLineBreak;
  2243. For I:=0 to Count-1 do
  2244. begin
  2245. if MultiLine then
  2246. Result:=Result+Ind;
  2247. if Items[i]=Nil then
  2248. Result:=Result+'null'
  2249. else
  2250. Result:=Result+Items[i].DoFormatJSON(Options,CurrentIndent+Indent,Indent);
  2251. If (I<Count-1) then
  2252. if MultiLine then
  2253. Result:=Result+','
  2254. else
  2255. Result:=Result+ElementSeps[SkipWhiteSpace];
  2256. if MultiLine then
  2257. Result:=Result+sLineBreak
  2258. end;
  2259. if MultiLine then
  2260. Result:=Result+IndentString(Options, CurrentIndent);
  2261. Result:=Result+']';
  2262. end;
  2263. {$warnings off}
  2264. function TJSONArray.GetAsString: TJSONStringType;
  2265. begin
  2266. ConvertError(True);
  2267. Result:='';
  2268. end;
  2269. procedure TJSONArray.SetAsString(const AValue: TJSONStringType);
  2270. begin
  2271. ConvertError(False);
  2272. if AValue='' then ;
  2273. end;
  2274. function TJSONArray.GetValue: TJSONVariant;
  2275. begin
  2276. ConvertError(True);
  2277. Result:=0;
  2278. end;
  2279. procedure TJSONArray.SetValue(const AValue: TJSONVariant);
  2280. begin
  2281. ConvertError(False);
  2282. {$IFDEF PAS2JS}
  2283. if AValue=0 then ;
  2284. {$else}
  2285. if VarType(AValue)=0 then ;
  2286. {$ENDIF}
  2287. end;
  2288. {$warnings on}
  2289. function TJSONArray.GetCount: Integer;
  2290. begin
  2291. Result:=FList.Count;
  2292. end;
  2293. function TJSONArray.GetItem(Index: Integer): TJSONData;
  2294. begin
  2295. Result:=FList[Index] as TJSONData;
  2296. end;
  2297. procedure TJSONArray.SetItem(Index: Integer; const AValue: TJSONData);
  2298. begin
  2299. If (Index=FList.Count) then
  2300. FList.Add(AValue)
  2301. else
  2302. FList[Index]:=AValue;
  2303. end;
  2304. constructor TJSONArray.Create;
  2305. begin
  2306. Flist:=TFPObjectList.Create(True);
  2307. end;
  2308. {$IFDEF PAS2JS}
  2309. Function VarRecToJSON(Const Element : jsvalue; const SourceType : String) : TJSONData;
  2310. var
  2311. i: NativeInt;
  2312. VObject: TObject;
  2313. begin
  2314. Result:=nil;
  2315. if Element=nil then
  2316. Result:=CreateJSON // TJSONNull
  2317. else if isBoolean(Element) then
  2318. Result:=CreateJSON(boolean(Element))
  2319. else if isString(Element) then
  2320. Result:=CreateJSON(String(Element))
  2321. else if isNumber(Element) then
  2322. begin
  2323. if isInteger(Element) then
  2324. begin
  2325. i:=NativeInt(Element);
  2326. if (i>=low(integer)) and (i<=high(integer)) then
  2327. Result:=CreateJSON(Integer(Element))
  2328. else
  2329. Result:=CreateJSON(NativeInt(Element));
  2330. end
  2331. else
  2332. Result:=CreateJSON(TJSONFloat(Element));
  2333. end
  2334. else if isObject(Element) and (Element is TObject) then
  2335. begin
  2336. VObject:=TObject(Element);
  2337. if VObject is TJSONData then
  2338. Result:=TJSONData(VObject)
  2339. else
  2340. TJSONData.DoError(SErrNotJSONData,[VObject.ClassName,SourceType]);
  2341. end
  2342. else
  2343. TJSONData.DoError(SErrUnknownTypeInConstructor,[SourceType,jsTypeOf(Element)]);
  2344. end;
  2345. {$else}
  2346. Function VarRecToJSON(Const Element : TVarRec; const SourceType : String) : TJSONData;
  2347. begin
  2348. Result:=Nil;
  2349. With Element do
  2350. case VType of
  2351. vtInteger : Result:=CreateJSON(VInteger);
  2352. vtBoolean : Result:=CreateJSON(VBoolean);
  2353. vtChar : Result:=CreateJSON(VChar);
  2354. vtExtended : Result:=CreateJSON(VExtended^);
  2355. vtString : Result:=CreateJSON(vString^);
  2356. vtAnsiString : Result:=CreateJSON(UTF8Decode(StrPas(VPChar)));
  2357. vtUnicodeString: Result:=CreateJSON(UnicodeString(VUnicodeString));
  2358. vtWideString: Result:=CreateJSON(WideString(VWideString));
  2359. vtPChar : Result:=CreateJSON(StrPas(VPChar));
  2360. vtPointer : If (VPointer<>Nil) then
  2361. TJSONData.DoError(SErrPointerNotNil,[SourceType])
  2362. else
  2363. Result:=CreateJSON();
  2364. vtCurrency : Result:=CreateJSON(vCurrency^);
  2365. vtInt64 : Result:=CreateJSON(vInt64^);
  2366. vtObject : if (VObject is TJSONData) then
  2367. Result:=TJSONData(VObject)
  2368. else
  2369. TJSONData.DoError(SErrNotJSONData,[VObject.ClassName,SourceType]);
  2370. //vtVariant :
  2371. else
  2372. TJSONData.DoError(SErrUnknownTypeInConstructor,[SourceType,VType])
  2373. end;
  2374. end;
  2375. {$ENDIF}
  2376. constructor TJSONArray.Create(const Elements: array of {$IFDEF PAS2JS}jsvalue{$else}Const{$ENDIF});
  2377. Var
  2378. I : integer;
  2379. J : TJSONData;
  2380. begin
  2381. Create;
  2382. For I:=Low(Elements) to High(Elements) do
  2383. begin
  2384. J:=VarRecToJSON(Elements[i],'Array');
  2385. Add(J);
  2386. end;
  2387. end;
  2388. destructor TJSONArray.Destroy;
  2389. begin
  2390. FreeAndNil(FList);
  2391. inherited Destroy;
  2392. end;
  2393. class function TJSONArray.JSONType: TJSONType;
  2394. begin
  2395. Result:=jtArray;
  2396. end;
  2397. function TJSONArray.Clone: TJSONData;
  2398. Var
  2399. A : TJSONArray;
  2400. I : Integer;
  2401. begin
  2402. A:=TJSONArrayClass(ClassType).Create;
  2403. try
  2404. For I:=0 to Count-1 do
  2405. A.Add(Self.Items[I].Clone);
  2406. Result:=A;
  2407. except
  2408. A.Free;
  2409. Raise;
  2410. end;
  2411. end;
  2412. procedure TJSONArray.Iterate(Iterator: TJSONArrayIterator; Data: TObject);
  2413. Var
  2414. I : Integer;
  2415. Cont : Boolean;
  2416. begin
  2417. I:=0;
  2418. Cont:=True;
  2419. While (I<FList.Count) and cont do
  2420. begin
  2421. Iterator(Items[i],Data,Cont);
  2422. Inc(I);
  2423. end;
  2424. end;
  2425. function TJSONArray.IndexOf(obj: TJSONData): Integer;
  2426. begin
  2427. Result:=FList.IndexOf(Obj);
  2428. end;
  2429. function TJSONArray.GetEnumerator: TBaseJSONEnumerator;
  2430. begin
  2431. Result:=TJSONArrayEnumerator.Create(Self);
  2432. end;
  2433. procedure TJSONArray.Clear;
  2434. begin
  2435. FList.Clear;
  2436. end;
  2437. function TJSONArray.Add(Item: TJSONData): Integer;
  2438. begin
  2439. Result:=FList.Add(Item);
  2440. end;
  2441. function TJSONArray.Add(I: Integer): Integer;
  2442. begin
  2443. Result:=Add(CreateJSON(I));
  2444. end;
  2445. {$IFNDEF PAS2JS}
  2446. function TJSONArray.GetAsInt64: Int64;
  2447. begin
  2448. ConvertError(True);
  2449. Result:=0;
  2450. end;
  2451. function TJSONArray.GetAsQWord: QWord;
  2452. begin
  2453. ConvertError(True);
  2454. Result:=0;
  2455. end;
  2456. procedure TJSONArray.SetAsInt64(const AValue: Int64);
  2457. begin
  2458. ConvertError(False);
  2459. if AValue>0 then ;
  2460. end;
  2461. procedure TJSONArray.SetAsQword(const AValue: QWord);
  2462. begin
  2463. ConvertError(False);
  2464. if AValue>0 then ;
  2465. end;
  2466. function TJSONArray.Add(I: Int64): Int64;
  2467. begin
  2468. Result:=Add(CreateJSON(I));
  2469. end;
  2470. function TJSONArray.Add(I: QWord): QWord;
  2471. begin
  2472. Result:=Add(CreateJSON(I));
  2473. end;
  2474. function TJSONArray.Add(const S: UnicodeString): Integer;
  2475. begin
  2476. Result:=Add(CreateJSON(S));
  2477. end;
  2478. procedure TJSONArray.Insert(Index: Integer; I: Int64);
  2479. begin
  2480. FList.Insert(Index, CreateJSON(I));
  2481. end;
  2482. procedure TJSONArray.Insert(Index: Integer; I: QWord);
  2483. begin
  2484. FList.Insert(Index, CreateJSON(I));
  2485. end;
  2486. procedure TJSONArray.Insert(Index: Integer; const S: UnicodeString);
  2487. begin
  2488. FList.Insert(Index, CreateJSON(S));
  2489. end;
  2490. {$ELSE}
  2491. function TJSONArray.GetAsNativeInt: NativeInt;
  2492. begin
  2493. ConvertError(True);
  2494. Result:=0;
  2495. end;
  2496. procedure TJSONArray.SetAsNativeInt(const AValue: NativeInt);
  2497. begin
  2498. ConvertError(False);
  2499. if AValue<>0 then;
  2500. end;
  2501. function TJSONArray.Add(I: NativeInt): Integer;
  2502. begin
  2503. Result:=Add(CreateJSON(I));
  2504. end;
  2505. procedure TJSONArray.Insert(Index: Integer; I: NativeInt);
  2506. begin
  2507. FList.Insert(Index, CreateJSON(I));
  2508. end;
  2509. {$ENDIF}
  2510. function TJSONArray.Add(const S: String): Integer;
  2511. begin
  2512. Result:=Add(CreateJSON(S));
  2513. end;
  2514. function TJSONArray.Add: Integer;
  2515. begin
  2516. Result:=Add(CreateJSON);
  2517. end;
  2518. function TJSONArray.Add(F: TJSONFloat): Integer;
  2519. begin
  2520. Result:=Add(CreateJSON(F));
  2521. end;
  2522. function TJSONArray.Add(B: Boolean): Integer;
  2523. begin
  2524. Result:=Add(CreateJSON(B));
  2525. end;
  2526. function TJSONArray.Add(AnArray: TJSONArray): Integer;
  2527. begin
  2528. If (IndexOf(AnArray)<>-1) then
  2529. DoError(SErrCannotAddArrayTwice);
  2530. Result:=Add(TJSONData(AnArray));
  2531. end;
  2532. function TJSONArray.Add(AnObject: TJSONObject): Integer;
  2533. begin
  2534. If (IndexOf(AnObject)<>-1) then
  2535. DoError(SErrCannotAddObjectTwice);
  2536. Result:=Add(TJSONData(AnObject));
  2537. end;
  2538. procedure TJSONArray.Delete(Index: Integer);
  2539. begin
  2540. FList.Delete(Index);
  2541. end;
  2542. procedure TJSONArray.Exchange(Index1, Index2: Integer);
  2543. begin
  2544. FList.Exchange(Index1, Index2);
  2545. end;
  2546. function TJSONArray.Extract(Item: TJSONData): TJSONData;
  2547. begin
  2548. Result := TJSONData(FList.Extract(Item));
  2549. end;
  2550. function TJSONArray.Extract(Index: Integer): TJSONData;
  2551. begin
  2552. Result := TJSONData(FList.Extract(FList.Items[Index]));
  2553. end;
  2554. procedure TJSONArray.Insert(Index: Integer);
  2555. begin
  2556. Insert(Index,CreateJSON);
  2557. end;
  2558. procedure TJSONArray.Insert(Index: Integer; Item: TJSONData);
  2559. begin
  2560. FList.Insert(Index, Item);
  2561. end;
  2562. procedure TJSONArray.Insert(Index: Integer; I: Integer);
  2563. begin
  2564. FList.Insert(Index, CreateJSON(I));
  2565. end;
  2566. procedure TJSONArray.Insert(Index: Integer; const S: String);
  2567. begin
  2568. FList.Insert(Index, CreateJSON(S));
  2569. end;
  2570. procedure TJSONArray.Insert(Index: Integer; F: TJSONFloat);
  2571. begin
  2572. FList.Insert(Index, CreateJSON(F));
  2573. end;
  2574. procedure TJSONArray.Insert(Index: Integer; B: Boolean);
  2575. begin
  2576. FList.Insert(Index, CreateJSON(B));
  2577. end;
  2578. procedure TJSONArray.Insert(Index: Integer; AnArray: TJSONArray);
  2579. begin
  2580. if (IndexOf(AnArray)<>-1) then
  2581. DoError(SErrCannotAddArrayTwice);
  2582. FList.Insert(Index, AnArray);
  2583. end;
  2584. procedure TJSONArray.Insert(Index: Integer; AnObject: TJSONObject);
  2585. begin
  2586. if (IndexOf(AnObject)<>-1) then
  2587. DoError(SErrCannotAddObjectTwice);
  2588. FList.Insert(Index, AnObject);
  2589. end;
  2590. procedure TJSONArray.Move(CurIndex, NewIndex: Integer);
  2591. begin
  2592. FList.Move(CurIndex, NewIndex);
  2593. end;
  2594. procedure TJSONArray.Remove(Item: TJSONData);
  2595. begin
  2596. FList.Remove(Item);
  2597. end;
  2598. procedure TJSONArray.Sort(Compare: TListSortCompare);
  2599. begin
  2600. FList.Sort(Compare);
  2601. end;
  2602. { TJSONObject }
  2603. function TJSONObject.GetArrays(const AName: String): TJSONArray;
  2604. begin
  2605. Result:=GetElements(AName) as TJSONArray;
  2606. end;
  2607. function TJSONObject.GetBooleans(const AName: String): Boolean;
  2608. begin
  2609. Result:=GetElements(AName).AsBoolean;
  2610. end;
  2611. function TJSONObject.GetElements(const AName: string): TJSONData;
  2612. begin
  2613. {$IFDEF PAS2JS}
  2614. if FHash.hasOwnProperty('%'+AName) then
  2615. Result:=TJSONData(FHash['%'+AName])
  2616. else
  2617. DoError(SErrNonexistentElement,[AName]);
  2618. {$else}
  2619. Result:=TJSONData(FHash.Find(AName));
  2620. If (Result=Nil) then
  2621. DoError(SErrNonexistentElement,[AName]);
  2622. {$ENDIF}
  2623. end;
  2624. function TJSONObject.GetFloats(const AName: String): TJSONFloat;
  2625. begin
  2626. Result:=GetElements(AName).AsFloat;
  2627. end;
  2628. function TJSONObject.GetIntegers(const AName: String): Integer;
  2629. begin
  2630. Result:=GetElements(AName).AsInteger;
  2631. end;
  2632. {$IFNDEF PAS2JS}
  2633. function TJSONObject.GetInt64s(const AName: String): Int64;
  2634. begin
  2635. Result:=GetElements(AName).AsInt64;
  2636. end;
  2637. function TJSONObject.GetQWords(AName : String): QWord;
  2638. begin
  2639. Result:=GetElements(AName).AsQWord;
  2640. end;
  2641. function TJSONObject.GetUnicodeStrings(const AName: String
  2642. ): TJSONUnicodeStringType;
  2643. begin
  2644. Result:=GetElements(AName).AsUnicodeString;
  2645. end;
  2646. procedure TJSONObject.SetInt64s(const AName : String; const AValue: Int64);
  2647. begin
  2648. SetElements(AName,CreateJSON(AVAlue));
  2649. end;
  2650. procedure TJSONObject.SetQWords(AName : String; AValue: QWord);
  2651. begin
  2652. SetElements(AName,CreateJSON(AVAlue));
  2653. end;
  2654. procedure TJSONObject.SetUnicodeStrings(const AName: String;
  2655. const AValue: TJSONUnicodeStringType);
  2656. begin
  2657. SetElements(AName,CreateJSON(AValue));
  2658. end;
  2659. {$ELSE}
  2660. function TJSONObject.GetNativeInts(const AName: String): NativeInt;
  2661. begin
  2662. Result:=GetElements(AName).AsNativeInt;
  2663. end;
  2664. procedure TJSONObject.SetNativeInts(const AName: String; const AValue: NativeInt);
  2665. begin
  2666. SetElements(AName,CreateJSON(AVAlue));
  2667. end;
  2668. {$ENDIF}
  2669. function TJSONObject.GetIsNull(const AName: String): Boolean;
  2670. begin
  2671. Result:=GetElements(AName).IsNull;
  2672. end;
  2673. function TJSONObject.GetNameOf(Index: Integer): TJSONStringType;
  2674. begin
  2675. {$IFDEF PAS2JS}
  2676. if FNames=nil then
  2677. FNames:=TJSObject.getOwnPropertyNames(FHash);
  2678. if (Index<0) or (Index>=FCount) then
  2679. DoError(SListIndexError,[Index]);
  2680. Result:=copy(FNames[Index],2);
  2681. {$else}
  2682. Result:=FHash.NameOfIndex(Index);
  2683. {$ENDIF}
  2684. end;
  2685. function TJSONObject.GetObjects(const AName : String): TJSONObject;
  2686. begin
  2687. Result:=GetElements(AName) as TJSONObject;
  2688. end;
  2689. function TJSONObject.GetStrings(const AName : String): TJSONStringType;
  2690. begin
  2691. Result:=GetElements(AName).AsString;
  2692. end;
  2693. function TJSONObject.GetTypes(const AName : String): TJSONType;
  2694. begin
  2695. Result:=Getelements(Aname).JSONType;
  2696. end;
  2697. class function TJSONObject.GetUnquotedMemberNames: Boolean; {$IFNDEF PAS2JS}static;{$ENDIF}
  2698. begin
  2699. Result:=FUnquotedMemberNames;
  2700. end;
  2701. procedure TJSONObject.SetArrays(const AName : String; const AValue: TJSONArray);
  2702. begin
  2703. SetElements(AName,AVAlue);
  2704. end;
  2705. procedure TJSONObject.SetBooleans(const AName : String; const AValue: Boolean);
  2706. begin
  2707. SetElements(AName,CreateJSON(AVAlue));
  2708. end;
  2709. procedure TJSONObject.SetElements(const AName: string; const AValue: TJSONData);
  2710. {$IFDEF PAS2JS}
  2711. begin
  2712. if not FHash.hasOwnProperty('%'+AName) then
  2713. inc(FCount);
  2714. FHash['%'+AName]:=AValue;
  2715. FNames:=nil;
  2716. end;
  2717. {$else}
  2718. Var
  2719. Index : Integer;
  2720. begin
  2721. Index:=FHash.FindIndexOf(AName);
  2722. If (Index=-1) then
  2723. FHash.Add(AName,AValue)
  2724. else
  2725. FHash.Items[Index]:=AValue; // Will free the previous value.
  2726. end;
  2727. {$ENDIF}
  2728. procedure TJSONObject.SetFloats(const AName : String; const AValue: TJSONFloat);
  2729. begin
  2730. SetElements(AName,CreateJSON(AVAlue));
  2731. end;
  2732. procedure TJSONObject.SetIntegers(const AName : String; const AValue: Integer);
  2733. begin
  2734. SetElements(AName,CreateJSON(AVAlue));
  2735. end;
  2736. procedure TJSONObject.SetIsNull(const AName : String; const AValue: Boolean);
  2737. begin
  2738. If Not AValue then
  2739. DoError(SErrCannotSetNotIsNull);
  2740. SetElements(AName,CreateJSON);
  2741. end;
  2742. procedure TJSONObject.SetObjects(const AName : String; const AValue: TJSONObject);
  2743. begin
  2744. SetElements(AName,AValue);
  2745. end;
  2746. procedure TJSONObject.SetStrings(const AName : String; const AValue: TJSONStringType);
  2747. begin
  2748. SetElements(AName,CreateJSON(AValue));
  2749. end;
  2750. class procedure TJSONObject.DetermineElementQuotes;
  2751. begin
  2752. FObjStartSep:=ObjStartSeps[TJSONData.FCompressedJSON];
  2753. FObjEndSep:=ObjEndSeps[TJSONData.FCompressedJSON];
  2754. if TJSONData.FCompressedJSON then
  2755. FElementEnd:=UnSpacedQuoted[FUnquotedMemberNames]
  2756. else
  2757. FElementEnd:=SpacedQuoted[FUnquotedMemberNames];
  2758. FElementStart:=ElementStart[FUnquotedMemberNames]
  2759. end;
  2760. class procedure TJSONObject.SetUnquotedMemberNames(AValue: Boolean); {$IFNDEF PAS2JS}static;{$ENDIF}
  2761. begin
  2762. if FUnquotedMemberNames=AValue then exit;
  2763. FUnquotedMemberNames:=AValue;
  2764. DetermineElementQuotes;
  2765. end;
  2766. function TJSONObject.DoFindPath(const APath: TJSONStringType; out
  2767. NotFound: TJSONStringType): TJSONdata;
  2768. Var
  2769. N: TJSONStringType;
  2770. L,P,P2 : Integer;
  2771. begin
  2772. If (APath='') then
  2773. Exit(Self);
  2774. N:=APath;
  2775. L:=Length(N);
  2776. P:=1;
  2777. While (P<L) and (N[P]='.') do
  2778. inc(P);
  2779. P2:=P;
  2780. While (P2<=L) and (Not (N[P2] in ['.','['])) do
  2781. inc(P2);
  2782. N:=Copy(APath,P,P2-P);
  2783. If (N='') then
  2784. Result:=Self
  2785. else
  2786. begin
  2787. Result:=Find(N);
  2788. If Result=Nil then
  2789. NotFound:=N+Copy(APath,P2,L-P2)
  2790. else
  2791. begin
  2792. N:=Copy(APath,P2,L-P2+1);
  2793. Result:=Result.DoFindPath(N,NotFound);
  2794. end;
  2795. end;
  2796. end;
  2797. procedure TJSONObject.Converterror(From: Boolean);
  2798. begin
  2799. If From then
  2800. DoError(SErrCannotConvertFromObject)
  2801. else
  2802. DoError(SErrCannotConvertToObject);
  2803. end;
  2804. {$warnings off}
  2805. function TJSONObject.GetAsBoolean: Boolean;
  2806. begin
  2807. ConvertError(True);
  2808. Result:=false;
  2809. end;
  2810. function TJSONObject.GetAsFloat: TJSONFloat;
  2811. begin
  2812. ConvertError(True);
  2813. Result:=0.0;
  2814. end;
  2815. function TJSONObject.GetAsInteger: Integer;
  2816. begin
  2817. ConvertError(True);
  2818. Result:=0;
  2819. end;
  2820. procedure TJSONObject.SetAsBoolean(const AValue: Boolean);
  2821. begin
  2822. ConvertError(False);
  2823. if AValue then ;
  2824. end;
  2825. procedure TJSONObject.SetAsFloat(const AValue: TJSONFloat);
  2826. begin
  2827. ConvertError(False);
  2828. if AValue>0 then ;
  2829. end;
  2830. procedure TJSONObject.SetAsInteger(const AValue: Integer);
  2831. begin
  2832. ConvertError(False);
  2833. if AValue>0 then ;
  2834. end;
  2835. {$IFNDEF PAS2JS}
  2836. function TJSONObject.Add(const AName: String; AValue: TJSONUnicodeStringType
  2837. ): Integer;
  2838. begin
  2839. Result:=DoAdd(AName,CreateJSON(AValue));
  2840. end;
  2841. function TJSONObject.Add(const AName: TJSONStringType; Avalue: Int64): Integer;
  2842. begin
  2843. Result:=DoAdd(AName,CreateJSON(AValue));
  2844. end;
  2845. function TJSONObject.Add(const AName: TJSONStringType; Avalue: QWord): Integer;
  2846. begin
  2847. Result:=DoAdd(AName,CreateJSON(AValue));
  2848. end;
  2849. function TJSONObject.GetAsInt64: Int64;
  2850. begin
  2851. ConvertError(True);
  2852. end;
  2853. function TJSONObject.GetAsQWord: QWord;
  2854. begin
  2855. ConvertError(True);
  2856. end;
  2857. procedure TJSONObject.SetAsInt64(const AValue: Int64);
  2858. begin
  2859. ConvertError(False);
  2860. if AValue>0 then ;
  2861. end;
  2862. procedure TJSONObject.SetAsQword(const AValue: QWord);
  2863. begin
  2864. ConvertError(False);
  2865. if AValue>0 then ;
  2866. end;
  2867. {$ELSE}
  2868. function TJSONObject.GetAsNativeInt: NativeInt;
  2869. begin
  2870. ConvertError(True);
  2871. Result:=0;
  2872. end;
  2873. Procedure TJSONObject.SetAsNativeInt(const aValue : NativeInt);
  2874. begin
  2875. ConvertError(False);
  2876. if AValue<>0 then;
  2877. end;
  2878. function TJSONObject.Add(const AName: TJSONStringType; Avalue: NativeInt): Integer;
  2879. begin
  2880. Result:=DoAdd(AName,CreateJSON(AValue));
  2881. end;
  2882. {$ENDIF}
  2883. {$warnings on}
  2884. function TJSONObject.GetAsJSON: TJSONStringType;
  2885. Var
  2886. I : Integer;
  2887. Sep : String;
  2888. V : TJSONStringType;
  2889. D : TJSONData;
  2890. begin
  2891. Sep:=TJSONData.FElementSep;
  2892. Result:='';
  2893. For I:=0 to Count-1 do
  2894. begin
  2895. If (Result<>'') then
  2896. Result:=Result+Sep;
  2897. D:=Items[i];
  2898. if Assigned(D) then
  2899. V:=Items[I].AsJSON
  2900. else
  2901. V:='null';
  2902. Result:=Result+FElementStart+StringToJSONString(Names[i])+FElementEnd+V;
  2903. end;
  2904. If (Result<>'') then
  2905. Result:=FObjStartSep+Result+FObjEndSep
  2906. else
  2907. Result:='{}';
  2908. end;
  2909. {$warnings off}
  2910. function TJSONObject.GetAsString: TJSONStringType;
  2911. begin
  2912. ConvertError(True);
  2913. Result:='';
  2914. end;
  2915. procedure TJSONObject.SetAsString(const AValue: TJSONStringType);
  2916. begin
  2917. ConvertError(False);
  2918. if AValue='' then ;
  2919. end;
  2920. function TJSONObject.GetValue: TJSONVariant;
  2921. begin
  2922. ConvertError(True);
  2923. Result:=0;
  2924. end;
  2925. procedure TJSONObject.SetValue(const AValue: TJSONVariant);
  2926. begin
  2927. ConvertError(False);
  2928. {$IFDEF PAS2JS}
  2929. if AValue=0 then ;
  2930. {$else}
  2931. if VarType(AValue)=0 then ;
  2932. {$ENDIF}
  2933. end;
  2934. {$warnings on}
  2935. function TJSONObject.GetCount: Integer;
  2936. begin
  2937. {$IFDEF PAS2JS}
  2938. Result:=FCount;
  2939. {$else}
  2940. Result:=FHash.Count;
  2941. {$ENDIF}
  2942. end;
  2943. function TJSONObject.GetItem(Index: Integer): TJSONData;
  2944. begin
  2945. {$IFDEF PAS2JS}
  2946. Result:=GetElements(GetNameOf(Index));
  2947. {$else}
  2948. Result:=TJSONData(FHash.Items[Index]);
  2949. {$ENDIF}
  2950. end;
  2951. procedure TJSONObject.SetItem(Index: Integer; const AValue: TJSONData);
  2952. begin
  2953. {$IFDEF PAS2JS}
  2954. SetElements(GetNameOf(Index),AValue);
  2955. {$else}
  2956. FHash.Items[Index]:=AValue;
  2957. {$ENDIF}
  2958. end;
  2959. constructor TJSONObject.Create;
  2960. begin
  2961. {$IFDEF PAS2JS}
  2962. FHash:=TJSObject.new;
  2963. {$else}
  2964. FHash:=TFPHashObjectList.Create(True);
  2965. {$ENDIF}
  2966. end;
  2967. constructor TJSONObject.Create(const Elements: array of {$IFDEF PAS2JS}jsvalue{$else}Const{$ENDIF});
  2968. Var
  2969. I : integer;
  2970. AName : TJSONUnicodeStringType;
  2971. J : TJSONData;
  2972. begin
  2973. Create;
  2974. If ((High(Elements)-Low(Elements)) mod 2)=0 then
  2975. DoError(SErrOddNumber);
  2976. I:=Low(Elements);
  2977. While I<=High(Elements) do
  2978. begin
  2979. {$IFDEF PAS2JS}
  2980. if isString(Elements[I]) then
  2981. AName:=String(Elements[I])
  2982. else
  2983. DoError(SErrNameMustBeString,[I+1]);
  2984. {$else}
  2985. With Elements[i] do
  2986. Case VType of
  2987. vtChar : AName:=TJSONUnicodeStringType(VChar);
  2988. vtString : AName:=TJSONUnicodeStringType(vString^);
  2989. vtAnsiString : AName:=UTF8Decode(StrPas(VPChar));
  2990. vtPChar : AName:=TJSONUnicodeStringType(StrPas(VPChar));
  2991. else
  2992. DoError(SErrNameMustBeString,[I+1]);
  2993. end;
  2994. {$ENDIF}
  2995. If (AName='') then
  2996. DoError(SErrNameMustBeString,[I+1]);
  2997. Inc(I);
  2998. J:=VarRecToJSON(Elements[i],'Object');
  2999. {$IFDEF FPC_HAS_CPSTRING}
  3000. Add(UTF8Encode(AName),J);
  3001. {$ELSE}
  3002. Add(AName,J);
  3003. {$ENDIF}
  3004. Inc(I);
  3005. end;
  3006. end;
  3007. destructor TJSONObject.Destroy;
  3008. begin
  3009. {$IFDEF PAS2JS}
  3010. FHash:=nil;
  3011. {$else}
  3012. FreeAndNil(FHash);
  3013. {$ENDIF}
  3014. inherited Destroy;
  3015. end;
  3016. class function TJSONObject.JSONType: TJSONType;
  3017. begin
  3018. Result:=jtObject;
  3019. end;
  3020. function TJSONObject.Clone: TJSONData;
  3021. Var
  3022. O : TJSONObject;
  3023. I: Integer;
  3024. begin
  3025. O:=TJSONObjectClass(ClassType).Create;
  3026. try
  3027. For I:=0 to Count-1 do
  3028. O.Add(Self.Names[I],Self.Items[I].Clone);
  3029. Result:=O;
  3030. except
  3031. FreeAndNil(O);
  3032. Raise;
  3033. end;
  3034. end;
  3035. function TJSONObject.GetEnumerator: TBaseJSONEnumerator;
  3036. begin
  3037. Result:=TJSONObjectEnumerator.Create(Self);
  3038. end;
  3039. function TJSONObject.DoFormatJSON(Options: TFormatOptions; CurrentIndent,
  3040. Indent: Integer): TJSONStringType;
  3041. Var
  3042. i : Integer;
  3043. S : TJSONStringType;
  3044. MultiLine,UseQuotes, SkipWhiteSpace,SkipWhiteSpaceOnlyLeading : Boolean;
  3045. NSep,Sep,Ind : String;
  3046. V : TJSONStringType;
  3047. D : TJSONData;
  3048. begin
  3049. Result:='';
  3050. UseQuotes:=Not (foDoNotQuoteMembers in options);
  3051. MultiLine:=Not (foSingleLineObject in Options);
  3052. SkipWhiteSpace:=foSkipWhiteSpace in Options;
  3053. SkipWhiteSpaceOnlyLeading:=foSkipWhiteSpaceOnlyLeading in Options;
  3054. CurrentIndent:=CurrentIndent+Indent;
  3055. Ind:=IndentString(Options, CurrentIndent);
  3056. If SkipWhiteSpace then
  3057. begin
  3058. if SkipWhiteSpaceOnlyLeading then
  3059. NSep:=': '
  3060. else
  3061. NSep:=':'
  3062. end
  3063. else
  3064. NSep:=' : ';
  3065. If MultiLine then
  3066. Sep:=','+SLineBreak+Ind
  3067. else if SkipWhiteSpace then
  3068. Sep:=','
  3069. else
  3070. Sep:=', ';
  3071. For I:=0 to Count-1 do
  3072. begin
  3073. If (I>0) then
  3074. Result:=Result+Sep
  3075. else If MultiLine then
  3076. Result:=Result+Ind;
  3077. S:=StringToJSONString(Names[i]);
  3078. If UseQuotes then
  3079. S:='"'+S+'"';
  3080. D:=Items[i];
  3081. if D=Nil then
  3082. V:='null'
  3083. else
  3084. v:=Items[I].DoFormatJSON(Options,CurrentIndent,Indent);
  3085. Result:=Result+S+NSep+V;
  3086. end;
  3087. If (Result<>'') then
  3088. begin
  3089. if MultiLine then
  3090. Result:='{'+sLineBreak+Result+sLineBreak+indentString(options,CurrentIndent-Indent)+'}'
  3091. else
  3092. Result:=ObjStartSeps[SkipWhiteSpace]+Result+ObjEndSeps[SkipWhiteSpace]
  3093. end
  3094. else
  3095. Result:='{}';
  3096. end;
  3097. procedure TJSONObject.Iterate(Iterator: TJSONObjectIterator; Data: TObject);
  3098. {$IFDEF PAS2JS}
  3099. var
  3100. i: Integer;
  3101. Cont: Boolean;
  3102. begin
  3103. if FNames=nil then
  3104. FNames:=TJSObject.getOwnPropertyNames(FHash);
  3105. Cont:=True;
  3106. for i:=0 to length(FNames) do
  3107. begin
  3108. Iterator(copy(FNames[I],2),TJSONData(FHash[FNames[i]]),Data,Cont);
  3109. if not Cont then break;
  3110. end;
  3111. end;
  3112. {$else}
  3113. Var
  3114. I : Integer;
  3115. Cont : Boolean;
  3116. begin
  3117. I:=0;
  3118. Cont:=True;
  3119. While (I<FHash.Count) and Cont do
  3120. begin
  3121. Iterator(Names[I],Items[i],Data,Cont);
  3122. Inc(I);
  3123. end;
  3124. end;
  3125. {$ENDIF}
  3126. function TJSONObject.IndexOf(Item: TJSONData): Integer;
  3127. begin
  3128. {$IFDEF PAS2JS}
  3129. if FNames=nil then
  3130. FNames:=TJSObject.getOwnPropertyNames(FHash);
  3131. for Result:=0 to length(FNames)-1 do
  3132. if TJSONData(FHash[FNames[Result]])=Item then exit;
  3133. Result:=-1;
  3134. {$else}
  3135. Result:=FHash.IndexOf(Item);
  3136. {$ENDIF}
  3137. end;
  3138. function TJSONObject.IndexOfName(const AName: TJSONStringType; CaseInsensitive : Boolean = False): Integer;
  3139. begin
  3140. {$IFDEF PAS2JS}
  3141. if FNames=nil then
  3142. FNames:=TJSObject.getOwnPropertyNames(FHash);
  3143. Result:=TJSArray(FNames).indexOf('%'+AName); // -1 if not found
  3144. {$else}
  3145. Result:=FHash.FindIndexOf(AName);
  3146. {$ENDIF}
  3147. if (Result<0) and CaseInsensitive then
  3148. begin
  3149. Result:=Count-1;
  3150. While (Result>=0) and (CompareText(Names[Result],AName)<>0) do
  3151. Dec(Result);
  3152. end;
  3153. end;
  3154. procedure TJSONObject.Clear;
  3155. begin
  3156. {$IFDEF PAS2JS}
  3157. FCount:=0;
  3158. FHash:=TJSObject.new;
  3159. FNames:=nil;
  3160. {$else}
  3161. FHash.Clear;
  3162. {$ENDIF}
  3163. end;
  3164. function TJSONObject.DoAdd(const AName: TJSONStringType; AValue: TJSONData; FreeOnError : Boolean = True): Integer;
  3165. begin
  3166. if {$IFDEF PAS2JS}FHash.hasOwnProperty('%'+AName){$else}(IndexOfName(aName)<>-1){$ENDIF} then
  3167. begin
  3168. if FreeOnError then
  3169. FreeAndNil(AValue);
  3170. DoError(SErrDuplicateValue,[aName]);
  3171. end;
  3172. {$IFDEF PAS2JS}
  3173. FHash['%'+AName]:=AValue;
  3174. FNames:=nil;
  3175. inc(FCount);
  3176. Result:=FCount;
  3177. {$else}
  3178. Result:=FHash.Add(AName,AValue);
  3179. {$ENDIF}
  3180. end;
  3181. function TJSONObject.Add(const AName: TJSONStringType; AValue: TJSONData
  3182. ): Integer;
  3183. begin
  3184. Result:=DoAdd(aName,AValue,False);
  3185. end;
  3186. function TJSONObject.Add(const AName: TJSONStringType; AValue: Boolean
  3187. ): Integer;
  3188. begin
  3189. Result:=DoAdd(AName,CreateJSON(AValue));
  3190. end;
  3191. function TJSONObject.Add(const AName: TJSONStringType; AValue: TJSONFloat): Integer;
  3192. begin
  3193. Result:=DoAdd(AName,CreateJSON(AValue));
  3194. end;
  3195. function TJSONObject.Add(const AName, AValue: TJSONStringType): Integer;
  3196. begin
  3197. Result:=DoAdd(AName,CreateJSON(AValue));
  3198. end;
  3199. function TJSONObject.Add(const AName: TJSONStringType; Avalue: Integer): Integer;
  3200. begin
  3201. Result:=DoAdd(AName,CreateJSON(AValue));
  3202. end;
  3203. function TJSONObject.Add(const AName: TJSONStringType): Integer;
  3204. begin
  3205. Result:=DoAdd(AName,CreateJSON);
  3206. end;
  3207. function TJSONObject.Add(const AName: TJSONStringType; AValue: TJSONArray
  3208. ): Integer;
  3209. begin
  3210. Result:=DoAdd(AName,TJSONData(AValue),False);
  3211. end;
  3212. procedure TJSONObject.Delete(Index: Integer);
  3213. begin
  3214. {$IFDEF PAS2JS}
  3215. if (Index<0) or (Index>=FCount) then
  3216. DoError(SListIndexError,[Index]);
  3217. JSDelete(FHash,'%'+GetNameOf(Index));
  3218. FNames:=nil;
  3219. dec(FCount);
  3220. {$else}
  3221. FHash.Delete(Index);
  3222. {$ENDIF}
  3223. end;
  3224. procedure TJSONObject.Delete(const AName: string);
  3225. {$IFDEF PAS2JS}
  3226. begin
  3227. if not FHash.hasOwnProperty('%'+AName) then exit;
  3228. JSDelete(FHash,'%'+AName);
  3229. FNames:=nil;
  3230. dec(FCount);
  3231. end;
  3232. {$else}
  3233. Var
  3234. I : Integer;
  3235. begin
  3236. I:=IndexOfName(AName);
  3237. if (I<>-1) then
  3238. Delete(I);
  3239. end;
  3240. {$ENDIF}
  3241. procedure TJSONObject.Remove(Item: TJSONData);
  3242. {$IFDEF PAS2JS}
  3243. var AName: String;
  3244. begin
  3245. for AName in FHash do
  3246. if FHash.hasOwnProperty(AName) and (FHash[AName]=Item) then
  3247. begin
  3248. JSDelete(FHash,AName);
  3249. FNames:=nil;
  3250. dec(FCount);
  3251. exit;
  3252. end;
  3253. end;
  3254. {$else}
  3255. begin
  3256. FHash.Remove(Item);
  3257. end;
  3258. {$ENDIF}
  3259. function TJSONObject.Extract(Index: Integer): TJSONData;
  3260. {$IFDEF PAS2JS}
  3261. Var
  3262. N : String;
  3263. begin
  3264. N:=GetNameOf(Index);
  3265. Result:=Extract(N);
  3266. end;
  3267. {$ELSE}
  3268. begin
  3269. Result:=Items[Index];
  3270. FHash.Extract(Result);
  3271. end;
  3272. {$ENDIF}
  3273. function TJSONObject.Extract(const AName: string): TJSONData;
  3274. {$IFDEF PAS2JS}
  3275. begin
  3276. if FHash.hasOwnProperty('%'+AName) then
  3277. begin
  3278. Result:=TJSONData(FHash['%'+AName]);
  3279. FHash['%'+AName]:=undefined;
  3280. Dec(FCount);
  3281. end
  3282. else
  3283. Result:=nil;
  3284. end;
  3285. {$ELSE}
  3286. Var
  3287. I : Integer;
  3288. begin
  3289. I:=IndexOfName(AName);
  3290. if (I<>-1) then
  3291. Result:=Extract(I)
  3292. else
  3293. Result:=Nil
  3294. end;
  3295. {$ENDIF}
  3296. function TJSONObject.Get(const AName: String): TJSONVariant;
  3297. {$IFDEF PAS2JS}
  3298. begin
  3299. if FHash.hasOwnProperty('%'+AName) then
  3300. Result:=TJSONData(FHash['%'+AName]).Value
  3301. else
  3302. Result:=nil;
  3303. end;
  3304. {$else}
  3305. Var
  3306. I : Integer;
  3307. begin
  3308. I:=IndexOfName(AName);
  3309. If (I<>-1) then
  3310. Result:=Items[i].Value
  3311. else
  3312. Result:=Null;
  3313. end;
  3314. {$ENDIF}
  3315. function TJSONObject.Get(const AName: String; ADefault: TJSONFloat
  3316. ): TJSONFloat;
  3317. Var
  3318. D : TJSONData;
  3319. begin
  3320. D:=Find(AName,jtNumber);
  3321. If D<>Nil then
  3322. Result:=D.AsFloat
  3323. else
  3324. Result:=ADefault;
  3325. end;
  3326. function TJSONObject.Get(const AName: String; ADefault: Integer
  3327. ): Integer;
  3328. Var
  3329. D : TJSONData;
  3330. begin
  3331. D:=Find(AName,jtNumber);
  3332. If D<>Nil then
  3333. Result:=D.AsInteger
  3334. else
  3335. Result:=ADefault;
  3336. end;
  3337. {$IFNDEF PAS2JS}
  3338. function TJSONObject.Get(const AName: String; ADefault: Int64): Int64;
  3339. Var
  3340. D : TJSONData;
  3341. begin
  3342. D:=Find(AName,jtNumber);
  3343. If D<>Nil then
  3344. Result:=D.AsInt64
  3345. else
  3346. Result:=ADefault;
  3347. end;
  3348. function TJSONObject.Get(const AName: String; ADefault: QWord): QWord;
  3349. Var
  3350. D : TJSONData;
  3351. begin
  3352. D:=Find(AName,jtNumber);
  3353. If D<>Nil then
  3354. Result:=D.AsQWord
  3355. else
  3356. Result:=ADefault;
  3357. end;
  3358. {$ENDIF}
  3359. function TJSONObject.Get(const AName: String; ADefault: Boolean
  3360. ): Boolean;
  3361. Var
  3362. D : TJSONData;
  3363. begin
  3364. D:=Find(AName,jtBoolean);
  3365. If D<>Nil then
  3366. Result:=D.AsBoolean
  3367. else
  3368. Result:=ADefault;
  3369. end;
  3370. function TJSONObject.Get(const AName: String; ADefault: TJSONStringType
  3371. ): TJSONStringType;
  3372. Var
  3373. D : TJSONData;
  3374. begin
  3375. D:=Find(AName,jtString);
  3376. If (D<>Nil) then
  3377. Result:=D.AsString
  3378. else
  3379. Result:=ADefault;
  3380. end;
  3381. {$IFNDEF PAS2JS}
  3382. function TJSONObject.Get(const AName: String; ADefault: TJSONUnicodeStringType
  3383. ): TJSONUnicodeStringType;
  3384. Var
  3385. D : TJSONData;
  3386. begin
  3387. D:=Find(AName,jtString);
  3388. If (D<>Nil) then
  3389. Result:=D.AsUnicodeString
  3390. else
  3391. Result:=ADefault;
  3392. end;
  3393. {$ENDIF}
  3394. function TJSONObject.Get(const AName: String; ADefault: TJSONArray
  3395. ): TJSONArray;
  3396. Var
  3397. D : TJSONData;
  3398. begin
  3399. D:=Find(AName,jtArray);
  3400. If (D<>Nil) then
  3401. Result:=TJSONArray(D)
  3402. else
  3403. Result:=ADefault;
  3404. end;
  3405. function TJSONObject.Get(const AName: String; ADefault: TJSONObject
  3406. ): TJSONObject;
  3407. Var
  3408. D : TJSONData;
  3409. begin
  3410. D:=Find(AName,jtObject);
  3411. If (D<>Nil) then
  3412. Result:=TJSONObject(D)
  3413. else
  3414. Result:=ADefault;
  3415. end;
  3416. function TJSONObject.Find(const AName: String): TJSONData;
  3417. {$IFDEF PAS2JS}
  3418. begin
  3419. if FHash.hasOwnProperty('%'+AName) then
  3420. Result:=TJSONData(FHash['%'+AName])
  3421. else
  3422. Result:=nil;
  3423. end;
  3424. {$else}
  3425. Var
  3426. I : Integer;
  3427. begin
  3428. I:=IndexOfName(AName);
  3429. If (I<>-1) then
  3430. Result:=Items[i]
  3431. else
  3432. Result:=Nil;
  3433. end;
  3434. {$ENDIF}
  3435. function TJSONObject.Find(const AName: String; AType: TJSONType): TJSONData;
  3436. begin
  3437. Result:=Find(AName);
  3438. If Assigned(Result) and (Result.JSONType<>AType) then
  3439. Result:=Nil;
  3440. end;
  3441. function TJSONObject.Find(const key: TJSONStringType; out AValue: TJSONData): boolean;
  3442. begin
  3443. AValue := Find(key);
  3444. Result := assigned(AValue);
  3445. end;
  3446. function TJSONObject.Find(const key: TJSONStringType; out AValue: TJSONObject): boolean;
  3447. var
  3448. v: TJSONData;
  3449. begin
  3450. v := Find(key);
  3451. Result := assigned(v) and (v.JSONType = jtObject);
  3452. if Result then
  3453. AValue := TJSONObject(v);
  3454. end;
  3455. function TJSONObject.Find(const key: TJSONStringType; out AValue: TJSONArray): boolean;
  3456. var
  3457. v: TJSONData;
  3458. begin
  3459. v := Find(key);
  3460. Result := assigned(v) and (v.JSONType = jtArray);
  3461. if Result then
  3462. AValue := TJSONArray(v);
  3463. end;
  3464. function TJSONObject.Find(const key: TJSONStringType; out AValue: TJSONString): boolean;
  3465. var
  3466. v: TJSONData;
  3467. begin
  3468. v := Find(key);
  3469. Result := assigned(v) and (v.JSONType = jtString);
  3470. if Result then
  3471. AValue := TJSONString(v);
  3472. end;
  3473. function TJSONObject.Find(const key: TJSONStringType; out AValue: TJSONBoolean): boolean;
  3474. var
  3475. v: TJSONData;
  3476. begin
  3477. v := Find(key);
  3478. Result := assigned(v) and (v.JSONType = jtBoolean);
  3479. if Result then
  3480. AValue := TJSONBoolean(v);
  3481. end;
  3482. function TJSONObject.Find(const key: TJSONStringType; out AValue: TJSONNumber): boolean;
  3483. var
  3484. v: TJSONData;
  3485. begin
  3486. v := Find(key);
  3487. Result := assigned(v) and (v.JSONType = jtNumber);
  3488. if Result then
  3489. AValue := TJSONNumber(v);
  3490. end;
  3491. initialization
  3492. // Need to force initialization;
  3493. TJSONData.DetermineElementSeparators;
  3494. TJSONObject.DetermineElementQuotes;
  3495. end.