sysutils.pas 236 KB

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