sysutils.pas 235 KB

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