sysutils.pas 229 KB

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