sysutils.pas 229 KB

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