sysutils.pas 232 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424542554265427542854295430543154325433543454355436543754385439544054415442544354445445544654475448544954505451545254535454545554565457545854595460546154625463546454655466546754685469547054715472547354745475547654775478547954805481548254835484548554865487548854895490549154925493549454955496549754985499550055015502550355045505550655075508550955105511551255135514551555165517551855195520552155225523552455255526552755285529553055315532553355345535553655375538553955405541554255435544554555465547554855495550555155525553555455555556555755585559556055615562556355645565556655675568556955705571557255735574557555765577557855795580558155825583558455855586558755885589559055915592559355945595559655975598559956005601560256035604560556065607560856095610561156125613561456155616561756185619562056215622562356245625562656275628562956305631563256335634563556365637563856395640564156425643564456455646564756485649565056515652565356545655565656575658565956605661566256635664566556665667566856695670567156725673567456755676567756785679568056815682568356845685568656875688568956905691569256935694569556965697569856995700570157025703570457055706570757085709571057115712571357145715571657175718571957205721572257235724572557265727572857295730573157325733573457355736573757385739574057415742574357445745574657475748574957505751575257535754575557565757575857595760576157625763576457655766576757685769577057715772577357745775577657775778577957805781578257835784578557865787578857895790579157925793579457955796579757985799580058015802580358045805580658075808580958105811581258135814581558165817581858195820582158225823582458255826582758285829583058315832583358345835583658375838583958405841584258435844584558465847584858495850585158525853585458555856585758585859586058615862586358645865586658675868586958705871587258735874587558765877587858795880588158825883588458855886588758885889589058915892589358945895589658975898589959005901590259035904590559065907590859095910591159125913591459155916591759185919592059215922592359245925592659275928592959305931593259335934593559365937593859395940594159425943594459455946594759485949595059515952595359545955595659575958595959605961596259635964596559665967596859695970597159725973597459755976597759785979598059815982598359845985598659875988598959905991599259935994599559965997599859996000600160026003600460056006600760086009601060116012601360146015601660176018601960206021602260236024602560266027602860296030603160326033603460356036603760386039604060416042604360446045604660476048604960506051605260536054605560566057605860596060606160626063606460656066606760686069607060716072607360746075607660776078607960806081608260836084608560866087608860896090609160926093609460956096609760986099610061016102610361046105610661076108610961106111611261136114611561166117611861196120612161226123612461256126612761286129613061316132613361346135613661376138613961406141614261436144614561466147614861496150615161526153615461556156615761586159616061616162616361646165616661676168616961706171617261736174617561766177617861796180618161826183618461856186618761886189619061916192619361946195619661976198619962006201620262036204620562066207620862096210621162126213621462156216621762186219622062216222622362246225622662276228622962306231623262336234623562366237623862396240624162426243624462456246624762486249625062516252625362546255625662576258625962606261626262636264626562666267626862696270627162726273627462756276627762786279628062816282628362846285628662876288628962906291629262936294629562966297629862996300630163026303630463056306630763086309631063116312631363146315631663176318631963206321632263236324632563266327632863296330633163326333633463356336633763386339634063416342634363446345634663476348634963506351635263536354635563566357635863596360636163626363636463656366636763686369637063716372637363746375637663776378637963806381638263836384638563866387638863896390639163926393639463956396639763986399640064016402640364046405640664076408640964106411641264136414641564166417641864196420642164226423642464256426642764286429643064316432643364346435643664376438643964406441644264436444644564466447644864496450645164526453645464556456645764586459646064616462646364646465646664676468646964706471647264736474647564766477647864796480648164826483648464856486648764886489649064916492649364946495649664976498649965006501650265036504650565066507650865096510651165126513651465156516651765186519652065216522652365246525652665276528652965306531653265336534653565366537653865396540654165426543654465456546654765486549655065516552655365546555655665576558655965606561656265636564656565666567656865696570657165726573657465756576657765786579658065816582658365846585658665876588658965906591659265936594659565966597659865996600660166026603660466056606660766086609661066116612661366146615661666176618661966206621662266236624662566266627662866296630663166326633663466356636663766386639664066416642664366446645664666476648664966506651665266536654665566566657665866596660666166626663666466656666666766686669667066716672667366746675667666776678667966806681668266836684668566866687668866896690669166926693669466956696669766986699670067016702670367046705670667076708670967106711671267136714671567166717671867196720672167226723672467256726672767286729673067316732673367346735673667376738673967406741674267436744674567466747674867496750675167526753675467556756675767586759676067616762676367646765676667676768676967706771677267736774677567766777677867796780678167826783678467856786678767886789679067916792679367946795679667976798679968006801680268036804680568066807680868096810681168126813681468156816681768186819682068216822682368246825682668276828682968306831683268336834683568366837683868396840684168426843684468456846684768486849685068516852685368546855685668576858685968606861686268636864686568666867686868696870687168726873687468756876687768786879688068816882688368846885688668876888688968906891689268936894689568966897689868996900690169026903690469056906690769086909691069116912691369146915691669176918691969206921692269236924692569266927692869296930693169326933693469356936693769386939694069416942694369446945694669476948694969506951695269536954695569566957695869596960696169626963696469656966696769686969697069716972697369746975697669776978697969806981698269836984698569866987698869896990699169926993699469956996699769986999700070017002700370047005700670077008700970107011701270137014701570167017701870197020702170227023702470257026702770287029703070317032703370347035703670377038703970407041704270437044704570467047704870497050705170527053705470557056705770587059706070617062706370647065706670677068706970707071707270737074707570767077707870797080708170827083708470857086708770887089709070917092709370947095709670977098709971007101710271037104710571067107710871097110711171127113711471157116711771187119712071217122712371247125712671277128712971307131713271337134713571367137713871397140714171427143714471457146714771487149715071517152715371547155715671577158715971607161716271637164716571667167716871697170717171727173717471757176717771787179718071817182718371847185718671877188718971907191719271937194719571967197719871997200720172027203720472057206720772087209721072117212721372147215721672177218721972207221722272237224722572267227722872297230723172327233723472357236723772387239724072417242724372447245724672477248724972507251725272537254725572567257725872597260726172627263726472657266726772687269727072717272727372747275727672777278727972807281728272837284728572867287728872897290729172927293729472957296729772987299730073017302730373047305730673077308730973107311731273137314731573167317731873197320732173227323732473257326732773287329733073317332733373347335733673377338733973407341734273437344734573467347734873497350735173527353735473557356735773587359736073617362736373647365736673677368736973707371737273737374737573767377737873797380738173827383738473857386738773887389739073917392739373947395739673977398739974007401740274037404740574067407740874097410741174127413741474157416741774187419742074217422742374247425742674277428742974307431743274337434743574367437743874397440744174427443744474457446744774487449745074517452745374547455745674577458745974607461746274637464746574667467746874697470747174727473747474757476747774787479748074817482748374847485748674877488748974907491749274937494749574967497749874997500750175027503750475057506750775087509751075117512751375147515751675177518751975207521752275237524752575267527752875297530753175327533753475357536753775387539754075417542754375447545754675477548754975507551755275537554755575567557755875597560756175627563756475657566756775687569757075717572757375747575757675777578757975807581758275837584758575867587758875897590759175927593759475957596759775987599760076017602760376047605760676077608760976107611761276137614761576167617761876197620762176227623762476257626762776287629763076317632763376347635763676377638763976407641764276437644764576467647764876497650765176527653765476557656765776587659766076617662766376647665766676677668766976707671767276737674767576767677767876797680768176827683768476857686768776887689769076917692769376947695769676977698769977007701770277037704770577067707770877097710771177127713771477157716771777187719772077217722772377247725772677277728772977307731773277337734773577367737773877397740774177427743774477457746774777487749775077517752775377547755775677577758775977607761776277637764776577667767776877697770777177727773777477757776777777787779778077817782778377847785778677877788778977907791779277937794779577967797779877997800780178027803780478057806780778087809781078117812781378147815781678177818781978207821782278237824782578267827782878297830783178327833783478357836783778387839784078417842784378447845784678477848784978507851785278537854785578567857785878597860786178627863786478657866786778687869787078717872787378747875787678777878787978807881788278837884788578867887788878897890789178927893789478957896789778987899790079017902790379047905790679077908790979107911791279137914791579167917791879197920792179227923792479257926792779287929793079317932793379347935793679377938793979407941794279437944794579467947794879497950795179527953795479557956795779587959796079617962796379647965796679677968796979707971797279737974797579767977797879797980798179827983798479857986798779887989799079917992799379947995799679977998799980008001800280038004800580068007800880098010801180128013801480158016801780188019802080218022802380248025802680278028802980308031803280338034803580368037803880398040804180428043804480458046804780488049805080518052805380548055805680578058805980608061806280638064806580668067806880698070807180728073807480758076807780788079808080818082808380848085808680878088808980908091809280938094809580968097809880998100810181028103810481058106810781088109811081118112811381148115811681178118811981208121812281238124812581268127812881298130813181328133813481358136813781388139814081418142814381448145814681478148814981508151815281538154815581568157815881598160816181628163816481658166816781688169817081718172817381748175817681778178817981808181818281838184818581868187818881898190819181928193819481958196819781988199820082018202820382048205820682078208820982108211821282138214821582168217821882198220822182228223822482258226822782288229823082318232823382348235823682378238823982408241824282438244824582468247824882498250825182528253825482558256825782588259826082618262826382648265826682678268826982708271827282738274827582768277827882798280828182828283828482858286828782888289829082918292829382948295829682978298829983008301830283038304830583068307830883098310831183128313831483158316831783188319832083218322832383248325832683278328832983308331833283338334833583368337833883398340834183428343834483458346834783488349835083518352835383548355835683578358835983608361836283638364836583668367836883698370837183728373837483758376837783788379838083818382838383848385838683878388838983908391839283938394839583968397839883998400840184028403840484058406840784088409841084118412841384148415841684178418841984208421842284238424842584268427842884298430843184328433843484358436843784388439844084418442844384448445844684478448844984508451845284538454845584568457845884598460846184628463846484658466846784688469847084718472847384748475847684778478847984808481848284838484848584868487848884898490849184928493849484958496849784988499850085018502850385048505850685078508850985108511851285138514851585168517851885198520852185228523852485258526852785288529853085318532853385348535853685378538853985408541854285438544854585468547854885498550855185528553855485558556855785588559856085618562856385648565856685678568856985708571857285738574857585768577857885798580858185828583858485858586858785888589859085918592859385948595859685978598859986008601860286038604860586068607860886098610861186128613861486158616861786188619862086218622862386248625862686278628862986308631863286338634863586368637863886398640864186428643864486458646864786488649865086518652865386548655865686578658865986608661866286638664866586668667866886698670867186728673867486758676867786788679868086818682868386848685868686878688868986908691869286938694869586968697869886998700870187028703870487058706870787088709871087118712871387148715871687178718871987208721872287238724872587268727872887298730873187328733873487358736873787388739874087418742874387448745
  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 const);
  100. constructor CreateHelp(const Msg: String; AHelpContext: Integer);
  101. constructor CreateFmtHelp(const Msg: string; const Args: array of const; 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 const): String;
  202. function Format(const Fmt: String; const Args: array of const; 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 const): 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 const): 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 const): 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. // Writeln('Precision ',Precision,' decimals: ',Decimals);
  1248. Result.Negative:=False;
  1249. Result.Exponent:=0;
  1250. For C:=0 to FloatRecDigits do
  1251. Result.Digits[C]:='0';
  1252. if Value=0 then
  1253. exit;
  1254. Str(Value:24,Buffer); // Double precision
  1255. // writeln('12345678901234567890123456789012345678901234567890');
  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-1] := 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;
  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. // writeln(len);
  1597. I:=1;
  1598. InQuote:=False;
  1599. Q:=#0;
  1600. while (I<=Len) do
  1601. begin
  1602. C:=Section[i];
  1603. if C in ['"',''''] then
  1604. begin
  1605. if InQuote then
  1606. InQuote:=C<>Q
  1607. else
  1608. begin
  1609. InQuote:=True;
  1610. Q:=C;
  1611. end;
  1612. end
  1613. else if not InQuote then
  1614. case C of
  1615. '.':
  1616. if (DecimalPos=0) then
  1617. DecimalPos:=RequestedDigits+1;
  1618. ',':
  1619. ThousandSep:=aSettings.ThousandSeparator<>#0;
  1620. 'e', 'E':
  1621. begin
  1622. Inc(I);
  1623. if (I<Len) then
  1624. begin
  1625. C:=Section[i];
  1626. IsScientific:=C in ['-','+'];
  1627. if IsScientific then
  1628. while (I<Len) and (Section[i+1]='0') do
  1629. begin
  1630. Inc(ExpSize);
  1631. Inc(I);
  1632. end;
  1633. if ExpSize>4 then
  1634. ExpSize:=4;
  1635. end;
  1636. end;
  1637. '#':
  1638. Inc(RequestedDigits);
  1639. '0':
  1640. begin
  1641. if RequestedDigits<FirstDigit then
  1642. FirstDigit:=RequestedDigits+1;
  1643. Inc(RequestedDigits);
  1644. LastDigit:=RequestedDigits+1;
  1645. end;
  1646. end;
  1647. Inc(I);
  1648. end;
  1649. if DecimalPos=0 then
  1650. DecimalPos:=RequestedDigits+1;
  1651. // Writeln('LastDigit: ',DecimalPos,'-',LastDigit);
  1652. LastDigit:=DecimalPos-LastDigit;
  1653. if LastDigit>0 then
  1654. LastDigit:=0;
  1655. // Writeln('FirstDigit: ',DecimalPos,'-',FirstDigit);
  1656. FirstDigit:=DecimalPos-FirstDigit;
  1657. if FirstDigit<0 then
  1658. FirstDigit:=0;
  1659. end;
  1660. Function ValueOutSideScope : Boolean;
  1661. begin
  1662. With FV do
  1663. Result:=((Exponent >= 18) and (not IsScientific)) or (Exponent = $7FF) or (Exponent = $800)
  1664. end;
  1665. Procedure CalcRunVars;
  1666. Var
  1667. D,P: Integer;
  1668. begin
  1669. if IsScientific then
  1670. begin
  1671. P:=RequestedDigits;
  1672. D:=9999;
  1673. end
  1674. else
  1675. begin
  1676. P:=MaxPrecision;
  1677. // Writeln(RequestedDigits,'-',DecimalPos,'+1');
  1678. D:=RequestedDigits-DecimalPos+1;
  1679. end;
  1680. FV:=FloatToDecimal(aValue,P,D);
  1681. // Writeln('Number of digits available : ',Length(FV.Digits));
  1682. // For p:=0 to Length(FV.Digits)-1 do
  1683. // Writeln(P,': ',FV.Digits[p]);
  1684. DistToDecimal:=DecimalPos-1;
  1685. // Writeln('DistToDecimal : ',DistToDecimal);
  1686. if IsScientific then
  1687. PadZeroes:=0 // No padding.
  1688. else
  1689. begin
  1690. PadZeroes:=FV.Exponent-(DecimalPos-1);
  1691. if (PadZeroes>=0) then
  1692. DistToDecimal:=FV.Exponent
  1693. end;
  1694. // Writeln('PadZeroes : ',PadZeroes, ', DistToDecimal : ',DistToDecimal);
  1695. Available:=-1;
  1696. while (Available<High(FV.Digits)) and (FV.Digits[Available+1]<>#0) do
  1697. Inc(Available);
  1698. // Writeln('Available: ',Available);
  1699. end;
  1700. Function FormatExponent(ASign: Char; aExponent: Integer) : String;
  1701. begin
  1702. Result:=IntToStr(aExponent);
  1703. Result:=StringOfChar('0',ExpSize-Length(Result))+Result;
  1704. if (aExponent<0) then
  1705. Result:='-'+Result
  1706. else if (aExponent>0) and (aSign='+') then
  1707. Result:=aSign+Result;
  1708. end;
  1709. var
  1710. I,S : Integer;
  1711. C,Q : Char;
  1712. PA : TPosArray;
  1713. InLiteral : Boolean;
  1714. begin
  1715. SetLength(PA,4);
  1716. Result:='';
  1717. Initvars;
  1718. // What section to use ?
  1719. if (E>0) then
  1720. S:=1
  1721. else if (E<0) then
  1722. S:=2
  1723. else
  1724. S:=3;
  1725. PA[0]:=0;
  1726. I:=GetSections(PA);
  1727. if (I<S) or (PA[S]-PA[S-1]=0) then
  1728. S:=1;
  1729. // Extract correct section
  1730. SectionLength:=PA[S]-PA[S-1]-1;
  1731. Section:=Copy(Fmt,PA[S-1]+1,SectionLength);
  1732. SetLength(Section,SectionLength);
  1733. // Writeln('Section ',I,' : "',Section,'" ',SectionLength);
  1734. AnalyzeFormat;
  1735. // Writeln('RequestedDigits: ',RequestedDigits,', DecimalPos : ',DecimalPos,', LastDigit: ',LastDigit,', FirstDigit: ',FirstDigit);
  1736. CalcRunVars;
  1737. // If we cannot process value using current settings, fallback
  1738. if (SectionLength=0) or ValueOutSideScope then
  1739. begin
  1740. asm
  1741. Section=E.toPrecision(15);
  1742. end;
  1743. Result:=Section;
  1744. end;
  1745. // Get Started
  1746. I:=1;
  1747. Current:=0;
  1748. Q:=' ';
  1749. InLiteral:=False;
  1750. if (FV.Negative) and (S=1) then
  1751. ToResult('-');
  1752. while (I<=SectionLength) do
  1753. begin
  1754. C:=Section[i];
  1755. // Writeln('Analyzing pos ',I,': "',C,'"');
  1756. If (C in ['"', '''']) then
  1757. begin
  1758. if InLiteral then
  1759. InLiteral:=C<>Q
  1760. else
  1761. begin
  1762. inLiteral:=True;
  1763. Q:=C;
  1764. end;
  1765. end
  1766. else if InLiteral then
  1767. ToResult(C)
  1768. else
  1769. case C of
  1770. '0', '#':
  1771. CopyDigit;
  1772. '.', ',':
  1773. ; // Do nothing, handled by CopyDigit
  1774. 'e', 'E':
  1775. begin
  1776. ToResult(C); // Always needed
  1777. Inc(I);
  1778. if I<=Length(Section) then
  1779. begin
  1780. C:=Section[I];
  1781. if (C in ['+','-']) then
  1782. begin
  1783. AddToResult(FormatExponent(C,FV.Exponent-DecimalPos+1));
  1784. // Skip rest
  1785. while (I<SectionLength) and (Section[i+1]='0') do
  1786. Inc(I);
  1787. end;
  1788. end;
  1789. end;
  1790. else
  1791. ToResult(C);
  1792. end;
  1793. Inc(i);
  1794. end;
  1795. end;
  1796. function StrToBool(const S: String): Boolean;
  1797. begin
  1798. if not(TryStrToBool(S,Result)) then
  1799. raise EConvertError.CreateFmt(SInvalidBoolean,[S]);
  1800. end;
  1801. procedure CheckBoolStrs;
  1802. begin
  1803. if Length(TrueBoolStrs)=0 then
  1804. begin
  1805. SetLength(TrueBoolStrs,1);
  1806. TrueBoolStrs[0]:='True';
  1807. end;
  1808. if Length(FalseBoolStrs)=0 then
  1809. begin
  1810. SetLength(FalseBoolStrs,1);
  1811. FalseBoolStrs[0]:='False';
  1812. end;
  1813. end;
  1814. function BoolToStr(B: Boolean; UseBoolStrs: Boolean): string;
  1815. begin
  1816. if UseBoolStrs Then
  1817. begin
  1818. CheckBoolStrs;
  1819. if B then
  1820. Result:=TrueBoolStrs[0]
  1821. else
  1822. Result:=FalseBoolStrs[0];
  1823. end else
  1824. if B then
  1825. Result:='-1'
  1826. else
  1827. Result:='0';
  1828. end;
  1829. function BoolToStr(B: Boolean; const TrueS, FalseS: String): string;
  1830. begin
  1831. if B then Result:=TrueS else Result:=FalseS;
  1832. end;
  1833. function StrToBoolDef(const S: String; Default: Boolean): Boolean;
  1834. begin
  1835. if not TryStrToBool(S,Result) then
  1836. Result:=Default;
  1837. end;
  1838. function TryStrToBool(const S: String; out Value: Boolean): Boolean;
  1839. Var
  1840. Temp : String;
  1841. I : Longint;
  1842. D : Double;
  1843. Code: integer;
  1844. begin
  1845. Temp:=uppercase(S);
  1846. Val(Temp,D,code);
  1847. Result:=true;
  1848. If Code=0 then
  1849. Value:=(D<>0.0)
  1850. else
  1851. begin
  1852. CheckBoolStrs;
  1853. for I:=low(TrueBoolStrs) to High(TrueBoolStrs) do
  1854. if Temp=uppercase(TrueBoolStrs[I]) then
  1855. begin
  1856. Value:=true;
  1857. exit;
  1858. end;
  1859. for I:=low(FalseBoolStrs) to High(FalseBoolStrs) do
  1860. if Temp=uppercase(FalseBoolStrs[I]) then
  1861. begin
  1862. Value:=false;
  1863. exit;
  1864. end;
  1865. Result:=false;
  1866. end;
  1867. end;
  1868. function UpperCase(const s: String): String; assembler;
  1869. asm
  1870. return s.toUpperCase();
  1871. end;
  1872. function LowerCase(const s: String): String; assembler;
  1873. asm
  1874. return s.toLowerCase();
  1875. end;
  1876. function CompareStr(const s1, s2: String): Integer; assembler;
  1877. asm
  1878. var l1 = s1.length;
  1879. var l2 = s2.length;
  1880. if (l1<=l2){
  1881. var s = s2.substr(0,l1);
  1882. if (s1<s){ return -1;
  1883. } else if (s1>s){ return 1;
  1884. } else { return l1<l2 ? -1 : 0; };
  1885. } else {
  1886. var s = s1.substr(0,l2);
  1887. if (s<s2){ return -1;
  1888. } else { return 1; };
  1889. };
  1890. end;
  1891. function SameStr(const s1, s2: String): Boolean; assembler;
  1892. asm
  1893. return s1 == s2;
  1894. end;
  1895. function CompareText(const s1, s2: String): Integer; assembler;
  1896. asm
  1897. var l1 = s1.toLowerCase();
  1898. var l2 = s2.toLowerCase();
  1899. if (l1>l2){ return 1;
  1900. } else if (l1<l2){ return -1;
  1901. } else { return 0; }
  1902. end;
  1903. function SameText(const s1, s2: String): Boolean; assembler;
  1904. asm
  1905. return s1.toLowerCase() == s2.toLowerCase();
  1906. end;
  1907. function AnsiCompareText(const s1, s2: String): Integer; assembler;
  1908. asm
  1909. return s1.localeCompare(s2);
  1910. end;
  1911. function AnsiSameText(const s1, s2: String): Boolean; assembler;
  1912. asm
  1913. return s1.toLowerCase() == s2.toLowerCase();
  1914. end;
  1915. function AnsiCompareStr(const s1, s2: String): Integer;
  1916. begin
  1917. {$IFDEF ECMAScript6}
  1918. Result:=CompareText(TJSString(s1).normalize(),TJSString(s2).normalize());
  1919. {$ELSE}
  1920. Result:=CompareText(s1,s2);
  1921. {$ENDIF}
  1922. end;
  1923. procedure AppendStr(var Dest: String; const S: string);
  1924. begin
  1925. Dest:=Dest+S;
  1926. end;
  1927. Const
  1928. feInvalidFormat = 1;
  1929. feMissingArgument = 2;
  1930. feInvalidArgIndex = 3;
  1931. Procedure DoFormatError (ErrCode : Longint;const fmt: String);
  1932. begin
  1933. //!! must be changed to contain format string...
  1934. Case ErrCode of
  1935. feInvalidFormat : raise EConvertError.Createfmt(SInvalidFormat,[Fmt]);
  1936. feMissingArgument : raise EConvertError.Createfmt(SArgumentMissing,[Fmt]);
  1937. feInvalidArgIndex : raise EConvertError.Createfmt(SInvalidArgIndex,[Fmt]);
  1938. end;
  1939. end;
  1940. Const
  1941. maxdigits = 15;
  1942. Function SwapEndian(W : Word) : Word;
  1943. begin
  1944. Result:=((W and $FF) shl 8) or ((W shr 8) and $FF)
  1945. end;
  1946. Function SwapEndian(C : Cardinal) : Cardinal;
  1947. begin
  1948. Result:=((C and $FF) shl 24)
  1949. or ((C and $FF00) shl 8)
  1950. or ((C shr 8) and $FF00)
  1951. or ((C shr 24) and $FF);
  1952. end;
  1953. Function ReplaceDecimalSep(S: String; Const DS : string) : string;
  1954. Var
  1955. P : Integer;
  1956. begin
  1957. P:=Pos('.',S);
  1958. if P>0 then
  1959. Result:=Copy(S,1,P-1)+DS+Copy(S,P+1,Length(S)-P)
  1960. else
  1961. Result:=S;
  1962. end;
  1963. function FormatGeneralFloat(Value : double; Precision : Integer; DS : String) : string;
  1964. Var
  1965. P, PE, Q, Exponent: Integer;
  1966. Begin
  1967. If (Precision = -1) Or (Precision > maxdigits) Then
  1968. Precision := maxdigits;
  1969. { First convert to scientific format, with correct precision }
  1970. Str(Value:precision+7, Result);
  1971. { Delete leading spaces }
  1972. Result:=TrimLeft(Result);
  1973. P:=Pos('.',Result);
  1974. if P=0 then
  1975. exit;
  1976. { Consider removing exponent }
  1977. PE:=Pos('E',Result);
  1978. if PE=0 then
  1979. begin
  1980. Result:=ReplaceDecimalSep(Result,DS);
  1981. exit;
  1982. end;
  1983. { Read exponent }
  1984. Q:=PE+2;
  1985. Exponent := 0;
  1986. while (Q <= Length(Result)) do
  1987. begin
  1988. Exponent := Exponent*10 + Ord(Result[Q])-Ord('0');
  1989. Inc(Q);
  1990. end;
  1991. if Result[PE+1] = '-' then
  1992. Exponent := -Exponent;
  1993. if (P+Exponent < PE) and (Exponent > -6) then
  1994. begin
  1995. { OK to remove exponent }
  1996. SetLength(Result,PE-1); { Trim exponent }
  1997. if Exponent >= 0 then
  1998. begin
  1999. { Shift point to right }
  2000. for Q := 0 to Exponent-1 do
  2001. begin
  2002. Result[P] := Result[P+1];
  2003. Inc(P);
  2004. end;
  2005. Result[P] := '.';
  2006. P := 1;
  2007. if Result[P] = '-' then
  2008. Inc(P);
  2009. while (Result[P] = '0') and (P < Length(Result)) and (Copy(Result,P+1,Length(DS))<>DS) do
  2010. { Trim leading zeros; conversion above should not give any, but occasionally does
  2011. because of rounding }
  2012. System.Delete(Result,P,1);
  2013. end
  2014. else
  2015. begin
  2016. { Add zeros at start }
  2017. Insert(Copy('00000',1,-Exponent),Result,P-1);
  2018. Result[P-Exponent] := Result[P-Exponent-1]; { Copy leading digit }
  2019. Result[P] := '.';
  2020. if Exponent <> -1 then
  2021. Result[P-Exponent-1] := '0';
  2022. end;
  2023. { Remove trailing zeros }
  2024. Q := Length(Result);
  2025. while (Q > 0) and (Result[Q] = '0') do
  2026. Dec(Q);
  2027. if Result[Q] = '.' then
  2028. Dec(Q); { Remove trailing decimal point }
  2029. if (Q = 0) or ((Q=1) and (Result[1] = '-')) then
  2030. Result := '0'
  2031. else
  2032. SetLength(Result,Q);
  2033. end
  2034. else
  2035. begin
  2036. { Need exponent, but remove superfluous characters }
  2037. { Delete trailing zeros }
  2038. while Result[PE-1] = '0' do
  2039. begin
  2040. System.Delete(Result,PE-1,1);
  2041. Dec(PE);
  2042. end;
  2043. { If number ends in decimal point, remove it }
  2044. if Result[PE-1] = DS then
  2045. begin
  2046. System.Delete(Result,PE-1,1);
  2047. Dec(PE);
  2048. end;
  2049. { delete superfluous + in exponent }
  2050. if Result[PE+1]='+' then
  2051. System.Delete(Result,PE+1,1)
  2052. else
  2053. Inc(PE);
  2054. while Result[PE+1] = '0' do
  2055. { Delete leading zeros in exponent }
  2056. System.Delete(Result,PE+1,1)
  2057. end;
  2058. Result:=ReplaceDecimalSep(Result,DS)
  2059. end;
  2060. function FormatExponentFloat(Value : double; Precision,Digits : Integer;DS : String) : string;
  2061. Var
  2062. P: Integer;
  2063. Begin
  2064. DS:=FormatSettings.DecimalSeparator;
  2065. If (Precision = -1) Or (Precision > maxdigits) Then
  2066. Precision := maxdigits;
  2067. Str(Value:Precision+7, Result);
  2068. { Delete leading spaces }
  2069. while Result[1] = ' ' do
  2070. System.Delete(Result, 1, 1);
  2071. P:=Pos('E',Result);
  2072. if P=0 then
  2073. begin
  2074. Result:=ReplaceDecimalSep(Result,DS);
  2075. exit;
  2076. end;
  2077. Inc(P, 2);
  2078. if Digits > 4 then
  2079. Digits:=4;
  2080. Digits:=Length(Result) - P - Digits + 1;
  2081. if Digits < 0 then
  2082. insert(copy('0000',1,-Digits),Result,P)
  2083. else
  2084. while (Digits > 0) and (Result[P] = '0') do
  2085. begin
  2086. System.Delete(Result, P, 1);
  2087. if P > Length(Result) then
  2088. begin
  2089. System.Delete(Result, P - 2, 2);
  2090. break;
  2091. end;
  2092. Dec(Digits);
  2093. end;
  2094. Result:=ReplaceDecimalSep(Result,DS);
  2095. End;
  2096. function FormatFixedFloat(Value : double; Digits : Integer; DS : String) : string;
  2097. Begin
  2098. If Digits = -1 Then
  2099. Digits := 2
  2100. Else If Digits > 18 Then
  2101. Digits := 18;
  2102. Str(Value:0:Digits, Result);
  2103. if (Result<>'') and (Result[1]=' ') then
  2104. Delete(Result,1,1);
  2105. Result:=ReplaceDecimalSep(Result,DS);
  2106. end;
  2107. function FormatNumberFloat(Value : double; Digits : Integer; DS,TS : String) : string;
  2108. Var
  2109. P : integer;
  2110. Begin
  2111. If Digits = -1 Then
  2112. Digits := 2
  2113. else If Digits > maxdigits Then
  2114. Digits := maxdigits;
  2115. Str(Value:0:Digits, Result);
  2116. if (Result<>'') and (Result[1]=' ') then
  2117. Delete(Result,1,1);
  2118. P:=Pos('.',Result);
  2119. if (P<=0) then
  2120. P:=Length(Result)+1;
  2121. Result:=ReplaceDecimalSep(Result,DS);
  2122. Dec(P,3);
  2123. if (TS<>'') and (TS<>#0) then
  2124. While (P>1) Do
  2125. Begin
  2126. If (Result[P-1] <> '-') Then
  2127. Insert(TS, Result, P);
  2128. Dec(P, 3);
  2129. End;
  2130. End;
  2131. function RemoveLeadingNegativeSign(var AValue: String; DS : String; aThousandSeparator : String): Boolean;
  2132. // removes negative sign in case when result is zero eg. -0.00
  2133. var
  2134. i: PtrInt;
  2135. TS: String;
  2136. StartPos: PtrInt;
  2137. begin
  2138. Result:=False;
  2139. StartPos := 2;
  2140. TS := aThousandSeparator;
  2141. for i :=StartPos to length(AValue) do
  2142. begin
  2143. Result := (AValue[i] in ['0', DS, 'E', '+']) or (aValue[i]=TS);
  2144. if not Result then
  2145. break;
  2146. end;
  2147. if (Result) and (AValue[1]='-') then
  2148. Delete(AValue, 1, 1);
  2149. end;
  2150. Function FormatNumberCurrency(const Value : Currency; Digits : Integer; const aSettings: TFormatSettings) : string;
  2151. Var
  2152. Negative: Boolean;
  2153. P : Integer;
  2154. CS,DS,TS : String;
  2155. Begin
  2156. DS:=aSettings.DecimalSeparator;
  2157. TS:=aSettings.ThousandSeparator;
  2158. CS:=aSettings.CurrencyString;
  2159. // Writeln('Value ',D);
  2160. If Digits = -1 Then
  2161. Digits := aSettings.CurrencyDecimals
  2162. Else If Digits > 18 Then
  2163. Digits := 18;
  2164. Str(Value:0:Digits, Result);
  2165. // Writeln('1. Result ',Result,' currencystring : ',CS);
  2166. Negative:=Result[1] = '-';
  2167. if Negative then
  2168. System.Delete(Result, 1, 1);
  2169. P := Pos('.', Result);
  2170. // Writeln('2. Result ',Result,' currencystring : ',CurrencyString);
  2171. If TS<>'' Then
  2172. begin
  2173. If P <> 0 Then
  2174. Result:=ReplaceDecimalSep(Result,DS)
  2175. else
  2176. P := Length(Result)+1;
  2177. Dec(P, 3);
  2178. While (P > 1) Do
  2179. Begin
  2180. Insert(TS, Result, P);
  2181. Dec(P, 3);
  2182. End;
  2183. end;
  2184. // Writeln('3. Result ',Result,' currencystring : ',CS);
  2185. if Negative then
  2186. RemoveLeadingNegativeSign(Result,DS,TS);
  2187. // Writeln('4. Result ',Result,' currencystring : ',CurrencyString);
  2188. // Writeln('CurrencyFormat: ',CurrencyFormat,'NegcurrencyFormat: ',NegCurrFormat);
  2189. If Not Negative Then
  2190. Case aSettings.CurrencyFormat Of
  2191. 0: Result := CS + Result;
  2192. 1: Result := Result + CS;
  2193. 2: Result := CS + ' ' + Result;
  2194. 3: Result := Result + ' ' + CS;
  2195. end
  2196. else
  2197. Case aSettings.NegCurrFormat Of
  2198. 0: Result := '(' + CS + Result + ')';
  2199. 1: Result := '-' + CS + Result;
  2200. 2: Result := CS + '-' + Result;
  2201. 3: Result := CS + Result + '-';
  2202. 4: Result := '(' + Result + CS + ')';
  2203. 5: Result := '-' + Result + CS;
  2204. 6: Result := Result + '-' + CS;
  2205. 7: Result := Result + CS + '-';
  2206. 8: Result := '-' + Result + ' ' + CS;
  2207. 9: Result := '-' + CS + ' ' + Result;
  2208. 10: Result := Result + ' ' + CS + '-';
  2209. 11: Result := CS + ' ' + Result + '-';
  2210. 12: Result := CS + ' ' + '-' + Result;
  2211. 13: Result := Result + '-' + ' ' + CS;
  2212. 14: Result := '(' + CS + ' ' + Result + ')';
  2213. 15: Result := '(' + Result + ' ' + CS + ')';
  2214. end;
  2215. end;
  2216. function FloatToStrF(const Value: double; format: TFloatFormat; Precision,
  2217. Digits: Integer): String;
  2218. begin
  2219. Result:=FloatToStrF(Value,Format,Precision,Digits,Formatsettings);
  2220. end;
  2221. function FloatToStrF(const Value: double; format: TFloatFormat; Precision,
  2222. Digits: Integer ;const aSettings : TFormatSettings): String;
  2223. Var
  2224. TS,DS: string;
  2225. Begin
  2226. DS:=aSettings.DecimalSeparator;
  2227. TS:=aSettings.ThousandSeparator;
  2228. Case format Of
  2229. ffGeneral:
  2230. Result:=FormatGeneralFloat(Value,Precision,DS);
  2231. ffExponent:
  2232. Result:=FormatExponentFloat(Value,Precision,Digits,DS);
  2233. ffFixed:
  2234. Result:=FormatFixedFloat(Value,Digits,DS);
  2235. ffNumber:
  2236. Result:=FormatNumberFloat(Value,Digits,DS,TS);
  2237. ffCurrency:
  2238. Result:=FormatNumberCurrency(Value,Digits,aSettings);
  2239. end;
  2240. if (Format<>ffCurrency) and (length(Result)>1) and (Result[1]='-') then
  2241. RemoveLeadingNegativeSign(Result,DS,TS);
  2242. end;
  2243. function Format(const Fmt: String; const Args: array of const): String;
  2244. begin
  2245. Result:=Format(Fmt,Args,FormatSettings)
  2246. end;
  2247. function Format(const Fmt: String; const Args: array of Const; const aSettings : TFormatSettings): String;
  2248. Var ChPos,OldPos,ArgPos,DoArg,Len : SizeInt;
  2249. Hs,ToAdd : String;
  2250. Index : Byte;
  2251. Width,Prec : Longint;
  2252. Left : Boolean;
  2253. Fchar : char;
  2254. vq : nativeint;
  2255. {
  2256. ReadFormat reads the format string. It returns the type character in
  2257. uppercase, and sets index, Width, Prec to their correct values,
  2258. or -1 if not set. It sets Left to true if left alignment was requested.
  2259. In case of an error, DoFormatError is called.
  2260. }
  2261. Function ReadFormat : Char;
  2262. Var Value : NativeInt;
  2263. Procedure ReadInteger;
  2264. var
  2265. Code: integer;
  2266. ArgN: SizeInt;
  2267. begin
  2268. If Value<>-1 then exit; // Was already read.
  2269. OldPos:=ChPos;
  2270. While (ChPos<=Len) and
  2271. (Fmt[ChPos]<='9') and (Fmt[ChPos]>='0') do inc(ChPos);
  2272. If ChPos>len then
  2273. DoFormatError(feInvalidFormat,Fmt);
  2274. If Fmt[ChPos]='*' then
  2275. begin
  2276. if Index=High(byte) then
  2277. ArgN:=Argpos
  2278. else
  2279. begin
  2280. ArgN:=Index;
  2281. Inc(Index);
  2282. end;
  2283. If (ChPos>OldPos) or (ArgN>High(Args)) then
  2284. DoFormatError(feInvalidFormat,Fmt);
  2285. ArgPos:=ArgN+1;
  2286. case Args[ArgN].Vtype of
  2287. vtInteger: Value := Args[ArgN].VInteger;
  2288. vtNativeInt: Value := Args[ArgN].VNativeInt;
  2289. else
  2290. DoFormatError(feInvalidFormat,Fmt);
  2291. end;
  2292. Inc(ChPos);
  2293. end
  2294. else
  2295. begin
  2296. If (OldPos<ChPos) Then
  2297. begin
  2298. Val (Copy(Fmt,OldPos,ChPos-OldPos),value,code);
  2299. // This should never happen !!
  2300. If Code>0 then DoFormatError (feInvalidFormat,Fmt);
  2301. end
  2302. else
  2303. Value:=-1;
  2304. end;
  2305. end;
  2306. Procedure ReadIndex;
  2307. begin
  2308. If Fmt[ChPos]<>':' then
  2309. ReadInteger
  2310. else
  2311. value:=0; // Delphi undocumented behaviour, assume 0, #11099
  2312. If Fmt[ChPos]=':' then
  2313. begin
  2314. If Value=-1 then DoFormatError(feMissingArgument,Fmt);
  2315. Index:=Value;
  2316. Value:=-1;
  2317. Inc(ChPos);
  2318. end;
  2319. end;
  2320. Procedure ReadLeft;
  2321. begin
  2322. If Fmt[ChPos]='-' then
  2323. begin
  2324. left:=True;
  2325. Inc(ChPos);
  2326. end
  2327. else
  2328. Left:=False;
  2329. end;
  2330. Procedure ReadWidth;
  2331. begin
  2332. ReadInteger;
  2333. If Value<>-1 then
  2334. begin
  2335. Width:=Value;
  2336. Value:=-1;
  2337. end;
  2338. end;
  2339. Procedure ReadPrec;
  2340. begin
  2341. If Fmt[ChPos]='.' then
  2342. begin
  2343. inc(ChPos);
  2344. ReadInteger;
  2345. If Value=-1 then
  2346. Value:=0;
  2347. prec:=Value;
  2348. end;
  2349. end;
  2350. begin
  2351. Index:=High(byte);
  2352. Width:=-1;
  2353. Prec:=-1;
  2354. Value:=-1;
  2355. inc(ChPos);
  2356. If Fmt[ChPos]='%' then
  2357. begin
  2358. Result:='%';
  2359. exit; // VP fix
  2360. end;
  2361. ReadIndex;
  2362. ReadLeft;
  2363. ReadWidth;
  2364. ReadPrec;
  2365. Result:=Upcase(Fmt[ChPos]);
  2366. end;
  2367. function Checkarg (AT : Integer; err:boolean):boolean;
  2368. {
  2369. Check if argument INDEX is of correct type (AT)
  2370. If Index=-1, ArgPos is used, and argpos is augmented with 1
  2371. DoArg is set to the argument that must be used.
  2372. }
  2373. begin
  2374. result:=false;
  2375. if Index=High(Byte) then
  2376. DoArg:=Argpos
  2377. else
  2378. DoArg:=Index;
  2379. ArgPos:=DoArg+1;
  2380. If (Doarg>High(Args)) or (Args[Doarg].VType<>AT) then
  2381. begin
  2382. if err then
  2383. DoFormatError(feInvalidArgindex,Fmt);
  2384. dec(ArgPos);
  2385. exit;
  2386. end;
  2387. result:=true;
  2388. end;
  2389. begin
  2390. Result:='';
  2391. Len:=Length(Fmt);
  2392. ChPos:=1;
  2393. OldPos:=1;
  2394. ArgPos:=0;
  2395. While ChPos<=len do
  2396. begin
  2397. While (ChPos<=Len) and (Fmt[ChPos]<>'%') do
  2398. inc(ChPos);
  2399. If ChPos>OldPos Then
  2400. Result:=Result+Copy(Fmt,OldPos,ChPos-Oldpos);
  2401. If ChPos<Len then
  2402. begin
  2403. FChar:=ReadFormat;
  2404. {$ifdef fmtdebug}
  2405. DumpFormat(FCHar);
  2406. {$endif}
  2407. Case FChar of
  2408. 'D' : begin
  2409. if Checkarg(vtinteger,false) then
  2410. toAdd:=IntToStr(Args[DoArg].VInteger)
  2411. else if CheckArg(vtNativeInt,True) then
  2412. toAdd:=IntToStr(Args[DoArg].VNativeInt);
  2413. Width:=Abs(width);
  2414. Index:=Prec-Length(ToAdd);
  2415. If ToAdd[1]<>'-' then
  2416. ToAdd:=StringOfChar('0',Index)+ToAdd
  2417. else
  2418. // + 1 to accomodate for - sign in length !!
  2419. Insert(StringOfChar('0',Index+1),toadd,2);
  2420. end;
  2421. 'U' : begin
  2422. if Checkarg(vtinteger,false) then
  2423. toAdd:=IntToStr(Cardinal(Args[DoArg].VInteger))
  2424. else if CheckArg(vtNativeInt,True) then
  2425. toAdd:=IntToStr(NativeUInt(Args[DoArg].VNativeInt));
  2426. Width:=Abs(width);
  2427. Index:=Prec-Length(ToAdd);
  2428. ToAdd:=StringOfChar('0',Index)+ToAdd
  2429. end;
  2430. 'E' : begin
  2431. if CheckArg(vtCurrency,false) then
  2432. ToAdd:=FloatToStrF(Args[doarg].VCurrency,ffExponent,3,Prec,aSettings)
  2433. else if CheckArg(vtExtended,True) then
  2434. ToAdd:=FloatToStrF(Args[doarg].VExtended,ffExponent,3,Prec,aSettings);
  2435. end;
  2436. 'F' : begin
  2437. if CheckArg(vtCurrency,false) then
  2438. ToAdd:=FloatToStrF(Args[doarg].VCurrency,ffFixed,9999,Prec,aSettings)
  2439. else if CheckArg(vtExtended,True) then
  2440. ToAdd:=FloatToStrF(Args[doarg].VExtended,ffFixed,9999,Prec,aSettings);
  2441. end;
  2442. 'G' : begin
  2443. if CheckArg(vtCurrency,false) then
  2444. ToAdd:=FloatToStrF(Args[doarg].VCurrency,ffGeneral,Prec,3,aSettings)
  2445. else if CheckArg(vtExtended,True) then
  2446. ToAdd:=FloatToStrF(Args[doarg].VExtended,ffGeneral,Prec,3,aSettings);
  2447. end;
  2448. 'N' : begin
  2449. if CheckArg(vtCurrency,false) then
  2450. ToAdd:=FloatToStrF(Args[doarg].VCurrency,ffNumber,9999,Prec,aSettings)
  2451. else if CheckArg(vtExtended,True) then
  2452. ToAdd:=FloatToStrF(Args[doarg].VExtended,ffNumber,9999,Prec,aSettings);
  2453. end;
  2454. 'M' : begin
  2455. if CheckArg(vtCurrency,false) then
  2456. ToAdd:=FloatToStrF(Args[doarg].VCurrency,ffCurrency,9999,Prec,aSettings)
  2457. else if CheckArg(vtExtended,True) then
  2458. ToAdd:=FloatToStrF(Args[doarg].VExtended,ffCurrency,9999,Prec,aSettings);
  2459. end;
  2460. 'S' : begin
  2461. if CheckArg(vtUnicodeString,false) then
  2462. hs:=Args[doarg].VUnicodeString
  2463. else if CheckArg(vtWideChar,True) then
  2464. hs:=Args[doarg].VWideChar;
  2465. Index:=Length(hs);
  2466. If (Prec<>-1) and (Index>Prec) then
  2467. Index:=Prec;
  2468. ToAdd:=Copy(hs,1,Index);
  2469. end;
  2470. 'P' : Begin
  2471. if CheckArg(vtInteger,false) then
  2472. ToAdd:=IntToHex(Args[DoArg].VInteger,8)
  2473. else if CheckArg(vtInteger,true) then
  2474. ToAdd:=IntToHex(Args[DoArg].VNativeInt,16);
  2475. end;
  2476. 'X' : begin
  2477. if Checkarg(vtinteger,false) then
  2478. begin
  2479. vq:=Args[Doarg].VInteger;
  2480. Index:=16;
  2481. end
  2482. else if Checkarg(vtNativeint,True) then
  2483. begin
  2484. vq:=Args[Doarg].VNativeInt;
  2485. index:=31; // May need to adjust to NativeInt
  2486. end;
  2487. If Prec>index then
  2488. ToAdd:=IntToHex(vq,index)
  2489. else
  2490. begin
  2491. // determine minimum needed number of hex digits.
  2492. Index:=1;
  2493. While (NativeInt(1) shl (Index*4)<=vq) and (index<16) do
  2494. inc(Index);
  2495. If Index>Prec then
  2496. Prec:=Index;
  2497. ToAdd:=IntToHex(vq,Prec);
  2498. end;
  2499. end;
  2500. '%': ToAdd:='%';
  2501. end;
  2502. If Width<>-1 then
  2503. If Length(ToAdd)<Width then
  2504. If not Left then
  2505. ToAdd:=StringOfChar(' ',Width-Length(ToAdd))+ToAdd
  2506. else
  2507. ToAdd:=ToAdd+StringOfChar(' ',Width-Length(ToAdd));
  2508. Result:=Result+ToAdd;
  2509. end;
  2510. inc(ChPos);
  2511. Oldpos:=ChPos;
  2512. end;
  2513. end;
  2514. function BytesOf(const AVal: string): TBytes;
  2515. var
  2516. I: SizeUInt;
  2517. begin
  2518. SetLength(Result, Length(AVal));
  2519. for I := 0 to Length(AVal)-1 do
  2520. Result[I] := Ord(AVal[I+1]);
  2521. end;
  2522. function StringOf(const ABytes: TBytes): string;
  2523. var
  2524. I: Integer;
  2525. begin
  2526. Result:='';
  2527. for I := 0 to Length(ABytes)-1 do
  2528. Result:=Result+Char(ABytes[I]);
  2529. end;
  2530. function LocaleCompare(const s1, s2, locales: String): Boolean; assembler;
  2531. asm
  2532. return s1.localeCompare(s2,locales) == 0;
  2533. end;
  2534. function NormalizeStr(const S: String; const Norm: String): String; assembler;
  2535. asm
  2536. return S.normalize(Norm);
  2537. end;
  2538. function IsValidIdent(const Ident: string; AllowDots: Boolean = False; StrictDots: Boolean = False): Boolean;
  2539. const
  2540. Alpha = ['A'..'Z', 'a'..'z', '_'];
  2541. AlphaNum = Alpha + ['0'..'9'];
  2542. Dot = '.';
  2543. var
  2544. First: Boolean;
  2545. I, Len: Integer;
  2546. begin
  2547. Len := Length(Ident);
  2548. if Len < 1 then
  2549. Exit(False);
  2550. First := True;
  2551. Result:=false;
  2552. I:=1;
  2553. While I<=len do
  2554. begin
  2555. if First then
  2556. begin
  2557. if not (Ident[I] in Alpha) then exit;
  2558. First := False;
  2559. end
  2560. else if AllowDots and (Ident[I] = Dot) then
  2561. begin
  2562. if StrictDots then
  2563. begin
  2564. if I >= Len then exit;
  2565. First := True;
  2566. end;
  2567. end
  2568. else
  2569. if not (Ident[I] in AlphaNum) then exit;
  2570. I:=I+1;
  2571. end;
  2572. Result:=true;
  2573. end;
  2574. procedure FreeAndNil(var Obj);
  2575. var
  2576. o: TObject;
  2577. begin
  2578. o:=TObject(Obj);
  2579. if o=nil then exit;
  2580. TObject(Obj):=nil;
  2581. o.Destroy;
  2582. end;
  2583. { EVariantError }
  2584. constructor EVariantError.CreateCode(Code: Longint);
  2585. begin
  2586. ErrCode:=Code;
  2587. end;
  2588. { Exception }
  2589. constructor Exception.Create(const Msg: String);
  2590. begin
  2591. fMessage:=Msg;
  2592. {$ifdef nodejs}
  2593. FNodeJSError:=TJSError.new;
  2594. {$endif}
  2595. if LogMessageOnCreate then
  2596. Writeln('Created exception ',ClassName,' with message: ',Msg);
  2597. end;
  2598. constructor Exception.CreateFmt(const Msg: string; const Args: array of Const
  2599. );
  2600. begin
  2601. //writeln('Exception.CreateFmt START ',ClassName,' "',Msg,'" Args=',Args);
  2602. Create(Format(Msg,Args));
  2603. //writeln('Exception.CreateFmt END ',ClassName,' "',Msg,'" fMessage=',fMessage);
  2604. end;
  2605. constructor Exception.CreateHelp(const Msg: String; AHelpContext: Integer);
  2606. begin
  2607. Create(Msg);
  2608. fHelpContext:=AHelpContext;
  2609. end;
  2610. constructor Exception.CreateFmtHelp(const Msg: string;
  2611. const Args: array of Const; AHelpContext: Integer);
  2612. begin
  2613. Create(Format(Msg,Args));
  2614. fHelpContext:=AHelpContext;
  2615. end;
  2616. function Exception.ToString: String;
  2617. begin
  2618. Result:=ClassName+': '+Message;
  2619. end;
  2620. Const
  2621. RESpecials = '([\$\+\[\]\(\)\\\.\*\^\?\|])';
  2622. function StringReplace(aOriginal, aSearch, aReplace: string;
  2623. Flags: TStringReplaceFlags): String;
  2624. Var
  2625. REFlags : String;
  2626. REString : String;
  2627. begin
  2628. REFlags:='';
  2629. if rfReplaceAll in flags then
  2630. ReFlags:='g';
  2631. if rfIgnoreCase in flags then
  2632. ReFlags:=ReFlags+'i';
  2633. REString:=TJSString(aSearch).replace(TJSRegexp.new(RESpecials,'g'),'\$1');
  2634. Result:=TJSString(aOriginal).replace(TJSRegexp.new(REString,REFlags),aReplace);
  2635. end;
  2636. function QuoteString(aOriginal: String; AQuote: Char): String;
  2637. begin
  2638. Result:=AQuote+StringReplace(aOriginal,aQuote,aQuote+aQuote,[rfReplaceAll])+AQuote;
  2639. end;
  2640. function QuotedStr(const s: string; QuoteChar : Char = ''''): string;
  2641. begin
  2642. Result:=QuoteString(S,QuoteChar);
  2643. end;
  2644. function DeQuoteString(aQuoted: String; AQuote: Char): String;
  2645. var
  2646. i: Integer;
  2647. begin
  2648. Result:=aQuoted;
  2649. if TJSString(Result).substr(0,1)<>AQuote then exit;
  2650. Result:=TJSString(Result).slice(1);
  2651. i:=1;
  2652. while i<=length(Result) do
  2653. begin
  2654. if Result[i]=AQuote then
  2655. begin
  2656. if (i=length(Result)) or (Result[i+1]<>AQuote) then
  2657. begin
  2658. Result:=TJSString(Result).slice(0,i-1);
  2659. exit;
  2660. end
  2661. else
  2662. Result:=TJSString(Result).slice(0,i-1)+TJSString(Result).slice(i);
  2663. end
  2664. else
  2665. inc(i);
  2666. end;
  2667. end;
  2668. function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean;
  2669. begin
  2670. Result:=False;
  2671. if (Index>0) and (Index<=Length(S)) then
  2672. Result:=Pos(S[Index],Delimiters)<>0; // Note we don't do MBCS yet
  2673. end;
  2674. Function LastDelimiter(const Delimiters, S: string): SizeInt;
  2675. begin
  2676. Result:=Length(S);
  2677. While (Result>0) and (Pos(S[Result],Delimiters)=0) do
  2678. Dec(Result);
  2679. end;
  2680. function AdjustLineBreaks(const S: string): string;
  2681. begin
  2682. Result:=AdjustLineBreaks(S,DefaultTextLineBreakStyle);
  2683. end;
  2684. function AdjustLineBreaks(const S: string; Style: TTextLineBreakStyle): string;
  2685. var
  2686. I,L: Longint;
  2687. Res : String;
  2688. Procedure Add(C : Char);
  2689. begin
  2690. Res:=Res+C;
  2691. end;
  2692. begin
  2693. I:=0;
  2694. L:=Length(S);
  2695. Result:='';
  2696. While (I<=L) do
  2697. case S[I] of
  2698. #10: begin
  2699. if Style in [tlbsCRLF,tlbsCR] then
  2700. Add(#13);
  2701. if Style=tlbsCRLF then
  2702. Add(#10);
  2703. Inc(I);
  2704. end;
  2705. #13: begin
  2706. if Style=tlbsCRLF then
  2707. Add(#13);
  2708. Add(#10);
  2709. Inc(I);
  2710. if S[I]=#10 then
  2711. Inc(I);
  2712. end;
  2713. else
  2714. Add(S[i]);
  2715. Inc(I);
  2716. end;
  2717. Result:=Res;
  2718. end;
  2719. function WrapText(const Line, BreakStr: string;
  2720. const BreakChars: array of char; MaxCol: Integer): string;
  2721. const
  2722. Quotes = ['''', '"'];
  2723. Var
  2724. L : String;
  2725. C,LQ,BC : Char;
  2726. P,BLen,Len : Integer;
  2727. HB,IBC : Boolean;
  2728. begin
  2729. Result:='';
  2730. L:=Line;
  2731. Blen:=Length(BreakStr);
  2732. If (BLen>0) then
  2733. BC:=BreakStr[1]
  2734. else
  2735. BC:=#0;
  2736. Len:=Length(L);
  2737. While (Len>0) do
  2738. begin
  2739. P:=1;
  2740. LQ:=#0;
  2741. HB:=False;
  2742. IBC:=False;
  2743. While ((P<=Len) and ((P<=MaxCol) or not IBC)) and ((LQ<>#0) or Not HB) do
  2744. begin
  2745. C:=L[P];
  2746. If (C=LQ) then
  2747. LQ:=#0
  2748. else If (C in Quotes) then
  2749. LQ:=C;
  2750. If (LQ<>#0) then
  2751. Inc(P)
  2752. else
  2753. begin
  2754. HB:=((C=BC) and (BreakStr=Copy(L,P,BLen)));
  2755. If HB then
  2756. Inc(P,Blen)
  2757. else
  2758. begin
  2759. If (P>=MaxCol) then
  2760. IBC:=CharInSet(C,BreakChars);
  2761. Inc(P);
  2762. end;
  2763. end;
  2764. // Writeln('"',C,'" : IBC : ',IBC,' HB : ',HB,' LQ : ',LQ,' P>MaxCol : ',P>MaxCol);
  2765. end;
  2766. Result:=Result+Copy(L,1,P-1);
  2767. Delete(L,1,P-1);
  2768. Len:=Length(L);
  2769. If (Len>0) and Not HB then
  2770. Result:=Result+BreakStr;
  2771. end;
  2772. end;
  2773. function WrapText(const Line: string; MaxCol: Integer): string;
  2774. begin
  2775. Result:=WrapText(Line,sLineBreak, [' ', '-', #9], MaxCol);
  2776. end;
  2777. function GetEnvironmentVariable(const EnvVar: String): String;
  2778. begin
  2779. if Assigned(OnGetEnvironmentVariable) then
  2780. Result:=OnGetEnvironmentVariable(EnvVar)
  2781. else
  2782. Result:='';
  2783. end;
  2784. function GetEnvironmentVariableCount: Integer;
  2785. begin
  2786. if Assigned(OnGetEnvironmentVariableCount) then
  2787. Result:=OnGetEnvironmentVariableCount()
  2788. else
  2789. Result:=0;
  2790. end;
  2791. function GetEnvironmentString(Index: Integer): String;
  2792. begin
  2793. if Assigned(OnGetEnvironmentString) then
  2794. Result:=OnGetEnvironmentString(Index)
  2795. else
  2796. Result:='';
  2797. end;
  2798. { Date/Time routines}
  2799. Function DoEncodeDate(Year, Month, Day: Word): longint;
  2800. Var
  2801. D : TDateTime;
  2802. begin
  2803. If TryEncodeDate(Year,Month,Day,D) then
  2804. Result:=Trunc(D)
  2805. else
  2806. Result:=0;
  2807. end;
  2808. function DoEncodeTime(Hour, Minute, Second, MilliSecond: word): TDateTime;
  2809. begin
  2810. If not TryEncodeTime(Hour,Minute,Second,MilliSecond,Result) then
  2811. Result:=0;
  2812. end;
  2813. function DateTimeToJSDate(aDateTime: TDateTime): TJSDate;
  2814. Var
  2815. Y,M,D,h,n,s,z : Word;
  2816. begin
  2817. DecodeDate(Trunc(aDateTime),Y,M,D);
  2818. DecodeTime(Frac(aDateTime),H,N,S,Z);
  2819. Result:=TJSDate.New(Y,M-1,D,h,n,s,z);
  2820. end;
  2821. function JSDateToDateTime(aDate: TJSDate): TDateTime;
  2822. begin
  2823. Result:=EncodeDate(ADate.FullYear,ADate.Month+1,ADate.Date) +
  2824. EncodeTime(ADate.Hours,ADate.Minutes,ADate.Seconds,ADate.Milliseconds);
  2825. end;
  2826. { ComposeDateTime converts a Date and a Time into one TDateTime }
  2827. function ComposeDateTime(Date,Time : TDateTime) : TDateTime;
  2828. begin
  2829. if Date < 0 then
  2830. Result := trunc(Date) - Abs(frac(Time))
  2831. else
  2832. Result := trunc(Date) + Abs(frac(Time));
  2833. end;
  2834. function TryEncodeDate(Year, Month, Day: Word; out Date: TDateTime): Boolean;
  2835. var
  2836. c, ya: LongWord;
  2837. begin
  2838. Result:=(Year>0) and (Year<10000) and
  2839. (Month >= 1) and (Month<=12) and
  2840. (Day>0) and (Day<=MonthDays[IsleapYear(Year),Month]);
  2841. If Result then
  2842. begin
  2843. if month > 2 then
  2844. Dec(Month,3)
  2845. else
  2846. begin
  2847. Inc(Month,9);
  2848. Dec(Year);
  2849. end;
  2850. c:= Year DIV 100;
  2851. ya:= Year - 100*c;
  2852. Date := (146097*c) SHR 2 + (1461*ya) SHR 2 + (153*LongWord(Month)+2) DIV 5 + LongWord(Day);
  2853. // Note that this line can't be part of the line above, since TDateTime is
  2854. // signed and c and ya are not
  2855. Date := Date - 693900;
  2856. end
  2857. end;
  2858. function TryEncodeTime(Hour, Min, Sec, MSec: Word; out Time: TDateTime
  2859. ): Boolean;
  2860. begin
  2861. Result:=(Hour<24) and (Min<60) and (Sec<60) and (MSec<1000);
  2862. If Result then
  2863. Time:=TDateTime(LongWord(Hour)*3600000+LongWord(Min)*60000+LongWord(Sec)*1000+MSec)/MSecsPerDay;
  2864. end;
  2865. { EncodeDate packs three variables Year, Month and Day into a
  2866. TDateTime value the result is the number of days since 12/30/1899 }
  2867. function EncodeDate(Year, Month, Day: word): TDateTime;
  2868. begin
  2869. If Not TryEncodeDate(Year,Month,Day,Result) then
  2870. Raise EConvertError.CreateFmt('%s-%s-%s is not a valid date specification',
  2871. [IntToStr(Year),IntToStr(Month),IntToStr(Day)]);
  2872. end;
  2873. { EncodeTime packs four variables Hour, Minute, Second and MilliSecond into
  2874. a TDateTime value }
  2875. function EncodeTime(Hour, Minute, Second, MilliSecond:word):TDateTime;
  2876. begin
  2877. If not TryEncodeTime(Hour,Minute,Second,MilliSecond,Result) then
  2878. Raise EConvertError.CreateFmt('%s:%s:%s.%s is not a valid time specification',
  2879. [IntToStr(Hour),IntToStr(Minute),IntToStr(Second),IntToStr(MilliSecond)]);
  2880. end;
  2881. { DecodeDate unpacks the value Date into three values:
  2882. Year, Month and Day }
  2883. procedure DecodeDate(Date: TDateTime; out Year, Month, Day: word);
  2884. var
  2885. ly,ld,lm,j : LongWord;
  2886. begin
  2887. if Date <= -datedelta then // If Date is before 1-1-1 then return 0-0-0
  2888. begin
  2889. Year := 0;
  2890. Month := 0;
  2891. Day := 0;
  2892. end
  2893. else
  2894. begin
  2895. if Date>0 then
  2896. Date:=(Date+(1/(msecsperday*2)))
  2897. else
  2898. Date:=Date-(1/(msecsperday*2));
  2899. if Date>MaxDateTime then
  2900. Date:=MaxDateTime;
  2901. // Raise EConvertError.CreateFmt('%f is not a valid TDatetime encoding, maximum value is %f.',[Date,MaxDateTime]);
  2902. j := ((Trunc(Date) + 693900) SHL 2)-1;
  2903. ly:= j DIV 146097;
  2904. j:= j - 146097 * LongWord(ly);
  2905. ld := j SHR 2;
  2906. j:=(ld SHL 2 + 3) DIV 1461;
  2907. ld:= ((ld SHL 2) + 7 - 1461*j) SHR 2;
  2908. lm:=(5 * ld-3) DIV 153;
  2909. ld:= (5 * ld +2 - 153*lm) DIV 5;
  2910. ly:= 100 * LongWord(ly) + j;
  2911. if lm < 10 then
  2912. inc(lm,3)
  2913. else
  2914. begin
  2915. dec(lm,9);
  2916. inc(ly);
  2917. end;
  2918. year:=ly;
  2919. month:=lm;
  2920. day:=ld;
  2921. end;
  2922. end;
  2923. function DecodeDateFully(const DateTime: TDateTime; out Year, Month, Day, DOW: Word): Boolean;
  2924. begin
  2925. DecodeDate(DateTime,Year,Month,Day);
  2926. DOW:=DayOfWeek(DateTime);
  2927. Result:=IsLeapYear(Year);
  2928. end;
  2929. { DateTimeToTimeStamp converts DateTime to a TTimeStamp }
  2930. function DateTimeToTimeStamp(DateTime: TDateTime): TTimeStamp;
  2931. Var
  2932. D : Double;
  2933. begin
  2934. D:=DateTime * Double(MSecsPerDay);
  2935. if D<0 then
  2936. D:=D-0.5
  2937. else
  2938. D:=D+0.5;
  2939. result.Time := Trunc(Abs(Trunc(D)) Mod MSecsPerDay);
  2940. result.Date := DateDelta + (Trunc(D) div MSecsPerDay);
  2941. end;
  2942. { TimeStampToDateTime converts TimeStamp to a TDateTime value }
  2943. function TimeStampToDateTime(const TimeStamp: TTimeStamp): TDateTime;
  2944. begin
  2945. Result := ComposeDateTime(TimeStamp.Date - DateDelta,TimeStamp.Time/MSecsPerDay)
  2946. end;
  2947. { MSecsToTimeStamp }
  2948. function MSecsToTimeStamp(MSecs: NativeInt): TTimeStamp;
  2949. begin
  2950. result.Date := Trunc(msecs/msecsperday);
  2951. msecs:= msecs-NativeInt(result.date)*msecsperday;
  2952. result.Time := Round(MSecs);
  2953. end;
  2954. function TimeStampToMSecs(const TimeStamp: TTimeStamp): NativeInt;
  2955. begin
  2956. result := TimeStamp.Time + (timestamp.date*msecsperday);
  2957. end ;
  2958. { DecodeTime unpacks Time into four values:
  2959. Hour, Minute, Second and MilliSecond }
  2960. procedure DecodeTime(Time: TDateTime; out Hour, Minute, Second, MilliSecond: word);
  2961. Var
  2962. l : LongWord;
  2963. begin
  2964. l := DateTimeToTimeStamp(Time).Time;
  2965. Hour := l div 3600000;
  2966. l := l mod 3600000;
  2967. Minute := l div 60000;
  2968. l := l mod 60000;
  2969. Second := l div 1000;
  2970. l := l mod 1000;
  2971. MilliSecond := l;
  2972. end;
  2973. { DateTimeToSystemTime converts DateTime value to SystemTime }
  2974. procedure DateTimeToSystemTime(DateTime: TDateTime; out SystemTime: TSystemTime);
  2975. begin
  2976. DecodeDateFully(DateTime, SystemTime.Year, SystemTime.Month, SystemTime.Day,SystemTime.DayOfWeek);
  2977. DecodeTime(DateTime, SystemTime.Hour, SystemTime.Minute, SystemTime.Second, SystemTime.MilliSecond);
  2978. Dec(SystemTime.DayOfWeek);
  2979. end ;
  2980. { SystemTimeToDateTime converts SystemTime to a TDateTime value }
  2981. function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime;
  2982. begin
  2983. result := ComposeDateTime(DoEncodeDate(SystemTime.Year, SystemTime.Month, SystemTime.Day),
  2984. DoEncodeTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second, SystemTime.MilliSecond));
  2985. end ;
  2986. function DayOfWeek(DateTime: TDateTime): integer;
  2987. begin
  2988. Result:= 1+((Trunc(DateTime) - 1) mod 7);
  2989. If (Result<=0) then
  2990. Inc(Result,7);
  2991. end;
  2992. function Now: TDateTime;
  2993. begin
  2994. Result:=JSDateToDateTime(TJSDate.New());
  2995. end;
  2996. function Date: TDateTime;
  2997. begin
  2998. Result:=Trunc(Now);
  2999. end;
  3000. function Time: TDateTime;
  3001. begin
  3002. Result:=Now-Date;
  3003. end ;
  3004. { IncMonth increments DateTime with NumberOfMonths months,
  3005. NumberOfMonths can be less than zero }
  3006. function IncMonth(const DateTime: TDateTime; NumberOfMonths: integer = 1 ): TDateTime;
  3007. var
  3008. Year, Month, Day : word;
  3009. begin
  3010. DecodeDate(DateTime, Year, Month, Day);
  3011. IncAMonth(Year, Month, Day, NumberOfMonths);
  3012. result := ComposeDateTime(DoEncodeDate(Year, Month, Day), DateTime);
  3013. end ;
  3014. { IncAMonth is the same as IncMonth, but operates on decoded date }
  3015. procedure IncAMonth(var Year, Month, Day: Word; NumberOfMonths: Integer = 1);
  3016. var
  3017. TempMonth, S: Integer;
  3018. begin
  3019. If NumberOfMonths>=0 then
  3020. s:=1
  3021. else
  3022. s:=-1;
  3023. inc(Year,(NumberOfMonths div 12));
  3024. TempMonth:=Month+(NumberOfMonths mod 12)-1;
  3025. if (TempMonth>11) or
  3026. (TempMonth<0) then
  3027. begin
  3028. Dec(TempMonth, S*12);
  3029. Inc(Year, S);
  3030. end;
  3031. Month:=TempMonth+1; { Months from 1 to 12 }
  3032. If (Day>MonthDays[IsLeapYear(Year)][Month]) then
  3033. Day:=MonthDays[IsLeapYear(Year)][Month];
  3034. end;
  3035. { IsLeapYear returns true if Year is a leap year }
  3036. function IsLeapYear(Year: Word): boolean;
  3037. begin
  3038. Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));
  3039. end;
  3040. { DateToStr returns a string representation of Date using ShortDateFormat }
  3041. function DateToStr(Date: TDateTime): string;
  3042. begin
  3043. Result:=DateToStr(Date,FormatSettings);
  3044. end;
  3045. function DateToStr(Date: TDateTime; const aSettings : TFormatSettings): string;
  3046. begin
  3047. Result:=FormatDateTime('ddddd', Date, aSettings);
  3048. end ;
  3049. { TimeToStr returns a string representation of Time using LongTimeFormat }
  3050. function TimeToStr(Time: TDateTime): string;
  3051. begin
  3052. Result:=TimeToStr(Time,FormatSettings);
  3053. end;
  3054. function TimeToStr(Time: TDateTime; const aSettings : TFormatSettings): string;
  3055. begin
  3056. Result:=FormatDateTime('tt',Time,aSettings);
  3057. end ;
  3058. { DateTimeToStr returns a string representation of DateTime using LongDateTimeFormat }
  3059. Var
  3060. DateTimeToStrFormat : Array[Boolean] of string = ('c','f');
  3061. function DateTimeToStr(DateTime: TDateTime; ForceTimeIfZero : Boolean = False): string;
  3062. begin
  3063. Result:=DateTimeToStr(DateTime,FormatSettings,ForceTimeIfZero);
  3064. end;
  3065. function DateTimeToStr(DateTime: TDateTime; Const aSettings : TFormatSettings; ForceTimeIfZero : Boolean = False): string;
  3066. begin
  3067. Result:=FormatDateTime(DateTimeToStrFormat[ForceTimeIfZero], DateTime,aSettings)
  3068. end ;
  3069. { StrToDate converts the string S to a TDateTime value
  3070. if S does not represent a valid date value
  3071. an EConvertError will be raised }
  3072. function IntStrToDate(Out ErrorMsg : String; const S: String; const useformat : string; separator : char): TDateTime;
  3073. Const
  3074. WhiteSpace = ' '#8#9#10#12#13;
  3075. Digits = '0123456789';
  3076. procedure FixErrorMsg(const errmarg : String);
  3077. begin
  3078. ErrorMsg:=Format(SInvalidDateFormat,[errmarg]);
  3079. end;
  3080. var
  3081. df:string;
  3082. d,m,y,ly,ld,lm:word;
  3083. n,i,len:longint;
  3084. c: integer;
  3085. dp,mp,yp,which : Byte;
  3086. s1:string;
  3087. values: array of integer;
  3088. YearMoreThenTwoDigits : boolean;
  3089. begin
  3090. SetLength(values,4);
  3091. Result:=0;
  3092. Len:=Length(S);
  3093. ErrorMsg:='';
  3094. While (Len>0) and (Pos(S[Len],WhiteSpace)>0) do
  3095. Dec(len);
  3096. if (Len=0) then
  3097. begin
  3098. FixErrorMsg(S);
  3099. exit;
  3100. end;
  3101. YearMoreThenTwoDigits := False;
  3102. if separator = #0 then
  3103. if (FormatSettings.DateSeparator<>#0) then
  3104. separator := FormatSettings.DateSeparator
  3105. else
  3106. separator:='-';
  3107. // Writeln('Separator: ',Separator);
  3108. df := UpperCase(useFormat);
  3109. { Determine order of D,M,Y }
  3110. yp:=0;
  3111. mp:=0;
  3112. dp:=0;
  3113. Which:=0;
  3114. i:=0;
  3115. while (i<Length(df)) and (Which<3) do
  3116. begin
  3117. inc(i);
  3118. Case df[i] of
  3119. 'Y' :
  3120. if yp=0 then
  3121. begin
  3122. Inc(Which);
  3123. yp:=which;
  3124. end;
  3125. 'M' :
  3126. if mp=0 then
  3127. begin
  3128. Inc(Which);
  3129. mp:=which;
  3130. end;
  3131. 'D' :
  3132. if dp=0 then
  3133. begin
  3134. Inc(Which);
  3135. dp:=which;
  3136. end;
  3137. end;
  3138. end;
  3139. // Writeln('YP: ',Yp,', MP: ',Mp,', DP: ',DP);
  3140. for i := 1 to 3 do
  3141. values[i] := 0;
  3142. s1 := '';
  3143. n := 0;
  3144. for i := 1 to len do
  3145. begin
  3146. if Pos(s[i],Digits)>0 then
  3147. s1 := s1 + s[i];
  3148. { space can be part of the shortdateformat, and is defaultly in slovak
  3149. windows, therefor it shouldn't be taken as separator (unless so specified)
  3150. and ignored }
  3151. if (Separator <> ' ') and (s[i] = ' ') then
  3152. Continue;
  3153. if (s[i] = separator) or ((i = len) and (Pos(s[i],Digits)>0)) then
  3154. begin
  3155. inc(n);
  3156. if n>3 then
  3157. begin
  3158. // Writeln('More than 3 separators');
  3159. FixErrorMsg(S);
  3160. exit;
  3161. end;
  3162. // Check if the year has more then two digits (if n=yp, then we are evaluating the year.)
  3163. if (n=yp) and (length(s1)>2) then YearMoreThenTwoDigits := True;
  3164. val(s1, values[n], c);
  3165. if c<>0 then
  3166. begin
  3167. // Writeln('S1 not a number ',S1);
  3168. FixErrorMsg(s);
  3169. Exit;
  3170. end;
  3171. s1 := '';
  3172. end
  3173. else if (Pos(s[i],Digits)=0) then
  3174. begin
  3175. // Writeln('Not a number at pos ',I,' ',S[i]);
  3176. FixErrorMsg(s);
  3177. Exit;
  3178. end;
  3179. end ;
  3180. // Writeln('Which : ',Which,' N : ',N);
  3181. if (Which<3) and (N>Which) then
  3182. begin
  3183. FixErrorMsg(s);
  3184. Exit;
  3185. end;
  3186. // Fill in values.
  3187. DecodeDate(Date,Ly,LM,LD);
  3188. If N=3 then
  3189. begin
  3190. y:=values[yp];
  3191. m:=values[mp];
  3192. d:=values[dp];
  3193. end
  3194. Else
  3195. begin
  3196. Y:=ly;
  3197. If n<2 then
  3198. begin
  3199. d:=values[1];
  3200. m := LM;
  3201. end
  3202. else
  3203. If dp<mp then
  3204. begin
  3205. d:=values[1];
  3206. m:=values[2];
  3207. end
  3208. else
  3209. begin
  3210. d:=values[2];
  3211. m:=values[1];
  3212. end;
  3213. end;
  3214. if (y >= 0) and (y < 100) and not YearMoreThenTwoDigits then
  3215. begin
  3216. ly := ly - TwoDigitYearCenturyWindow;
  3217. Inc(Y, ly div 100 * 100);
  3218. if (TwoDigitYearCenturyWindow > 0) and (Y < ly) then
  3219. Inc(Y, 100);
  3220. end;
  3221. if not TryEncodeDate(y, m, d, result) then
  3222. errormsg:=SErrInvalidDate;
  3223. end;
  3224. function StrToDate(const S: String; const useformat : string; separator : char): TDateTime;
  3225. Var
  3226. MSg : String;
  3227. begin
  3228. Result:=IntStrToDate(Msg,S,useFormat,Separator);
  3229. If (Msg<>'') then
  3230. Raise EConvertError.Create(Msg);
  3231. end;
  3232. function StrToDate(const S: String; const aSettings : TFormatSettings): TDateTime;
  3233. begin
  3234. Result:=StrToDate(S,aSettings.ShortDateFormat,aSettings.DateSeparator);
  3235. end;
  3236. function StrToDate(const S: String): TDateTime;
  3237. begin
  3238. result:=StrToDate(S,FormatSettings);
  3239. end;
  3240. function StrToDate(const S: String; separator : char): TDateTime;
  3241. begin
  3242. result := StrToDate(S,FormatSettings.ShortDateFormat,separator)
  3243. end;
  3244. { StrToTime converts the string S to a TDateTime value
  3245. if S does not represent a valid time value an
  3246. EConvertError will be raised }
  3247. function IntStrToTime(Out ErrorMsg : String; const S: String; Len : integer; Const aSettings : TFormatSettings): TDateTime;
  3248. const
  3249. AMPM_None = 0;
  3250. AMPM_AM = 1;
  3251. AMPM_PM = 2;
  3252. tiHour = 0;
  3253. tiMin = 1;
  3254. tiSec = 2;
  3255. tiMSec = 3;
  3256. type
  3257. TTimeValues = array of Word;
  3258. var
  3259. AmPm: integer;
  3260. TimeValues: TTimeValues;
  3261. function SplitElements(out TimeValues: TTimeValues; out AmPm: Integer): Boolean;
  3262. //Strict version. It does not allow #32 as Separator, it will treat it as whitespace always
  3263. const
  3264. Digits = '0123456789';
  3265. var
  3266. Cur, Offset, ElemLen, Err, TimeIndex, FirstSignificantDigit: Integer;
  3267. Value: Integer;
  3268. DigitPending, MSecPending: Boolean;
  3269. AmPmStr: String;
  3270. CurChar: Char;
  3271. I : Integer;
  3272. allowedchars : string;
  3273. begin
  3274. Result := False;
  3275. AmPm := AMPM_None; //No Am or PM in string found yet
  3276. MSecPending := False;
  3277. TimeIndex := 0; //indicating which TTimeValue must be filled next
  3278. For I:=tiHour to tiMSec do
  3279. TimeValues[i]:=0;
  3280. Cur := 1;
  3281. //skip leading blanks
  3282. While (Cur < Len) and (S[Cur] =#32) do Inc(Cur);
  3283. Offset := Cur;
  3284. //First non-blank cannot be Separator or DecimalSeparator
  3285. if (Cur > Len - 1) or (S[Cur] = aSettings.TimeSeparator) or (S[Cur] = aSettings.Decimalseparator) then
  3286. begin
  3287. // Writeln('Error in sep S[Cur]',S[Cur],' ',separator,' ',GetDecimalSeparator);
  3288. Exit;
  3289. end;
  3290. DigitPending := (Pos(S[Cur],Digits)>0);
  3291. While (Cur <= Len) do
  3292. begin
  3293. //writeln;
  3294. // writeln('Main While loop: Cur = ',Cur,' S[Cur] = "',S[Cur],'" Len = ',Len,' separator : ',Separator);
  3295. CurChar := S[Cur];
  3296. if Pos(CurChar,Digits)>0 then
  3297. begin//Digits
  3298. //HH, MM, SS, or Msec?
  3299. // writeln('Digit: ', CurChar);
  3300. //Digits are only allowed after starting Am/PM or at beginning of string or after Separator
  3301. //and TimeIndex must be <= tiMSec
  3302. //Uncomment "or (#32 = Separator)" and it will allllow #32 as separator
  3303. if (not (DigitPending {or (#32 = Separator)})) or (TimeIndex > tiMSec) then
  3304. begin
  3305. // Writeln('DigitPending',ElemLen);
  3306. Exit;
  3307. end;
  3308. OffSet := Cur;
  3309. if (CurChar <> '0') then FirstSignificantDigit := OffSet else FirstSignificantDigit := -1;
  3310. while (Cur < Len) and (Pos(S[Cur + 1],Digits)>0) do
  3311. begin
  3312. //Mark first Digit that is not '0'
  3313. if (FirstSignificantDigit = -1) and (S[Cur] <> '0') then FirstSignificantDigit := Cur;
  3314. Inc(Cur);
  3315. end;
  3316. if (FirstSignificantDigit = -1) then FirstSignificantDigit := Cur;
  3317. ElemLen := 1+ Cur - FirstSignificantDigit;
  3318. // writeln(' S[FirstSignificantDigit] = ',S[FirstSignificantDigit], ' S[Cur] = ',S[Cur],' ElemLen = ',ElemLen,' -> ', S[Offset], ElemLen);
  3319. // writeln(' Cur = ',Cur);
  3320. //this way we know that Val() will never overflow Value !
  3321. if (ElemLen <= 2) or ((ElemLen <= 3) and (TimeIndex = tiMSec) ) then
  3322. begin
  3323. Val(Copy(S,FirstSignificantDigit, ElemLen), Value, Err);
  3324. // writeln(' Value = ',Value,' HH = ',TimeValues[0],' MM = ',TimeValues[1],' SS = ',TimeValues[2],' MSec = ',Timevalues[3]);
  3325. //This is safe now, because we know Value < High(Word)
  3326. TimeValues[TimeIndex] := Value;
  3327. Inc(TimeIndex);
  3328. DigitPending := False;
  3329. end
  3330. else
  3331. begin
  3332. // Writeln('Wrong elemlen: ',ElemLen, ' timeIndex: ',timeindex);
  3333. Exit; //Value to big, so it must be a wrong timestring
  3334. end;
  3335. end//Digits
  3336. else if (CurChar = #32) then
  3337. begin
  3338. //writeln('#32');
  3339. //just skip, but we must adress this, or it will be parsed by either AM/PM or Separator
  3340. end
  3341. else if (CurChar = aSettings.TimeSeparator) then
  3342. begin
  3343. // writeln('Separator ',Separator);
  3344. if DigitPending or (TimeIndex > tiSec) then
  3345. begin
  3346. // Writeln ('DigitPending ',DigitPending,' or (TimeIndex',Timeindex,' > tiSec,', tiSec,')');
  3347. Exit;
  3348. end;
  3349. DigitPending := True;
  3350. MSecPending := False;
  3351. end
  3352. else if (CurChar = aSettings.DecimalSeparator) then
  3353. begin
  3354. //writeln('DecimalSeparator');
  3355. if DigitPending or MSecPending or (TimeIndex <> tiMSec) then
  3356. begin
  3357. // Writeln('DigitPending ',DigitPending,' or MSecPending ',MSecPending,' (',TimeIndex,',Timeindex, >', tiMSec,' tiSec)');
  3358. Exit;
  3359. end;
  3360. DigitPending := True;
  3361. MSecPending := True;
  3362. end
  3363. else
  3364. begin//AM/PM?
  3365. //None of the above, so this char _must_ be the start of AM/PM string
  3366. //If we already have found AM/PM or we expect a digit then then timestring must be wrong at this point
  3367. //writeln('AM/PM?');
  3368. if (AmPm <> AMPM_None) or DigitPending then
  3369. begin
  3370. // Writeln('AmPm <> AMPM_None) or DigitPending');
  3371. Exit;
  3372. end;
  3373. OffSet := Cur;
  3374. allowedchars:=aSettings.DecimalSeparator+' ';
  3375. if aSettings.TimeSeparator<>#0 then
  3376. allowedchars:=allowedchars+aSettings.TimeSeparator;
  3377. while (Cur < Len) and (Pos(S[Cur + 1],AllowedChars)=0)
  3378. and (Pos(S[Cur + 1],Digits)=0) do Inc(Cur);
  3379. ElemLen := 1 + Cur - OffSet;
  3380. // writeln(' S[Offset] = ',S[Offset], ' S[Cur] = ',S[Cur],' ElemLen = ',ElemLen,' -> ', S[1+Offset], ElemLen);
  3381. // writeln(' Cur = ',Cur, ', S =',S);
  3382. AmPmStr := Copy(S,OffSet, ElemLen);
  3383. // writeln('AmPmStr = ',ampmstr,' (',length(ampmstr),')');
  3384. //We must compare to TimeAMString before hardcoded 'AM' for delphi compatibility
  3385. //Also it is perfectly legal, though insane to have TimeAMString = 'PM' and vice versa
  3386. if (CompareText(AmPmStr, aSettings.TimeAMString) = 0) then AmPm := AMPM_AM
  3387. else if (CompareText(AmPmStr, aSettings.TimePMString) = 0) then AmPm := AMPM_PM
  3388. else if (CompareText(AmPmStr, 'AM') = 0) then AmPm := AMPM_AM
  3389. else if (CompareText(AmPmStr, 'PM') = 0) then AmPm := AMPM_PM
  3390. else
  3391. begin
  3392. // Writeln('No timestring ',AmPmStr);
  3393. Exit; //If text does not match any of these, timestring must be wrong;
  3394. end;
  3395. //if AM/PM is at beginning of string, then a digit is mandatory after it
  3396. if (TimeIndex = tiHour) then
  3397. begin
  3398. DigitPending := True;
  3399. end
  3400. //otherwise, no more TimeValues allowed after this
  3401. else
  3402. begin
  3403. TimeIndex := tiMSec + 1;
  3404. DigitPending := False;
  3405. end;
  3406. end;//AM/PM
  3407. Inc(Cur)
  3408. end;//while
  3409. //If we arrive here, parsing the elements has been successfull
  3410. //if not at least Hours specified then input is not valid
  3411. //when am/pm is specified Hour must be <= 12 and not 0
  3412. if (TimeIndex = tiHour) or ((AmPm <> AMPM_None) and ((TimeValues[tiHour] > 12) or (TimeValues[tiHour] = 0))) or DigitPending then
  3413. Exit;
  3414. Result := True;
  3415. end;
  3416. begin
  3417. setlength(timevalues,4);
  3418. AmPm := AMPM_None;
  3419. if not SplitElements(TimeValues, AmPm) then
  3420. begin
  3421. ErrorMsg:=Format(SErrInvalidTimeFormat,[S]);
  3422. Exit;
  3423. end;
  3424. if (AmPm=AMPM_PM) and (TimeValues[tiHour]<>12) then Inc(TimeValues[tiHour], 12)
  3425. else if (AmPm=AMPM_AM) and (TimeValues[tiHour]=12) then TimeValues[tiHour]:=0;
  3426. // Writeln( TimeValues[tiHour], TimeValues[tiMin], TimeValues[tiSec], TimeValues[tiMSec]);
  3427. if not TryEncodeTime(TimeValues[tiHour], TimeValues[tiMin], TimeValues[tiSec], TimeValues[tiMSec], result) Then
  3428. ErrorMsg:=Format(SErrInvalidTimeFormat,[S]);
  3429. end ;
  3430. function StrToTime(const S: String; const aSettings : TFormatSettings): TDateTime;
  3431. Var
  3432. Msg : String;
  3433. begin
  3434. Result:=IntStrToTime(Msg,S,Length(S),aSettings);
  3435. If (Msg<>'') then
  3436. Raise EConvertError.Create(Msg);
  3437. end;
  3438. function StrToTime(const S: String): TDateTime;
  3439. begin
  3440. result:=StrToTime(S, FormatSettings);
  3441. end;
  3442. function StrToTime(const S: String; separator: char): TDateTime;
  3443. Var
  3444. aSettings : TFormatSettings;
  3445. begin
  3446. aSettings:=TFormatSettings.Create;
  3447. aSettings.TimeSeparator:=Separator;
  3448. Result:=StrToTime(S,aSettings);
  3449. end;
  3450. { StrToDateTime converts the string S to a TDateTime value
  3451. if S does not represent a valid date and/or time value
  3452. an EConvertError will be raised }
  3453. function SplitDateTimeStr(DateTimeStr: String; out DateStr, TimeStr: String; Const aSettings : TFormatSettings): Integer;
  3454. { Helper function for StrToDateTime
  3455. Pre-condition
  3456. Date is before Time
  3457. If either Date or Time is omitted then see what fits best, a time or a date (issue #0020522)
  3458. Date and Time are separated by whitespace (space Tab, Linefeed or carriage return)
  3459. FS.DateSeparator can be the same as FS.TimeSeparator (issue #0020522)
  3460. If they are both #32 and TrimWhite(DateTimeStr) contains a #32 a date is assumed.
  3461. Post-condition
  3462. DateStr holds date as string or is empty
  3463. TimeStr holds time as string or is empty
  3464. Result = number of strings returned, 0 = error
  3465. }
  3466. const
  3467. WhiteSpace = #9#10#13#32;
  3468. var
  3469. p: Integer;
  3470. DummyDT: TDateTime;
  3471. begin
  3472. Result := 0;
  3473. DateStr := '';
  3474. TimeStr := '';
  3475. DateTimeStr := Trim(DateTimeStr);
  3476. if Length(DateTimeStr) = 0 then exit;
  3477. if (aSettings.DateSeparator = #32) and (aSettings.TimeSeparator = #32) and (Pos(#32, DateTimeStr) > 0) then
  3478. begin
  3479. DateStr:=DateTimeStr;
  3480. {
  3481. Assume a date: dd [mm [yy]].
  3482. Really fancy would be counting the number of whitespace occurrences and decide
  3483. and split accordingly
  3484. }
  3485. Exit(1);
  3486. end;
  3487. p:=1;
  3488. //find separator
  3489. if (aSettings.DateSeparator<>#32) then
  3490. begin
  3491. while (p<Length(DateTimeStr)) and (not (Pos(DateTimeStr[p+1],WhiteSpace)>0)) do
  3492. Inc(p);
  3493. end
  3494. else
  3495. begin
  3496. p:=Pos(aSettings.TimeSeparator, DateTimeStr);
  3497. if (p<>0) then
  3498. repeat
  3499. Dec(p);
  3500. until (p=0) or (Pos(DateTimeStr[p],WhiteSpace)>0);
  3501. end;
  3502. //Always fill DateStr, it eases the algorithm later
  3503. if (p=0) then
  3504. p:=Length(DateTimeStr);
  3505. DateStr:=Copy(DateTimeStr,1,p);
  3506. TimeStr:=Trim(Copy(DateTimeStr,p+1,100));
  3507. if (Length(TimeStr)<>0) then
  3508. Result:=2
  3509. else
  3510. begin
  3511. Result:=1; //found 1 string
  3512. // 2 cases when DateTimeStr only contains a time:
  3513. // Date/time separator differ, and string contains a timeseparator
  3514. // Date/time separators are equal, but transformation to date fails.
  3515. if ((aSettings.DateSeparator<>aSettings.TimeSeparator) and (Pos(aSettings.TimeSeparator,DateStr) > 0))
  3516. or ((aSettings.DateSeparator=aSettings.TimeSeparator) and (not TryStrToDate(DateStr, DummyDT))) then
  3517. begin
  3518. TimeStr := DateStr;
  3519. DateStr := '';
  3520. end;
  3521. end;
  3522. end;
  3523. function StrToDateTime(const S: String): TDateTime;
  3524. begin
  3525. Result:=StrToDateTime(S,FormatSettings);
  3526. end;
  3527. function StrToDateTime(const S: String; Const aSettings : TFormatSettings): TDateTime;
  3528. var
  3529. TimeStr, DateStr: String;
  3530. PartsFound: Integer;
  3531. begin
  3532. PartsFound := SplitDateTimeStr(S, DateStr, TimeStr,aSettings);
  3533. case PartsFound of
  3534. 0: Result:=StrToDate('');
  3535. 1: if (Length(DateStr) > 0) then
  3536. Result := StrToDate(DateStr,aSettings.ShortDateFormat,aSettings.DateSeparator)
  3537. else
  3538. Result := StrToTime(TimeStr);
  3539. 2: Result := ComposeDateTime(StrTodate(DateStr,aSettings.ShortDateFormat,aSettings.DateSeparator),
  3540. StrToTime(TimeStr));
  3541. end;
  3542. end;
  3543. function FormatDateTime(const FormatStr: string; const DateTime: TDateTime): string;
  3544. begin
  3545. Result:=FormatDateTime(FormatStr,DateTime,FormatSettings);
  3546. end;
  3547. function FormatDateTime(const FormatStr: string; const DateTime: TDateTime; const aSettings : TFormatSettings): string;
  3548. procedure StoreStr(APos,Len: Integer);
  3549. begin
  3550. // Writeln('StoreStr: ',Result,'+',Copy(FormatStr,APos,Len));
  3551. Result:=Result+Copy(FormatStr,APos,Len);
  3552. end;
  3553. procedure StoreString(const AStr: string);
  3554. begin
  3555. // Writeln('StoreString: ',Result,'+',AStr);
  3556. Result:=Result+AStr;
  3557. end;
  3558. procedure StoreInt(Value, Digits: Integer);
  3559. var
  3560. S: string;
  3561. begin
  3562. S:=IntToStr(Value);
  3563. While (Length(S)<Digits) do
  3564. S:='0'+S;
  3565. StoreString(S);
  3566. end;
  3567. var
  3568. Year, Month, Day, DayOfWeek, Hour, Minute, Second, MilliSecond: word;
  3569. procedure StoreFormat(const FormatStr: string; Nesting: Integer; TimeFlag: Boolean);
  3570. var
  3571. Token, lastformattoken, prevlasttoken: char;
  3572. Count: integer;
  3573. Clock12: boolean;
  3574. tmp: integer;
  3575. isInterval: Boolean;
  3576. P,FormatCurrent,FormatEnd : Integer;
  3577. begin
  3578. if Nesting > 1 then // 0 is original string, 1 is included FormatString
  3579. Exit;
  3580. FormatCurrent := 1;
  3581. FormatEnd := Length(FormatStr);
  3582. Clock12 := false;
  3583. isInterval := false;
  3584. // look for unquoted 12-hour clock token
  3585. P:=1;
  3586. while P<=FormatEnd do
  3587. begin
  3588. Token := FormatStr[P];
  3589. case Token of
  3590. '''', '"':
  3591. begin
  3592. Inc(P);
  3593. while (P < FormatEnd) and (FormatStr[P]<>Token) do
  3594. Inc(P);
  3595. end;
  3596. 'A', 'a':
  3597. begin
  3598. if (CompareText(Copy(FormatStr,P,3),'A/P')=0) or
  3599. (CompareText(Copy(FormatStr,P,4),'AMPM')=0) or
  3600. (CompareText(Copy(FormatStr,P,5),'AM/PM')=0) then
  3601. begin
  3602. Clock12 := true;
  3603. break;
  3604. end;
  3605. end;
  3606. end; // case
  3607. Inc(P);
  3608. end ;
  3609. token := #255;
  3610. lastformattoken := ' ';
  3611. prevlasttoken := 'H';
  3612. while FormatCurrent <= FormatEnd do
  3613. begin
  3614. Token := UpperCase(FormatStr[FormatCurrent])[1];
  3615. // Writeln('Treating token at pos ',FormatCurrent,', : ',Token,' (',FormatStr,')');
  3616. Count := 1;
  3617. P := FormatCurrent + 1;
  3618. case Token of
  3619. '''', '"':
  3620. begin
  3621. while (P < FormatEnd) and (FormatStr[P]<>Token) do
  3622. Inc(P);
  3623. Inc(P);
  3624. Count := P - FormatCurrent;
  3625. StoreStr(FormatCurrent + 1, Count - 2);
  3626. end ;
  3627. 'A':
  3628. begin
  3629. if CompareText(Copy(FormatStr,FormatCurrent,4), 'AMPM') = 0 then
  3630. begin
  3631. Count := 4;
  3632. if Hour < 12 then
  3633. StoreString(aSettings.TimeAMString)
  3634. else
  3635. StoreString(aSettings.TimePMString);
  3636. end
  3637. else if CompareText(Copy(FormatStr,FormatCurrent,5), 'AM/PM') = 0 then
  3638. begin
  3639. Count := 5;
  3640. if Hour < 12 then StoreStr(FormatCurrent, 2)
  3641. else StoreStr(FormatCurrent+3, 2);
  3642. end
  3643. else if CompareText(Copy(FormatStr,FormatCurrent,3), 'A/P') = 0 then
  3644. begin
  3645. Count := 3;
  3646. if Hour < 12 then StoreStr(FormatCurrent, 1)
  3647. else StoreStr(FormatCurrent+2, 1);
  3648. end
  3649. else
  3650. raise EConvertError.Create('Illegal character in format string');
  3651. end ;
  3652. '/':
  3653. begin
  3654. // Writeln('Detected date separator');
  3655. StoreString(aSettings.DateSeparator);
  3656. end;
  3657. ':': StoreString(aSettings.TimeSeparator);
  3658. ' ', 'C', 'D', 'H', 'M', 'N', 'S', 'T', 'Y', 'Z', 'F' :
  3659. begin
  3660. // Writeln(FormatCurrent,' Special Token: ',Token,', Count: ',Count,', P: ',P);
  3661. while (P <= FormatEnd) and (UpperCase(FormatStr[P]) = Token) do
  3662. Inc(P);
  3663. Count := P - FormatCurrent;
  3664. // Writeln(FormatCurrent,' Special Token: ',Token,', Count: ',Count,', P: ',P);
  3665. case Token of
  3666. ' ': StoreStr(FormatCurrent, Count);
  3667. 'Y': begin
  3668. if Count > 2 then
  3669. StoreInt(Year, 4)
  3670. else
  3671. StoreInt(Year mod 100, 2);
  3672. end;
  3673. 'M': begin
  3674. if isInterval and ((prevlasttoken = 'H') or TimeFlag) then
  3675. StoreInt(Minute + (Hour + trunc(abs(DateTime))*24)*60, 0)
  3676. else
  3677. if (lastformattoken = 'H') or TimeFlag then
  3678. begin
  3679. if Count = 1 then
  3680. StoreInt(Minute, 0)
  3681. else
  3682. StoreInt(Minute, 2);
  3683. end
  3684. else
  3685. begin
  3686. case Count of
  3687. 1: StoreInt(Month, 0);
  3688. 2: StoreInt(Month, 2);
  3689. 3: StoreString(aSettings.ShortMonthNames[Month]);
  3690. else
  3691. StoreString(aSettings.LongMonthNames[Month]);
  3692. end;
  3693. end;
  3694. end;
  3695. 'D': begin
  3696. case Count of
  3697. 1: StoreInt(Day, 0);
  3698. 2: StoreInt(Day, 2);
  3699. 3: StoreString(aSettings.ShortDayNames[DayOfWeek-1]);
  3700. 4: StoreString(aSettings.LongDayNames[DayOfWeek-1]);
  3701. 5: StoreFormat(aSettings.ShortDateFormat, Nesting+1, False);
  3702. else
  3703. StoreFormat(aSettings.LongDateFormat, Nesting+1, False);
  3704. end ;
  3705. end ;
  3706. 'H':
  3707. if isInterval then
  3708. StoreInt(Hour + trunc(abs(DateTime))*24, 0)
  3709. else
  3710. if Clock12 then
  3711. begin
  3712. tmp := hour mod 12;
  3713. if tmp=0 then tmp:=12;
  3714. if Count = 1 then
  3715. StoreInt(tmp, 0)
  3716. else
  3717. StoreInt(tmp, 2);
  3718. end
  3719. else begin
  3720. if Count = 1 then
  3721. StoreInt(Hour, 0)
  3722. else
  3723. StoreInt(Hour, 2);
  3724. end;
  3725. 'N': if isInterval then
  3726. StoreInt(Minute + (Hour + trunc(abs(DateTime))*24)*60, 0)
  3727. else
  3728. if Count = 1 then
  3729. StoreInt(Minute, 0)
  3730. else
  3731. StoreInt(Minute, 2);
  3732. 'S': if isInterval then
  3733. StoreInt(Second + (Minute + (Hour + trunc(abs(DateTime))*24)*60)*60, 0)
  3734. else
  3735. if Count = 1 then
  3736. StoreInt(Second, 0)
  3737. else
  3738. StoreInt(Second, 2);
  3739. 'Z': if Count = 1 then
  3740. StoreInt(MilliSecond, 0)
  3741. else
  3742. StoreInt(MilliSecond, 3);
  3743. 'T': if Count = 1 then
  3744. StoreFormat(aSettings.ShortTimeFormat, Nesting+1, True)
  3745. else
  3746. StoreFormat(aSettings.LongTimeFormat, Nesting+1, True);
  3747. 'C': begin
  3748. StoreFormat(aSettings.ShortDateFormat, Nesting+1, False);
  3749. if (Hour<>0) or (Minute<>0) or (Second<>0) then
  3750. begin
  3751. StoreString(' ');
  3752. StoreFormat(aSettings.LongTimeFormat, Nesting+1, True);
  3753. end;
  3754. end;
  3755. 'F': begin
  3756. StoreFormat(aSettings.ShortDateFormat, Nesting+1, False);
  3757. StoreString(' ');
  3758. StoreFormat(aSettings.LongTimeFormat, Nesting+1, True);
  3759. end;
  3760. end;
  3761. prevlasttoken := lastformattoken;
  3762. lastformattoken := token;
  3763. end;
  3764. else
  3765. StoreString(Token);
  3766. end ;
  3767. Inc(FormatCurrent, Count);
  3768. end;
  3769. end;
  3770. begin
  3771. DecodeDateFully(DateTime, Year, Month, Day, DayOfWeek);
  3772. DecodeTime(DateTime, Hour, Minute, Second, MilliSecond);
  3773. // Writeln(DateTime,'->',Year,',', Month, ',',Day, ',',DayOfWeek,',',Hour, ',',Minute, ',',Second, ',',MilliSecond);
  3774. if FormatStr <> '' then
  3775. StoreFormat(FormatStr, 0, False)
  3776. else
  3777. StoreFormat('C', 0, False);
  3778. end ;
  3779. function CurrentYear: Word;
  3780. begin
  3781. Result:=TJSDate.New().FullYear;
  3782. end;
  3783. function TryStrToDate(const S: String; out Value: TDateTime): Boolean;
  3784. begin
  3785. Result:=TryStrToDate(S,Value,FormatSettings);
  3786. end;
  3787. function TryStrToDate(const S: String; out Value: TDateTime; separator : char): Boolean;
  3788. begin
  3789. Result:=TryStrToDate(S,Value,FormatSettings.ShortDateFormat,Separator);
  3790. end;
  3791. function TryStrToDate(const S: String; out Value: TDateTime; const useformat : string; separator : char): Boolean;
  3792. Var
  3793. Msg : String;
  3794. begin
  3795. Result:=Length(S)<>0;
  3796. If Result then
  3797. begin
  3798. Value:=IntStrToDate(Msg,S,useformat,Separator);
  3799. Result:=(Msg='');
  3800. end;
  3801. end;
  3802. function TryStrToDate(const S: String; out Value: TDateTime; const aSettings : TFormatSettings): Boolean;
  3803. begin
  3804. Result:=TryStrToDate(S,Value,aSettings.ShortDateFormat,aSettings.DateSeparator);
  3805. end;
  3806. function TryStrToTime(const S: String; out Value: TDateTime; aSettings : TFormatSettings): Boolean;
  3807. Var
  3808. Msg : String;
  3809. begin
  3810. Result:=Length(S)<>0;
  3811. If Result then
  3812. begin
  3813. Value:=IntStrToTime(Msg,S,Length(S),aSettings);
  3814. Result:=(Msg='');
  3815. end;
  3816. end;
  3817. function TryStrToTime(const S: String; out Value: TDateTime; separator : char): Boolean;
  3818. Var
  3819. Fmt : TFormatSettings;
  3820. begin
  3821. fmt:=TFormatSettings.Create;
  3822. fmt.TimeSeparator:=Separator;
  3823. Result:=TryStrToTime(S,Value,Fmt);
  3824. end;
  3825. function TryStrToTime(const S: String; out Value: TDateTime): Boolean;
  3826. begin
  3827. result:=TryStrToTime(S,Value,FormatSettings);
  3828. end;
  3829. function TryStrToDateTime(const S: String; out Value: TDateTime): Boolean;
  3830. begin
  3831. Result:=TryStrToDateTime(S,Value,FormatSettings);
  3832. end;
  3833. function TryStrToDateTime(const S: String; out Value: TDateTime; Const aSettings : TFormatSettings): Boolean;
  3834. var
  3835. I: integer;
  3836. dtdate, dttime :TDateTime;
  3837. begin
  3838. result:=false;
  3839. I:=Pos(aSettings.TimeSeparator,S);
  3840. If (I>0) then
  3841. begin
  3842. While (I>0) and (S[I]<>' ') do
  3843. Dec(I);
  3844. If I>0 then
  3845. begin
  3846. if not TryStrToDate(Copy(S,1,I-1),dtdate) then
  3847. exit;
  3848. if not TryStrToTime(Copy(S,i+1, Length(S)-i),dttime) then
  3849. exit;
  3850. Value:=ComposeDateTime(dtdate,dttime);
  3851. result:=true;
  3852. end
  3853. else
  3854. result:=TryStrToTime(s,Value);
  3855. end
  3856. else
  3857. result:=TryStrToDate(s,Value);
  3858. end;
  3859. function StrToDateDef(const S: String; const Defvalue : TDateTime): TDateTime;
  3860. begin
  3861. result := StrToDateDef(S,DefValue,#0);
  3862. end;
  3863. function StrToTimeDef(const S: String; const Defvalue : TDateTime): TDateTime;
  3864. begin
  3865. result := StrToTimeDef(S,DefValue,#0);
  3866. end;
  3867. function StrToDateTimeDef(const S: String; const Defvalue : TDateTime; aSettings : TFormatSettings): TDateTime; overload;
  3868. begin
  3869. if not TryStrToDateTime(s,Result,aSettings) Then
  3870. result:=defvalue;
  3871. end;
  3872. function StrToDateTimeDef(const S: String; const Defvalue : TDateTime): TDateTime;
  3873. begin
  3874. Result:=StrToDateTimeDef(s,DefValue,FormatSettings);
  3875. end;
  3876. function StrToDateDef(const S: String; const Defvalue : TDateTime; separator : char): TDateTime;
  3877. begin
  3878. if not TryStrToDate(s,Result, separator) Then
  3879. result:=defvalue;
  3880. end;
  3881. function StrToTimeDef(const S: String; const Defvalue : TDateTime; separator : char): TDateTime;
  3882. begin
  3883. if not TryStrToTime(s,Result, separator) Then
  3884. result:=defvalue;
  3885. end;
  3886. function StrToTimeDef(const AString: string; const ADefault: TDateTime;
  3887. const aSettings: TFormatSettings): TDateTime;
  3888. begin
  3889. if not TryStrToTime(AString, Result, aSettings) Then
  3890. Result := ADefault;
  3891. end;
  3892. procedure ReplaceTime(var dati:TDateTime; NewTime : TDateTime);
  3893. begin
  3894. dati:= ComposeDateTime(dati, newtime);
  3895. end;
  3896. procedure ReplaceDate(var DateTime: TDateTime; const NewDate: TDateTime);
  3897. var
  3898. tmp : TDateTime;
  3899. begin
  3900. tmp:=NewDate;
  3901. ReplaceTime(tmp,DateTime);
  3902. DateTime:=tmp;
  3903. end;
  3904. function FloatToDateTime(const Value: Extended): TDateTime;
  3905. begin
  3906. If (Value<MinDateTime) or (Value>MaxDateTime) then
  3907. Raise EConvertError.CreateFmt (SInvalidDateTime,[FloatToStr(Value)]);
  3908. Result:=Value;
  3909. end;
  3910. function FloattoCurr(const Value: Extended): Currency;
  3911. begin
  3912. if not TryFloatToCurr(Value, Result) then
  3913. Raise EConvertError.CreateFmt(SInvalidCurrency, [FloatToStr(Value)]);
  3914. end;
  3915. function TryFloatToCurr(const Value: Extended; var AResult: Currency): Boolean;
  3916. begin
  3917. Result:=(Value>=MinCurrency) and (Value<=MaxCurrency);
  3918. if Result then
  3919. AResult := Value;
  3920. end;
  3921. function CurrToStr(Value: Currency): string;
  3922. begin
  3923. Result:=FloatToStrF(Value,ffGeneral,-1,0,FormatSettings);
  3924. end;
  3925. function CurrToStr(Value: Currency; const aSettings: TFormatSettings): string;
  3926. begin
  3927. Result:=FloatToStrF(Value,ffGeneral,-1,0,aSettings);
  3928. end;
  3929. function StrToCurr(const S: string): Currency;
  3930. begin
  3931. if not TryStrToCurr(S,Result) then
  3932. Raise EConvertError.createfmt(SInvalidCurrency,[S]);
  3933. end;
  3934. function StrToCurr(const S: string; const aSettings: TFormatSettings): Currency;
  3935. begin
  3936. if not TryStrToCurr(S,Result,aSettings) then
  3937. Raise EConvertError.createfmt(SInvalidCurrency,[S]);
  3938. end;
  3939. function TryStrToCurr(const S: string; out Value: Currency): Boolean;
  3940. Var
  3941. D : Double;
  3942. begin
  3943. Result:=TryStrToFloat(S,D,FormatSettings);
  3944. if Result then
  3945. Value:=D;
  3946. end;
  3947. function TryStrToCurr(const S: string; out Value: Currency; const aSettings: TFormatSettings): Boolean;
  3948. Var
  3949. D : Double;
  3950. begin
  3951. Result:=TryStrToFloat(S,D,aSettings);
  3952. if Result then
  3953. Value:=D;
  3954. end;
  3955. function StrToCurrDef(const S: string; Default: Currency): Currency;
  3956. Var
  3957. R : Currency;
  3958. begin
  3959. if TryStrToCurr(S,R,FormatSettings) then
  3960. Result:=R
  3961. else
  3962. Result:=Default;
  3963. end;
  3964. function StrToCurrDef(const S: string; Default: Currency; const aSettings: TFormatSettings): Currency;
  3965. Var
  3966. R : Currency;
  3967. begin
  3968. if TryStrToCurr(S,R,aSettings) then
  3969. Result:=R
  3970. else
  3971. Result:=Default;
  3972. end;
  3973. { ---------------------------------------------------------------------
  3974. Interface related
  3975. ---------------------------------------------------------------------}
  3976. function Supports(const Instance: IInterface; const AClass: TClass; out Obj
  3977. ): Boolean;
  3978. begin
  3979. Result := (Instance<>nil) and (Instance.QueryInterface(IObjectInstance,Obj)=S_OK)
  3980. and (TObject(Obj).InheritsFrom(AClass));
  3981. end;
  3982. function Supports(const Instance: IInterface; const IID: TGuid; out Intf
  3983. ): Boolean;
  3984. begin
  3985. Result:=(Instance<>nil) and (Instance.QueryInterface(IID,Intf)=S_OK);
  3986. end;
  3987. function Supports(const Instance: TObject; const IID: TGuid; out Intf): Boolean;
  3988. begin
  3989. Result:=(Instance<>nil) and Instance.GetInterface(IID,Intf);
  3990. end;
  3991. function Supports(const Instance: TObject; const IID: TGuidString; out Intf
  3992. ): Boolean;
  3993. begin
  3994. Result:=(Instance<>nil) and Instance.GetInterfaceByStr(IID,Intf);
  3995. end;
  3996. function Supports(const Instance: IInterface; const AClass: TClass): Boolean;
  3997. var
  3998. Temp: TObject;
  3999. begin
  4000. Result:=Supports(Instance,AClass,Temp);
  4001. end;
  4002. function Supports(const Instance: IInterface; const IID: TGuid): Boolean;
  4003. var
  4004. Temp: IInterface;
  4005. begin
  4006. Result:=Supports(Instance,IID,Temp);
  4007. end;
  4008. function Supports(const Instance: TObject; const IID: TGuid): Boolean;
  4009. var
  4010. Temp: TJSObject;
  4011. begin
  4012. Result:=Supports(Instance,IID,Temp);
  4013. asm
  4014. if (Temp && Temp.$kind==='com') Temp._Release();
  4015. end;
  4016. end;
  4017. function Supports(const Instance: TObject; const IID: TGuidString): Boolean;
  4018. var
  4019. Temp: TJSObject;
  4020. begin
  4021. Result:=Supports(Instance,IID,Temp);
  4022. asm
  4023. if (Temp && Temp.$kind==='com') Temp._Release();
  4024. end;
  4025. end;
  4026. function Supports(const AClass: TClass; const IID: TGuid): Boolean;
  4027. var
  4028. maps: JSValue;
  4029. begin
  4030. if AClass=nil then exit(false);
  4031. maps := TJSObject(AClass)['$intfmaps'];
  4032. if not maps then exit(false);
  4033. if TJSObject(maps)[GUIDToString(IID)] then exit(true);
  4034. Result:=false;
  4035. end;
  4036. function Supports(const AClass: TClass; const IID: TGuidString): Boolean;
  4037. var
  4038. maps: JSValue;
  4039. begin
  4040. if AClass=nil then exit(false);
  4041. maps := TJSObject(AClass)['$intfmaps'];
  4042. if not maps then exit(false);
  4043. if TJSObject(maps)[uppercase(IID)] then exit(true);
  4044. Result:=false;
  4045. end;
  4046. function TryStringToGUID(const s: string; out Guid: TGuid): Boolean;
  4047. var
  4048. re: TJSRegexp;
  4049. begin
  4050. if Length(s)<>38 then Exit(False);
  4051. 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}\}$');
  4052. Result:=re.test(s);
  4053. if not Result then
  4054. begin
  4055. Guid.D1:=0;
  4056. exit;
  4057. end;
  4058. asm
  4059. rtl.strToGUIDR(s,Guid);
  4060. end;
  4061. Result:=true;
  4062. end;
  4063. function StringToGUID(const S: string): TGuid;
  4064. begin
  4065. if not TryStringToGUID(S, Result) then
  4066. raise EConvertError.CreateFmt(SInvalidGUID, [S]);
  4067. end;
  4068. function GUIDToString(const guid: TGuid): string;
  4069. begin
  4070. Result:=System.GUIDToString(guid);
  4071. end;
  4072. function IsEqualGUID(const guid1, guid2: TGuid): Boolean;
  4073. var
  4074. i: integer;
  4075. begin
  4076. if (guid1.D1<>guid2.D1) or (guid1.D2<>guid2.D2) or (guid1.D3<>guid2.D3) then
  4077. exit(false);
  4078. for i:=0 to 7 do if guid1.D4[i]<>guid2.D4[i] then exit(false);
  4079. Result:=true;
  4080. end;
  4081. function GuidCase(const guid: TGuid; const List: array of TGuid): Integer;
  4082. begin
  4083. for Result := High(List) downto 0 do
  4084. if IsEqualGUID(guid, List[Result]) then
  4085. Exit;
  4086. Result := -1;
  4087. end;
  4088. function CreateGUID(out GUID: TGUID): Integer;
  4089. Function R(B: Integer) : NativeInt;
  4090. Var
  4091. v : NativeInt;
  4092. begin
  4093. v:=Random(256);
  4094. While B>1 do
  4095. begin
  4096. v:=v*256+Random(256);
  4097. Dec(B);
  4098. end;
  4099. Result:=V;
  4100. end;
  4101. Var
  4102. I : Integer;
  4103. begin
  4104. Result:=0;
  4105. GUID.D1:= R(4);
  4106. GUID.D2:= R(2);
  4107. GUID.D3:= R(2);
  4108. For I:=0 to 7 do
  4109. GUID.D4[I]:=R(1);
  4110. end;
  4111. { ---------------------------------------------------------------------
  4112. Integer/Ordinal related
  4113. ---------------------------------------------------------------------}
  4114. function TryStrToInt(const S: String; out res: Integer): Boolean;
  4115. Var
  4116. NI : NativeInt;
  4117. begin
  4118. Result:=TryStrToInt(S,NI);
  4119. Result:=Result and (-2147483648<=NI) and (NI<=2147483647);
  4120. if Result then
  4121. res:=NI;
  4122. end;
  4123. function IntTryStrToInt(const S: String; out res: NativeInt; Const aSep : string): Boolean;
  4124. Var
  4125. Radix : Integer = 10;
  4126. N : String;
  4127. J : JSValue;
  4128. begin
  4129. N:=S;
  4130. // 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.
  4131. if (Pos(aSep,N)<>0) or (Pos('.',N)<>0) then
  4132. exit(False);
  4133. case Copy(N,1,1) of
  4134. '$': Radix:=16;
  4135. '&': Radix:=8;
  4136. '%': Radix:=2;
  4137. end;
  4138. // Check for E after we know radix
  4139. if (Radix<>16) and (Pos('e',LowerCase(N))<>0) then
  4140. exit(False);
  4141. If Radix<>10 then
  4142. Delete(N,1,1);
  4143. J:=parseInt(N,Radix);
  4144. Result:=Not jsIsNan(j);
  4145. if Result then
  4146. res:=NativeInt(J);
  4147. end;
  4148. function TryStrToInt(const S: String; out res: NativeInt): Boolean;
  4149. begin
  4150. Result:=IntTryStrToInt(S,res,FormatSettings.DecimalSeparator);
  4151. end;
  4152. function TryStrToInt(const S: String; out res: NativeInt; Const aSettings : TFormatSettings): Boolean;
  4153. begin
  4154. Result:=IntTryStrToInt(S,res,aSettings.DecimalSeparator);
  4155. end;
  4156. function StrToIntDef(const S: String; const aDef: Integer): Integer;
  4157. Var
  4158. R : NativeInt;
  4159. begin
  4160. if TryStrToInt(S,R) then
  4161. Result:=R
  4162. else
  4163. Result:=aDef;
  4164. end;
  4165. function StrToIntDef(const S: String; const aDef: NativeInt): NativeInt;
  4166. Var
  4167. R : NativeInt;
  4168. begin
  4169. if TryStrToInt(S,R) then
  4170. Result:=R
  4171. else
  4172. Result:=aDef;
  4173. end;
  4174. function StrToInt(const S: String): Integer;
  4175. Var
  4176. R : NativeInt;
  4177. begin
  4178. if not TryStrToInt(S,R) then
  4179. Raise EConvertError.CreateFmt(SErrInvalidInteger,[S]);
  4180. Result:=R;
  4181. end;
  4182. function StrToNativeInt(const S: String): NativeInt;
  4183. begin
  4184. if not TryStrToInt(S,Result) then
  4185. Raise EConvertError.CreateFmt(SErrInvalidInteger,[S]);
  4186. end;
  4187. function StrToUInt(const s: string): Cardinal;
  4188. begin
  4189. If not TryStrToUint(S,Result) then
  4190. Raise EConvertError.CreateFmt(SErrInvalidInteger,[S])
  4191. end;
  4192. function StrToUIntDef(const s: string; aDef : Cardinal): Cardinal;
  4193. begin
  4194. If not TryStrToUint(S,Result) then
  4195. Result:=aDef;
  4196. end;
  4197. function UIntToStr(Value: Cardinal): string;
  4198. begin
  4199. Result:=IntToStr(Value);
  4200. end;
  4201. function TryStrToUInt(const s: string; out C: Cardinal): Boolean;
  4202. Var
  4203. N : NativeInt;
  4204. begin
  4205. Result:=TryStrToInt(S,N);
  4206. Result:=(N>=0) and (N<=high(longword));
  4207. If Result then
  4208. C:=N;
  4209. end;
  4210. function StrToInt64(const S: String): NativeLargeInt;
  4211. Var
  4212. N : NativeInt;
  4213. begin
  4214. if not TryStrToInt(S,N) then
  4215. Raise EConvertError.CreateFmt(SErrInvalidInteger,[S]);
  4216. Result:=N;
  4217. end;
  4218. function TryStrToInt64(const S: String; out res: NativeLargeInt): Boolean;
  4219. Var
  4220. R : nativeint;
  4221. begin
  4222. Result:=TryStrToInt(S,R);
  4223. If Result then
  4224. Res:=R;
  4225. end;
  4226. function TryStrToInt64(const S: String; out res: Int64): Boolean;
  4227. begin
  4228. Result:=TryStrToInt64(S,NativeLargeInt(res));
  4229. end;
  4230. function StrToInt64Def(const S: String; ADefault: NativeLargeInt
  4231. ): NativeLargeInt;
  4232. begin
  4233. if not TryStrToInt64(S,Result) then
  4234. Result:=ADefault;
  4235. end;
  4236. function StrToQWord(const S: String): NativeLargeUInt;
  4237. Var
  4238. N : NativeInt;
  4239. begin
  4240. if (not TryStrToInt(S,N)) or (N<0) then
  4241. Raise EConvertError.CreateFmt(SErrInvalidInteger,[S]);
  4242. Result:=N;
  4243. end;
  4244. function TryStrToQWord(const S: String; out res: NativeLargeUInt): Boolean;
  4245. Var
  4246. R : nativeint;
  4247. begin
  4248. Result:=TryStrToInt(S,R) and (R>=0);
  4249. If Result then
  4250. Res:=R;
  4251. end;
  4252. function TryStrToQWord(const S: String; out res: QWord): Boolean;
  4253. begin
  4254. Result:=TryStrToQWord(S,NativeLargeUInt(res));
  4255. end;
  4256. function StrToQWordDef(const S: String; ADefault: NativeLargeUInt
  4257. ): NativeLargeUInt;
  4258. begin
  4259. if Not TryStrToQword(S,Result) then
  4260. Result:=ADefault;
  4261. end;
  4262. function StrToUInt64(const S: String): NativeLargeUInt;
  4263. Var
  4264. N : NativeInt;
  4265. begin
  4266. if (not TryStrToInt(S,N)) or (N<0) then
  4267. Raise EConvertError.CreateFmt(SErrInvalidInteger,[S]);
  4268. Result:=N;
  4269. end;
  4270. function TryStrToUInt64(const S: String; out res: NativeLargeUInt): Boolean;
  4271. Var
  4272. R : nativeint;
  4273. begin
  4274. Result:=TryStrToInt(S,R) and (R>=0);
  4275. If Result then
  4276. Res:=R;
  4277. end;
  4278. function TryStrToUInt64(const S: String; out res: UInt64): Boolean;
  4279. begin
  4280. Result:=TryStrToUInt64(S,NativeLargeUInt(res));
  4281. end;
  4282. function StrToUInt64Def(const S: String; ADefault: NativeLargeUInt
  4283. ): NativeLargeUInt;
  4284. begin
  4285. if Not TryStrToUInt64(S,Result) then
  4286. Result:=ADefault;
  4287. end;
  4288. function TryStrToDWord(const S: String; out res: DWord): Boolean;
  4289. Var
  4290. R : nativeint;
  4291. begin
  4292. Result:=TryStrToInt(S,R) and (R>=0) and (R<=DWord($FFFFFFFF));
  4293. If Result then
  4294. Res:=R;
  4295. end;
  4296. function StrToDWord(const S: String): DWord;
  4297. begin
  4298. if not TryStrToDWord(S,Result) then
  4299. Raise EConvertError.CreateFmt(SErrInvalidInteger,[S]);
  4300. end;
  4301. function StrToDWordDef(const S: String; ADefault: DWord): DWord;
  4302. begin
  4303. if Not TryStrToDWord(S,Result) then
  4304. Result:=ADefault;
  4305. end;
  4306. function IntToHex(Value: NativeInt; Digits: integer): string;
  4307. begin
  4308. // Result:=HexStr(Value,Digits); // TestNegLongintHelper Failed: "ToHexString" expected: <FFFE0000> but was: <00-20000> !
  4309. Result:='';
  4310. if Value<0 then
  4311. asm
  4312. if (Value<0) Value = 0xFFFFFFFF + Value + 1;
  4313. end;
  4314. asm
  4315. Result=Value.toString(16);
  4316. end;
  4317. Result:=UpperCase(Result);
  4318. while (Length(Result)<Digits) do
  4319. Result:='0'+Result;
  4320. end;
  4321. { TFormatSettings }
  4322. { TFormatSettings }
  4323. class function TFormatSettings.Create: TFormatSettings;
  4324. begin
  4325. Result := Create(GetJSLocale);
  4326. end;
  4327. class function TFormatSettings.Create(const ALocale: string): TFormatSettings;
  4328. begin
  4329. Result.LongDayNames:=DefaultLongDayNames;
  4330. Result.ShortDayNames:=DefaultShortDayNames;
  4331. Result.ShortMonthNames:=DefaultShortMonthNames;
  4332. Result.LongMonthNames:=DefaultLongMonthNames;
  4333. Result.DateTimeToStrFormat[False] := 'c';
  4334. Result.DateTimeToStrFormat[True] := 'f';
  4335. Result.DateSeparator := '-';
  4336. Result.TimeSeparator := ':';
  4337. Result.ShortDateFormat := 'yyyy-mm-dd';
  4338. Result.LongDateFormat := 'ddd, yyyy-mm-dd';
  4339. Result.ShortTimeFormat := 'hh:nn';
  4340. Result.LongTimeFormat := 'hh:nn:ss';
  4341. Result.DecimalSeparator := '.';
  4342. Result.ThousandSeparator := ',';
  4343. Result.TimeAMString := 'AM';
  4344. Result.TimePMString := 'PM';
  4345. Result.TwoDigitYearCenturyWindow := 50;
  4346. Result.CurrencyFormat:=0;
  4347. Result.NegCurrFormat:=0;
  4348. Result.CurrencyDecimals:=2;
  4349. Result.CurrencyString:='$';
  4350. If Assigned(TFormatSettings.InitLocaleHandler) then
  4351. TFormatSettings.InitLocaleHandler(UpperCase(aLocale),Result);
  4352. end;
  4353. class function TFormatSettings.GetJSLocale: string; assembler;
  4354. asm
  4355. return Intl.DateTimeFormat().resolvedOptions().locale
  4356. end;
  4357. class function TFormatSettings.GetLocaleDecimalSeparator(const ALocale: string): string; assembler;
  4358. asm
  4359. var lNumber = 1.1;
  4360. lNumber = lNumber.toLocaleString(ALocale).substring(1, 2);
  4361. return lNumber;
  4362. end;
  4363. class function TFormatSettings.GetLocaleLongDayName(const ADayOfWeek: Integer; const ALocale: string): string; assembler;
  4364. asm
  4365. var lBaseDate = new Date(2017, 0, 1); // Sunday
  4366. lBaseDate.setDate(lBaseDate.getDate() + ADayOfWeek - 1);
  4367. return lBaseDate.toLocaleDateString(ALocale, { weekday: 'long' });
  4368. end;
  4369. class function TFormatSettings.GetLocaleLongMonthName(const AMonth: Integer; const ALocale: string): string; assembler;
  4370. asm
  4371. var lBaseDate = new Date(2017, AMonth - 1, 1);
  4372. return lBaseDate.toLocaleDateString(ALocale, { month: 'long' });
  4373. end;
  4374. class function TFormatSettings.GetLocaleShortDayName(const ADayOfWeek: Integer; const ALocale: string): string;
  4375. Var
  4376. d : TJSDate;
  4377. begin
  4378. d:=TJSDate.New(2017, 0, 1); // Sunday
  4379. d.Date:=d.Date + ADayOfWeek - 1;
  4380. Result:=d.toLocaleDateString(aLocale, new(['weekday','short']));
  4381. end;
  4382. class function TFormatSettings.GetLocaleShortMonthName(const AMonth: Integer; const ALocale: string): string;
  4383. Var
  4384. d : TJSDate;
  4385. begin
  4386. d:=TJSDate.New(2017, aMonth-1, 1); // Sunday
  4387. Result:=d.toLocaleDateString(aLocale,new(['month','short']));
  4388. end;
  4389. { ---------------------------------------------------------------------
  4390. FileNames
  4391. ---------------------------------------------------------------------}
  4392. function ChangeFileExt(const FileName, Extension: PathStr): PathStr;
  4393. var
  4394. i : longint;
  4395. EndSep : Set of Char;
  4396. SOF : Boolean;
  4397. begin
  4398. i := Length(FileName);
  4399. EndSep:=AllowDirectorySeparators+AllowDriveSeparators+[ExtensionSeparator];
  4400. while (I > 0) and not(FileName[I] in EndSep) do
  4401. Dec(I);
  4402. if (I = 0) or (FileName[I] <> ExtensionSeparator) then
  4403. I := Length(FileName)+1
  4404. else
  4405. begin
  4406. SOF:=(I=1) or (FileName[i-1] in AllowDirectorySeparators);
  4407. if (SOF) and not FirstDotAtFileNameStartIsExtension then
  4408. I:=Length(FileName)+1;
  4409. end;
  4410. Result := Copy(FileName, 1, I - 1) + Extension;
  4411. end;
  4412. function ExtractFilePath(const FileName: PathStr): PathStr;
  4413. var
  4414. i : longint;
  4415. EndSep : Set of Char;
  4416. begin
  4417. i := Length(FileName);
  4418. EndSep:=AllowDirectorySeparators+AllowDriveSeparators;
  4419. while (i > 0) and not CharInSet(FileName[i],EndSep) do
  4420. Dec(i);
  4421. If I>0 then
  4422. Result := Copy(FileName, 1, i)
  4423. else
  4424. Result:='';
  4425. end;
  4426. function ExtractFileDir(const FileName: PathStr): PathStr;
  4427. var
  4428. i : longint;
  4429. EndSep : Set of Char;
  4430. begin
  4431. I := Length(FileName);
  4432. EndSep:=AllowDirectorySeparators+AllowDriveSeparators;
  4433. while (I > 0) and not CharInSet(FileName[I],EndSep) do
  4434. Dec(I);
  4435. if (I > 1) and CharInSet(FileName[I],AllowDirectorySeparators) and
  4436. not CharInSet(FileName[I - 1],EndSep) then
  4437. Dec(I);
  4438. Result := Copy(FileName, 1, I);
  4439. end;
  4440. function ExtractFileDrive(const FileName: PathStr): PathStr;
  4441. var
  4442. i,l: longint;
  4443. begin
  4444. Result := '';
  4445. l:=Length(FileName);
  4446. if (l<2) then
  4447. exit;
  4448. If CharInSet(FileName[2],AllowDriveSeparators) then
  4449. result:=Copy(FileName,1,2)
  4450. else if CharInSet(FileName[1],AllowDirectorySeparators) and
  4451. CharInSet(FileName[2],AllowDirectorySeparators) then
  4452. begin
  4453. i := 2;
  4454. { skip share }
  4455. While (i<l) and Not CharInSet(Filename[i+1],AllowDirectorySeparators) do
  4456. inc(i);
  4457. inc(i);
  4458. While (i<l) and Not CharInSet(Filename[i+1],AllowDirectorySeparators) do
  4459. inc(i);
  4460. Result:=Copy(FileName,1,i);
  4461. end;
  4462. end;
  4463. function ExtractFileName(const FileName: PathStr): PathStr;
  4464. var
  4465. i : longint;
  4466. EndSep : Set of Char;
  4467. begin
  4468. I := Length(FileName);
  4469. EndSep:=AllowDirectorySeparators+AllowDriveSeparators;
  4470. while (I > 0) and not CharInSet(FileName[I],EndSep) do
  4471. Dec(I);
  4472. Result := Copy(FileName, I + 1, MaxInt);
  4473. end;
  4474. function ExtractFileExt(const FileName: PathStr): PathStr;
  4475. var
  4476. i : longint;
  4477. EndSep : Set of Char;
  4478. SOF : Boolean; // Dot at Start of filename ?
  4479. begin
  4480. Result:='';
  4481. I := Length(FileName);
  4482. EndSep:=AllowDirectorySeparators+AllowDriveSeparators+[ExtensionSeparator];
  4483. while (I > 0) and not CharInSet(FileName[I],EndSep) do
  4484. Dec(I);
  4485. if (I > 0) and (FileName[I] = ExtensionSeparator) then
  4486. begin
  4487. SOF:=(I=1) or (FileName[i-1] in AllowDirectorySeparators);
  4488. if (Not SOF) or FirstDotAtFileNameStartIsExtension then
  4489. Result := Copy(FileName, I, MaxInt);
  4490. end
  4491. else
  4492. Result := '';
  4493. end;
  4494. function ExtractRelativepath(const BaseName, DestName: PathStr): PathStr;
  4495. Var
  4496. OneLevelBack,Source, Dest : PathStr;
  4497. Sc,Dc,I,J : Longint;
  4498. SD,DD : TPathStrArray;
  4499. begin
  4500. OneLevelBack := '..'+PathDelim;
  4501. If Uppercase(ExtractFileDrive(BaseName))<>Uppercase(ExtractFileDrive(DestName)) Then
  4502. begin
  4503. Result:=DestName;
  4504. exit;
  4505. end;
  4506. Source:=ExcludeTrailingPathDelimiter(ExtractFilePath(BaseName));
  4507. Dest:=ExcludeTrailingPathDelimiter(ExtractFilePath(DestName));
  4508. SD:=GetDirs (Source);
  4509. SC:=Length(SD);
  4510. DD:=GetDirs (Dest);
  4511. DC:=Length(SD);
  4512. I:=0;
  4513. While (I<DC) and (I<SC) do
  4514. begin
  4515. If SameText(DD[i],SD[i]) then
  4516. Inc(i)
  4517. else
  4518. Break;
  4519. end;
  4520. Result:='';
  4521. For J:=I to SC do Result:=Result+OneLevelBack;
  4522. For J:=I to DC do Result:=Result+DD[J]+PathDelim;
  4523. Result:=Result+ExtractFileName(DestName);
  4524. end;
  4525. function SetDirSeparators(const FileName: PathStr): PathStr;
  4526. Var
  4527. I : integer;
  4528. begin
  4529. Result:=FileName;
  4530. For I:=1 to Length(Result) do
  4531. If CharInSet(Result[I],AllowDirectorySeparators) then
  4532. Result[i]:=PathDelim;
  4533. end;
  4534. function GetDirs(DirName: PathStr): TPathStrArray;
  4535. Var
  4536. I,J,L : Longint;
  4537. D : String;
  4538. begin
  4539. I:=1;
  4540. J:=0;
  4541. L:=0;
  4542. SetLength(Result,Length(DirName));
  4543. While I<=Length(DirName) do
  4544. begin
  4545. If CharInSet(DirName[i],AllowDirectorySeparators) then
  4546. begin
  4547. D:=Copy(DirName,J+1,J-I);
  4548. if (D<>'') then
  4549. begin
  4550. Result[L]:=D;
  4551. Inc(L);
  4552. end;
  4553. J:=I;
  4554. end;
  4555. Inc(I);
  4556. end;
  4557. SetLength(Result,L);
  4558. end;
  4559. function IncludeTrailingPathDelimiter(const Path: PathStr): PathStr;
  4560. Var
  4561. l : Integer;
  4562. begin
  4563. Result:=Path;
  4564. l:=Length(Result);
  4565. If (L=0) or not CharInSet(Result[l],AllowDirectorySeparators) then
  4566. Result:=Result+PathDelim;
  4567. end;
  4568. function ExcludeTrailingPathDelimiter(const Path: PathStr): PathStr;
  4569. Var
  4570. L : Integer;
  4571. begin
  4572. L:=Length(Path);
  4573. If (L>0) and CharInSet(Path[L],AllowDirectorySeparators) then
  4574. Dec(L);
  4575. Result:=Copy(Path,1,L);
  4576. end;
  4577. function IncludeLeadingPathDelimiter(const Path: PathStr): PathStr;
  4578. Var
  4579. l : Integer;
  4580. begin
  4581. Result:=Path;
  4582. l:=Length(Result);
  4583. If (L=0) or not CharInSet(Result[1],AllowDirectorySeparators) then
  4584. Result:=PathDelim+Result;
  4585. end;
  4586. function ExcludeLeadingPathDelimiter(const Path: PathStr): PathStr;
  4587. Var
  4588. L : Integer;
  4589. begin
  4590. Result:=Path;
  4591. L:=Length(Result);
  4592. If (L>0) and CharInSet(Result[1],AllowDirectorySeparators) then
  4593. Delete(Result,1,1);
  4594. end;
  4595. function IsPathDelimiter(const Path: PathStr; Index: Integer): Boolean;
  4596. begin
  4597. Result:=(Index>0) and (Index<=Length(Path)) and CharInSet(Path[Index],AllowDirectorySeparators);
  4598. end;
  4599. function ConcatPaths(const Paths: array of PathStr): PathStr;
  4600. var
  4601. I: Integer;
  4602. begin
  4603. if Length(Paths) > 0 then
  4604. begin
  4605. Result := Paths[0];
  4606. for I := 1 to Length(Paths) - 1 do
  4607. Result := IncludeTrailingPathDelimiter(Result) + ExcludeLeadingPathDelimiter(Paths[I]);
  4608. end else
  4609. Result := '';
  4610. end;
  4611. Function EncodeHTMLEntities (S : String) : String;
  4612. begin
  4613. Result:='';
  4614. if S='' then exit;
  4615. asm
  4616. return S.replace(/[\u00A0-\u9999<>\&]/gim, function(i) {
  4617. return '&#'+i.charCodeAt(0)+';';
  4618. });
  4619. end;
  4620. end;
  4621. { ---------------------------------------------------------------------
  4622. Type helpers implementation
  4623. ---------------------------------------------------------------------}
  4624. { ---------------------------------------------------------------------
  4625. TGUIDHelper
  4626. ---------------------------------------------------------------------}
  4627. Procedure NotImplemented(S : String);
  4628. begin
  4629. Raise Exception.Create('Not yet implemented : '+S);
  4630. end;
  4631. class function TGuidHelper.Create(Src: TGUID; BigEndian: Boolean): TGUID;
  4632. begin
  4633. Result:=Src;
  4634. if Not Bigendian then
  4635. begin
  4636. Result.D1:=SwapEndian(Result.D1);
  4637. Result.D2:=SwapEndian(Result.D2);
  4638. Result.D3:=SwapEndian(Result.D3);
  4639. end;
  4640. end;
  4641. class function TGuidHelper.Create(const Buf: TJSArrayBuffer; AStartIndex: Cardinal; BigEndian: Boolean): TGUID;
  4642. Var
  4643. A : Cardinal;
  4644. B,C : Word;
  4645. V : TJSDataView;
  4646. begin
  4647. V:=TJSDataView.New(Buf);
  4648. // The get functions return by default correct endianness.
  4649. if BigEndian then
  4650. begin
  4651. A:=V.getUint32(aStartIndex);
  4652. B:=V.getUint16(AStartIndex+4);
  4653. C:=V.getUint16(AStartIndex+6);
  4654. end
  4655. else
  4656. begin
  4657. A:=SwapEndian(V.getUint32(aStartIndex));
  4658. B:=SwapEndian(V.getUint16(AStartIndex+4));
  4659. C:=SwapEndian(V.getUint16(AStartIndex+6));
  4660. end;
  4661. 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));
  4662. end;
  4663. class function TGuidHelper.Create(const Data: array of Byte; AStartIndex: Cardinal; BigEndian: Boolean): TGUID;
  4664. Var
  4665. D : TJSUint8Array;
  4666. begin
  4667. if ((System.Length(Data)-AStartIndex)<16) then
  4668. raise EArgumentException.CreateFmt('The length of a GUID array must be at least %d',[]);
  4669. D:=TJSUint8Array.From(Data);
  4670. Result:=Create(D.buffer,aStartIndex,BigEndian);
  4671. end;
  4672. class function TGuidHelper.Create(const B: TBytes; DataEndian: TEndian): TGUID;
  4673. begin
  4674. Result:=Create(B,0,DataEndian);
  4675. end;
  4676. class function TGuidHelper.Create(const B: TBytes; AStartIndex: Cardinal; DataEndian: TEndian): TGUID;
  4677. begin
  4678. if ((System.Length(B)-AStartIndex)<16) then
  4679. raise EArgumentException.CreateFmt('The length of a GUID array must be at least %d',[]);
  4680. Result:=Create(B,AStartIndex,DataEndian=TEndian.Big);
  4681. end;
  4682. class function TGuidHelper.Create(const S: string): TGUID;
  4683. begin
  4684. Result:=StringToGUID(S);
  4685. end;
  4686. class function TGuidHelper.Create(A: Integer; B: SmallInt; C: SmallInt; const D: TBytes): TGUID;
  4687. begin
  4688. if (System.Length(D)<>8) then
  4689. raise EArgumentException.CreateFmt('The length of a GUID array must be %d',[]);
  4690. Result:=Create(Cardinal(A),Word(B),Word(C),D[0],D[1],D[2],D[3],D[4],D[5],D[6],D[7]);
  4691. end;
  4692. (*
  4693. class function TGuidHelper.Create(A: Integer; B: SmallInt; C: SmallInt; D, E, F, G, H, I, J, K: Byte): TGUID;
  4694. begin
  4695. Result:=Create(Cardinal(A),Word(B),Word(C),D,E,F,G,H,I,J,K);
  4696. end;
  4697. *)
  4698. class function TGuidHelper.Create(A: Cardinal; B: Word; C: Word; D, E, F, G, H, I, J, K: Byte): TGUID;
  4699. begin
  4700. Result.D1 := Cardinal(A);
  4701. Result.D2 := Word(B);
  4702. Result.D3 := Word(C);
  4703. Result.D4[0] := D;
  4704. Result.D4[1] := E;
  4705. Result.D4[2] := F;
  4706. Result.D4[3] := G;
  4707. Result.D4[4] := H;
  4708. Result.D4[5] := I;
  4709. Result.D4[6] := J;
  4710. Result.D4[7] := K;
  4711. end;
  4712. class function TGuidHelper.NewGuid: TGUID;
  4713. begin
  4714. CreateGUID(Result)
  4715. end;
  4716. function TGuidHelper.ToByteArray(DataEndian: TEndian): TBytes;
  4717. Var
  4718. D : TJSUint8Array;
  4719. V : TJSDataView;
  4720. I : Integer;
  4721. begin
  4722. D:=TJSUint8array.New(16);
  4723. V:=TJSDataView.New(D.buffer);
  4724. V.setUint32(0,D1,DataEndian=TEndian.Little);
  4725. V.setUint16(4,D2,DataEndian=TEndian.Little);
  4726. V.setUint16(6,D3,DataEndian=TEndian.Little);
  4727. for I:=0 to 7 do
  4728. V.setUint8(8+I,D4[i]);
  4729. SetLength(Result, 16);
  4730. for I:=0 to 15 do
  4731. Result[i]:=V.getUint8(I);
  4732. end;
  4733. function TGuidHelper.ToString(SkipBrackets: Boolean): string;
  4734. begin
  4735. Result:=GuidToString(Self);
  4736. If SkipBrackets then
  4737. Result:=Copy(Result,2,Length(Result)-2);
  4738. end;
  4739. { ---------------------------------------------------------------------
  4740. TStringHelper
  4741. ---------------------------------------------------------------------}
  4742. Function HaveChar(AChar : Char; const AList: array of Char) : Boolean;
  4743. Var
  4744. I : SizeInt;
  4745. begin
  4746. I:=0;
  4747. Result:=False;
  4748. While (Not Result) and (I<Length(AList)) do
  4749. begin
  4750. Result:=(AList[i]=AChar);
  4751. Inc(I);
  4752. end;
  4753. end;
  4754. function TStringHelper.GetChar(AIndex: SizeInt): Char;
  4755. begin
  4756. Result:=Self[AIndex+1];
  4757. end;
  4758. function TStringHelper.GetLength: SizeInt;
  4759. begin
  4760. Result:=System.Length(Self);
  4761. end;
  4762. class function TStringHelper.Compare(const A: string; const B: string): Integer;
  4763. begin
  4764. Result:=Compare(A,0,B,0,System.Length(B),[]);
  4765. end;
  4766. class function TStringHelper.Compare(const A: string; const B: string;
  4767. IgnoreCase: Boolean): Integer; //deprecated 'Use same with TCompareOptions';
  4768. begin
  4769. if IgnoreCase then
  4770. Result:=Compare(A,B,[coIgnoreCase])
  4771. else
  4772. Result:=Compare(A,B,[]);
  4773. end;
  4774. class function TStringHelper.Compare(const A: string; const B: string;
  4775. Options: TCompareOptions): Integer;
  4776. begin
  4777. Result:=Compare(A,0,B,0,System.Length(B),Options);
  4778. end;
  4779. class function TStringHelper.Compare(const A: string; IndexA: SizeInt;
  4780. const B: string; IndexB: SizeInt; ALen: SizeInt): Integer;
  4781. begin
  4782. Result:=Compare(A,IndexA,B,IndexB,ALen,[]);
  4783. end;
  4784. class function TStringHelper.Compare(const A: string; IndexA: SizeInt;
  4785. const B: string; IndexB: SizeInt; ALen: SizeInt; IgnoreCase: Boolean
  4786. ): Integer; //deprecated 'Use same with TCompareOptions';
  4787. begin
  4788. if IgnoreCase then
  4789. Result:=Compare(A,IndexA,B,IndexB,ALen,[coIgnoreCase])
  4790. else
  4791. Result:=Compare(A,IndexA,B,IndexB,ALen,[])
  4792. end;
  4793. class function TStringHelper.Compare(const A: string; IndexA: SizeInt;
  4794. const B: string; IndexB: SizeInt; ALen: SizeInt; Options: TCompareOptions
  4795. ): Integer;
  4796. Var
  4797. AL,BL : String;
  4798. begin
  4799. AL:=System.Copy(A,IndexA+1,aLen);
  4800. BL:=System.Copy(B,IndexB+1,aLen);
  4801. if (coIgnoreCase in Options) then
  4802. Result:=TJSString(UpperCase(AL)).localeCompare(UpperCase(BL))
  4803. else
  4804. Result:=TJSString(AL).localeCompare(BL)
  4805. end;
  4806. class function TStringHelper.CompareOrdinal(const A: string; const B: string
  4807. ): Integer;
  4808. Var
  4809. L : SizeInt;
  4810. begin
  4811. L:=System.Length(B);
  4812. if L>System.Length(A) then
  4813. L:=System.Length(A);
  4814. Result:=CompareOrdinal(A,0,B,0,L);
  4815. end;
  4816. class function TStringHelper.CompareOrdinal(const A: string; IndexA: SizeInt;
  4817. const B: string; IndexB: SizeInt; ALen: SizeInt): Integer;
  4818. Var
  4819. I,M : integer;
  4820. begin
  4821. M:=System.Length(A)-IndexA;
  4822. If M>(System.Length(B)-IndexB) then
  4823. M:=(System.Length(B)-IndexB);
  4824. if M>aLen then
  4825. M:=aLen;
  4826. I:=0;
  4827. Result:=0;
  4828. While (Result=0) and (I<M) do
  4829. begin
  4830. Result:=TJSString(A).charCodeAt(IndexA+I)-TJSString(B).charCodeAt(IndexB+I);
  4831. Inc(I);
  4832. end;
  4833. end;
  4834. class function TStringHelper.CompareText(const A: string; const B: string
  4835. ): Integer;
  4836. begin
  4837. Result:=Sysutils.CompareText(A,B);
  4838. end;
  4839. class function TStringHelper.Copy(const Str: string): string;
  4840. begin
  4841. Result:=Str;
  4842. end;
  4843. class function TStringHelper.Create(AChar: Char; ACount: SizeInt): string;
  4844. begin
  4845. Result:=StringOfChar(AChar,ACount);
  4846. end;
  4847. class function TStringHelper.Create(const AValue: array of Char): string;
  4848. begin
  4849. Result:=Create(AValue,0,System.Length(AValue));
  4850. end;
  4851. class function TStringHelper.Create(const AValue: array of Char;
  4852. StartIndex: SizeInt; ALen: SizeInt): string;
  4853. Var
  4854. I : Integer;
  4855. begin
  4856. SetLength(Result,ALen);
  4857. For I:=1 to ALen do
  4858. Result[I]:=AValue[StartIndex+I-1];
  4859. end;
  4860. class function TStringHelper.EndsText(const ASubText, AText: string): Boolean;
  4861. begin
  4862. Result:=(ASubText<>'') and (sysutils.CompareText(System.Copy(AText,System.Length(AText)-System.Length(ASubText)+1,System.Length(ASubText)),ASubText)=0);
  4863. end;
  4864. class function TStringHelper.Equals(const a: string; const b: string): Boolean;
  4865. begin
  4866. Result:=A=B;
  4867. end;
  4868. class function TStringHelper.Format(const AFormat: string; const args: array of const): string;
  4869. begin
  4870. Result:=Sysutils.Format(AFormat,Args);
  4871. end;
  4872. class function TStringHelper.IsNullOrEmpty(const AValue: string): Boolean;
  4873. begin
  4874. Result:=system.Length(AValue)=0;
  4875. end;
  4876. class function TStringHelper.IsNullOrWhiteSpace(const AValue: string): Boolean;
  4877. begin
  4878. Result:=system.Length(sysutils.Trim(AValue))=0;
  4879. end;
  4880. class function TStringHelper.Join(const Separator: string; const Values: array of const): string;
  4881. begin
  4882. Result:=TJSArray(Values).Join(Separator);
  4883. end;
  4884. class function TStringHelper.Join(const Separator: string;
  4885. const Values: array of string): string;
  4886. begin
  4887. Result:=TJSArray(Values).Join(Separator);
  4888. end;
  4889. class function TStringHelper.Join(const Separator: string;
  4890. const Values: array of string; StartIndex: SizeInt; ACount: SizeInt): string;
  4891. Var
  4892. VLen : SizeInt;
  4893. begin
  4894. VLen:=High(Values);
  4895. If (ACount<0) or ((StartIndex>0) and (StartIndex>VLen)) then
  4896. raise ERangeError.Create(SRangeError);
  4897. If (ACount=0) or (VLen<0) then
  4898. Result:=''
  4899. else
  4900. Result:=TJSArray(Values).Slice(StartIndex,StartIndex+aCount).Join(Separator);
  4901. end;
  4902. class function TStringHelper.LowerCase(const S: string): string;
  4903. begin
  4904. Result:=sysutils.Lowercase(S);
  4905. end;
  4906. class function TStringHelper.Parse(const AValue: Boolean): string;
  4907. begin
  4908. Result:=BoolToStr(AValue);
  4909. end;
  4910. class function TStringHelper.Parse(const AValue: Extended): string;
  4911. begin
  4912. Result:=FloatToStr(AValue);
  4913. end;
  4914. class function TStringHelper.Parse(const AValue: NativeInt): string;
  4915. begin
  4916. Result:=IntToStr(AValue);
  4917. end;
  4918. class function TStringHelper.Parse(const AValue: Integer): string;
  4919. begin
  4920. Result:=IntToStr(AValue);
  4921. end;
  4922. class function TStringHelper.ToBoolean(const S: string): Boolean;
  4923. begin
  4924. Result:=StrToBool(S);
  4925. end;
  4926. class function TStringHelper.ToDouble(const S: string): Double;
  4927. begin
  4928. Result:=StrToFloat(S);
  4929. end;
  4930. class function TStringHelper.ToExtended(const S: string): Extended;
  4931. begin
  4932. Result:=StrToFloat(S);
  4933. end;
  4934. class function TStringHelper.ToNativeInt(const S: string): NativeInt;
  4935. begin
  4936. Result:=StrToInt64(S);
  4937. end;
  4938. class function TStringHelper.ToInteger(const S: string): Integer;
  4939. begin
  4940. Result:=StrToInt(S);
  4941. end;
  4942. class function TStringHelper.UpperCase(const S: string): string;
  4943. begin
  4944. Result:=sysutils.Uppercase(S);
  4945. end;
  4946. class function TStringHelper.ToCharArray(const S: String): TCharArray;
  4947. Var
  4948. I,Len: integer;
  4949. begin
  4950. Len:=System.Length(S);
  4951. SetLength(Result,Len);
  4952. For I:=1 to Len do
  4953. Result[I-1]:=S[I];
  4954. end;
  4955. function TStringHelper.CompareTo(const B: string): Integer;
  4956. begin
  4957. // Order is important
  4958. Result:=Compare(Self,B);
  4959. end;
  4960. function TStringHelper.Contains(const AValue: string): Boolean;
  4961. begin
  4962. Result:=(AValue<>'') and (Pos(AValue,Self)>0);
  4963. end;
  4964. function TStringHelper.CountChar(const C: Char): SizeInt;
  4965. Var
  4966. S : Char;
  4967. begin
  4968. Result:=0;
  4969. For S in Self do
  4970. if (S=C) then
  4971. Inc(Result);
  4972. end;
  4973. function TStringHelper.DeQuotedString: string;
  4974. begin
  4975. Result:=DeQuotedString('''');
  4976. end;
  4977. function TStringHelper.DeQuotedString(const AQuoteChar: Char): string;
  4978. var
  4979. L,I : SizeInt;
  4980. Res : Array of Char;
  4981. PS,PD : SizeInt;
  4982. IsQuote : Boolean;
  4983. begin
  4984. L:=System.Length(Self);
  4985. if (L<2) or Not ((Self[1]=AQuoteChar) and (Self[L]=AQuoteChar)) then
  4986. Exit(Self);
  4987. SetLength(Res,L);
  4988. IsQuote:=False;
  4989. PS:=2;
  4990. PD:=1;
  4991. For I:=2 to L-1 do
  4992. begin
  4993. if (Self[PS]=AQuoteChar) then
  4994. begin
  4995. IsQuote:=Not IsQuote;
  4996. if Not IsQuote then
  4997. begin
  4998. Result[PD]:=Self[PS];
  4999. Inc(PD);
  5000. end;
  5001. end
  5002. else
  5003. begin
  5004. if IsQuote then
  5005. IsQuote:=false;
  5006. Result[PD]:=Self[PS];
  5007. Inc(PD);
  5008. end;
  5009. Inc(PS);
  5010. end;
  5011. SetLength(Result,PD-1);
  5012. end;
  5013. function TStringHelper.EndsWith(const AValue: string): Boolean;
  5014. begin
  5015. Result:=EndsWith(AValue,False);
  5016. end;
  5017. function TStringHelper.EndsWith(const AValue: string; IgnoreCase: Boolean): Boolean;
  5018. Var
  5019. L : SizeInt;
  5020. S : String;
  5021. begin
  5022. L:=system.Length(AVAlue);
  5023. Result:=L=0;
  5024. if Not Result then
  5025. begin
  5026. S:=system.Copy(Self,Length-L+1,L);
  5027. Result:=system.Length(S)=L;
  5028. if Result then
  5029. if IgnoreCase then
  5030. Result:=CompareText(S,AValue)=0
  5031. else
  5032. Result:=S=AValue;
  5033. end;
  5034. end;
  5035. function TStringHelper.Equals(const AValue: string): Boolean;
  5036. begin
  5037. Result:=(Self=AValue);
  5038. end;
  5039. function TStringHelper.Format(const args: array of const): string;
  5040. begin
  5041. Result:=Sysutils.Format(Self,Args);
  5042. end;
  5043. function TStringHelper.GetHashCode: Integer;
  5044. // Taken from contnrs, fphash
  5045. var
  5046. P,pmax : Integer;
  5047. L : TJSString;
  5048. begin
  5049. {$push}
  5050. {$Q-}
  5051. L:=TJSString(Self);
  5052. Result:=0;
  5053. P:=1;
  5054. pmax:=length+1;
  5055. while (p<pmax) do
  5056. begin
  5057. Result:=LongWord(LongInt(Result shl 5) - LongInt(Result)) xor L.CharCodeAt(P);
  5058. Inc(p);
  5059. end;
  5060. {$pop}
  5061. end;
  5062. function TStringHelper.IndexOf(AValue: Char): SizeInt;
  5063. begin
  5064. Result:=IndexOf(AValue,0,Length);
  5065. end;
  5066. function TStringHelper.IndexOf(const AValue: string): SizeInt;
  5067. begin
  5068. Result:=IndexOf(AValue,0,Length);
  5069. end;
  5070. function TStringHelper.IndexOf(AValue: Char; StartIndex: SizeInt): SizeInt;
  5071. begin
  5072. Result:=IndexOf(AValue,StartIndex,Length);
  5073. end;
  5074. function TStringHelper.IndexOf(const AValue: string; StartIndex: SizeInt
  5075. ): SizeInt;
  5076. begin
  5077. Result:=IndexOf(AValue,StartIndex,Length);
  5078. end;
  5079. function TStringHelper.IndexOf(AValue: Char; StartIndex: SizeInt;
  5080. ACount: SizeInt): SizeInt;
  5081. Var
  5082. S : String;
  5083. begin
  5084. S:=System.Copy(Self,StartIndex+1,ACount);
  5085. Result:=Pos(AValue,S)-1;
  5086. if Result<>-1 then
  5087. Result:=Result+StartIndex;
  5088. end;
  5089. function TStringHelper.IndexOf(const AValue: string; StartIndex: SizeInt;
  5090. ACount: SizeInt): SizeInt;
  5091. Var
  5092. S : String;
  5093. begin
  5094. S:=System.Copy(Self,StartIndex+1,ACount);
  5095. Result:=Pos(AValue,S)-1;
  5096. if Result<>-1 then
  5097. Result:=Result+StartIndex;
  5098. end;
  5099. function TStringHelper.IndexOfUnQuoted(const AValue: string; StartQuote,
  5100. EndQuote: Char; StartIndex: SizeInt = 0): SizeInt;
  5101. Var
  5102. LV : SizeInt;
  5103. S : String;
  5104. Function MatchAt(I : SizeInt) : Boolean ; Inline;
  5105. Var
  5106. J : SizeInt;
  5107. begin
  5108. J:=1;
  5109. Repeat
  5110. Result:=(S[I+J-1]=AValue[j]);
  5111. Inc(J);
  5112. Until (Not Result) or (J>LV);
  5113. end;
  5114. Var
  5115. I,L,Q: SizeInt;
  5116. begin
  5117. S:=Self;
  5118. Result:=-1;
  5119. LV:=system.Length(AValue);
  5120. L:=Length-LV+1;
  5121. if L<0 then
  5122. L:=0;
  5123. I:=StartIndex+1;
  5124. Q:=0;
  5125. if StartQuote=EndQuote then
  5126. begin
  5127. While (Result=-1) and (I<=L) do
  5128. begin
  5129. if (S[I]=StartQuote) then
  5130. Q:=1-Q;
  5131. if (Q=0) and MatchAt(i) then
  5132. Result:=I-1;
  5133. Inc(I);
  5134. end;
  5135. end
  5136. else
  5137. begin
  5138. While (Result=-1) and (I<=L) do
  5139. begin
  5140. if S[I]=StartQuote then
  5141. Inc(Q)
  5142. else if (S[I]=EndQuote) and (Q>0) then
  5143. Dec(Q);
  5144. if (Q=0) and MatchAt(i) then
  5145. Result:=I-1;
  5146. Inc(I);
  5147. end;
  5148. end;
  5149. end;
  5150. function TStringHelper.IndexOfAny(const AnyOf: string): SizeInt;
  5151. begin
  5152. Result:=IndexOfAny(AnyOf.ToCharArray);
  5153. end;
  5154. function TStringHelper.IndexOfAny(const AnyOf: array of Char): SizeInt;
  5155. begin
  5156. Result:=IndexOfAny(AnyOf,0,Length);
  5157. end;
  5158. function TStringHelper.IndexOfAny(const AnyOf: String; StartIndex: SizeInt): SizeInt;
  5159. begin
  5160. Result:=IndexOfAny(AnyOf.ToCharArray,StartIndex);
  5161. end;
  5162. function TStringHelper.IndexOfAny(const AnyOf: array of Char;
  5163. StartIndex: SizeInt): SizeInt;
  5164. begin
  5165. Result:=IndexOfAny(AnyOf,StartIndex,Length);
  5166. end;
  5167. function TStringHelper.IndexOfAny(const AnyOf: String; StartIndex: SizeInt; ACount: SizeInt): SizeInt;
  5168. begin
  5169. Result:=IndexOfAny(AnyOf.ToCharArray,StartIndex,aCount);
  5170. end;
  5171. function TStringHelper.IndexOfAny(const AnyOf: array of Char;
  5172. StartIndex: SizeInt; ACount: SizeInt): SizeInt;
  5173. Var
  5174. i,L : SizeInt;
  5175. begin
  5176. I:=StartIndex+1;
  5177. L:=I+ACount-1;
  5178. If L>Length then
  5179. L:=Length;
  5180. Result:=-1;
  5181. While (Result=-1) and (I<=L) do
  5182. begin
  5183. if HaveChar(Self[i],AnyOf) then
  5184. Result:=I-1;
  5185. Inc(I);
  5186. end;
  5187. end;
  5188. function TStringHelper.IndexOfAny(const AnyOf: array of String): SizeInt;
  5189. begin
  5190. Result:=IndexOfAny(AnyOf,0,Length);
  5191. end;
  5192. function TStringHelper.IndexOfAny(const AnyOf: array of String;
  5193. StartIndex: SizeInt): SizeInt;
  5194. begin
  5195. Result:=IndexOfAny(AnyOf,StartIndex,Length-StartIndex);
  5196. end;
  5197. function TStringHelper.IndexOfAny(const AnyOf: array of String;
  5198. StartIndex: SizeInt; ACount: SizeInt): SizeInt;
  5199. Var
  5200. M : SizeInt;
  5201. begin
  5202. Result:=IndexOfAny(AnyOf,StartIndex,ACount,M);
  5203. end;
  5204. function TStringHelper.IndexOfAny(const AnyOf: array of String;
  5205. StartIndex: SizeInt; ACount: SizeInt; out AMatch: SizeInt): SizeInt;
  5206. Var
  5207. L,I : SizeInt;
  5208. begin
  5209. Result:=-1;
  5210. For I:=0 to System.Length(AnyOf)-1 do
  5211. begin
  5212. L:=IndexOf(AnyOf[i],StartIndex,ACount);
  5213. If (L>=0) and ((Result=-1) or (L<Result)) then
  5214. begin
  5215. Result:=L;
  5216. AMatch:=I;
  5217. end;
  5218. end;
  5219. end;
  5220. function TStringHelper.IndexOfAnyUnquoted(const AnyOf: array of Char;
  5221. StartQuote, EndQuote: Char): SizeInt;
  5222. begin
  5223. Result:=IndexOfAnyUnquoted(AnyOf,StartQuote,EndQuote,0,Length);
  5224. end;
  5225. function TStringHelper.IndexOfAnyUnquoted(const AnyOf: array of Char;
  5226. StartQuote, EndQuote: Char; StartIndex: SizeInt): SizeInt;
  5227. begin
  5228. Result:=IndexOfAnyUnquoted(AnyOf,StartQuote,EndQuote,StartIndex,Length);
  5229. end;
  5230. function TStringHelper.IndexOfAnyUnquoted(const AnyOf: array of Char;
  5231. StartQuote, EndQuote: Char; StartIndex: SizeInt; ACount: SizeInt): SizeInt;
  5232. Var
  5233. I,L : SizeInt;
  5234. Q : SizeInt;
  5235. begin
  5236. Result:=-1;
  5237. L:=StartIndex+ACount-1;
  5238. if L>Length then
  5239. L:=Length;
  5240. I:=StartIndex+1;
  5241. Q:=0;
  5242. if StartQuote=EndQuote then
  5243. begin
  5244. While (Result=-1) and (I<=L) do
  5245. begin
  5246. if (Self[I]=StartQuote) then
  5247. Q:=1-Q;
  5248. if (Q=0) and HaveChar(Self[i],AnyOf) then
  5249. Result:=I-1;
  5250. Inc(I);
  5251. end;
  5252. end
  5253. else
  5254. begin
  5255. While (Result=-1) and (I<=L) do
  5256. begin
  5257. if Self[I]=StartQuote then
  5258. Inc(Q)
  5259. else if (Self[I]=EndQuote) and (Q>0) then
  5260. Dec(Q);
  5261. if (Q=0) and HaveChar(Self[i],AnyOf) then
  5262. Result:=I-1;
  5263. Inc(I);
  5264. end;
  5265. end;
  5266. end;
  5267. function TStringHelper.IndexOfAnyUnquoted(const AnyOf: array of string;
  5268. StartQuote, EndQuote: Char; StartIndex: SizeInt; out Matched: SizeInt
  5269. ): SizeInt;
  5270. Var
  5271. L,I : SizeInt;
  5272. begin
  5273. Result:=-1;
  5274. For I:=0 to System.Length(AnyOf)-1 do
  5275. begin
  5276. L:=IndexOfUnquoted(AnyOf[i],StartQuote,EndQuote,StartIndex);
  5277. If (L>=0) and ((Result=-1) or (L<Result)) then
  5278. begin
  5279. Result:=L;
  5280. Matched:=I;
  5281. end;
  5282. end;
  5283. end;
  5284. function TStringHelper.Insert(StartIndex: SizeInt; const AValue: string
  5285. ): string;
  5286. begin
  5287. system.Insert(AValue,Self,StartIndex+1);
  5288. Result:=Self;
  5289. end;
  5290. function TStringHelper.IsDelimiter(const Delimiters: string; Index: SizeInt
  5291. ): Boolean;
  5292. begin
  5293. Result:=sysutils.IsDelimiter(Delimiters,Self,Index+1);
  5294. end;
  5295. function TStringHelper.IsEmpty: Boolean;
  5296. begin
  5297. Result:=(Length=0)
  5298. end;
  5299. function TStringHelper.LastDelimiter(const Delims: string): SizeInt;
  5300. begin
  5301. Result:=sysutils.LastDelimiter(Delims,Self)-1;
  5302. end;
  5303. function TStringHelper.LastIndexOf(AValue: Char): SizeInt;
  5304. begin
  5305. Result:=LastIndexOf(AValue,Length-1,Length);
  5306. end;
  5307. function TStringHelper.LastIndexOf(const AValue: string): SizeInt;
  5308. begin
  5309. Result:=LastIndexOf(AValue,Length-1,Length);
  5310. end;
  5311. function TStringHelper.LastIndexOf(AValue: Char; AStartIndex: SizeInt): SizeInt;
  5312. begin
  5313. Result:=LastIndexOf(AValue,AStartIndex,Length);
  5314. end;
  5315. function TStringHelper.LastIndexOf(const AValue: string; AStartIndex: SizeInt
  5316. ): SizeInt;
  5317. begin
  5318. Result:=LastIndexOf(AValue,AStartIndex,Length);
  5319. end;
  5320. function TStringHelper.LastIndexOf(AValue: Char; AStartIndex: SizeInt;
  5321. ACount: SizeInt): SizeInt;
  5322. Var
  5323. Min : SizeInt;
  5324. begin
  5325. Result:=AStartIndex+1;
  5326. Min:=Result-ACount+1;
  5327. If Min<1 then
  5328. Min:=1;
  5329. While (Result>=Min) and (Self[Result]<>AValue) do
  5330. Dec(Result);
  5331. if Result<Min then
  5332. Result:=-1
  5333. else
  5334. Result:=Result-1;
  5335. end;
  5336. function TStringHelper.LastIndexOf(const AValue: string; AStartIndex: SizeInt; ACount: SizeInt): SizeInt;
  5337. begin
  5338. Result:=TJSString(Self).lastIndexOf(aValue,aStartIndex);
  5339. if (aStartIndex-Result)>aCount then
  5340. Result:=-1;
  5341. end;
  5342. function TStringHelper.LastIndexOfAny(const AnyOf: array of Char): SizeInt;
  5343. begin
  5344. Result:=LastIndexOfAny(AnyOf,Length-1,Length);
  5345. end;
  5346. function TStringHelper.LastIndexOfAny(const AnyOf: array of Char;
  5347. AStartIndex: SizeInt): SizeInt;
  5348. begin
  5349. Result:=LastIndexOfAny(AnyOf,AStartIndex,Length);
  5350. end;
  5351. function TStringHelper.LastIndexOfAny(const AnyOf: array of Char;
  5352. AStartIndex: SizeInt; ACount: SizeInt): SizeInt;
  5353. Var
  5354. Min : SizeInt;
  5355. begin
  5356. Result:=AStartIndex+1;
  5357. Min:=Result-ACount+1;
  5358. If Min<1 then
  5359. Min:=1;
  5360. While (Result>=Min) and Not HaveChar(Self[Result],AnyOf) do
  5361. Dec(Result);
  5362. if Result<Min then
  5363. Result:=-1
  5364. else
  5365. Result:=Result-1;
  5366. end;
  5367. function TStringHelper.PadLeft(ATotalWidth: SizeInt): string;
  5368. begin
  5369. Result:=PadLeft(ATotalWidth,' ');
  5370. end;
  5371. function TStringHelper.PadLeft(ATotalWidth: SizeInt; PaddingChar: Char): string;
  5372. Var
  5373. L : SizeInt;
  5374. begin
  5375. Result:=Self;
  5376. L:=ATotalWidth-Length;
  5377. If L>0 then
  5378. Result:=StringOfChar(PaddingChar,L)+Result;
  5379. end;
  5380. function TStringHelper.PadRight(ATotalWidth: SizeInt): string;
  5381. begin
  5382. Result:=PadRight(ATotalWidth,' ');
  5383. end;
  5384. function TStringHelper.PadRight(ATotalWidth: SizeInt; PaddingChar: Char
  5385. ): string;
  5386. Var
  5387. L : SizeInt;
  5388. begin
  5389. Result:=Self;
  5390. L:=ATotalWidth-Length;
  5391. If L>0 then
  5392. Result:=Result+StringOfChar(PaddingChar,L);
  5393. end;
  5394. function TStringHelper.QuotedString: string;
  5395. begin
  5396. Result:=QuotedStr(Self);
  5397. end;
  5398. function TStringHelper.QuotedString(const AQuoteChar: Char): string;
  5399. begin
  5400. Result:=QuotedStr(Self,AQuoteChar);
  5401. end;
  5402. function TStringHelper.Remove(StartIndex: SizeInt): string;
  5403. begin
  5404. Result:=Remove(StartIndex,Self.Length-StartIndex);
  5405. end;
  5406. function TStringHelper.Remove(StartIndex: SizeInt; ACount: SizeInt): string;
  5407. begin
  5408. Result:=Self;
  5409. System.Delete(Result,StartIndex+1,ACount);
  5410. end;
  5411. function TStringHelper.Replace(OldChar: Char; NewChar: Char): string;
  5412. begin
  5413. Result:=Replace(OldChar,NewChar,[rfReplaceAll]);
  5414. end;
  5415. function TStringHelper.Replace(OldChar: Char; NewChar: Char;
  5416. ReplaceFlags: TReplaceFlags): string;
  5417. begin
  5418. Result:=StringReplace(Self,OldChar,NewChar,ReplaceFlags);
  5419. end;
  5420. function TStringHelper.Replace(const OldValue: string; const NewValue: string
  5421. ): string;
  5422. begin
  5423. Result:=Replace(OldValue,NewValue,[rfReplaceAll]);
  5424. end;
  5425. function TStringHelper.Replace(const OldValue: string; const NewValue: string;
  5426. ReplaceFlags: TReplaceFlags): string;
  5427. begin
  5428. Result:=StringReplace(Self,OldValue,NewValue,ReplaceFlags);
  5429. end;
  5430. function TStringHelper.Split(const Separators: String): TStringArray;
  5431. begin
  5432. Result:=Split(Separators.ToCharArray);
  5433. end;
  5434. function TStringHelper.Split(const Separators: array of Char): TStringArray;
  5435. begin
  5436. Result:=Split(Separators,#0,#0,Length+1,TStringSplitOptions.None);
  5437. end;
  5438. function TStringHelper.Split(const Separators: string; ACount: SizeInt): TStringArray;
  5439. begin
  5440. Result:=Split(Separators.ToCharArray,aCount);
  5441. end;
  5442. function TStringHelper.Split(const Separators: array of Char; ACount: SizeInt
  5443. ): TStringArray;
  5444. begin
  5445. Result:=Split(Separators,#0,#0,ACount,TStringSplitOptions.None);
  5446. end;
  5447. function TStringHelper.Split(const Separators: string; Options: TStringSplitOptions): TStringArray;
  5448. begin
  5449. Result:=Split(Separators.ToCharArray,Options);
  5450. end;
  5451. function TStringHelper.Split(const Separators: array of Char;
  5452. Options: TStringSplitOptions): TStringArray;
  5453. begin
  5454. Result:=Split(Separators,Length+1,Options);
  5455. end;
  5456. function TStringHelper.Split(const Separators: string; ACount: SizeInt; Options: TStringSplitOptions): TStringArray;
  5457. begin
  5458. Result:=Split(Separators.ToCharArray,aCount,Options);
  5459. end;
  5460. function TStringHelper.Split(const Separators: array of Char; ACount: SizeInt;
  5461. Options: TStringSplitOptions): TStringArray;
  5462. begin
  5463. Result:=Split(Separators,#0,#0,ACount,Options);
  5464. end;
  5465. function TStringHelper.Split(const Separators: array of string): TStringArray;
  5466. begin
  5467. Result:=Split(Separators,Length+1);
  5468. end;
  5469. function TStringHelper.Split(const Separators: array of string; ACount: SizeInt
  5470. ): TStringArray;
  5471. begin
  5472. Result:=Split(Separators,ACount,TStringSplitOptions.None);
  5473. end;
  5474. function TStringHelper.Split(const Separators: array of string;
  5475. Options: TStringSplitOptions): TStringArray;
  5476. begin
  5477. Result:=Split(Separators,Length+1,Options);
  5478. end;
  5479. function TStringHelper.Split(const Separators: array of string;
  5480. ACount: SizeInt; Options: TStringSplitOptions): TStringArray;
  5481. begin
  5482. Result:=Split(Separators,#0,#0,ACount,Options);
  5483. end;
  5484. function TStringHelper.Split(const Separators: String; AQuote: Char): TStringArray;
  5485. begin
  5486. Result:=Split(Separators.ToCharArray,aQuote);
  5487. end;
  5488. function TStringHelper.Split(const Separators: array of Char; AQuote: Char
  5489. ): TStringArray;
  5490. begin
  5491. Result:=Split(Separators,AQuote,AQuote);
  5492. end;
  5493. function TStringHelper.Split(const Separators: String; AQuoteStart, AQuoteEnd: Char): TStringArray;
  5494. begin
  5495. Result:=Split(Separators.ToCharArray,aQuoteStart,aQuoteEnd);
  5496. end;
  5497. function TStringHelper.Split(const Separators: array of Char; AQuoteStart,
  5498. AQuoteEnd: Char): TStringArray;
  5499. begin
  5500. Result:=Split(Separators,AQuoteStart,AQuoteEnd,TStringSplitOptions.None);
  5501. end;
  5502. function TStringHelper.Split(const Separators: string; AQuoteStart, AQuoteEnd: Char; Options: TStringSplitOptions): TStringArray;
  5503. begin
  5504. Result:=Split(Separators.ToCharArray,aQuoteStart,aQuoteEnd,Options);
  5505. end;
  5506. function TStringHelper.Split(const Separators: array of Char; AQuoteStart,
  5507. AQuoteEnd: Char; Options: TStringSplitOptions): TStringArray;
  5508. begin
  5509. Result:=Split(Separators,AQuoteStart,AQuoteEnd,Length+1,Options);
  5510. end;
  5511. function TStringHelper.Split(const Separators: string; AQuoteStart, AQuoteEnd: Char; ACount: SizeInt): TStringArray;
  5512. begin
  5513. Result:=Split(Separators.ToCharArray,aQuoteStart,aQuoteEnd,aCount);
  5514. end;
  5515. function TStringHelper.Split(const Separators: array of Char; AQuoteStart,
  5516. AQuoteEnd: Char; ACount: SizeInt): TStringArray;
  5517. begin
  5518. Result:=Split(Separators,AQuoteStart,AQuoteEnd,ACount,TStringSplitOptions.None);
  5519. end;
  5520. function TStringHelper.Split(const Separators: string; AQuoteStart, AQuoteEnd: Char; ACount: SizeInt; Options: TStringSplitOptions
  5521. ): TStringArray;
  5522. begin
  5523. Result:=Split(Separators.ToCharArray,aQuoteStart,aQuoteEnd,aCount,Options);
  5524. end;
  5525. function TStringHelper.Split(const Separators: array of Char; AQuoteStart,
  5526. AQuoteEnd: Char; ACount: SizeInt; Options: TStringSplitOptions): TStringArray;
  5527. Const
  5528. BlockSize = 10;
  5529. Var
  5530. S : String;
  5531. Function NextSep(StartIndex : SizeInt) : SizeInt;
  5532. begin
  5533. if (AQuoteStart<>#0) then
  5534. Result:=S.IndexOfAnyUnQuoted(Separators,AQuoteStart,AQuoteEnd,StartIndex)
  5535. else
  5536. Result:=S.IndexOfAny(Separators,StartIndex);
  5537. end;
  5538. Procedure MaybeGrow(Curlen : SizeInt);
  5539. begin
  5540. if System.Length(Result)<=CurLen then
  5541. SetLength(Result,System.Length(Result)+BlockSize);
  5542. end;
  5543. Var
  5544. Sep,LastSep,Len : SizeInt;
  5545. T : String;
  5546. begin
  5547. S:=Self;
  5548. SetLength(Result,BlockSize);
  5549. Len:=0;
  5550. LastSep:=0;
  5551. Sep:=NextSep(0);
  5552. While (Sep<>-1) and ((ACount=0) or (Len<ACount)) do
  5553. begin
  5554. T:=SubString(LastSep,Sep-LastSep);
  5555. // Writeln('Examining >',T,'< at pos ',LastSep,', till pos ',Sep);
  5556. If (T<>'') or (not (TStringSplitOptions.ExcludeEmpty=Options)) then
  5557. begin
  5558. MaybeGrow(Len);
  5559. Result[Len]:=T;
  5560. Inc(Len);
  5561. end;
  5562. LastSep:=Sep+1;
  5563. Sep:=NextSep(LastSep);
  5564. end;
  5565. if (LastSep<=Length) and ((ACount=0) or (Len<ACount)) then
  5566. begin
  5567. T:=SubString(LastSep);
  5568. // Writeln('Examining >',T,'< at pos,',LastSep,' till pos ',Sep);
  5569. If (T<>'') or (not (TStringSplitOptions.ExcludeEmpty=Options)) then
  5570. begin
  5571. MaybeGrow(Len);
  5572. Result[Len]:=T;
  5573. Inc(Len);
  5574. end;
  5575. end;
  5576. SetLength(Result,Len);
  5577. end;
  5578. function TStringHelper.Split(const Separators: array of string; AQuote: Char
  5579. ): TStringArray;
  5580. begin
  5581. Result:=SPlit(Separators,AQuote,AQuote);
  5582. end;
  5583. function TStringHelper.Split(const Separators: array of string; AQuoteStart,
  5584. AQuoteEnd: Char): TStringArray;
  5585. begin
  5586. Result:=SPlit(Separators,AQuoteStart,AQuoteEnd,Length+1,TStringSplitOptions.None);
  5587. end;
  5588. function TStringHelper.Split(const Separators: array of string; AQuoteStart,
  5589. AQuoteEnd: Char; Options: TStringSplitOptions): TStringArray;
  5590. begin
  5591. Result:=SPlit(Separators,AQuoteStart,AQuoteEnd,Length+1,Options);
  5592. end;
  5593. function TStringHelper.Split(const Separators: array of string; AQuoteStart,
  5594. AQuoteEnd: Char; ACount: SizeInt): TStringArray;
  5595. begin
  5596. Result:=SPlit(Separators,AQuoteStart,AQuoteEnd,ACount,TStringSplitOptions.None);
  5597. end;
  5598. function TStringHelper.Split(const Separators: array of string; AQuoteStart,
  5599. AQuoteEnd: Char; ACount: SizeInt; Options: TStringSplitOptions): TStringArray;
  5600. Const
  5601. BlockSize = 10;
  5602. Var
  5603. S : String;
  5604. Function NextSep(StartIndex : SizeInt; out Match : SizeInt) : SizeInt;
  5605. begin
  5606. if (AQuoteStart<>#0) then
  5607. Result:=S.IndexOfAnyUnQuoted(Separators,AQuoteStart,AQuoteEnd,StartIndex,Match)
  5608. else
  5609. Result:=S.IndexOfAny(Separators,StartIndex,Length,Match);
  5610. end;
  5611. Procedure MaybeGrow(Curlen : SizeInt);
  5612. begin
  5613. if System.Length(Result)<=CurLen then
  5614. SetLength(Result,System.Length(Result)+BlockSize);
  5615. end;
  5616. Var
  5617. Sep,LastSep,Len,Match : SizeInt;
  5618. T : String;
  5619. begin
  5620. S:=Self;
  5621. SetLength(Result,BlockSize);
  5622. Len:=0;
  5623. LastSep:=0;
  5624. Sep:=NextSep(0,Match);
  5625. While (Sep<>-1) and ((ACount=0) or (Len<ACount)) do
  5626. begin
  5627. T:=SubString(LastSep,Sep-LastSep);
  5628. If (T<>'') or (not (TStringSplitOptions.ExcludeEmpty=Options)) then
  5629. begin
  5630. MaybeGrow(Len);
  5631. Result[Len]:=T;
  5632. Inc(Len);
  5633. end;
  5634. LastSep:=Sep+System.Length(Separators[Match]);
  5635. Sep:=NextSep(LastSep,Match);
  5636. end;
  5637. if (LastSep<=Length) and ((ACount=0) or (Len<ACount)) then
  5638. begin
  5639. T:=SubString(LastSep);
  5640. // Writeln('Examining >',T,'< at pos,',LastSep,' till pos ',Sep);
  5641. If (T<>'') or (not (TStringSplitOptions.ExcludeEmpty=Options)) then
  5642. begin
  5643. MaybeGrow(Len);
  5644. Result[Len]:=T;
  5645. Inc(Len);
  5646. end;
  5647. end;
  5648. SetLength(Result,Len);
  5649. end;
  5650. function TStringHelper.StartsWith(const AValue: string): Boolean;
  5651. begin
  5652. Result:=StartsWith(AValue,False);
  5653. end;
  5654. function TStringHelper.StartsWith(const AValue: string; IgnoreCase: Boolean
  5655. ): Boolean;
  5656. Var
  5657. L : SizeInt;
  5658. S : String;
  5659. begin
  5660. L:=System.Length(AValue);
  5661. Result:=L<=0;
  5662. if not Result then
  5663. begin
  5664. S:=System.Copy(Self,1,L);
  5665. Result:=(System.Length(S)=L);
  5666. if Result then
  5667. if IgnoreCase then
  5668. Result:=SameText(S,aValue)
  5669. else
  5670. Result:=SameStr(S,AValue);
  5671. end;
  5672. end;
  5673. function TStringHelper.Substring(AStartIndex: SizeInt): string;
  5674. begin
  5675. Result:=Self.SubString(AStartIndex,Self.Length-AStartIndex);
  5676. end;
  5677. function TStringHelper.Substring(AStartIndex: SizeInt; ALen: SizeInt): string;
  5678. begin
  5679. Result:=system.Copy(Self,AStartIndex+1,ALen);
  5680. end;
  5681. function TStringHelper.ToBoolean: Boolean;
  5682. begin
  5683. Result:=StrToBool(Self);
  5684. end;
  5685. function TStringHelper.ToInteger: Integer;
  5686. begin
  5687. Result:=StrToInt(Self);
  5688. end;
  5689. function TStringHelper.ToNativeInt: NativeInt;
  5690. begin
  5691. Result:=StrToNativeInt(Self);
  5692. end;
  5693. function TStringHelper.ToDouble: Double;
  5694. begin
  5695. Result:=StrToFLoat(Self);
  5696. end;
  5697. function TStringHelper.ToExtended: Extended;
  5698. begin
  5699. Result:=StrToFLoat(Self);
  5700. end;
  5701. function TStringHelper.ToCharArray: TCharArray;
  5702. begin
  5703. Result:=ToCharArray(0,Self.Length);
  5704. end;
  5705. function TStringHelper.ToCharArray(AStartIndex: SizeInt; ALen: SizeInt
  5706. ): TCharArray;
  5707. Var
  5708. I : SizeInt;
  5709. begin
  5710. SetLength(Result,ALen);
  5711. For I:=0 to ALen-1 do
  5712. Result[I]:=Self[AStartIndex+I+1];
  5713. end;
  5714. function TStringHelper.ToLower: string;
  5715. begin
  5716. Result:=LowerCase(Self);
  5717. end;
  5718. function TStringHelper.ToLowerInvariant: string;
  5719. begin
  5720. Result:=LowerCase(Self);
  5721. end;
  5722. function TStringHelper.ToUpper: string;
  5723. begin
  5724. Result:=UpperCase(Self);
  5725. end;
  5726. function TStringHelper.ToUpperInvariant: string;
  5727. begin
  5728. Result:=UpperCase(Self);
  5729. end;
  5730. function TStringHelper.Trim: string;
  5731. begin
  5732. Result:=SysUtils.Trim(self);
  5733. end;
  5734. function TStringHelper.TrimLeft: string;
  5735. begin
  5736. Result:=SysUtils.TrimLeft(Self);
  5737. end;
  5738. function TStringHelper.TrimRight: string;
  5739. begin
  5740. Result:=SysUtils.TrimRight(Self);
  5741. end;
  5742. function TStringHelper.Trim(const ATrimChars: array of Char): string;
  5743. begin
  5744. Result:=Self.TrimLeft(ATrimChars).TrimRight(ATrimChars);
  5745. end;
  5746. function TStringHelper.TrimLeft(const ATrimChars: array of Char): string;
  5747. Var
  5748. I,Len : SizeInt;
  5749. begin
  5750. I:=1;
  5751. Len:=Self.Length;
  5752. While (I<=Len) and HaveChar(Self[i],ATrimChars) do Inc(I);
  5753. if I=1 then
  5754. Result:=Self
  5755. else if I>Len then
  5756. Result:=''
  5757. else
  5758. Result:=system.Copy(Self,I,Len-I+1);
  5759. end;
  5760. function TStringHelper.TrimRight(const ATrimChars: array of Char): string;
  5761. Var
  5762. I,Len : SizeInt;
  5763. begin
  5764. Len:=Self.Length;
  5765. I:=Len;
  5766. While (I>=1) and HaveChar(Self[i],ATrimChars) do Dec(I);
  5767. if I<1 then
  5768. Result:=''
  5769. else if I=Len then
  5770. Result:=Self
  5771. else
  5772. Result:=system.Copy(Self,1,I);
  5773. end;
  5774. function TStringHelper.TrimEnd(const ATrimChars: array of Char): string;
  5775. begin
  5776. Result:=TrimRight(ATrimChars);
  5777. end;
  5778. function TStringHelper.TrimStart(const ATrimChars: array of Char): string;
  5779. begin
  5780. Result:=TrimLeft(ATrimChars);
  5781. end;
  5782. { ---------------------------------------------------------------------
  5783. TDoubleHelper
  5784. ---------------------------------------------------------------------}
  5785. Class Function TDoubleHelper.IsNan(const AValue: Double): Boolean; overload; inline;
  5786. begin
  5787. Result:=JS.jsIsNaN(AValue);
  5788. end;
  5789. Class Function TDoubleHelper.IsInfinity(const AValue: Double): Boolean; overload; inline;
  5790. begin
  5791. Result:=Not jsIsFinite(aValue);
  5792. end;
  5793. Class Function TDoubleHelper.IsNegativeInfinity(const AValue: Double): Boolean; overload; inline;
  5794. begin
  5795. asm
  5796. return (AValue=Number.NEGATIVE_INFINITY);
  5797. end;
  5798. Result:=aValue=0; // Fool compiler
  5799. end;
  5800. Class Function TDoubleHelper.IsPositiveInfinity(const AValue: Double): Boolean; overload; inline;
  5801. begin
  5802. asm
  5803. return (AValue=Number.POSITIVE_INFINITY);
  5804. end;
  5805. Result:=aValue=0; // Fool compiler.
  5806. end;
  5807. Class Function TDoubleHelper.Parse(const AString: string): Double; overload; inline;
  5808. begin
  5809. Result:=StrToFloat(AString);
  5810. end;
  5811. Class Function TDoubleHelper.ToString(const AValue: Double): string; overload; inline;
  5812. begin
  5813. Result:=FloatToStr(AValue);
  5814. end;
  5815. Class Function TDoubleHelper.ToString(const AValue: Double; const AFormat: TFloatFormat; const APrecision, ADigits: Integer): string; overload; inline;
  5816. begin
  5817. Result:=FloatToStrF(AValue,AFormat,APrecision,ADigits);
  5818. end;
  5819. Class Function TDoubleHelper.TryParse(const AString: string; out AValue: Double): Boolean; overload; inline;
  5820. begin
  5821. Result:=TryStrToFloat(AString,AValue);
  5822. end;
  5823. Function TDoubleHelper.GetB(AIndex: Cardinal): Byte;
  5824. var
  5825. F : TJSFloat64Array;
  5826. B : TJSUInt8array;
  5827. begin
  5828. F:=TJSFloat64Array.New(1);
  5829. B:=TJSUInt8array.New(F.Buffer);
  5830. F[0]:=Self;
  5831. Result:=B[AIndex];
  5832. end;
  5833. Function TDoubleHelper.GetW(AIndex: Cardinal): Word;
  5834. var
  5835. F : TJSFloat64Array;
  5836. W : TJSUInt16array;
  5837. begin
  5838. F:=TJSFloat64Array.New(1);
  5839. W:=TJSUInt16array.New(F.Buffer);
  5840. F[0]:=Self;
  5841. Result:=W[AIndex];
  5842. end;
  5843. Type
  5844. TFloatParts = Record
  5845. sign : boolean;
  5846. exp : integer;
  5847. mantissa : double;
  5848. end;
  5849. // See https://stackoverflow.com/questions/9383593/extracting-the-exponent-and-mantissa-of-a-javascript-number
  5850. Function FloatToParts(aValue : Double) : TFloatParts;
  5851. var
  5852. F : TJSFloat64Array;
  5853. B : TJSUInt8array;
  5854. begin
  5855. F:=TJSFloat64Array.New(1);
  5856. B:=TJSUInt8array.New(F.Buffer);
  5857. F[0]:=aValue;
  5858. Result.Sign:=(B[7] shr 7)=0;
  5859. Result.exp:=(((B[7] and $7f) shl 4) or (B[6] shr 4))- $3ff;
  5860. B[3]:=$3F;
  5861. B[6]:=B[6] or $F0;
  5862. Result.Mantissa:=F[0];
  5863. end;
  5864. Function TDoubleHelper.GetE: NativeUInt; inline;
  5865. begin
  5866. Result:=FloatToParts(Self).Exp;
  5867. end;
  5868. Function TDoubleHelper.GetF: NativeUInt; inline;
  5869. begin
  5870. Result:=0;
  5871. NotImplemented('GetF');
  5872. end;
  5873. Function TDoubleHelper.GetS: Boolean; inline;
  5874. begin
  5875. Result:=FloatToParts(Self).Sign;
  5876. end;
  5877. procedure TDoubleHelper.SetB(AIndex: Cardinal; const AValue: Byte);
  5878. var
  5879. F : TJSFloat64Array;
  5880. B : TJSUInt8array;
  5881. begin
  5882. if (AIndex>=8) then
  5883. raise ERangeError.Create(SRangeError);
  5884. F:=TJSFloat64Array.New(1);
  5885. B:=TJSUInt8array.New(F.Buffer);
  5886. F[0]:=Self;
  5887. B[AIndex]:=aValue;
  5888. Self:=F[0];
  5889. end;
  5890. procedure TDoubleHelper.SetW(AIndex: Cardinal; const AValue: Word);
  5891. Var
  5892. F : TJSFloat64Array;
  5893. W : TJSUInt16array;
  5894. begin
  5895. if (AIndex>=4) then
  5896. raise ERangeError.Create(SRangeError);
  5897. F:=TJSFloat64Array.New(1);
  5898. W:=TJSUInt16array.New(F.Buffer);
  5899. F[0]:=Self;
  5900. W[AIndex]:=aValue;
  5901. Self:=F[0];
  5902. end;
  5903. procedure TDoubleHelper.SetS(AValue: Boolean);
  5904. Var
  5905. F : TJSFloat64Array;
  5906. B : TJSUInt8array;
  5907. begin
  5908. F:=TJSFloat64Array.New(1);
  5909. B:=TJSUInt8array.New(F.Buffer);
  5910. F[0]:=Self;
  5911. if aValue then
  5912. B[7]:=B[7] or (1 shr 7)
  5913. else
  5914. B[7]:=B[7] and not (1 shr 7);
  5915. Self:=F[0];
  5916. end;
  5917. Procedure TDoubleHelper.BuildUp(const ASignFlag: Boolean; const AMantissa: NativeUInt; const AExponent: Integer);
  5918. begin
  5919. NotImplemented('BuildUp');
  5920. // Following statement is just to fool the compiler
  5921. if ASignFlag and (AMantissa>0) and (AExponent<0) then exit;
  5922. // TFloatRec(Self).BuildUp(ASignFlag, AMantissa, AExponent);
  5923. end;
  5924. Function TDoubleHelper.Exponent: Integer;
  5925. begin
  5926. Result:=FloatToParts(Self).Exp;
  5927. end;
  5928. Function TDoubleHelper.Fraction: Extended;
  5929. begin
  5930. Result:=system.Frac(Self);
  5931. end;
  5932. Function TDoubleHelper.IsInfinity: Boolean; overload; inline;
  5933. begin
  5934. Result:=Double.IsInfinity(Self);
  5935. end;
  5936. Function TDoubleHelper.IsNan: Boolean; overload; inline;
  5937. begin
  5938. Result:=Double.IsNan(Self);
  5939. end;
  5940. Function TDoubleHelper.IsNegativeInfinity: Boolean; overload; inline;
  5941. begin
  5942. Result:=Double.IsNegativeInfinity(Self);
  5943. end;
  5944. Function TDoubleHelper.IsPositiveInfinity: Boolean; overload; inline;
  5945. begin
  5946. Result:=Double.IsPositiveInfinity(Self);
  5947. end;
  5948. Function TDoubleHelper.Mantissa: NativeUInt;
  5949. begin
  5950. Result:=Trunc(FloatToParts(Self).mantissa);
  5951. end;
  5952. Function TDoubleHelper.ToString(const AFormat: TFloatFormat; const APrecision, ADigits: Integer): string; overload; inline;
  5953. begin
  5954. Result:=FloatToStrF(Self,AFormat,APrecision,ADigits);
  5955. end;
  5956. Function TDoubleHelper.ToString: string; overload; inline;
  5957. begin
  5958. Result:=FloatToStr(Self);
  5959. end;
  5960. { ---------------------------------------------------------------------
  5961. TByteHelper
  5962. ---------------------------------------------------------------------}
  5963. Class Function TByteHelper.Parse(const AString: string): Byte; inline;
  5964. begin
  5965. Result:=StrToInt(AString);
  5966. end;
  5967. Class Function TByteHelper.Size: Integer; inline;
  5968. begin
  5969. Result:=1;
  5970. end;
  5971. Class Function TByteHelper.ToString(const AValue: Byte): string; overload; inline;
  5972. begin
  5973. Result:=IntToStr(AValue);
  5974. end;
  5975. Class Function TByteHelper.TryParse(const AString: string; out AValue: Byte): Boolean; inline;
  5976. Var
  5977. C : Integer;
  5978. begin
  5979. Val(AString,AValue,C);
  5980. Result:=(C=0);
  5981. end;
  5982. Function TByteHelper.ToBoolean: Boolean; inline;
  5983. begin
  5984. Result:=(Self<>0);
  5985. end;
  5986. Function TByteHelper.ToDouble: Double; inline;
  5987. begin
  5988. Result:=Self;
  5989. end;
  5990. Function TByteHelper.ToExtended: Extended; inline;
  5991. begin
  5992. Result:=Self;
  5993. end;
  5994. Function TByteHelper.ToBinString: string; inline;
  5995. begin
  5996. Result:=BinStr(Self,Size*8);
  5997. end;
  5998. Function TByteHelper.ToHexString(const AMinDigits: Integer): string;
  5999. overload; inline;
  6000. begin
  6001. Result:=IntToHex(Self,AMinDigits);
  6002. end;
  6003. Function TByteHelper.ToHexString: string; overload; inline;
  6004. begin
  6005. Result:=IntToHex(Self,Size*2);
  6006. end;
  6007. Function TByteHelper.ToString: string; overload; inline;
  6008. begin
  6009. Result:=IntToStr(Self);
  6010. end;
  6011. Function TByteHelper.SetBit(const index: TByteBitIndex) : Byte; inline;
  6012. begin
  6013. Self := Self or (Byte(1) shl index);
  6014. Result:=Self;
  6015. end;
  6016. Function TByteHelper.ClearBit(const index: TByteBitIndex) : Byte; inline;
  6017. begin
  6018. Self:=Self and not Byte((Byte(1) shl index));
  6019. Result:=Self;
  6020. end;
  6021. Function TByteHelper.ToggleBit(const index: TByteBitIndex) : Byte; inline;
  6022. begin
  6023. Self := Self xor Byte((Byte(1) shl index));
  6024. Result:=Self;
  6025. end;
  6026. Function TByteHelper.TestBit(const Index: TByteBitIndex):Boolean; inline;
  6027. begin
  6028. Result := (Self and Byte((Byte(1) shl index)))<>0;
  6029. end;
  6030. { ---------------------------------------------------------------------
  6031. TShortintHelper
  6032. ---------------------------------------------------------------------}
  6033. Class Function TShortIntHelper.Parse(const AString: string): ShortInt; inline;
  6034. begin
  6035. Result:=StrToInt(AString);
  6036. end;
  6037. Class Function TShortIntHelper.Size: Integer; inline;
  6038. begin
  6039. Result:=1;
  6040. end;
  6041. Class Function TShortIntHelper.ToString(const AValue: ShortInt): string; overload; inline;
  6042. begin
  6043. Result:=IntToStr(AValue);
  6044. end;
  6045. Class Function TShortIntHelper.TryParse(const AString: string; out AValue: ShortInt): Boolean; inline;
  6046. Var
  6047. C : Integer;
  6048. begin
  6049. Val(AString,AValue,C);
  6050. Result:=(C=0);
  6051. end;
  6052. Function TShortIntHelper.ToBoolean: Boolean; inline;
  6053. begin
  6054. Result:=(Self<>0);
  6055. end;
  6056. Function TShortIntHelper.ToDouble: Double; inline;
  6057. begin
  6058. Result:=Self;
  6059. end;
  6060. Function TShortIntHelper.ToExtended: Extended; inline;
  6061. begin
  6062. Result:=Self;
  6063. end;
  6064. Function TShortIntHelper.ToBinString: string; inline;
  6065. begin
  6066. Result:=BinStr(Self,Size*8);
  6067. end;
  6068. Function TShortIntHelper.ToHexString(const AMinDigits: Integer): string; overload; inline;
  6069. Var
  6070. B : Word;
  6071. U : TJSUInt8Array;
  6072. S : TJSInt8array;
  6073. begin
  6074. if Self>=0 then
  6075. B:=Self
  6076. else
  6077. begin
  6078. S:=TJSInt8Array.New(1);
  6079. S[0]:=Self;
  6080. U:=TJSUInt8Array.New(S);
  6081. B:=U[0];
  6082. if AMinDigits>2 then
  6083. B:=$FF00+B;
  6084. end;
  6085. Result:=IntToHex(B,AMinDigits);
  6086. end;
  6087. Function TShortIntHelper.ToHexString: string; overload; inline;
  6088. begin
  6089. Result:=ToHexString(Size*2);
  6090. end;
  6091. Function TShortIntHelper.ToString: string; overload; inline;
  6092. begin
  6093. Result:=IntToStr(Self);
  6094. end;
  6095. Function TShortIntHelper.SetBit(const index: TShortIntBitIndex) : ShortInt; inline;
  6096. begin
  6097. Self := Self or (ShortInt(1) shl index);
  6098. Result:=Self;
  6099. end;
  6100. Function TShortIntHelper.ClearBit(const index: TShortIntBitIndex) : ShortInt; inline;
  6101. begin
  6102. Self:=Self and not ShortInt((ShortInt(1) shl index));
  6103. Result:=Self;
  6104. end;
  6105. Function TShortIntHelper.ToggleBit(const index: TShortIntBitIndex) : ShortInt; inline;
  6106. begin
  6107. Self := Self xor ShortInt((ShortInt(1) shl index));
  6108. Result:=Self;
  6109. end;
  6110. Function TShortIntHelper.TestBit(const Index: TShortIntBitIndex):Boolean; inline;
  6111. begin
  6112. Result := (Self and ShortInt((ShortInt(1) shl index)))<>0;
  6113. end;
  6114. { ---------------------------------------------------------------------
  6115. TSmallintHelper
  6116. ---------------------------------------------------------------------}
  6117. Class Function TSmallIntHelper.Parse(const AString: string): SmallInt; inline;
  6118. begin
  6119. Result:=StrToInt(AString);
  6120. end;
  6121. Class Function TSmallIntHelper.Size: Integer; inline;
  6122. begin
  6123. Result:=2;
  6124. end;
  6125. Class Function TSmallIntHelper.ToString(const AValue: SmallInt): string; overload; inline;
  6126. begin
  6127. Result:=IntToStr(AValue);
  6128. end;
  6129. Class Function TSmallIntHelper.TryParse(const AString: string; out AValue: SmallInt): Boolean; inline;
  6130. Var
  6131. C : Integer;
  6132. begin
  6133. Val(AString,AValue,C);
  6134. Result:=(C=0);
  6135. end;
  6136. Function TSmallIntHelper.ToBoolean: Boolean; inline;
  6137. begin
  6138. Result:=(Self<>0);
  6139. end;
  6140. Function TSmallIntHelper.ToDouble: Double; inline;
  6141. begin
  6142. Result:=Self;
  6143. end;
  6144. Function TSmallIntHelper.ToExtended: Extended; inline;
  6145. begin
  6146. Result:=Self;
  6147. end;
  6148. Function TSmallIntHelper.ToBinString: string; inline;
  6149. begin
  6150. Result:=BinStr(Self,Size*8);
  6151. end;
  6152. Function TSmallIntHelper.ToHexString(const AMinDigits: Integer): string; overload; inline;
  6153. Var
  6154. B : Cardinal;
  6155. U : TJSUInt16Array;
  6156. S : TJSInt16array;
  6157. begin
  6158. if Self>=0 then
  6159. B:=Self
  6160. else
  6161. begin
  6162. S:=TJSInt16Array.New(1);
  6163. S[0]:=Self;
  6164. U:=TJSUInt16Array.New(S);
  6165. B:=U[0];
  6166. if AMinDigits>6 then
  6167. B:=$FFFF0000+B
  6168. else if AMinDigits>4 then
  6169. B:=$FF0000+B;
  6170. end;
  6171. Result:=IntToHex(B,AMinDigits);
  6172. end;
  6173. Function TSmallIntHelper.ToHexString: string; overload; inline;
  6174. begin
  6175. Result:=ToHexString(Size*2);
  6176. end;
  6177. Function TSmallIntHelper.ToString: string; overload; inline;
  6178. begin
  6179. Result:=IntToStr(Self);
  6180. end;
  6181. Function TSmallIntHelper.SetBit(const index: TSmallIntBitIndex) : SmallInt; inline;
  6182. begin
  6183. Self := Self or (SmallInt(1) shl index);
  6184. Result:=Self;
  6185. end;
  6186. Function TSmallIntHelper.ClearBit(const index: TSmallIntBitIndex) : SmallInt; inline;
  6187. begin
  6188. Self:=Self and not SmallInt((SmallInt(1) shl index));
  6189. Result:=Self;
  6190. end;
  6191. Function TSmallIntHelper.ToggleBit(const index: TSmallIntBitIndex) : SmallInt; inline;
  6192. begin
  6193. Self := Self xor SmallInt((SmallInt(1) shl index));
  6194. Result:=Self;
  6195. end;
  6196. Function TSmallIntHelper.TestBit(const Index: TSmallIntBitIndex):Boolean; inline;
  6197. begin
  6198. Result := (Self and SmallInt((SmallInt(1) shl index)))<>0;
  6199. end;
  6200. { ---------------------------------------------------------------------
  6201. TWordHelper
  6202. ---------------------------------------------------------------------}
  6203. Class Function TWordHelper.Parse(const AString: string): Word; inline;
  6204. begin
  6205. Result:=StrToInt(AString);
  6206. end;
  6207. Class Function TWordHelper.Size: Integer; inline;
  6208. begin
  6209. Result:=2;
  6210. end;
  6211. Class Function TWordHelper.ToString(const AValue: Word): string; overload; inline;
  6212. begin
  6213. Result:=IntToStr(AValue);
  6214. end;
  6215. Class Function TWordHelper.TryParse(const AString: string; out AValue: Word): Boolean; inline;
  6216. Var
  6217. C : Integer;
  6218. begin
  6219. Val(AString,AValue,C);
  6220. Result:=(C=0);
  6221. end;
  6222. Function TWordHelper.ToBoolean: Boolean; inline;
  6223. begin
  6224. Result:=(Self<>0);
  6225. end;
  6226. Function TWordHelper.ToDouble: Double; inline;
  6227. begin
  6228. Result:=Self;
  6229. end;
  6230. Function TWordHelper.ToExtended: Extended; inline;
  6231. begin
  6232. Result:=Self;
  6233. end;
  6234. Function TWordHelper.ToBinString: string; inline;
  6235. begin
  6236. Result:=BinStr(Self,Size*8);
  6237. end;
  6238. Function TWordHelper.ToHexString(const AMinDigits: Integer): string;
  6239. overload; inline;
  6240. begin
  6241. Result:=IntToHex(Self,AMinDigits);
  6242. end;
  6243. Function TWordHelper.ToHexString: string; overload; inline;
  6244. begin
  6245. Result:=IntToHex(Self,Size*2);
  6246. end;
  6247. Function TWordHelper.ToString: string; overload; inline;
  6248. begin
  6249. Result:=IntToStr(Self);
  6250. end;
  6251. Function TWordHelper.SetBit(const index: TWordBitIndex) : Word; inline;
  6252. begin
  6253. Self := Self or (Word(1) shl index);
  6254. Result:=Self;
  6255. end;
  6256. Function TWordHelper.ClearBit(const index: TWordBitIndex) : Word; inline;
  6257. begin
  6258. Self:=Self and not Word((Word(1) shl index));
  6259. Result:=Self;
  6260. end;
  6261. Function TWordHelper.ToggleBit(const index: TWordBitIndex) : Word; inline;
  6262. begin
  6263. Self := Self xor Word((Word(1) shl index));
  6264. Result:=Self;
  6265. end;
  6266. Function TWordHelper.TestBit(const Index: TWordBitIndex):Boolean; inline;
  6267. begin
  6268. Result := (Self and Word((Word(1) shl index)))<>0;
  6269. end;
  6270. { ---------------------------------------------------------------------
  6271. TCardinalHelper
  6272. ---------------------------------------------------------------------}
  6273. Class Function TCardinalHelper.Parse(const AString: string): Cardinal; inline;
  6274. begin
  6275. Result:=StrToInt(AString);
  6276. end;
  6277. Class Function TCardinalHelper.Size: Integer; inline;
  6278. begin
  6279. Result:=4;
  6280. end;
  6281. Class Function TCardinalHelper.ToString(const AValue: Cardinal): string; overload; inline;
  6282. begin
  6283. Result:=IntToStr(AValue);
  6284. end;
  6285. Class Function TCardinalHelper.TryParse(const AString: string; out AValue: Cardinal): Boolean; inline;
  6286. Var
  6287. C : Integer;
  6288. begin
  6289. Val(AString,AValue,C);
  6290. Result:=(C=0);
  6291. end;
  6292. Function TCardinalHelper.ToBoolean: Boolean; inline;
  6293. begin
  6294. Result:=(Self<>0);
  6295. end;
  6296. Function TCardinalHelper.ToDouble: Double; inline;
  6297. begin
  6298. Result:=Self;
  6299. end;
  6300. Function TCardinalHelper.ToExtended: Extended; inline;
  6301. begin
  6302. Result:=Self;
  6303. end;
  6304. Function TCardinalHelper.ToBinString: string; inline;
  6305. begin
  6306. Result:=BinStr(Self,Size*8);
  6307. end;
  6308. Function TCardinalHelper.ToHexString(const AMinDigits: Integer): string;
  6309. overload; inline;
  6310. begin
  6311. Result:=IntToHex(Self,AMinDigits);
  6312. end;
  6313. Function TCardinalHelper.ToHexString: string; overload; inline;
  6314. begin
  6315. Result:=ToHexString(Size*2);
  6316. end;
  6317. Function TCardinalHelper.ToString: string; overload; inline;
  6318. begin
  6319. Result:=IntToStr(Self);
  6320. end;
  6321. Function TCardinalHelper.SetBit(const index: TCardinalBitIndex) : Cardinal; inline;
  6322. begin
  6323. Self := Self or (Cardinal(1) shl index);
  6324. Result:=Self;
  6325. end;
  6326. Function TCardinalHelper.ClearBit(const index: TCardinalBitIndex) : Cardinal; inline;
  6327. begin
  6328. Self:=Self and not Cardinal((Cardinal(1) shl index));
  6329. Result:=Self;
  6330. end;
  6331. Function TCardinalHelper.ToggleBit(const index: TCardinalBitIndex) : Cardinal; inline;
  6332. begin
  6333. Self := Self xor Cardinal((Cardinal(1) shl index));
  6334. Result:=Self;
  6335. end;
  6336. Function TCardinalHelper.TestBit(const Index: TCardinalBitIndex):Boolean; inline;
  6337. begin
  6338. Result := (Self and Cardinal((Cardinal(1) shl index)))<>0;
  6339. end;
  6340. { ---------------------------------------------------------------------
  6341. TIntegerHelper
  6342. ---------------------------------------------------------------------}
  6343. Class Function TIntegerHelper.Parse(const AString: string): Integer; inline;
  6344. begin
  6345. Result:=StrToInt(AString);
  6346. end;
  6347. Class Function TIntegerHelper.Size: Integer; inline;
  6348. begin
  6349. Result:=4;
  6350. end;
  6351. Class Function TIntegerHelper.ToString(const AValue: Integer): string; overload; inline;
  6352. begin
  6353. Result:=IntToStr(AValue);
  6354. end;
  6355. Class Function TIntegerHelper.TryParse(const AString: string; out AValue: Integer): Boolean; inline;
  6356. Var
  6357. C : Integer;
  6358. begin
  6359. Val(AString,AValue,C);
  6360. Result:=(C=0);
  6361. end;
  6362. Function TIntegerHelper.ToBoolean: Boolean; inline;
  6363. begin
  6364. Result:=(Self<>0);
  6365. end;
  6366. Function TIntegerHelper.ToDouble: Double; inline;
  6367. begin
  6368. Result:=Self;
  6369. end;
  6370. Function TIntegerHelper.ToExtended: Extended; inline;
  6371. begin
  6372. Result:=Self;
  6373. end;
  6374. Function TIntegerHelper.ToBinString: string; inline;
  6375. begin
  6376. Result:=BinStr(Self,Size*8);
  6377. end;
  6378. Function TIntegerHelper.ToHexString(const AMinDigits: Integer): string;
  6379. overload; inline;
  6380. Var
  6381. B : Word;
  6382. U : TJSUInt32Array;
  6383. S : TJSInt32array;
  6384. begin
  6385. if Self>=0 then
  6386. B:=Self
  6387. else
  6388. begin
  6389. S:=TJSInt32Array.New(1);
  6390. S[0]:=Self;
  6391. U:=TJSUInt32Array.New(S);
  6392. B:=U[0];
  6393. end;
  6394. Result:=IntToHex(B,AMinDigits);
  6395. end;
  6396. Function TIntegerHelper.ToHexString: string; overload; inline;
  6397. begin
  6398. Result:=ToHexString(Size*2);
  6399. end;
  6400. Function TIntegerHelper.ToString: string; overload; inline;
  6401. begin
  6402. Result:=IntToStr(Self);
  6403. end;
  6404. Function TIntegerHelper.SetBit(const index: TIntegerBitIndex) : Integer; inline;
  6405. begin
  6406. Self := Self or (Integer(1) shl index);
  6407. Result:=Self;
  6408. end;
  6409. Function TIntegerHelper.ClearBit(const index: TIntegerBitIndex) : Integer; inline;
  6410. begin
  6411. Self:=Self and not Integer((Integer(1) shl index));
  6412. Result:=Self;
  6413. end;
  6414. Function TIntegerHelper.ToggleBit(const index: TIntegerBitIndex) : Integer; inline;
  6415. begin
  6416. Self := Self xor Integer((Integer(1) shl index));
  6417. Result:=Self;
  6418. end;
  6419. Function TIntegerHelper.TestBit(const Index: TIntegerBitIndex):Boolean; inline;
  6420. begin
  6421. Result := (Self and Integer((Integer(1) shl index)))<>0;
  6422. end;
  6423. { ---------------------------------------------------------------------
  6424. TNativeIntHelper
  6425. ---------------------------------------------------------------------}
  6426. Class Function TNativeIntHelper.Parse(const AString: string): NativeInt; inline;
  6427. begin
  6428. Result:=StrToInt(AString);
  6429. end;
  6430. Class Function TNativeIntHelper.Size: Integer; inline;
  6431. begin
  6432. Result:=7;
  6433. end;
  6434. Class Function TNativeIntHelper.ToString(const AValue: NativeInt): string; overload; inline;
  6435. begin
  6436. Result:=IntToStr(AValue);
  6437. end;
  6438. Class Function TNativeIntHelper.TryParse(const AString: string; out AValue: NativeInt): Boolean; inline;
  6439. Var
  6440. C : Integer;
  6441. begin
  6442. Val(AString,AValue,C);
  6443. Result:=(C=0);
  6444. end;
  6445. Function TNativeIntHelper.ToBoolean: Boolean; inline;
  6446. begin
  6447. Result:=(Self<>0);
  6448. end;
  6449. Function TNativeIntHelper.ToDouble: Double; inline;
  6450. begin
  6451. Result:=Self;
  6452. end;
  6453. Function TNativeIntHelper.ToExtended: Extended; inline;
  6454. begin
  6455. Result:=Self;
  6456. end;
  6457. Function TNativeIntHelper.ToBinString: string; inline;
  6458. begin
  6459. Result:=BinStr(Self,Size*8);
  6460. end;
  6461. Function TNativeIntHelper.ToHexString(const AMinDigits: Integer): string;
  6462. overload; inline;
  6463. begin
  6464. Result:=IntToHex(Self,AMinDigits);
  6465. end;
  6466. Function TNativeIntHelper.ToHexString: string; overload; inline;
  6467. begin
  6468. Result:=IntToHex(Self,Size*2);
  6469. end;
  6470. Function TNativeIntHelper.ToString: string; overload; inline;
  6471. begin
  6472. Result:=IntToStr(Self);
  6473. end;
  6474. Function TNativeIntHelper.SetBit(const index: TNativeIntBitIndex) : NativeInt; inline;
  6475. begin
  6476. Self := Self or (NativeInt(1) shl index);
  6477. Result:=Self;
  6478. end;
  6479. Function TNativeIntHelper.ClearBit(const index: TNativeIntBitIndex) : NativeInt; inline;
  6480. begin
  6481. Self:=Self and not NativeInt((NativeInt(1) shl index));
  6482. Result:=Self;
  6483. end;
  6484. Function TNativeIntHelper.ToggleBit(const index: TNativeIntBitIndex) : NativeInt; inline;
  6485. begin
  6486. Self := Self xor NativeInt((NativeInt(1) shl index));
  6487. Result:=Self;
  6488. end;
  6489. Function TNativeIntHelper.TestBit(const Index: TNativeIntBitIndex):Boolean; inline;
  6490. begin
  6491. Result := (Self and NativeInt((NativeInt(1) shl index)))<>0;
  6492. end;
  6493. { ---------------------------------------------------------------------
  6494. TNativeUIntHelper
  6495. ---------------------------------------------------------------------}
  6496. Class Function TNativeUIntHelper.Parse(const AString: string): NativeUInt; inline;
  6497. begin
  6498. Result:=StrToInt(AString);
  6499. end;
  6500. Class Function TNativeUIntHelper.Size: Integer; inline;
  6501. begin
  6502. Result:=7;
  6503. end;
  6504. Class Function TNativeUIntHelper.ToString(const AValue: NativeUInt): string; overload; inline;
  6505. begin
  6506. Result:=IntToStr(AValue);
  6507. end;
  6508. Class Function TNativeUIntHelper.TryParse(const AString: string; out AValue: NativeUInt): Boolean; inline;
  6509. Var
  6510. C : Integer;
  6511. begin
  6512. Val(AString,AValue,C);
  6513. Result:=(C=0);
  6514. end;
  6515. Function TNativeUIntHelper.ToBoolean: Boolean; inline;
  6516. begin
  6517. Result:=(Self<>0);
  6518. end;
  6519. Function TNativeUIntHelper.ToDouble: Double; inline;
  6520. begin
  6521. Result:=Self;
  6522. end;
  6523. Function TNativeUIntHelper.ToExtended: Extended; inline;
  6524. begin
  6525. Result:=Self;
  6526. end;
  6527. Function TNativeUIntHelper.ToBinString: string; inline;
  6528. begin
  6529. Result:=BinStr(Self,Size*8);
  6530. end;
  6531. Function TNativeUIntHelper.ToHexString(const AMinDigits: Integer): string;
  6532. overload; inline;
  6533. begin
  6534. Result:=IntToHex(Self,AMinDigits);
  6535. end;
  6536. Function TNativeUIntHelper.ToHexString: string; overload; inline;
  6537. begin
  6538. Result:=IntToHex(Self,Size*2);
  6539. end;
  6540. Function TNativeUIntHelper.ToSingle: Single; inline;
  6541. begin
  6542. Result:=Self;
  6543. end;
  6544. Function TNativeUIntHelper.ToString: string; overload; inline;
  6545. begin
  6546. Result:=IntToStr(Self);
  6547. end;
  6548. Function TNativeUIntHelper.SetBit(const index: TNativeUIntBitIndex) : NativeUInt; inline;
  6549. begin
  6550. Self := Self or (NativeUInt(1) shl index);
  6551. Result:=Self;
  6552. end;
  6553. Function TNativeUIntHelper.ClearBit(const index: TNativeUIntBitIndex) : NativeUInt; inline;
  6554. begin
  6555. Self:=Self and not NativeUInt((NativeUInt(1) shl index));
  6556. Result:=Self;
  6557. end;
  6558. Function TNativeUIntHelper.ToggleBit(const index: TNativeUIntBitIndex) : NativeUInt; inline;
  6559. begin
  6560. Self := Self xor NativeUInt((NativeUInt(1) shl index));
  6561. Result:=Self;
  6562. end;
  6563. Function TNativeUIntHelper.TestBit(const Index: TNativeUIntBitIndex):Boolean; inline;
  6564. begin
  6565. Result := (Self and NativeUInt((NativeUInt(1) shl index)))<>0;
  6566. end;
  6567. { ---------------------------------------------------------------------
  6568. TBooleanHelper
  6569. ---------------------------------------------------------------------}
  6570. Class Function TBooleanHelper.Parse(const S: string): Boolean; inline;
  6571. begin
  6572. Result:=StrToBool(S);
  6573. end;
  6574. Class Function TBooleanHelper.Size: Integer; inline;
  6575. begin
  6576. Result:=1;
  6577. end;
  6578. Class Function TBooleanHelper.ToString(const AValue: Boolean; UseBoolStrs: TUseBoolStrs = TUseBoolStrs.False): string; overload; inline;
  6579. begin
  6580. Result:=BoolToStr(AValue,UseBoolStrs=TUseBoolStrs.True);
  6581. end;
  6582. Class Function TBooleanHelper.TryToParse(const S: string; out AValue: Boolean): Boolean; inline;
  6583. begin
  6584. Result:=TryStrToBool(S,AValue);
  6585. end;
  6586. Function TBooleanHelper.ToInteger: Integer; inline;
  6587. begin
  6588. Result:=Integer(Self);
  6589. end;
  6590. Function TBooleanHelper.ToString(UseBoolStrs: TUseBoolStrs = TUseBoolStrs.False): string; overload; inline;
  6591. begin
  6592. Result:=BoolToStr(Self,UseBoolStrs=TUseBoolStrs.True);
  6593. end;
  6594. { ---------------------------------------------------------------------
  6595. TByteBoolHelper
  6596. ---------------------------------------------------------------------}
  6597. Class Function TByteBoolHelper.Parse(const S: string): Boolean; inline;
  6598. begin
  6599. Result:=StrToBool(S);
  6600. end;
  6601. Class Function TByteBoolHelper.Size: Integer; inline;
  6602. begin
  6603. Result:=1;
  6604. end;
  6605. Class Function TByteBoolHelper.ToString(const AValue: Boolean; UseBoolStrs: Boolean = False): string; overload; inline;
  6606. begin
  6607. Result:=BoolToStr(AValue,UseBoolStrs);
  6608. end;
  6609. Class Function TByteBoolHelper.TryToParse(const S: string; out AValue: Boolean): Boolean; inline;
  6610. begin
  6611. Result:=TryStrToBool(S,AValue);
  6612. end;
  6613. Function TByteBoolHelper.ToInteger: Integer; inline;
  6614. begin
  6615. Result:=Integer(Self);
  6616. end;
  6617. Function TByteBoolHelper.ToString(UseBoolStrs: Boolean = False): string; overload; inline;
  6618. begin
  6619. Result:=BoolToStr(Self,UseBoolStrs);
  6620. end;
  6621. { ---------------------------------------------------------------------
  6622. TWordBoolHelper
  6623. ---------------------------------------------------------------------}
  6624. Class Function TWordBoolHelper.Parse(const S: string): Boolean; inline;
  6625. begin
  6626. Result:=StrToBool(S);
  6627. end;
  6628. Class Function TWordBoolHelper.Size: Integer; inline;
  6629. begin
  6630. Result:=2;
  6631. end;
  6632. Class Function TWordBoolHelper.ToString(const AValue: Boolean; UseBoolStrs: boolean = False): string; overload; inline;
  6633. begin
  6634. Result:=BoolToStr(AValue,UseBoolStrs);
  6635. end;
  6636. Class Function TWordBoolHelper.TryToParse(const S: string; out AValue: Boolean): Boolean; inline;
  6637. begin
  6638. Result:=TryStrToBool(S,AValue);
  6639. end;
  6640. Function TWordBoolHelper.ToInteger: Integer; inline;
  6641. begin
  6642. Result:=Integer(Self);
  6643. end;
  6644. Function TWordBoolHelper.ToString(UseBoolStrs: Boolean = False): string; overload; inline;
  6645. begin
  6646. Result:=BoolToStr(Self,UseBoolStrs);
  6647. end;
  6648. { ---------------------------------------------------------------------
  6649. TLongBoolHelper
  6650. ---------------------------------------------------------------------}
  6651. Class Function TLongBoolHelper.Parse(const S: string): Boolean; inline;
  6652. begin
  6653. Result:=StrToBool(S);
  6654. end;
  6655. Class Function TLongBoolHelper.Size: Integer; inline;
  6656. begin
  6657. Result:=4;
  6658. end;
  6659. Class Function TLongBoolHelper.ToString(const AValue: Boolean; UseBoolStrs: Boolean = False): string; overload; inline;
  6660. begin
  6661. Result:=BoolToStr(AValue,UseBoolStrs);
  6662. end;
  6663. Class Function TLongBoolHelper.TryToParse(const S: string; out AValue: Boolean): Boolean; inline;
  6664. begin
  6665. Result:=TryStrToBool(S,AValue);
  6666. end;
  6667. Function TLongBoolHelper.ToInteger: Integer; inline;
  6668. begin
  6669. Result:=Integer(Self);
  6670. end;
  6671. Function TLongBoolHelper.ToString(UseBoolStrs: Boolean = False): string; overload; inline;
  6672. begin
  6673. Result:=BoolToStr(Self,UseBoolStrs);
  6674. end;
  6675. { TStringBuilder }
  6676. constructor TStringBuilder.Create;
  6677. begin
  6678. Create(DefaultCapacity,Maxint);
  6679. end;
  6680. constructor TStringBuilder.Create(const AValue: String; aCapacity: Integer);
  6681. begin
  6682. Create(aCapacity,Maxint);
  6683. if (system.Length(AValue)>0) then
  6684. Append(AValue);
  6685. end;
  6686. constructor TStringBuilder.Create(const AValue: String; StartIndex, Alength,
  6687. aCapacity: Integer);
  6688. begin
  6689. Create(Copy(AValue,StartIndex+1,Alength), aCapacity);
  6690. end;
  6691. constructor TStringBuilder.Create(aCapacity, aMaxCapacity: Integer);
  6692. begin
  6693. FMaxCapacity:=aMaxCapacity;
  6694. Capacity:=aCapacity;
  6695. end;
  6696. constructor TStringBuilder.Create(aCapacity: Integer);
  6697. begin
  6698. Create(aCapacity,MaxInt);
  6699. end;
  6700. constructor TStringBuilder.Create(const AValue: String);
  6701. begin
  6702. Create(aValue,DefaultCapacity);
  6703. end;
  6704. { Property getter/setter }
  6705. function TStringBuilder.GetLength: Integer;
  6706. begin
  6707. Result:=System.Length(FData);
  6708. end;
  6709. function TStringBuilder.GetCapacity: Integer;
  6710. begin
  6711. Result:=System.Length(FData);
  6712. end;
  6713. function TStringBuilder.GetC(Index: Integer): Char;
  6714. begin
  6715. CheckNegative(Index,'Index');
  6716. CheckRange(Index,0,Length);
  6717. Result:=FData[Index];
  6718. end;
  6719. procedure TStringBuilder.SetC(Index: Integer; AValue: Char);
  6720. begin
  6721. CheckNegative(Index,'Index');
  6722. CheckRange(Index,0,Length-1);
  6723. FData[Index]:=AValue;
  6724. end;
  6725. procedure TStringBuilder.SetLength(AValue: Integer);
  6726. begin
  6727. CheckNegative(AValue,'AValue');
  6728. CheckRange(AValue,0,MaxCapacity);
  6729. SetLength(FData,aValue);
  6730. end;
  6731. { Check functions }
  6732. procedure TStringBuilder.CheckRange(Idx, Count, MaxLen: Integer);
  6733. begin
  6734. if (Idx<0) or (Idx+Count>MaxLen) then
  6735. Raise ERangeError.CreateFmt(SListIndexError,[Idx]);
  6736. end;
  6737. procedure TStringBuilder.CheckNegative(const AValue: Integer;
  6738. const AName: String);
  6739. begin
  6740. if (AValue<0) then
  6741. Raise ERangeError.CreateFmt(SParamIsNegative,[AName])
  6742. end;
  6743. { These do the actual Appending/Inserting }
  6744. procedure TStringBuilder.DoAppend(const S: String);
  6745. begin
  6746. FData:=FData+S;
  6747. end;
  6748. procedure TStringBuilder.DoAppend(const AValue: Array of Char; Idx, aCount: Integer
  6749. );
  6750. Var
  6751. S : String;
  6752. I : Integer;
  6753. begin
  6754. S:='';
  6755. CheckRange(Idx,aCount,System.Length(AValue));
  6756. for I:=Idx to Idx+aCount-1 do
  6757. S:=S+aValue[I];
  6758. DoAppend(S);
  6759. end;
  6760. procedure TStringBuilder.DoInsert(Index: Integer; const AValue: String);
  6761. begin
  6762. CheckRange(Index,0,Length-1);
  6763. System.Insert(aValue,FData,Index+1);
  6764. end;
  6765. procedure TStringBuilder.DoInsert(Index: Integer; const AValue: Array of Char;
  6766. StartIndex, aCharCount: Integer);
  6767. Var
  6768. I : Integer;
  6769. S : String;
  6770. begin
  6771. CheckRange(Index,0,Length-1);
  6772. CheckNegative(StartIndex,'StartIndex');
  6773. CheckNegative(aCharCount,'SBCharCount');
  6774. CheckRange(StartIndex,aCharCount,System.Length(AValue));
  6775. S:='';
  6776. for I:=StartIndex to StartIndex+aCharCount-1 do
  6777. S:=S+aValue[I];
  6778. DoInsert(Index,S);
  6779. end;
  6780. { Public routines for appending }
  6781. function TStringBuilder.Append(const AValue: UInt64): TStringBuilder;
  6782. begin
  6783. DoAppend(IntToStr(AValue));
  6784. Result:=self;
  6785. end;
  6786. function TStringBuilder.Append(const AValue: Array of Char): TStringBuilder;
  6787. var
  6788. I,L: Integer;
  6789. begin
  6790. I:=-1;
  6791. L:=System.Length(AValue);
  6792. If L=0 then
  6793. Exit(Self);
  6794. Repeat
  6795. Inc(I);
  6796. Until (I>=L) or (AValue[I]=#0);
  6797. DoAppend(AValue,0,I);
  6798. Result:=Self;
  6799. end;
  6800. function TStringBuilder.Append(const AValue: Single): TStringBuilder;
  6801. begin
  6802. DoAppend(FloatToStr(AValue));
  6803. Result:=self;
  6804. end;
  6805. function TStringBuilder.Append(const AValue: Word): TStringBuilder;
  6806. begin
  6807. Append(IntToStr(AValue));
  6808. Result:=self;
  6809. end;
  6810. function TStringBuilder.Append(const AValue: Cardinal): TStringBuilder;
  6811. begin
  6812. DoAppend(IntToStr(AValue));
  6813. Result:=self;
  6814. end;
  6815. function TStringBuilder.Append(const AValue: Char; RepeatCount: Integer
  6816. ): TStringBuilder;
  6817. begin
  6818. DoAppend(StringOfChar(AValue,RepeatCount));
  6819. Result:=Self;
  6820. end;
  6821. function TStringBuilder.Append(const AValue: Shortint): TStringBuilder;
  6822. begin
  6823. DoAppend(IntToStr(AValue));
  6824. Result:=Self;
  6825. end;
  6826. function TStringBuilder.Append(const AValue: Char): TStringBuilder;
  6827. begin
  6828. DoAppend(AValue);
  6829. Result:=Self;
  6830. end;
  6831. function TStringBuilder.Append(const AValue: Currency): TStringBuilder;
  6832. begin
  6833. DoAppend(CurrToStr(AValue));
  6834. Result:=Self;
  6835. end;
  6836. function TStringBuilder.Append(const AValue: Boolean): TStringBuilder;
  6837. begin
  6838. DoAppend(BoolToStr(AValue, True));
  6839. Result:=Self;
  6840. end;
  6841. function TStringBuilder.Append(const AValue: Byte): TStringBuilder;
  6842. begin
  6843. DoAppend(IntToStr(AValue));
  6844. Result:=Self;
  6845. end;
  6846. function TStringBuilder.Append(const AValue: Double): TStringBuilder;
  6847. begin
  6848. DoAppend(FloatToStr(AValue));
  6849. Result:=Self;
  6850. end;
  6851. function TStringBuilder.Append(const AValue: Int64): TStringBuilder;
  6852. begin
  6853. DoAppend(IntToStr(AValue));
  6854. Result:=Self;
  6855. end;
  6856. function TStringBuilder.Append(const AValue: TObject): TStringBuilder;
  6857. begin
  6858. DoAppend(AValue.ToString);
  6859. Result:=Self;
  6860. end;
  6861. function TStringBuilder.Append(const AValue: Smallint): TStringBuilder;
  6862. begin
  6863. DoAppend(IntToStr(AValue));
  6864. Result:=Self;
  6865. end;
  6866. function TStringBuilder.Append(const AValue: LongInt): TStringBuilder;
  6867. begin
  6868. DoAppend(IntToStr(AValue));
  6869. Result:=Self;
  6870. end;
  6871. Function TStringBuilder.Append(const AValue: Array of Char; StartIndex, SBCharCount: Integer): TStringBuilder;
  6872. begin
  6873. DoAppend(AValue,StartIndex,SBCharCount);
  6874. Result:=Self;
  6875. end;
  6876. Function TStringBuilder.Append(const AValue: String; StartIndex, Count: Integer): TStringBuilder;
  6877. begin
  6878. CheckRange(StartIndex,Count,System.Length(AValue));
  6879. DoAppend(Copy(AValue,StartIndex+1,Count));
  6880. Result:=Self;
  6881. end;
  6882. function TStringBuilder.Append(const AValue: String): TStringBuilder;
  6883. begin
  6884. DoAppend(AValue);
  6885. Result:=Self;
  6886. end;
  6887. function TStringBuilder.AppendFormat(const Fmt: String;
  6888. const Args: array of const): TStringBuilder;
  6889. begin
  6890. DoAppend(Format(Fmt,Args));
  6891. Result:=Self;
  6892. end;
  6893. function TStringBuilder.Append(const Fmt: String;
  6894. const Args: array of const): TStringBuilder;
  6895. begin
  6896. DoAppend(Format(Fmt,Args));
  6897. Result:=Self;
  6898. end;
  6899. function TStringBuilder.AppendLine: TStringBuilder;
  6900. begin
  6901. DoAppend(sLineBreak);
  6902. Result:=Self;
  6903. end;
  6904. function TStringBuilder.AppendLine(const AValue: String): TStringBuilder;
  6905. begin
  6906. DoAppend(AValue);
  6907. Result:=AppendLine();
  6908. end;
  6909. procedure TStringBuilder.Clear;
  6910. begin
  6911. Length:=0;
  6912. Capacity:=DefaultCapacity;
  6913. end;
  6914. procedure TStringBuilder.CopyTo(SourceIndex: Integer;
  6915. Var Destination: Array of Char; DestinationIndex: Integer; Count: Integer);
  6916. Var
  6917. I : Integer;
  6918. begin
  6919. CheckNegative(Count,'Count');
  6920. CheckNegative(DestinationIndex,'DestinationIndex');
  6921. CheckRange(DestinationIndex,Count,System.Length(Destination));
  6922. if Count>0 then
  6923. begin
  6924. CheckRange(SourceIndex,Count,Length);
  6925. For I:=SourceIndex+1 to SourceIndex+Count do
  6926. Destination[DestinationIndex]:=FData[I];
  6927. end;
  6928. end;
  6929. function TStringBuilder.EnsureCapacity(aCapacity: Integer): Integer;
  6930. begin
  6931. CheckRange(aCapacity,0,MaxCapacity);
  6932. if Capacity<aCapacity then
  6933. Capacity:=aCapacity;
  6934. Result:=Capacity;
  6935. end;
  6936. function TStringBuilder.Equals(StringBuilder: TStringBuilder): Boolean;
  6937. begin
  6938. Result:=(StringBuilder<>nil);
  6939. if Result then
  6940. Result:=(Length=StringBuilder.Length)
  6941. and (MaxCapacity=StringBuilder.MaxCapacity)
  6942. and (FData=StringBuilder.FData[0]);
  6943. end;
  6944. procedure TStringBuilder.Grow;
  6945. var
  6946. NewCapacity: SizeInt;
  6947. begin
  6948. NewCapacity:=Capacity*2;
  6949. if NewCapacity>MaxCapacity then
  6950. NewCapacity:=MaxCapacity;
  6951. Capacity:=NewCapacity;
  6952. end;
  6953. function TStringBuilder.Insert(Index: Integer; const AValue: TObject
  6954. ): TStringBuilder;
  6955. begin
  6956. DoInsert(Index,AValue.ToString());
  6957. Result:=Self;
  6958. end;
  6959. function TStringBuilder.Insert(Index: Integer; const AValue: Int64
  6960. ): TStringBuilder;
  6961. begin
  6962. DoInsert(Index,IntToStr(AValue));
  6963. Result:=Self;
  6964. end;
  6965. function TStringBuilder.Insert(Index: Integer; const AValue: Single
  6966. ): TStringBuilder;
  6967. begin
  6968. DoInsert(Index,FloatToStr(AValue));
  6969. Result:=Self;
  6970. end;
  6971. function TStringBuilder.Insert(Index: Integer; const AValue: String
  6972. ): TStringBuilder;
  6973. begin
  6974. DoInsert(Index,AValue);
  6975. Result:=Self;
  6976. end;
  6977. function TStringBuilder.Insert(Index: Integer; const AValue: Word
  6978. ): TStringBuilder;
  6979. begin
  6980. DoInsert(Index,IntToStr(AValue));
  6981. Result:=Self;
  6982. end;
  6983. function TStringBuilder.Insert(Index: Integer; const AValue: Shortint
  6984. ): TStringBuilder;
  6985. begin
  6986. DoInsert(Index, IntToStr(AValue));
  6987. Result:=Self;
  6988. end;
  6989. function TStringBuilder.Insert(Index: Integer; const AValue: Currency
  6990. ): TStringBuilder;
  6991. begin
  6992. DoInsert(Index,CurrToStr(AValue));
  6993. Result:=Self;
  6994. end;
  6995. function TStringBuilder.Insert(Index: Integer; const AValue: Char
  6996. ): TStringBuilder;
  6997. begin
  6998. DoInsert(Index,AValue);
  6999. Result:=Self;
  7000. end;
  7001. function TStringBuilder.Insert(Index: Integer; const AValue: Byte
  7002. ): TStringBuilder;
  7003. begin
  7004. DoInsert(Index,IntToStr(AValue));
  7005. Result:=Self;
  7006. end;
  7007. function TStringBuilder.Insert(Index: Integer; const AValue: Double
  7008. ): TStringBuilder;
  7009. begin
  7010. DoInsert(Index,FloatToStr(AValue));
  7011. Result:=Self;
  7012. end;
  7013. function TStringBuilder.Insert(Index: Integer; const AValue: LongInt
  7014. ): TStringBuilder;
  7015. begin
  7016. DoInsert(Index,IntToStr(AValue));
  7017. Result:=Self;
  7018. end;
  7019. function TStringBuilder.Insert(Index: Integer; const AValue: Smallint
  7020. ): TStringBuilder;
  7021. begin
  7022. DoInsert(Index,IntToStr(AValue));
  7023. Result:=Self;
  7024. end;
  7025. function TStringBuilder.Insert(Index: Integer; const AValue: Boolean
  7026. ): TStringBuilder;
  7027. begin
  7028. DoInsert(Index,BoolToStr(AValue,True));
  7029. Result:=Self;
  7030. end;
  7031. function TStringBuilder.Insert(Index: Integer; const AValue: String;
  7032. const aRepeatCount: Integer): TStringBuilder;
  7033. var
  7034. I: Integer;
  7035. begin
  7036. for I:=0 to aRepeatCount-1 do
  7037. DoInsert(Index,AValue);
  7038. Result:=Self;
  7039. end;
  7040. function TStringBuilder.Insert(Index: Integer; const AValue: Array of Char
  7041. ): TStringBuilder;
  7042. begin
  7043. DoInsert(Index,AValue,0,System.Length(AValue));
  7044. Result:=Self;
  7045. end;
  7046. function TStringBuilder.Insert(Index: Integer; const AValue: Array of Char;
  7047. startIndex: Integer; SBCharCount: Integer): TStringBuilder;
  7048. begin
  7049. DoInsert(Index,AValue,StartIndex,SBCharCount);
  7050. Result:=Self;
  7051. end;
  7052. function TStringBuilder.Insert(Index: Integer; const AValue: Cardinal
  7053. ): TStringBuilder;
  7054. begin
  7055. DoInsert(Index,IntToStr(AValue));
  7056. Result:=self;
  7057. end;
  7058. function TStringBuilder.Insert(Index: Integer; const AValue: UInt64
  7059. ): TStringBuilder;
  7060. begin
  7061. DoInsert(Index,IntToStr(AValue));
  7062. Result:=self;
  7063. end;
  7064. procedure TStringBuilder.Shrink;
  7065. begin
  7066. if (Capacity div 4)>=Length then
  7067. Capacity:=Capacity div 2;
  7068. end;
  7069. function TStringBuilder.Remove(StartIndex: Integer; RemLength: Integer
  7070. ): TStringBuilder;
  7071. Var
  7072. MoveIndex : Integer;
  7073. begin
  7074. if (RemLength=0) then
  7075. exit(Self);
  7076. CheckNegative(RemLength,'RemLength');
  7077. CheckRange(StartIndex,0,Length);
  7078. MoveIndex:=StartIndex+RemLength;
  7079. CheckRange(MoveIndex,0,Length);
  7080. Delete(FData,StartIndex+1,RemLength);
  7081. Shrink;
  7082. Result:=Self;
  7083. end;
  7084. Function TStringBuilder.Replace(const OldValue, NewValue: String; StartIndex, Count: Integer): TStringBuilder;
  7085. var
  7086. I : Integer;
  7087. Start : String;
  7088. begin
  7089. if Count=0 then
  7090. Exit(Self);
  7091. // Some checks.
  7092. CheckNegative(StartIndex,'StartIndex');
  7093. CheckNegative(Count,'Count');
  7094. CheckRange(Startindex,Count,Length);
  7095. // Init
  7096. Start:=Copy(FData,1,StartIndex+1);
  7097. FData:=Copy(FData,StartIndex+1);
  7098. For I:=1 to Count do
  7099. FData:=StringReplace(FData,OldValue,NewValue,[]);
  7100. FData:=Start+FData;
  7101. Result:=Self;
  7102. end;
  7103. Function TStringBuilder.Replace(const OldValue, NewValue: String): TStringBuilder;
  7104. begin
  7105. Result:=Replace(OldValue,NewValue,0,Length);
  7106. end;
  7107. procedure TStringBuilder.SetCapacity(AValue: Integer);
  7108. begin
  7109. if (AValue>FMaxCapacity) then
  7110. Raise ERangeError.CreateFmt(SListCapacityError,[AValue]);
  7111. if (AValue<Length) then
  7112. Raise ERangeError.CreateFmt(SListCapacityError,[AValue]);
  7113. // No-op
  7114. end;
  7115. function TStringBuilder.ToString: String;
  7116. begin
  7117. Result:=ToString(0,Length);
  7118. end;
  7119. function TStringBuilder.ToString(aStartIndex: Integer; aLength: Integer
  7120. ): String;
  7121. begin
  7122. CheckNegative(aStartIndex,'aStartIndex');
  7123. CheckNegative(aLength,'aLength');
  7124. CheckRange(aStartIndex,aLength,Length);
  7125. Writeln('FData : ',FData);
  7126. Result:=Copy(FData,1+aStartIndex,aStartIndex+aLength);
  7127. end;
  7128. procedure TStringBuilder.DoReplace(Index: Integer; const Old, New: String);
  7129. var
  7130. OVLen : Integer;
  7131. begin
  7132. OVLen:=System.Length(Old);
  7133. System.Delete(FData,Index+1,OVLen);
  7134. System.Insert(New,FData,Index+1);
  7135. end;
  7136. initialization
  7137. {$WARN 5043 off}
  7138. ShortMonthNames:=DefaultShortMonthNames;
  7139. LongMonthNames:=DefaultLongMonthNames;
  7140. ShortDayNames:=DefaultShortDayNames;
  7141. LongDayNames:=DefaultLongDayNames;
  7142. FormatSettings:=TFormatSettings.Create;
  7143. // So the defaults are taken from FormatSettings.
  7144. TimeSeparator:=FormatSettings.TimeSeparator;
  7145. DateSeparator:=FormatSettings.DateSeparator;
  7146. ShortDateFormat:=FormatSettings.ShortDateFormat;
  7147. LongDateFormat:=FormatSettings.LongDateFormat;
  7148. ShortTimeFormat:=FormatSettings.ShortTimeFormat;
  7149. LongTimeFormat:=FormatSettings.LongTimeFormat;
  7150. DecimalSeparator:=FormatSettings.DecimalSeparator;
  7151. ThousandSeparator:=FormatSettings.ThousandSeparator;
  7152. TimeAMString:=FormatSettings.TimeAMString;
  7153. TimePMString:=FormatSettings.TimePMString;
  7154. CurrencyFormat:=FormatSettings.CurrencyFormat;
  7155. NegCurrFormat:=FormatSettings.NegCurrFormat;
  7156. CurrencyDecimals:=FormatSettings.CurrencyDecimals;
  7157. CurrencyString:=FormatSettings.CurrencyString;
  7158. end.