sysutils.pas 233 KB

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