sysutils.pas 230 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424542554265427542854295430543154325433543454355436543754385439544054415442544354445445544654475448544954505451545254535454545554565457545854595460546154625463546454655466546754685469547054715472547354745475547654775478547954805481548254835484548554865487548854895490549154925493549454955496549754985499550055015502550355045505550655075508550955105511551255135514551555165517551855195520552155225523552455255526552755285529553055315532553355345535553655375538553955405541554255435544554555465547554855495550555155525553555455555556555755585559556055615562556355645565556655675568556955705571557255735574557555765577557855795580558155825583558455855586558755885589559055915592559355945595559655975598559956005601560256035604560556065607560856095610561156125613561456155616561756185619562056215622562356245625562656275628562956305631563256335634563556365637563856395640564156425643564456455646564756485649565056515652565356545655565656575658565956605661566256635664566556665667566856695670567156725673567456755676567756785679568056815682568356845685568656875688568956905691569256935694569556965697569856995700570157025703570457055706570757085709571057115712571357145715571657175718571957205721572257235724572557265727572857295730573157325733573457355736573757385739574057415742574357445745574657475748574957505751575257535754575557565757575857595760576157625763576457655766576757685769577057715772577357745775577657775778577957805781578257835784578557865787578857895790579157925793579457955796579757985799580058015802580358045805580658075808580958105811581258135814581558165817581858195820582158225823582458255826582758285829583058315832583358345835583658375838583958405841584258435844584558465847584858495850585158525853585458555856585758585859586058615862586358645865586658675868586958705871587258735874587558765877587858795880588158825883588458855886588758885889589058915892589358945895589658975898589959005901590259035904590559065907590859095910591159125913591459155916591759185919592059215922592359245925592659275928592959305931593259335934593559365937593859395940594159425943594459455946594759485949595059515952595359545955595659575958595959605961596259635964596559665967596859695970597159725973597459755976597759785979598059815982598359845985598659875988598959905991599259935994599559965997599859996000600160026003600460056006600760086009601060116012601360146015601660176018601960206021602260236024602560266027602860296030603160326033603460356036603760386039604060416042604360446045604660476048604960506051605260536054605560566057605860596060606160626063606460656066606760686069607060716072607360746075607660776078607960806081608260836084608560866087608860896090609160926093609460956096609760986099610061016102610361046105610661076108610961106111611261136114611561166117611861196120612161226123612461256126612761286129613061316132613361346135613661376138613961406141614261436144614561466147614861496150615161526153615461556156615761586159616061616162616361646165616661676168616961706171617261736174617561766177617861796180618161826183618461856186618761886189619061916192619361946195619661976198619962006201620262036204620562066207620862096210621162126213621462156216621762186219622062216222622362246225622662276228622962306231623262336234623562366237623862396240624162426243624462456246624762486249625062516252625362546255625662576258625962606261626262636264626562666267626862696270627162726273627462756276627762786279628062816282628362846285628662876288628962906291629262936294629562966297629862996300630163026303630463056306630763086309631063116312631363146315631663176318631963206321632263236324632563266327632863296330633163326333633463356336633763386339634063416342634363446345634663476348634963506351635263536354635563566357635863596360636163626363636463656366636763686369637063716372637363746375637663776378637963806381638263836384638563866387638863896390639163926393639463956396639763986399640064016402640364046405640664076408640964106411641264136414641564166417641864196420642164226423642464256426642764286429643064316432643364346435643664376438643964406441644264436444644564466447644864496450645164526453645464556456645764586459646064616462646364646465646664676468646964706471647264736474647564766477647864796480648164826483648464856486648764886489649064916492649364946495649664976498649965006501650265036504650565066507650865096510651165126513651465156516651765186519652065216522652365246525652665276528652965306531653265336534653565366537653865396540654165426543654465456546654765486549655065516552655365546555655665576558655965606561656265636564656565666567656865696570657165726573657465756576657765786579658065816582658365846585658665876588658965906591659265936594659565966597659865996600660166026603660466056606660766086609661066116612661366146615661666176618661966206621662266236624662566266627662866296630663166326633663466356636663766386639664066416642664366446645664666476648664966506651665266536654665566566657665866596660666166626663666466656666666766686669667066716672667366746675667666776678667966806681668266836684668566866687668866896690669166926693669466956696669766986699670067016702670367046705670667076708670967106711671267136714671567166717671867196720672167226723672467256726672767286729673067316732673367346735673667376738673967406741674267436744674567466747674867496750675167526753675467556756675767586759676067616762676367646765676667676768676967706771677267736774677567766777677867796780678167826783678467856786678767886789679067916792679367946795679667976798679968006801680268036804680568066807680868096810681168126813681468156816681768186819682068216822682368246825682668276828682968306831683268336834683568366837683868396840684168426843684468456846684768486849685068516852685368546855685668576858685968606861686268636864686568666867686868696870687168726873687468756876687768786879688068816882688368846885688668876888688968906891689268936894689568966897689868996900690169026903690469056906690769086909691069116912691369146915691669176918691969206921692269236924692569266927692869296930693169326933693469356936693769386939694069416942694369446945694669476948694969506951695269536954695569566957695869596960696169626963696469656966696769686969697069716972697369746975697669776978697969806981698269836984698569866987698869896990699169926993699469956996699769986999700070017002700370047005700670077008700970107011701270137014701570167017701870197020702170227023702470257026702770287029703070317032703370347035703670377038703970407041704270437044704570467047704870497050705170527053705470557056705770587059706070617062706370647065706670677068706970707071707270737074707570767077707870797080708170827083708470857086708770887089709070917092709370947095709670977098709971007101710271037104710571067107710871097110711171127113711471157116711771187119712071217122712371247125712671277128712971307131713271337134713571367137713871397140714171427143714471457146714771487149715071517152715371547155715671577158715971607161716271637164716571667167716871697170717171727173717471757176717771787179718071817182718371847185718671877188718971907191719271937194719571967197719871997200720172027203720472057206720772087209721072117212721372147215721672177218721972207221722272237224722572267227722872297230723172327233723472357236723772387239724072417242724372447245724672477248724972507251725272537254725572567257725872597260726172627263726472657266726772687269727072717272727372747275727672777278727972807281728272837284728572867287728872897290729172927293729472957296729772987299730073017302730373047305730673077308730973107311731273137314731573167317731873197320732173227323732473257326732773287329733073317332733373347335733673377338733973407341734273437344734573467347734873497350735173527353735473557356735773587359736073617362736373647365736673677368736973707371737273737374737573767377737873797380738173827383738473857386738773887389739073917392739373947395739673977398739974007401740274037404740574067407740874097410741174127413741474157416741774187419742074217422742374247425742674277428742974307431743274337434743574367437743874397440744174427443744474457446744774487449745074517452745374547455745674577458745974607461746274637464746574667467746874697470747174727473747474757476747774787479748074817482748374847485748674877488748974907491749274937494749574967497749874997500750175027503750475057506750775087509751075117512751375147515751675177518751975207521752275237524752575267527752875297530753175327533753475357536753775387539754075417542754375447545754675477548754975507551755275537554755575567557755875597560756175627563756475657566756775687569757075717572757375747575757675777578757975807581758275837584758575867587758875897590759175927593759475957596759775987599760076017602760376047605760676077608760976107611761276137614761576167617761876197620762176227623762476257626762776287629763076317632763376347635763676377638763976407641764276437644764576467647764876497650765176527653765476557656765776587659766076617662766376647665766676677668766976707671767276737674767576767677767876797680768176827683768476857686768776887689769076917692769376947695769676977698769977007701770277037704770577067707770877097710771177127713771477157716771777187719772077217722772377247725772677277728772977307731773277337734773577367737773877397740774177427743774477457746774777487749775077517752775377547755775677577758775977607761776277637764776577667767776877697770777177727773777477757776777777787779778077817782778377847785778677877788778977907791779277937794779577967797779877997800780178027803780478057806780778087809781078117812781378147815781678177818781978207821782278237824782578267827782878297830783178327833783478357836783778387839784078417842784378447845784678477848784978507851785278537854785578567857785878597860786178627863786478657866786778687869787078717872787378747875787678777878787978807881788278837884788578867887788878897890789178927893789478957896789778987899790079017902790379047905790679077908790979107911791279137914791579167917791879197920792179227923792479257926792779287929793079317932793379347935793679377938793979407941794279437944794579467947794879497950795179527953795479557956795779587959796079617962796379647965796679677968796979707971797279737974797579767977797879797980798179827983798479857986798779887989799079917992799379947995799679977998799980008001800280038004800580068007800880098010801180128013801480158016801780188019802080218022802380248025802680278028802980308031803280338034803580368037803880398040804180428043804480458046804780488049805080518052805380548055805680578058805980608061806280638064806580668067806880698070807180728073807480758076807780788079808080818082808380848085808680878088808980908091809280938094809580968097809880998100810181028103810481058106810781088109811081118112811381148115811681178118811981208121812281238124812581268127812881298130813181328133813481358136813781388139814081418142814381448145814681478148814981508151815281538154815581568157815881598160816181628163816481658166816781688169817081718172817381748175817681778178817981808181818281838184818581868187818881898190819181928193819481958196819781988199820082018202820382048205820682078208820982108211821282138214821582168217821882198220822182228223822482258226822782288229823082318232823382348235823682378238823982408241824282438244824582468247824882498250825182528253825482558256825782588259826082618262826382648265826682678268826982708271827282738274827582768277827882798280828182828283828482858286828782888289829082918292829382948295829682978298829983008301830283038304830583068307830883098310831183128313831483158316831783188319832083218322832383248325832683278328832983308331833283338334833583368337833883398340834183428343834483458346834783488349835083518352835383548355835683578358835983608361836283638364836583668367836883698370837183728373837483758376837783788379838083818382838383848385838683878388838983908391839283938394839583968397839883998400840184028403840484058406840784088409841084118412841384148415841684178418841984208421842284238424842584268427842884298430843184328433843484358436843784388439844084418442844384448445844684478448844984508451845284538454845584568457845884598460846184628463846484658466846784688469847084718472847384748475847684778478847984808481848284838484848584868487848884898490849184928493849484958496849784988499850085018502850385048505850685078508850985108511851285138514851585168517851885198520852185228523852485258526852785288529853085318532853385348535853685378538853985408541854285438544854585468547854885498550855185528553855485558556855785588559856085618562856385648565856685678568856985708571857285738574857585768577857885798580858185828583858485858586858785888589859085918592859385948595859685978598859986008601860286038604860586068607860886098610861186128613861486158616861786188619862086218622862386248625862686278628862986308631863286338634863586368637863886398640864186428643864486458646864786488649865086518652865386548655865686578658865986608661866286638664866586668667866886698670867186728673867486758676867786788679868086818682868386848685868686878688868986908691869286938694869586968697869886998700870187028703870487058706870787088709871087118712871387148715871687178718
  1. {
  2. This file is part of the Pas2JS run time library.
  3. Copyright (c) 2017 by Mattias Gaertner
  4. See the file COPYING.FPC, included in this distribution,
  5. for details about the copyright.
  6. This program is distributed in the hope that it will be useful,
  7. but WITHOUT ANY WARRANTY; without even the implied warranty of
  8. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  9. **********************************************************************}
  10. unit SysUtils;
  11. {$mode objfpc}
  12. {$modeswitch typehelpers}
  13. {$modeswitch advancedrecords}
  14. {$WARN 5078 off}
  15. interface
  16. uses
  17. RTLConsts, js;
  18. procedure FreeAndNil(var Obj);
  19. type
  20. TProcedure = procedure;
  21. {*****************************************************************************
  22. Various types
  23. *****************************************************************************}
  24. Const
  25. FloatRecDigits = 19;
  26. type
  27. TSysCharSet = Set of Char;
  28. { TFloatRec }
  29. TFloatRec = Record
  30. Exponent: Integer;
  31. Negative: Boolean;
  32. Digits: Array[0..FloatRecDigits-1] of Char;
  33. End;
  34. TEndian = (Little,Big);
  35. TFileName = String;
  36. TByteArray = array [0..32767] of Byte;
  37. TWordArray = array [0..16383] of Word;
  38. TBytes = Array of byte;
  39. TStringArray = array of string;
  40. TMonthNameArray = array [1..12] of string;
  41. TDayTable = array [1..12] of Word;
  42. TWeekNameArray = array [1..7] of string;
  43. TMonthNames = TMonthNameArray;
  44. TDayNames = array[0..6] of string;
  45. type
  46. { TFormatSettings }
  47. TFormatSettings = record
  48. strict private
  49. class function GetJSLocale: string; assembler; static;
  50. class function GetLocaleShortDayName(const ADayOfWeek: Integer; const ALocale: string): string; static;
  51. class function GetLocaleDecimalSeparator(const ALocale: string): string; static;
  52. class function GetLocaleLongMonthName(const AMonth: Integer; const ALocale: string): string; static;
  53. class function GetLocaleLongDayName(const ADayOfWeek: Integer; const ALocale: string): string; static;
  54. class function GetLocaleShortMonthName(const AMonth: Integer; const ALocale: string): string; static;
  55. public
  56. CurrencyDecimals: Byte;
  57. CurrencyFormat: Byte;
  58. CurrencyString: string;
  59. DateSeparator: Char;
  60. DateTimeToStrFormat: array[Boolean] of string;
  61. DecimalSeparator: string;
  62. LongDateFormat: string;
  63. LongDayNames: TDayNames;
  64. LongMonthNames: TMonthNames;
  65. LongTimeFormat: string;
  66. NegCurrFormat: Byte;
  67. ShortDateFormat: string;
  68. ShortDayNames: TDayNames;
  69. ShortMonthNames: TMonthNames;
  70. ShortTimeFormat: string;
  71. ThousandSeparator: string;
  72. TimeAMString: string;
  73. TimePMString: string;
  74. TimeSeparator: Char;
  75. TwoDigitYearCenturyWindow: Word;
  76. public
  77. Type
  78. TLocaleInitCallback = Procedure(const aLocale : String; aInstance : TFormatSettings);
  79. class var InitLocaleHandler : TLocaleInitCallback;
  80. class function Create: TFormatSettings; overload; static;
  81. class function Create(const ALocale: string): TFormatSettings; overload; static;
  82. end;
  83. {*****************************************************************************
  84. Exception handling
  85. *****************************************************************************}
  86. { Exception }
  87. Exception = class(TObject)
  88. private
  89. fMessage: String;
  90. fHelpContext: Integer;
  91. {$ifdef NodeJS}
  92. FNodeJSError: TJSError;
  93. {$endif}
  94. public
  95. class var
  96. LogMessageOnCreate : Boolean;
  97. Public
  98. constructor Create(const Msg: String); reintroduce;
  99. constructor CreateFmt(const Msg: string; const Args: array of jsvalue);
  100. constructor CreateHelp(const Msg: String; AHelpContext: Integer);
  101. constructor CreateFmtHelp(const Msg: string; const Args: array of jsvalue; AHelpContext: Integer);
  102. function ToString: String; override;
  103. property HelpContext: Integer read fHelpContext write fHelpContext;
  104. property Message: String read fMessage write fMessage;
  105. {$ifdef NodeJS}
  106. property NodeJSError: TJSError read FNodeJSError write FNodeJSError;
  107. {$endif}
  108. end;
  109. ExceptClass = class of Exception;
  110. EExternal = class(Exception);
  111. { General math errors }
  112. EMathError = class(EExternal);
  113. EInvalidOp = class(EMathError);
  114. EZeroDivide = class(EMathError);
  115. EOverflow = class(EMathError);
  116. EUnderflow = class(EMathError);
  117. EAbort = class(Exception);
  118. EInvalidCast = class(Exception);
  119. EAssertionFailed = class(Exception);
  120. EObjectCheck = class(Exception);
  121. { String conversion errors }
  122. EConvertError = class(Exception);
  123. EFormatError = class(Exception);
  124. { integer math exceptions }
  125. EIntError = Class(EExternal);
  126. EDivByZero = Class(EIntError);
  127. ERangeError = Class(EIntError);
  128. EIntOverflow = Class(EIntError);
  129. { General math errors }
  130. { Run-time and I/O Errors }
  131. EInOutError = class(Exception)
  132. public
  133. ErrorCode : Integer;
  134. end;
  135. EHeapMemoryError = class(Exception);
  136. EHeapException = EHeapMemoryError;
  137. EExternalException = class(EExternal);
  138. EInvalidPointer = Class(EHeapMemoryError);
  139. EOutOfMemory = Class(EHeapMemoryError);
  140. { EVariantError }
  141. EVariantError = Class(Exception)
  142. ErrCode : longint;
  143. Constructor CreateCode(Code : Longint);
  144. end;
  145. EAccessViolation = Class(EExternal);
  146. EBusError = Class(EAccessViolation);
  147. EPrivilege = class(EExternal);
  148. EStackOverflow = class(EExternal);
  149. EControlC = class(EExternal);
  150. { String conversion errors }
  151. { Other errors }
  152. EAbstractError = Class(Exception);
  153. EPropReadOnly = class(Exception);
  154. EPropWriteOnly = class(Exception);
  155. EIntfCastError = class(Exception);
  156. EInvalidContainer = class(Exception);
  157. EInvalidInsert = class(Exception);
  158. EPackageError = class(Exception);
  159. EOSError = class(Exception)
  160. public
  161. ErrorCode: Longint;
  162. end;
  163. ESafecallException = class(Exception);
  164. ENoThreadSupport = Class(Exception);
  165. ENoWideStringSupport = Class(Exception);
  166. ENotImplemented = class(Exception);
  167. EArgumentException = class(Exception);
  168. EArgumentOutOfRangeException = class(EArgumentException);
  169. EArgumentNilException = class(EArgumentException);
  170. EPathTooLongException = class(Exception);
  171. ENotSupportedException = class(Exception);
  172. EDirectoryNotFoundException = class(Exception);
  173. EFileNotFoundException = class(Exception);
  174. EPathNotFoundException = class(Exception);
  175. ENoConstructException = class(Exception);
  176. //function GetTickCount: Integer;
  177. {*****************************************************************************
  178. String function
  179. *****************************************************************************}
  180. Const
  181. EmptyStr = '';
  182. EmptyWideStr = ''; // No difference here.
  183. HexDisplayPrefix: string = '$';
  184. LeadBytes = [] unimplemented;
  185. Function CharInSet(Ch: Char;Const CSet : array of char) : Boolean; overload;
  186. function LeftStr(const S: string; Count: Integer): String; assembler;
  187. function RightStr(const S: string; Count: Integer): String; assembler;
  188. function Trim(const S: String): String; assembler;
  189. function TrimLeft(const S: String): String; assembler;
  190. function TrimRight(const S: String): String; assembler;
  191. function UpperCase(const s: String): String; assembler; overload;
  192. function LowerCase(const s: String): String; assembler; overload;
  193. function CompareStr(const s1, s2: String): Integer; assembler;
  194. function SameStr(const s1, s2: String): Boolean; assembler;
  195. function CompareText(const s1, s2: String): Integer; assembler;
  196. function SameText(const s1, s2: String): Boolean; assembler;
  197. function AnsiCompareText(const s1, s2: String): Integer; assembler;
  198. function AnsiSameText(const s1, s2: String): Boolean; assembler;
  199. function AnsiCompareStr(const s1, s2: String): Integer;
  200. procedure AppendStr(var Dest: String; const S: string);
  201. function Format(const Fmt: String; const Args: array of JSValue): String;
  202. function Format(const Fmt: String; const Args: array of JSValue; const aSettings : TFormatSettings): String;
  203. function BytesOf(const AVal: string): TBytes;
  204. function StringOf(const ABytes: TBytes): string;
  205. // JavaScript built-in functions
  206. function LocaleCompare(const s1, s2, locales: String): Boolean; assembler; overload;
  207. function NormalizeStr(const S: String; const Norm: String = 'NFC'): String; assembler; overload; // not in IE
  208. function IsValidIdent(const Ident: string; AllowDots: Boolean = False; StrictDots: Boolean = False): Boolean;
  209. Type
  210. TStringReplaceFlag = (rfReplaceAll, rfIgnoreCase);
  211. TReplaceFlag = TStringReplaceFlag;
  212. TStringReplaceFlags = set of TStringReplaceFlag;
  213. TReplaceFlags = TStringReplaceFlags;
  214. function StringReplace(aOriginal, aSearch, aReplace: string; Flags: TStringReplaceFlags): String;
  215. function QuoteString(aOriginal: String; AQuote: Char): String;
  216. function QuotedStr(const s: string; QuoteChar: Char = ''''): string;
  217. function DeQuoteString(aQuoted: String; AQuote: Char): String;
  218. Function LastDelimiter(const Delimiters, S: string): SizeInt;
  219. function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean;
  220. function AdjustLineBreaks(const S: string): string;
  221. function AdjustLineBreaks(const S: string; Style: TTextLineBreakStyle): string;
  222. function WrapText(const Line, BreakStr: string; const BreakChars: Array of char; MaxCol: Integer): string;
  223. function WrapText(const Line: string; MaxCol: Integer): string;
  224. { *****************************************************************************
  225. Integer conversions
  226. *****************************************************************************}
  227. Function SwapEndian(W : Word) : Word;
  228. Function SwapEndian(C : Cardinal) : Cardinal;
  229. function IntToStr(const Value: Integer): string;
  230. Function TryStrToInt(const S : String; Out res : Integer) : Boolean;
  231. Function TryStrToInt(const S : String; Out res : NativeInt) : Boolean;
  232. function TryStrToInt(const S: String; out res: NativeInt; Const aSettings : TFormatSettings): Boolean;
  233. Function StrToIntDef(const S : String; Const aDef : Integer) : Integer;
  234. Function StrToIntDef(const S : String; Const aDef : NativeInt) : NativeInt;
  235. Function StrToInt(const S : String) : Integer;
  236. Function StrToNativeInt(const S : String) : NativeInt;
  237. function StrToUInt(const s: string): Cardinal;
  238. function StrToUIntDef(const s: string; aDef : Cardinal): Cardinal;
  239. function UIntToStr(Value: Cardinal): string;
  240. function TryStrToUInt(const s: string; out C: Cardinal): Boolean;
  241. // For compatibility
  242. Function StrToInt64(const S : String) : NativeLargeInt;
  243. Function StrToInt64Def(const S : String; ADefault : NativeLargeInt) : NativeLargeInt;
  244. Function TryStrToInt64(const S : String; Out res : NativeLargeInt) : Boolean; overload;
  245. Function TryStrToInt64(const S : String; Out res : Int64) : Boolean; unimplemented; overload; // only 53 bits
  246. Function StrToQWord(const S : String) : NativeLargeUInt;
  247. Function StrToQWordDef(const S : String; ADefault : NativeLargeUInt) : NativeLargeUInt;
  248. Function TryStrToQWord(const S : String; Out res : NativeLargeUInt) : Boolean; overload;
  249. Function TryStrToQWord(const S : String; Out res : QWord) : Boolean; unimplemented; overload; // only 52 bits
  250. Function StrToUInt64(const S : String) : NativeLargeUInt;
  251. Function StrToUInt64Def(const S : String; ADefault : NativeLargeUInt) : NativeLargeUInt;
  252. Function TryStrToUInt64(const S : String; Out res : NativeLargeUInt) : Boolean; overload;
  253. Function TryStrToUInt64(const S : String; Out res : UInt64) : Boolean; unimplemented; overload; // only 52 bits
  254. Function StrToDWord(const S : String) : DWord;
  255. Function StrToDWordDef(const S : String; ADefault : DWord) : DWord;
  256. Function TryStrToDWord(const S : String; Out res : DWord) : Boolean;
  257. function IntToHex(Value: NativeInt; Digits: Integer): string; overload;
  258. { *****************************************************************************
  259. Float conversions
  260. *****************************************************************************}
  261. const
  262. // Note: Currency is internally a double, multiplied by 10000 and truncated.
  263. // The below values are the safe limits, within every step exists.
  264. // Since currency is a double it can take much larger values, but the result
  265. // may differ from Delphi/FPC
  266. MaxCurrency: Currency = 900719925474.0991; // fpc: 922337203685477.5807;
  267. MinCurrency: Currency = -900719925474.0991; // fpc: -922337203685477.5808;
  268. Type
  269. TFloatFormat = (ffFixed,ffGeneral,ffExponent,ffNumber,ffCurrency);
  270. Function FloatToDecimal(Value : double; Precision, Decimals : integer) : TFloatRec;
  271. Function FloatToStr(Value: Double): String; overload;
  272. Function FloatToStr(Value: Double; const aSettings : TFormatSettings): String; overload;
  273. Function FloatToStrF(const Value : double; format: TFloatFormat; Precision, Digits: Integer): String; overload;
  274. Function FloatToStrF(const Value : double; format: TFloatFormat; Precision, Digits: Integer;const aSettings : TFormatSettings): String; overload;
  275. Function TryStrToFloat(const S : String; Out res : Extended) : Boolean; overload;
  276. Function TryStrToFloat(const S : String; Out res : Extended; const aSettings : TFormatSettings) : Boolean; overload;
  277. Function TryStrToFloat(const S : String; Out res : Double) : Boolean; overload;
  278. Function TryStrToFloat(const S : String; Out res : Double; const aSettings : TFormatSettings) : Boolean; overload;
  279. Function StrToFloatDef(const S : String; Const aDef : Double) : Double;
  280. function StrToFloatDef(const S: String; const aDef: Double; const aSettings : TFormatSettings): Double;
  281. Function StrToFloat(const S : String) : Double; overload;
  282. Function StrToFloat(const S : String; const aSettings : TFormatSettings) : Double; overload;
  283. Function FormatFloat (Fmt : String; aValue : Double) : String; overload;
  284. Function FormatFloat (Fmt : String; aValue : Double; aSettings : TFormatSettings) : String; overload;
  285. { *****************************************************************************
  286. Boolean conversions
  287. *****************************************************************************}
  288. Var
  289. TrueBoolStrs, FalseBoolStrs : Array of String;
  290. function StrToBool(const S: String): Boolean;
  291. function BoolToStr(B: Boolean; UseBoolStrs:Boolean=False): string;
  292. function BoolToStr(B: Boolean; const TrueS, FalseS: String): string;
  293. function StrToBoolDef(const S: String; Default: Boolean): Boolean;
  294. function TryStrToBool(const S: String; out Value: Boolean): Boolean;
  295. {*****************************************************************************
  296. OS/Environment
  297. *****************************************************************************}
  298. Const
  299. ConfigExtension : String = '.cfg';
  300. SysConfigDir : String = '';
  301. type
  302. TOnGetEnvironmentVariable = function(Const EnvVar: String): String;
  303. TOnGetEnvironmentString = function(Index: Integer): String;
  304. TOnGetEnvironmentVariableCount = function: Integer;
  305. TShowExceptionHandler = Procedure (Const Msg : String);
  306. TUncaughtPascalExceptionHandler = reference to Procedure(aObject : TObject);
  307. TUncaughtJSExceptionHandler = reference to Procedure(aObject : TJSObject);
  308. var
  309. OnGetEnvironmentVariable: TOnGetEnvironmentVariable;
  310. OnGetEnvironmentString: TOnGetEnvironmentString;
  311. OnGetEnvironmentVariableCount: TOnGetEnvironmentVariableCount;
  312. // Handler to show an exception (used when showexception is called)
  313. OnShowException : TShowExceptionHandler = nil;
  314. // Set handlers for uncaught exceptions. These will call HookUncaughtExceptions
  315. // They return the old exception handler, if there was any.
  316. Function SetOnUnCaughtExceptionHandler(aValue : TUncaughtPascalExceptionHandler) : TUncaughtPascalExceptionHandler;
  317. Function SetOnUnCaughtExceptionHandler(aValue : TUncaughtJSExceptionHandler) : TUncaughtJSExceptionHandler;
  318. // Hook the rtl handler for uncaught exceptions. If any exception handlers were set, they will be called.
  319. // If none were set, the exceptions will be displayed using ShowException.
  320. Procedure HookUncaughtExceptions;
  321. function GetEnvironmentVariable(Const EnvVar: String): String;
  322. function GetEnvironmentVariableCount: Integer;
  323. function GetEnvironmentString(Index: Integer): String;
  324. procedure ShowException(ExceptObject: TObject; ExceptAddr: Pointer = Nil);
  325. Procedure Abort;
  326. {*****************************************************************************
  327. Events
  328. *****************************************************************************}
  329. Type
  330. TEventType = (etCustom,etInfo,etWarning,etError,etDebug);
  331. TEventTypes = Set of TEventType;
  332. {*****************************************************************************
  333. Date and time
  334. *****************************************************************************}
  335. Type
  336. TSystemTime = record
  337. Year, Month, Day, DayOfWeek: word;
  338. Hour, Minute, Second, MilliSecond: word;
  339. end ;
  340. TTimeStamp = record
  341. Time: longint; { Number of milliseconds since midnight }
  342. Date: longint; { One plus number of days since 1/1/0001 }
  343. end ;
  344. Var
  345. TimeSeparator : char deprecated;
  346. DateSeparator : char deprecated;
  347. ShortDateFormat : string deprecated;
  348. LongDateFormat : string deprecated;
  349. ShortTimeFormat : string deprecated;
  350. LongTimeFormat : string deprecated;
  351. DecimalSeparator : string deprecated;
  352. ThousandSeparator : string deprecated;
  353. TimeAMString : string deprecated;
  354. TimePMString : string deprecated;
  355. const
  356. HoursPerDay = 24;
  357. MinsPerHour = 60;
  358. SecsPerMin = 60;
  359. MSecsPerSec = 1000;
  360. MinsPerDay = HoursPerDay * MinsPerHour;
  361. SecsPerDay = MinsPerDay * SecsPerMin;
  362. MSecsPerDay = SecsPerDay * MSecsPerSec;
  363. MaxDateTime: TDateTime = 2958465.99999999;
  364. MinDateTime: TDateTime = -693593.99999999;
  365. JulianEpoch = TDateTime(-2415018.5);
  366. UnixEpoch = JulianEpoch + TDateTime(2440587.5);
  367. DateDelta = 693594; // Days between 1/1/0001 and 12/31/1899
  368. UnixDateDelta = 25569;
  369. { True=Leapyear }
  370. Var
  371. MonthDays : array [Boolean] of TDayTable =
  372. ((31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31),
  373. (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31));
  374. Var
  375. ShortMonthNames : TMonthNames deprecated;
  376. LongMonthNames : TMonthNames deprecated;
  377. ShortDayNames : TDayNames deprecated;
  378. LongDayNames : TDayNames deprecated;
  379. Var
  380. FormatSettings: TFormatSettings;
  381. TwoDigitYearCenturyWindow : word = 50;
  382. { Threshold to be subtracted from year before age-detection.}
  383. // Various conversions
  384. function DateTimeToJSDate(aDateTime : TDateTime) : TJSDate;
  385. function JSDateToDateTime(aDate : TJSDate) : TDateTime;
  386. function DateTimeToTimeStamp(DateTime: TDateTime): TTimeStamp;
  387. function TimeStampToDateTime(const TimeStamp: TTimeStamp): TDateTime;
  388. function MSecsToTimeStamp(MSecs: NativeInt): TTimeStamp;
  389. function TimeStampToMSecs(const TimeStamp: TTimeStamp): NativeInt;
  390. procedure DateTimeToSystemTime(DateTime: TDateTime; out SystemTime: TSystemTime);
  391. function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime;
  392. Function FloatToDateTime (Const Value : Extended) : TDateTime;
  393. // Encode/Decode
  394. function TryEncodeDate(Year, Month, Day: Word; out Date: TDateTime): Boolean; overload;
  395. function TryEncodeTime(Hour, Min, Sec, MSec: Word; out Time: TDateTime): Boolean;
  396. function EncodeDate(Year, Month, Day :word): TDateTime;
  397. function EncodeTime(Hour, Minute, Second, MilliSecond:word): TDateTime;
  398. procedure DecodeDate(Date: TDateTime; out Year, Month, Day: word);
  399. procedure DecodeTime(Time: TDateTime; out Hour, Minute, Second, MilliSecond: word);
  400. function DecodeDateFully(const DateTime: TDateTime; out Year, Month, Day, DOW: Word): Boolean;
  401. function ComposeDateTime(Date,Time : TDateTime) : TDateTime;
  402. procedure ReplaceTime(var dati: TDateTime; NewTime : TDateTime);
  403. procedure ReplaceDate(var DateTime: TDateTime; const NewDate: TDateTime);
  404. function Date: TDateTime;
  405. function Time: TDateTime;
  406. function Now: TDateTime;
  407. function DayOfWeek(DateTime: TDateTime): integer;
  408. function IncMonth(const DateTime: TDateTime; NumberOfMonths: integer = 1 ): TDateTime;
  409. procedure IncAMonth(var Year, Month, Day: Word; NumberOfMonths: Integer = 1);
  410. function IsLeapYear(Year: Word): boolean;
  411. function CurrentYear:Word;
  412. // Date <-> String conversion
  413. function DateToStr(Date: TDateTime): string; overload;
  414. function DateToStr(Date: TDateTime; const aSettings: TFormatSettings): string; overload;
  415. function StrToDate(const S: String): TDateTime; overload;
  416. function StrToDate(const S: String; separator : char): TDateTime; overload;
  417. function StrToDate(const S: String; const useformat : string; separator : char): TDateTime; overload;
  418. function StrToDate(const S: string; const aSettings : TFormatSettings): TDateTime; overload;
  419. function TryStrToDate(const S: String; out Value: TDateTime): Boolean; overload;
  420. function TryStrToDate(const S: String; out Value: TDateTime; const aSettings : TFormatSettings): Boolean; overload;
  421. function TryStrToDate(const S: String; out Value: TDateTime; separator : char): Boolean; overload;
  422. function TryStrToDate(const S: String; out Value: TDateTime; const useformat : string; separator : char): Boolean; overload;
  423. function StrToDateDef(const S: String; const Defvalue : TDateTime): TDateTime; overload;
  424. function StrToDateDef(const S: String; const Defvalue : TDateTime; separator : char): TDateTime; overload;
  425. // Time <-> String conversion
  426. function TimeToStr(Time: TDateTime): string;overload;
  427. function TimeToStr(Time: TDateTime; const aSettings: TFormatSettings): string;overload;
  428. function StrToTime(const S: String): TDateTime;overload;
  429. function StrToTime(const S: String; separator : char): TDateTime;overload;
  430. function StrToTime(const S: string; const aSettings : TFormatSettings): TDateTime;overload;
  431. function TryStrToTime(const S: String; out Value: TDateTime): Boolean;overload;
  432. function TryStrToTime(const S: String; out Value: TDateTime; aSettings : TFormatSettings): Boolean;overload;
  433. function TryStrToTime(const S: String; out Value: TDateTime; separator : char): Boolean; overload;
  434. function StrToTimeDef(const S: String; const Defvalue : TDateTime): TDateTime;overload;
  435. function StrToTimeDef(const S: String; const Defvalue : TDateTime; separator : char): TDateTime;overload;
  436. function StrToTimeDef(const AString: string; const ADefault: TDateTime; const aSettings: TFormatSettings): TDateTime;
  437. // DateTime <-> String conversion
  438. function DateTimeToStr(DateTime: TDateTime; ForceTimeIfZero : Boolean = False): string;overload;
  439. function DateTimeToStr(DateTime: TDateTime; const aSettings: TFormatSettings; ForceTimeIfZero : Boolean = False): string;overload;
  440. function StrToDateTime(const S: String): TDateTime;overload;
  441. function StrToDateTime(const s: String; const aSettings : TFormatSettings): TDateTime;overload;
  442. function TryStrToDateTime(const S: String; out Value: TDateTime): Boolean; overload;
  443. function TryStrToDateTime(const S: string; out Value: TDateTime; const aSettings: TFormatSettings): Boolean; overload;
  444. function StrToDateTimeDef(const S: String; const Defvalue : TDateTime): TDateTime; overload;
  445. function StrToDateTimeDef(const S: String; const Defvalue : TDateTime; aSettings : TFormatSettings): TDateTime; overload;
  446. function FormatDateTime(const FormatStr: string; const DateTime: TDateTime): string; overload;
  447. function FormatDateTime(const FormatStr: string; const DateTime: TDateTime; const aSettings: TFormatSettings): string; overload;
  448. { *****************************************************************************
  449. Currency support
  450. *****************************************************************************}
  451. Var
  452. CurrencyFormat : Byte deprecated;
  453. NegCurrFormat : Byte deprecated;
  454. CurrencyDecimals : Byte deprecated;
  455. CurrencyString : String deprecated;
  456. Function FloattoCurr (Const Value : Extended) : Currency;
  457. function TryFloatToCurr(const Value: Extended; var AResult: Currency): Boolean;
  458. Function CurrToStr(Value: Currency): string;
  459. Function CurrToStr(Value: Currency; Const aSettings: TFormatSettings): string;
  460. function StrToCurr(const S: string): Currency;
  461. function StrToCurr(const S: string; Const aSettings: TFormatSettings): Currency;
  462. function TryStrToCurr(const S: string;Out Value : Currency): Boolean;
  463. function TryStrToCurr(const S: string;Out Value : Currency; Const aSettings: TFormatSettings): Boolean;
  464. function StrToCurrDef(const S: string; Default : Currency): Currency;
  465. function StrToCurrDef(const S: string; Default : Currency; Const aSettings: TFormatSettings): Currency;
  466. {*****************************************************************************
  467. File Paths
  468. *****************************************************************************}
  469. type
  470. PathStr = String;
  471. TPathStrArray = Array of PathStr;
  472. function ChangeFileExt(const FileName, Extension: PathStr): PathStr;
  473. function ExtractFilePath(const FileName: PathStr): PathStr;
  474. function ExtractFileDrive(const FileName: PathStr): PathStr;
  475. function ExtractFileName(const FileName: PathStr): PathStr;
  476. function ExtractFileExt(const FileName: PathStr): PathStr;
  477. function ExtractFileDir(Const FileName : PathStr): PathStr;
  478. function ExtractRelativepath (Const BaseName,DestName : PathStr): PathStr;
  479. function IncludeTrailingPathDelimiter(Const Path : PathStr) : PathStr;
  480. function ExcludeTrailingPathDelimiter(Const Path: PathStr): PathStr;
  481. function IncludeLeadingPathDelimiter(Const Path : PathStr) : PathStr;
  482. function ExcludeLeadingPathDelimiter(Const Path: PathStr): PathStr;
  483. function IsPathDelimiter(Const Path: PathStr; Index: Integer): Boolean;
  484. Function SetDirSeparators (Const FileName : PathStr) : PathStr;
  485. Function GetDirs (DirName : PathStr) : TPathStrArray;
  486. function ConcatPaths(const Paths: array of PathStr): PathStr;
  487. {*****************************************************************************
  488. Interfaces
  489. *****************************************************************************}
  490. const
  491. GUID_NULL: TGuid = '{00000000-0000-0000-0000-000000000000}';
  492. function Supports(const Instance: IInterface; const AClass: TClass; out Obj): Boolean; overload;
  493. function Supports(const Instance: IInterface; const IID: TGuid; out Intf): Boolean; overload;
  494. function Supports(const Instance: TObject; const IID: TGuid; out Intf): Boolean; overload;
  495. function Supports(const Instance: TObject; const IID: TGuidString; out Intf): Boolean; overload;
  496. function Supports(const Instance: IInterface; const AClass: TClass): Boolean; overload;
  497. function Supports(const Instance: IInterface; const IID: TGuid): Boolean; overload;
  498. function Supports(const Instance: TObject; const IID: TGuid): Boolean; overload;
  499. function Supports(const Instance: TObject; const IID: TGuidString): Boolean; overload;
  500. function Supports(const AClass: TClass; const IID: TGuid): Boolean; overload;
  501. function Supports(const AClass: TClass; const IID: TGuidString): Boolean; overload;
  502. function TryStringToGUID(const s: string; out Guid: TGuid): Boolean;
  503. function StringToGUID(const S: string): TGuid;
  504. function GUIDToString(const guid: TGuid): string;
  505. function IsEqualGUID(const guid1, guid2: TGuid): Boolean;
  506. function GuidCase(const guid: TGuid; const List: array of TGuid): Integer;
  507. Function CreateGUID(out GUID : TGUID) : Integer;
  508. Function EncodeHTMLEntities (S : String) : String;
  509. { ---------------------------------------------------------------------
  510. Type Helpers
  511. ---------------------------------------------------------------------}
  512. Type
  513. TCharArray = Array of char;
  514. TByteBitIndex = 0..7;
  515. TShortIntBitIndex = 0..7;
  516. TWordBitIndex = 0..15;
  517. TSmallIntBitIndex = 0..15;
  518. TCardinalBitIndex = 0..31;
  519. TIntegerBitIndex = 0..31;
  520. TLongIntBitIndex = TIntegerBitIndex;
  521. TQwordBitIndex = 0..52;
  522. TInt64BitIndex = 0..52;
  523. TNativeIntBitIndex = 0..52;
  524. TNativeUIntBitIndex = 0..52;
  525. Const
  526. CPUEndian = {$IFNDEF FPC_LITTLE_ENDIAN}TEndian.Big{$ELSE}TEndian.Little{$ENDIF};
  527. Type
  528. { TGuidHelper }
  529. TGuidHelper = record helper for TGUID
  530. class function Create(Src : TGUID; BigEndian: Boolean): TGUID; overload; static;
  531. class function Create(const Buf : TJSArrayBuffer; AStartIndex: Cardinal; BigEndian: Boolean): TGUID; overload; static;
  532. class function Create(const Data: array of Byte; AStartIndex: Cardinal; BigEndian: Boolean): TGUID; overload; static;
  533. Class Function Create(const B: TBytes; DataEndian: TEndian = CPUEndian): TGUID; overload; static; inline;
  534. Class Function Create(const B: TBytes; AStartIndex: Cardinal; DataEndian: TEndian = CPUEndian): TGUID; overload; static;
  535. Class Function Create(const S: string): TGUID; overload; static;
  536. Class Function Create(A: Integer; B: SmallInt; C: SmallInt; const D: TBytes): TGUID; overload; static;
  537. // Class Function Create(A: Integer; B: SmallInt; C: SmallInt; D, E, F, G, H, I, J, K: Byte): TGUID; overload; static;
  538. Class Function Create(A: Cardinal; B: Word; C: Word; D, E, F, G, H, I, J, K: Byte): TGUID; overload; static;
  539. Class Function NewGuid: TGUID; static;
  540. Function ToByteArray(DataEndian: TEndian = CPUEndian): TBytes;
  541. Function ToString(SkipBrackets: Boolean = False): string;
  542. end;
  543. {$SCOPEDENUMS ON}
  544. TStringSplitOptions = (None, ExcludeEmpty);
  545. {$SCOPEDENUMS OFF}
  546. { TStringHelper }
  547. TStringHelper = Type Helper for String
  548. Private
  549. Function GetChar(AIndex : SizeInt) : Char;
  550. Function GetLength : SizeInt;
  551. public
  552. const Empty = '';
  553. // Methods
  554. Class Function Compare(const A: string; const B: string): Integer; overload; static; //inline;
  555. Class Function Compare(const A: string; const B: string; IgnoreCase: Boolean): Integer; overload; static; //inline; //deprecated 'Use same with TCompareOptions';
  556. Class Function Compare(const A: string; const B: string; Options: TCompareOptions): Integer; overload; static; // inline;
  557. Class Function Compare(const A: string; IndexA: SizeInt; const B: string; IndexB: SizeInt; ALen: SizeInt): Integer; overload; static; // inline;
  558. Class Function Compare(const A: string; IndexA: SizeInt; const B: string; IndexB: SizeInt; ALen: SizeInt; IgnoreCase: Boolean): Integer; overload; static; // inline; //deprecated 'Use same with TCompareOptions';
  559. Class Function Compare(const A: string; IndexA: SizeInt; const B: string; IndexB: SizeInt; ALen: SizeInt; Options: TCompareOptions): Integer; overload; static;// inline;
  560. Class Function CompareOrdinal(const A: string; const B: string): Integer; overload; static;
  561. Class Function CompareOrdinal(const A: string; IndexA: SizeInt; const B: string; IndexB: SizeInt; ALen: SizeInt): Integer; overload; static;
  562. Class Function CompareText(const A: string; const B: string): Integer; static; inline;
  563. Class Function Copy(const Str: string): string; inline; static;
  564. Class Function Create(AChar: Char; ACount: SizeInt): string; overload; inline; static;
  565. Class Function Create(const AValue: array of Char): string; overload; static;
  566. Class Function Create(const AValue: array of Char; StartIndex: SizeInt; ALen: SizeInt): string; overload; static;
  567. Class Function EndsText(const ASubText, AText: string): Boolean; static;
  568. Class Function Equals(const a: string; const b: string): Boolean; overload; static;
  569. Class Function Format(const AFormat: string; const args: array of JSValue): string; overload; static;
  570. Class Function IsNullOrEmpty(const AValue: string): Boolean; static;
  571. Class Function IsNullOrWhiteSpace(const AValue: string): Boolean; static;
  572. Class Function Join(const Separator: string; const Values: array of JSValue): string; overload; static;
  573. Class Function Join(const Separator: string; const Values: array of string): string; overload; static;
  574. Class Function Join(const Separator: string; const Values: array of string; StartIndex: SizeInt; ACount: SizeInt): string; overload; static;
  575. Class Function LowerCase(const S: string): string; overload; static; inline;
  576. Class Function Parse(const AValue: Boolean): string; overload; static; inline;
  577. Class Function Parse(const AValue: Extended): string; overload; static;inline;
  578. Class Function Parse(const AValue: NativeInt): string; overload; static; inline;
  579. Class Function Parse(const AValue: Integer): string; overload; static; inline;
  580. Class Function ToBoolean(const S: string): Boolean; overload; static; inline;
  581. Class Function ToDouble(const S: string): Double; overload; static; inline;
  582. Class Function ToExtended(const S: string): Extended; overload; static; inline;
  583. Class Function ToNativeInt(const S: string): NativeInt; overload; static; inline;
  584. Class Function ToInteger(const S: string): Integer; overload; static; inline;
  585. Class Function UpperCase(const S: string): string; overload; static; inline;
  586. Class Function ToCharArray(const S : String) : TCharArray; static;
  587. Function CompareTo(const B: string): Integer;
  588. Function Contains(const AValue: string): Boolean;
  589. Function CountChar(const C: Char): SizeInt;
  590. Function DeQuotedString: string; overload;
  591. Function DeQuotedString(const AQuoteChar: Char): string; overload;
  592. Function EndsWith(const AValue: string): Boolean; overload; inline;
  593. Function EndsWith(const AValue: string; IgnoreCase: Boolean): Boolean; overload;
  594. Function Equals(const AValue: string): Boolean; overload;
  595. Function Format(const args: array of jsValue): string; overload;
  596. Function GetHashCode: Integer;
  597. Function IndexOf(AValue: Char): SizeInt; overload; inline;
  598. Function IndexOf(const AValue: string): SizeInt; overload; inline;
  599. Function IndexOf(AValue: Char; StartIndex: SizeInt): SizeInt; overload;
  600. Function IndexOf(const AValue: string; StartIndex: SizeInt): SizeInt; overload;
  601. Function IndexOf(AValue: Char; StartIndex: SizeInt; ACount: SizeInt): SizeInt; overload;
  602. Function IndexOf(const AValue: string; StartIndex: SizeInt; ACount: SizeInt): SizeInt; overload;
  603. Function IndexOfUnQuoted(const AValue: string; StartQuote, EndQuote: Char; StartIndex: SizeInt = 0): SizeInt; overload;
  604. Function IndexOfAny(const AnyOf: string): SizeInt; overload;
  605. Function IndexOfAny(const AnyOf: array of Char): SizeInt; overload;
  606. Function IndexOfAny(const AnyOf: String; StartIndex: SizeInt): SizeInt; overload;
  607. Function IndexOfAny(const AnyOf: array of Char; StartIndex: SizeInt): SizeInt; overload;
  608. Function IndexOfAny(const AnyOf: String; StartIndex: SizeInt; ACount: SizeInt): SizeInt; overload;
  609. Function IndexOfAny(const AnyOf: array of Char; StartIndex: SizeInt; ACount: SizeInt): SizeInt; overload;
  610. Function IndexOfAny(const AnyOf: array of String): SizeInt; overload;
  611. Function IndexOfAny(const AnyOf: array of String; StartIndex: SizeInt): SizeInt; overload;
  612. Function IndexOfAny(const AnyOf: array of String; StartIndex: SizeInt; ACount: SizeInt): SizeInt; overload;
  613. Function IndexOfAny(const AnyOf: array of String; StartIndex: SizeInt; ACount: SizeInt; Out AMatch : SizeInt): SizeInt; overload;
  614. Function IndexOfAnyUnquoted(const AnyOf: array of Char; StartQuote, EndQuote: Char): SizeInt; overload;
  615. Function IndexOfAnyUnquoted(const AnyOf: array of Char; StartQuote, EndQuote: Char; StartIndex: SizeInt): SizeInt; overload;
  616. Function IndexOfAnyUnquoted(const AnyOf: array of Char; StartQuote, EndQuote: Char; StartIndex: SizeInt; ACount: SizeInt): SizeInt; overload;
  617. function IndexOfAnyUnquoted(const AnyOf: array of string; StartQuote, EndQuote: Char; StartIndex: SizeInt; Out Matched: SizeInt): SizeInt; overload;
  618. Function Insert(StartIndex: SizeInt; const AValue: string): string;
  619. Function IsDelimiter(const Delimiters: string; Index: SizeInt): Boolean;
  620. Function IsEmpty: Boolean;
  621. Function LastDelimiter(const Delims: string): SizeInt;
  622. Function LastIndexOf(AValue: Char): SizeInt; overload;
  623. Function LastIndexOf(const AValue: string): SizeInt; overload;
  624. Function LastIndexOf(AValue: Char; AStartIndex: SizeInt): SizeInt; overload;
  625. Function LastIndexOf(const AValue: string; AStartIndex: SizeInt): SizeInt; overload;
  626. Function LastIndexOf(AValue: Char; AStartIndex: SizeInt; ACount: SizeInt): SizeInt; overload;
  627. Function LastIndexOf(const AValue: string; AStartIndex: SizeInt; ACount: SizeInt): SizeInt; overload;
  628. Function LastIndexOfAny(const AnyOf: array of Char): SizeInt; overload;
  629. Function LastIndexOfAny(const AnyOf: array of Char; AStartIndex: SizeInt): SizeInt; overload;
  630. Function LastIndexOfAny(const AnyOf: array of Char; AStartIndex: SizeInt; ACount: SizeInt): SizeInt; overload;
  631. Function PadLeft(ATotalWidth: SizeInt): string; overload; inline;
  632. Function PadLeft(ATotalWidth: SizeInt; PaddingChar: Char): string; overload; inline;
  633. Function PadRight(ATotalWidth: SizeInt): string; overload; inline;
  634. Function PadRight(ATotalWidth: SizeInt; PaddingChar: Char): string; overload; inline;
  635. Function QuotedString: string; overload;
  636. Function QuotedString(const AQuoteChar: Char): string; overload;
  637. Function Remove(StartIndex: SizeInt): string; overload; inline;
  638. Function Remove(StartIndex: SizeInt; ACount: SizeInt): string; overload; inline;
  639. Function Replace(OldChar: Char; NewChar: Char): string; overload;
  640. Function Replace(OldChar: Char; NewChar: Char; ReplaceFlags: TReplaceFlags): string; overload;
  641. Function Replace(const OldValue: string; const NewValue: string): string; overload;
  642. Function Replace(const OldValue: string; const NewValue: string; ReplaceFlags: TReplaceFlags): string; overload;
  643. Function Split(const Separators: String): TStringArray; overload;
  644. Function Split(const Separators: array of Char): TStringArray; overload;
  645. Function Split(const Separators: string; ACount: SizeInt): TStringArray; overload;
  646. Function Split(const Separators: array of Char; ACount: SizeInt): TStringArray; overload;
  647. Function Split(const Separators: string; Options: TStringSplitOptions): TStringArray; overload;
  648. Function Split(const Separators: array of Char; Options: TStringSplitOptions): TStringArray; overload;
  649. Function Split(const Separators: string; ACount: SizeInt; Options: TStringSplitOptions): TStringArray; overload;
  650. Function Split(const Separators: array of Char; ACount: SizeInt; Options: TStringSplitOptions): TStringArray; overload;
  651. Function Split(const Separators: array of string): TStringArray; overload;
  652. Function Split(const Separators: array of string; ACount: SizeInt): TStringArray; overload;
  653. Function Split(const Separators: array of string; Options: TStringSplitOptions): TStringArray; overload;
  654. Function Split(const Separators: array of string; ACount: SizeInt; Options: TStringSplitOptions): TStringArray; overload;
  655. Function Split(const Separators: String; AQuote: Char): TStringArray; overload;
  656. Function Split(const Separators: array of Char; AQuote: Char): TStringArray; overload;
  657. Function Split(const Separators: String; AQuoteStart, AQuoteEnd: Char): TStringArray; overload;
  658. Function Split(const Separators: array of Char; AQuoteStart, AQuoteEnd: Char): TStringArray; overload;
  659. Function Split(const Separators: string; AQuoteStart, AQuoteEnd: Char; Options: TStringSplitOptions): TStringArray; overload;
  660. Function Split(const Separators: array of Char; AQuoteStart, AQuoteEnd: Char; Options: TStringSplitOptions): TStringArray; overload;
  661. Function Split(const Separators: string; AQuoteStart, AQuoteEnd: Char; ACount: SizeInt): TStringArray; overload;
  662. Function Split(const Separators: array of Char; AQuoteStart, AQuoteEnd: Char; ACount: SizeInt): TStringArray; overload;
  663. Function Split(const Separators: string; AQuoteStart, AQuoteEnd: Char; ACount: SizeInt; Options: TStringSplitOptions): TStringArray; overload;
  664. Function Split(const Separators: array of Char; AQuoteStart, AQuoteEnd: Char; ACount: SizeInt; Options: TStringSplitOptions): TStringArray; overload;
  665. Function Split(const Separators: array of string; AQuote: Char): TStringArray; overload;
  666. Function Split(const Separators: array of string; AQuoteStart, AQuoteEnd: Char): TStringArray; overload;
  667. Function Split(const Separators: array of string; AQuoteStart, AQuoteEnd: Char; Options: TStringSplitOptions): TStringArray; overload;
  668. Function Split(const Separators: array of string; AQuoteStart, AQuoteEnd: Char; ACount: SizeInt): TStringArray; overload;
  669. Function Split(const Separators: array of string; AQuoteStart, AQuoteEnd: Char; ACount: SizeInt; Options: TStringSplitOptions): TStringArray; overload;
  670. Function StartsWith(const AValue: string): Boolean; overload; inline;
  671. Function StartsWith(const AValue: string; IgnoreCase: Boolean): Boolean; overload;
  672. Function Substring(AStartIndex: SizeInt): string; overload;
  673. Function Substring(AStartIndex: SizeInt; ALen: SizeInt): string; overload;
  674. Function ToBoolean: Boolean; overload; inline;
  675. Function ToInteger: Integer; overload; inline;
  676. Function ToNativeInt: NativeInt; overload; inline;
  677. Function ToDouble: Double; overload; inline;
  678. Function ToExtended: Extended; overload; inline;
  679. Function ToCharArray: TCharArray; overload;
  680. Function ToCharArray(AStartIndex: SizeInt; ALen: SizeInt): TCharArray; overload;
  681. Function ToLower: string; overload; inline;
  682. Function ToLowerInvariant: string;
  683. Function ToUpper: string; overload; inline;
  684. Function ToUpperInvariant: string; inline;
  685. Function Trim: string; overload;
  686. Function TrimLeft: string; overload;
  687. Function TrimRight: string; overload;
  688. Function Trim(const ATrimChars: array of Char): string; overload;
  689. Function TrimLeft(const ATrimChars: array of Char): string; overload;
  690. Function TrimRight(const ATrimChars: array of Char): string; overload;
  691. Function TrimEnd(const ATrimChars: array of Char): string; deprecated 'Use TrimRight';
  692. Function TrimStart(const ATrimChars: array of Char): string; deprecated 'Use TrimLeft';
  693. property Chars[AIndex: SizeInt]: Char read GetChar;
  694. property Length: SizeInt read GetLength;
  695. end;
  696. TDoubleHelper = Type Helper for Double
  697. private
  698. Function GetB(AIndex: Cardinal): Byte;
  699. Function GetW(AIndex: Cardinal): Word;
  700. Function GetE: NativeUInt; inline;
  701. Function GetF: NativeUInt; inline;
  702. Function GetS: Boolean; inline;
  703. Procedure SetS(aValue : Boolean); inline;
  704. procedure SetB(AIndex: Cardinal; const AValue: Byte);
  705. procedure SetW(AIndex: Cardinal; const AValue: Word);
  706. public
  707. const
  708. {$push}
  709. {$R-}
  710. {$Q-}
  711. Epsilon : Double = 4.9406564584124654418e-324;
  712. MaxValue : Double = 1.7976931348623157081e+308;
  713. MinValue : Double = -1.7976931348623157081e+308;
  714. // PositiveInfinity : Double = 1.0/0.0;
  715. // NegativeInfinity : Double = -1.0/0.0;
  716. // NaN : Double = 0.0/0.0;
  717. {$POP}
  718. Class Function IsInfinity(const AValue: Double): Boolean; overload; inline; static;
  719. Class Function IsNan(const AValue: Double): Boolean; overload; inline; static;
  720. Class Function IsNegativeInfinity(const AValue: Double): Boolean; overload; inline; static;
  721. Class Function IsPositiveInfinity(const AValue: Double): Boolean; overload; inline; static;
  722. Class Function Parse(const AString: string): Double; overload; inline; static;
  723. Class Function ToString(const AValue: Double): string; overload; inline; static;
  724. Class Function ToString(const AValue: Double; const AFormat: TFloatFormat; const APrecision, ADigits: Integer): string; overload; inline; static;
  725. Class Function TryParse(const AString: string; out AValue: Double): Boolean; overload; inline; static;
  726. Procedure BuildUp(const ASignFlag: Boolean; const AMantissa: NativeUInt; const AExponent: Integer);
  727. Function Exponent: Integer;
  728. Function Fraction: Extended;
  729. Function IsInfinity: Boolean; overload; inline;
  730. Function IsNan: Boolean; overload; inline;
  731. Function IsNegativeInfinity: Boolean; overload; inline;
  732. Function IsPositiveInfinity: Boolean; overload; inline;
  733. Function Mantissa: NativeUInt;
  734. Function ToString(const AFormat: TFloatFormat; const APrecision, ADigits: Integer): string; overload; inline;
  735. Function ToString: string; overload; inline;
  736. property Bytes[AIndex: Cardinal]: Byte read GetB write SetB; // 0..7
  737. property Words[AIndex: Cardinal]: Word read GetW write SetW; // 0..3
  738. property Sign: Boolean read GetS Write SetS;
  739. property Exp: NativeUInt read GetE;
  740. property Frac: NativeUInt read GetF;
  741. end;
  742. TByteHelper = Type Helper for Byte
  743. public
  744. const
  745. MaxValue = 255;
  746. MinValue = 0;
  747. public
  748. Class Function Parse(const AString: string): Byte; inline; static;
  749. Class Function Size: Integer; inline; static;
  750. Class Function ToString(const AValue: Byte): string; overload; inline; static;
  751. Class Function TryParse(const AString: string; out AValue: Byte): Boolean; inline; static;
  752. Public
  753. Function ToBoolean: Boolean; inline;
  754. Function ToDouble: Double; inline;
  755. Function ToExtended: Extended; inline;
  756. Function ToBinString:string; inline;
  757. Function ToHexString(const AMinDigits: Integer): string; overload; inline;
  758. Function ToHexString: string; overload; inline;
  759. Function ToString: string; overload; inline;
  760. Function SetBit(const Index: TByteBitIndex) : Byte; inline;
  761. Function ClearBit(const Index: TByteBitIndex) : Byte; inline;
  762. Function ToggleBit(const Index: TByteBitIndex) : Byte; inline;
  763. Function TestBit(const Index:TByteBitIndex):Boolean; inline;
  764. end;
  765. TShortIntHelper = Type Helper for ShortInt
  766. public
  767. const
  768. MaxValue = 127;
  769. MinValue = -128;
  770. public
  771. Class Function Parse(const AString: string): ShortInt; inline; static;
  772. Class Function Size: Integer; inline; static;
  773. Class Function ToString(const AValue: ShortInt): string; overload; inline; static;
  774. Class Function TryParse(const AString: string; out AValue: ShortInt): Boolean; inline; static;
  775. public
  776. Function ToBoolean: Boolean; inline;
  777. Function ToDouble: Double; inline;
  778. Function ToExtended: Extended; inline;
  779. Function ToBinString:string; inline;
  780. Function ToHexString(const AMinDigits: Integer): string; overload; inline;
  781. Function ToHexString: string; overload; inline;
  782. Function ToString: string; overload; inline;
  783. Function SetBit(const Index: TShortIntBitIndex): Shortint; inline;
  784. Function ClearBit(const Index: TShortIntBitIndex): Shortint; inline;
  785. Function ToggleBit(const Index: TShortIntBitIndex): Shortint; inline;
  786. Function TestBit(const Index:TShortIntBitIndex):Boolean; inline;
  787. end;
  788. TSmallIntHelper = Type Helper for SmallInt
  789. public
  790. const
  791. MaxValue = 32767;
  792. MinValue = -32768;
  793. public
  794. Class Function Parse(const AString: string): SmallInt; inline; static;
  795. Class Function Size: Integer; inline; static;
  796. Class Function ToString(const AValue: SmallInt): string; overload; inline; static;
  797. Class Function TryParse(const AString: string; out AValue: SmallInt): Boolean; inline; static;
  798. public
  799. Function ToString: string; overload; inline;
  800. Function ToBoolean: Boolean; inline;
  801. Function ToBinString:string; inline;
  802. Function ToHexString: string; overload; inline;
  803. Function ToHexString(const AMinDigits: Integer): string; overload; inline;
  804. Function ToDouble: Double; inline;
  805. Function ToExtended: Extended; inline;
  806. Function SetBit(const Index: TSmallIntBitIndex) : Smallint; inline;
  807. Function ClearBit(const Index: TSmallIntBitIndex) : Smallint; inline;
  808. Function ToggleBit(const Index: TSmallIntBitIndex) : Smallint; inline;
  809. Function TestBit(const Index:TSmallIntBitIndex):Boolean; inline;
  810. end;
  811. TWordHelper = Type Helper for Word
  812. public
  813. const
  814. MaxValue = 65535;
  815. MinValue = 0;
  816. Public
  817. Class Function Parse(const AString: string): Word; inline; static;
  818. Class Function Size: Integer; inline; static;
  819. Class Function ToString(const AValue: Word): string; overload; inline; static;
  820. Class Function TryParse(const AString: string; out AValue: Word): Boolean; inline; static;
  821. Public
  822. Function ToBoolean: Boolean; inline;
  823. Function ToDouble: Double; inline;
  824. Function ToExtended: Extended; inline;
  825. Function ToBinString:string; inline;
  826. Function ToHexString(const AMinDigits: Integer): string; overload; inline;
  827. Function ToHexString: string; overload; inline;
  828. Function ToString: string; overload; inline;
  829. Function SetBit(const Index: TWordBitIndex) : Word; inline;
  830. Function ClearBit(const Index: TWordBitIndex) : Word; inline;
  831. Function ToggleBit(const Index: TWordBitIndex) : Word; inline;
  832. Function TestBit(const Index:TWordBitIndex):Boolean; inline;
  833. end;
  834. TCardinalHelper = Type Helper for Cardinal { for LongWord Type too }
  835. public
  836. const
  837. MaxValue = 4294967295;
  838. MinValue = 0;
  839. Public
  840. Class Function Parse(const AString: string): Cardinal; inline; static;
  841. Class Function Size: Integer; inline; static;
  842. Class Function ToString(const AValue: Cardinal): string; overload; inline; static;
  843. Class Function TryParse(const AString: string; out AValue: Cardinal): Boolean; inline; static;
  844. Public
  845. Function ToBoolean: Boolean; inline;
  846. Function ToDouble: Double; inline;
  847. Function ToExtended: Extended; inline;
  848. Function ToBinString:string; inline;
  849. Function ToHexString(const AMinDigits: Integer): string; overload; inline;
  850. Function ToHexString: string; overload; inline;
  851. Function ToString: string; overload; inline;
  852. Function SetBit(const Index: TCardinalBitIndex) : Cardinal; inline;
  853. Function ClearBit(const Index: TCardinalBitIndex) : Cardinal; inline;
  854. Function ToggleBit(const Index: TCardinalBitIndex) : Cardinal; inline;
  855. Function TestBit(const Index:TCardinalBitIndex):Boolean; inline;
  856. end;
  857. TIntegerHelper = Type Helper for Integer { for LongInt Type too }
  858. public
  859. const
  860. MaxValue = 2147483647;
  861. MinValue = -2147483648;
  862. Public
  863. Class Function Size: Integer; inline; static;
  864. Class Function ToString(const AValue: Integer): string; overload; inline; static;
  865. Class Function Parse(const AString: string): Integer; inline; static;
  866. Class Function TryParse(const AString: string; out AValue: Integer): Boolean; inline; static;
  867. Public
  868. Function ToBoolean: Boolean; inline;
  869. Function ToDouble: Double; inline;
  870. Function ToExtended: Extended; inline;
  871. Function ToBinString:string; inline;
  872. Function ToHexString(const AMinDigits: Integer): string; overload; inline;
  873. Function ToHexString: string; overload; inline;
  874. Function ToString: string; overload; inline;
  875. Function SetBit(const Index: TIntegerBitIndex) : Integer; inline;
  876. Function ClearBit(const Index: TIntegerBitIndex) : Integer; inline;
  877. Function ToggleBit(const Index: TIntegerBitIndex) : Integer; inline;
  878. Function TestBit(const Index:TIntegerBitIndex):Boolean; inline;
  879. end;
  880. TNativeIntHelper = Type Helper for NativeInt
  881. public
  882. const
  883. MaxValue = High(NativeInt);
  884. MinValue = Low(NativeInt);
  885. Public
  886. Class Function Parse(const AString: string): NativeInt; inline; static;
  887. Class Function Size: Integer; inline; static;
  888. Class Function ToString(const AValue: NativeInt): string; overload; inline; static;
  889. Class Function TryParse(const AString: string; out AValue: NativeInt): Boolean; inline; static;
  890. Public
  891. Function ToBoolean: Boolean; inline;
  892. Function ToDouble: Double; inline;
  893. Function ToExtended: Extended; inline;
  894. Function ToBinString:string; inline;
  895. Function ToHexString(const AMinDigits: Integer): string; overload; inline;
  896. Function ToHexString: string; overload; inline;
  897. Function ToString: string; overload; inline;
  898. Function SetBit(const Index: TNativeIntBitIndex) : NativeInt; inline;
  899. Function ClearBit(const Index: TNativeIntBitIndex) : NativeInt; inline;
  900. Function ToggleBit(const Index: TNativeIntBitIndex) : NativeInt; inline;
  901. Function TestBit(const Index:TNativeIntBitIndex):Boolean; inline;
  902. end;
  903. TNativeUIntHelper = Type Helper for NativeUInt
  904. public
  905. const
  906. MaxValue = High(NativeUInt);
  907. MinValue = 0;
  908. Public
  909. Class Function Parse(const AString: string): NativeUInt; inline; static;
  910. Class Function Size: Integer; inline; static;
  911. Class Function ToString(const AValue: NativeUInt): string; overload; inline; static;
  912. Class Function TryParse(const AString: string; out AValue: NativeUInt): Boolean; inline; static;
  913. Public
  914. Function ToBoolean: Boolean; inline;
  915. Function ToDouble: Double; inline;
  916. Function ToExtended: Extended; inline;
  917. Function ToBinString:string; inline;
  918. Function ToHexString(const AMinDigits: Integer): string; overload; inline;
  919. Function ToHexString: string; overload; inline;
  920. Function ToSingle: Single; inline;
  921. Function ToString: string; overload; inline;
  922. Function SetBit(const Index: TNativeUIntBitIndex) : NativeUint; inline;
  923. Function ClearBit(const Index: TNativeUIntBitIndex): NativeUint; inline;
  924. Function ToggleBit(const Index: TNativeUIntBitIndex) : NativeUint; inline;
  925. Function TestBit(const Index:TNativeUIntBitIndex) :Boolean; inline;
  926. end;
  927. {$SCOPEDENUMS ON}
  928. TUseBoolStrs = (False,True);
  929. {$SCOPEDENUMS OFF}
  930. TBooleanHelper = Type Helper for Boolean
  931. public
  932. Class Function Parse(const S: string): Boolean; inline; static;
  933. Class Function Size: Integer; inline; static;
  934. Class Function ToString(const AValue: Boolean; UseBoolStrs: TUseBoolStrs = TUseBoolStrs.false): string; overload; inline; static;
  935. Class Function TryToParse(const S: string; out AValue: Boolean): Boolean; inline; static;
  936. Public
  937. Function ToInteger: Integer; inline;
  938. Function ToString(UseBoolStrs: TUseBoolStrs = TUseBoolStrs.False): string; overload; inline;
  939. end;
  940. TByteBoolHelper = Type Helper for ByteBool
  941. public
  942. Class Function Parse(const S: string): Boolean; inline; static;
  943. Class Function Size: Integer; inline; static;
  944. Class Function ToString(const AValue: Boolean; UseBoolStrs : Boolean = False): string; overload; inline; static;
  945. Class Function TryToParse(const S: string; out AValue: Boolean): Boolean; inline; static;
  946. Public
  947. Function ToInteger: Integer; inline;
  948. Function ToString(UseBoolStrs: Boolean = False): string; overload; inline;
  949. end;
  950. TWordBoolHelper = Type Helper for WordBool
  951. public
  952. Class Function Parse(const S: string): Boolean; inline; static;
  953. Class Function Size: Integer; inline; static;
  954. Class Function ToString(const AValue: Boolean; UseBoolStrs: Boolean = False): string; overload; inline; static;
  955. Class Function TryToParse(const S: string; out AValue: Boolean): Boolean; inline; static;
  956. Public
  957. Function ToInteger: Integer; inline;
  958. Function ToString(UseBoolStrs: boolean = False): string; overload; inline;
  959. end;
  960. TLongBoolHelper = Type Helper for LongBool
  961. public
  962. Class Function Parse(const S: string): Boolean; inline; static;
  963. Class Function Size: Integer; inline; static;
  964. Class Function ToString(const AValue: Boolean; UseBoolStrs: Boolean= False): string; overload; inline; static;
  965. Class Function TryToParse(const S: string; out AValue: Boolean): Boolean; inline; static;
  966. public
  967. Function ToInteger: Integer; inline;
  968. Function ToString(UseBoolStrs: Boolean = False): string; overload; inline;
  969. end;
  970. { TStringBuilder }
  971. TStringBuilder = class
  972. private
  973. const
  974. DefaultCapacity = 64;
  975. private
  976. Function GetCapacity: Integer;
  977. Procedure SetCapacity(AValue: Integer);
  978. Function GetC(Index: Integer): Char;
  979. Procedure SetC(Index: Integer; AValue: Char);
  980. Function GetLength: Integer; inline;
  981. Procedure SetLength(AValue: Integer);
  982. protected
  983. FData: String;
  984. FMaxCapacity: Integer;
  985. // Raise error on range check.
  986. Procedure CheckRange(Idx,Count,MaxLen : Integer);inline;
  987. Procedure CheckNegative(Const AValue : Integer; Const AName: String); inline;
  988. // All appends/inserts pass through here.
  989. Procedure DoAppend(Const S : String);virtual;
  990. Procedure DoAppend(const AValue: Array of char; Idx, aCount: Integer); virtual;
  991. Procedure DoInsert(Index: Integer; const AValue: String); virtual;
  992. Procedure DoInsert(Index: Integer; const AValue: Array of char; StartIndex, aCharCount: Integer); virtual;
  993. Procedure DoReplace(Index: Integer; const Old, New: String); virtual;
  994. Procedure Grow;
  995. Procedure Shrink;
  996. public
  997. Constructor Create;
  998. Constructor Create(aCapacity: Integer);
  999. Constructor Create(const AValue: String);
  1000. Constructor Create(aCapacity: Integer; aMaxCapacity: Integer);
  1001. Constructor Create(const AValue: String; aCapacity: Integer);
  1002. Constructor Create(const AValue: String; StartIndex: Integer; aLength: Integer; aCapacity: Integer);
  1003. Function Append(const AValue: Boolean): TStringBuilder;
  1004. Function Append(const AValue: Byte): TStringBuilder;
  1005. Function Append(const AValue: Char): TStringBuilder;
  1006. Function Append(const AValue: Currency): TStringBuilder;
  1007. Function Append(const AValue: Double): TStringBuilder;
  1008. Function Append(const AValue: Smallint): TStringBuilder;
  1009. Function Append(const AValue: LongInt): TStringBuilder;
  1010. Function Append(const AValue: Int64): TStringBuilder;
  1011. Function Append(const AValue: TObject): TStringBuilder;
  1012. Function Append(const AValue: Shortint): TStringBuilder;
  1013. Function Append(const AValue: Single): TStringBuilder;
  1014. Function Append(const AValue: UInt64): TStringBuilder;
  1015. Function Append(const AValue: Array of char): TStringBuilder;
  1016. Function Append(const AValue: Word): TStringBuilder;
  1017. Function Append(const AValue: Cardinal): TStringBuilder;
  1018. Function Append(const AValue: String): TStringBuilder;
  1019. Function Append(const AValue: Char; RepeatCount: Integer): TStringBuilder;
  1020. Function Append(const AValue: Array of char; StartIndex: Integer; SBCharCount: Integer): TStringBuilder;
  1021. Function Append(const AValue: String; StartIndex: Integer; Count: Integer): TStringBuilder;
  1022. Function Append(const Fmt: String; const Args: array of const): TStringBuilder;
  1023. Function AppendFormat(const Fmt: String; const Args: array of const): TStringBuilder;
  1024. Function AppendLine: TStringBuilder;
  1025. Function AppendLine(const AValue: String): TStringBuilder;
  1026. Procedure Clear;
  1027. Procedure CopyTo(SourceIndex: Integer; Var Destination: Array of char; DestinationIndex: Integer; Count: Integer);
  1028. Function EnsureCapacity(aCapacity: Integer): Integer;
  1029. Function Equals(StringBuilder: TStringBuilder): Boolean; reintroduce;
  1030. Function Insert(Index: Integer; const AValue: Boolean): TStringBuilder;
  1031. Function Insert(Index: Integer; const AValue: Byte): TStringBuilder;
  1032. Function Insert(Index: Integer; const AValue: Char): TStringBuilder;
  1033. Function Insert(Index: Integer; const AValue: Currency): TStringBuilder;
  1034. Function Insert(Index: Integer; const AValue: Double): TStringBuilder;
  1035. Function Insert(Index: Integer; const AValue: Smallint): TStringBuilder;
  1036. Function Insert(Index: Integer; const AValue: LongInt): TStringBuilder;
  1037. Function Insert(Index: Integer; const AValue: Array of char): TStringBuilder;
  1038. Function Insert(Index: Integer; const AValue: Int64): TStringBuilder;
  1039. Function Insert(Index: Integer; const AValue: TObject): TStringBuilder;
  1040. Function Insert(Index: Integer; const AValue: Shortint): TStringBuilder;
  1041. Function Insert(Index: Integer; const AValue: Single): TStringBuilder;
  1042. Function Insert(Index: Integer; const AValue: String): TStringBuilder;
  1043. Function Insert(Index: Integer; const AValue: Word): TStringBuilder;
  1044. Function Insert(Index: Integer; const AValue: Cardinal): TStringBuilder;
  1045. Function Insert(Index: Integer; const AValue: UInt64): TStringBuilder;
  1046. Function Insert(Index: Integer; const AValue: String; const aRepeatCount: Integer): TStringBuilder;
  1047. Function Insert(Index: Integer; const AValue: Array of char; startIndex: Integer; SBCharCount: Integer): TStringBuilder;
  1048. Function Remove(StartIndex: Integer; RemLength: Integer): TStringBuilder;
  1049. Function Replace(const OldValue, NewValue: String): TStringBuilder;
  1050. Function Replace(const OldValue, NewValue: String; StartIndex: Integer; Count: Integer): TStringBuilder;
  1051. Function ToString: String; override;
  1052. Function ToString(aStartIndex: Integer; aLength: Integer): String; reintroduce;
  1053. property Chars[index: Integer]: Char read GetC write SetC; default;
  1054. property Length: Integer read GetLength write SetLength;
  1055. property Capacity: Integer read GetCapacity write SetCapacity;
  1056. property MaxCapacity: Integer read FMaxCapacity;
  1057. end;
  1058. implementation
  1059. Const
  1060. DefaultShortMonthNames : TMonthNames = (
  1061. 'Jan',
  1062. 'Feb',
  1063. 'Mar',
  1064. 'Apr',
  1065. 'May',
  1066. 'Jun',
  1067. 'Jul',
  1068. 'Aug',
  1069. 'Sep',
  1070. 'Oct',
  1071. 'Nov',
  1072. 'Dec');
  1073. DefaultLongMonthNames : TMonthNames = (
  1074. 'January',
  1075. 'February',
  1076. 'March',
  1077. 'April',
  1078. 'May',
  1079. 'June',
  1080. 'July',
  1081. 'August',
  1082. 'September',
  1083. 'October',
  1084. 'November',
  1085. 'December');
  1086. DefaultShortDayNames : TDayNames = (
  1087. 'Sun',
  1088. 'Mon',
  1089. 'Tue',
  1090. 'Wed',
  1091. 'Thu',
  1092. 'Fri',
  1093. 'Sat');
  1094. DefaultLongDayNames : TDayNames = (
  1095. 'Sunday',
  1096. 'Monday',
  1097. 'Tuesday',
  1098. 'Wednesday',
  1099. 'Thursday',
  1100. 'Friday',
  1101. 'Saturday');
  1102. { ---------------------------------------------------------------------
  1103. Exception handling
  1104. ---------------------------------------------------------------------}
  1105. Resourcestring
  1106. SAbortError = 'Operation aborted';
  1107. SApplicationException = 'Application raised an exception: ';
  1108. SErrUnknownExceptionType = 'Caught unknown exception type : ';
  1109. procedure DoShowException(S : String);
  1110. begin
  1111. if Assigned(OnShowException) then
  1112. OnShowException(S)
  1113. else
  1114. begin
  1115. {$IFDEF BROWSER}
  1116. asm
  1117. window.alert(S);
  1118. end;
  1119. {$ENDIF}
  1120. {$IFDEF NODEJS}
  1121. Writeln(S);
  1122. {$ENDIF}
  1123. end;
  1124. end;
  1125. procedure ShowException(ExceptObject: TObject; ExceptAddr: Pointer = Nil);
  1126. Var
  1127. S : String;
  1128. begin
  1129. S:=SApplicationException+ExceptObject.ClassName;
  1130. if ExceptObject is Exception then
  1131. S:=S+' : '+Exception(ExceptObject).Message;
  1132. DoShowException(S);
  1133. if ExceptAddr=nil then;
  1134. end;
  1135. Type
  1136. TRTLExceptionHandler = procedure (aError : JSValue);
  1137. Var
  1138. rtlExceptionHandler : TRTLExceptionHandler; External name 'rtl.onUncaughtException';
  1139. rtlShowUncaughtExceptions : Boolean; External name 'rtl.showUncaughtExceptions';
  1140. OnPascalException : TUncaughtPascalExceptionHandler;
  1141. OnJSException : TUncaughtJSExceptionHandler;
  1142. Procedure RTLExceptionHook(aError : JSValue);
  1143. Var
  1144. S : String;
  1145. begin
  1146. if isClassInstance(aError) then
  1147. begin
  1148. if Assigned(OnPascalException) then
  1149. OnPascalException(TObject(aError))
  1150. else
  1151. ShowException(TObject(aError),Nil);
  1152. end
  1153. else if isObject(aError) then
  1154. begin
  1155. if Assigned(OnJSException) then
  1156. OnJSException(TJSObject(aError))
  1157. else
  1158. begin
  1159. if TJSObject(aError).hasOwnProperty('message') then
  1160. S:=SErrUnknownExceptionType+String(TJSObject(aError).Properties['message'])
  1161. else
  1162. S:=SErrUnknownExceptionType+TJSObject(aError).toString;
  1163. DoShowException(S);
  1164. end
  1165. end
  1166. else
  1167. begin
  1168. S:=SErrUnknownExceptionType+String(aError);
  1169. DoShowException(S);
  1170. end;
  1171. end;
  1172. Function SetOnUnCaughtExceptionHandler(aValue : TUncaughtPascalExceptionHandler) : TUncaughtPascalExceptionHandler;
  1173. begin
  1174. Result:=OnPascalException;
  1175. OnPascalException:=aValue;
  1176. HookUncaughtExceptions;
  1177. end;
  1178. Function SetOnUnCaughtExceptionHandler(aValue : TUncaughtJSExceptionHandler) : TUncaughtJSExceptionHandler;
  1179. begin
  1180. Result:=OnJSException;
  1181. OnJSException:=aValue;
  1182. HookUncaughtExceptions;
  1183. end;
  1184. Procedure HookUncaughtExceptions;
  1185. begin
  1186. rtlExceptionHandler:=@RTLExceptionHook;
  1187. rtlShowUncaughtExceptions:=True;
  1188. end;
  1189. procedure Abort;
  1190. begin
  1191. Raise EAbort.Create(SAbortError);
  1192. end;
  1193. {$IFNDEF MAKESTUB}
  1194. Type
  1195. TCharSet = Set of Char;
  1196. Function CharInSet(Ch: Char;Const CSet : TCharSet) : Boolean; overload;
  1197. begin
  1198. Result:=Ch in CSet;
  1199. end;
  1200. {$ENDIF}
  1201. function CharInSet(Ch: Char; const CSet: array of char): Boolean; overload;
  1202. Var
  1203. I : integer;
  1204. begin
  1205. Result:=False;
  1206. I:=Length(CSet)-1;
  1207. While (Not Result) and (I>=0) do
  1208. begin
  1209. Result:=(Ch=CSet[i]);
  1210. Dec(I);
  1211. end;
  1212. end;
  1213. function LeftStr(const S: string; Count: Integer): String; assembler;
  1214. asm
  1215. return (Count>0) ? S.substr(0,Count) : "";
  1216. end;
  1217. function RightStr(const S: string; Count: Integer): String; assembler;
  1218. asm
  1219. var l = S.length;
  1220. return (Count<1) ? "" : ( Count>=l ? S : S.substr(l-Count));
  1221. end;
  1222. function Trim(const S: String): String; assembler;
  1223. asm
  1224. return S.replace(/^[\s\uFEFF\xA0\x00-\x1f]+/,'').replace(/[\s\uFEFF\xA0\x00-\x1f]+$/,'');
  1225. end;
  1226. function TrimLeft(const S: String): String; assembler;
  1227. asm
  1228. return S.replace(/^[\s\uFEFF\xA0\x00-\x1f]+/,'');
  1229. end;
  1230. function TrimRight(const S: String): String; assembler;
  1231. asm
  1232. return S.replace(/[\s\uFEFF\xA0\x00-\x1f]+$/,'');
  1233. end;
  1234. function IntToStr(const Value: Integer): string;
  1235. begin
  1236. Result:=str(Value);
  1237. end;
  1238. function FloatToDecimal(Value: double; Precision, Decimals: integer): TFloatRec;
  1239. Const
  1240. Rounds = '123456789:';
  1241. var
  1242. Buffer: String; //Though str func returns only 25 chars, this might change in the future
  1243. InfNan: string;
  1244. OutPos,Error, N, L, C: Integer;
  1245. GotNonZeroBeforeDot, BeforeDot : boolean;
  1246. begin
  1247. Result.Negative:=False;
  1248. Result.Exponent:=0;
  1249. For C:=0 to FloatRecDigits do
  1250. Result.Digits[C]:='0';
  1251. if Value=0 then
  1252. exit;
  1253. asm
  1254. Buffer=Value.toPrecision(21); // Double precision
  1255. end;
  1256. // Writeln('Buffer :',Buffer);
  1257. N := 1;
  1258. L := Length(Buffer);
  1259. while Buffer[N]=' ' do
  1260. Inc(N);
  1261. Result.Negative := (Buffer[N] = '-');
  1262. if Result.Negative then
  1263. Inc(N)
  1264. else if (Buffer[N] = '+') then
  1265. inc(N);
  1266. { special cases for Inf and Nan }
  1267. if (L>=N+2) then
  1268. begin
  1269. InfNan:=copy(Buffer,N,3);
  1270. if (InfNan='Inf') then
  1271. begin
  1272. Result.Digits[0]:=#0;
  1273. Result.Exponent:=32767;
  1274. exit
  1275. end;
  1276. if (InfNan='Nan') then
  1277. begin
  1278. Result.Digits[0]:=#0;
  1279. Result.Exponent:=-32768;
  1280. exit
  1281. end;
  1282. end;
  1283. //Start := N; //Start of digits
  1284. Outpos:=0;
  1285. Result.Exponent := 0; BeforeDot := true;
  1286. GotNonZeroBeforeDot := false;
  1287. while (L>=N) and (Buffer[N]<>'E') do
  1288. begin
  1289. // Writeln('Examining : ',Buffer[N],'( output pos: ',outPos,')');
  1290. if Buffer[N]='.' then
  1291. BeforeDot := false
  1292. else
  1293. begin
  1294. if BeforeDot then
  1295. begin // Currently this is always 1 char
  1296. Inc(Result.Exponent);
  1297. Result.Digits[Outpos] := Buffer[N];
  1298. if Buffer[N] <> '0' then
  1299. GotNonZeroBeforeDot := true;
  1300. end
  1301. else
  1302. Result.Digits[Outpos] := Buffer[N];
  1303. Inc(outpos);
  1304. end;
  1305. Inc(N);
  1306. end;
  1307. Inc(N); // Pass through 'E'
  1308. if N<=L then
  1309. begin
  1310. Val(Copy(Buffer, N, L-N+1), C, Error); // Get exponent after 'E'
  1311. Inc(Result.Exponent, C);
  1312. end;
  1313. // Calculate number of digits we have from str
  1314. N:=OutPos;
  1315. // Writeln('Number of digits: ',N,' requested precision : ',Precision);
  1316. L:=Length(Result.Digits);
  1317. While N<L do
  1318. begin
  1319. Result.Digits[N]:='0'; //Zero remaining space
  1320. Inc(N);
  1321. end;
  1322. if Decimals + Result.Exponent < Precision Then //After this it is the same as in FloatToDecimal
  1323. N := Decimals + Result.Exponent
  1324. Else
  1325. N := Precision;
  1326. if N >= L Then
  1327. N := L-1;
  1328. // Writeln('Rounding on digit : ',N);
  1329. if N = 0 Then
  1330. begin
  1331. if Result.Digits[0] >= '5' Then
  1332. begin
  1333. Result.Digits[0] := '1';
  1334. Result.Digits[1] := #0;
  1335. Inc(Result.Exponent);
  1336. end
  1337. Else
  1338. Result.Digits[0] := #0;
  1339. end //N=0
  1340. Else if N > 0 Then
  1341. begin
  1342. if Result.Digits[N] >= '5' Then
  1343. begin
  1344. Repeat
  1345. Result.Digits[N] := #0;
  1346. Dec(N);
  1347. // Writeln(N,': ',Result.Digits[N],', Rounding to : ',Rounds[StrToInt(Result.Digits[N])]);
  1348. Result.Digits[N]:=Rounds[StrToInt(Result.Digits[N])+1];
  1349. Until (N = 0) Or (Result.Digits[N] < ':');
  1350. If Result.Digits[0] = ':' Then
  1351. begin
  1352. Result.Digits[0] := '1';
  1353. Inc(Result.Exponent);
  1354. end;
  1355. end
  1356. Else
  1357. begin
  1358. Result.Digits[N] := '0';
  1359. While (N > -1) And (Result.Digits[N] = '0') Do
  1360. begin
  1361. Result.Digits[N] := #0;
  1362. Dec(N);
  1363. end;
  1364. end;
  1365. end //N>0
  1366. Else
  1367. Result.Digits[0] := #0;
  1368. if (Result.Digits[0] = #0) and
  1369. not GotNonZeroBeforeDot then
  1370. begin
  1371. Result.Exponent := 0;
  1372. Result.Negative := False;
  1373. end;
  1374. end;
  1375. Function FloatToStr(Value: Double; const aSettings : TFormatSettings): String; overload;
  1376. begin
  1377. Result:=FloatToStrF(Value,ffGeneral,15,0,aSettings);
  1378. end;
  1379. function FloatToStr(Value: Double): String;
  1380. begin
  1381. Result:=FloatToStr(Value,FormatSettings);
  1382. end;
  1383. function TryStrToFloat(const S: String; out res: Extended): Boolean;
  1384. begin
  1385. Result:=TryStrToFloat(S,double(res));
  1386. end;
  1387. function TryStrToFloat(const S: String; out res: Double): Boolean;
  1388. begin
  1389. Result:=TryStrToFloat(S,Res,FormatSettings);
  1390. end;
  1391. function TryStrToFloat(const S: String; out res: Extended; const aSettings : TFormatSettings): Boolean;
  1392. begin
  1393. Result:=TryStrToFloat(S,double(res),aSettings);
  1394. end;
  1395. function TryStrToFloat(const S: String; out res: Double; const aSettings : TFormatSettings): Boolean;
  1396. Var
  1397. J : JSValue;
  1398. N : String;
  1399. begin
  1400. N:=S;
  1401. // Delocalize
  1402. if (aSettings.ThousandSeparator <>'') then
  1403. N:=StringReplace(N,aSettings.ThousandSeparator,'',[rfReplaceAll]);
  1404. if (aSettings.DecimalSeparator<>'.') then
  1405. N:=StringReplace(N,aSettings.DecimalSeparator,'.',[]);
  1406. J:=parseFloat(N);
  1407. Result:=Not jsIsNaN(J);
  1408. if Result then
  1409. Res:=Double(J);
  1410. end;
  1411. function StrToFloatDef(const S: String; const aDef: Double; const aSettings : TFormatSettings): Double;
  1412. begin
  1413. if not TryStrToFloat(S,Result,aSettings) then
  1414. Result:=aDef;
  1415. end;
  1416. function StrToFloatDef(const S: String; const aDef: Double): Double;
  1417. begin
  1418. if not TryStrToFloat(S,Result,FormatSettings) then
  1419. Result:=aDef;
  1420. end;
  1421. function StrToFloat(const S: String): Double;
  1422. begin
  1423. Result:=StrToFloat(S,FormatSettings);
  1424. end;
  1425. function StrToFloat(const S: String; const aSettings : TFormatSettings): Double;
  1426. begin
  1427. if not TryStrToFloat(S,Result,aSettings) then
  1428. Raise EConvertError.CreateFmt(SErrInvalidFloat,[S]);
  1429. end;
  1430. Function FormatFloat (Fmt : String; aValue : Double) : String;
  1431. begin
  1432. Result:=FormatFloat(Fmt,aValue,FormatSettings);
  1433. end;
  1434. function FormatFloat(Fmt: String; aValue: Double; aSettings : TFormatSettings): String;
  1435. Type
  1436. TPosArray = Array of Integer;
  1437. const
  1438. MaxPrecision = 18; // Extended precision
  1439. var
  1440. // Input in usable format
  1441. E : Extended; // Value as extended.
  1442. FV: TFloatRec; // Value as floatrec.
  1443. Section : String; // Format can contain 3 sections, semicolon separated: Pos;Neg;Zero. This is the one to use.
  1444. SectionLength : Integer; // Length of section.
  1445. // Calculated based on section. Static during output
  1446. ThousandSep: Boolean; // Thousands separator detected in format ?
  1447. IsScientific: Boolean; // Use Scientific notation ? (E detected in format)
  1448. DecimalPos: Integer; // Position of decimal point in pattern.
  1449. FirstDigit: Integer; // First actual digit in input (# or 0), relative to decimal point
  1450. LastDigit: Integer; // Last required (0) digit, relative to decimal point
  1451. RequestedDigits: Integer; // Number of requested digits, # and 0 alike
  1452. ExpSize : Integer; // Number of digits in exponent
  1453. Available: Integer; // Available digits in FV.
  1454. // These change during output loop
  1455. Current: Integer; // Current digit in available digits
  1456. PadZeroes: Integer; // Difference in requested digits before comma and exponent, needs to be padded with zeroes.
  1457. DistToDecimal: Integer; // Place of current digit, relative to decimal point taking in account PadZeroes!
  1458. Procedure InitVars;
  1459. begin
  1460. E:=aValue;
  1461. Section:='';
  1462. SectionLength:=0;
  1463. ThousandSep:=false;
  1464. IsScientific:=false;
  1465. DecimalPos:=0;
  1466. FirstDigit:=MaxInt;
  1467. LastDigit:=0;
  1468. RequestedDigits:=0;
  1469. ExpSize:=0;
  1470. Available:=-1;
  1471. end;
  1472. procedure ToResult(const AChar: Char);
  1473. begin
  1474. Result:=Result+AChar;
  1475. end;
  1476. procedure AddToResult(const AStr: String);
  1477. begin
  1478. Result:=Result+AStr;
  1479. end;
  1480. procedure WriteDigit(ADigit: Char);
  1481. // Write a digit to result, prepend with decimalseparator or append with 1000 separator
  1482. begin
  1483. if ADigit=#0 then exit;
  1484. // Writeln('WriteDigit: ',ADigit,', DistToDecimal: ',DistToDecimal);
  1485. Dec(DistToDecimal);
  1486. // -1 -> we've arrived behind the decimal
  1487. if (DistToDecimal=-1) then
  1488. begin
  1489. AddToResult(aSettings.DecimalSeparator);
  1490. ToResult(ADigit);
  1491. end
  1492. else
  1493. begin
  1494. // We're still before the decimal.
  1495. ToResult(ADigit);
  1496. if ThousandSep and ((DistToDecimal mod 3)=0) and (DistToDecimal>1) then
  1497. AddToResult(aSettings.ThousandSeparator);
  1498. end;
  1499. end;
  1500. Function GetDigit : Char;
  1501. // Return next digit from available digits.
  1502. // May return #0 if none available.
  1503. // Will return '0' if applicable.
  1504. begin
  1505. // Writeln(' DistToDecimal <= LastDigit : ',DistToDecimal,' <= ',LastDigit,' have digit: ',Current<=Available, ' (',Current,')');
  1506. Result:=#0;
  1507. if (Current<=Available) then
  1508. begin
  1509. Result:=FV.Digits[Current];
  1510. Inc(Current);
  1511. end
  1512. else if (DistToDecimal <= LastDigit) then
  1513. Dec(DistToDecimal)
  1514. else
  1515. Result:='0';
  1516. // Writeln('GetDigit ->: ',Result);
  1517. end;
  1518. procedure CopyDigit;
  1519. // Copy a digit (#, 0) to the output with the correct value
  1520. begin
  1521. // Writeln('CopyDigit: Padzeroes: ',PadZeroes,', DistToDecimal: ',DistToDecimal);
  1522. if (PadZeroes=0) then
  1523. WriteDigit(GetDigit) // No shift needed, just copy what is available.
  1524. else if (PadZeroes<0) then
  1525. begin
  1526. // We must prepend zeroes
  1527. Inc(PadZeroes);
  1528. if (DistToDecimal<=FirstDigit) then
  1529. WriteDigit('0')
  1530. else
  1531. Dec(DistToDecimal);
  1532. end
  1533. else
  1534. begin
  1535. // We must append zeroes
  1536. while PadZeroes > 0 do
  1537. begin
  1538. WriteDigit(GetDigit);
  1539. Dec(PadZeroes);
  1540. end;
  1541. WriteDigit(GetDigit);
  1542. end;
  1543. end;
  1544. Function GetSections(Var SP : TPosArray) : Integer;
  1545. var
  1546. FL : Integer;
  1547. i : Integer;
  1548. C,Q : Char;
  1549. inQuote : Boolean;
  1550. begin
  1551. Result:=1;
  1552. SP[1]:=-1;
  1553. SP[2]:=-1;
  1554. SP[3]:=-1;
  1555. inQuote:=False;
  1556. Q:=#0;
  1557. I:=1;
  1558. FL:=Length(Fmt);
  1559. while (I<=FL) do
  1560. begin
  1561. C:=Fmt[I];
  1562. case C of
  1563. ';':
  1564. begin
  1565. if not InQuote then
  1566. begin
  1567. if Result>3 then
  1568. Raise Exception.Create('Invalid float format');
  1569. SP[Result]:=I+1;
  1570. Inc(Result);
  1571. end;
  1572. end;
  1573. '"','''':
  1574. begin
  1575. if InQuote then
  1576. InQuote:=C<>Q
  1577. else
  1578. begin
  1579. InQuote:=True;
  1580. Q:=C;
  1581. end;
  1582. end;
  1583. end;
  1584. Inc(I);
  1585. end;
  1586. if SP[Result]=-1 then
  1587. SP[Result]:=FL+1;
  1588. end;
  1589. Procedure AnalyzeFormat;
  1590. var
  1591. I,Len: Integer;
  1592. Q,C: Char;
  1593. InQuote : Boolean;
  1594. begin
  1595. Len:=Length(Section);
  1596. I:=1;
  1597. InQuote:=False;
  1598. Q:=#0;
  1599. while (I<=Len) do
  1600. begin
  1601. C:=Section[i];
  1602. if C in ['"',''''] then
  1603. begin
  1604. if InQuote then
  1605. InQuote:=C<>Q
  1606. else
  1607. begin
  1608. InQuote:=True;
  1609. Q:=C;
  1610. end;
  1611. end
  1612. else if not InQuote then
  1613. case C of
  1614. '.':
  1615. if (DecimalPos=0) then
  1616. DecimalPos:=RequestedDigits+1;
  1617. ',':
  1618. ThousandSep:=aSettings.ThousandSeparator<>#0;
  1619. 'e', 'E':
  1620. begin
  1621. Inc(I);
  1622. if (I<Len) then
  1623. begin
  1624. C:=Section[i];
  1625. IsScientific:=C in ['-','+'];
  1626. if IsScientific then
  1627. while (I<Len) and (Section[i+1]='0') do
  1628. begin
  1629. Inc(ExpSize);
  1630. Inc(I);
  1631. end;
  1632. if ExpSize>4 then
  1633. ExpSize:=4;
  1634. end;
  1635. end;
  1636. '#':
  1637. Inc(RequestedDigits);
  1638. '0':
  1639. begin
  1640. if RequestedDigits<FirstDigit then
  1641. FirstDigit:=RequestedDigits+1;
  1642. Inc(RequestedDigits);
  1643. LastDigit:=RequestedDigits+1;
  1644. end;
  1645. end;
  1646. Inc(I);
  1647. end;
  1648. if DecimalPos=0 then
  1649. DecimalPos:=RequestedDigits+1;
  1650. // Writeln('LastDigit: ',DecimalPos,'-',LastDigit);
  1651. LastDigit:=DecimalPos-LastDigit;
  1652. if LastDigit>0 then
  1653. LastDigit:=0;
  1654. // Writeln('FirstDigit: ',DecimalPos,'-',FirstDigit);
  1655. FirstDigit:=DecimalPos-FirstDigit;
  1656. if FirstDigit<0 then
  1657. FirstDigit:=0;
  1658. end;
  1659. Function ValueOutSideScope : Boolean;
  1660. begin
  1661. With FV do
  1662. Result:=((Exponent >= 18) and (not IsScientific)) or (Exponent = $7FF) or (Exponent = $800)
  1663. end;
  1664. Procedure CalcRunVars;
  1665. Var
  1666. D,P: Integer;
  1667. begin
  1668. if IsScientific then
  1669. begin
  1670. P:=RequestedDigits;
  1671. D:=9999;
  1672. end
  1673. else
  1674. begin
  1675. P:=MaxPrecision;
  1676. D:=RequestedDigits-DecimalPos+1;
  1677. end;
  1678. FV:=FloatToDecimal(aValue,P,D);
  1679. // Writeln('Number of digits available : ',Length(FV.Digits));
  1680. // For p:=0 to Length(FV.Digits)-1 do
  1681. // Writeln(P,': ',FV.Digits[p]);
  1682. DistToDecimal:=DecimalPos-1;
  1683. // Writeln('DistToDecimal : ',DistToDecimal);
  1684. if IsScientific then
  1685. PadZeroes:=0 // No padding.
  1686. else
  1687. begin
  1688. PadZeroes:=FV.Exponent-(DecimalPos-1);
  1689. if (PadZeroes>=0) then
  1690. DistToDecimal:=FV.Exponent
  1691. end;
  1692. // Writeln('PadZeroes : ',PadZeroes, ', DistToDecimal : ',DistToDecimal);
  1693. Available:=-1;
  1694. while (Available<High(FV.Digits)) and (FV.Digits[Available+1]<>#0) do
  1695. Inc(Available);
  1696. // Writeln('Available: ',Available);
  1697. end;
  1698. Function FormatExponent(ASign: Char; aExponent: Integer) : String;
  1699. begin
  1700. Result:=IntToStr(aExponent);
  1701. Result:=StringOfChar('0',ExpSize-Length(Result))+Result;
  1702. if (aExponent<0) then
  1703. Result:='-'+Result
  1704. else if (aExponent>0) and (aSign='+') then
  1705. Result:=aSign+Result;
  1706. end;
  1707. var
  1708. I,S : Integer;
  1709. C,Q : Char;
  1710. PA : TPosArray;
  1711. InLiteral : Boolean;
  1712. begin
  1713. SetLength(PA,4);
  1714. Result:='';
  1715. Initvars;
  1716. // What section to use ?
  1717. if (E>0) then
  1718. S:=1
  1719. else if (E<0) then
  1720. S:=2
  1721. else
  1722. S:=3;
  1723. PA[0]:=0;
  1724. I:=GetSections(PA);
  1725. if (I<S) or (PA[S]-PA[S-1]=0) then
  1726. S:=1;
  1727. // Extract correct section
  1728. SectionLength:=PA[S]-PA[S-1]-1;
  1729. Section:=Copy(Fmt,PA[S-1]+1,SectionLength);
  1730. SetLength(Section,SectionLength);
  1731. // Writeln('Section ',I,' : "',Section,'" ',SectionLength);
  1732. AnalyzeFormat;
  1733. // Writeln('RequestedDigits: ',RequestedDigits,', DecimalPos : ',DecimalPos,', LastDigit: ',LastDigit,', FirstDigit: ',FirstDigit);
  1734. CalcRunVars;
  1735. // If we cannot process value using current settings, fallback
  1736. if (SectionLength=0) or ValueOutSideScope then
  1737. begin
  1738. asm
  1739. Section=E.toPrecision(15);
  1740. end;
  1741. Result:=Section;
  1742. end;
  1743. // Get Started
  1744. I:=1;
  1745. Current:=0;
  1746. Q:=' ';
  1747. InLiteral:=False;
  1748. if (FV.Negative) and (S=1) then
  1749. ToResult('-');
  1750. while (I<=SectionLength) do
  1751. begin
  1752. C:=Section[i];
  1753. // Writeln('Analyzing pos ',I,': "',C,'"');
  1754. If (C in ['"', '''']) then
  1755. begin
  1756. if InLiteral then
  1757. InLiteral:=C<>Q
  1758. else
  1759. begin
  1760. inLiteral:=True;
  1761. Q:=C;
  1762. end;
  1763. end
  1764. else if InLiteral then
  1765. ToResult(C)
  1766. else
  1767. case C of
  1768. '0', '#':
  1769. CopyDigit;
  1770. '.', ',':
  1771. ; // Do nothing, handled by CopyDigit
  1772. 'e', 'E':
  1773. begin
  1774. ToResult(C); // Always needed
  1775. Inc(I);
  1776. if I<=Length(Section) then
  1777. begin
  1778. C:=Section[I];
  1779. if (C in ['+','-']) then
  1780. begin
  1781. AddToResult(FormatExponent(C,FV.Exponent-DecimalPos+1));
  1782. // Skip rest
  1783. while (I<SectionLength) and (Section[i+1]='0') do
  1784. Inc(I);
  1785. end;
  1786. end;
  1787. end;
  1788. else
  1789. ToResult(C);
  1790. end;
  1791. Inc(i);
  1792. end;
  1793. end;
  1794. function StrToBool(const S: String): Boolean;
  1795. begin
  1796. if not(TryStrToBool(S,Result)) then
  1797. raise EConvertError.CreateFmt(SInvalidBoolean,[S]);
  1798. end;
  1799. procedure CheckBoolStrs;
  1800. begin
  1801. if Length(TrueBoolStrs)=0 then
  1802. begin
  1803. SetLength(TrueBoolStrs,1);
  1804. TrueBoolStrs[0]:='True';
  1805. end;
  1806. if Length(FalseBoolStrs)=0 then
  1807. begin
  1808. SetLength(FalseBoolStrs,1);
  1809. FalseBoolStrs[0]:='False';
  1810. end;
  1811. end;
  1812. function BoolToStr(B: Boolean; UseBoolStrs: Boolean): string;
  1813. begin
  1814. if UseBoolStrs Then
  1815. begin
  1816. CheckBoolStrs;
  1817. if B then
  1818. Result:=TrueBoolStrs[0]
  1819. else
  1820. Result:=FalseBoolStrs[0];
  1821. end else
  1822. if B then
  1823. Result:='-1'
  1824. else
  1825. Result:='0';
  1826. end;
  1827. function BoolToStr(B: Boolean; const TrueS, FalseS: String): string;
  1828. begin
  1829. if B then Result:=TrueS else Result:=FalseS;
  1830. end;
  1831. function StrToBoolDef(const S: String; Default: Boolean): Boolean;
  1832. begin
  1833. if not TryStrToBool(S,Result) then
  1834. Result:=Default;
  1835. end;
  1836. function TryStrToBool(const S: String; out Value: Boolean): Boolean;
  1837. Var
  1838. Temp : String;
  1839. I : Longint;
  1840. D : Double;
  1841. Code: integer;
  1842. begin
  1843. Temp:=uppercase(S);
  1844. Val(Temp,D,code);
  1845. Result:=true;
  1846. If Code=0 then
  1847. Value:=(D<>0.0)
  1848. else
  1849. begin
  1850. CheckBoolStrs;
  1851. for I:=low(TrueBoolStrs) to High(TrueBoolStrs) do
  1852. if Temp=uppercase(TrueBoolStrs[I]) then
  1853. begin
  1854. Value:=true;
  1855. exit;
  1856. end;
  1857. for I:=low(FalseBoolStrs) to High(FalseBoolStrs) do
  1858. if Temp=uppercase(FalseBoolStrs[I]) then
  1859. begin
  1860. Value:=false;
  1861. exit;
  1862. end;
  1863. Result:=false;
  1864. end;
  1865. end;
  1866. function UpperCase(const s: String): String; assembler;
  1867. asm
  1868. return s.toUpperCase();
  1869. end;
  1870. function LowerCase(const s: String): String; assembler;
  1871. asm
  1872. return s.toLowerCase();
  1873. end;
  1874. function CompareStr(const s1, s2: String): Integer; assembler;
  1875. asm
  1876. var l1 = s1.length;
  1877. var l2 = s2.length;
  1878. if (l1<=l2){
  1879. var s = s2.substr(0,l1);
  1880. if (s1<s){ return -1;
  1881. } else if (s1>s){ return 1;
  1882. } else { return l1<l2 ? -1 : 0; };
  1883. } else {
  1884. var s = s1.substr(0,l2);
  1885. if (s<s2){ return -1;
  1886. } else { return 1; };
  1887. };
  1888. end;
  1889. function SameStr(const s1, s2: String): Boolean; assembler;
  1890. asm
  1891. return s1 == s2;
  1892. end;
  1893. function CompareText(const s1, s2: String): Integer; assembler;
  1894. asm
  1895. var l1 = s1.toLowerCase();
  1896. var l2 = s2.toLowerCase();
  1897. if (l1>l2){ return 1;
  1898. } else if (l1<l2){ return -1;
  1899. } else { return 0; }
  1900. end;
  1901. function SameText(const s1, s2: String): Boolean; assembler;
  1902. asm
  1903. return s1.toLowerCase() == s2.toLowerCase();
  1904. end;
  1905. function AnsiCompareText(const s1, s2: String): Integer; assembler;
  1906. asm
  1907. return s1.localeCompare(s2);
  1908. end;
  1909. function AnsiSameText(const s1, s2: String): Boolean; assembler;
  1910. asm
  1911. return s1.toLowerCase() == s2.toLowerCase();
  1912. end;
  1913. function AnsiCompareStr(const s1, s2: String): Integer;
  1914. begin
  1915. {$IFDEF ECMAScript6}
  1916. Result:=CompareText(TJSString(s1).normalize(),TJSString(s2).normalize());
  1917. {$ELSE}
  1918. Result:=CompareText(s1,s2);
  1919. {$ENDIF}
  1920. end;
  1921. procedure AppendStr(var Dest: String; const S: string);
  1922. begin
  1923. Dest:=Dest+S;
  1924. end;
  1925. Const
  1926. feInvalidFormat = 1;
  1927. feMissingArgument = 2;
  1928. feInvalidArgIndex = 3;
  1929. Procedure DoFormatError (ErrCode : Longint;const fmt: String);
  1930. begin
  1931. //!! must be changed to contain format string...
  1932. Case ErrCode of
  1933. feInvalidFormat : raise EConvertError.Createfmt(SInvalidFormat,[Fmt]);
  1934. feMissingArgument : raise EConvertError.Createfmt(SArgumentMissing,[Fmt]);
  1935. feInvalidArgIndex : raise EConvertError.Createfmt(SInvalidArgIndex,[Fmt]);
  1936. end;
  1937. end;
  1938. Const
  1939. maxdigits = 15;
  1940. Function SwapEndian(W : Word) : Word;
  1941. begin
  1942. Result:=((W and $FF) shl 8) or ((W shr 8) and $FF)
  1943. end;
  1944. Function SwapEndian(C : Cardinal) : Cardinal;
  1945. begin
  1946. Result:=((C and $FF) shl 24)
  1947. or ((C and $FF00) shl 8)
  1948. or ((C shr 8) and $FF00)
  1949. or ((C shr 24) and $FF);
  1950. end;
  1951. Function ReplaceDecimalSep(S: String; Const DS : string) : string;
  1952. Var
  1953. P : Integer;
  1954. begin
  1955. P:=Pos('.',S);
  1956. if P>0 then
  1957. Result:=Copy(S,1,P-1)+DS+Copy(S,P+1,Length(S)-P)
  1958. else
  1959. Result:=S;
  1960. end;
  1961. function FormatGeneralFloat(Value : double; Precision : Integer; DS : String) : string;
  1962. Var
  1963. P, PE, Q, Exponent: Integer;
  1964. Begin
  1965. If (Precision = -1) Or (Precision > maxdigits) Then
  1966. Precision := maxdigits;
  1967. { First convert to scientific format, with correct precision }
  1968. Str(Value:precision+7, Result);
  1969. { Delete leading spaces }
  1970. Result:=TrimLeft(Result);
  1971. P:=Pos('.',Result);
  1972. if P=0 then
  1973. exit;
  1974. { Consider removing exponent }
  1975. PE:=Pos('E',Result);
  1976. if PE=0 then
  1977. begin
  1978. Result:=ReplaceDecimalSep(Result,DS);
  1979. exit;
  1980. end;
  1981. { Read exponent }
  1982. Q:=PE+2;
  1983. Exponent := 0;
  1984. while (Q <= Length(Result)) do
  1985. begin
  1986. Exponent := Exponent*10 + Ord(Result[Q])-Ord('0');
  1987. Inc(Q);
  1988. end;
  1989. if Result[PE+1] = '-' then
  1990. Exponent := -Exponent;
  1991. if (P+Exponent < PE) and (Exponent > -6) then
  1992. begin
  1993. { OK to remove exponent }
  1994. SetLength(Result,PE-1); { Trim exponent }
  1995. if Exponent >= 0 then
  1996. begin
  1997. { Shift point to right }
  1998. for Q := 0 to Exponent-1 do
  1999. begin
  2000. Result[P] := Result[P+1];
  2001. Inc(P);
  2002. end;
  2003. Result[P] := '.';
  2004. P := 1;
  2005. if Result[P] = '-' then
  2006. Inc(P);
  2007. while (Result[P] = '0') and (P < Length(Result)) and (Copy(Result,P+1,Length(DS))<>DS) do
  2008. { Trim leading zeros; conversion above should not give any, but occasionally does
  2009. because of rounding }
  2010. System.Delete(Result,P,1);
  2011. end
  2012. else
  2013. begin
  2014. { Add zeros at start }
  2015. Insert(Copy('00000',1,-Exponent),Result,P-1);
  2016. Result[P-Exponent] := Result[P-Exponent-1]; { Copy leading digit }
  2017. Result[P] := '.';
  2018. if Exponent <> -1 then
  2019. Result[P-Exponent-1] := '0';
  2020. end;
  2021. { Remove trailing zeros }
  2022. Q := Length(Result);
  2023. while (Q > 0) and (Result[Q] = '0') do
  2024. Dec(Q);
  2025. if Result[Q] = '.' then
  2026. Dec(Q); { Remove trailing decimal point }
  2027. if (Q = 0) or ((Q=1) and (Result[1] = '-')) then
  2028. Result := '0'
  2029. else
  2030. SetLength(Result,Q);
  2031. end
  2032. else
  2033. begin
  2034. { Need exponent, but remove superfluous characters }
  2035. { Delete trailing zeros }
  2036. while Result[PE-1] = '0' do
  2037. begin
  2038. System.Delete(Result,PE-1,1);
  2039. Dec(PE);
  2040. end;
  2041. { If number ends in decimal point, remove it }
  2042. if Result[PE-1] = DS then
  2043. begin
  2044. System.Delete(Result,PE-1,1);
  2045. Dec(PE);
  2046. end;
  2047. { delete superfluous + in exponent }
  2048. if Result[PE+1]='+' then
  2049. System.Delete(Result,PE+1,1)
  2050. else
  2051. Inc(PE);
  2052. while Result[PE+1] = '0' do
  2053. { Delete leading zeros in exponent }
  2054. System.Delete(Result,PE+1,1)
  2055. end;
  2056. Result:=ReplaceDecimalSep(Result,DS)
  2057. end;
  2058. function FormatExponentFloat(Value : double; Precision,Digits : Integer;DS : String) : string;
  2059. Var
  2060. P: Integer;
  2061. Begin
  2062. DS:=FormatSettings.DecimalSeparator;
  2063. If (Precision = -1) Or (Precision > maxdigits) Then
  2064. Precision := maxdigits;
  2065. Str(Value:Precision+7, Result);
  2066. { Delete leading spaces }
  2067. while Result[1] = ' ' do
  2068. System.Delete(Result, 1, 1);
  2069. P:=Pos('E',Result);
  2070. if P=0 then
  2071. begin
  2072. Result:=ReplaceDecimalSep(Result,DS);
  2073. exit;
  2074. end;
  2075. Inc(P, 2);
  2076. if Digits > 4 then
  2077. Digits:=4;
  2078. Digits:=Length(Result) - P - Digits + 1;
  2079. if Digits < 0 then
  2080. insert(copy('0000',1,-Digits),Result,P)
  2081. else
  2082. while (Digits > 0) and (Result[P] = '0') do
  2083. begin
  2084. System.Delete(Result, P, 1);
  2085. if P > Length(Result) then
  2086. begin
  2087. System.Delete(Result, P - 2, 2);
  2088. break;
  2089. end;
  2090. Dec(Digits);
  2091. end;
  2092. Result:=ReplaceDecimalSep(Result,DS);
  2093. End;
  2094. function FormatFixedFloat(Value : double; Digits : Integer; DS : String) : string;
  2095. Begin
  2096. If Digits = -1 Then
  2097. Digits := 2
  2098. Else If Digits > 18 Then
  2099. Digits := 18;
  2100. Str(Value:0:Digits, Result);
  2101. if (Result<>'') and (Result[1]=' ') then
  2102. Delete(Result,1,1);
  2103. Result:=ReplaceDecimalSep(Result,DS);
  2104. end;
  2105. function FormatNumberFloat(Value : double; Digits : Integer; DS,TS : String) : string;
  2106. Var
  2107. P : integer;
  2108. Begin
  2109. If Digits = -1 Then
  2110. Digits := 2
  2111. else If Digits > maxdigits Then
  2112. Digits := maxdigits;
  2113. Str(Value:0:Digits, Result);
  2114. if (Result<>'') and (Result[1]=' ') then
  2115. Delete(Result,1,1);
  2116. P:=Pos('.',Result);
  2117. if (P<=0) then
  2118. P:=Length(Result)+1;
  2119. Result:=ReplaceDecimalSep(Result,DS);
  2120. Dec(P,3);
  2121. if (TS<>'') and (TS<>#0) then
  2122. While (P>1) Do
  2123. Begin
  2124. If (Result[P-1] <> '-') Then
  2125. Insert(TS, Result, P);
  2126. Dec(P, 3);
  2127. End;
  2128. End;
  2129. function RemoveLeadingNegativeSign(var AValue: String; DS : String; aThousandSeparator : String): Boolean;
  2130. // removes negative sign in case when result is zero eg. -0.00
  2131. var
  2132. i: PtrInt;
  2133. TS: String;
  2134. StartPos: PtrInt;
  2135. begin
  2136. Result:=False;
  2137. StartPos := 2;
  2138. TS := aThousandSeparator;
  2139. for i :=StartPos to length(AValue) do
  2140. begin
  2141. Result := (AValue[i] in ['0', DS, 'E', '+']) or (aValue[i]=TS);
  2142. if not Result then
  2143. break;
  2144. end;
  2145. if (Result) and (AValue[1]='-') then
  2146. Delete(AValue, 1, 1);
  2147. end;
  2148. Function FormatNumberCurrency(const Value : Currency; Digits : Integer; const aSettings: TFormatSettings) : string;
  2149. Var
  2150. Negative: Boolean;
  2151. P : Integer;
  2152. CS,DS,TS : String;
  2153. Begin
  2154. DS:=aSettings.DecimalSeparator;
  2155. TS:=aSettings.ThousandSeparator;
  2156. CS:=aSettings.CurrencyString;
  2157. // Writeln('Value ',D);
  2158. If Digits = -1 Then
  2159. Digits := aSettings.CurrencyDecimals
  2160. Else If Digits > 18 Then
  2161. Digits := 18;
  2162. Str(Value:0:Digits, Result);
  2163. // Writeln('1. Result ',Result,' currencystring : ',CurrencyString);
  2164. Negative:=Result[1] = '-';
  2165. if Negative then
  2166. System.Delete(Result, 1, 1);
  2167. P := Pos('.', Result);
  2168. // Writeln('2. Result ',Result,' currencystring : ',CurrencyString);
  2169. If TS<>'' Then
  2170. begin
  2171. If P <> 0 Then
  2172. Result:=ReplaceDecimalSep(Result,DS)
  2173. else
  2174. P := Length(Result)+1;
  2175. Dec(P, 3);
  2176. While (P > 1) Do
  2177. Begin
  2178. Insert(DS, Result, P);
  2179. Dec(P, 3);
  2180. End;
  2181. end;
  2182. // Writeln('3. Result ',Result,' currencystring : ',CurrencyString);
  2183. if Negative then
  2184. RemoveLeadingNegativeSign(Result,DS,TS);
  2185. // Writeln('4. Result ',Result,' currencystring : ',CurrencyString);
  2186. // Writeln('CurrencyFormat: ',CurrencyFormat,'NegcurrencyFormat: ',NegCurrFormat);
  2187. If Not Negative Then
  2188. Case aSettings.CurrencyFormat Of
  2189. 0: Result := CS + Result;
  2190. 1: Result := Result + CS;
  2191. 2: Result := CS + ' ' + Result;
  2192. 3: Result := Result + ' ' + CS;
  2193. end
  2194. else
  2195. Case aSettings.NegCurrFormat Of
  2196. 0: Result := '(' + CS + Result + ')';
  2197. 1: Result := '-' + CS + Result;
  2198. 2: Result := CS + '-' + Result;
  2199. 3: Result := CS + Result + '-';
  2200. 4: Result := '(' + Result + CS + ')';
  2201. 5: Result := '-' + Result + CS;
  2202. 6: Result := Result + '-' + CS;
  2203. 7: Result := Result + CS + '-';
  2204. 8: Result := '-' + Result + ' ' + CS;
  2205. 9: Result := '-' + CS + ' ' + Result;
  2206. 10: Result := Result + ' ' + CS + '-';
  2207. 11: Result := CS + ' ' + Result + '-';
  2208. 12: Result := CS + ' ' + '-' + Result;
  2209. 13: Result := Result + '-' + ' ' + CS;
  2210. 14: Result := '(' + CS + ' ' + Result + ')';
  2211. 15: Result := '(' + Result + ' ' + CS + ')';
  2212. end;
  2213. end;
  2214. function FloatToStrF(const Value: double; format: TFloatFormat; Precision,
  2215. Digits: Integer): String;
  2216. begin
  2217. Result:=FloatToStrF(Value,Format,Precision,Digits,Formatsettings);
  2218. end;
  2219. function FloatToStrF(const Value: double; format: TFloatFormat; Precision,
  2220. Digits: Integer ;const aSettings : TFormatSettings): String;
  2221. Var
  2222. TS,DS: string;
  2223. Begin
  2224. DS:=aSettings.DecimalSeparator;
  2225. TS:=aSettings.ThousandSeparator;
  2226. Case format Of
  2227. ffGeneral:
  2228. Result:=FormatGeneralFloat(Value,Precision,DS);
  2229. ffExponent:
  2230. Result:=FormatExponentFloat(Value,Precision,Digits,DS);
  2231. ffFixed:
  2232. Result:=FormatFixedFloat(Value,Digits,DS);
  2233. ffNumber:
  2234. Result:=FormatNumberFloat(Value,Digits,DS,TS);
  2235. ffCurrency:
  2236. Result:=FormatNumberCurrency(Value,Digits,aSettings);
  2237. end;
  2238. if (Format<>ffCurrency) and (length(Result)>1) and (Result[1]='-') then
  2239. RemoveLeadingNegativeSign(Result,DS,TS);
  2240. end;
  2241. function Format(const Fmt: String; const Args: array of JSValue): String;
  2242. begin
  2243. Result:=Format(Fmt,Args,FormatSettings)
  2244. end;
  2245. function Format(const Fmt: String; const Args: array of JSValue ; const aSettings : TFormatSettings): String;
  2246. Var ChPos,OldPos,ArgPos,DoArg,Len : SizeInt;
  2247. Hs,ToAdd : String;
  2248. Index : Byte;
  2249. Width,Prec : Longint;
  2250. Left : Boolean;
  2251. Fchar : char;
  2252. vq : nativeint;
  2253. {
  2254. ReadFormat reads the format string. It returns the type character in
  2255. uppercase, and sets index, Width, Prec to their correct values,
  2256. or -1 if not set. It sets Left to true if left alignment was requested.
  2257. In case of an error, DoFormatError is called.
  2258. }
  2259. Function ReadFormat : Char;
  2260. Var Value : NativeInt;
  2261. Procedure ReadInteger;
  2262. var
  2263. Code: integer;
  2264. ArgN: SizeInt;
  2265. begin
  2266. If Value<>-1 then exit; // Was already read.
  2267. OldPos:=ChPos;
  2268. While (ChPos<=Len) and
  2269. (Fmt[ChPos]<='9') and (Fmt[ChPos]>='0') do inc(ChPos);
  2270. If ChPos>len then
  2271. DoFormatError(feInvalidFormat,Fmt);
  2272. If Fmt[ChPos]='*' then
  2273. begin
  2274. if Index=High(byte) then
  2275. ArgN:=Argpos
  2276. else
  2277. begin
  2278. ArgN:=Index;
  2279. Inc(Index);
  2280. end;
  2281. If (ChPos>OldPos) or (ArgN>High(Args)) then
  2282. DoFormatError(feInvalidFormat,Fmt);
  2283. ArgPos:=ArgN+1;
  2284. if IsNumber(Args[ArgN]) and IsInteger(Args[ArgN]) then
  2285. Value:=Integer(Args[ArgN])
  2286. else
  2287. DoFormatError(feInvalidFormat,Fmt);
  2288. Inc(ChPos);
  2289. end
  2290. else
  2291. begin
  2292. If (OldPos<ChPos) Then
  2293. begin
  2294. Val (Copy(Fmt,OldPos,ChPos-OldPos),value,code);
  2295. // This should never happen !!
  2296. If Code>0 then DoFormatError (feInvalidFormat,Fmt);
  2297. end
  2298. else
  2299. Value:=-1;
  2300. end;
  2301. end;
  2302. Procedure ReadIndex;
  2303. begin
  2304. If Fmt[ChPos]<>':' then
  2305. ReadInteger
  2306. else
  2307. value:=0; // Delphi undocumented behaviour, assume 0, #11099
  2308. If Fmt[ChPos]=':' then
  2309. begin
  2310. If Value=-1 then DoFormatError(feMissingArgument,Fmt);
  2311. Index:=Value;
  2312. Value:=-1;
  2313. Inc(ChPos);
  2314. end;
  2315. end;
  2316. Procedure ReadLeft;
  2317. begin
  2318. If Fmt[ChPos]='-' then
  2319. begin
  2320. left:=True;
  2321. Inc(ChPos);
  2322. end
  2323. else
  2324. Left:=False;
  2325. end;
  2326. Procedure ReadWidth;
  2327. begin
  2328. ReadInteger;
  2329. If Value<>-1 then
  2330. begin
  2331. Width:=Value;
  2332. Value:=-1;
  2333. end;
  2334. end;
  2335. Procedure ReadPrec;
  2336. begin
  2337. If Fmt[ChPos]='.' then
  2338. begin
  2339. inc(ChPos);
  2340. ReadInteger;
  2341. If Value=-1 then
  2342. Value:=0;
  2343. prec:=Value;
  2344. end;
  2345. end;
  2346. begin
  2347. Index:=High(byte);
  2348. Width:=-1;
  2349. Prec:=-1;
  2350. Value:=-1;
  2351. inc(ChPos);
  2352. If Fmt[ChPos]='%' then
  2353. begin
  2354. Result:='%';
  2355. exit; // VP fix
  2356. end;
  2357. ReadIndex;
  2358. ReadLeft;
  2359. ReadWidth;
  2360. ReadPrec;
  2361. Result:=Upcase(Fmt[ChPos]);
  2362. end;
  2363. function Checkarg (AT : TJSValueType; err:boolean):boolean;
  2364. {
  2365. Check if argument INDEX is of correct type (AT)
  2366. If Index=-1, ArgPos is used, and argpos is augmented with 1
  2367. DoArg is set to the argument that must be used.
  2368. }
  2369. begin
  2370. result:=false;
  2371. if Index=High(Byte) then
  2372. DoArg:=Argpos
  2373. else
  2374. DoArg:=Index;
  2375. ArgPos:=DoArg+1;
  2376. If (Doarg>High(Args)) or (GetValueTYpe(Args[Doarg])<>AT) then
  2377. begin
  2378. if err then
  2379. DoFormatError(feInvalidArgindex,Fmt);
  2380. dec(ArgPos);
  2381. exit;
  2382. end;
  2383. result:=true;
  2384. end;
  2385. begin
  2386. Result:='';
  2387. Len:=Length(Fmt);
  2388. ChPos:=1;
  2389. OldPos:=1;
  2390. ArgPos:=0;
  2391. While ChPos<=len do
  2392. begin
  2393. While (ChPos<=Len) and (Fmt[ChPos]<>'%') do
  2394. inc(ChPos);
  2395. If ChPos>OldPos Then
  2396. Result:=Result+Copy(Fmt,OldPos,ChPos-Oldpos);
  2397. If ChPos<Len then
  2398. begin
  2399. FChar:=ReadFormat;
  2400. {$ifdef fmtdebug}
  2401. DumpFormat(FCHar);
  2402. {$endif}
  2403. Case FChar of
  2404. 'D' : begin
  2405. Checkarg(jvtinteger,true);
  2406. toAdd:=IntToStr(NativeInt(Args[DoArg]));
  2407. Width:=Abs(width);
  2408. Index:=Prec-Length(ToAdd);
  2409. If ToAdd[1]<>'-' then
  2410. ToAdd:=StringOfChar('0',Index)+ToAdd
  2411. else
  2412. // + 1 to accomodate for - sign in length !!
  2413. Insert(StringOfChar('0',Index+1),toadd,2);
  2414. end;
  2415. 'U' : begin
  2416. Checkarg(jvtinteger,True);
  2417. if NativeInt(Args[Doarg])<0 then
  2418. DoFormatError(feInvalidArgindex,Fmt);
  2419. Toadd:=IntToStr(NativeInt(Args[Doarg]));
  2420. Width:=Abs(width);
  2421. Index:=Prec-Length(ToAdd);
  2422. ToAdd:=StringOfChar('0',Index)+ToAdd
  2423. end;
  2424. 'E' : begin
  2425. if CheckArg(jvtFloat,false) or CheckArg(jvtInteger,True) then
  2426. ToAdd:=FloatToStrF(Double(Args[doarg]),ffFixed,9999,Prec,aSettings);
  2427. end;
  2428. 'F' : begin
  2429. if CheckArg(jvtFloat,false) or CheckArg(jvtInteger,True) then
  2430. ToAdd:=FloatToStrF(Double(Args[doarg]),ffFixed,9999,Prec,aSettings);
  2431. end;
  2432. 'G' : begin
  2433. if CheckArg(jvtFloat,false) or CheckArg(jvtInteger,True) then
  2434. ToAdd:=FloatToStrF(Double(Args[doarg]),ffGeneral,Prec,3,aSettings);
  2435. end;
  2436. 'N' : begin
  2437. if CheckArg(jvtFloat,false) or CheckArg(jvtInteger,True) then
  2438. ToAdd:=FloatToStrF(Double(Args[doarg]),ffNumber,9999,Prec,aSettings);
  2439. end;
  2440. 'M' : begin
  2441. if CheckArg(jvtFloat,false) or CheckArg(jvtInteger,True) then
  2442. ToAdd:=FloatToStrF(Double(Args[doarg]),ffCurrency,9999,Prec,aSettings);
  2443. end;
  2444. 'S' : begin
  2445. CheckArg(jvtString,true);
  2446. hs:=String(Args[doarg]);
  2447. Index:=Length(hs);
  2448. If (Prec<>-1) and (Index>Prec) then
  2449. Index:=Prec;
  2450. ToAdd:=Copy(hs,1,Index);
  2451. end;
  2452. 'P' : Begin
  2453. CheckArg(jvtInteger,true);
  2454. ToAdd:=IntToHex(NativeInt(Args[DoArg]),31);
  2455. end;
  2456. 'X' : begin
  2457. Checkarg(jvtinteger,true);
  2458. vq:=nativeInt(Args[Doarg]);
  2459. index:=31; // May need to adjust to NativeInt
  2460. If Prec>index then
  2461. ToAdd:=IntToHex(NativeInt(vq),index)
  2462. else
  2463. begin
  2464. // determine minimum needed number of hex digits.
  2465. Index:=1;
  2466. While (NativeInt(1) shl (Index*4)<=vq) and (index<16) do
  2467. inc(Index);
  2468. If Index>Prec then
  2469. Prec:=Index;
  2470. ToAdd:=IntToHex(vq,Prec);
  2471. end;
  2472. end;
  2473. '%': ToAdd:='%';
  2474. end;
  2475. If Width<>-1 then
  2476. If Length(ToAdd)<Width then
  2477. If not Left then
  2478. ToAdd:=StringOfChar(' ',Width-Length(ToAdd))+ToAdd
  2479. else
  2480. ToAdd:=ToAdd+StringOfChar(' ',Width-Length(ToAdd));
  2481. Result:=Result+ToAdd;
  2482. end;
  2483. inc(ChPos);
  2484. Oldpos:=ChPos;
  2485. end;
  2486. end;
  2487. function BytesOf(const AVal: string): TBytes;
  2488. var
  2489. I: SizeUInt;
  2490. begin
  2491. SetLength(Result, Length(AVal));
  2492. for I := 0 to Length(AVal)-1 do
  2493. Result[I] := Ord(AVal[I+1]);
  2494. end;
  2495. function StringOf(const ABytes: TBytes): string;
  2496. var
  2497. I: Integer;
  2498. begin
  2499. Result:='';
  2500. for I := 0 to Length(ABytes)-1 do
  2501. Result:=Result+Char(ABytes[I]);
  2502. end;
  2503. function LocaleCompare(const s1, s2, locales: String): Boolean; assembler;
  2504. asm
  2505. return s1.localeCompare(s2,locales) == 0;
  2506. end;
  2507. function NormalizeStr(const S: String; const Norm: String): String; assembler;
  2508. asm
  2509. return S.normalize(Norm);
  2510. end;
  2511. function IsValidIdent(const Ident: string; AllowDots: Boolean = False; StrictDots: Boolean = False): Boolean;
  2512. const
  2513. Alpha = ['A'..'Z', 'a'..'z', '_'];
  2514. AlphaNum = Alpha + ['0'..'9'];
  2515. Dot = '.';
  2516. var
  2517. First: Boolean;
  2518. I, Len: Integer;
  2519. begin
  2520. Len := Length(Ident);
  2521. if Len < 1 then
  2522. Exit(False);
  2523. First := True;
  2524. Result:=false;
  2525. I:=1;
  2526. While I<=len do
  2527. begin
  2528. if First then
  2529. begin
  2530. if not (Ident[I] in Alpha) then exit;
  2531. First := False;
  2532. end
  2533. else if AllowDots and (Ident[I] = Dot) then
  2534. begin
  2535. if StrictDots then
  2536. begin
  2537. if I >= Len then exit;
  2538. First := True;
  2539. end;
  2540. end
  2541. else
  2542. if not (Ident[I] in AlphaNum) then exit;
  2543. I:=I+1;
  2544. end;
  2545. Result:=true;
  2546. end;
  2547. procedure FreeAndNil(var Obj);
  2548. var
  2549. o: TObject;
  2550. begin
  2551. o:=TObject(Obj);
  2552. if o=nil then exit;
  2553. TObject(Obj):=nil;
  2554. o.Destroy;
  2555. end;
  2556. { EVariantError }
  2557. constructor EVariantError.CreateCode(Code: Longint);
  2558. begin
  2559. ErrCode:=Code;
  2560. end;
  2561. { Exception }
  2562. constructor Exception.Create(const Msg: String);
  2563. begin
  2564. fMessage:=Msg;
  2565. {$ifdef nodejs}
  2566. FNodeJSError:=TJSError.new;
  2567. {$endif}
  2568. if LogMessageOnCreate then
  2569. Writeln('Created exception ',ClassName,' with message: ',Msg);
  2570. end;
  2571. constructor Exception.CreateFmt(const Msg: string; const Args: array of jsvalue
  2572. );
  2573. begin
  2574. //writeln('Exception.CreateFmt START ',ClassName,' "',Msg,'" Args=',Args);
  2575. Create(Format(Msg,Args));
  2576. //writeln('Exception.CreateFmt END ',ClassName,' "',Msg,'" fMessage=',fMessage);
  2577. end;
  2578. constructor Exception.CreateHelp(const Msg: String; AHelpContext: Integer);
  2579. begin
  2580. Create(Msg);
  2581. fHelpContext:=AHelpContext;
  2582. end;
  2583. constructor Exception.CreateFmtHelp(const Msg: string;
  2584. const Args: array of jsvalue; AHelpContext: Integer);
  2585. begin
  2586. Create(Format(Msg,Args));
  2587. fHelpContext:=AHelpContext;
  2588. end;
  2589. function Exception.ToString: String;
  2590. begin
  2591. Result:=ClassName+': '+Message;
  2592. end;
  2593. Const
  2594. RESpecials = '([\$\+\[\]\(\)\\\.\*\^\?\|])';
  2595. function StringReplace(aOriginal, aSearch, aReplace: string;
  2596. Flags: TStringReplaceFlags): String;
  2597. Var
  2598. REFlags : String;
  2599. REString : String;
  2600. begin
  2601. REFlags:='';
  2602. if rfReplaceAll in flags then
  2603. ReFlags:='g';
  2604. if rfIgnoreCase in flags then
  2605. ReFlags:=ReFlags+'i';
  2606. REString:=TJSString(aSearch).replace(TJSRegexp.new(RESpecials,'g'),'\$1');
  2607. Result:=TJSString(aOriginal).replace(TJSRegexp.new(REString,REFlags),aReplace);
  2608. end;
  2609. function QuoteString(aOriginal: String; AQuote: Char): String;
  2610. begin
  2611. Result:=AQuote+StringReplace(aOriginal,aQuote,aQuote+aQuote,[rfReplaceAll])+AQuote;
  2612. end;
  2613. function QuotedStr(const s: string; QuoteChar : Char = ''''): string;
  2614. begin
  2615. Result:=QuoteString(S,QuoteChar);
  2616. end;
  2617. function DeQuoteString(aQuoted: String; AQuote: Char): String;
  2618. var
  2619. i: Integer;
  2620. begin
  2621. Result:=aQuoted;
  2622. if TJSString(Result).substr(0,1)<>AQuote then exit;
  2623. Result:=TJSString(Result).slice(1);
  2624. i:=1;
  2625. while i<=length(Result) do
  2626. begin
  2627. if Result[i]=AQuote then
  2628. begin
  2629. if (i=length(Result)) or (Result[i+1]<>AQuote) then
  2630. begin
  2631. Result:=TJSString(Result).slice(0,i-1);
  2632. exit;
  2633. end
  2634. else
  2635. Result:=TJSString(Result).slice(0,i-1)+TJSString(Result).slice(i);
  2636. end
  2637. else
  2638. inc(i);
  2639. end;
  2640. end;
  2641. function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean;
  2642. begin
  2643. Result:=False;
  2644. if (Index>0) and (Index<=Length(S)) then
  2645. Result:=Pos(S[Index],Delimiters)<>0; // Note we don't do MBCS yet
  2646. end;
  2647. Function LastDelimiter(const Delimiters, S: string): SizeInt;
  2648. begin
  2649. Result:=Length(S);
  2650. While (Result>0) and (Pos(S[Result],Delimiters)=0) do
  2651. Dec(Result);
  2652. end;
  2653. function AdjustLineBreaks(const S: string): string;
  2654. begin
  2655. Result:=AdjustLineBreaks(S,DefaultTextLineBreakStyle);
  2656. end;
  2657. function AdjustLineBreaks(const S: string; Style: TTextLineBreakStyle): string;
  2658. var
  2659. I,L: Longint;
  2660. Res : String;
  2661. Procedure Add(C : Char);
  2662. begin
  2663. Res:=Res+C;
  2664. end;
  2665. begin
  2666. I:=0;
  2667. L:=Length(S);
  2668. Result:='';
  2669. While (I<=L) do
  2670. case S[I] of
  2671. #10: begin
  2672. if Style in [tlbsCRLF,tlbsCR] then
  2673. Add(#13);
  2674. if Style=tlbsCRLF then
  2675. Add(#10);
  2676. Inc(I);
  2677. end;
  2678. #13: begin
  2679. if Style=tlbsCRLF then
  2680. Add(#13);
  2681. Add(#10);
  2682. Inc(I);
  2683. if S[I]=#10 then
  2684. Inc(I);
  2685. end;
  2686. else
  2687. Add(S[i]);
  2688. Inc(I);
  2689. end;
  2690. Result:=Res;
  2691. end;
  2692. function WrapText(const Line, BreakStr: string;
  2693. const BreakChars: array of char; MaxCol: Integer): string;
  2694. const
  2695. Quotes = ['''', '"'];
  2696. Var
  2697. L : String;
  2698. C,LQ,BC : Char;
  2699. P,BLen,Len : Integer;
  2700. HB,IBC : Boolean;
  2701. begin
  2702. Result:='';
  2703. L:=Line;
  2704. Blen:=Length(BreakStr);
  2705. If (BLen>0) then
  2706. BC:=BreakStr[1]
  2707. else
  2708. BC:=#0;
  2709. Len:=Length(L);
  2710. While (Len>0) do
  2711. begin
  2712. P:=1;
  2713. LQ:=#0;
  2714. HB:=False;
  2715. IBC:=False;
  2716. While ((P<=Len) and ((P<=MaxCol) or not IBC)) and ((LQ<>#0) or Not HB) do
  2717. begin
  2718. C:=L[P];
  2719. If (C=LQ) then
  2720. LQ:=#0
  2721. else If (C in Quotes) then
  2722. LQ:=C;
  2723. If (LQ<>#0) then
  2724. Inc(P)
  2725. else
  2726. begin
  2727. HB:=((C=BC) and (BreakStr=Copy(L,P,BLen)));
  2728. If HB then
  2729. Inc(P,Blen)
  2730. else
  2731. begin
  2732. If (P>=MaxCol) then
  2733. IBC:=CharInSet(C,BreakChars);
  2734. Inc(P);
  2735. end;
  2736. end;
  2737. // Writeln('"',C,'" : IBC : ',IBC,' HB : ',HB,' LQ : ',LQ,' P>MaxCol : ',P>MaxCol);
  2738. end;
  2739. Result:=Result+Copy(L,1,P-1);
  2740. Delete(L,1,P-1);
  2741. Len:=Length(L);
  2742. If (Len>0) and Not HB then
  2743. Result:=Result+BreakStr;
  2744. end;
  2745. end;
  2746. function WrapText(const Line: string; MaxCol: Integer): string;
  2747. begin
  2748. Result:=WrapText(Line,sLineBreak, [' ', '-', #9], MaxCol);
  2749. end;
  2750. function GetEnvironmentVariable(const EnvVar: String): String;
  2751. begin
  2752. if Assigned(OnGetEnvironmentVariable) then
  2753. Result:=OnGetEnvironmentVariable(EnvVar)
  2754. else
  2755. Result:='';
  2756. end;
  2757. function GetEnvironmentVariableCount: Integer;
  2758. begin
  2759. if Assigned(OnGetEnvironmentVariableCount) then
  2760. Result:=OnGetEnvironmentVariableCount()
  2761. else
  2762. Result:=0;
  2763. end;
  2764. function GetEnvironmentString(Index: Integer): String;
  2765. begin
  2766. if Assigned(OnGetEnvironmentString) then
  2767. Result:=OnGetEnvironmentString(Index)
  2768. else
  2769. Result:='';
  2770. end;
  2771. { Date/Time routines}
  2772. Function DoEncodeDate(Year, Month, Day: Word): longint;
  2773. Var
  2774. D : TDateTime;
  2775. begin
  2776. If TryEncodeDate(Year,Month,Day,D) then
  2777. Result:=Trunc(D)
  2778. else
  2779. Result:=0;
  2780. end;
  2781. function DoEncodeTime(Hour, Minute, Second, MilliSecond: word): TDateTime;
  2782. begin
  2783. If not TryEncodeTime(Hour,Minute,Second,MilliSecond,Result) then
  2784. Result:=0;
  2785. end;
  2786. function DateTimeToJSDate(aDateTime: TDateTime): TJSDate;
  2787. Var
  2788. Y,M,D,h,n,s,z : Word;
  2789. begin
  2790. DecodeDate(Trunc(aDateTime),Y,M,D);
  2791. DecodeTime(Frac(aDateTime),H,N,S,Z);
  2792. Result:=TJSDate.New(Y,M-1,D,h,n,s,z);
  2793. end;
  2794. function JSDateToDateTime(aDate: TJSDate): TDateTime;
  2795. begin
  2796. Result:=EncodeDate(ADate.FullYear,ADate.Month+1,ADate.Date) +
  2797. EncodeTime(ADate.Hours,ADate.Minutes,ADate.Seconds,ADate.Milliseconds);
  2798. end;
  2799. { ComposeDateTime converts a Date and a Time into one TDateTime }
  2800. function ComposeDateTime(Date,Time : TDateTime) : TDateTime;
  2801. begin
  2802. if Date < 0 then
  2803. Result := trunc(Date) - Abs(frac(Time))
  2804. else
  2805. Result := trunc(Date) + Abs(frac(Time));
  2806. end;
  2807. function TryEncodeDate(Year, Month, Day: Word; out Date: TDateTime): Boolean;
  2808. var
  2809. c, ya: LongWord;
  2810. begin
  2811. Result:=(Year>0) and (Year<10000) and
  2812. (Month >= 1) and (Month<=12) and
  2813. (Day>0) and (Day<=MonthDays[IsleapYear(Year),Month]);
  2814. If Result then
  2815. begin
  2816. if month > 2 then
  2817. Dec(Month,3)
  2818. else
  2819. begin
  2820. Inc(Month,9);
  2821. Dec(Year);
  2822. end;
  2823. c:= Year DIV 100;
  2824. ya:= Year - 100*c;
  2825. Date := (146097*c) SHR 2 + (1461*ya) SHR 2 + (153*LongWord(Month)+2) DIV 5 + LongWord(Day);
  2826. // Note that this line can't be part of the line above, since TDateTime is
  2827. // signed and c and ya are not
  2828. Date := Date - 693900;
  2829. end
  2830. end;
  2831. function TryEncodeTime(Hour, Min, Sec, MSec: Word; out Time: TDateTime
  2832. ): Boolean;
  2833. begin
  2834. Result:=(Hour<24) and (Min<60) and (Sec<60) and (MSec<1000);
  2835. If Result then
  2836. Time:=TDateTime(LongWord(Hour)*3600000+LongWord(Min)*60000+LongWord(Sec)*1000+MSec)/MSecsPerDay;
  2837. end;
  2838. { EncodeDate packs three variables Year, Month and Day into a
  2839. TDateTime value the result is the number of days since 12/30/1899 }
  2840. function EncodeDate(Year, Month, Day: word): TDateTime;
  2841. begin
  2842. If Not TryEncodeDate(Year,Month,Day,Result) then
  2843. Raise EConvertError.CreateFmt('%s-%s-%s is not a valid date specification',
  2844. [IntToStr(Year),IntToStr(Month),IntToStr(Day)]);
  2845. end;
  2846. { EncodeTime packs four variables Hour, Minute, Second and MilliSecond into
  2847. a TDateTime value }
  2848. function EncodeTime(Hour, Minute, Second, MilliSecond:word):TDateTime;
  2849. begin
  2850. If not TryEncodeTime(Hour,Minute,Second,MilliSecond,Result) then
  2851. Raise EConvertError.CreateFmt('%s:%s:%s.%s is not a valid time specification',
  2852. [IntToStr(Hour),IntToStr(Minute),IntToStr(Second),IntToStr(MilliSecond)]);
  2853. end;
  2854. { DecodeDate unpacks the value Date into three values:
  2855. Year, Month and Day }
  2856. procedure DecodeDate(Date: TDateTime; out Year, Month, Day: word);
  2857. var
  2858. ly,ld,lm,j : LongWord;
  2859. begin
  2860. if Date <= -datedelta then // If Date is before 1-1-1 then return 0-0-0
  2861. begin
  2862. Year := 0;
  2863. Month := 0;
  2864. Day := 0;
  2865. end
  2866. else
  2867. begin
  2868. if Date>0 then
  2869. Date:=(Date+(1/(msecsperday*2)))
  2870. else
  2871. Date:=Date-(1/(msecsperday*2));
  2872. if Date>MaxDateTime then
  2873. Date:=MaxDateTime;
  2874. // Raise EConvertError.CreateFmt('%f is not a valid TDatetime encoding, maximum value is %f.',[Date,MaxDateTime]);
  2875. j := ((Trunc(Date) + 693900) SHL 2)-1;
  2876. ly:= j DIV 146097;
  2877. j:= j - 146097 * LongWord(ly);
  2878. ld := j SHR 2;
  2879. j:=(ld SHL 2 + 3) DIV 1461;
  2880. ld:= ((ld SHL 2) + 7 - 1461*j) SHR 2;
  2881. lm:=(5 * ld-3) DIV 153;
  2882. ld:= (5 * ld +2 - 153*lm) DIV 5;
  2883. ly:= 100 * LongWord(ly) + j;
  2884. if lm < 10 then
  2885. inc(lm,3)
  2886. else
  2887. begin
  2888. dec(lm,9);
  2889. inc(ly);
  2890. end;
  2891. year:=ly;
  2892. month:=lm;
  2893. day:=ld;
  2894. end;
  2895. end;
  2896. function DecodeDateFully(const DateTime: TDateTime; out Year, Month, Day, DOW: Word): Boolean;
  2897. begin
  2898. DecodeDate(DateTime,Year,Month,Day);
  2899. DOW:=DayOfWeek(DateTime);
  2900. Result:=IsLeapYear(Year);
  2901. end;
  2902. { DateTimeToTimeStamp converts DateTime to a TTimeStamp }
  2903. function DateTimeToTimeStamp(DateTime: TDateTime): TTimeStamp;
  2904. Var
  2905. D : Double;
  2906. begin
  2907. D:=DateTime * Double(MSecsPerDay);
  2908. if D<0 then
  2909. D:=D-0.5
  2910. else
  2911. D:=D+0.5;
  2912. result.Time := Trunc(Abs(Trunc(D)) Mod MSecsPerDay);
  2913. result.Date := DateDelta + (Trunc(D) div MSecsPerDay);
  2914. end;
  2915. { TimeStampToDateTime converts TimeStamp to a TDateTime value }
  2916. function TimeStampToDateTime(const TimeStamp: TTimeStamp): TDateTime;
  2917. begin
  2918. Result := ComposeDateTime(TimeStamp.Date - DateDelta,TimeStamp.Time/MSecsPerDay)
  2919. end;
  2920. { MSecsToTimeStamp }
  2921. function MSecsToTimeStamp(MSecs: NativeInt): TTimeStamp;
  2922. begin
  2923. result.Date := Trunc(msecs/msecsperday);
  2924. msecs:= msecs-NativeInt(result.date)*msecsperday;
  2925. result.Time := Round(MSecs);
  2926. end;
  2927. function TimeStampToMSecs(const TimeStamp: TTimeStamp): NativeInt;
  2928. begin
  2929. result := TimeStamp.Time + (timestamp.date*msecsperday);
  2930. end ;
  2931. { DecodeTime unpacks Time into four values:
  2932. Hour, Minute, Second and MilliSecond }
  2933. procedure DecodeTime(Time: TDateTime; out Hour, Minute, Second, MilliSecond: word);
  2934. Var
  2935. l : LongWord;
  2936. begin
  2937. l := DateTimeToTimeStamp(Time).Time;
  2938. Hour := l div 3600000;
  2939. l := l mod 3600000;
  2940. Minute := l div 60000;
  2941. l := l mod 60000;
  2942. Second := l div 1000;
  2943. l := l mod 1000;
  2944. MilliSecond := l;
  2945. end;
  2946. { DateTimeToSystemTime converts DateTime value to SystemTime }
  2947. procedure DateTimeToSystemTime(DateTime: TDateTime; out SystemTime: TSystemTime);
  2948. begin
  2949. DecodeDateFully(DateTime, SystemTime.Year, SystemTime.Month, SystemTime.Day,SystemTime.DayOfWeek);
  2950. DecodeTime(DateTime, SystemTime.Hour, SystemTime.Minute, SystemTime.Second, SystemTime.MilliSecond);
  2951. Dec(SystemTime.DayOfWeek);
  2952. end ;
  2953. { SystemTimeToDateTime converts SystemTime to a TDateTime value }
  2954. function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime;
  2955. begin
  2956. result := ComposeDateTime(DoEncodeDate(SystemTime.Year, SystemTime.Month, SystemTime.Day),
  2957. DoEncodeTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second, SystemTime.MilliSecond));
  2958. end ;
  2959. function DayOfWeek(DateTime: TDateTime): integer;
  2960. begin
  2961. Result:= 1+((Trunc(DateTime) - 1) mod 7);
  2962. If (Result<=0) then
  2963. Inc(Result,7);
  2964. end;
  2965. function Now: TDateTime;
  2966. begin
  2967. Result:=JSDateToDateTime(TJSDate.New());
  2968. end;
  2969. function Date: TDateTime;
  2970. begin
  2971. Result:=Trunc(Now);
  2972. end;
  2973. function Time: TDateTime;
  2974. begin
  2975. Result:=Now-Date;
  2976. end ;
  2977. { IncMonth increments DateTime with NumberOfMonths months,
  2978. NumberOfMonths can be less than zero }
  2979. function IncMonth(const DateTime: TDateTime; NumberOfMonths: integer = 1 ): TDateTime;
  2980. var
  2981. Year, Month, Day : word;
  2982. begin
  2983. DecodeDate(DateTime, Year, Month, Day);
  2984. IncAMonth(Year, Month, Day, NumberOfMonths);
  2985. result := ComposeDateTime(DoEncodeDate(Year, Month, Day), DateTime);
  2986. end ;
  2987. { IncAMonth is the same as IncMonth, but operates on decoded date }
  2988. procedure IncAMonth(var Year, Month, Day: Word; NumberOfMonths: Integer = 1);
  2989. var
  2990. TempMonth, S: Integer;
  2991. begin
  2992. If NumberOfMonths>=0 then
  2993. s:=1
  2994. else
  2995. s:=-1;
  2996. inc(Year,(NumberOfMonths div 12));
  2997. TempMonth:=Month+(NumberOfMonths mod 12)-1;
  2998. if (TempMonth>11) or
  2999. (TempMonth<0) then
  3000. begin
  3001. Dec(TempMonth, S*12);
  3002. Inc(Year, S);
  3003. end;
  3004. Month:=TempMonth+1; { Months from 1 to 12 }
  3005. If (Day>MonthDays[IsLeapYear(Year)][Month]) then
  3006. Day:=MonthDays[IsLeapYear(Year)][Month];
  3007. end;
  3008. { IsLeapYear returns true if Year is a leap year }
  3009. function IsLeapYear(Year: Word): boolean;
  3010. begin
  3011. Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));
  3012. end;
  3013. { DateToStr returns a string representation of Date using ShortDateFormat }
  3014. function DateToStr(Date: TDateTime): string;
  3015. begin
  3016. Result:=DateToStr(Date,FormatSettings);
  3017. end;
  3018. function DateToStr(Date: TDateTime; const aSettings : TFormatSettings): string;
  3019. begin
  3020. Result:=FormatDateTime('ddddd', Date, aSettings);
  3021. end ;
  3022. { TimeToStr returns a string representation of Time using LongTimeFormat }
  3023. function TimeToStr(Time: TDateTime): string;
  3024. begin
  3025. Result:=TimeToStr(Time,FormatSettings);
  3026. end;
  3027. function TimeToStr(Time: TDateTime; const aSettings : TFormatSettings): string;
  3028. begin
  3029. Result:=FormatDateTime('tt',Time,aSettings);
  3030. end ;
  3031. { DateTimeToStr returns a string representation of DateTime using LongDateTimeFormat }
  3032. Var
  3033. DateTimeToStrFormat : Array[Boolean] of string = ('c','f');
  3034. function DateTimeToStr(DateTime: TDateTime; ForceTimeIfZero : Boolean = False): string;
  3035. begin
  3036. Result:=DateTimeToStr(DateTime,FormatSettings,ForceTimeIfZero);
  3037. end;
  3038. function DateTimeToStr(DateTime: TDateTime; Const aSettings : TFormatSettings; ForceTimeIfZero : Boolean = False): string;
  3039. begin
  3040. Result:=FormatDateTime(DateTimeToStrFormat[ForceTimeIfZero], DateTime,aSettings)
  3041. end ;
  3042. { StrToDate converts the string S to a TDateTime value
  3043. if S does not represent a valid date value
  3044. an EConvertError will be raised }
  3045. function IntStrToDate(Out ErrorMsg : String; const S: String; const useformat : string; separator : char): TDateTime;
  3046. Const
  3047. WhiteSpace = ' '#8#9#10#12#13;
  3048. Digits = '0123456789';
  3049. procedure FixErrorMsg(const errmarg : String);
  3050. begin
  3051. ErrorMsg:=Format(SInvalidDateFormat,[errmarg]);
  3052. end;
  3053. var
  3054. df:string;
  3055. d,m,y,ly,ld,lm:word;
  3056. n,i,len:longint;
  3057. c: integer;
  3058. dp,mp,yp,which : Byte;
  3059. s1:string;
  3060. values: array of integer;
  3061. YearMoreThenTwoDigits : boolean;
  3062. begin
  3063. SetLength(values,4);
  3064. Result:=0;
  3065. Len:=Length(S);
  3066. ErrorMsg:='';
  3067. While (Len>0) and (Pos(S[Len],WhiteSpace)>0) do
  3068. Dec(len);
  3069. if (Len=0) then
  3070. begin
  3071. FixErrorMsg(S);
  3072. exit;
  3073. end;
  3074. YearMoreThenTwoDigits := False;
  3075. if separator = #0 then
  3076. if (FormatSettings.DateSeparator<>#0) then
  3077. separator := FormatSettings.DateSeparator
  3078. else
  3079. separator:='-';
  3080. // Writeln('Separator: ',Separator);
  3081. df := UpperCase(useFormat);
  3082. { Determine order of D,M,Y }
  3083. yp:=0;
  3084. mp:=0;
  3085. dp:=0;
  3086. Which:=0;
  3087. i:=0;
  3088. while (i<Length(df)) and (Which<3) do
  3089. begin
  3090. inc(i);
  3091. Case df[i] of
  3092. 'Y' :
  3093. if yp=0 then
  3094. begin
  3095. Inc(Which);
  3096. yp:=which;
  3097. end;
  3098. 'M' :
  3099. if mp=0 then
  3100. begin
  3101. Inc(Which);
  3102. mp:=which;
  3103. end;
  3104. 'D' :
  3105. if dp=0 then
  3106. begin
  3107. Inc(Which);
  3108. dp:=which;
  3109. end;
  3110. end;
  3111. end;
  3112. // Writeln('YP: ',Yp,', MP: ',Mp,', DP: ',DP);
  3113. for i := 1 to 3 do
  3114. values[i] := 0;
  3115. s1 := '';
  3116. n := 0;
  3117. for i := 1 to len do
  3118. begin
  3119. if Pos(s[i],Digits)>0 then
  3120. s1 := s1 + s[i];
  3121. { space can be part of the shortdateformat, and is defaultly in slovak
  3122. windows, therefor it shouldn't be taken as separator (unless so specified)
  3123. and ignored }
  3124. if (Separator <> ' ') and (s[i] = ' ') then
  3125. Continue;
  3126. if (s[i] = separator) or ((i = len) and (Pos(s[i],Digits)>0)) then
  3127. begin
  3128. inc(n);
  3129. if n>3 then
  3130. begin
  3131. // Writeln('More than 3 separators');
  3132. FixErrorMsg(S);
  3133. exit;
  3134. end;
  3135. // Check if the year has more then two digits (if n=yp, then we are evaluating the year.)
  3136. if (n=yp) and (length(s1)>2) then YearMoreThenTwoDigits := True;
  3137. val(s1, values[n], c);
  3138. if c<>0 then
  3139. begin
  3140. // Writeln('S1 not a number ',S1);
  3141. FixErrorMsg(s);
  3142. Exit;
  3143. end;
  3144. s1 := '';
  3145. end
  3146. else if (Pos(s[i],Digits)=0) then
  3147. begin
  3148. // Writeln('Not a number at pos ',I,' ',S[i]);
  3149. FixErrorMsg(s);
  3150. Exit;
  3151. end;
  3152. end ;
  3153. // Writeln('Which : ',Which,' N : ',N);
  3154. if (Which<3) and (N>Which) then
  3155. begin
  3156. FixErrorMsg(s);
  3157. Exit;
  3158. end;
  3159. // Fill in values.
  3160. DecodeDate(Date,Ly,LM,LD);
  3161. If N=3 then
  3162. begin
  3163. y:=values[yp];
  3164. m:=values[mp];
  3165. d:=values[dp];
  3166. end
  3167. Else
  3168. begin
  3169. Y:=ly;
  3170. If n<2 then
  3171. begin
  3172. d:=values[1];
  3173. m := LM;
  3174. end
  3175. else
  3176. If dp<mp then
  3177. begin
  3178. d:=values[1];
  3179. m:=values[2];
  3180. end
  3181. else
  3182. begin
  3183. d:=values[2];
  3184. m:=values[1];
  3185. end;
  3186. end;
  3187. if (y >= 0) and (y < 100) and not YearMoreThenTwoDigits then
  3188. begin
  3189. ly := ly - TwoDigitYearCenturyWindow;
  3190. Inc(Y, ly div 100 * 100);
  3191. if (TwoDigitYearCenturyWindow > 0) and (Y < ly) then
  3192. Inc(Y, 100);
  3193. end;
  3194. if not TryEncodeDate(y, m, d, result) then
  3195. errormsg:=SErrInvalidDate;
  3196. end;
  3197. function StrToDate(const S: String; const useformat : string; separator : char): TDateTime;
  3198. Var
  3199. MSg : String;
  3200. begin
  3201. Result:=IntStrToDate(Msg,S,useFormat,Separator);
  3202. If (Msg<>'') then
  3203. Raise EConvertError.Create(Msg);
  3204. end;
  3205. function StrToDate(const S: String; const aSettings : TFormatSettings): TDateTime;
  3206. begin
  3207. Result:=StrToDate(S,aSettings.ShortDateFormat,aSettings.DateSeparator);
  3208. end;
  3209. function StrToDate(const S: String): TDateTime;
  3210. begin
  3211. result:=StrToDate(S,FormatSettings);
  3212. end;
  3213. function StrToDate(const S: String; separator : char): TDateTime;
  3214. begin
  3215. result := StrToDate(S,FormatSettings.ShortDateFormat,separator)
  3216. end;
  3217. { StrToTime converts the string S to a TDateTime value
  3218. if S does not represent a valid time value an
  3219. EConvertError will be raised }
  3220. function IntStrToTime(Out ErrorMsg : String; const S: String; Len : integer; Const aSettings : TFormatSettings): TDateTime;
  3221. const
  3222. AMPM_None = 0;
  3223. AMPM_AM = 1;
  3224. AMPM_PM = 2;
  3225. tiHour = 0;
  3226. tiMin = 1;
  3227. tiSec = 2;
  3228. tiMSec = 3;
  3229. type
  3230. TTimeValues = array of Word;
  3231. var
  3232. AmPm: integer;
  3233. TimeValues: TTimeValues;
  3234. function SplitElements(out TimeValues: TTimeValues; out AmPm: Integer): Boolean;
  3235. //Strict version. It does not allow #32 as Separator, it will treat it as whitespace always
  3236. const
  3237. Digits = '0123456789';
  3238. var
  3239. Cur, Offset, ElemLen, Err, TimeIndex, FirstSignificantDigit: Integer;
  3240. Value: Integer;
  3241. DigitPending, MSecPending: Boolean;
  3242. AmPmStr: String;
  3243. CurChar: Char;
  3244. I : Integer;
  3245. allowedchars : string;
  3246. begin
  3247. Result := False;
  3248. AmPm := AMPM_None; //No Am or PM in string found yet
  3249. MSecPending := False;
  3250. TimeIndex := 0; //indicating which TTimeValue must be filled next
  3251. For I:=tiHour to tiMSec do
  3252. TimeValues[i]:=0;
  3253. Cur := 1;
  3254. //skip leading blanks
  3255. While (Cur < Len) and (S[Cur] =#32) do Inc(Cur);
  3256. Offset := Cur;
  3257. //First non-blank cannot be Separator or DecimalSeparator
  3258. if (Cur > Len - 1) or (S[Cur] = aSettings.TimeSeparator) or (S[Cur] = aSettings.Decimalseparator) then
  3259. begin
  3260. // Writeln('Error in sep S[Cur]',S[Cur],' ',separator,' ',GetDecimalSeparator);
  3261. Exit;
  3262. end;
  3263. DigitPending := (Pos(S[Cur],Digits)>0);
  3264. While (Cur <= Len) do
  3265. begin
  3266. //writeln;
  3267. // writeln('Main While loop: Cur = ',Cur,' S[Cur] = "',S[Cur],'" Len = ',Len,' separator : ',Separator);
  3268. CurChar := S[Cur];
  3269. if Pos(CurChar,Digits)>0 then
  3270. begin//Digits
  3271. //HH, MM, SS, or Msec?
  3272. // writeln('Digit: ', CurChar);
  3273. //Digits are only allowed after starting Am/PM or at beginning of string or after Separator
  3274. //and TimeIndex must be <= tiMSec
  3275. //Uncomment "or (#32 = Separator)" and it will allllow #32 as separator
  3276. if (not (DigitPending {or (#32 = Separator)})) or (TimeIndex > tiMSec) then
  3277. begin
  3278. // Writeln('DigitPending',ElemLen);
  3279. Exit;
  3280. end;
  3281. OffSet := Cur;
  3282. if (CurChar <> '0') then FirstSignificantDigit := OffSet else FirstSignificantDigit := -1;
  3283. while (Cur < Len) and (Pos(S[Cur + 1],Digits)>0) do
  3284. begin
  3285. //Mark first Digit that is not '0'
  3286. if (FirstSignificantDigit = -1) and (S[Cur] <> '0') then FirstSignificantDigit := Cur;
  3287. Inc(Cur);
  3288. end;
  3289. if (FirstSignificantDigit = -1) then FirstSignificantDigit := Cur;
  3290. ElemLen := 1+ Cur - FirstSignificantDigit;
  3291. // writeln(' S[FirstSignificantDigit] = ',S[FirstSignificantDigit], ' S[Cur] = ',S[Cur],' ElemLen = ',ElemLen,' -> ', S[Offset], ElemLen);
  3292. // writeln(' Cur = ',Cur);
  3293. //this way we know that Val() will never overflow Value !
  3294. if (ElemLen <= 2) or ((ElemLen <= 3) and (TimeIndex = tiMSec) ) then
  3295. begin
  3296. Val(Copy(S,FirstSignificantDigit, ElemLen), Value, Err);
  3297. // writeln(' Value = ',Value,' HH = ',TimeValues[0],' MM = ',TimeValues[1],' SS = ',TimeValues[2],' MSec = ',Timevalues[3]);
  3298. //This is safe now, because we know Value < High(Word)
  3299. TimeValues[TimeIndex] := Value;
  3300. Inc(TimeIndex);
  3301. DigitPending := False;
  3302. end
  3303. else
  3304. begin
  3305. // Writeln('Wrong elemlen: ',ElemLen, ' timeIndex: ',timeindex);
  3306. Exit; //Value to big, so it must be a wrong timestring
  3307. end;
  3308. end//Digits
  3309. else if (CurChar = #32) then
  3310. begin
  3311. //writeln('#32');
  3312. //just skip, but we must adress this, or it will be parsed by either AM/PM or Separator
  3313. end
  3314. else if (CurChar = aSettings.TimeSeparator) then
  3315. begin
  3316. // writeln('Separator ',Separator);
  3317. if DigitPending or (TimeIndex > tiSec) then
  3318. begin
  3319. // Writeln ('DigitPending ',DigitPending,' or (TimeIndex',Timeindex,' > tiSec,', tiSec,')');
  3320. Exit;
  3321. end;
  3322. DigitPending := True;
  3323. MSecPending := False;
  3324. end
  3325. else if (CurChar = aSettings.DecimalSeparator) then
  3326. begin
  3327. //writeln('DecimalSeparator');
  3328. if DigitPending or MSecPending or (TimeIndex <> tiMSec) then
  3329. begin
  3330. // Writeln('DigitPending ',DigitPending,' or MSecPending ',MSecPending,' (',TimeIndex,',Timeindex, >', tiMSec,' tiSec)');
  3331. Exit;
  3332. end;
  3333. DigitPending := True;
  3334. MSecPending := True;
  3335. end
  3336. else
  3337. begin//AM/PM?
  3338. //None of the above, so this char _must_ be the start of AM/PM string
  3339. //If we already have found AM/PM or we expect a digit then then timestring must be wrong at this point
  3340. //writeln('AM/PM?');
  3341. if (AmPm <> AMPM_None) or DigitPending then
  3342. begin
  3343. // Writeln('AmPm <> AMPM_None) or DigitPending');
  3344. Exit;
  3345. end;
  3346. OffSet := Cur;
  3347. allowedchars:=aSettings.DecimalSeparator+' ';
  3348. if aSettings.TimeSeparator<>#0 then
  3349. allowedchars:=allowedchars+aSettings.TimeSeparator;
  3350. while (Cur < Len) and (Pos(S[Cur + 1],AllowedChars)=0)
  3351. and (Pos(S[Cur + 1],Digits)=0) do Inc(Cur);
  3352. ElemLen := 1 + Cur - OffSet;
  3353. // writeln(' S[Offset] = ',S[Offset], ' S[Cur] = ',S[Cur],' ElemLen = ',ElemLen,' -> ', S[1+Offset], ElemLen);
  3354. // writeln(' Cur = ',Cur, ', S =',S);
  3355. AmPmStr := Copy(S,OffSet, ElemLen);
  3356. // writeln('AmPmStr = ',ampmstr,' (',length(ampmstr),')');
  3357. //We must compare to TimeAMString before hardcoded 'AM' for delphi compatibility
  3358. //Also it is perfectly legal, though insane to have TimeAMString = 'PM' and vice versa
  3359. if (CompareText(AmPmStr, aSettings.TimeAMString) = 0) then AmPm := AMPM_AM
  3360. else if (CompareText(AmPmStr, aSettings.TimePMString) = 0) then AmPm := AMPM_PM
  3361. else if (CompareText(AmPmStr, 'AM') = 0) then AmPm := AMPM_AM
  3362. else if (CompareText(AmPmStr, 'PM') = 0) then AmPm := AMPM_PM
  3363. else
  3364. begin
  3365. // Writeln('No timestring ',AmPmStr);
  3366. Exit; //If text does not match any of these, timestring must be wrong;
  3367. end;
  3368. //if AM/PM is at beginning of string, then a digit is mandatory after it
  3369. if (TimeIndex = tiHour) then
  3370. begin
  3371. DigitPending := True;
  3372. end
  3373. //otherwise, no more TimeValues allowed after this
  3374. else
  3375. begin
  3376. TimeIndex := tiMSec + 1;
  3377. DigitPending := False;
  3378. end;
  3379. end;//AM/PM
  3380. Inc(Cur)
  3381. end;//while
  3382. //If we arrive here, parsing the elements has been successfull
  3383. //if not at least Hours specified then input is not valid
  3384. //when am/pm is specified Hour must be <= 12 and not 0
  3385. if (TimeIndex = tiHour) or ((AmPm <> AMPM_None) and ((TimeValues[tiHour] > 12) or (TimeValues[tiHour] = 0))) or DigitPending then
  3386. Exit;
  3387. Result := True;
  3388. end;
  3389. begin
  3390. setlength(timevalues,4);
  3391. AmPm := AMPM_None;
  3392. if not SplitElements(TimeValues, AmPm) then
  3393. begin
  3394. ErrorMsg:=Format(SErrInvalidTimeFormat,[S]);
  3395. Exit;
  3396. end;
  3397. if (AmPm=AMPM_PM) and (TimeValues[tiHour]<>12) then Inc(TimeValues[tiHour], 12)
  3398. else if (AmPm=AMPM_AM) and (TimeValues[tiHour]=12) then TimeValues[tiHour]:=0;
  3399. // Writeln( TimeValues[tiHour], TimeValues[tiMin], TimeValues[tiSec], TimeValues[tiMSec]);
  3400. if not TryEncodeTime(TimeValues[tiHour], TimeValues[tiMin], TimeValues[tiSec], TimeValues[tiMSec], result) Then
  3401. ErrorMsg:=Format(SErrInvalidTimeFormat,[S]);
  3402. end ;
  3403. function StrToTime(const S: String; const aSettings : TFormatSettings): TDateTime;
  3404. Var
  3405. Msg : String;
  3406. begin
  3407. Result:=IntStrToTime(Msg,S,Length(S),aSettings);
  3408. If (Msg<>'') then
  3409. Raise EConvertError.Create(Msg);
  3410. end;
  3411. function StrToTime(const S: String): TDateTime;
  3412. begin
  3413. result:=StrToTime(S, FormatSettings);
  3414. end;
  3415. function StrToTime(const S: String; separator: char): TDateTime;
  3416. Var
  3417. aSettings : TFormatSettings;
  3418. begin
  3419. aSettings:=TFormatSettings.Create;
  3420. aSettings.TimeSeparator:=Separator;
  3421. Result:=StrToTime(S,aSettings);
  3422. end;
  3423. { StrToDateTime converts the string S to a TDateTime value
  3424. if S does not represent a valid date and/or time value
  3425. an EConvertError will be raised }
  3426. function SplitDateTimeStr(DateTimeStr: String; out DateStr, TimeStr: String; Const aSettings : TFormatSettings): Integer;
  3427. { Helper function for StrToDateTime
  3428. Pre-condition
  3429. Date is before Time
  3430. If either Date or Time is omitted then see what fits best, a time or a date (issue #0020522)
  3431. Date and Time are separated by whitespace (space Tab, Linefeed or carriage return)
  3432. FS.DateSeparator can be the same as FS.TimeSeparator (issue #0020522)
  3433. If they are both #32 and TrimWhite(DateTimeStr) contains a #32 a date is assumed.
  3434. Post-condition
  3435. DateStr holds date as string or is empty
  3436. TimeStr holds time as string or is empty
  3437. Result = number of strings returned, 0 = error
  3438. }
  3439. const
  3440. WhiteSpace = #9#10#13#32;
  3441. var
  3442. p: Integer;
  3443. DummyDT: TDateTime;
  3444. begin
  3445. Result := 0;
  3446. DateStr := '';
  3447. TimeStr := '';
  3448. DateTimeStr := Trim(DateTimeStr);
  3449. if Length(DateTimeStr) = 0 then exit;
  3450. if (aSettings.DateSeparator = #32) and (aSettings.TimeSeparator = #32) and (Pos(#32, DateTimeStr) > 0) then
  3451. begin
  3452. DateStr:=DateTimeStr;
  3453. {
  3454. Assume a date: dd [mm [yy]].
  3455. Really fancy would be counting the number of whitespace occurrences and decide
  3456. and split accordingly
  3457. }
  3458. Exit(1);
  3459. end;
  3460. p:=1;
  3461. //find separator
  3462. if (aSettings.DateSeparator<>#32) then
  3463. begin
  3464. while (p<Length(DateTimeStr)) and (not (Pos(DateTimeStr[p+1],WhiteSpace)>0)) do
  3465. Inc(p);
  3466. end
  3467. else
  3468. begin
  3469. p:=Pos(aSettings.TimeSeparator, DateTimeStr);
  3470. if (p<>0) then
  3471. repeat
  3472. Dec(p);
  3473. until (p=0) or (Pos(DateTimeStr[p],WhiteSpace)>0);
  3474. end;
  3475. //Always fill DateStr, it eases the algorithm later
  3476. if (p=0) then
  3477. p:=Length(DateTimeStr);
  3478. DateStr:=Copy(DateTimeStr,1,p);
  3479. TimeStr:=Trim(Copy(DateTimeStr,p+1,100));
  3480. if (Length(TimeStr)<>0) then
  3481. Result:=2
  3482. else
  3483. begin
  3484. Result:=1; //found 1 string
  3485. // 2 cases when DateTimeStr only contains a time:
  3486. // Date/time separator differ, and string contains a timeseparator
  3487. // Date/time separators are equal, but transformation to date fails.
  3488. if ((aSettings.DateSeparator<>aSettings.TimeSeparator) and (Pos(aSettings.TimeSeparator,DateStr) > 0))
  3489. or ((aSettings.DateSeparator=aSettings.TimeSeparator) and (not TryStrToDate(DateStr, DummyDT))) then
  3490. begin
  3491. TimeStr := DateStr;
  3492. DateStr := '';
  3493. end;
  3494. end;
  3495. end;
  3496. function StrToDateTime(const S: String): TDateTime;
  3497. begin
  3498. Result:=StrToDateTime(S,FormatSettings);
  3499. end;
  3500. function StrToDateTime(const S: String; Const aSettings : TFormatSettings): TDateTime;
  3501. var
  3502. TimeStr, DateStr: String;
  3503. PartsFound: Integer;
  3504. begin
  3505. PartsFound := SplitDateTimeStr(S, DateStr, TimeStr,aSettings);
  3506. case PartsFound of
  3507. 0: Result:=StrToDate('');
  3508. 1: if (Length(DateStr) > 0) then
  3509. Result := StrToDate(DateStr,aSettings.ShortDateFormat,aSettings.DateSeparator)
  3510. else
  3511. Result := StrToTime(TimeStr);
  3512. 2: Result := ComposeDateTime(StrTodate(DateStr,aSettings.ShortDateFormat,aSettings.DateSeparator),
  3513. StrToTime(TimeStr));
  3514. end;
  3515. end;
  3516. function FormatDateTime(const FormatStr: string; const DateTime: TDateTime): string;
  3517. begin
  3518. Result:=FormatDateTime(FormatStr,DateTime,FormatSettings);
  3519. end;
  3520. function FormatDateTime(const FormatStr: string; const DateTime: TDateTime; const aSettings : TFormatSettings): string;
  3521. procedure StoreStr(APos,Len: Integer);
  3522. begin
  3523. // Writeln('StoreStr: ',Result,'+',Copy(FormatStr,APos,Len));
  3524. Result:=Result+Copy(FormatStr,APos,Len);
  3525. end;
  3526. procedure StoreString(const AStr: string);
  3527. begin
  3528. // Writeln('StoreString: ',Result,'+',AStr);
  3529. Result:=Result+AStr;
  3530. end;
  3531. procedure StoreInt(Value, Digits: Integer);
  3532. var
  3533. S: string;
  3534. begin
  3535. S:=IntToStr(Value);
  3536. While (Length(S)<Digits) do
  3537. S:='0'+S;
  3538. StoreString(S);
  3539. end;
  3540. var
  3541. Year, Month, Day, DayOfWeek, Hour, Minute, Second, MilliSecond: word;
  3542. procedure StoreFormat(const FormatStr: string; Nesting: Integer; TimeFlag: Boolean);
  3543. var
  3544. Token, lastformattoken, prevlasttoken: char;
  3545. Count: integer;
  3546. Clock12: boolean;
  3547. tmp: integer;
  3548. isInterval: Boolean;
  3549. P,FormatCurrent,FormatEnd : Integer;
  3550. begin
  3551. if Nesting > 1 then // 0 is original string, 1 is included FormatString
  3552. Exit;
  3553. FormatCurrent := 1;
  3554. FormatEnd := Length(FormatStr);
  3555. Clock12 := false;
  3556. isInterval := false;
  3557. // look for unquoted 12-hour clock token
  3558. P:=1;
  3559. while P<=FormatEnd do
  3560. begin
  3561. Token := FormatStr[P];
  3562. case Token of
  3563. '''', '"':
  3564. begin
  3565. Inc(P);
  3566. while (P < FormatEnd) and (FormatStr[P]<>Token) do
  3567. Inc(P);
  3568. end;
  3569. 'A', 'a':
  3570. begin
  3571. if (CompareText(Copy(FormatStr,P,3),'A/P')=0) or
  3572. (CompareText(Copy(FormatStr,P,4),'AMPM')=0) or
  3573. (CompareText(Copy(FormatStr,P,5),'AM/PM')=0) then
  3574. begin
  3575. Clock12 := true;
  3576. break;
  3577. end;
  3578. end;
  3579. end; // case
  3580. Inc(P);
  3581. end ;
  3582. token := #255;
  3583. lastformattoken := ' ';
  3584. prevlasttoken := 'H';
  3585. while FormatCurrent <= FormatEnd do
  3586. begin
  3587. Token := UpperCase(FormatStr[FormatCurrent])[1];
  3588. // Writeln('Treating token at pos ',FormatCurrent,', : ',Token,' (',FormatStr,')');
  3589. Count := 1;
  3590. P := FormatCurrent + 1;
  3591. case Token of
  3592. '''', '"':
  3593. begin
  3594. while (P < FormatEnd) and (FormatStr[P]<>Token) do
  3595. Inc(P);
  3596. Inc(P);
  3597. Count := P - FormatCurrent;
  3598. StoreStr(FormatCurrent + 1, Count - 2);
  3599. end ;
  3600. 'A':
  3601. begin
  3602. if CompareText(Copy(FormatStr,FormatCurrent,4), 'AMPM') = 0 then
  3603. begin
  3604. Count := 4;
  3605. if Hour < 12 then
  3606. StoreString(aSettings.TimeAMString)
  3607. else
  3608. StoreString(aSettings.TimePMString);
  3609. end
  3610. else if CompareText(Copy(FormatStr,FormatCurrent,5), 'AM/PM') = 0 then
  3611. begin
  3612. Count := 5;
  3613. if Hour < 12 then StoreStr(FormatCurrent, 2)
  3614. else StoreStr(FormatCurrent+3, 2);
  3615. end
  3616. else if CompareText(Copy(FormatStr,FormatCurrent,3), 'A/P') = 0 then
  3617. begin
  3618. Count := 3;
  3619. if Hour < 12 then StoreStr(FormatCurrent, 1)
  3620. else StoreStr(FormatCurrent+2, 1);
  3621. end
  3622. else
  3623. raise EConvertError.Create('Illegal character in format string');
  3624. end ;
  3625. '/':
  3626. begin
  3627. // Writeln('Detected date separator');
  3628. StoreString(aSettings.DateSeparator);
  3629. end;
  3630. ':': StoreString(aSettings.TimeSeparator);
  3631. ' ', 'C', 'D', 'H', 'M', 'N', 'S', 'T', 'Y', 'Z', 'F' :
  3632. begin
  3633. // Writeln(FormatCurrent,' Special Token: ',Token,', Count: ',Count,', P: ',P);
  3634. while (P <= FormatEnd) and (UpperCase(FormatStr[P]) = Token) do
  3635. Inc(P);
  3636. Count := P - FormatCurrent;
  3637. // Writeln(FormatCurrent,' Special Token: ',Token,', Count: ',Count,', P: ',P);
  3638. case Token of
  3639. ' ': StoreStr(FormatCurrent, Count);
  3640. 'Y': begin
  3641. if Count > 2 then
  3642. StoreInt(Year, 4)
  3643. else
  3644. StoreInt(Year mod 100, 2);
  3645. end;
  3646. 'M': begin
  3647. if isInterval and ((prevlasttoken = 'H') or TimeFlag) then
  3648. StoreInt(Minute + (Hour + trunc(abs(DateTime))*24)*60, 0)
  3649. else
  3650. if (lastformattoken = 'H') or TimeFlag then
  3651. begin
  3652. if Count = 1 then
  3653. StoreInt(Minute, 0)
  3654. else
  3655. StoreInt(Minute, 2);
  3656. end
  3657. else
  3658. begin
  3659. case Count of
  3660. 1: StoreInt(Month, 0);
  3661. 2: StoreInt(Month, 2);
  3662. 3: StoreString(aSettings.ShortMonthNames[Month]);
  3663. else
  3664. StoreString(aSettings.LongMonthNames[Month]);
  3665. end;
  3666. end;
  3667. end;
  3668. 'D': begin
  3669. case Count of
  3670. 1: StoreInt(Day, 0);
  3671. 2: StoreInt(Day, 2);
  3672. 3: StoreString(aSettings.ShortDayNames[DayOfWeek-1]);
  3673. 4: StoreString(aSettings.LongDayNames[DayOfWeek-1]);
  3674. 5: StoreFormat(aSettings.ShortDateFormat, Nesting+1, False);
  3675. else
  3676. StoreFormat(aSettings.LongDateFormat, Nesting+1, False);
  3677. end ;
  3678. end ;
  3679. 'H':
  3680. if isInterval then
  3681. StoreInt(Hour + trunc(abs(DateTime))*24, 0)
  3682. else
  3683. if Clock12 then
  3684. begin
  3685. tmp := hour mod 12;
  3686. if tmp=0 then tmp:=12;
  3687. if Count = 1 then
  3688. StoreInt(tmp, 0)
  3689. else
  3690. StoreInt(tmp, 2);
  3691. end
  3692. else begin
  3693. if Count = 1 then
  3694. StoreInt(Hour, 0)
  3695. else
  3696. StoreInt(Hour, 2);
  3697. end;
  3698. 'N': if isInterval then
  3699. StoreInt(Minute + (Hour + trunc(abs(DateTime))*24)*60, 0)
  3700. else
  3701. if Count = 1 then
  3702. StoreInt(Minute, 0)
  3703. else
  3704. StoreInt(Minute, 2);
  3705. 'S': if isInterval then
  3706. StoreInt(Second + (Minute + (Hour + trunc(abs(DateTime))*24)*60)*60, 0)
  3707. else
  3708. if Count = 1 then
  3709. StoreInt(Second, 0)
  3710. else
  3711. StoreInt(Second, 2);
  3712. 'Z': if Count = 1 then
  3713. StoreInt(MilliSecond, 0)
  3714. else
  3715. StoreInt(MilliSecond, 3);
  3716. 'T': if Count = 1 then
  3717. StoreFormat(aSettings.ShortTimeFormat, Nesting+1, True)
  3718. else
  3719. StoreFormat(aSettings.LongTimeFormat, Nesting+1, True);
  3720. 'C': begin
  3721. StoreFormat(aSettings.ShortDateFormat, Nesting+1, False);
  3722. if (Hour<>0) or (Minute<>0) or (Second<>0) then
  3723. begin
  3724. StoreString(' ');
  3725. StoreFormat(aSettings.LongTimeFormat, Nesting+1, True);
  3726. end;
  3727. end;
  3728. 'F': begin
  3729. StoreFormat(aSettings.ShortDateFormat, Nesting+1, False);
  3730. StoreString(' ');
  3731. StoreFormat(aSettings.LongTimeFormat, Nesting+1, True);
  3732. end;
  3733. end;
  3734. prevlasttoken := lastformattoken;
  3735. lastformattoken := token;
  3736. end;
  3737. else
  3738. StoreString(Token);
  3739. end ;
  3740. Inc(FormatCurrent, Count);
  3741. end;
  3742. end;
  3743. begin
  3744. DecodeDateFully(DateTime, Year, Month, Day, DayOfWeek);
  3745. DecodeTime(DateTime, Hour, Minute, Second, MilliSecond);
  3746. // Writeln(DateTime,'->',Year,',', Month, ',',Day, ',',DayOfWeek,',',Hour, ',',Minute, ',',Second, ',',MilliSecond);
  3747. if FormatStr <> '' then
  3748. StoreFormat(FormatStr, 0, False)
  3749. else
  3750. StoreFormat('C', 0, False);
  3751. end ;
  3752. function CurrentYear: Word;
  3753. begin
  3754. Result:=TJSDate.New().FullYear;
  3755. end;
  3756. function TryStrToDate(const S: String; out Value: TDateTime): Boolean;
  3757. begin
  3758. Result:=TryStrToDate(S,Value,FormatSettings);
  3759. end;
  3760. function TryStrToDate(const S: String; out Value: TDateTime; separator : char): Boolean;
  3761. begin
  3762. Result:=TryStrToDate(S,Value,FormatSettings.ShortDateFormat,Separator);
  3763. end;
  3764. function TryStrToDate(const S: String; out Value: TDateTime; const useformat : string; separator : char): Boolean;
  3765. Var
  3766. Msg : String;
  3767. begin
  3768. Result:=Length(S)<>0;
  3769. If Result then
  3770. begin
  3771. Value:=IntStrToDate(Msg,S,useformat,Separator);
  3772. Result:=(Msg='');
  3773. end;
  3774. end;
  3775. function TryStrToDate(const S: String; out Value: TDateTime; const aSettings : TFormatSettings): Boolean;
  3776. begin
  3777. Result:=TryStrToDate(S,Value,aSettings.ShortDateFormat,aSettings.DateSeparator);
  3778. end;
  3779. function TryStrToTime(const S: String; out Value: TDateTime; aSettings : TFormatSettings): Boolean;
  3780. Var
  3781. Msg : String;
  3782. begin
  3783. Result:=Length(S)<>0;
  3784. If Result then
  3785. begin
  3786. Value:=IntStrToTime(Msg,S,Length(S),aSettings);
  3787. Result:=(Msg='');
  3788. end;
  3789. end;
  3790. function TryStrToTime(const S: String; out Value: TDateTime; separator : char): Boolean;
  3791. Var
  3792. Fmt : TFormatSettings;
  3793. begin
  3794. fmt:=TFormatSettings.Create;
  3795. fmt.TimeSeparator:=Separator;
  3796. Result:=TryStrToTime(S,Value,Fmt);
  3797. end;
  3798. function TryStrToTime(const S: String; out Value: TDateTime): Boolean;
  3799. begin
  3800. result:=TryStrToTime(S,Value,FormatSettings);
  3801. end;
  3802. function TryStrToDateTime(const S: String; out Value: TDateTime): Boolean;
  3803. begin
  3804. Result:=TryStrToDateTime(S,Value,FormatSettings);
  3805. end;
  3806. function TryStrToDateTime(const S: String; out Value: TDateTime; Const aSettings : TFormatSettings): Boolean;
  3807. var
  3808. I: integer;
  3809. dtdate, dttime :TDateTime;
  3810. begin
  3811. result:=false;
  3812. I:=Pos(aSettings.TimeSeparator,S);
  3813. If (I>0) then
  3814. begin
  3815. While (I>0) and (S[I]<>' ') do
  3816. Dec(I);
  3817. If I>0 then
  3818. begin
  3819. if not TryStrToDate(Copy(S,1,I-1),dtdate) then
  3820. exit;
  3821. if not TryStrToTime(Copy(S,i+1, Length(S)-i),dttime) then
  3822. exit;
  3823. Value:=ComposeDateTime(dtdate,dttime);
  3824. result:=true;
  3825. end
  3826. else
  3827. result:=TryStrToTime(s,Value);
  3828. end
  3829. else
  3830. result:=TryStrToDate(s,Value);
  3831. end;
  3832. function StrToDateDef(const S: String; const Defvalue : TDateTime): TDateTime;
  3833. begin
  3834. result := StrToDateDef(S,DefValue,#0);
  3835. end;
  3836. function StrToTimeDef(const S: String; const Defvalue : TDateTime): TDateTime;
  3837. begin
  3838. result := StrToTimeDef(S,DefValue,#0);
  3839. end;
  3840. function StrToDateTimeDef(const S: String; const Defvalue : TDateTime; aSettings : TFormatSettings): TDateTime; overload;
  3841. begin
  3842. if not TryStrToDateTime(s,Result,aSettings) Then
  3843. result:=defvalue;
  3844. end;
  3845. function StrToDateTimeDef(const S: String; const Defvalue : TDateTime): TDateTime;
  3846. begin
  3847. Result:=StrToDateTimeDef(s,DefValue,FormatSettings);
  3848. end;
  3849. function StrToDateDef(const S: String; const Defvalue : TDateTime; separator : char): TDateTime;
  3850. begin
  3851. if not TryStrToDate(s,Result, separator) Then
  3852. result:=defvalue;
  3853. end;
  3854. function StrToTimeDef(const S: String; const Defvalue : TDateTime; separator : char): TDateTime;
  3855. begin
  3856. if not TryStrToTime(s,Result, separator) Then
  3857. result:=defvalue;
  3858. end;
  3859. function StrToTimeDef(const AString: string; const ADefault: TDateTime;
  3860. const aSettings: TFormatSettings): TDateTime;
  3861. begin
  3862. if not TryStrToTime(AString, Result, aSettings) Then
  3863. Result := ADefault;
  3864. end;
  3865. procedure ReplaceTime(var dati:TDateTime; NewTime : TDateTime);
  3866. begin
  3867. dati:= ComposeDateTime(dati, newtime);
  3868. end;
  3869. procedure ReplaceDate(var DateTime: TDateTime; const NewDate: TDateTime);
  3870. var
  3871. tmp : TDateTime;
  3872. begin
  3873. tmp:=NewDate;
  3874. ReplaceTime(tmp,DateTime);
  3875. DateTime:=tmp;
  3876. end;
  3877. function FloatToDateTime(const Value: Extended): TDateTime;
  3878. begin
  3879. If (Value<MinDateTime) or (Value>MaxDateTime) then
  3880. Raise EConvertError.CreateFmt (SInvalidDateTime,[FloatToStr(Value)]);
  3881. Result:=Value;
  3882. end;
  3883. function FloattoCurr(const Value: Extended): Currency;
  3884. begin
  3885. if not TryFloatToCurr(Value, Result) then
  3886. Raise EConvertError.CreateFmt(SInvalidCurrency, [FloatToStr(Value)]);
  3887. end;
  3888. function TryFloatToCurr(const Value: Extended; var AResult: Currency): Boolean;
  3889. begin
  3890. Result:=(Value>=MinCurrency) and (Value<=MaxCurrency);
  3891. if Result then
  3892. AResult := Value;
  3893. end;
  3894. function CurrToStr(Value: Currency): string;
  3895. begin
  3896. Result:=FloatToStrF(Value,ffGeneral,-1,0,FormatSettings);
  3897. end;
  3898. function CurrToStr(Value: Currency; const aSettings: TFormatSettings): string;
  3899. begin
  3900. Result:=FloatToStrF(Value,ffGeneral,-1,0,aSettings);
  3901. end;
  3902. function StrToCurr(const S: string): Currency;
  3903. begin
  3904. if not TryStrToCurr(S,Result) then
  3905. Raise EConvertError.createfmt(SInvalidCurrency,[S]);
  3906. end;
  3907. function StrToCurr(const S: string; const aSettings: TFormatSettings): Currency;
  3908. begin
  3909. if not TryStrToCurr(S,Result,aSettings) then
  3910. Raise EConvertError.createfmt(SInvalidCurrency,[S]);
  3911. end;
  3912. function TryStrToCurr(const S: string; out Value: Currency): Boolean;
  3913. Var
  3914. D : Double;
  3915. begin
  3916. Result:=TryStrToFloat(S,D,FormatSettings);
  3917. if Result then
  3918. Value:=D;
  3919. end;
  3920. function TryStrToCurr(const S: string; out Value: Currency; const aSettings: TFormatSettings): Boolean;
  3921. Var
  3922. D : Double;
  3923. begin
  3924. Result:=TryStrToFloat(S,D,aSettings);
  3925. if Result then
  3926. Value:=D;
  3927. end;
  3928. function StrToCurrDef(const S: string; Default: Currency): Currency;
  3929. Var
  3930. R : Currency;
  3931. begin
  3932. if TryStrToCurr(S,R,FormatSettings) then
  3933. Result:=R
  3934. else
  3935. Result:=Default;
  3936. end;
  3937. function StrToCurrDef(const S: string; Default: Currency; const aSettings: TFormatSettings): Currency;
  3938. Var
  3939. R : Currency;
  3940. begin
  3941. if TryStrToCurr(S,R,aSettings) then
  3942. Result:=R
  3943. else
  3944. Result:=Default;
  3945. end;
  3946. { ---------------------------------------------------------------------
  3947. Interface related
  3948. ---------------------------------------------------------------------}
  3949. function Supports(const Instance: IInterface; const AClass: TClass; out Obj
  3950. ): Boolean;
  3951. begin
  3952. Result := (Instance<>nil) and (Instance.QueryInterface(IObjectInstance,Obj)=S_OK)
  3953. and (TObject(Obj).InheritsFrom(AClass));
  3954. end;
  3955. function Supports(const Instance: IInterface; const IID: TGuid; out Intf
  3956. ): Boolean;
  3957. begin
  3958. Result:=(Instance<>nil) and (Instance.QueryInterface(IID,Intf)=S_OK);
  3959. end;
  3960. function Supports(const Instance: TObject; const IID: TGuid; out Intf): Boolean;
  3961. begin
  3962. Result:=(Instance<>nil) and Instance.GetInterface(IID,Intf);
  3963. end;
  3964. function Supports(const Instance: TObject; const IID: TGuidString; out Intf
  3965. ): Boolean;
  3966. begin
  3967. Result:=(Instance<>nil) and Instance.GetInterfaceByStr(IID,Intf);
  3968. end;
  3969. function Supports(const Instance: IInterface; const AClass: TClass): Boolean;
  3970. var
  3971. Temp: TObject;
  3972. begin
  3973. Result:=Supports(Instance,AClass,Temp);
  3974. end;
  3975. function Supports(const Instance: IInterface; const IID: TGuid): Boolean;
  3976. var
  3977. Temp: IInterface;
  3978. begin
  3979. Result:=Supports(Instance,IID,Temp);
  3980. end;
  3981. function Supports(const Instance: TObject; const IID: TGuid): Boolean;
  3982. var
  3983. Temp: TJSObject;
  3984. begin
  3985. Result:=Supports(Instance,IID,Temp);
  3986. asm
  3987. if (Temp && Temp.$kind==='com') Temp._Release();
  3988. end;
  3989. end;
  3990. function Supports(const Instance: TObject; const IID: TGuidString): Boolean;
  3991. var
  3992. Temp: TJSObject;
  3993. begin
  3994. Result:=Supports(Instance,IID,Temp);
  3995. asm
  3996. if (Temp && Temp.$kind==='com') Temp._Release();
  3997. end;
  3998. end;
  3999. function Supports(const AClass: TClass; const IID: TGuid): Boolean;
  4000. var
  4001. maps: JSValue;
  4002. begin
  4003. if AClass=nil then exit(false);
  4004. maps := TJSObject(AClass)['$intfmaps'];
  4005. if not maps then exit(false);
  4006. if TJSObject(maps)[GUIDToString(IID)] then exit(true);
  4007. Result:=false;
  4008. end;
  4009. function Supports(const AClass: TClass; const IID: TGuidString): Boolean;
  4010. var
  4011. maps: JSValue;
  4012. begin
  4013. if AClass=nil then exit(false);
  4014. maps := TJSObject(AClass)['$intfmaps'];
  4015. if not maps then exit(false);
  4016. if TJSObject(maps)[uppercase(IID)] then exit(true);
  4017. Result:=false;
  4018. end;
  4019. function TryStringToGUID(const s: string; out Guid: TGuid): Boolean;
  4020. var
  4021. re: TJSRegexp;
  4022. begin
  4023. if Length(s)<>38 then Exit(False);
  4024. re:=TJSRegexp.new('^\{[0-9a-fA-F]{8}-[0-9a-fA-F]{4}-[0-9a-fA-F]{4}-[0-9a-fA-F]{4}-[0-9a-fA-F]{12}\}$');
  4025. Result:=re.test(s);
  4026. if not Result then
  4027. begin
  4028. Guid.D1:=0;
  4029. exit;
  4030. end;
  4031. asm
  4032. rtl.strToGUIDR(s,Guid);
  4033. end;
  4034. Result:=true;
  4035. end;
  4036. function StringToGUID(const S: string): TGuid;
  4037. begin
  4038. if not TryStringToGUID(S, Result) then
  4039. raise EConvertError.CreateFmt(SInvalidGUID, [S]);
  4040. end;
  4041. function GUIDToString(const guid: TGuid): string;
  4042. begin
  4043. Result:=System.GUIDToString(guid);
  4044. end;
  4045. function IsEqualGUID(const guid1, guid2: TGuid): Boolean;
  4046. var
  4047. i: integer;
  4048. begin
  4049. if (guid1.D1<>guid2.D1) or (guid1.D2<>guid2.D2) or (guid1.D3<>guid2.D3) then
  4050. exit(false);
  4051. for i:=0 to 7 do if guid1.D4[i]<>guid2.D4[i] then exit(false);
  4052. Result:=true;
  4053. end;
  4054. function GuidCase(const guid: TGuid; const List: array of TGuid): Integer;
  4055. begin
  4056. for Result := High(List) downto 0 do
  4057. if IsEqualGUID(guid, List[Result]) then
  4058. Exit;
  4059. Result := -1;
  4060. end;
  4061. function CreateGUID(out GUID: TGUID): Integer;
  4062. Function R(B: Integer) : NativeInt;
  4063. Var
  4064. v : NativeInt;
  4065. begin
  4066. v:=Random(256);
  4067. While B>1 do
  4068. begin
  4069. v:=v*256+Random(256);
  4070. Dec(B);
  4071. end;
  4072. Result:=V;
  4073. end;
  4074. Var
  4075. I : Integer;
  4076. begin
  4077. Result:=0;
  4078. GUID.D1:= R(4);
  4079. GUID.D2:= R(2);
  4080. GUID.D3:= R(2);
  4081. For I:=0 to 7 do
  4082. GUID.D4[I]:=R(1);
  4083. end;
  4084. { ---------------------------------------------------------------------
  4085. Integer/Ordinal related
  4086. ---------------------------------------------------------------------}
  4087. function TryStrToInt(const S: String; out res: Integer): Boolean;
  4088. Var
  4089. NI : NativeInt;
  4090. begin
  4091. Result:=TryStrToInt(S,NI);
  4092. Result:=Result and (-2147483648<=NI) and (NI<=2147483647);
  4093. if Result then
  4094. res:=NI;
  4095. end;
  4096. function IntTryStrToInt(const S: String; out res: NativeInt; Const aSep : string): Boolean;
  4097. Var
  4098. Radix : Integer = 10;
  4099. N : String;
  4100. J : JSValue;
  4101. begin
  4102. N:=S;
  4103. // Javascript Parseint allows 1.0 or 1E0 to be an integer, so we must check for this to get the same behaviour as FPC/Delphi.
  4104. if (Pos(aSep,N)<>0) or (Pos('.',N)<>0) then
  4105. exit(False);
  4106. case Copy(N,1,1) of
  4107. '$': Radix:=16;
  4108. '&': Radix:=8;
  4109. '%': Radix:=2;
  4110. end;
  4111. // Check for E after we know radix
  4112. if (Radix<>16) and (Pos('e',LowerCase(N))<>0) then
  4113. exit(False);
  4114. If Radix<>10 then
  4115. Delete(N,1,1);
  4116. J:=parseInt(N,Radix);
  4117. Result:=Not jsIsNan(j);
  4118. if Result then
  4119. res:=NativeInt(J);
  4120. end;
  4121. function TryStrToInt(const S: String; out res: NativeInt): Boolean;
  4122. begin
  4123. Result:=IntTryStrToInt(S,res,FormatSettings.DecimalSeparator);
  4124. end;
  4125. function TryStrToInt(const S: String; out res: NativeInt; Const aSettings : TFormatSettings): Boolean;
  4126. begin
  4127. Result:=IntTryStrToInt(S,res,aSettings.DecimalSeparator);
  4128. end;
  4129. function StrToIntDef(const S: String; const aDef: Integer): Integer;
  4130. Var
  4131. R : NativeInt;
  4132. begin
  4133. if TryStrToInt(S,R) then
  4134. Result:=R
  4135. else
  4136. Result:=aDef;
  4137. end;
  4138. function StrToIntDef(const S: String; const aDef: NativeInt): NativeInt;
  4139. Var
  4140. R : NativeInt;
  4141. begin
  4142. if TryStrToInt(S,R) then
  4143. Result:=R
  4144. else
  4145. Result:=aDef;
  4146. end;
  4147. function StrToInt(const S: String): Integer;
  4148. Var
  4149. R : NativeInt;
  4150. begin
  4151. if not TryStrToInt(S,R) then
  4152. Raise EConvertError.CreateFmt(SErrInvalidInteger,[S]);
  4153. Result:=R;
  4154. end;
  4155. function StrToNativeInt(const S: String): NativeInt;
  4156. begin
  4157. if not TryStrToInt(S,Result) then
  4158. Raise EConvertError.CreateFmt(SErrInvalidInteger,[S]);
  4159. end;
  4160. function StrToUInt(const s: string): Cardinal;
  4161. begin
  4162. If not TryStrToUint(S,Result) then
  4163. Raise EConvertError.CreateFmt(SErrInvalidInteger,[S])
  4164. end;
  4165. function StrToUIntDef(const s: string; aDef : Cardinal): Cardinal;
  4166. begin
  4167. If not TryStrToUint(S,Result) then
  4168. Result:=aDef;
  4169. end;
  4170. function UIntToStr(Value: Cardinal): string;
  4171. begin
  4172. Result:=IntToStr(Value);
  4173. end;
  4174. function TryStrToUInt(const s: string; out C: Cardinal): Boolean;
  4175. Var
  4176. N : NativeInt;
  4177. begin
  4178. Result:=TryStrToInt(S,N);
  4179. Result:=(N>=0) and (N<=high(longword));
  4180. If Result then
  4181. C:=N;
  4182. end;
  4183. function StrToInt64(const S: String): NativeLargeInt;
  4184. Var
  4185. N : NativeInt;
  4186. begin
  4187. if not TryStrToInt(S,N) then
  4188. Raise EConvertError.CreateFmt(SErrInvalidInteger,[S]);
  4189. Result:=N;
  4190. end;
  4191. function TryStrToInt64(const S: String; out res: NativeLargeInt): Boolean;
  4192. Var
  4193. R : nativeint;
  4194. begin
  4195. Result:=TryStrToInt(S,R);
  4196. If Result then
  4197. Res:=R;
  4198. end;
  4199. function TryStrToInt64(const S: String; out res: Int64): Boolean;
  4200. begin
  4201. Result:=TryStrToInt64(S,NativeLargeInt(res));
  4202. end;
  4203. function StrToInt64Def(const S: String; ADefault: NativeLargeInt
  4204. ): NativeLargeInt;
  4205. begin
  4206. if not TryStrToInt64(S,Result) then
  4207. Result:=ADefault;
  4208. end;
  4209. function StrToQWord(const S: String): NativeLargeUInt;
  4210. Var
  4211. N : NativeInt;
  4212. begin
  4213. if (not TryStrToInt(S,N)) or (N<0) then
  4214. Raise EConvertError.CreateFmt(SErrInvalidInteger,[S]);
  4215. Result:=N;
  4216. end;
  4217. function TryStrToQWord(const S: String; out res: NativeLargeUInt): Boolean;
  4218. Var
  4219. R : nativeint;
  4220. begin
  4221. Result:=TryStrToInt(S,R) and (R>=0);
  4222. If Result then
  4223. Res:=R;
  4224. end;
  4225. function TryStrToQWord(const S: String; out res: QWord): Boolean;
  4226. begin
  4227. Result:=TryStrToQWord(S,NativeLargeUInt(res));
  4228. end;
  4229. function StrToQWordDef(const S: String; ADefault: NativeLargeUInt
  4230. ): NativeLargeUInt;
  4231. begin
  4232. if Not TryStrToQword(S,Result) then
  4233. Result:=ADefault;
  4234. end;
  4235. function StrToUInt64(const S: String): NativeLargeUInt;
  4236. Var
  4237. N : NativeInt;
  4238. begin
  4239. if (not TryStrToInt(S,N)) or (N<0) then
  4240. Raise EConvertError.CreateFmt(SErrInvalidInteger,[S]);
  4241. Result:=N;
  4242. end;
  4243. function TryStrToUInt64(const S: String; out res: NativeLargeUInt): Boolean;
  4244. Var
  4245. R : nativeint;
  4246. begin
  4247. Result:=TryStrToInt(S,R) and (R>=0);
  4248. If Result then
  4249. Res:=R;
  4250. end;
  4251. function TryStrToUInt64(const S: String; out res: UInt64): Boolean;
  4252. begin
  4253. Result:=TryStrToUInt64(S,NativeLargeUInt(res));
  4254. end;
  4255. function StrToUInt64Def(const S: String; ADefault: NativeLargeUInt
  4256. ): NativeLargeUInt;
  4257. begin
  4258. if Not TryStrToUInt64(S,Result) then
  4259. Result:=ADefault;
  4260. end;
  4261. function TryStrToDWord(const S: String; out res: DWord): Boolean;
  4262. Var
  4263. R : nativeint;
  4264. begin
  4265. Result:=TryStrToInt(S,R) and (R>=0) and (R<=DWord($FFFFFFFF));
  4266. If Result then
  4267. Res:=R;
  4268. end;
  4269. function StrToDWord(const S: String): DWord;
  4270. begin
  4271. if not TryStrToDWord(S,Result) then
  4272. Raise EConvertError.CreateFmt(SErrInvalidInteger,[S]);
  4273. end;
  4274. function StrToDWordDef(const S: String; ADefault: DWord): DWord;
  4275. begin
  4276. if Not TryStrToDWord(S,Result) then
  4277. Result:=ADefault;
  4278. end;
  4279. function IntToHex(Value: NativeInt; Digits: integer): string;
  4280. begin
  4281. // Result:=HexStr(Value,Digits); // TestNegLongintHelper Failed: "ToHexString" expected: <FFFE0000> but was: <00-20000> !
  4282. Result:='';
  4283. if Value<0 then
  4284. asm
  4285. if (Value<0) Value = 0xFFFFFFFF + Value + 1;
  4286. end;
  4287. asm
  4288. Result=Value.toString(16);
  4289. end;
  4290. Result:=UpperCase(Result);
  4291. while (Length(Result)<Digits) do
  4292. Result:='0'+Result;
  4293. end;
  4294. { TFormatSettings }
  4295. { TFormatSettings }
  4296. class function TFormatSettings.Create: TFormatSettings;
  4297. begin
  4298. Result := Create(GetJSLocale);
  4299. end;
  4300. class function TFormatSettings.Create(const ALocale: string): TFormatSettings;
  4301. begin
  4302. Result.LongDayNames:=DefaultLongDayNames;
  4303. Result.ShortDayNames:=DefaultShortDayNames;
  4304. Result.ShortMonthNames:=DefaultShortMonthNames;
  4305. Result.LongMonthNames:=DefaultLongMonthNames;
  4306. Result.DateTimeToStrFormat[False] := 'c';
  4307. Result.DateTimeToStrFormat[True] := 'f';
  4308. Result.DateSeparator := '-';
  4309. Result.TimeSeparator := ':';
  4310. Result.ShortDateFormat := 'yyyy-mm-dd';
  4311. Result.LongDateFormat := 'ddd, yyyy-mm-dd';
  4312. Result.ShortTimeFormat := 'hh:nn';
  4313. Result.LongTimeFormat := 'hh:nn:ss';
  4314. Result.DecimalSeparator := '.';
  4315. Result.ThousandSeparator := ',';
  4316. Result.TimeAMString := 'AM';
  4317. Result.TimePMString := 'PM';
  4318. Result.TwoDigitYearCenturyWindow := 50;
  4319. Result.CurrencyFormat:=0;
  4320. Result.NegCurrFormat:=0;
  4321. Result.CurrencyDecimals:=2;
  4322. Result.CurrencyString:='$';
  4323. If Assigned(TFormatSettings.InitLocaleHandler) then
  4324. TFormatSettings.InitLocaleHandler(UpperCase(aLocale),Result);
  4325. end;
  4326. class function TFormatSettings.GetJSLocale: string; assembler;
  4327. asm
  4328. return Intl.DateTimeFormat().resolvedOptions().locale
  4329. end;
  4330. class function TFormatSettings.GetLocaleDecimalSeparator(const ALocale: string): string; assembler;
  4331. asm
  4332. var lNumber = 1.1;
  4333. lNumber = lNumber.toLocaleString(ALocale).substring(1, 2);
  4334. return lNumber;
  4335. end;
  4336. class function TFormatSettings.GetLocaleLongDayName(const ADayOfWeek: Integer; const ALocale: string): string; assembler;
  4337. asm
  4338. var lBaseDate = new Date(2017, 0, 1); // Sunday
  4339. lBaseDate.setDate(lBaseDate.getDate() + ADayOfWeek - 1);
  4340. return lBaseDate.toLocaleDateString(ALocale, { weekday: 'long' });
  4341. end;
  4342. class function TFormatSettings.GetLocaleLongMonthName(const AMonth: Integer; const ALocale: string): string; assembler;
  4343. asm
  4344. var lBaseDate = new Date(2017, AMonth - 1, 1);
  4345. return lBaseDate.toLocaleDateString(ALocale, { month: 'long' });
  4346. end;
  4347. class function TFormatSettings.GetLocaleShortDayName(const ADayOfWeek: Integer; const ALocale: string): string;
  4348. Var
  4349. d : TJSDate;
  4350. begin
  4351. d:=TJSDate.New(2017, 0, 1); // Sunday
  4352. d.Date:=d.Date + ADayOfWeek - 1;
  4353. Result:=d.toLocaleDateString(aLocale, new(['weekday','short']));
  4354. end;
  4355. class function TFormatSettings.GetLocaleShortMonthName(const AMonth: Integer; const ALocale: string): string;
  4356. Var
  4357. d : TJSDate;
  4358. begin
  4359. d:=TJSDate.New(2017, aMonth-1, 1); // Sunday
  4360. Result:=d.toLocaleDateString(aLocale,new(['month','short']));
  4361. end;
  4362. { ---------------------------------------------------------------------
  4363. FileNames
  4364. ---------------------------------------------------------------------}
  4365. function ChangeFileExt(const FileName, Extension: PathStr): PathStr;
  4366. var
  4367. i : longint;
  4368. EndSep : Set of Char;
  4369. SOF : Boolean;
  4370. begin
  4371. i := Length(FileName);
  4372. EndSep:=AllowDirectorySeparators+AllowDriveSeparators+[ExtensionSeparator];
  4373. while (I > 0) and not(FileName[I] in EndSep) do
  4374. Dec(I);
  4375. if (I = 0) or (FileName[I] <> ExtensionSeparator) then
  4376. I := Length(FileName)+1
  4377. else
  4378. begin
  4379. SOF:=(I=1) or (FileName[i-1] in AllowDirectorySeparators);
  4380. if (SOF) and not FirstDotAtFileNameStartIsExtension then
  4381. I:=Length(FileName)+1;
  4382. end;
  4383. Result := Copy(FileName, 1, I - 1) + Extension;
  4384. end;
  4385. function ExtractFilePath(const FileName: PathStr): PathStr;
  4386. var
  4387. i : longint;
  4388. EndSep : Set of Char;
  4389. begin
  4390. i := Length(FileName);
  4391. EndSep:=AllowDirectorySeparators+AllowDriveSeparators;
  4392. while (i > 0) and not CharInSet(FileName[i],EndSep) do
  4393. Dec(i);
  4394. If I>0 then
  4395. Result := Copy(FileName, 1, i)
  4396. else
  4397. Result:='';
  4398. end;
  4399. function ExtractFileDir(const FileName: PathStr): PathStr;
  4400. var
  4401. i : longint;
  4402. EndSep : Set of Char;
  4403. begin
  4404. I := Length(FileName);
  4405. EndSep:=AllowDirectorySeparators+AllowDriveSeparators;
  4406. while (I > 0) and not CharInSet(FileName[I],EndSep) do
  4407. Dec(I);
  4408. if (I > 1) and CharInSet(FileName[I],AllowDirectorySeparators) and
  4409. not CharInSet(FileName[I - 1],EndSep) then
  4410. Dec(I);
  4411. Result := Copy(FileName, 1, I);
  4412. end;
  4413. function ExtractFileDrive(const FileName: PathStr): PathStr;
  4414. var
  4415. i,l: longint;
  4416. begin
  4417. Result := '';
  4418. l:=Length(FileName);
  4419. if (l<2) then
  4420. exit;
  4421. If CharInSet(FileName[2],AllowDriveSeparators) then
  4422. result:=Copy(FileName,1,2)
  4423. else if CharInSet(FileName[1],AllowDirectorySeparators) and
  4424. CharInSet(FileName[2],AllowDirectorySeparators) then
  4425. begin
  4426. i := 2;
  4427. { skip share }
  4428. While (i<l) and Not CharInSet(Filename[i+1],AllowDirectorySeparators) do
  4429. inc(i);
  4430. inc(i);
  4431. While (i<l) and Not CharInSet(Filename[i+1],AllowDirectorySeparators) do
  4432. inc(i);
  4433. Result:=Copy(FileName,1,i);
  4434. end;
  4435. end;
  4436. function ExtractFileName(const FileName: PathStr): PathStr;
  4437. var
  4438. i : longint;
  4439. EndSep : Set of Char;
  4440. begin
  4441. I := Length(FileName);
  4442. EndSep:=AllowDirectorySeparators+AllowDriveSeparators;
  4443. while (I > 0) and not CharInSet(FileName[I],EndSep) do
  4444. Dec(I);
  4445. Result := Copy(FileName, I + 1, MaxInt);
  4446. end;
  4447. function ExtractFileExt(const FileName: PathStr): PathStr;
  4448. var
  4449. i : longint;
  4450. EndSep : Set of Char;
  4451. SOF : Boolean; // Dot at Start of filename ?
  4452. begin
  4453. Result:='';
  4454. I := Length(FileName);
  4455. EndSep:=AllowDirectorySeparators+AllowDriveSeparators+[ExtensionSeparator];
  4456. while (I > 0) and not CharInSet(FileName[I],EndSep) do
  4457. Dec(I);
  4458. if (I > 0) and (FileName[I] = ExtensionSeparator) then
  4459. begin
  4460. SOF:=(I=1) or (FileName[i-1] in AllowDirectorySeparators);
  4461. if (Not SOF) or FirstDotAtFileNameStartIsExtension then
  4462. Result := Copy(FileName, I, MaxInt);
  4463. end
  4464. else
  4465. Result := '';
  4466. end;
  4467. function ExtractRelativepath(const BaseName, DestName: PathStr): PathStr;
  4468. Var
  4469. OneLevelBack,Source, Dest : PathStr;
  4470. Sc,Dc,I,J : Longint;
  4471. SD,DD : TPathStrArray;
  4472. begin
  4473. OneLevelBack := '..'+PathDelim;
  4474. If Uppercase(ExtractFileDrive(BaseName))<>Uppercase(ExtractFileDrive(DestName)) Then
  4475. begin
  4476. Result:=DestName;
  4477. exit;
  4478. end;
  4479. Source:=ExcludeTrailingPathDelimiter(ExtractFilePath(BaseName));
  4480. Dest:=ExcludeTrailingPathDelimiter(ExtractFilePath(DestName));
  4481. SD:=GetDirs (Source);
  4482. SC:=Length(SD);
  4483. DD:=GetDirs (Dest);
  4484. DC:=Length(SD);
  4485. I:=0;
  4486. While (I<DC) and (I<SC) do
  4487. begin
  4488. If SameText(DD[i],SD[i]) then
  4489. Inc(i)
  4490. else
  4491. Break;
  4492. end;
  4493. Result:='';
  4494. For J:=I to SC do Result:=Result+OneLevelBack;
  4495. For J:=I to DC do Result:=Result+DD[J]+PathDelim;
  4496. Result:=Result+ExtractFileName(DestName);
  4497. end;
  4498. function SetDirSeparators(const FileName: PathStr): PathStr;
  4499. Var
  4500. I : integer;
  4501. begin
  4502. Result:=FileName;
  4503. For I:=1 to Length(Result) do
  4504. If CharInSet(Result[I],AllowDirectorySeparators) then
  4505. Result[i]:=PathDelim;
  4506. end;
  4507. function GetDirs(DirName: PathStr): TPathStrArray;
  4508. Var
  4509. I,J,L : Longint;
  4510. D : String;
  4511. begin
  4512. I:=1;
  4513. J:=0;
  4514. L:=0;
  4515. SetLength(Result,Length(DirName));
  4516. While I<=Length(DirName) do
  4517. begin
  4518. If CharInSet(DirName[i],AllowDirectorySeparators) then
  4519. begin
  4520. D:=Copy(DirName,J+1,J-I);
  4521. if (D<>'') then
  4522. begin
  4523. Result[L]:=D;
  4524. Inc(L);
  4525. end;
  4526. J:=I;
  4527. end;
  4528. Inc(I);
  4529. end;
  4530. SetLength(Result,L);
  4531. end;
  4532. function IncludeTrailingPathDelimiter(const Path: PathStr): PathStr;
  4533. Var
  4534. l : Integer;
  4535. begin
  4536. Result:=Path;
  4537. l:=Length(Result);
  4538. If (L=0) or not CharInSet(Result[l],AllowDirectorySeparators) then
  4539. Result:=Result+PathDelim;
  4540. end;
  4541. function ExcludeTrailingPathDelimiter(const Path: PathStr): PathStr;
  4542. Var
  4543. L : Integer;
  4544. begin
  4545. L:=Length(Path);
  4546. If (L>0) and CharInSet(Path[L],AllowDirectorySeparators) then
  4547. Dec(L);
  4548. Result:=Copy(Path,1,L);
  4549. end;
  4550. function IncludeLeadingPathDelimiter(const Path: PathStr): PathStr;
  4551. Var
  4552. l : Integer;
  4553. begin
  4554. Result:=Path;
  4555. l:=Length(Result);
  4556. If (L=0) or not CharInSet(Result[1],AllowDirectorySeparators) then
  4557. Result:=PathDelim+Result;
  4558. end;
  4559. function ExcludeLeadingPathDelimiter(const Path: PathStr): PathStr;
  4560. Var
  4561. L : Integer;
  4562. begin
  4563. Result:=Path;
  4564. L:=Length(Result);
  4565. If (L>0) and CharInSet(Result[1],AllowDirectorySeparators) then
  4566. Delete(Result,1,1);
  4567. end;
  4568. function IsPathDelimiter(const Path: PathStr; Index: Integer): Boolean;
  4569. begin
  4570. Result:=(Index>0) and (Index<=Length(Path)) and CharInSet(Path[Index],AllowDirectorySeparators);
  4571. end;
  4572. function ConcatPaths(const Paths: array of PathStr): PathStr;
  4573. var
  4574. I: Integer;
  4575. begin
  4576. if Length(Paths) > 0 then
  4577. begin
  4578. Result := Paths[0];
  4579. for I := 1 to Length(Paths) - 1 do
  4580. Result := IncludeTrailingPathDelimiter(Result) + ExcludeLeadingPathDelimiter(Paths[I]);
  4581. end else
  4582. Result := '';
  4583. end;
  4584. Function EncodeHTMLEntities (S : String) : String;
  4585. begin
  4586. Result:='';
  4587. if S='' then exit;
  4588. asm
  4589. return S.replace(/[\u00A0-\u9999<>\&]/gim, function(i) {
  4590. return '&#'+i.charCodeAt(0)+';';
  4591. });
  4592. end;
  4593. end;
  4594. { ---------------------------------------------------------------------
  4595. Type helpers implementation
  4596. ---------------------------------------------------------------------}
  4597. { ---------------------------------------------------------------------
  4598. TGUIDHelper
  4599. ---------------------------------------------------------------------}
  4600. Procedure NotImplemented(S : String);
  4601. begin
  4602. Raise Exception.Create('Not yet implemented : '+S);
  4603. end;
  4604. class function TGuidHelper.Create(Src: TGUID; BigEndian: Boolean): TGUID;
  4605. begin
  4606. Result:=Src;
  4607. if Not Bigendian then
  4608. begin
  4609. Result.D1:=SwapEndian(Result.D1);
  4610. Result.D2:=SwapEndian(Result.D2);
  4611. Result.D3:=SwapEndian(Result.D3);
  4612. end;
  4613. end;
  4614. class function TGuidHelper.Create(const Buf: TJSArrayBuffer; AStartIndex: Cardinal; BigEndian: Boolean): TGUID;
  4615. Var
  4616. A : Cardinal;
  4617. B,C : Word;
  4618. V : TJSDataView;
  4619. begin
  4620. V:=TJSDataView.New(Buf);
  4621. // The get functions return by default correct endianness.
  4622. if BigEndian then
  4623. begin
  4624. A:=V.getUint32(aStartIndex);
  4625. B:=V.getUint16(AStartIndex+4);
  4626. C:=V.getUint16(AStartIndex+6);
  4627. end
  4628. else
  4629. begin
  4630. A:=SwapEndian(V.getUint32(aStartIndex));
  4631. B:=SwapEndian(V.getUint16(AStartIndex+4));
  4632. C:=SwapEndian(V.getUint16(AStartIndex+6));
  4633. end;
  4634. Result:=Create(A,B,C,V.GetUint8(AStartIndex+8),V.GetUint8(AStartIndex+9),V.GetUint8(AStartIndex+10),V.GetUint8(AStartIndex+11),V.GetUint8(AStartIndex+12),V.GetUint8(AStartIndex+13),V.GetUint8(AStartIndex+14),V.GetUint8(AStartIndex+15));
  4635. end;
  4636. class function TGuidHelper.Create(const Data: array of Byte; AStartIndex: Cardinal; BigEndian: Boolean): TGUID;
  4637. Var
  4638. D : TJSUint8Array;
  4639. begin
  4640. if ((System.Length(Data)-AStartIndex)<16) then
  4641. raise EArgumentException.CreateFmt('The length of a GUID array must be at least %d',[]);
  4642. D:=TJSUint8Array.From(Data);
  4643. Result:=Create(D.buffer,aStartIndex,BigEndian);
  4644. end;
  4645. class function TGuidHelper.Create(const B: TBytes; DataEndian: TEndian): TGUID;
  4646. begin
  4647. Result:=Create(B,0,DataEndian);
  4648. end;
  4649. class function TGuidHelper.Create(const B: TBytes; AStartIndex: Cardinal; DataEndian: TEndian): TGUID;
  4650. begin
  4651. if ((System.Length(B)-AStartIndex)<16) then
  4652. raise EArgumentException.CreateFmt('The length of a GUID array must be at least %d',[]);
  4653. Result:=Create(B,AStartIndex,DataEndian=TEndian.Big);
  4654. end;
  4655. class function TGuidHelper.Create(const S: string): TGUID;
  4656. begin
  4657. Result:=StringToGUID(S);
  4658. end;
  4659. class function TGuidHelper.Create(A: Integer; B: SmallInt; C: SmallInt; const D: TBytes): TGUID;
  4660. begin
  4661. if (System.Length(D)<>8) then
  4662. raise EArgumentException.CreateFmt('The length of a GUID array must be %d',[]);
  4663. Result:=Create(Cardinal(A),Word(B),Word(C),D[0],D[1],D[2],D[3],D[4],D[5],D[6],D[7]);
  4664. end;
  4665. (*
  4666. class function TGuidHelper.Create(A: Integer; B: SmallInt; C: SmallInt; D, E, F, G, H, I, J, K: Byte): TGUID;
  4667. begin
  4668. Result:=Create(Cardinal(A),Word(B),Word(C),D,E,F,G,H,I,J,K);
  4669. end;
  4670. *)
  4671. class function TGuidHelper.Create(A: Cardinal; B: Word; C: Word; D, E, F, G, H, I, J, K: Byte): TGUID;
  4672. begin
  4673. Result.D1 := Cardinal(A);
  4674. Result.D2 := Word(B);
  4675. Result.D3 := Word(C);
  4676. Result.D4[0] := D;
  4677. Result.D4[1] := E;
  4678. Result.D4[2] := F;
  4679. Result.D4[3] := G;
  4680. Result.D4[4] := H;
  4681. Result.D4[5] := I;
  4682. Result.D4[6] := J;
  4683. Result.D4[7] := K;
  4684. end;
  4685. class function TGuidHelper.NewGuid: TGUID;
  4686. begin
  4687. CreateGUID(Result)
  4688. end;
  4689. function TGuidHelper.ToByteArray(DataEndian: TEndian): TBytes;
  4690. Var
  4691. D : TJSUint8Array;
  4692. V : TJSDataView;
  4693. I : Integer;
  4694. begin
  4695. D:=TJSUint8array.New(16);
  4696. V:=TJSDataView.New(D.buffer);
  4697. V.setUint32(0,D1,DataEndian=TEndian.Little);
  4698. V.setUint16(4,D2,DataEndian=TEndian.Little);
  4699. V.setUint16(6,D3,DataEndian=TEndian.Little);
  4700. for I:=0 to 7 do
  4701. V.setUint8(8+I,D4[i]);
  4702. SetLength(Result, 16);
  4703. for I:=0 to 15 do
  4704. Result[i]:=V.getUint8(I);
  4705. end;
  4706. function TGuidHelper.ToString(SkipBrackets: Boolean): string;
  4707. begin
  4708. Result:=GuidToString(Self);
  4709. If SkipBrackets then
  4710. Result:=Copy(Result,2,Length(Result)-2);
  4711. end;
  4712. { ---------------------------------------------------------------------
  4713. TStringHelper
  4714. ---------------------------------------------------------------------}
  4715. Function HaveChar(AChar : Char; const AList: array of Char) : Boolean;
  4716. Var
  4717. I : SizeInt;
  4718. begin
  4719. I:=0;
  4720. Result:=False;
  4721. While (Not Result) and (I<Length(AList)) do
  4722. begin
  4723. Result:=(AList[i]=AChar);
  4724. Inc(I);
  4725. end;
  4726. end;
  4727. function TStringHelper.GetChar(AIndex: SizeInt): Char;
  4728. begin
  4729. Result:=Self[AIndex+1];
  4730. end;
  4731. function TStringHelper.GetLength: SizeInt;
  4732. begin
  4733. Result:=System.Length(Self);
  4734. end;
  4735. class function TStringHelper.Compare(const A: string; const B: string): Integer;
  4736. begin
  4737. Result:=Compare(A,0,B,0,System.Length(B),[]);
  4738. end;
  4739. class function TStringHelper.Compare(const A: string; const B: string;
  4740. IgnoreCase: Boolean): Integer; //deprecated 'Use same with TCompareOptions';
  4741. begin
  4742. if IgnoreCase then
  4743. Result:=Compare(A,B,[coIgnoreCase])
  4744. else
  4745. Result:=Compare(A,B,[]);
  4746. end;
  4747. class function TStringHelper.Compare(const A: string; const B: string;
  4748. Options: TCompareOptions): Integer;
  4749. begin
  4750. Result:=Compare(A,0,B,0,System.Length(B),Options);
  4751. end;
  4752. class function TStringHelper.Compare(const A: string; IndexA: SizeInt;
  4753. const B: string; IndexB: SizeInt; ALen: SizeInt): Integer;
  4754. begin
  4755. Result:=Compare(A,IndexA,B,IndexB,ALen,[]);
  4756. end;
  4757. class function TStringHelper.Compare(const A: string; IndexA: SizeInt;
  4758. const B: string; IndexB: SizeInt; ALen: SizeInt; IgnoreCase: Boolean
  4759. ): Integer; //deprecated 'Use same with TCompareOptions';
  4760. begin
  4761. if IgnoreCase then
  4762. Result:=Compare(A,IndexA,B,IndexB,ALen,[coIgnoreCase])
  4763. else
  4764. Result:=Compare(A,IndexA,B,IndexB,ALen,[])
  4765. end;
  4766. class function TStringHelper.Compare(const A: string; IndexA: SizeInt;
  4767. const B: string; IndexB: SizeInt; ALen: SizeInt; Options: TCompareOptions
  4768. ): Integer;
  4769. Var
  4770. AL,BL : String;
  4771. begin
  4772. AL:=System.Copy(A,IndexA+1,aLen);
  4773. BL:=System.Copy(B,IndexB+1,aLen);
  4774. if (coIgnoreCase in Options) then
  4775. Result:=TJSString(UpperCase(AL)).localeCompare(UpperCase(BL))
  4776. else
  4777. Result:=TJSString(AL).localeCompare(BL)
  4778. end;
  4779. class function TStringHelper.CompareOrdinal(const A: string; const B: string
  4780. ): Integer;
  4781. Var
  4782. L : SizeInt;
  4783. begin
  4784. L:=System.Length(B);
  4785. if L>System.Length(A) then
  4786. L:=System.Length(A);
  4787. Result:=CompareOrdinal(A,0,B,0,L);
  4788. end;
  4789. class function TStringHelper.CompareOrdinal(const A: string; IndexA: SizeInt;
  4790. const B: string; IndexB: SizeInt; ALen: SizeInt): Integer;
  4791. Var
  4792. I,M : integer;
  4793. begin
  4794. M:=System.Length(A)-IndexA;
  4795. If M>(System.Length(B)-IndexB) then
  4796. M:=(System.Length(B)-IndexB);
  4797. if M>aLen then
  4798. M:=aLen;
  4799. I:=0;
  4800. Result:=0;
  4801. While (Result=0) and (I<M) do
  4802. begin
  4803. Result:=TJSString(A).charCodeAt(IndexA+I)-TJSString(B).charCodeAt(IndexB+I);
  4804. Inc(I);
  4805. end;
  4806. end;
  4807. class function TStringHelper.CompareText(const A: string; const B: string
  4808. ): Integer;
  4809. begin
  4810. Result:=Sysutils.CompareText(A,B);
  4811. end;
  4812. class function TStringHelper.Copy(const Str: string): string;
  4813. begin
  4814. Result:=Str;
  4815. end;
  4816. class function TStringHelper.Create(AChar: Char; ACount: SizeInt): string;
  4817. begin
  4818. Result:=StringOfChar(AChar,ACount);
  4819. end;
  4820. class function TStringHelper.Create(const AValue: array of Char): string;
  4821. begin
  4822. Result:=Create(AValue,0,System.Length(AValue));
  4823. end;
  4824. class function TStringHelper.Create(const AValue: array of Char;
  4825. StartIndex: SizeInt; ALen: SizeInt): string;
  4826. Var
  4827. I : Integer;
  4828. begin
  4829. SetLength(Result,ALen);
  4830. For I:=1 to ALen do
  4831. Result[I]:=AValue[StartIndex+I-1];
  4832. end;
  4833. class function TStringHelper.EndsText(const ASubText, AText: string): Boolean;
  4834. begin
  4835. Result:=(ASubText<>'') and (sysutils.CompareText(System.Copy(AText,System.Length(AText)-System.Length(ASubText)+1,System.Length(ASubText)),ASubText)=0);
  4836. end;
  4837. class function TStringHelper.Equals(const a: string; const b: string): Boolean;
  4838. begin
  4839. Result:=A=B;
  4840. end;
  4841. class function TStringHelper.Format(const AFormat: string; const args: array of JSValue): string;
  4842. begin
  4843. Result:=Sysutils.Format(AFormat,Args);
  4844. end;
  4845. class function TStringHelper.IsNullOrEmpty(const AValue: string): Boolean;
  4846. begin
  4847. Result:=system.Length(AValue)=0;
  4848. end;
  4849. class function TStringHelper.IsNullOrWhiteSpace(const AValue: string): Boolean;
  4850. begin
  4851. Result:=system.Length(sysutils.Trim(AValue))=0;
  4852. end;
  4853. class function TStringHelper.Join(const Separator: string; const Values: array of JSValue): string;
  4854. begin
  4855. Result:=TJSArray(Values).Join(Separator);
  4856. end;
  4857. class function TStringHelper.Join(const Separator: string;
  4858. const Values: array of string): string;
  4859. begin
  4860. Result:=TJSArray(Values).Join(Separator);
  4861. end;
  4862. class function TStringHelper.Join(const Separator: string;
  4863. const Values: array of string; StartIndex: SizeInt; ACount: SizeInt): string;
  4864. Var
  4865. VLen : SizeInt;
  4866. begin
  4867. VLen:=High(Values);
  4868. If (ACount<0) or ((StartIndex>0) and (StartIndex>VLen)) then
  4869. raise ERangeError.Create(SRangeError);
  4870. If (ACount=0) or (VLen<0) then
  4871. Result:=''
  4872. else
  4873. Result:=TJSArray(Values).Slice(StartIndex,StartIndex+aCount).Join(Separator);
  4874. end;
  4875. class function TStringHelper.LowerCase(const S: string): string;
  4876. begin
  4877. Result:=sysutils.Lowercase(S);
  4878. end;
  4879. class function TStringHelper.Parse(const AValue: Boolean): string;
  4880. begin
  4881. Result:=BoolToStr(AValue);
  4882. end;
  4883. class function TStringHelper.Parse(const AValue: Extended): string;
  4884. begin
  4885. Result:=FloatToStr(AValue);
  4886. end;
  4887. class function TStringHelper.Parse(const AValue: NativeInt): string;
  4888. begin
  4889. Result:=IntToStr(AValue);
  4890. end;
  4891. class function TStringHelper.Parse(const AValue: Integer): string;
  4892. begin
  4893. Result:=IntToStr(AValue);
  4894. end;
  4895. class function TStringHelper.ToBoolean(const S: string): Boolean;
  4896. begin
  4897. Result:=StrToBool(S);
  4898. end;
  4899. class function TStringHelper.ToDouble(const S: string): Double;
  4900. begin
  4901. Result:=StrToFloat(S);
  4902. end;
  4903. class function TStringHelper.ToExtended(const S: string): Extended;
  4904. begin
  4905. Result:=StrToFloat(S);
  4906. end;
  4907. class function TStringHelper.ToNativeInt(const S: string): NativeInt;
  4908. begin
  4909. Result:=StrToInt64(S);
  4910. end;
  4911. class function TStringHelper.ToInteger(const S: string): Integer;
  4912. begin
  4913. Result:=StrToInt(S);
  4914. end;
  4915. class function TStringHelper.UpperCase(const S: string): string;
  4916. begin
  4917. Result:=sysutils.Uppercase(S);
  4918. end;
  4919. class function TStringHelper.ToCharArray(const S: String): TCharArray;
  4920. Var
  4921. I,Len: integer;
  4922. begin
  4923. Len:=System.Length(S);
  4924. SetLength(Result,Len);
  4925. For I:=1 to Len do
  4926. Result[I-1]:=S[I];
  4927. end;
  4928. function TStringHelper.CompareTo(const B: string): Integer;
  4929. begin
  4930. // Order is important
  4931. Result:=Compare(Self,B);
  4932. end;
  4933. function TStringHelper.Contains(const AValue: string): Boolean;
  4934. begin
  4935. Result:=(AValue<>'') and (Pos(AValue,Self)>0);
  4936. end;
  4937. function TStringHelper.CountChar(const C: Char): SizeInt;
  4938. Var
  4939. S : Char;
  4940. begin
  4941. Result:=0;
  4942. For S in Self do
  4943. if (S=C) then
  4944. Inc(Result);
  4945. end;
  4946. function TStringHelper.DeQuotedString: string;
  4947. begin
  4948. Result:=DeQuotedString('''');
  4949. end;
  4950. function TStringHelper.DeQuotedString(const AQuoteChar: Char): string;
  4951. var
  4952. L,I : SizeInt;
  4953. Res : Array of Char;
  4954. PS,PD : SizeInt;
  4955. IsQuote : Boolean;
  4956. begin
  4957. L:=System.Length(Self);
  4958. if (L<2) or Not ((Self[1]=AQuoteChar) and (Self[L]=AQuoteChar)) then
  4959. Exit(Self);
  4960. SetLength(Res,L);
  4961. IsQuote:=False;
  4962. PS:=2;
  4963. PD:=1;
  4964. For I:=2 to L-1 do
  4965. begin
  4966. if (Self[PS]=AQuoteChar) then
  4967. begin
  4968. IsQuote:=Not IsQuote;
  4969. if Not IsQuote then
  4970. begin
  4971. Result[PD]:=Self[PS];
  4972. Inc(PD);
  4973. end;
  4974. end
  4975. else
  4976. begin
  4977. if IsQuote then
  4978. IsQuote:=false;
  4979. Result[PD]:=Self[PS];
  4980. Inc(PD);
  4981. end;
  4982. Inc(PS);
  4983. end;
  4984. SetLength(Result,PD-1);
  4985. end;
  4986. function TStringHelper.EndsWith(const AValue: string): Boolean;
  4987. begin
  4988. Result:=EndsWith(AValue,False);
  4989. end;
  4990. function TStringHelper.EndsWith(const AValue: string; IgnoreCase: Boolean): Boolean;
  4991. Var
  4992. L : SizeInt;
  4993. S : String;
  4994. begin
  4995. L:=system.Length(AVAlue);
  4996. Result:=L=0;
  4997. if Not Result then
  4998. begin
  4999. S:=system.Copy(Self,Length-L+1,L);
  5000. Result:=system.Length(S)=L;
  5001. if Result then
  5002. if IgnoreCase then
  5003. Result:=CompareText(S,AValue)=0
  5004. else
  5005. Result:=S=AValue;
  5006. end;
  5007. end;
  5008. function TStringHelper.Equals(const AValue: string): Boolean;
  5009. begin
  5010. Result:=(Self=AValue);
  5011. end;
  5012. function TStringHelper.Format(const args: array of jsValue): string;
  5013. begin
  5014. Result:=Sysutils.Format(Self,Args);
  5015. end;
  5016. function TStringHelper.GetHashCode: Integer;
  5017. // Taken from contnrs, fphash
  5018. var
  5019. P,pmax : Integer;
  5020. L : TJSString;
  5021. begin
  5022. {$push}
  5023. {$Q-}
  5024. L:=TJSString(Self);
  5025. Result:=0;
  5026. P:=1;
  5027. pmax:=length+1;
  5028. while (p<pmax) do
  5029. begin
  5030. Result:=LongWord(LongInt(Result shl 5) - LongInt(Result)) xor L.CharCodeAt(P);
  5031. Inc(p);
  5032. end;
  5033. {$pop}
  5034. end;
  5035. function TStringHelper.IndexOf(AValue: Char): SizeInt;
  5036. begin
  5037. Result:=IndexOf(AValue,0,Length);
  5038. end;
  5039. function TStringHelper.IndexOf(const AValue: string): SizeInt;
  5040. begin
  5041. Result:=IndexOf(AValue,0,Length);
  5042. end;
  5043. function TStringHelper.IndexOf(AValue: Char; StartIndex: SizeInt): SizeInt;
  5044. begin
  5045. Result:=IndexOf(AValue,StartIndex,Length);
  5046. end;
  5047. function TStringHelper.IndexOf(const AValue: string; StartIndex: SizeInt
  5048. ): SizeInt;
  5049. begin
  5050. Result:=IndexOf(AValue,StartIndex,Length);
  5051. end;
  5052. function TStringHelper.IndexOf(AValue: Char; StartIndex: SizeInt;
  5053. ACount: SizeInt): SizeInt;
  5054. Var
  5055. S : String;
  5056. begin
  5057. S:=System.Copy(Self,StartIndex+1,ACount);
  5058. Result:=Pos(AValue,S)-1;
  5059. if Result<>-1 then
  5060. Result:=Result+StartIndex;
  5061. end;
  5062. function TStringHelper.IndexOf(const AValue: string; StartIndex: SizeInt;
  5063. ACount: SizeInt): SizeInt;
  5064. Var
  5065. S : String;
  5066. begin
  5067. S:=System.Copy(Self,StartIndex+1,ACount);
  5068. Result:=Pos(AValue,S)-1;
  5069. if Result<>-1 then
  5070. Result:=Result+StartIndex;
  5071. end;
  5072. function TStringHelper.IndexOfUnQuoted(const AValue: string; StartQuote,
  5073. EndQuote: Char; StartIndex: SizeInt = 0): SizeInt;
  5074. Var
  5075. LV : SizeInt;
  5076. S : String;
  5077. Function MatchAt(I : SizeInt) : Boolean ; Inline;
  5078. Var
  5079. J : SizeInt;
  5080. begin
  5081. J:=1;
  5082. Repeat
  5083. Result:=(S[I+J-1]=AValue[j]);
  5084. Inc(J);
  5085. Until (Not Result) or (J>LV);
  5086. end;
  5087. Var
  5088. I,L,Q: SizeInt;
  5089. begin
  5090. S:=Self;
  5091. Result:=-1;
  5092. LV:=system.Length(AValue);
  5093. L:=Length-LV+1;
  5094. if L<0 then
  5095. L:=0;
  5096. I:=StartIndex+1;
  5097. Q:=0;
  5098. if StartQuote=EndQuote then
  5099. begin
  5100. While (Result=-1) and (I<=L) do
  5101. begin
  5102. if (S[I]=StartQuote) then
  5103. Q:=1-Q;
  5104. if (Q=0) and MatchAt(i) then
  5105. Result:=I-1;
  5106. Inc(I);
  5107. end;
  5108. end
  5109. else
  5110. begin
  5111. While (Result=-1) and (I<=L) do
  5112. begin
  5113. if S[I]=StartQuote then
  5114. Inc(Q)
  5115. else if (S[I]=EndQuote) and (Q>0) then
  5116. Dec(Q);
  5117. if (Q=0) and MatchAt(i) then
  5118. Result:=I-1;
  5119. Inc(I);
  5120. end;
  5121. end;
  5122. end;
  5123. function TStringHelper.IndexOfAny(const AnyOf: string): SizeInt;
  5124. begin
  5125. Result:=IndexOfAny(AnyOf.ToCharArray);
  5126. end;
  5127. function TStringHelper.IndexOfAny(const AnyOf: array of Char): SizeInt;
  5128. begin
  5129. Result:=IndexOfAny(AnyOf,0,Length);
  5130. end;
  5131. function TStringHelper.IndexOfAny(const AnyOf: String; StartIndex: SizeInt): SizeInt;
  5132. begin
  5133. Result:=IndexOfAny(AnyOf.ToCharArray,StartIndex);
  5134. end;
  5135. function TStringHelper.IndexOfAny(const AnyOf: array of Char;
  5136. StartIndex: SizeInt): SizeInt;
  5137. begin
  5138. Result:=IndexOfAny(AnyOf,StartIndex,Length);
  5139. end;
  5140. function TStringHelper.IndexOfAny(const AnyOf: String; StartIndex: SizeInt; ACount: SizeInt): SizeInt;
  5141. begin
  5142. Result:=IndexOfAny(AnyOf.ToCharArray,StartIndex,aCount);
  5143. end;
  5144. function TStringHelper.IndexOfAny(const AnyOf: array of Char;
  5145. StartIndex: SizeInt; ACount: SizeInt): SizeInt;
  5146. Var
  5147. i,L : SizeInt;
  5148. begin
  5149. I:=StartIndex+1;
  5150. L:=I+ACount-1;
  5151. If L>Length then
  5152. L:=Length;
  5153. Result:=-1;
  5154. While (Result=-1) and (I<=L) do
  5155. begin
  5156. if HaveChar(Self[i],AnyOf) then
  5157. Result:=I-1;
  5158. Inc(I);
  5159. end;
  5160. end;
  5161. function TStringHelper.IndexOfAny(const AnyOf: array of String): SizeInt;
  5162. begin
  5163. Result:=IndexOfAny(AnyOf,0,Length);
  5164. end;
  5165. function TStringHelper.IndexOfAny(const AnyOf: array of String;
  5166. StartIndex: SizeInt): SizeInt;
  5167. begin
  5168. Result:=IndexOfAny(AnyOf,StartIndex,Length-StartIndex);
  5169. end;
  5170. function TStringHelper.IndexOfAny(const AnyOf: array of String;
  5171. StartIndex: SizeInt; ACount: SizeInt): SizeInt;
  5172. Var
  5173. M : SizeInt;
  5174. begin
  5175. Result:=IndexOfAny(AnyOf,StartIndex,ACount,M);
  5176. end;
  5177. function TStringHelper.IndexOfAny(const AnyOf: array of String;
  5178. StartIndex: SizeInt; ACount: SizeInt; out AMatch: SizeInt): SizeInt;
  5179. Var
  5180. L,I : SizeInt;
  5181. begin
  5182. Result:=-1;
  5183. For I:=0 to System.Length(AnyOf)-1 do
  5184. begin
  5185. L:=IndexOf(AnyOf[i],StartIndex,ACount);
  5186. If (L>=0) and ((Result=-1) or (L<Result)) then
  5187. begin
  5188. Result:=L;
  5189. AMatch:=I;
  5190. end;
  5191. end;
  5192. end;
  5193. function TStringHelper.IndexOfAnyUnquoted(const AnyOf: array of Char;
  5194. StartQuote, EndQuote: Char): SizeInt;
  5195. begin
  5196. Result:=IndexOfAnyUnquoted(AnyOf,StartQuote,EndQuote,0,Length);
  5197. end;
  5198. function TStringHelper.IndexOfAnyUnquoted(const AnyOf: array of Char;
  5199. StartQuote, EndQuote: Char; StartIndex: SizeInt): SizeInt;
  5200. begin
  5201. Result:=IndexOfAnyUnquoted(AnyOf,StartQuote,EndQuote,StartIndex,Length);
  5202. end;
  5203. function TStringHelper.IndexOfAnyUnquoted(const AnyOf: array of Char;
  5204. StartQuote, EndQuote: Char; StartIndex: SizeInt; ACount: SizeInt): SizeInt;
  5205. Var
  5206. I,L : SizeInt;
  5207. Q : SizeInt;
  5208. begin
  5209. Result:=-1;
  5210. L:=StartIndex+ACount-1;
  5211. if L>Length then
  5212. L:=Length;
  5213. I:=StartIndex+1;
  5214. Q:=0;
  5215. if StartQuote=EndQuote then
  5216. begin
  5217. While (Result=-1) and (I<=L) do
  5218. begin
  5219. if (Self[I]=StartQuote) then
  5220. Q:=1-Q;
  5221. if (Q=0) and HaveChar(Self[i],AnyOf) then
  5222. Result:=I-1;
  5223. Inc(I);
  5224. end;
  5225. end
  5226. else
  5227. begin
  5228. While (Result=-1) and (I<=L) do
  5229. begin
  5230. if Self[I]=StartQuote then
  5231. Inc(Q)
  5232. else if (Self[I]=EndQuote) and (Q>0) then
  5233. Dec(Q);
  5234. if (Q=0) and HaveChar(Self[i],AnyOf) then
  5235. Result:=I-1;
  5236. Inc(I);
  5237. end;
  5238. end;
  5239. end;
  5240. function TStringHelper.IndexOfAnyUnquoted(const AnyOf: array of string;
  5241. StartQuote, EndQuote: Char; StartIndex: SizeInt; out Matched: SizeInt
  5242. ): SizeInt;
  5243. Var
  5244. L,I : SizeInt;
  5245. begin
  5246. Result:=-1;
  5247. For I:=0 to System.Length(AnyOf)-1 do
  5248. begin
  5249. L:=IndexOfUnquoted(AnyOf[i],StartQuote,EndQuote,StartIndex);
  5250. If (L>=0) and ((Result=-1) or (L<Result)) then
  5251. begin
  5252. Result:=L;
  5253. Matched:=I;
  5254. end;
  5255. end;
  5256. end;
  5257. function TStringHelper.Insert(StartIndex: SizeInt; const AValue: string
  5258. ): string;
  5259. begin
  5260. system.Insert(AValue,Self,StartIndex+1);
  5261. Result:=Self;
  5262. end;
  5263. function TStringHelper.IsDelimiter(const Delimiters: string; Index: SizeInt
  5264. ): Boolean;
  5265. begin
  5266. Result:=sysutils.IsDelimiter(Delimiters,Self,Index+1);
  5267. end;
  5268. function TStringHelper.IsEmpty: Boolean;
  5269. begin
  5270. Result:=(Length=0)
  5271. end;
  5272. function TStringHelper.LastDelimiter(const Delims: string): SizeInt;
  5273. begin
  5274. Result:=sysutils.LastDelimiter(Delims,Self)-1;
  5275. end;
  5276. function TStringHelper.LastIndexOf(AValue: Char): SizeInt;
  5277. begin
  5278. Result:=LastIndexOf(AValue,Length-1,Length);
  5279. end;
  5280. function TStringHelper.LastIndexOf(const AValue: string): SizeInt;
  5281. begin
  5282. Result:=LastIndexOf(AValue,Length-1,Length);
  5283. end;
  5284. function TStringHelper.LastIndexOf(AValue: Char; AStartIndex: SizeInt): SizeInt;
  5285. begin
  5286. Result:=LastIndexOf(AValue,AStartIndex,Length);
  5287. end;
  5288. function TStringHelper.LastIndexOf(const AValue: string; AStartIndex: SizeInt
  5289. ): SizeInt;
  5290. begin
  5291. Result:=LastIndexOf(AValue,AStartIndex,Length);
  5292. end;
  5293. function TStringHelper.LastIndexOf(AValue: Char; AStartIndex: SizeInt;
  5294. ACount: SizeInt): SizeInt;
  5295. Var
  5296. Min : SizeInt;
  5297. begin
  5298. Result:=AStartIndex+1;
  5299. Min:=Result-ACount+1;
  5300. If Min<1 then
  5301. Min:=1;
  5302. While (Result>=Min) and (Self[Result]<>AValue) do
  5303. Dec(Result);
  5304. if Result<Min then
  5305. Result:=-1
  5306. else
  5307. Result:=Result-1;
  5308. end;
  5309. function TStringHelper.LastIndexOf(const AValue: string; AStartIndex: SizeInt; ACount: SizeInt): SizeInt;
  5310. begin
  5311. Result:=TJSString(Self).lastIndexOf(aValue,aStartIndex);
  5312. if (aStartIndex-Result)>aCount then
  5313. Result:=-1;
  5314. end;
  5315. function TStringHelper.LastIndexOfAny(const AnyOf: array of Char): SizeInt;
  5316. begin
  5317. Result:=LastIndexOfAny(AnyOf,Length-1,Length);
  5318. end;
  5319. function TStringHelper.LastIndexOfAny(const AnyOf: array of Char;
  5320. AStartIndex: SizeInt): SizeInt;
  5321. begin
  5322. Result:=LastIndexOfAny(AnyOf,AStartIndex,Length);
  5323. end;
  5324. function TStringHelper.LastIndexOfAny(const AnyOf: array of Char;
  5325. AStartIndex: SizeInt; ACount: SizeInt): SizeInt;
  5326. Var
  5327. Min : SizeInt;
  5328. begin
  5329. Result:=AStartIndex+1;
  5330. Min:=Result-ACount+1;
  5331. If Min<1 then
  5332. Min:=1;
  5333. While (Result>=Min) and Not HaveChar(Self[Result],AnyOf) do
  5334. Dec(Result);
  5335. if Result<Min then
  5336. Result:=-1
  5337. else
  5338. Result:=Result-1;
  5339. end;
  5340. function TStringHelper.PadLeft(ATotalWidth: SizeInt): string;
  5341. begin
  5342. Result:=PadLeft(ATotalWidth,' ');
  5343. end;
  5344. function TStringHelper.PadLeft(ATotalWidth: SizeInt; PaddingChar: Char): string;
  5345. Var
  5346. L : SizeInt;
  5347. begin
  5348. Result:=Self;
  5349. L:=ATotalWidth-Length;
  5350. If L>0 then
  5351. Result:=StringOfChar(PaddingChar,L)+Result;
  5352. end;
  5353. function TStringHelper.PadRight(ATotalWidth: SizeInt): string;
  5354. begin
  5355. Result:=PadRight(ATotalWidth,' ');
  5356. end;
  5357. function TStringHelper.PadRight(ATotalWidth: SizeInt; PaddingChar: Char
  5358. ): string;
  5359. Var
  5360. L : SizeInt;
  5361. begin
  5362. Result:=Self;
  5363. L:=ATotalWidth-Length;
  5364. If L>0 then
  5365. Result:=Result+StringOfChar(PaddingChar,L);
  5366. end;
  5367. function TStringHelper.QuotedString: string;
  5368. begin
  5369. Result:=QuotedStr(Self);
  5370. end;
  5371. function TStringHelper.QuotedString(const AQuoteChar: Char): string;
  5372. begin
  5373. Result:=QuotedStr(Self,AQuoteChar);
  5374. end;
  5375. function TStringHelper.Remove(StartIndex: SizeInt): string;
  5376. begin
  5377. Result:=Remove(StartIndex,Self.Length-StartIndex);
  5378. end;
  5379. function TStringHelper.Remove(StartIndex: SizeInt; ACount: SizeInt): string;
  5380. begin
  5381. Result:=Self;
  5382. System.Delete(Result,StartIndex+1,ACount);
  5383. end;
  5384. function TStringHelper.Replace(OldChar: Char; NewChar: Char): string;
  5385. begin
  5386. Result:=Replace(OldChar,NewChar,[rfReplaceAll]);
  5387. end;
  5388. function TStringHelper.Replace(OldChar: Char; NewChar: Char;
  5389. ReplaceFlags: TReplaceFlags): string;
  5390. begin
  5391. Result:=StringReplace(Self,OldChar,NewChar,ReplaceFlags);
  5392. end;
  5393. function TStringHelper.Replace(const OldValue: string; const NewValue: string
  5394. ): string;
  5395. begin
  5396. Result:=Replace(OldValue,NewValue,[rfReplaceAll]);
  5397. end;
  5398. function TStringHelper.Replace(const OldValue: string; const NewValue: string;
  5399. ReplaceFlags: TReplaceFlags): string;
  5400. begin
  5401. Result:=StringReplace(Self,OldValue,NewValue,ReplaceFlags);
  5402. end;
  5403. function TStringHelper.Split(const Separators: String): TStringArray;
  5404. begin
  5405. Result:=Split(Separators.ToCharArray);
  5406. end;
  5407. function TStringHelper.Split(const Separators: array of Char): TStringArray;
  5408. begin
  5409. Result:=Split(Separators,#0,#0,Length+1,TStringSplitOptions.None);
  5410. end;
  5411. function TStringHelper.Split(const Separators: string; ACount: SizeInt): TStringArray;
  5412. begin
  5413. Result:=Split(Separators.ToCharArray,aCount);
  5414. end;
  5415. function TStringHelper.Split(const Separators: array of Char; ACount: SizeInt
  5416. ): TStringArray;
  5417. begin
  5418. Result:=Split(Separators,#0,#0,ACount,TStringSplitOptions.None);
  5419. end;
  5420. function TStringHelper.Split(const Separators: string; Options: TStringSplitOptions): TStringArray;
  5421. begin
  5422. Result:=Split(Separators.ToCharArray,Options);
  5423. end;
  5424. function TStringHelper.Split(const Separators: array of Char;
  5425. Options: TStringSplitOptions): TStringArray;
  5426. begin
  5427. Result:=Split(Separators,Length+1,Options);
  5428. end;
  5429. function TStringHelper.Split(const Separators: string; ACount: SizeInt; Options: TStringSplitOptions): TStringArray;
  5430. begin
  5431. Result:=Split(Separators.ToCharArray,aCount,Options);
  5432. end;
  5433. function TStringHelper.Split(const Separators: array of Char; ACount: SizeInt;
  5434. Options: TStringSplitOptions): TStringArray;
  5435. begin
  5436. Result:=Split(Separators,#0,#0,ACount,Options);
  5437. end;
  5438. function TStringHelper.Split(const Separators: array of string): TStringArray;
  5439. begin
  5440. Result:=Split(Separators,Length+1);
  5441. end;
  5442. function TStringHelper.Split(const Separators: array of string; ACount: SizeInt
  5443. ): TStringArray;
  5444. begin
  5445. Result:=Split(Separators,ACount,TStringSplitOptions.None);
  5446. end;
  5447. function TStringHelper.Split(const Separators: array of string;
  5448. Options: TStringSplitOptions): TStringArray;
  5449. begin
  5450. Result:=Split(Separators,Length+1,Options);
  5451. end;
  5452. function TStringHelper.Split(const Separators: array of string;
  5453. ACount: SizeInt; Options: TStringSplitOptions): TStringArray;
  5454. begin
  5455. Result:=Split(Separators,#0,#0,ACount,Options);
  5456. end;
  5457. function TStringHelper.Split(const Separators: String; AQuote: Char): TStringArray;
  5458. begin
  5459. Result:=Split(Separators.ToCharArray,aQuote);
  5460. end;
  5461. function TStringHelper.Split(const Separators: array of Char; AQuote: Char
  5462. ): TStringArray;
  5463. begin
  5464. Result:=Split(Separators,AQuote,AQuote);
  5465. end;
  5466. function TStringHelper.Split(const Separators: String; AQuoteStart, AQuoteEnd: Char): TStringArray;
  5467. begin
  5468. Result:=Split(Separators.ToCharArray,aQuoteStart,aQuoteEnd);
  5469. end;
  5470. function TStringHelper.Split(const Separators: array of Char; AQuoteStart,
  5471. AQuoteEnd: Char): TStringArray;
  5472. begin
  5473. Result:=Split(Separators,AQuoteStart,AQuoteEnd,TStringSplitOptions.None);
  5474. end;
  5475. function TStringHelper.Split(const Separators: string; AQuoteStart, AQuoteEnd: Char; Options: TStringSplitOptions): TStringArray;
  5476. begin
  5477. Result:=Split(Separators.ToCharArray,aQuoteStart,aQuoteEnd,Options);
  5478. end;
  5479. function TStringHelper.Split(const Separators: array of Char; AQuoteStart,
  5480. AQuoteEnd: Char; Options: TStringSplitOptions): TStringArray;
  5481. begin
  5482. Result:=Split(Separators,AQuoteStart,AQuoteEnd,Length+1,Options);
  5483. end;
  5484. function TStringHelper.Split(const Separators: string; AQuoteStart, AQuoteEnd: Char; ACount: SizeInt): TStringArray;
  5485. begin
  5486. Result:=Split(Separators.ToCharArray,aQuoteStart,aQuoteEnd,aCount);
  5487. end;
  5488. function TStringHelper.Split(const Separators: array of Char; AQuoteStart,
  5489. AQuoteEnd: Char; ACount: SizeInt): TStringArray;
  5490. begin
  5491. Result:=Split(Separators,AQuoteStart,AQuoteEnd,ACount,TStringSplitOptions.None);
  5492. end;
  5493. function TStringHelper.Split(const Separators: string; AQuoteStart, AQuoteEnd: Char; ACount: SizeInt; Options: TStringSplitOptions
  5494. ): TStringArray;
  5495. begin
  5496. Result:=Split(Separators.ToCharArray,aQuoteStart,aQuoteEnd,aCount,Options);
  5497. end;
  5498. function TStringHelper.Split(const Separators: array of Char; AQuoteStart,
  5499. AQuoteEnd: Char; ACount: SizeInt; Options: TStringSplitOptions): TStringArray;
  5500. Const
  5501. BlockSize = 10;
  5502. Var
  5503. S : String;
  5504. Function NextSep(StartIndex : SizeInt) : SizeInt;
  5505. begin
  5506. if (AQuoteStart<>#0) then
  5507. Result:=S.IndexOfAnyUnQuoted(Separators,AQuoteStart,AQuoteEnd,StartIndex)
  5508. else
  5509. Result:=S.IndexOfAny(Separators,StartIndex);
  5510. end;
  5511. Procedure MaybeGrow(Curlen : SizeInt);
  5512. begin
  5513. if System.Length(Result)<=CurLen then
  5514. SetLength(Result,System.Length(Result)+BlockSize);
  5515. end;
  5516. Var
  5517. Sep,LastSep,Len : SizeInt;
  5518. T : String;
  5519. begin
  5520. S:=Self;
  5521. SetLength(Result,BlockSize);
  5522. Len:=0;
  5523. LastSep:=0;
  5524. Sep:=NextSep(0);
  5525. While (Sep<>-1) and ((ACount=0) or (Len<ACount)) do
  5526. begin
  5527. T:=SubString(LastSep,Sep-LastSep);
  5528. // Writeln('Examining >',T,'< at pos ',LastSep,', till pos ',Sep);
  5529. If (T<>'') or (not (TStringSplitOptions.ExcludeEmpty=Options)) then
  5530. begin
  5531. MaybeGrow(Len);
  5532. Result[Len]:=T;
  5533. Inc(Len);
  5534. end;
  5535. LastSep:=Sep+1;
  5536. Sep:=NextSep(LastSep);
  5537. end;
  5538. if (LastSep<=Length) and ((ACount=0) or (Len<ACount)) then
  5539. begin
  5540. T:=SubString(LastSep);
  5541. // Writeln('Examining >',T,'< at pos,',LastSep,' till pos ',Sep);
  5542. If (T<>'') or (not (TStringSplitOptions.ExcludeEmpty=Options)) then
  5543. begin
  5544. MaybeGrow(Len);
  5545. Result[Len]:=T;
  5546. Inc(Len);
  5547. end;
  5548. end;
  5549. SetLength(Result,Len);
  5550. end;
  5551. function TStringHelper.Split(const Separators: array of string; AQuote: Char
  5552. ): TStringArray;
  5553. begin
  5554. Result:=SPlit(Separators,AQuote,AQuote);
  5555. end;
  5556. function TStringHelper.Split(const Separators: array of string; AQuoteStart,
  5557. AQuoteEnd: Char): TStringArray;
  5558. begin
  5559. Result:=SPlit(Separators,AQuoteStart,AQuoteEnd,Length+1,TStringSplitOptions.None);
  5560. end;
  5561. function TStringHelper.Split(const Separators: array of string; AQuoteStart,
  5562. AQuoteEnd: Char; Options: TStringSplitOptions): TStringArray;
  5563. begin
  5564. Result:=SPlit(Separators,AQuoteStart,AQuoteEnd,Length+1,Options);
  5565. end;
  5566. function TStringHelper.Split(const Separators: array of string; AQuoteStart,
  5567. AQuoteEnd: Char; ACount: SizeInt): TStringArray;
  5568. begin
  5569. Result:=SPlit(Separators,AQuoteStart,AQuoteEnd,ACount,TStringSplitOptions.None);
  5570. end;
  5571. function TStringHelper.Split(const Separators: array of string; AQuoteStart,
  5572. AQuoteEnd: Char; ACount: SizeInt; Options: TStringSplitOptions): TStringArray;
  5573. Const
  5574. BlockSize = 10;
  5575. Var
  5576. S : String;
  5577. Function NextSep(StartIndex : SizeInt; out Match : SizeInt) : SizeInt;
  5578. begin
  5579. if (AQuoteStart<>#0) then
  5580. Result:=S.IndexOfAnyUnQuoted(Separators,AQuoteStart,AQuoteEnd,StartIndex,Match)
  5581. else
  5582. Result:=S.IndexOfAny(Separators,StartIndex,Length,Match);
  5583. end;
  5584. Procedure MaybeGrow(Curlen : SizeInt);
  5585. begin
  5586. if System.Length(Result)<=CurLen then
  5587. SetLength(Result,System.Length(Result)+BlockSize);
  5588. end;
  5589. Var
  5590. Sep,LastSep,Len,Match : SizeInt;
  5591. T : String;
  5592. begin
  5593. S:=Self;
  5594. SetLength(Result,BlockSize);
  5595. Len:=0;
  5596. LastSep:=0;
  5597. Sep:=NextSep(0,Match);
  5598. While (Sep<>-1) and ((ACount=0) or (Len<ACount)) do
  5599. begin
  5600. T:=SubString(LastSep,Sep-LastSep);
  5601. If (T<>'') or (not (TStringSplitOptions.ExcludeEmpty=Options)) then
  5602. begin
  5603. MaybeGrow(Len);
  5604. Result[Len]:=T;
  5605. Inc(Len);
  5606. end;
  5607. LastSep:=Sep+System.Length(Separators[Match]);
  5608. Sep:=NextSep(LastSep,Match);
  5609. end;
  5610. if (LastSep<=Length) and ((ACount=0) or (Len<ACount)) then
  5611. begin
  5612. T:=SubString(LastSep);
  5613. // Writeln('Examining >',T,'< at pos,',LastSep,' till pos ',Sep);
  5614. If (T<>'') or (not (TStringSplitOptions.ExcludeEmpty=Options)) then
  5615. begin
  5616. MaybeGrow(Len);
  5617. Result[Len]:=T;
  5618. Inc(Len);
  5619. end;
  5620. end;
  5621. SetLength(Result,Len);
  5622. end;
  5623. function TStringHelper.StartsWith(const AValue: string): Boolean;
  5624. begin
  5625. Result:=StartsWith(AValue,False);
  5626. end;
  5627. function TStringHelper.StartsWith(const AValue: string; IgnoreCase: Boolean
  5628. ): Boolean;
  5629. Var
  5630. L : SizeInt;
  5631. S : String;
  5632. begin
  5633. L:=System.Length(AValue);
  5634. Result:=L<=0;
  5635. if not Result then
  5636. begin
  5637. S:=System.Copy(Self,1,L);
  5638. Result:=(System.Length(S)=L);
  5639. if Result then
  5640. if IgnoreCase then
  5641. Result:=SameText(S,aValue)
  5642. else
  5643. Result:=SameStr(S,AValue);
  5644. end;
  5645. end;
  5646. function TStringHelper.Substring(AStartIndex: SizeInt): string;
  5647. begin
  5648. Result:=Self.SubString(AStartIndex,Self.Length-AStartIndex);
  5649. end;
  5650. function TStringHelper.Substring(AStartIndex: SizeInt; ALen: SizeInt): string;
  5651. begin
  5652. Result:=system.Copy(Self,AStartIndex+1,ALen);
  5653. end;
  5654. function TStringHelper.ToBoolean: Boolean;
  5655. begin
  5656. Result:=StrToBool(Self);
  5657. end;
  5658. function TStringHelper.ToInteger: Integer;
  5659. begin
  5660. Result:=StrToInt(Self);
  5661. end;
  5662. function TStringHelper.ToNativeInt: NativeInt;
  5663. begin
  5664. Result:=StrToNativeInt(Self);
  5665. end;
  5666. function TStringHelper.ToDouble: Double;
  5667. begin
  5668. Result:=StrToFLoat(Self);
  5669. end;
  5670. function TStringHelper.ToExtended: Extended;
  5671. begin
  5672. Result:=StrToFLoat(Self);
  5673. end;
  5674. function TStringHelper.ToCharArray: TCharArray;
  5675. begin
  5676. Result:=ToCharArray(0,Self.Length);
  5677. end;
  5678. function TStringHelper.ToCharArray(AStartIndex: SizeInt; ALen: SizeInt
  5679. ): TCharArray;
  5680. Var
  5681. I : SizeInt;
  5682. begin
  5683. SetLength(Result,ALen);
  5684. For I:=0 to ALen-1 do
  5685. Result[I]:=Self[AStartIndex+I+1];
  5686. end;
  5687. function TStringHelper.ToLower: string;
  5688. begin
  5689. Result:=LowerCase(Self);
  5690. end;
  5691. function TStringHelper.ToLowerInvariant: string;
  5692. begin
  5693. Result:=LowerCase(Self);
  5694. end;
  5695. function TStringHelper.ToUpper: string;
  5696. begin
  5697. Result:=UpperCase(Self);
  5698. end;
  5699. function TStringHelper.ToUpperInvariant: string;
  5700. begin
  5701. Result:=UpperCase(Self);
  5702. end;
  5703. function TStringHelper.Trim: string;
  5704. begin
  5705. Result:=SysUtils.Trim(self);
  5706. end;
  5707. function TStringHelper.TrimLeft: string;
  5708. begin
  5709. Result:=SysUtils.TrimLeft(Self);
  5710. end;
  5711. function TStringHelper.TrimRight: string;
  5712. begin
  5713. Result:=SysUtils.TrimRight(Self);
  5714. end;
  5715. function TStringHelper.Trim(const ATrimChars: array of Char): string;
  5716. begin
  5717. Result:=Self.TrimLeft(ATrimChars).TrimRight(ATrimChars);
  5718. end;
  5719. function TStringHelper.TrimLeft(const ATrimChars: array of Char): string;
  5720. Var
  5721. I,Len : SizeInt;
  5722. begin
  5723. I:=1;
  5724. Len:=Self.Length;
  5725. While (I<=Len) and HaveChar(Self[i],ATrimChars) do Inc(I);
  5726. if I=1 then
  5727. Result:=Self
  5728. else if I>Len then
  5729. Result:=''
  5730. else
  5731. Result:=system.Copy(Self,I,Len-I+1);
  5732. end;
  5733. function TStringHelper.TrimRight(const ATrimChars: array of Char): string;
  5734. Var
  5735. I,Len : SizeInt;
  5736. begin
  5737. Len:=Self.Length;
  5738. I:=Len;
  5739. While (I>=1) and HaveChar(Self[i],ATrimChars) do Dec(I);
  5740. if I<1 then
  5741. Result:=''
  5742. else if I=Len then
  5743. Result:=Self
  5744. else
  5745. Result:=system.Copy(Self,1,I);
  5746. end;
  5747. function TStringHelper.TrimEnd(const ATrimChars: array of Char): string;
  5748. begin
  5749. Result:=TrimRight(ATrimChars);
  5750. end;
  5751. function TStringHelper.TrimStart(const ATrimChars: array of Char): string;
  5752. begin
  5753. Result:=TrimLeft(ATrimChars);
  5754. end;
  5755. { ---------------------------------------------------------------------
  5756. TDoubleHelper
  5757. ---------------------------------------------------------------------}
  5758. Class Function TDoubleHelper.IsNan(const AValue: Double): Boolean; overload; inline;
  5759. begin
  5760. Result:=JS.jsIsNaN(AValue);
  5761. end;
  5762. Class Function TDoubleHelper.IsInfinity(const AValue: Double): Boolean; overload; inline;
  5763. begin
  5764. Result:=Not jsIsFinite(aValue);
  5765. end;
  5766. Class Function TDoubleHelper.IsNegativeInfinity(const AValue: Double): Boolean; overload; inline;
  5767. begin
  5768. asm
  5769. return (AValue=Number.NEGATIVE_INFINITY);
  5770. end;
  5771. Result:=aValue=0; // Fool compiler
  5772. end;
  5773. Class Function TDoubleHelper.IsPositiveInfinity(const AValue: Double): Boolean; overload; inline;
  5774. begin
  5775. asm
  5776. return (AValue=Number.POSITIVE_INFINITY);
  5777. end;
  5778. Result:=aValue=0; // Fool compiler.
  5779. end;
  5780. Class Function TDoubleHelper.Parse(const AString: string): Double; overload; inline;
  5781. begin
  5782. Result:=StrToFloat(AString);
  5783. end;
  5784. Class Function TDoubleHelper.ToString(const AValue: Double): string; overload; inline;
  5785. begin
  5786. Result:=FloatToStr(AValue);
  5787. end;
  5788. Class Function TDoubleHelper.ToString(const AValue: Double; const AFormat: TFloatFormat; const APrecision, ADigits: Integer): string; overload; inline;
  5789. begin
  5790. Result:=FloatToStrF(AValue,AFormat,APrecision,ADigits);
  5791. end;
  5792. Class Function TDoubleHelper.TryParse(const AString: string; out AValue: Double): Boolean; overload; inline;
  5793. begin
  5794. Result:=TryStrToFloat(AString,AValue);
  5795. end;
  5796. Function TDoubleHelper.GetB(AIndex: Cardinal): Byte;
  5797. var
  5798. F : TJSFloat64Array;
  5799. B : TJSUInt8array;
  5800. begin
  5801. F:=TJSFloat64Array.New(1);
  5802. B:=TJSUInt8array.New(F.Buffer);
  5803. F[0]:=Self;
  5804. Result:=B[AIndex];
  5805. end;
  5806. Function TDoubleHelper.GetW(AIndex: Cardinal): Word;
  5807. var
  5808. F : TJSFloat64Array;
  5809. W : TJSUInt16array;
  5810. begin
  5811. F:=TJSFloat64Array.New(1);
  5812. W:=TJSUInt16array.New(F.Buffer);
  5813. F[0]:=Self;
  5814. Result:=W[AIndex];
  5815. end;
  5816. Type
  5817. TFloatParts = Record
  5818. sign : boolean;
  5819. exp : integer;
  5820. mantissa : double;
  5821. end;
  5822. // See https://stackoverflow.com/questions/9383593/extracting-the-exponent-and-mantissa-of-a-javascript-number
  5823. Function FloatToParts(aValue : Double) : TFloatParts;
  5824. var
  5825. F : TJSFloat64Array;
  5826. B : TJSUInt8array;
  5827. begin
  5828. F:=TJSFloat64Array.New(1);
  5829. B:=TJSUInt8array.New(F.Buffer);
  5830. F[0]:=aValue;
  5831. Result.Sign:=(B[7] shr 7)=0;
  5832. Result.exp:=(((B[7] and $7f) shl 4) or (B[6] shr 4))- $3ff;
  5833. B[3]:=$3F;
  5834. B[6]:=B[6] or $F0;
  5835. Result.Mantissa:=F[0];
  5836. end;
  5837. Function TDoubleHelper.GetE: NativeUInt; inline;
  5838. begin
  5839. Result:=FloatToParts(Self).Exp;
  5840. end;
  5841. Function TDoubleHelper.GetF: NativeUInt; inline;
  5842. begin
  5843. Result:=0;
  5844. NotImplemented('GetF');
  5845. end;
  5846. Function TDoubleHelper.GetS: Boolean; inline;
  5847. begin
  5848. Result:=FloatToParts(Self).Sign;
  5849. end;
  5850. procedure TDoubleHelper.SetB(AIndex: Cardinal; const AValue: Byte);
  5851. var
  5852. F : TJSFloat64Array;
  5853. B : TJSUInt8array;
  5854. begin
  5855. if (AIndex>=8) then
  5856. raise ERangeError.Create(SRangeError);
  5857. F:=TJSFloat64Array.New(1);
  5858. B:=TJSUInt8array.New(F.Buffer);
  5859. F[0]:=Self;
  5860. B[AIndex]:=aValue;
  5861. Self:=F[0];
  5862. end;
  5863. procedure TDoubleHelper.SetW(AIndex: Cardinal; const AValue: Word);
  5864. Var
  5865. F : TJSFloat64Array;
  5866. W : TJSUInt16array;
  5867. begin
  5868. if (AIndex>=4) then
  5869. raise ERangeError.Create(SRangeError);
  5870. F:=TJSFloat64Array.New(1);
  5871. W:=TJSUInt16array.New(F.Buffer);
  5872. F[0]:=Self;
  5873. W[AIndex]:=aValue;
  5874. Self:=F[0];
  5875. end;
  5876. procedure TDoubleHelper.SetS(AValue: Boolean);
  5877. Var
  5878. F : TJSFloat64Array;
  5879. B : TJSUInt8array;
  5880. begin
  5881. F:=TJSFloat64Array.New(1);
  5882. B:=TJSUInt8array.New(F.Buffer);
  5883. F[0]:=Self;
  5884. if aValue then
  5885. B[7]:=B[7] or (1 shr 7)
  5886. else
  5887. B[7]:=B[7] and not (1 shr 7);
  5888. Self:=F[0];
  5889. end;
  5890. Procedure TDoubleHelper.BuildUp(const ASignFlag: Boolean; const AMantissa: NativeUInt; const AExponent: Integer);
  5891. begin
  5892. NotImplemented('BuildUp');
  5893. // Following statement is just to fool the compiler
  5894. if ASignFlag and (AMantissa>0) and (AExponent<0) then exit;
  5895. // TFloatRec(Self).BuildUp(ASignFlag, AMantissa, AExponent);
  5896. end;
  5897. Function TDoubleHelper.Exponent: Integer;
  5898. begin
  5899. Result:=FloatToParts(Self).Exp;
  5900. end;
  5901. Function TDoubleHelper.Fraction: Extended;
  5902. begin
  5903. Result:=system.Frac(Self);
  5904. end;
  5905. Function TDoubleHelper.IsInfinity: Boolean; overload; inline;
  5906. begin
  5907. Result:=Double.IsInfinity(Self);
  5908. end;
  5909. Function TDoubleHelper.IsNan: Boolean; overload; inline;
  5910. begin
  5911. Result:=Double.IsNan(Self);
  5912. end;
  5913. Function TDoubleHelper.IsNegativeInfinity: Boolean; overload; inline;
  5914. begin
  5915. Result:=Double.IsNegativeInfinity(Self);
  5916. end;
  5917. Function TDoubleHelper.IsPositiveInfinity: Boolean; overload; inline;
  5918. begin
  5919. Result:=Double.IsPositiveInfinity(Self);
  5920. end;
  5921. Function TDoubleHelper.Mantissa: NativeUInt;
  5922. begin
  5923. Result:=Trunc(FloatToParts(Self).mantissa);
  5924. end;
  5925. Function TDoubleHelper.ToString(const AFormat: TFloatFormat; const APrecision, ADigits: Integer): string; overload; inline;
  5926. begin
  5927. Result:=FloatToStrF(Self,AFormat,APrecision,ADigits);
  5928. end;
  5929. Function TDoubleHelper.ToString: string; overload; inline;
  5930. begin
  5931. Result:=FloatToStr(Self);
  5932. end;
  5933. { ---------------------------------------------------------------------
  5934. TByteHelper
  5935. ---------------------------------------------------------------------}
  5936. Class Function TByteHelper.Parse(const AString: string): Byte; inline;
  5937. begin
  5938. Result:=StrToInt(AString);
  5939. end;
  5940. Class Function TByteHelper.Size: Integer; inline;
  5941. begin
  5942. Result:=1;
  5943. end;
  5944. Class Function TByteHelper.ToString(const AValue: Byte): string; overload; inline;
  5945. begin
  5946. Result:=IntToStr(AValue);
  5947. end;
  5948. Class Function TByteHelper.TryParse(const AString: string; out AValue: Byte): Boolean; inline;
  5949. Var
  5950. C : Integer;
  5951. begin
  5952. Val(AString,AValue,C);
  5953. Result:=(C=0);
  5954. end;
  5955. Function TByteHelper.ToBoolean: Boolean; inline;
  5956. begin
  5957. Result:=(Self<>0);
  5958. end;
  5959. Function TByteHelper.ToDouble: Double; inline;
  5960. begin
  5961. Result:=Self;
  5962. end;
  5963. Function TByteHelper.ToExtended: Extended; inline;
  5964. begin
  5965. Result:=Self;
  5966. end;
  5967. Function TByteHelper.ToBinString: string; inline;
  5968. begin
  5969. Result:=BinStr(Self,Size*8);
  5970. end;
  5971. Function TByteHelper.ToHexString(const AMinDigits: Integer): string;
  5972. overload; inline;
  5973. begin
  5974. Result:=IntToHex(Self,AMinDigits);
  5975. end;
  5976. Function TByteHelper.ToHexString: string; overload; inline;
  5977. begin
  5978. Result:=IntToHex(Self,Size*2);
  5979. end;
  5980. Function TByteHelper.ToString: string; overload; inline;
  5981. begin
  5982. Result:=IntToStr(Self);
  5983. end;
  5984. Function TByteHelper.SetBit(const index: TByteBitIndex) : Byte; inline;
  5985. begin
  5986. Self := Self or (Byte(1) shl index);
  5987. Result:=Self;
  5988. end;
  5989. Function TByteHelper.ClearBit(const index: TByteBitIndex) : Byte; inline;
  5990. begin
  5991. Self:=Self and not Byte((Byte(1) shl index));
  5992. Result:=Self;
  5993. end;
  5994. Function TByteHelper.ToggleBit(const index: TByteBitIndex) : Byte; inline;
  5995. begin
  5996. Self := Self xor Byte((Byte(1) shl index));
  5997. Result:=Self;
  5998. end;
  5999. Function TByteHelper.TestBit(const Index: TByteBitIndex):Boolean; inline;
  6000. begin
  6001. Result := (Self and Byte((Byte(1) shl index)))<>0;
  6002. end;
  6003. { ---------------------------------------------------------------------
  6004. TShortintHelper
  6005. ---------------------------------------------------------------------}
  6006. Class Function TShortIntHelper.Parse(const AString: string): ShortInt; inline;
  6007. begin
  6008. Result:=StrToInt(AString);
  6009. end;
  6010. Class Function TShortIntHelper.Size: Integer; inline;
  6011. begin
  6012. Result:=1;
  6013. end;
  6014. Class Function TShortIntHelper.ToString(const AValue: ShortInt): string; overload; inline;
  6015. begin
  6016. Result:=IntToStr(AValue);
  6017. end;
  6018. Class Function TShortIntHelper.TryParse(const AString: string; out AValue: ShortInt): Boolean; inline;
  6019. Var
  6020. C : Integer;
  6021. begin
  6022. Val(AString,AValue,C);
  6023. Result:=(C=0);
  6024. end;
  6025. Function TShortIntHelper.ToBoolean: Boolean; inline;
  6026. begin
  6027. Result:=(Self<>0);
  6028. end;
  6029. Function TShortIntHelper.ToDouble: Double; inline;
  6030. begin
  6031. Result:=Self;
  6032. end;
  6033. Function TShortIntHelper.ToExtended: Extended; inline;
  6034. begin
  6035. Result:=Self;
  6036. end;
  6037. Function TShortIntHelper.ToBinString: string; inline;
  6038. begin
  6039. Result:=BinStr(Self,Size*8);
  6040. end;
  6041. Function TShortIntHelper.ToHexString(const AMinDigits: Integer): string; overload; inline;
  6042. Var
  6043. B : Word;
  6044. U : TJSUInt8Array;
  6045. S : TJSInt8array;
  6046. begin
  6047. if Self>=0 then
  6048. B:=Self
  6049. else
  6050. begin
  6051. S:=TJSInt8Array.New(1);
  6052. S[0]:=Self;
  6053. U:=TJSUInt8Array.New(S);
  6054. B:=U[0];
  6055. if AMinDigits>2 then
  6056. B:=$FF00+B;
  6057. end;
  6058. Result:=IntToHex(B,AMinDigits);
  6059. end;
  6060. Function TShortIntHelper.ToHexString: string; overload; inline;
  6061. begin
  6062. Result:=ToHexString(Size*2);
  6063. end;
  6064. Function TShortIntHelper.ToString: string; overload; inline;
  6065. begin
  6066. Result:=IntToStr(Self);
  6067. end;
  6068. Function TShortIntHelper.SetBit(const index: TShortIntBitIndex) : ShortInt; inline;
  6069. begin
  6070. Self := Self or (ShortInt(1) shl index);
  6071. Result:=Self;
  6072. end;
  6073. Function TShortIntHelper.ClearBit(const index: TShortIntBitIndex) : ShortInt; inline;
  6074. begin
  6075. Self:=Self and not ShortInt((ShortInt(1) shl index));
  6076. Result:=Self;
  6077. end;
  6078. Function TShortIntHelper.ToggleBit(const index: TShortIntBitIndex) : ShortInt; inline;
  6079. begin
  6080. Self := Self xor ShortInt((ShortInt(1) shl index));
  6081. Result:=Self;
  6082. end;
  6083. Function TShortIntHelper.TestBit(const Index: TShortIntBitIndex):Boolean; inline;
  6084. begin
  6085. Result := (Self and ShortInt((ShortInt(1) shl index)))<>0;
  6086. end;
  6087. { ---------------------------------------------------------------------
  6088. TSmallintHelper
  6089. ---------------------------------------------------------------------}
  6090. Class Function TSmallIntHelper.Parse(const AString: string): SmallInt; inline;
  6091. begin
  6092. Result:=StrToInt(AString);
  6093. end;
  6094. Class Function TSmallIntHelper.Size: Integer; inline;
  6095. begin
  6096. Result:=2;
  6097. end;
  6098. Class Function TSmallIntHelper.ToString(const AValue: SmallInt): string; overload; inline;
  6099. begin
  6100. Result:=IntToStr(AValue);
  6101. end;
  6102. Class Function TSmallIntHelper.TryParse(const AString: string; out AValue: SmallInt): Boolean; inline;
  6103. Var
  6104. C : Integer;
  6105. begin
  6106. Val(AString,AValue,C);
  6107. Result:=(C=0);
  6108. end;
  6109. Function TSmallIntHelper.ToBoolean: Boolean; inline;
  6110. begin
  6111. Result:=(Self<>0);
  6112. end;
  6113. Function TSmallIntHelper.ToDouble: Double; inline;
  6114. begin
  6115. Result:=Self;
  6116. end;
  6117. Function TSmallIntHelper.ToExtended: Extended; inline;
  6118. begin
  6119. Result:=Self;
  6120. end;
  6121. Function TSmallIntHelper.ToBinString: string; inline;
  6122. begin
  6123. Result:=BinStr(Self,Size*8);
  6124. end;
  6125. Function TSmallIntHelper.ToHexString(const AMinDigits: Integer): string; overload; inline;
  6126. Var
  6127. B : Cardinal;
  6128. U : TJSUInt16Array;
  6129. S : TJSInt16array;
  6130. begin
  6131. if Self>=0 then
  6132. B:=Self
  6133. else
  6134. begin
  6135. S:=TJSInt16Array.New(1);
  6136. S[0]:=Self;
  6137. U:=TJSUInt16Array.New(S);
  6138. B:=U[0];
  6139. if AMinDigits>6 then
  6140. B:=$FFFF0000+B
  6141. else if AMinDigits>4 then
  6142. B:=$FF0000+B;
  6143. end;
  6144. Result:=IntToHex(B,AMinDigits);
  6145. end;
  6146. Function TSmallIntHelper.ToHexString: string; overload; inline;
  6147. begin
  6148. Result:=ToHexString(Size*2);
  6149. end;
  6150. Function TSmallIntHelper.ToString: string; overload; inline;
  6151. begin
  6152. Result:=IntToStr(Self);
  6153. end;
  6154. Function TSmallIntHelper.SetBit(const index: TSmallIntBitIndex) : SmallInt; inline;
  6155. begin
  6156. Self := Self or (SmallInt(1) shl index);
  6157. Result:=Self;
  6158. end;
  6159. Function TSmallIntHelper.ClearBit(const index: TSmallIntBitIndex) : SmallInt; inline;
  6160. begin
  6161. Self:=Self and not SmallInt((SmallInt(1) shl index));
  6162. Result:=Self;
  6163. end;
  6164. Function TSmallIntHelper.ToggleBit(const index: TSmallIntBitIndex) : SmallInt; inline;
  6165. begin
  6166. Self := Self xor SmallInt((SmallInt(1) shl index));
  6167. Result:=Self;
  6168. end;
  6169. Function TSmallIntHelper.TestBit(const Index: TSmallIntBitIndex):Boolean; inline;
  6170. begin
  6171. Result := (Self and SmallInt((SmallInt(1) shl index)))<>0;
  6172. end;
  6173. { ---------------------------------------------------------------------
  6174. TWordHelper
  6175. ---------------------------------------------------------------------}
  6176. Class Function TWordHelper.Parse(const AString: string): Word; inline;
  6177. begin
  6178. Result:=StrToInt(AString);
  6179. end;
  6180. Class Function TWordHelper.Size: Integer; inline;
  6181. begin
  6182. Result:=2;
  6183. end;
  6184. Class Function TWordHelper.ToString(const AValue: Word): string; overload; inline;
  6185. begin
  6186. Result:=IntToStr(AValue);
  6187. end;
  6188. Class Function TWordHelper.TryParse(const AString: string; out AValue: Word): Boolean; inline;
  6189. Var
  6190. C : Integer;
  6191. begin
  6192. Val(AString,AValue,C);
  6193. Result:=(C=0);
  6194. end;
  6195. Function TWordHelper.ToBoolean: Boolean; inline;
  6196. begin
  6197. Result:=(Self<>0);
  6198. end;
  6199. Function TWordHelper.ToDouble: Double; inline;
  6200. begin
  6201. Result:=Self;
  6202. end;
  6203. Function TWordHelper.ToExtended: Extended; inline;
  6204. begin
  6205. Result:=Self;
  6206. end;
  6207. Function TWordHelper.ToBinString: string; inline;
  6208. begin
  6209. Result:=BinStr(Self,Size*8);
  6210. end;
  6211. Function TWordHelper.ToHexString(const AMinDigits: Integer): string;
  6212. overload; inline;
  6213. begin
  6214. Result:=IntToHex(Self,AMinDigits);
  6215. end;
  6216. Function TWordHelper.ToHexString: string; overload; inline;
  6217. begin
  6218. Result:=IntToHex(Self,Size*2);
  6219. end;
  6220. Function TWordHelper.ToString: string; overload; inline;
  6221. begin
  6222. Result:=IntToStr(Self);
  6223. end;
  6224. Function TWordHelper.SetBit(const index: TWordBitIndex) : Word; inline;
  6225. begin
  6226. Self := Self or (Word(1) shl index);
  6227. Result:=Self;
  6228. end;
  6229. Function TWordHelper.ClearBit(const index: TWordBitIndex) : Word; inline;
  6230. begin
  6231. Self:=Self and not Word((Word(1) shl index));
  6232. Result:=Self;
  6233. end;
  6234. Function TWordHelper.ToggleBit(const index: TWordBitIndex) : Word; inline;
  6235. begin
  6236. Self := Self xor Word((Word(1) shl index));
  6237. Result:=Self;
  6238. end;
  6239. Function TWordHelper.TestBit(const Index: TWordBitIndex):Boolean; inline;
  6240. begin
  6241. Result := (Self and Word((Word(1) shl index)))<>0;
  6242. end;
  6243. { ---------------------------------------------------------------------
  6244. TCardinalHelper
  6245. ---------------------------------------------------------------------}
  6246. Class Function TCardinalHelper.Parse(const AString: string): Cardinal; inline;
  6247. begin
  6248. Result:=StrToInt(AString);
  6249. end;
  6250. Class Function TCardinalHelper.Size: Integer; inline;
  6251. begin
  6252. Result:=4;
  6253. end;
  6254. Class Function TCardinalHelper.ToString(const AValue: Cardinal): string; overload; inline;
  6255. begin
  6256. Result:=IntToStr(AValue);
  6257. end;
  6258. Class Function TCardinalHelper.TryParse(const AString: string; out AValue: Cardinal): Boolean; inline;
  6259. Var
  6260. C : Integer;
  6261. begin
  6262. Val(AString,AValue,C);
  6263. Result:=(C=0);
  6264. end;
  6265. Function TCardinalHelper.ToBoolean: Boolean; inline;
  6266. begin
  6267. Result:=(Self<>0);
  6268. end;
  6269. Function TCardinalHelper.ToDouble: Double; inline;
  6270. begin
  6271. Result:=Self;
  6272. end;
  6273. Function TCardinalHelper.ToExtended: Extended; inline;
  6274. begin
  6275. Result:=Self;
  6276. end;
  6277. Function TCardinalHelper.ToBinString: string; inline;
  6278. begin
  6279. Result:=BinStr(Self,Size*8);
  6280. end;
  6281. Function TCardinalHelper.ToHexString(const AMinDigits: Integer): string;
  6282. overload; inline;
  6283. begin
  6284. Result:=IntToHex(Self,AMinDigits);
  6285. end;
  6286. Function TCardinalHelper.ToHexString: string; overload; inline;
  6287. begin
  6288. Result:=ToHexString(Size*2);
  6289. end;
  6290. Function TCardinalHelper.ToString: string; overload; inline;
  6291. begin
  6292. Result:=IntToStr(Self);
  6293. end;
  6294. Function TCardinalHelper.SetBit(const index: TCardinalBitIndex) : Cardinal; inline;
  6295. begin
  6296. Self := Self or (Cardinal(1) shl index);
  6297. Result:=Self;
  6298. end;
  6299. Function TCardinalHelper.ClearBit(const index: TCardinalBitIndex) : Cardinal; inline;
  6300. begin
  6301. Self:=Self and not Cardinal((Cardinal(1) shl index));
  6302. Result:=Self;
  6303. end;
  6304. Function TCardinalHelper.ToggleBit(const index: TCardinalBitIndex) : Cardinal; inline;
  6305. begin
  6306. Self := Self xor Cardinal((Cardinal(1) shl index));
  6307. Result:=Self;
  6308. end;
  6309. Function TCardinalHelper.TestBit(const Index: TCardinalBitIndex):Boolean; inline;
  6310. begin
  6311. Result := (Self and Cardinal((Cardinal(1) shl index)))<>0;
  6312. end;
  6313. { ---------------------------------------------------------------------
  6314. TIntegerHelper
  6315. ---------------------------------------------------------------------}
  6316. Class Function TIntegerHelper.Parse(const AString: string): Integer; inline;
  6317. begin
  6318. Result:=StrToInt(AString);
  6319. end;
  6320. Class Function TIntegerHelper.Size: Integer; inline;
  6321. begin
  6322. Result:=4;
  6323. end;
  6324. Class Function TIntegerHelper.ToString(const AValue: Integer): string; overload; inline;
  6325. begin
  6326. Result:=IntToStr(AValue);
  6327. end;
  6328. Class Function TIntegerHelper.TryParse(const AString: string; out AValue: Integer): Boolean; inline;
  6329. Var
  6330. C : Integer;
  6331. begin
  6332. Val(AString,AValue,C);
  6333. Result:=(C=0);
  6334. end;
  6335. Function TIntegerHelper.ToBoolean: Boolean; inline;
  6336. begin
  6337. Result:=(Self<>0);
  6338. end;
  6339. Function TIntegerHelper.ToDouble: Double; inline;
  6340. begin
  6341. Result:=Self;
  6342. end;
  6343. Function TIntegerHelper.ToExtended: Extended; inline;
  6344. begin
  6345. Result:=Self;
  6346. end;
  6347. Function TIntegerHelper.ToBinString: string; inline;
  6348. begin
  6349. Result:=BinStr(Self,Size*8);
  6350. end;
  6351. Function TIntegerHelper.ToHexString(const AMinDigits: Integer): string;
  6352. overload; inline;
  6353. Var
  6354. B : Word;
  6355. U : TJSUInt32Array;
  6356. S : TJSInt32array;
  6357. begin
  6358. if Self>=0 then
  6359. B:=Self
  6360. else
  6361. begin
  6362. S:=TJSInt32Array.New(1);
  6363. S[0]:=Self;
  6364. U:=TJSUInt32Array.New(S);
  6365. B:=U[0];
  6366. end;
  6367. Result:=IntToHex(B,AMinDigits);
  6368. end;
  6369. Function TIntegerHelper.ToHexString: string; overload; inline;
  6370. begin
  6371. Result:=ToHexString(Size*2);
  6372. end;
  6373. Function TIntegerHelper.ToString: string; overload; inline;
  6374. begin
  6375. Result:=IntToStr(Self);
  6376. end;
  6377. Function TIntegerHelper.SetBit(const index: TIntegerBitIndex) : Integer; inline;
  6378. begin
  6379. Self := Self or (Integer(1) shl index);
  6380. Result:=Self;
  6381. end;
  6382. Function TIntegerHelper.ClearBit(const index: TIntegerBitIndex) : Integer; inline;
  6383. begin
  6384. Self:=Self and not Integer((Integer(1) shl index));
  6385. Result:=Self;
  6386. end;
  6387. Function TIntegerHelper.ToggleBit(const index: TIntegerBitIndex) : Integer; inline;
  6388. begin
  6389. Self := Self xor Integer((Integer(1) shl index));
  6390. Result:=Self;
  6391. end;
  6392. Function TIntegerHelper.TestBit(const Index: TIntegerBitIndex):Boolean; inline;
  6393. begin
  6394. Result := (Self and Integer((Integer(1) shl index)))<>0;
  6395. end;
  6396. { ---------------------------------------------------------------------
  6397. TNativeIntHelper
  6398. ---------------------------------------------------------------------}
  6399. Class Function TNativeIntHelper.Parse(const AString: string): NativeInt; inline;
  6400. begin
  6401. Result:=StrToInt(AString);
  6402. end;
  6403. Class Function TNativeIntHelper.Size: Integer; inline;
  6404. begin
  6405. Result:=7;
  6406. end;
  6407. Class Function TNativeIntHelper.ToString(const AValue: NativeInt): string; overload; inline;
  6408. begin
  6409. Result:=IntToStr(AValue);
  6410. end;
  6411. Class Function TNativeIntHelper.TryParse(const AString: string; out AValue: NativeInt): Boolean; inline;
  6412. Var
  6413. C : Integer;
  6414. begin
  6415. Val(AString,AValue,C);
  6416. Result:=(C=0);
  6417. end;
  6418. Function TNativeIntHelper.ToBoolean: Boolean; inline;
  6419. begin
  6420. Result:=(Self<>0);
  6421. end;
  6422. Function TNativeIntHelper.ToDouble: Double; inline;
  6423. begin
  6424. Result:=Self;
  6425. end;
  6426. Function TNativeIntHelper.ToExtended: Extended; inline;
  6427. begin
  6428. Result:=Self;
  6429. end;
  6430. Function TNativeIntHelper.ToBinString: string; inline;
  6431. begin
  6432. Result:=BinStr(Self,Size*8);
  6433. end;
  6434. Function TNativeIntHelper.ToHexString(const AMinDigits: Integer): string;
  6435. overload; inline;
  6436. begin
  6437. Result:=IntToHex(Self,AMinDigits);
  6438. end;
  6439. Function TNativeIntHelper.ToHexString: string; overload; inline;
  6440. begin
  6441. Result:=IntToHex(Self,Size*2);
  6442. end;
  6443. Function TNativeIntHelper.ToString: string; overload; inline;
  6444. begin
  6445. Result:=IntToStr(Self);
  6446. end;
  6447. Function TNativeIntHelper.SetBit(const index: TNativeIntBitIndex) : NativeInt; inline;
  6448. begin
  6449. Self := Self or (NativeInt(1) shl index);
  6450. Result:=Self;
  6451. end;
  6452. Function TNativeIntHelper.ClearBit(const index: TNativeIntBitIndex) : NativeInt; inline;
  6453. begin
  6454. Self:=Self and not NativeInt((NativeInt(1) shl index));
  6455. Result:=Self;
  6456. end;
  6457. Function TNativeIntHelper.ToggleBit(const index: TNativeIntBitIndex) : NativeInt; inline;
  6458. begin
  6459. Self := Self xor NativeInt((NativeInt(1) shl index));
  6460. Result:=Self;
  6461. end;
  6462. Function TNativeIntHelper.TestBit(const Index: TNativeIntBitIndex):Boolean; inline;
  6463. begin
  6464. Result := (Self and NativeInt((NativeInt(1) shl index)))<>0;
  6465. end;
  6466. { ---------------------------------------------------------------------
  6467. TNativeUIntHelper
  6468. ---------------------------------------------------------------------}
  6469. Class Function TNativeUIntHelper.Parse(const AString: string): NativeUInt; inline;
  6470. begin
  6471. Result:=StrToInt(AString);
  6472. end;
  6473. Class Function TNativeUIntHelper.Size: Integer; inline;
  6474. begin
  6475. Result:=7;
  6476. end;
  6477. Class Function TNativeUIntHelper.ToString(const AValue: NativeUInt): string; overload; inline;
  6478. begin
  6479. Result:=IntToStr(AValue);
  6480. end;
  6481. Class Function TNativeUIntHelper.TryParse(const AString: string; out AValue: NativeUInt): Boolean; inline;
  6482. Var
  6483. C : Integer;
  6484. begin
  6485. Val(AString,AValue,C);
  6486. Result:=(C=0);
  6487. end;
  6488. Function TNativeUIntHelper.ToBoolean: Boolean; inline;
  6489. begin
  6490. Result:=(Self<>0);
  6491. end;
  6492. Function TNativeUIntHelper.ToDouble: Double; inline;
  6493. begin
  6494. Result:=Self;
  6495. end;
  6496. Function TNativeUIntHelper.ToExtended: Extended; inline;
  6497. begin
  6498. Result:=Self;
  6499. end;
  6500. Function TNativeUIntHelper.ToBinString: string; inline;
  6501. begin
  6502. Result:=BinStr(Self,Size*8);
  6503. end;
  6504. Function TNativeUIntHelper.ToHexString(const AMinDigits: Integer): string;
  6505. overload; inline;
  6506. begin
  6507. Result:=IntToHex(Self,AMinDigits);
  6508. end;
  6509. Function TNativeUIntHelper.ToHexString: string; overload; inline;
  6510. begin
  6511. Result:=IntToHex(Self,Size*2);
  6512. end;
  6513. Function TNativeUIntHelper.ToSingle: Single; inline;
  6514. begin
  6515. Result:=Self;
  6516. end;
  6517. Function TNativeUIntHelper.ToString: string; overload; inline;
  6518. begin
  6519. Result:=IntToStr(Self);
  6520. end;
  6521. Function TNativeUIntHelper.SetBit(const index: TNativeUIntBitIndex) : NativeUInt; inline;
  6522. begin
  6523. Self := Self or (NativeUInt(1) shl index);
  6524. Result:=Self;
  6525. end;
  6526. Function TNativeUIntHelper.ClearBit(const index: TNativeUIntBitIndex) : NativeUInt; inline;
  6527. begin
  6528. Self:=Self and not NativeUInt((NativeUInt(1) shl index));
  6529. Result:=Self;
  6530. end;
  6531. Function TNativeUIntHelper.ToggleBit(const index: TNativeUIntBitIndex) : NativeUInt; inline;
  6532. begin
  6533. Self := Self xor NativeUInt((NativeUInt(1) shl index));
  6534. Result:=Self;
  6535. end;
  6536. Function TNativeUIntHelper.TestBit(const Index: TNativeUIntBitIndex):Boolean; inline;
  6537. begin
  6538. Result := (Self and NativeUInt((NativeUInt(1) shl index)))<>0;
  6539. end;
  6540. { ---------------------------------------------------------------------
  6541. TBooleanHelper
  6542. ---------------------------------------------------------------------}
  6543. Class Function TBooleanHelper.Parse(const S: string): Boolean; inline;
  6544. begin
  6545. Result:=StrToBool(S);
  6546. end;
  6547. Class Function TBooleanHelper.Size: Integer; inline;
  6548. begin
  6549. Result:=1;
  6550. end;
  6551. Class Function TBooleanHelper.ToString(const AValue: Boolean; UseBoolStrs: TUseBoolStrs = TUseBoolStrs.False): string; overload; inline;
  6552. begin
  6553. Result:=BoolToStr(AValue,UseBoolStrs=TUseBoolStrs.True);
  6554. end;
  6555. Class Function TBooleanHelper.TryToParse(const S: string; out AValue: Boolean): Boolean; inline;
  6556. begin
  6557. Result:=TryStrToBool(S,AValue);
  6558. end;
  6559. Function TBooleanHelper.ToInteger: Integer; inline;
  6560. begin
  6561. Result:=Integer(Self);
  6562. end;
  6563. Function TBooleanHelper.ToString(UseBoolStrs: TUseBoolStrs = TUseBoolStrs.False): string; overload; inline;
  6564. begin
  6565. Result:=BoolToStr(Self,UseBoolStrs=TUseBoolStrs.True);
  6566. end;
  6567. { ---------------------------------------------------------------------
  6568. TByteBoolHelper
  6569. ---------------------------------------------------------------------}
  6570. Class Function TByteBoolHelper.Parse(const S: string): Boolean; inline;
  6571. begin
  6572. Result:=StrToBool(S);
  6573. end;
  6574. Class Function TByteBoolHelper.Size: Integer; inline;
  6575. begin
  6576. Result:=1;
  6577. end;
  6578. Class Function TByteBoolHelper.ToString(const AValue: Boolean; UseBoolStrs: Boolean = False): string; overload; inline;
  6579. begin
  6580. Result:=BoolToStr(AValue,UseBoolStrs);
  6581. end;
  6582. Class Function TByteBoolHelper.TryToParse(const S: string; out AValue: Boolean): Boolean; inline;
  6583. begin
  6584. Result:=TryStrToBool(S,AValue);
  6585. end;
  6586. Function TByteBoolHelper.ToInteger: Integer; inline;
  6587. begin
  6588. Result:=Integer(Self);
  6589. end;
  6590. Function TByteBoolHelper.ToString(UseBoolStrs: Boolean = False): string; overload; inline;
  6591. begin
  6592. Result:=BoolToStr(Self,UseBoolStrs);
  6593. end;
  6594. { ---------------------------------------------------------------------
  6595. TWordBoolHelper
  6596. ---------------------------------------------------------------------}
  6597. Class Function TWordBoolHelper.Parse(const S: string): Boolean; inline;
  6598. begin
  6599. Result:=StrToBool(S);
  6600. end;
  6601. Class Function TWordBoolHelper.Size: Integer; inline;
  6602. begin
  6603. Result:=2;
  6604. end;
  6605. Class Function TWordBoolHelper.ToString(const AValue: Boolean; UseBoolStrs: boolean = False): string; overload; inline;
  6606. begin
  6607. Result:=BoolToStr(AValue,UseBoolStrs);
  6608. end;
  6609. Class Function TWordBoolHelper.TryToParse(const S: string; out AValue: Boolean): Boolean; inline;
  6610. begin
  6611. Result:=TryStrToBool(S,AValue);
  6612. end;
  6613. Function TWordBoolHelper.ToInteger: Integer; inline;
  6614. begin
  6615. Result:=Integer(Self);
  6616. end;
  6617. Function TWordBoolHelper.ToString(UseBoolStrs: Boolean = False): string; overload; inline;
  6618. begin
  6619. Result:=BoolToStr(Self,UseBoolStrs);
  6620. end;
  6621. { ---------------------------------------------------------------------
  6622. TLongBoolHelper
  6623. ---------------------------------------------------------------------}
  6624. Class Function TLongBoolHelper.Parse(const S: string): Boolean; inline;
  6625. begin
  6626. Result:=StrToBool(S);
  6627. end;
  6628. Class Function TLongBoolHelper.Size: Integer; inline;
  6629. begin
  6630. Result:=4;
  6631. end;
  6632. Class Function TLongBoolHelper.ToString(const AValue: Boolean; UseBoolStrs: Boolean = False): string; overload; inline;
  6633. begin
  6634. Result:=BoolToStr(AValue,UseBoolStrs);
  6635. end;
  6636. Class Function TLongBoolHelper.TryToParse(const S: string; out AValue: Boolean): Boolean; inline;
  6637. begin
  6638. Result:=TryStrToBool(S,AValue);
  6639. end;
  6640. Function TLongBoolHelper.ToInteger: Integer; inline;
  6641. begin
  6642. Result:=Integer(Self);
  6643. end;
  6644. Function TLongBoolHelper.ToString(UseBoolStrs: Boolean = False): string; overload; inline;
  6645. begin
  6646. Result:=BoolToStr(Self,UseBoolStrs);
  6647. end;
  6648. { TStringBuilder }
  6649. constructor TStringBuilder.Create;
  6650. begin
  6651. Create(DefaultCapacity,Maxint);
  6652. end;
  6653. constructor TStringBuilder.Create(const AValue: String; aCapacity: Integer);
  6654. begin
  6655. Create(aCapacity,Maxint);
  6656. if (system.Length(AValue)>0) then
  6657. Append(AValue);
  6658. end;
  6659. constructor TStringBuilder.Create(const AValue: String; StartIndex, Alength,
  6660. aCapacity: Integer);
  6661. begin
  6662. Create(Copy(AValue,StartIndex+1,Alength), aCapacity);
  6663. end;
  6664. constructor TStringBuilder.Create(aCapacity, aMaxCapacity: Integer);
  6665. begin
  6666. FMaxCapacity:=aMaxCapacity;
  6667. Capacity:=aCapacity;
  6668. end;
  6669. constructor TStringBuilder.Create(aCapacity: Integer);
  6670. begin
  6671. Create(aCapacity,MaxInt);
  6672. end;
  6673. constructor TStringBuilder.Create(const AValue: String);
  6674. begin
  6675. Create(aValue,DefaultCapacity);
  6676. end;
  6677. { Property getter/setter }
  6678. function TStringBuilder.GetLength: Integer;
  6679. begin
  6680. Result:=System.Length(FData);
  6681. end;
  6682. function TStringBuilder.GetCapacity: Integer;
  6683. begin
  6684. Result:=System.Length(FData);
  6685. end;
  6686. function TStringBuilder.GetC(Index: Integer): Char;
  6687. begin
  6688. CheckNegative(Index,'Index');
  6689. CheckRange(Index,0,Length);
  6690. Result:=FData[Index];
  6691. end;
  6692. procedure TStringBuilder.SetC(Index: Integer; AValue: Char);
  6693. begin
  6694. CheckNegative(Index,'Index');
  6695. CheckRange(Index,0,Length-1);
  6696. FData[Index]:=AValue;
  6697. end;
  6698. procedure TStringBuilder.SetLength(AValue: Integer);
  6699. begin
  6700. CheckNegative(AValue,'AValue');
  6701. CheckRange(AValue,0,MaxCapacity);
  6702. SetLength(FData,aValue);
  6703. end;
  6704. { Check functions }
  6705. procedure TStringBuilder.CheckRange(Idx, Count, MaxLen: Integer);
  6706. begin
  6707. if (Idx<0) or (Idx+Count>MaxLen) then
  6708. Raise ERangeError.CreateFmt(SListIndexError,[Idx]);
  6709. end;
  6710. procedure TStringBuilder.CheckNegative(const AValue: Integer;
  6711. const AName: String);
  6712. begin
  6713. if (AValue<0) then
  6714. Raise ERangeError.CreateFmt(SParamIsNegative,[AName])
  6715. end;
  6716. { These do the actual Appending/Inserting }
  6717. procedure TStringBuilder.DoAppend(const S: String);
  6718. begin
  6719. FData:=FData+S;
  6720. end;
  6721. procedure TStringBuilder.DoAppend(const AValue: Array of Char; Idx, aCount: Integer
  6722. );
  6723. Var
  6724. S : String;
  6725. I : Integer;
  6726. begin
  6727. S:='';
  6728. CheckRange(Idx,aCount,System.Length(AValue));
  6729. for I:=Idx to Idx+aCount-1 do
  6730. S:=S+aValue[I];
  6731. DoAppend(S);
  6732. end;
  6733. procedure TStringBuilder.DoInsert(Index: Integer; const AValue: String);
  6734. begin
  6735. CheckRange(Index,0,Length-1);
  6736. System.Insert(aValue,FData,Index+1);
  6737. end;
  6738. procedure TStringBuilder.DoInsert(Index: Integer; const AValue: Array of Char;
  6739. StartIndex, aCharCount: Integer);
  6740. Var
  6741. I : Integer;
  6742. S : String;
  6743. begin
  6744. CheckRange(Index,0,Length-1);
  6745. CheckNegative(StartIndex,'StartIndex');
  6746. CheckNegative(aCharCount,'SBCharCount');
  6747. CheckRange(StartIndex,aCharCount,System.Length(AValue));
  6748. S:='';
  6749. for I:=StartIndex to StartIndex+aCharCount-1 do
  6750. S:=S+aValue[I];
  6751. DoInsert(Index,S);
  6752. end;
  6753. { Public routines for appending }
  6754. function TStringBuilder.Append(const AValue: UInt64): TStringBuilder;
  6755. begin
  6756. DoAppend(IntToStr(AValue));
  6757. Result:=self;
  6758. end;
  6759. function TStringBuilder.Append(const AValue: Array of Char): TStringBuilder;
  6760. var
  6761. I,L: Integer;
  6762. begin
  6763. I:=-1;
  6764. L:=System.Length(AValue);
  6765. If L=0 then
  6766. Exit(Self);
  6767. Repeat
  6768. Inc(I);
  6769. Until (I>=L) or (AValue[I]=#0);
  6770. DoAppend(AValue,0,I);
  6771. Result:=Self;
  6772. end;
  6773. function TStringBuilder.Append(const AValue: Single): TStringBuilder;
  6774. begin
  6775. DoAppend(FloatToStr(AValue));
  6776. Result:=self;
  6777. end;
  6778. function TStringBuilder.Append(const AValue: Word): TStringBuilder;
  6779. begin
  6780. Append(IntToStr(AValue));
  6781. Result:=self;
  6782. end;
  6783. function TStringBuilder.Append(const AValue: Cardinal): TStringBuilder;
  6784. begin
  6785. DoAppend(IntToStr(AValue));
  6786. Result:=self;
  6787. end;
  6788. function TStringBuilder.Append(const AValue: Char; RepeatCount: Integer
  6789. ): TStringBuilder;
  6790. begin
  6791. DoAppend(StringOfChar(AValue,RepeatCount));
  6792. Result:=Self;
  6793. end;
  6794. function TStringBuilder.Append(const AValue: Shortint): TStringBuilder;
  6795. begin
  6796. DoAppend(IntToStr(AValue));
  6797. Result:=Self;
  6798. end;
  6799. function TStringBuilder.Append(const AValue: Char): TStringBuilder;
  6800. begin
  6801. DoAppend(AValue);
  6802. Result:=Self;
  6803. end;
  6804. function TStringBuilder.Append(const AValue: Currency): TStringBuilder;
  6805. begin
  6806. DoAppend(CurrToStr(AValue));
  6807. Result:=Self;
  6808. end;
  6809. function TStringBuilder.Append(const AValue: Boolean): TStringBuilder;
  6810. begin
  6811. DoAppend(BoolToStr(AValue, True));
  6812. Result:=Self;
  6813. end;
  6814. function TStringBuilder.Append(const AValue: Byte): TStringBuilder;
  6815. begin
  6816. DoAppend(IntToStr(AValue));
  6817. Result:=Self;
  6818. end;
  6819. function TStringBuilder.Append(const AValue: Double): TStringBuilder;
  6820. begin
  6821. DoAppend(FloatToStr(AValue));
  6822. Result:=Self;
  6823. end;
  6824. function TStringBuilder.Append(const AValue: Int64): TStringBuilder;
  6825. begin
  6826. DoAppend(IntToStr(AValue));
  6827. Result:=Self;
  6828. end;
  6829. function TStringBuilder.Append(const AValue: TObject): TStringBuilder;
  6830. begin
  6831. DoAppend(AValue.ToString);
  6832. Result:=Self;
  6833. end;
  6834. function TStringBuilder.Append(const AValue: Smallint): TStringBuilder;
  6835. begin
  6836. DoAppend(IntToStr(AValue));
  6837. Result:=Self;
  6838. end;
  6839. function TStringBuilder.Append(const AValue: LongInt): TStringBuilder;
  6840. begin
  6841. DoAppend(IntToStr(AValue));
  6842. Result:=Self;
  6843. end;
  6844. Function TStringBuilder.Append(const AValue: Array of Char; StartIndex, SBCharCount: Integer): TStringBuilder;
  6845. begin
  6846. DoAppend(AValue,StartIndex,SBCharCount);
  6847. Result:=Self;
  6848. end;
  6849. Function TStringBuilder.Append(const AValue: String; StartIndex, Count: Integer): TStringBuilder;
  6850. begin
  6851. CheckRange(StartIndex,Count,System.Length(AValue));
  6852. DoAppend(Copy(AValue,StartIndex+1,Count));
  6853. Result:=Self;
  6854. end;
  6855. function TStringBuilder.Append(const AValue: String): TStringBuilder;
  6856. begin
  6857. DoAppend(AValue);
  6858. Result:=Self;
  6859. end;
  6860. function TStringBuilder.AppendFormat(const Fmt: String;
  6861. const Args: array of const): TStringBuilder;
  6862. begin
  6863. DoAppend(Format(Fmt,Args));
  6864. Result:=Self;
  6865. end;
  6866. function TStringBuilder.Append(const Fmt: String;
  6867. const Args: array of const): TStringBuilder;
  6868. begin
  6869. DoAppend(Format(Fmt,Args));
  6870. Result:=Self;
  6871. end;
  6872. function TStringBuilder.AppendLine: TStringBuilder;
  6873. begin
  6874. DoAppend(sLineBreak);
  6875. Result:=Self;
  6876. end;
  6877. function TStringBuilder.AppendLine(const AValue: String): TStringBuilder;
  6878. begin
  6879. DoAppend(AValue);
  6880. Result:=AppendLine();
  6881. end;
  6882. procedure TStringBuilder.Clear;
  6883. begin
  6884. Length:=0;
  6885. Capacity:=DefaultCapacity;
  6886. end;
  6887. procedure TStringBuilder.CopyTo(SourceIndex: Integer;
  6888. Var Destination: Array of Char; DestinationIndex: Integer; Count: Integer);
  6889. Var
  6890. I : Integer;
  6891. begin
  6892. CheckNegative(Count,'Count');
  6893. CheckNegative(DestinationIndex,'DestinationIndex');
  6894. CheckRange(DestinationIndex,Count,System.Length(Destination));
  6895. if Count>0 then
  6896. begin
  6897. CheckRange(SourceIndex,Count,Length);
  6898. For I:=SourceIndex+1 to SourceIndex+Count do
  6899. Destination[DestinationIndex]:=FData[I];
  6900. end;
  6901. end;
  6902. function TStringBuilder.EnsureCapacity(aCapacity: Integer): Integer;
  6903. begin
  6904. CheckRange(aCapacity,0,MaxCapacity);
  6905. if Capacity<aCapacity then
  6906. Capacity:=aCapacity;
  6907. Result:=Capacity;
  6908. end;
  6909. function TStringBuilder.Equals(StringBuilder: TStringBuilder): Boolean;
  6910. begin
  6911. Result:=(StringBuilder<>nil);
  6912. if Result then
  6913. Result:=(Length=StringBuilder.Length)
  6914. and (MaxCapacity=StringBuilder.MaxCapacity)
  6915. and (FData=StringBuilder.FData[0]);
  6916. end;
  6917. procedure TStringBuilder.Grow;
  6918. var
  6919. NewCapacity: SizeInt;
  6920. begin
  6921. NewCapacity:=Capacity*2;
  6922. if NewCapacity>MaxCapacity then
  6923. NewCapacity:=MaxCapacity;
  6924. Capacity:=NewCapacity;
  6925. end;
  6926. function TStringBuilder.Insert(Index: Integer; const AValue: TObject
  6927. ): TStringBuilder;
  6928. begin
  6929. DoInsert(Index,AValue.ToString());
  6930. Result:=Self;
  6931. end;
  6932. function TStringBuilder.Insert(Index: Integer; const AValue: Int64
  6933. ): TStringBuilder;
  6934. begin
  6935. DoInsert(Index,IntToStr(AValue));
  6936. Result:=Self;
  6937. end;
  6938. function TStringBuilder.Insert(Index: Integer; const AValue: Single
  6939. ): TStringBuilder;
  6940. begin
  6941. DoInsert(Index,FloatToStr(AValue));
  6942. Result:=Self;
  6943. end;
  6944. function TStringBuilder.Insert(Index: Integer; const AValue: String
  6945. ): TStringBuilder;
  6946. begin
  6947. DoInsert(Index,AValue);
  6948. Result:=Self;
  6949. end;
  6950. function TStringBuilder.Insert(Index: Integer; const AValue: Word
  6951. ): TStringBuilder;
  6952. begin
  6953. DoInsert(Index,IntToStr(AValue));
  6954. Result:=Self;
  6955. end;
  6956. function TStringBuilder.Insert(Index: Integer; const AValue: Shortint
  6957. ): TStringBuilder;
  6958. begin
  6959. DoInsert(Index, IntToStr(AValue));
  6960. Result:=Self;
  6961. end;
  6962. function TStringBuilder.Insert(Index: Integer; const AValue: Currency
  6963. ): TStringBuilder;
  6964. begin
  6965. DoInsert(Index,CurrToStr(AValue));
  6966. Result:=Self;
  6967. end;
  6968. function TStringBuilder.Insert(Index: Integer; const AValue: Char
  6969. ): TStringBuilder;
  6970. begin
  6971. DoInsert(Index,AValue);
  6972. Result:=Self;
  6973. end;
  6974. function TStringBuilder.Insert(Index: Integer; const AValue: Byte
  6975. ): TStringBuilder;
  6976. begin
  6977. DoInsert(Index,IntToStr(AValue));
  6978. Result:=Self;
  6979. end;
  6980. function TStringBuilder.Insert(Index: Integer; const AValue: Double
  6981. ): TStringBuilder;
  6982. begin
  6983. DoInsert(Index,FloatToStr(AValue));
  6984. Result:=Self;
  6985. end;
  6986. function TStringBuilder.Insert(Index: Integer; const AValue: LongInt
  6987. ): TStringBuilder;
  6988. begin
  6989. DoInsert(Index,IntToStr(AValue));
  6990. Result:=Self;
  6991. end;
  6992. function TStringBuilder.Insert(Index: Integer; const AValue: Smallint
  6993. ): TStringBuilder;
  6994. begin
  6995. DoInsert(Index,IntToStr(AValue));
  6996. Result:=Self;
  6997. end;
  6998. function TStringBuilder.Insert(Index: Integer; const AValue: Boolean
  6999. ): TStringBuilder;
  7000. begin
  7001. DoInsert(Index,BoolToStr(AValue,True));
  7002. Result:=Self;
  7003. end;
  7004. function TStringBuilder.Insert(Index: Integer; const AValue: String;
  7005. const aRepeatCount: Integer): TStringBuilder;
  7006. var
  7007. I: Integer;
  7008. begin
  7009. for I:=0 to aRepeatCount-1 do
  7010. DoInsert(Index,AValue);
  7011. Result:=Self;
  7012. end;
  7013. function TStringBuilder.Insert(Index: Integer; const AValue: Array of Char
  7014. ): TStringBuilder;
  7015. begin
  7016. DoInsert(Index,AValue,0,System.Length(AValue));
  7017. Result:=Self;
  7018. end;
  7019. function TStringBuilder.Insert(Index: Integer; const AValue: Array of Char;
  7020. startIndex: Integer; SBCharCount: Integer): TStringBuilder;
  7021. begin
  7022. DoInsert(Index,AValue,StartIndex,SBCharCount);
  7023. Result:=Self;
  7024. end;
  7025. function TStringBuilder.Insert(Index: Integer; const AValue: Cardinal
  7026. ): TStringBuilder;
  7027. begin
  7028. DoInsert(Index,IntToStr(AValue));
  7029. Result:=self;
  7030. end;
  7031. function TStringBuilder.Insert(Index: Integer; const AValue: UInt64
  7032. ): TStringBuilder;
  7033. begin
  7034. DoInsert(Index,IntToStr(AValue));
  7035. Result:=self;
  7036. end;
  7037. procedure TStringBuilder.Shrink;
  7038. begin
  7039. if (Capacity div 4)>=Length then
  7040. Capacity:=Capacity div 2;
  7041. end;
  7042. function TStringBuilder.Remove(StartIndex: Integer; RemLength: Integer
  7043. ): TStringBuilder;
  7044. Var
  7045. MoveIndex : Integer;
  7046. begin
  7047. if (RemLength=0) then
  7048. exit(Self);
  7049. CheckNegative(RemLength,'RemLength');
  7050. CheckRange(StartIndex,0,Length);
  7051. MoveIndex:=StartIndex+RemLength;
  7052. CheckRange(MoveIndex,0,Length);
  7053. Delete(FData,StartIndex+1,RemLength);
  7054. Shrink;
  7055. Result:=Self;
  7056. end;
  7057. Function TStringBuilder.Replace(const OldValue, NewValue: String; StartIndex, Count: Integer): TStringBuilder;
  7058. var
  7059. I : Integer;
  7060. Start : String;
  7061. begin
  7062. if Count=0 then
  7063. Exit(Self);
  7064. // Some checks.
  7065. CheckNegative(StartIndex,'StartIndex');
  7066. CheckNegative(Count,'Count');
  7067. CheckRange(Startindex,Count,Length);
  7068. // Init
  7069. Start:=Copy(FData,1,StartIndex+1);
  7070. FData:=Copy(FData,StartIndex+1);
  7071. For I:=1 to Count do
  7072. FData:=StringReplace(FData,OldValue,NewValue,[]);
  7073. FData:=Start+FData;
  7074. Result:=Self;
  7075. end;
  7076. Function TStringBuilder.Replace(const OldValue, NewValue: String): TStringBuilder;
  7077. begin
  7078. Result:=Replace(OldValue,NewValue,0,Length);
  7079. end;
  7080. procedure TStringBuilder.SetCapacity(AValue: Integer);
  7081. begin
  7082. if (AValue>FMaxCapacity) then
  7083. Raise ERangeError.CreateFmt(SListCapacityError,[AValue]);
  7084. if (AValue<Length) then
  7085. Raise ERangeError.CreateFmt(SListCapacityError,[AValue]);
  7086. // No-op
  7087. end;
  7088. function TStringBuilder.ToString: String;
  7089. begin
  7090. Result:=ToString(0,Length);
  7091. end;
  7092. function TStringBuilder.ToString(aStartIndex: Integer; aLength: Integer
  7093. ): String;
  7094. begin
  7095. CheckNegative(aStartIndex,'aStartIndex');
  7096. CheckNegative(aLength,'aLength');
  7097. CheckRange(aStartIndex,aLength,Length);
  7098. Writeln('FData : ',FData);
  7099. Result:=Copy(FData,1+aStartIndex,aStartIndex+aLength);
  7100. end;
  7101. procedure TStringBuilder.DoReplace(Index: Integer; const Old, New: String);
  7102. var
  7103. OVLen : Integer;
  7104. begin
  7105. OVLen:=System.Length(Old);
  7106. System.Delete(FData,Index+1,OVLen);
  7107. System.Insert(New,FData,Index+1);
  7108. end;
  7109. initialization
  7110. {$WARN 5043 off}
  7111. ShortMonthNames:=DefaultShortMonthNames;
  7112. LongMonthNames:=DefaultLongMonthNames;
  7113. ShortDayNames:=DefaultShortDayNames;
  7114. LongDayNames:=DefaultLongDayNames;
  7115. FormatSettings:=TFormatSettings.Create;
  7116. // So the defaults are taken from FormatSettings.
  7117. TimeSeparator:=FormatSettings.TimeSeparator;
  7118. DateSeparator:=FormatSettings.DateSeparator;
  7119. ShortDateFormat:=FormatSettings.ShortDateFormat;
  7120. LongDateFormat:=FormatSettings.LongDateFormat;
  7121. ShortTimeFormat:=FormatSettings.ShortTimeFormat;
  7122. LongTimeFormat:=FormatSettings.LongTimeFormat;
  7123. DecimalSeparator:=FormatSettings.DecimalSeparator;
  7124. ThousandSeparator:=FormatSettings.ThousandSeparator;
  7125. TimeAMString:=FormatSettings.TimeAMString;
  7126. TimePMString:=FormatSettings.TimePMString;
  7127. CurrencyFormat:=FormatSettings.CurrencyFormat;
  7128. NegCurrFormat:=FormatSettings.NegCurrFormat;
  7129. CurrencyDecimals:=FormatSettings.CurrencyDecimals;
  7130. CurrencyString:=FormatSettings.CurrencyString;
  7131. end.