sysutils.pas 204 KB

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