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