sysutils.pas 207 KB

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