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