sysutils.pas 208 KB

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