sysutils.pas 207 KB

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