sysutils.pas 201 KB

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