sysutils.pas 230 KB

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