sysutils.pas 233 KB

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