| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415441644174418441944204421442244234424442544264427442844294430443144324433443444354436443744384439444044414442444344444445444644474448444944504451445244534454445544564457445844594460446144624463446444654466446744684469447044714472447344744475447644774478447944804481448244834484448544864487448844894490449144924493449444954496449744984499450045014502450345044505450645074508450945104511451245134514451545164517451845194520452145224523452445254526452745284529453045314532453345344535453645374538453945404541454245434544454545464547454845494550455145524553455445554556455745584559456045614562456345644565456645674568456945704571457245734574457545764577457845794580458145824583458445854586458745884589459045914592459345944595459645974598459946004601460246034604460546064607460846094610461146124613461446154616461746184619462046214622462346244625462646274628462946304631463246334634463546364637463846394640464146424643464446454646464746484649465046514652465346544655465646574658465946604661466246634664466546664667466846694670467146724673467446754676467746784679468046814682468346844685468646874688468946904691469246934694469546964697469846994700470147024703470447054706470747084709471047114712471347144715471647174718471947204721472247234724472547264727472847294730473147324733473447354736473747384739474047414742474347444745474647474748474947504751475247534754475547564757475847594760476147624763476447654766476747684769477047714772477347744775477647774778477947804781478247834784478547864787478847894790479147924793479447954796479747984799480048014802480348044805480648074808480948104811481248134814481548164817481848194820482148224823482448254826482748284829483048314832483348344835483648374838483948404841484248434844484548464847484848494850485148524853485448554856485748584859486048614862486348644865486648674868486948704871487248734874487548764877487848794880488148824883488448854886488748884889489048914892489348944895489648974898489949004901490249034904490549064907490849094910491149124913491449154916491749184919492049214922492349244925492649274928492949304931493249334934493549364937493849394940494149424943494449454946494749484949495049514952495349544955495649574958495949604961496249634964496549664967496849694970497149724973497449754976497749784979498049814982498349844985498649874988498949904991499249934994499549964997499849995000500150025003500450055006500750085009501050115012501350145015501650175018501950205021502250235024502550265027502850295030503150325033503450355036503750385039504050415042504350445045504650475048504950505051505250535054505550565057505850595060506150625063506450655066506750685069507050715072507350745075507650775078507950805081508250835084508550865087508850895090509150925093509450955096509750985099510051015102510351045105510651075108510951105111511251135114511551165117511851195120512151225123512451255126512751285129513051315132513351345135513651375138513951405141514251435144514551465147514851495150515151525153515451555156515751585159516051615162516351645165516651675168516951705171517251735174517551765177517851795180518151825183518451855186518751885189519051915192519351945195519651975198519952005201520252035204520552065207520852095210521152125213521452155216521752185219522052215222522352245225522652275228522952305231523252335234523552365237523852395240524152425243524452455246524752485249525052515252525352545255525652575258525952605261526252635264526552665267526852695270527152725273527452755276527752785279528052815282528352845285528652875288528952905291529252935294529552965297529852995300530153025303530453055306530753085309531053115312531353145315531653175318531953205321532253235324532553265327532853295330533153325333533453355336533753385339534053415342534353445345534653475348534953505351535253535354535553565357535853595360536153625363536453655366536753685369537053715372537353745375537653775378537953805381538253835384538553865387538853895390539153925393539453955396539753985399540054015402540354045405540654075408540954105411541254135414541554165417541854195420542154225423542454255426542754285429543054315432543354345435543654375438543954405441544254435444544554465447544854495450545154525453545454555456545754585459546054615462546354645465546654675468546954705471547254735474547554765477547854795480548154825483548454855486548754885489549054915492549354945495549654975498549955005501550255035504550555065507550855095510551155125513551455155516551755185519552055215522552355245525552655275528552955305531553255335534553555365537553855395540554155425543554455455546554755485549555055515552555355545555555655575558555955605561556255635564556555665567556855695570557155725573557455755576557755785579558055815582558355845585558655875588558955905591559255935594559555965597559855995600560156025603560456055606560756085609561056115612561356145615561656175618561956205621562256235624562556265627562856295630563156325633563456355636563756385639564056415642564356445645564656475648564956505651565256535654565556565657565856595660566156625663566456655666566756685669567056715672567356745675567656775678567956805681568256835684568556865687568856895690569156925693569456955696569756985699570057015702570357045705570657075708570957105711571257135714571557165717571857195720572157225723572457255726572757285729573057315732573357345735573657375738573957405741574257435744574557465747574857495750575157525753575457555756575757585759576057615762576357645765576657675768576957705771577257735774577557765777577857795780578157825783578457855786578757885789579057915792579357945795579657975798579958005801580258035804580558065807580858095810581158125813581458155816581758185819582058215822582358245825582658275828582958305831583258335834583558365837583858395840584158425843584458455846584758485849585058515852585358545855585658575858585958605861586258635864586558665867586858695870587158725873587458755876587758785879588058815882588358845885588658875888588958905891589258935894589558965897589858995900590159025903590459055906590759085909591059115912591359145915591659175918591959205921592259235924592559265927592859295930593159325933593459355936593759385939594059415942594359445945594659475948594959505951595259535954595559565957595859595960596159625963596459655966596759685969597059715972597359745975597659775978597959805981598259835984598559865987598859895990599159925993599459955996599759985999600060016002600360046005600660076008600960106011601260136014601560166017601860196020602160226023602460256026602760286029603060316032603360346035603660376038603960406041604260436044604560466047604860496050605160526053605460556056605760586059606060616062606360646065606660676068606960706071607260736074607560766077607860796080608160826083608460856086608760886089609060916092609360946095609660976098609961006101610261036104610561066107610861096110611161126113611461156116611761186119612061216122612361246125612661276128612961306131613261336134613561366137613861396140614161426143614461456146614761486149615061516152615361546155615661576158615961606161616261636164616561666167616861696170617161726173617461756176617761786179618061816182618361846185618661876188618961906191619261936194619561966197619861996200620162026203620462056206620762086209621062116212621362146215621662176218621962206221622262236224622562266227622862296230623162326233623462356236623762386239624062416242624362446245624662476248624962506251625262536254625562566257625862596260626162626263626462656266626762686269627062716272627362746275627662776278627962806281628262836284628562866287628862896290629162926293629462956296629762986299630063016302630363046305630663076308630963106311631263136314631563166317631863196320632163226323632463256326632763286329633063316332633363346335633663376338633963406341634263436344634563466347634863496350635163526353635463556356635763586359636063616362636363646365636663676368636963706371637263736374637563766377637863796380638163826383638463856386638763886389639063916392639363946395639663976398639964006401640264036404640564066407640864096410641164126413641464156416641764186419642064216422642364246425642664276428642964306431643264336434643564366437643864396440644164426443644464456446644764486449645064516452645364546455645664576458645964606461646264636464646564666467646864696470647164726473647464756476647764786479648064816482648364846485648664876488648964906491649264936494649564966497649864996500650165026503650465056506650765086509651065116512651365146515651665176518651965206521652265236524652565266527652865296530653165326533653465356536653765386539654065416542654365446545654665476548654965506551655265536554655565566557655865596560656165626563656465656566656765686569657065716572657365746575657665776578657965806581658265836584658565866587658865896590659165926593659465956596659765986599660066016602660366046605660666076608660966106611661266136614661566166617661866196620662166226623662466256626662766286629663066316632663366346635663666376638663966406641664266436644664566466647664866496650665166526653665466556656665766586659666066616662666366646665666666676668666966706671667266736674667566766677667866796680668166826683668466856686668766886689669066916692669366946695669666976698669967006701670267036704670567066707670867096710671167126713671467156716671767186719672067216722672367246725672667276728672967306731673267336734673567366737673867396740674167426743674467456746674767486749675067516752675367546755675667576758675967606761676267636764676567666767676867696770677167726773677467756776677767786779678067816782678367846785678667876788678967906791679267936794679567966797679867996800680168026803680468056806680768086809681068116812681368146815681668176818681968206821682268236824682568266827682868296830683168326833683468356836683768386839684068416842684368446845684668476848684968506851685268536854685568566857685868596860686168626863686468656866686768686869687068716872687368746875687668776878687968806881688268836884688568866887688868896890689168926893689468956896689768986899690069016902690369046905690669076908690969106911691269136914691569166917691869196920692169226923692469256926692769286929693069316932693369346935693669376938693969406941694269436944694569466947694869496950695169526953695469556956695769586959696069616962696369646965696669676968696969706971697269736974697569766977697869796980698169826983698469856986698769886989699069916992699369946995699669976998699970007001700270037004700570067007700870097010701170127013701470157016701770187019702070217022702370247025702670277028702970307031703270337034703570367037703870397040704170427043704470457046704770487049705070517052705370547055705670577058705970607061706270637064706570667067706870697070707170727073707470757076707770787079708070817082708370847085708670877088708970907091709270937094709570967097709870997100710171027103710471057106710771087109711071117112711371147115711671177118711971207121712271237124712571267127712871297130713171327133713471357136713771387139714071417142714371447145714671477148714971507151715271537154715571567157715871597160716171627163716471657166716771687169717071717172717371747175717671777178717971807181718271837184718571867187718871897190719171927193719471957196719771987199720072017202720372047205720672077208720972107211721272137214721572167217721872197220722172227223722472257226722772287229723072317232723372347235723672377238723972407241724272437244724572467247724872497250725172527253725472557256725772587259726072617262726372647265726672677268726972707271727272737274727572767277727872797280728172827283728472857286728772887289729072917292729372947295729672977298729973007301730273037304730573067307730873097310731173127313731473157316731773187319732073217322732373247325732673277328732973307331733273337334733573367337733873397340734173427343734473457346734773487349735073517352735373547355735673577358735973607361736273637364736573667367736873697370737173727373737473757376737773787379738073817382738373847385738673877388738973907391739273937394739573967397739873997400740174027403740474057406740774087409741074117412741374147415741674177418741974207421742274237424742574267427742874297430743174327433743474357436743774387439744074417442744374447445744674477448744974507451745274537454745574567457745874597460746174627463746474657466746774687469747074717472747374747475747674777478747974807481748274837484748574867487748874897490749174927493749474957496749774987499750075017502750375047505750675077508750975107511751275137514751575167517751875197520752175227523752475257526752775287529753075317532753375347535753675377538753975407541754275437544754575467547754875497550755175527553755475557556755775587559756075617562756375647565756675677568756975707571757275737574757575767577757875797580758175827583758475857586758775887589759075917592759375947595759675977598759976007601760276037604760576067607760876097610761176127613761476157616761776187619762076217622762376247625762676277628762976307631763276337634763576367637763876397640764176427643764476457646764776487649765076517652765376547655765676577658765976607661766276637664766576667667766876697670767176727673767476757676767776787679768076817682768376847685768676877688768976907691769276937694769576967697769876997700770177027703770477057706770777087709771077117712771377147715771677177718771977207721772277237724772577267727772877297730773177327733773477357736773777387739774077417742774377447745774677477748774977507751775277537754775577567757775877597760776177627763776477657766776777687769777077717772777377747775777677777778777977807781778277837784778577867787778877897790779177927793779477957796779777987799780078017802780378047805780678077808780978107811781278137814781578167817781878197820782178227823782478257826782778287829783078317832783378347835783678377838783978407841784278437844784578467847784878497850785178527853785478557856785778587859786078617862786378647865786678677868786978707871787278737874787578767877787878797880788178827883788478857886788778887889789078917892789378947895789678977898789979007901790279037904790579067907790879097910791179127913791479157916791779187919792079217922792379247925792679277928792979307931793279337934793579367937793879397940794179427943794479457946794779487949795079517952795379547955795679577958795979607961796279637964796579667967796879697970797179727973797479757976797779787979798079817982798379847985798679877988798979907991799279937994799579967997799879998000 |
- {******************************************************************************}
- { }
- { Library: Fundamentals 4.00 }
- { File name: cUtils.pas }
- { File version: 4.51 }
- { Description: Utility functions for simple data types }
- { }
- { Copyright: Copyright © 2000-2013, David J Butler }
- { All rights reserved. }
- { Redistribution and use in source and binary forms, with }
- { or without modification, are permitted provided that }
- { the following conditions are met: }
- { Redistributions of source code must retain the above }
- { copyright notice, this list of conditions and the }
- { following disclaimer. }
- { THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND }
- { CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED }
- { WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED }
- { WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A }
- { PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL }
- { THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, }
- { INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR }
- { CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, }
- { PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF }
- { USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) }
- { HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER }
- { IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING }
- { NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE }
- { USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE }
- { POSSIBILITY OF SUCH DAMAGE. }
- { }
- { Home page: http://fundementals.sourceforge.net }
- { Forum: http://sourceforge.net/forum/forum.php?forum_id=2117 }
- { E-mail: fundamentalslib at gmail.com }
- { }
- { Revision history: }
- { }
- { 2000/02/02 0.01 Initial version. }
- { 2000/03/08 1.02 Added array functions. }
- { 2000/04/10 1.03 Added Append, Renamed Delete to Remove and added }
- { StringArrays. }
- { 2000/05/03 1.04 Added Path functions. }
- { 2000/05/08 1.05 Revision. }
- { 2000/06/01 1.06 Added Range and Dup constructors for dynamic arrays. }
- { 2000/06/03 1.07 Added ArrayInsert functions. }
- { 2000/06/06 1.08 Added bit functions from cMaths. }
- { 2000/06/08 1.09 Removed data structure classes. }
- { 2000/06/10 1.10 Added linked lists for Integer, Int64, Extended and }
- { String. }
- { 2000/06/14 1.11 cUtils now generated from a template using a source }
- { pre-processor. }
- { 2000/07/04 1.12 Revision for first Fundamentals release. }
- { 2000/07/24 1.13 Added TrimArray functions. }
- { 2000/07/26 1.14 Added Difference functions. }
- { 2000/09/02 1.15 Added RemoveDuplicates functions. }
- { Added Count functions. }
- { Fixed bug in Sort. }
- { 2000/09/27 1.16 Fixed bug in ArrayInsert. }
- { 2000/11/29 1.17 Moved SetFPUPrecision to cSysUtils. }
- { 2001/05/03 1.18 Improved bit functions. Added Pascal versions of }
- { assembly routines. }
- { 2001/05/13 1.19 Added CharCount. }
- { 2001/05/15 1.20 Added PosNext (ClassType, ObjectArray). }
- { 2001/05/18 1.21 Added hashing functions from cMaths. }
- { 2001/07/07 1.22 Added TBinaryTreeNode. }
- { 2001/11/11 2.23 Revision. }
- { 2002/01/03 2.24 Added EncodeBase64, DecodeBase64 from cMaths and }
- { optimized. Added LongWordToHex, HexToLongWord. }
- { 2002/03/30 2.25 Fixed bug in DecodeBase64. }
- { 2002/04/02 2.26 Removed dependencies on all other units to remove }
- { initialization code associated with SysUtils. This }
- { allows usage of cUtils in projects and still have }
- { very small binaries. }
- { Fixed bug in LongWordToHex. }
- { 2002/05/31 3.27 Refactored for Fundamentals 3. }
- { Moved linked lists to cLinkedLists. }
- { 2002/08/09 3.28 Added HashInteger. }
- { 2002/10/06 3.29 Renamed Cond to iif. }
- { 2002/12/12 3.30 Small revisions. }
- { 2003/03/14 3.31 Removed ApproxZero. Added FloatZero, FloatsEqual and }
- { FloatsCompare. Added documentation and test cases for }
- { comparison functions. }
- { Added support for Currency type. }
- { 2003/07/27 3.32 Added fast ZeroMem and FillMem routines. }
- { 2003/09/11 3.33 Added InterfaceArray functions. }
- { 2004/01/18 3.34 Added WideStringArray functions. }
- { 2004/07/24 3.35 Optimizations of Sort functions. }
- { 2004/08/01 3.36 Improved validation in base conversion routines. }
- { 2004/08/22 3.37 Compilable with Delphi 8. }
- { 2005/06/10 4.38 Compilable with FreePascal 2 Win32 i386. }
- { 2005/08/19 4.39 Compilable with FreePascal 2 Linux i386. }
- { 2005/09/21 4.40 Revised for Fundamentals 4. }
- { 2006/03/04 4.41 Compilable with Delphi 2006 Win32/.NET. }
- { 2007/06/08 4.42 Compilable with FreePascal 2.04 Win32 i386 }
- { 2007/08/08 4.43 Changes to memory functions for Delphi 2006/2007. }
- { 2008/06/06 4.44 Fixed bug in case insensitive hashing functions. }
- { 2009/10/09 4.45 Compilable with Delphi 2009 Win32/.NET. }
- { 2010/06/27 4.46 Compilable with FreePascal 2.4.0 OSX x86-64. }
- { 2012/04/03 4.47 Support for Delphi XE string and integer types. }
- { 2012/04/04 4.48 Moved dynamic arrays functions to cDynArrays. }
- { 2012/04/11 4.49 StringToFloat/FloatToStr functions. }
- { 2012/08/26 4.50 UnicodeString versions of functions. }
- { 2013/01/29 4.51 Compilable with Delphi XE3 x86-64. }
- { }
- { Supported compilers: }
- { }
- { Delphi 5 Win32 i386 }
- { Delphi 6 Win32 i386 }
- { Delphi 7 Win32 i386 4.50 2012/08/30 }
- { Delphi 8 .NET }
- { Delphi 2005 Win32 i386 }
- { Delphi 2006 Win32 i386 }
- { Delphi 2007 Win32 i386 4.50 2012/08/26 }
- { Delphi 2009 Win32 i386 4.46 2011/09/27 }
- { Delphi 2009 .NET 4.45 2009/10/09 }
- { Delphi XE 4.51 2013/01/29 }
- { Delphi XE3 x86-64 4.51 2013/01/29 }
- { FreePascal 2.0.4 Linux i386 }
- { FreePascal 2.4.0 OSX x86-64 4.46 2010/06/27 }
- { FreePascal 2.6.0 Win32 4.50 2012/08/30 }
- { }
- {******************************************************************************}
- {$INCLUDE cDefines.inc}
- {$IFDEF FREEPASCAL}
- {$WARNINGS OFF}
- {$HINTS OFF}
- {$ENDIF}
- {$IFDEF DEBUG}
- {$IFDEF SELFTEST}
- {$DEFINE UTILS_SELFTEST}
- {$ENDIF}
- {$ENDIF}
- unit cUtils;
- interface
- { }
- { Fundamentals Library constants }
- { }
- const
- LibraryVersion = '4.00';
- LibraryMajorVersion = 4;
- LibraryMinorVersion = 0;
- LibraryName = 'Fundamentals ' + LibraryVersion;
- LibraryCopyright = 'Copyright (c) 1998-2013 David J Butler';
- { }
- { Integer types }
- { }
- { Unsigned integers Signed integers }
- { -------------------------------- -------------------------------- }
- { Byte unsigned 8 bits ShortInt signed 8 bits }
- { Word unsigned 16 bits SmallInt signed 16 bits }
- { LongWord unsigned 32 bits LongInt signed 32 bits }
- { - Int64 signed 64 bits }
- { Cardinal unsigned 32 bits Integer signed 32 bits }
- { NativeUInt unsigned system word NativeInt signed system word }
- { }
- type
- Int8 = ShortInt;
- Int16 = SmallInt;
- Int32 = LongInt;
- UInt8 = Byte;
- UInt16 = Word;
- UInt32 = LongWord;
- {$IFNDEF SupportUInt64}
- UInt64 = type Int64;
- {$ENDIF}
- Word8 = UInt8;
- Word16 = UInt16;
- Word32 = UInt32;
- Word64 = UInt64;
- LargeInt = Int64;
- {$IFNDEF SupportNativeInt}
- NativeInt = type Integer;
- NativeUInt = type Cardinal;
- PNativeUInt = ^NativeUInt;
- PNativeInt = ^NativeInt;
- {$ENDIF}
- {$IFDEF DELPHI5_DOWN}
- PByte = ^Byte;
- PWord = ^Word;
- PLongWord = ^LongWord;
- PShortInt = ^ShortInt;
- PSmallInt = ^SmallInt;
- PLongInt = ^LongInt;
- PInteger = ^Integer;
- PInt64 = ^Int64;
- {$ENDIF}
- PInt8 = ^Int8;
- PInt16 = ^Int16;
- PInt32 = ^Int32;
- PLargeInt = ^LargeInt;
- PWord8 = ^Word8;
- PWord16 = ^Word16;
- PWord32 = ^Word32;
- PUInt8 = ^UInt8;
- PUInt16 = ^UInt16;
- PUInt32 = ^UInt32;
- PUInt64 = ^UInt64;
- {$IFNDEF ManagedCode}
- SmallIntRec = packed record
- case Integer of
- 0 : (Lo, Hi : Byte);
- 1 : (Bytes : array[0..1] of Byte);
- end;
- LongIntRec = packed record
- case Integer of
- 0 : (Lo, Hi : Word);
- 1 : (Words : array[0..1] of Word);
- 2 : (Bytes : array[0..3] of Byte);
- end;
- PLongIntRec = ^LongIntRec;
- {$ENDIF}
- const
- MinByte = Low(Byte);
- MaxByte = High(Byte);
- MinWord = Low(Word);
- MaxWord = High(Word);
- MinShortInt = Low(ShortInt);
- MaxShortInt = High(ShortInt);
- MinSmallInt = Low(SmallInt);
- MaxSmallInt = High(SmallInt);
- MinLongWord = LongWord(Low(LongWord));
- MaxLongWord = LongWord(High(LongWord));
- MinLongInt = LongInt(Low(LongInt));
- MaxLongInt = LongInt(High(LongInt));
- MinInt64 = Int64(Low(Int64));
- MaxInt64 = Int64(High(Int64));
- MinInteger = Integer(Low(Integer));
- MaxInteger = Integer(High(Integer));
- MinCardinal = Cardinal(Low(Cardinal));
- MaxCardinal = Cardinal(High(Cardinal));
- MinNativeUInt = NativeUInt(Low(NativeUInt));
- MaxNativeUInt = NativeUInt(High(NativeUInt));
- MinNativeInt = NativeInt(Low(NativeInt));
- MaxNativeInt = NativeInt(High(NativeInt));
- const
- BitsPerByte = 8;
- BitsPerWord = 16;
- BitsPerLongWord = 32;
- BytesPerCardinal = Sizeof(Cardinal);
- BitsPerCardinal = BytesPerCardinal * 8;
- BytesPerNativeWord = SizeOf(NativeInt);
- BitsPerNativeWord = BytesPerNativeWord * 8;
- { Min returns smallest of A and B }
- { Max returns greatest of A and B }
- function MinI(const A, B: Integer): Integer; {$IFDEF UseInline}inline;{$ENDIF}
- function MaxI(const A, B: Integer): Integer; {$IFDEF UseInline}inline;{$ENDIF}
- function MinC(const A, B: Cardinal): Cardinal; {$IFDEF UseInline}inline;{$ENDIF}
- function MaxC(const A, B: Cardinal): Cardinal; {$IFDEF UseInline}inline;{$ENDIF}
- { Clip returns Value if in Low..High range, otherwise Low or High }
- function Clip(const Value: LongInt; const Low, High: LongInt): LongInt; overload; {$IFDEF UseInline}inline;{$ENDIF}
- function Clip(const Value: Int64; const Low, High: Int64): Int64; overload; {$IFDEF UseInline}inline;{$ENDIF}
- function ClipByte(const Value: LongInt): LongInt; overload; {$IFDEF UseInline}inline;{$ENDIF}
- function ClipByte(const Value: Int64): Int64; overload; {$IFDEF UseInline}inline;{$ENDIF}
- function ClipWord(const Value: LongInt): LongInt; overload; {$IFDEF UseInline}inline;{$ENDIF}
- function ClipWord(const Value: Int64): Int64; overload; {$IFDEF UseInline}inline;{$ENDIF}
- function ClipLongWord(const Value: Int64): LongWord; {$IFDEF UseInline}inline;{$ENDIF}
- function SumClipI(const A, I: Integer): Integer;
- function SumClipC(const A: Cardinal; const I: Integer): Cardinal;
- { InXXXRange returns True if A in range of type XXX }
- function InByteRange(const A: Int64): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
- function InWordRange(const A: Int64): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
- function InLongWordRange(const A: Int64): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
- function InShortIntRange(const A: Int64): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
- function InSmallIntRange(const A: Int64): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
- function InLongIntRange(const A: Int64): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
- { }
- { Boolean types }
- { }
- { Boolean - - }
- { ByteBool Bool8 8 bits }
- { WordBool Bool16 16 bits }
- { LongBool Bool32 32 bits }
- { }
- type
- Bool8 = ByteBool;
- Bool16 = WordBool;
- Bool32 = LongBool;
- {$IFDEF DELPHI5_DOWN}
- PBoolean = ^Boolean;
- PByteBool = ^ByteBool;
- PWordBool = ^WordBool;
- {$ENDIF}
- {$IFNDEF FREEPASCAL}
- PLongBool = ^LongBool;
- {$ENDIF}
- PBool8 = ^Bool8;
- PBool16 = ^Bool16;
- PBool32 = ^Bool32;
- { }
- { Comparison }
- { }
- type
- TCompareResult = (
- crLess,
- crEqual,
- crGreater,
- crUndefined);
- TCompareResultSet = set of TCompareResult;
- function ReverseCompareResult(const C: TCompareResult): TCompareResult;
- { }
- { Real types }
- { }
- { Floating point }
- { Single 32 bits 7-8 significant digits }
- { Double 64 bits 15-16 significant digits }
- { Extended 80 bits 19-20 significant digits (mapped to Double in .NET) }
- { }
- { Fixed point }
- { Currency 64 bits 19-20 significant digits, 4 after the decimal point. }
- { }
- const
- MinSingle : Single = 1.5E-45;
- MaxSingle : Single = 3.4E+38;
- MinDouble : Double = 5.0E-324;
- MaxDouble : Double = 1.7E+308;
- {$IFDEF ExtendedIsDouble}
- MinExtended : Extended = 5.0E-324;
- MaxExtended : Extended = 1.7E+308;
- {$ELSE}
- MinExtended : Extended = 3.4E-4932;
- MaxExtended : Extended = 1.1E+4932;
- {$ENDIF}
- {$IFNDEF CLR}
- MinCurrency : Currency = -922337203685477.5807;
- MaxCurrency : Currency = 922337203685477.5807;
- {$ENDIF}
- type
- {$IFDEF DELPHI5_DOWN}
- PSingle = ^Single;
- PDouble = ^Double;
- PExtended = ^Extended;
- PCurrency = ^Currency;
- {$ENDIF}
- {$IFNDEF ManagedCode}
- {$IFNDEF ExtendedIsDouble}
- ExtendedRec = packed record
- case Boolean of
- True: (
- Mantissa : packed array[0..1] of LongWord; { MSB of [1] is the normalized 1 bit }
- Exponent : Word; { MSB is the sign bit }
- );
- False: (Value: Extended);
- end;
- {$ENDIF}
- {$ENDIF}
- {$IFDEF CLR}
- Float = Double;
- {$ELSE}
- Float = Extended;
- {$ENDIF}
- PFloat = ^Float;
- {$IFNDEF ManagedCode}
- const
- ExtendedNan : ExtendedRec = (Mantissa:($FFFFFFFF, $FFFFFFFF); Exponent:$7FFF);
- ExtendedInfinity : ExtendedRec = (Mantissa:($00000000, $80000000); Exponent:$7FFF);
- {$ENDIF}
- { Min returns smallest of A and B }
- { Max returns greatest of A and B }
- { Clip returns Value if in Low..High range, otherwise Low or High }
- function MinF(const A, B: Float): Float; {$IFDEF UseInline}inline;{$ENDIF}
- function MaxF(const A, B: Float): Float; {$IFDEF UseInline}inline;{$ENDIF}
- function ClipF(const Value: Float; const Low, High: Float): Float;
- { InXXXRange returns True if A in range of type XXX }
- function InSingleRange(const A: Float): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
- function InDoubleRange(const A: Float): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
- {$IFNDEF CLR}
- function InCurrencyRange(const A: Float): Boolean; overload;
- function InCurrencyRange(const A: Int64): Boolean; overload;
- {$ENDIF}
- { FloatExponent returns the exponent component of an Extended value }
- {$IFNDEF ExtendedIsDouble}
- function FloatExponentBase2(const A: Extended; var Exponent: Integer): Boolean;
- function FloatExponentBase10(const A: Extended; var Exponent: Integer): Boolean;
- {$ENDIF}
- { FloatIsInfinity is True if A is a positive or negative infinity. }
- { FloatIsNaN is True if A is Not-a-Number. }
- function FloatIsInfinity(const A: Extended): Boolean;
- function FloatIsNaN(const A: Extended): Boolean;
- { }
- { Approximate comparison of floating point values }
- { }
- { FloatZero, FloatOne, FloatsEqual and FloatsCompare are functions for }
- { comparing floating point numbers based on a fixed CompareDelta difference }
- { between the values. This means that values are considered equal if the }
- { unsigned difference between the values are less than CompareDelta. }
- { }
- const
- // Minimum CompareDelta values for the different floating point types:
- // The values were chosen to be slightly higher than the minimum value that
- // the floating-point type can store.
- SingleCompareDelta = 1.0E-34;
- DoubleCompareDelta = 1.0E-280;
- {$IFDEF ExtendedIsDouble}
- ExtendedCompareDelta = DoubleCompareDelta;
- {$ELSE}
- ExtendedCompareDelta = 1.0E-4400;
- {$ENDIF}
- // Default CompareDelta is set to SingleCompareDelta. This allows any type
- // of floating-point value to be compared with any other.
- DefaultCompareDelta = SingleCompareDelta;
- function FloatZero(const A: Float;
- const CompareDelta: Float = DefaultCompareDelta): Boolean;
- function FloatOne(const A: Float;
- const CompareDelta: Float = DefaultCompareDelta): Boolean;
- function FloatsEqual(const A, B: Float;
- const CompareDelta: Float = DefaultCompareDelta): Boolean;
- function FloatsCompare(const A, B: Float;
- const CompareDelta: Float = DefaultCompareDelta): TCompareResult;
- {$IFNDEF ExtendedIsDouble}
- { }
- { Scaled approximate comparison of floating point values }
- { }
- { ApproxEqual and ApproxCompare are functions for comparing floating point }
- { numbers based on a scaled order of magnitude difference between the }
- { values. CompareEpsilon is the ratio applied to the largest of the two }
- { exponents to give the maximum difference (CompareDelta) for comparison. }
- { }
- { For example: }
- { }
- { When the CompareEpsilon is 1.0E-9, the result of }
- { }
- { ApproxEqual(1.0E+20, 1.000000001E+20) = False, but the result of }
- { ApproxEqual(1.0E+20, 1.0000000001E+20) = True, ie the first 9 digits of }
- { the mantissas of the values must be the same. }
- { }
- { Note that for A <> 0.0, the value of ApproxEqual(A, 0.0) will always be }
- { False. Rather use the unscaled FloatZero, FloatsEqual and FloatsCompare }
- { functions when specifically testing for zero. }
- { }
- const
- // Smallest (most sensitive) CompareEpsilon values allowed for the different
- // floating point types:
- SingleCompareEpsilon = 1.0E-5;
- DoubleCompareEpsilon = 1.0E-13;
- ExtendedCompareEpsilon = 1.0E-17;
- // Default CompareEpsilon is set for half the significant digits of the
- // Extended type.
- DefaultCompareEpsilon = 1.0E-10;
- function ApproxEqual(const A, B: Extended;
- const CompareEpsilon: Double = DefaultCompareEpsilon): Boolean;
- function ApproxCompare(const A, B: Extended;
- const CompareEpsilon: Double = DefaultCompareEpsilon): TCompareResult;
- {$ENDIF}
- { }
- { Bit functions }
- { }
- function ClearBit(const Value, BitIndex: LongWord): LongWord;
- function SetBit(const Value, BitIndex: LongWord): LongWord;
- function IsBitSet(const Value, BitIndex: LongWord): Boolean;
- function ToggleBit(const Value, BitIndex: LongWord): LongWord;
- function IsHighBitSet(const Value: LongWord): Boolean;
- function SetBitScanForward(const Value: LongWord): Integer; overload;
- function SetBitScanForward(const Value, BitIndex: LongWord): Integer; overload;
- function SetBitScanReverse(const Value: LongWord): Integer; overload;
- function SetBitScanReverse(const Value, BitIndex: LongWord): Integer; overload;
- function ClearBitScanForward(const Value: LongWord): Integer; overload;
- function ClearBitScanForward(const Value, BitIndex: LongWord): Integer; overload;
- function ClearBitScanReverse(const Value: LongWord): Integer; overload;
- function ClearBitScanReverse(const Value, BitIndex: LongWord): Integer; overload;
- function ReverseBits(const Value: LongWord): LongWord; overload;
- function ReverseBits(const Value: LongWord; const BitCount: Integer): LongWord; overload;
- function SwapEndian(const Value: LongWord): LongWord;
- {$IFDEF ManagedCode}
- procedure SwapEndianBuf(var Buf: array of LongWord);
- {$ELSE}
- procedure SwapEndianBuf(var Buf; const Count: Integer);
- {$ENDIF}
- function TwosComplement(const Value: LongWord): LongWord;
- function RotateLeftBits16(const Value: Word; const Bits: Byte): Word;
- function RotateLeftBits32(const Value: LongWord; const Bits: Byte): LongWord;
- function RotateRightBits16(const Value: Word; const Bits: Byte): Word;
- function RotateRightBits32(const Value: LongWord; const Bits: Byte): LongWord;
- function BitCount(const Value: LongWord): LongWord;
- function IsPowerOfTwo(const Value: LongWord): Boolean;
- function LowBitMask(const HighBitIndex: LongWord): LongWord;
- function HighBitMask(const LowBitIndex: LongWord): LongWord;
- function RangeBitMask(const LowBitIndex, HighBitIndex: LongWord): LongWord;
- function SetBitRange(const Value: LongWord;
- const LowBitIndex, HighBitIndex: LongWord): LongWord;
- function ClearBitRange(const Value: LongWord;
- const LowBitIndex, HighBitIndex: LongWord): LongWord;
- function ToggleBitRange(const Value: LongWord;
- const LowBitIndex, HighBitIndex: LongWord): LongWord;
- function IsBitRangeSet(const Value: LongWord;
- const LowBitIndex, HighBitIndex: LongWord): Boolean;
- function IsBitRangeClear(const Value: LongWord;
- const LowBitIndex, HighBitIndex: LongWord): Boolean;
- const
- BitMaskTable: array[0..31] of LongWord =
- ($00000001, $00000002, $00000004, $00000008,
- $00000010, $00000020, $00000040, $00000080,
- $00000100, $00000200, $00000400, $00000800,
- $00001000, $00002000, $00004000, $00008000,
- $00010000, $00020000, $00040000, $00080000,
- $00100000, $00200000, $00400000, $00800000,
- $01000000, $02000000, $04000000, $08000000,
- $10000000, $20000000, $40000000, $80000000);
- { }
- { Sets }
- { Operations on byte and character sets. }
- { }
- type
- CharSet = set of AnsiChar;
- AnsiCharSet = CharSet;
- ByteSet = set of Byte;
- PCharSet = ^CharSet;
- PByteSet = ^ByteSet;
- const
- CompleteCharSet = [AnsiChar(#0)..AnsiChar(#255)];
- CompleteByteSet = [0..255];
- function AsCharSet(const C: array of AnsiChar): CharSet;
- function AsByteSet(const C: array of Byte): ByteSet;
- procedure ComplementChar(var C: CharSet; const Ch: AnsiChar);
- procedure ClearCharSet(var C: CharSet);
- procedure FillCharSet(var C: CharSet);
- procedure ComplementCharSet(var C: CharSet);
- procedure AssignCharSet(var DestSet: CharSet; const SourceSet: CharSet); overload;
- procedure Union(var DestSet: CharSet; const SourceSet: CharSet); overload;
- procedure Difference(var DestSet: CharSet; const SourceSet: CharSet); overload;
- procedure Intersection(var DestSet: CharSet; const SourceSet: CharSet); overload;
- procedure XORCharSet(var DestSet: CharSet; const SourceSet: CharSet);
- function IsSubSet(const A, B: CharSet): Boolean;
- function IsEqual(const A, B: CharSet): Boolean; overload;
- function IsEmpty(const C: CharSet): Boolean;
- function IsComplete(const C: CharSet): Boolean;
- function CharCount(const C: CharSet): Integer; overload;
- procedure ConvertCaseInsensitive(var C: CharSet);
- function CaseInsensitiveCharSet(const C: CharSet): CharSet;
- { }
- { Range functions }
- { }
- { RangeLength Length of a range }
- { RangeAdjacent True if ranges are adjacent }
- { RangeOverlap True if ranges overlap }
- { RangeHasElement True if element is in range }
- { }
- function IntRangeLength(const Low, High: Integer): Int64;
- function IntRangeAdjacent(const Low1, High1, Low2, High2: Integer): Boolean;
- function IntRangeOverlap(const Low1, High1, Low2, High2: Integer): Boolean;
- function IntRangeHasElement(const Low, High, Element: Integer): Boolean;
- function IntRangeIncludeElement(var Low, High: Integer;
- const Element: Integer): Boolean;
- function IntRangeIncludeElementRange(var Low, High: Integer;
- const LowElement, HighElement: Integer): Boolean;
- function CardRangeLength(const Low, High: Cardinal): Int64;
- function CardRangeAdjacent(const Low1, High1, Low2, High2: Cardinal): Boolean;
- function CardRangeOverlap(const Low1, High1, Low2, High2: Cardinal): Boolean;
- function CardRangeHasElement(const Low, High, Element: Cardinal): Boolean;
- function CardRangeIncludeElement(var Low, High: Cardinal;
- const Element: Cardinal): Boolean;
- function CardRangeIncludeElementRange(var Low, High: Cardinal;
- const LowElement, HighElement: Cardinal): Boolean;
- { }
- { UnicodeString }
- { UnicodeString in Delphi 2009 is reference counted, code page aware, }
- { variable character length unicode string. Defaults to UTF-16 encoding. }
- { WideString is not reference counted. }
- { }
- type
- UnicodeChar = WideChar;
- PUnicodeChar = ^UnicodeChar;
- {$IFNDEF SupportUnicodeString}
- UnicodeString = WideString;
- PUnicodeString = ^UnicodeString;
- {$ENDIF}
- { }
- { Swap }
- { }
- procedure Swap(var X, Y: Boolean); overload;
- procedure Swap(var X, Y: Byte); overload;
- procedure Swap(var X, Y: Word); overload;
- procedure Swap(var X, Y: LongWord); overload;
- procedure Swap(var X, Y: NativeUInt); overload;
- procedure Swap(var X, Y: ShortInt); overload;
- procedure Swap(var X, Y: SmallInt); overload;
- procedure Swap(var X, Y: LongInt); overload;
- procedure Swap(var X, Y: Int64); overload;
- procedure Swap(var X, Y: NativeInt); overload;
- procedure Swap(var X, Y: Single); overload;
- procedure Swap(var X, Y: Double); overload;
- procedure Swap(var X, Y: Extended); overload;
- procedure Swap(var X, Y: Currency); overload;
- procedure SwapA(var X, Y: AnsiString); overload;
- procedure SwapW(var X, Y: WideString); overload;
- procedure SwapU(var X, Y: UnicodeString); overload;
- procedure Swap(var X, Y: String); overload;
- procedure Swap(var X, Y: TObject); overload;
- {$IFDEF ManagedCode}
- procedure SwapObjects(var X, Y: TObject);
- {$ELSE}
- procedure SwapObjects(var X, Y);
- {$ENDIF}
- {$IFNDEF ManagedCode}
- procedure Swap(var X, Y: Pointer); overload;
- {$ENDIF}
- { }
- { Inline if }
- { }
- { iif returns TrueValue if Expr is True, otherwise it returns FalseValue. }
- { }
- function iif(const Expr: Boolean; const TrueValue: Integer;
- const FalseValue: Integer = 0): Integer; overload; {$IFDEF UseInline}inline;{$ENDIF}
- function iif(const Expr: Boolean; const TrueValue: Int64;
- const FalseValue: Int64 = 0): Int64; overload; {$IFDEF UseInline}inline;{$ENDIF}
- function iif(const Expr: Boolean; const TrueValue: Extended;
- const FalseValue: Extended = 0.0): Extended; overload; {$IFDEF UseInline}inline;{$ENDIF}
- function iifA(const Expr: Boolean; const TrueValue: AnsiString;
- const FalseValue: AnsiString = ''): AnsiString; overload; {$IFDEF UseInline}inline;{$ENDIF}
- function iifW(const Expr: Boolean; const TrueValue: WideString;
- const FalseValue: WideString = ''): WideString; overload; {$IFDEF UseInline}inline;{$ENDIF}
- function iifU(const Expr: Boolean; const TrueValue: UnicodeString;
- const FalseValue: UnicodeString = ''): UnicodeString; overload; {$IFDEF UseInline}inline;{$ENDIF}
- function iif(const Expr: Boolean; const TrueValue: String;
- const FalseValue: String = ''): String; overload; {$IFDEF UseInline}inline;{$ENDIF}
- function iif(const Expr: Boolean; const TrueValue: TObject;
- const FalseValue: TObject = nil): TObject; overload; {$IFDEF UseInline}inline;{$ENDIF}
- { }
- { Direct comparison }
- { }
- { Compare(I1, I2) returns crLess if I1 < I2, crEqual if I1 = I2 or }
- { crGreater if I1 > I2. }
- { }
- function Compare(const I1, I2: Boolean): TCompareResult; overload;
- function Compare(const I1, I2: Integer): TCompareResult; overload;
- function Compare(const I1, I2: Int64): TCompareResult; overload;
- function Compare(const I1, I2: Extended): TCompareResult; overload;
- function CompareA(const I1, I2: AnsiString): TCompareResult;
- function CompareW(const I1, I2: WideString): TCompareResult;
- function CompareU(const I1, I2: UnicodeString): TCompareResult;
- function Sgn(const A: LongInt): Integer; overload;
- function Sgn(const A: Int64): Integer; overload;
- function Sgn(const A: Extended): Integer; overload;
- { }
- { Convert result }
- { }
- type
- TConvertResult = (
- convertOK,
- convertFormatError,
- convertOverflow
- );
- { }
- { Integer-String conversions }
- { }
- const
- StrHexDigitsUpper: String[16] = '0123456789ABCDEF';
- StrHexDigitsLower: String[16] = '0123456789abcdef';
- function AnsiCharToInt(const A: AnsiChar): Integer; {$IFDEF UseInline}inline;{$ENDIF}
- function WideCharToInt(const A: WideChar): Integer; {$IFDEF UseInline}inline;{$ENDIF}
- function CharToInt(const A: Char): Integer; {$IFDEF UseInline}inline;{$ENDIF}
- function IntToAnsiChar(const A: Integer): AnsiChar; {$IFDEF UseInline}inline;{$ENDIF}
- function IntToWideChar(const A: Integer): WideChar; {$IFDEF UseInline}inline;{$ENDIF}
- function IntToChar(const A: Integer): Char; {$IFDEF UseInline}inline;{$ENDIF}
- function IsHexAnsiChar(const Ch: AnsiChar): Boolean;
- function IsHexWideChar(const Ch: WideChar): Boolean;
- function IsHexChar(const Ch: Char): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
- function HexAnsiCharToInt(const A: AnsiChar): Integer;
- function HexWideCharToInt(const A: WideChar): Integer;
- function HexCharToInt(const A: Char): Integer; {$IFDEF UseInline}inline;{$ENDIF}
- function IntToUpperHexAnsiChar(const A: Integer): AnsiChar;
- function IntToUpperHexWideChar(const A: Integer): WideChar;
- function IntToUpperHexChar(const A: Integer): Char; {$IFDEF UseInline}inline;{$ENDIF}
- function IntToLowerHexAnsiChar(const A: Integer): AnsiChar;
- function IntToLowerHexWideChar(const A: Integer): WideChar;
- function IntToLowerHexChar(const A: Integer): Char; {$IFDEF UseInline}inline;{$ENDIF}
- function IntToStringA(const A: Int64): AnsiString;
- function IntToStringW(const A: Int64): WideString;
- function IntToStringU(const A: Int64): UnicodeString;
- function IntToString(const A: Int64): String;
- function UIntToStringA(const A: NativeUInt): AnsiString;
- function UIntToStringW(const A: NativeUInt): WideString;
- function UIntToStringU(const A: NativeUInt): UnicodeString;
- function UIntToString(const A: NativeUInt): String;
- function LongWordToStrA(const A: LongWord; const Digits: Integer = 0): AnsiString;
- function LongWordToStrW(const A: LongWord; const Digits: Integer = 0): WideString;
- function LongWordToStrU(const A: LongWord; const Digits: Integer = 0): UnicodeString;
- function LongWordToStr(const A: LongWord; const Digits: Integer = 0): String;
- function LongWordToHexA(const A: LongWord; const Digits: Integer = 0; const UpperCase: Boolean = True): AnsiString;
- function LongWordToHexW(const A: LongWord; const Digits: Integer = 0; const UpperCase: Boolean = True): WideString;
- function LongWordToHexU(const A: LongWord; const Digits: Integer = 0; const UpperCase: Boolean = True): UnicodeString;
- function LongWordToHex(const A: LongWord; const Digits: Integer = 0; const UpperCase: Boolean = True): String;
- function LongWordToOctA(const A: LongWord; const Digits: Integer = 0): AnsiString;
- function LongWordToOctW(const A: LongWord; const Digits: Integer = 0): WideString;
- function LongWordToOctU(const A: LongWord; const Digits: Integer = 0): UnicodeString;
- function LongWordToOct(const A: LongWord; const Digits: Integer = 0): String;
- function LongWordToBinA(const A: LongWord; const Digits: Integer = 0): AnsiString;
- function LongWordToBinW(const A: LongWord; const Digits: Integer = 0): WideString;
- function LongWordToBinU(const A: LongWord; const Digits: Integer = 0): UnicodeString;
- function LongWordToBin(const A: LongWord; const Digits: Integer = 0): String;
- function TryStringToInt64PA(const BufP: Pointer; const BufLen: Integer; out Value: Int64; out StrLen: Integer): TConvertResult;
- function TryStringToInt64PW(const BufP: Pointer; const BufLen: Integer; out Value: Int64; out StrLen: Integer): TConvertResult;
- function TryStringToInt64P(const BufP: Pointer; const BufLen: Integer; out Value: Int64; out StrLen: Integer): TConvertResult;
- function TryStringToInt64A(const S: AnsiString; out A: Int64): Boolean;
- function TryStringToInt64W(const S: WideString; out A: Int64): Boolean;
- function TryStringToInt64U(const S: UnicodeString; out A: Int64): Boolean;
- function TryStringToInt64(const S: String; out A: Int64): Boolean;
- function StringToInt64DefA(const S: AnsiString; const Default: Int64): Int64;
- function StringToInt64DefW(const S: WideString; const Default: Int64): Int64;
- function StringToInt64DefU(const S: UnicodeString; const Default: Int64): Int64;
- function StringToInt64Def(const S: String; const Default: Int64): Int64;
- function StringToInt64A(const S: AnsiString): Int64;
- function StringToInt64W(const S: WideString): Int64;
- function StringToInt64U(const S: UnicodeString): Int64;
- function StringToInt64(const S: String): Int64;
- function TryStringToIntA(const S: AnsiString; out A: Integer): Boolean;
- function TryStringToIntW(const S: WideString; out A: Integer): Boolean;
- function TryStringToIntU(const S: UnicodeString; out A: Integer): Boolean;
- function TryStringToInt(const S: String; out A: Integer): Boolean;
- function StringToIntDefA(const S: AnsiString; const Default: Integer): Integer;
- function StringToIntDefW(const S: WideString; const Default: Integer): Integer;
- function StringToIntDefU(const S: UnicodeString; const Default: Integer): Integer;
- function StringToIntDef(const S: String; const Default: Integer): Integer;
- function StringToIntA(const S: AnsiString): Integer;
- function StringToIntW(const S: WideString): Integer;
- function StringToIntU(const S: UnicodeString): Integer;
- function StringToInt(const S: String): Integer;
- function TryStringToLongWordA(const S: AnsiString; out A: LongWord): Boolean;
- function TryStringToLongWordW(const S: WideString; out A: LongWord): Boolean;
- function TryStringToLongWordU(const S: UnicodeString; out A: LongWord): Boolean;
- function TryStringToLongWord(const S: String; out A: LongWord): Boolean;
- function StringToLongWordA(const S: AnsiString): LongWord;
- function StringToLongWordW(const S: WideString): LongWord;
- function StringToLongWordU(const S: UnicodeString): LongWord;
- function StringToLongWord(const S: String): LongWord;
- function HexToUIntA(const S: AnsiString): NativeUInt;
- function HexToUIntW(const S: WideString): NativeUInt;
- function HexToUIntU(const S: UnicodeString): NativeUInt;
- function HexToUInt(const S: String): NativeUInt;
- function TryHexToLongWordA(const S: AnsiString; out A: LongWord): Boolean;
- function TryHexToLongWordW(const S: WideString; out A: LongWord): Boolean;
- function TryHexToLongWordU(const S: UnicodeString; out A: LongWord): Boolean;
- function TryHexToLongWord(const S: String; out A: LongWord): Boolean;
- function HexToLongWordA(const S: AnsiString): LongWord;
- function HexToLongWordW(const S: WideString): LongWord;
- function HexToLongWordU(const S: UnicodeString): LongWord;
- function HexToLongWord(const S: String): LongWord;
- function TryOctToLongWordA(const S: AnsiString; out A: LongWord): Boolean;
- function TryOctToLongWordW(const S: WideString; out A: LongWord): Boolean;
- function TryOctToLongWordU(const S: UnicodeString; out A: LongWord): Boolean;
- function TryOctToLongWord(const S: String; out A: LongWord): Boolean;
- function OctToLongWordA(const S: AnsiString): LongWord;
- function OctToLongWordW(const S: WideString): LongWord;
- function OctToLongWordU(const S: UnicodeString): LongWord;
- function OctToLongWord(const S: String): LongWord;
- function TryBinToLongWordA(const S: AnsiString; out A: LongWord): Boolean;
- function TryBinToLongWordW(const S: WideString; out A: LongWord): Boolean;
- function TryBinToLongWordU(const S: UnicodeString; out A: LongWord): Boolean;
- function TryBinToLongWord(const S: String; out A: LongWord): Boolean;
- function BinToLongWordA(const S: AnsiString): LongWord;
- function BinToLongWordW(const S: WideString): LongWord;
- function BinToLongWordU(const S: UnicodeString): LongWord;
- function BinToLongWord(const S: String): LongWord;
- { }
- { Float-String conversions }
- { }
- function FloatToStringA(const A: Extended): AnsiString;
- function FloatToStringW(const A: Extended): WideString;
- function FloatToStringU(const A: Extended): UnicodeString;
- function FloatToString(const A: Extended): String;
- function TryStringToFloatPA(const BufP: Pointer; const BufLen: Integer; out Value: Extended; out StrLen: Integer): TConvertResult;
- function TryStringToFloatPW(const BufP: Pointer; const BufLen: Integer; out Value: Extended; out StrLen: Integer): TConvertResult;
- function TryStringToFloatP(const BufP: Pointer; const BufLen: Integer; out Value: Extended; out StrLen: Integer): TConvertResult;
- function TryStringToFloatA(const A: AnsiString; out B: Extended): Boolean;
- function TryStringToFloatW(const A: WideString; out B: Extended): Boolean;
- function TryStringToFloatU(const A: UnicodeString; out B: Extended): Boolean;
- function TryStringToFloat(const A: String; out B: Extended): Boolean;
- function StringToFloatA(const A: AnsiString): Extended;
- function StringToFloatW(const A: WideString): Extended;
- function StringToFloatU(const A: UnicodeString): Extended;
- function StringToFloat(const A: String): Extended;
- function StringToFloatDefA(const A: AnsiString; const Default: Extended): Extended;
- function StringToFloatDefW(const A: WideString; const Default: Extended): Extended;
- function StringToFloatDefU(const A: UnicodeString; const Default: Extended): Extended;
- function StringToFloatDef(const A: String; const Default: Extended): Extended;
- { }
- { Base64 }
- { }
- { EncodeBase64 converts a binary string (S) to a base 64 string using }
- { Alphabet. if Pad is True, the result will be padded with PadChar to be a }
- { multiple of PadMultiple. }
- { }
- { DecodeBase64 converts a base 64 string using Alphabet (64 characters for }
- { values 0-63) to a binary string. }
- { }
- function EncodeBase64(const S, Alphabet: AnsiString;
- const Pad: Boolean = False;
- const PadMultiple: Integer = 4;
- const PadChar: AnsiChar = '='): AnsiString;
- function DecodeBase64(const S, Alphabet: AnsiString;
- const PadSet: CharSet{$IFNDEF CLR} = []{$ENDIF}): AnsiString;
- const
- b64_MIMEBase64 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
- b64_UUEncode = ' !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
- b64_XXEncode = '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
- function MIMEBase64Decode(const S: AnsiString): AnsiString;
- function MIMEBase64Encode(const S: AnsiString): AnsiString;
- function UUDecode(const S: AnsiString): AnsiString;
- function XXDecode(const S: AnsiString): AnsiString;
- function BytesToHex(
- {$IFDEF ManagedCode}const P: array of Byte;
- {$ELSE} const P: Pointer; const Count: Integer;{$ENDIF}
- const UpperCase: Boolean = True): AnsiString;
- { }
- { Type conversion }
- { }
- {$IFNDEF ManagedCode}
- function PointerToStrA(const P: Pointer): AnsiString;
- function PointerToStrW(const P: Pointer): WideString;
- function PointerToStr(const P: Pointer): String;
- function StrToPointerA(const S: AnsiString): Pointer;
- function StrToPointerW(const S: WideString): Pointer;
- function StrToPointer(const S: String): Pointer;
- function InterfaceToStrA(const I: IInterface): AnsiString;
- function InterfaceToStrW(const I: IInterface): WideString;
- function InterfaceToStr(const I: IInterface): String;
- {$ENDIF}
- function ObjectClassName(const O: TObject): String;
- function ClassClassName(const C: TClass): String;
- function ObjectToStr(const O: TObject): String;
- function CharSetToStr(const C: CharSet): AnsiString;
- function StrToCharSet(const S: AnsiString): CharSet;
- { }
- { Hashing functions }
- { }
- { HashBuf uses a every byte in the buffer to calculate a hash. }
- { }
- { HashStr is a general purpose string hashing function. }
- { }
- { If Slots = 0 the hash value is in the LongWord range (0-$FFFFFFFF), }
- { otherwise the value is in the range from 0 to Slots-1. Note that the }
- { 'mod' operation, which is used when Slots <> 0, is comparitively slow. }
- { }
- function HashBuf(const Hash: LongWord; const Buf; const BufSize: Integer): LongWord;
- function HashStrA(const S: AnsiString;
- const Index: Integer = 1; const Count: Integer = -1;
- const AsciiCaseSensitive: Boolean = True;
- const Slots: LongWord = 0): LongWord;
- function HashStrW(const S: WideString;
- const Index: Integer = 1; const Count: Integer = -1;
- const AsciiCaseSensitive: Boolean = True;
- const Slots: LongWord = 0): LongWord;
- function HashStrU(const S: UnicodeString;
- const Index: Integer = 1; const Count: Integer = -1;
- const AsciiCaseSensitive: Boolean = True;
- const Slots: LongWord = 0): LongWord;
- function HashStr(const S: String;
- const Index: Integer = 1; const Count: Integer = -1;
- const AsciiCaseSensitive: Boolean = True;
- const Slots: LongWord = 0): LongWord;
- function HashInteger(const I: Integer; const Slots: LongWord = 0): LongWord;
- function HashLongWord(const I: LongWord; const Slots: LongWord = 0): LongWord;
- { }
- { Memory operations }
- { }
- {$IFDEF DELPHI5_DOWN}
- type
- PPointer = ^Pointer;
- {$ENDIF}
- const
- Bytes1KB = 1024;
- Bytes1MB = 1024 * Bytes1KB;
- Bytes1GB = 1024 * Bytes1MB;
- Bytes64KB = 64 * Bytes1KB;
- Bytes64MB = 64 * Bytes1MB;
- Bytes2GB = 2 * LongWord(Bytes1GB);
- {$IFNDEF ManagedCode}
- {$IFDEF ASM386_DELPHI}{$IFNDEF DELPHI2006_UP}
- {$DEFINE UseAsmMemFunction}
- {$ENDIF}{$ENDIF}
- {$IFDEF UseInline}{$IFNDEF UseAsmMemFunction}
- {$DEFINE InlineMemFunction}
- {$ENDIF}{$ENDIF}
- procedure FillMem(var Buf; const Count: Integer; const Value: Byte); {$IFDEF InlineMemFunction}inline;{$ENDIF}
- procedure ZeroMem(var Buf; const Count: Integer); {$IFDEF InlineMemFunction}inline;{$ENDIF}
- procedure GetZeroMem(var P: Pointer; const Size: Integer); {$IFDEF InlineMemFunction}inline;{$ENDIF}
- procedure MoveMem(const Source; var Dest; const Count: Integer); {$IFDEF InlineMemFunction}inline;{$ENDIF}
- function CompareMem(const Buf1; const Buf2; const Count: Integer): Boolean;
- function CompareMemNoCase(const Buf1; const Buf2; const Count: Integer): TCompareResult;
- function LocateMem(const Buf1; const Size1: Integer; const Buf2; const Size2: Integer): Integer;
- procedure ReverseMem(var Buf; const Size: Integer);
- {$ENDIF}
- { }
- { IInterface }
- { }
- {$IFDEF DELPHI5_DOWN}
- type
- IInterface = interface
- ['{00000000-0000-0000-C000-000000000046}']
- function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
- function _AddRef: Integer; stdcall;
- function _Release: Integer; stdcall;
- end;
- {$ENDIF}
- { }
- { Array pointers }
- { }
- { Maximum array elements }
- const
- MaxArraySize = $7FFFFFFF; // 2 Gigabytes
- MaxByteArrayElements = MaxArraySize div Sizeof(Byte);
- MaxWordArrayElements = MaxArraySize div Sizeof(Word);
- MaxLongWordArrayElements = MaxArraySize div Sizeof(LongWord);
- MaxCardinalArrayElements = MaxArraySize div Sizeof(Cardinal);
- MaxNativeUIntArrayElements = MaxArraySize div Sizeof(NativeUInt);
- MaxShortIntArrayElements = MaxArraySize div Sizeof(ShortInt);
- MaxSmallIntArrayElements = MaxArraySize div Sizeof(SmallInt);
- MaxLongIntArrayElements = MaxArraySize div Sizeof(LongInt);
- MaxIntegerArrayElements = MaxArraySize div Sizeof(Integer);
- MaxInt64ArrayElements = MaxArraySize div Sizeof(Int64);
- MaxNativeIntArrayElements = MaxArraySize div Sizeof(NativeInt);
- MaxSingleArrayElements = MaxArraySize div Sizeof(Single);
- MaxDoubleArrayElements = MaxArraySize div Sizeof(Double);
- MaxExtendedArrayElements = MaxArraySize div Sizeof(Extended);
- MaxBooleanArrayElements = MaxArraySize div Sizeof(Boolean);
- {$IFNDEF CLR}
- MaxCurrencyArrayElements = MaxArraySize div Sizeof(Currency);
- MaxAnsiStringArrayElements = MaxArraySize div Sizeof(AnsiString);
- MaxWideStringArrayElements = MaxArraySize div Sizeof(WideString);
- MaxUnicodeStringArrayElements = MaxArraySize div Sizeof(UnicodeString);
- {$IFDEF StringIsUnicode}
- MaxStringArrayElements = MaxArraySize div Sizeof(UnicodeString);
- {$ELSE}
- MaxStringArrayElements = MaxArraySize div Sizeof(AnsiString);
- {$ENDIF}
- MaxPointerArrayElements = MaxArraySize div Sizeof(Pointer);
- MaxObjectArrayElements = MaxArraySize div Sizeof(TObject);
- MaxInterfaceArrayElements = MaxArraySize div Sizeof(IInterface);
- MaxCharSetArrayElements = MaxArraySize div Sizeof(CharSet);
- MaxByteSetArrayElements = MaxArraySize div Sizeof(ByteSet);
- {$ENDIF}
- { Static array types }
- type
- TStaticByteArray = array[0..MaxByteArrayElements - 1] of Byte;
- TStaticWordArray = array[0..MaxWordArrayElements - 1] of Word;
- TStaticLongWordArray = array[0..MaxLongWordArrayElements - 1] of LongWord;
- TStaticNativeUIntArray = array[0..MaxNativeUIntArrayElements - 1] of NativeUInt;
- TStaticShortIntArray = array[0..MaxShortIntArrayElements - 1] of ShortInt;
- TStaticSmallIntArray = array[0..MaxSmallIntArrayElements - 1] of SmallInt;
- TStaticLongIntArray = array[0..MaxLongIntArrayElements - 1] of LongInt;
- TStaticInt64Array = array[0..MaxInt64ArrayElements - 1] of Int64;
- TStaticNativeIntArray = array[0..MaxNativeIntArrayElements - 1] of NativeInt;
- TStaticSingleArray = array[0..MaxSingleArrayElements - 1] of Single;
- TStaticDoubleArray = array[0..MaxDoubleArrayElements - 1] of Double;
- TStaticExtendedArray = array[0..MaxExtendedArrayElements - 1] of Extended;
- TStaticBooleanArray = array[0..MaxBooleanArrayElements - 1] of Boolean;
- {$IFNDEF CLR}
- TStaticCurrencyArray = array[0..MaxCurrencyArrayElements - 1] of Currency;
- TStaticAnsiStringArray = array[0..MaxAnsiStringArrayElements - 1] of AnsiString;
- TStaticWideStringArray = array[0..MaxWideStringArrayElements - 1] of WideString;
- TStaticUnicodeStringArray = array[0..MaxUnicodeStringArrayElements - 1] of UnicodeString;
- {$IFDEF StringIsUnicode}
- TStaticStringArray = TStaticWideStringArray;
- {$ELSE}
- TStaticStringArray = TStaticAnsiStringArray;
- {$ENDIF}
- TStaticPointerArray = array[0..MaxPointerArrayElements - 1] of Pointer;
- TStaticObjectArray = array[0..MaxObjectArrayElements - 1] of TObject;
- TStaticInterfaceArray = array[0..MaxInterfaceArrayElements - 1] of IInterface;
- TStaticCharSetArray = array[0..MaxCharSetArrayElements - 1] of CharSet;
- TStaticByteSetArray = array[0..MaxByteSetArrayElements - 1] of ByteSet;
- {$ENDIF}
- TStaticCardinalArray = TStaticLongWordArray;
- TStaticIntegerArray = TStaticLongIntArray;
- { Static array pointers }
- type
- PStaticByteArray = ^TStaticByteArray;
- PStaticWordArray = ^TStaticWordArray;
- PStaticLongWordArray = ^TStaticLongWordArray;
- PStaticCardinalArray = ^TStaticCardinalArray;
- PStaticNativeUIntArray = ^TStaticNativeUIntArray;
- PStaticShortIntArray = ^TStaticShortIntArray;
- PStaticSmallIntArray = ^TStaticSmallIntArray;
- PStaticLongIntArray = ^TStaticLongIntArray;
- PStaticIntegerArray = ^TStaticIntegerArray;
- PStaticInt64Array = ^TStaticInt64Array;
- PStaticNativeIntArray = ^TStaticNativeIntArray;
- PStaticSingleArray = ^TStaticSingleArray;
- PStaticDoubleArray = ^TStaticDoubleArray;
- PStaticExtendedArray = ^TStaticExtendedArray;
- PStaticBooleanArray = ^TStaticBooleanArray;
- {$IFNDEF CLR}
- PStaticCurrencyArray = ^TStaticCurrencyArray;
- PStaticAnsiStringArray = ^TStaticAnsiStringArray;
- PStaticWideStringArray = ^TStaticWideStringArray;
- PStaticUnicodeStringArray = ^TStaticUnicodeStringArray;
- PStaticStringArray = ^TStaticStringArray;
- PStaticPointerArray = ^TStaticPointerArray;
- PStaticObjectArray = ^TStaticObjectArray;
- PStaticInterfaceArray = ^TStaticInterfaceArray;
- PStaticCharSetArray = ^TStaticCharSetArray;
- PStaticByteSetArray = ^TStaticByteSetArray;
- {$ENDIF}
- { }
- { Dynamic arrays }
- { }
- type
- ByteArray = array of Byte;
- WordArray = array of Word;
- LongWordArray = array of LongWord;
- CardinalArray = LongWordArray;
- NativeUIntArray = array of NativeUInt;
- ShortIntArray = array of ShortInt;
- SmallIntArray = array of SmallInt;
- LongIntArray = array of LongInt;
- IntegerArray = LongIntArray;
- NativeIntArray = array of NativeInt;
- Int64Array = array of Int64;
- SingleArray = array of Single;
- DoubleArray = array of Double;
- ExtendedArray = array of Extended;
- CurrencyArray = array of Currency;
- BooleanArray = array of Boolean;
- AnsiStringArray = array of AnsiString;
- WideStringArray = array of WideString;
- UnicodeStringArray = array of UnicodeString;
- StringArray = array of String;
- {$IFNDEF ManagedCode}
- PointerArray = array of Pointer;
- {$ENDIF}
- ObjectArray = array of TObject;
- InterfaceArray = array of IInterface;
- CharSetArray = array of CharSet;
- ByteSetArray = array of ByteSet;
- {$IFDEF ManagedCode}
- procedure FreeObjectArray(var V: ObjectArray); overload;
- procedure FreeObjectArray(var V: ObjectArray; const LoIdx, HiIdx: Integer); overload;
- {$ELSE}
- procedure FreeObjectArray(var V); overload;
- procedure FreeObjectArray(var V; const LoIdx, HiIdx: Integer); overload;
- {$ENDIF}
- procedure FreeAndNilObjectArray(var V: ObjectArray);
- {$IFNDEF CLR}
- { }
- { Generic quick sort algorithm }
- { }
- type
- TQuickSortCompareFunction =
- function (const Data: Pointer; const Index1, Index2: Integer): TCompareResult;
- TQuickSortSwapFunction =
- procedure (const Data: Pointer; const Index1, Index2: Integer);
- procedure GenericQuickSort(const Data: Pointer; const Count: Integer;
- const CompareFunc: TQuickSortCompareFunction;
- const SwapFunc: TQuickSortSwapFunction);
- { }
- { Generic binary search algorithm }
- { }
- type
- TBinarySearchCompareFunction =
- function (const Data: Pointer; const Index: Integer;
- const Item: Pointer): TCompareResult;
- function GenericBinarySearch(const Data: Pointer; const Count: Integer;
- const Item: Pointer;
- const CompareFunc: TBinarySearchCompareFunction): Integer;
- {$ENDIF}
- { }
- { Test cases }
- { }
- {$IFDEF UTILS_SELFTEST}
- procedure SelfTest;
- {$ENDIF}
- implementation
- uses
- { System }
- SysUtils,
- Math;
- { }
- { CPU identification }
- { }
- {$IFDEF ASM386_DELPHI}
- var
- CPUIDInitialised : Boolean = False;
- CPUIDSupport : Boolean = False;
- MMXSupport : Boolean = False;
- procedure InitialiseCPUID; assembler;
- asm
- // Set CPUID flag
- PUSHFD
- POP EAX
- OR EAX, $200000
- PUSH EAX
- POPFD
- // Check if CPUID flag is still set
- PUSHFD
- POP EAX
- AND EAX, $200000
- JNZ @CPUIDSupported
- // CPUID not supported
- MOV BYTE PTR [CPUIDSupport], 0
- MOV BYTE PTR [MMXSupport], 0
- JMP @CPUIDFin
- // CPUID supported
- @CPUIDSupported:
- MOV BYTE PTR [CPUIDSupport], 1
- PUSH EBX
- // Perform CPUID function 1
- MOV EAX, 1
- {$IFDEF DELPHI5_DOWN}
- DW 0FA2h
- {$ELSE}
- CPUID
- {$ENDIF}
- // Check if MMX feature flag is set
- AND EDX, $800000
- SETNZ AL
- MOV BYTE PTR [MMXSupport], AL
- POP EBX
- @CPUIDFin:
- MOV BYTE PTR [CPUIDInitialised], 1
- end;
- {$ENDIF}
- { }
- { Range check error }
- { }
- resourcestring
- SRangeCheckError = 'Range check error';
- procedure RaiseRangeCheckError; {$IFDEF UseInline}inline;{$ENDIF}
- begin
- raise ERangeError.Create(SRangeCheckError);
- end;
- { }
- { Integer }
- { }
- function MinI(const A, B: Integer): Integer;
- begin
- if A < B then
- Result := A
- else
- Result := B;
- end;
- function MaxI(const A, B: Integer): Integer;
- begin
- if A > B then
- Result := A
- else
- Result := B;
- end;
- function MinC(const A, B: Cardinal): Cardinal;
- begin
- if A < B then
- Result := A
- else
- Result := B;
- end;
- function MaxC(const A, B: Cardinal): Cardinal;
- begin
- if A > B then
- Result := A
- else
- Result := B;
- end;
- function Clip(const Value: LongInt; const Low, High: LongInt): LongInt;
- begin
- if Value < Low then
- Result := Low else
- if Value > High then
- Result := High
- else
- Result := Value;
- end;
- function Clip(const Value: Int64; const Low, High: Int64): Int64;
- begin
- if Value < Low then
- Result := Low else
- if Value > High then
- Result := High
- else
- Result := Value;
- end;
- function ClipByte(const Value: LongInt): LongInt;
- begin
- if Value < MinByte then
- Result := MinByte else
- if Value > MaxByte then
- Result := MaxByte
- else
- Result := Value;
- end;
- function ClipByte(const Value: Int64): Int64;
- begin
- if Value < MinByte then
- Result := MinByte else
- if Value > MaxByte then
- Result := MaxByte
- else
- Result := Value;
- end;
- function ClipWord(const Value: LongInt): LongInt;
- begin
- if Value < MinWord then
- Result := MinWord else
- if Value > MaxWord then
- Result := MaxWord
- else
- Result := Value;
- end;
- function ClipWord(const Value: Int64): Int64;
- begin
- if Value < MinWord then
- Result := MinWord else
- if Value > MaxWord then
- Result := MaxWord
- else
- Result := Value;
- end;
- function ClipLongWord(const Value: Int64): LongWord;
- begin
- if Value < MinLongWord then
- Result := MinLongWord else
- if Value > MaxLongWord then
- Result := MaxLongWord
- else
- Result := LongWord(Value);
- end;
- function SumClipI(const A, I: Integer): Integer;
- begin
- if I >= 0 then
- if A >= MaxInteger - I then
- Result := MaxInteger
- else
- Result := A + I
- else
- if A <= MinInteger - I then
- Result := MinInteger
- else
- Result := A + I;
- end;
- function SumClipC(const A: Cardinal; const I: Integer): Cardinal;
- var B : Cardinal;
- begin
- if I >= 0 then
- if A >= MaxCardinal - Cardinal(I) then
- Result := MaxCardinal
- else
- Result := A + Cardinal(I)
- else
- begin
- B := Cardinal(-I);
- if A <= B then
- Result := 0
- else
- Result := A - B;
- end;
- end;
- function InByteRange(const A: Int64): Boolean;
- begin
- Result := (A >= MinByte) and (A <= MaxByte);
- end;
- function InWordRange(const A: Int64): Boolean;
- begin
- Result := (A >= MinWord) and (A <= MaxWord);
- end;
- function InLongWordRange(const A: Int64): Boolean;
- begin
- Result := (A >= MinLongWord) and (A <= MaxLongWord);
- end;
- function InShortIntRange(const A: Int64): Boolean;
- begin
- Result := (A >= MinShortInt) and (A <= MaxShortInt);
- end;
- function InSmallIntRange(const A: Int64): Boolean;
- begin
- Result := (A >= MinSmallInt) and (A <= MaxSmallInt);
- end;
- function InLongIntRange(const A: Int64): Boolean;
- begin
- Result := (A >= MinLongInt) and (A <= MaxLongInt);
- end;
- { }
- { Real }
- { }
- function MinF(const A, B: Float): Float;
- begin
- if A < B then
- Result := A
- else
- Result := B;
- end;
- function MaxF(const A, B: Float): Float;
- begin
- if A > B then
- Result := A
- else
- Result := B;
- end;
- function ClipF(const Value: Float; const Low, High: Float): Float;
- begin
- if Value < Low then
- Result := Low else
- if Value > High then
- Result := High
- else
- Result := Value;
- end;
- function InSingleRange(const A: Float): Boolean;
- var B : Float;
- begin
- B := Abs(A);
- Result := (B >= MinSingle) and (B <= MaxSingle);
- end;
- {$IFDEF CLR}
- function InDoubleRange(const A: Float): Boolean;
- begin
- Result := True;
- end;
- {$ELSE}
- function InDoubleRange(const A: Float): Boolean;
- var B : Float;
- begin
- B := Abs(A);
- Result := (B >= MinDouble) and (B <= MaxDouble);
- end;
- {$ENDIF}
- {$IFNDEF CLR}
- function InCurrencyRange(const A: Float): Boolean;
- begin
- Result := (A >= MinCurrency) and (A <= MaxCurrency);
- end;
- function InCurrencyRange(const A: Int64): Boolean;
- begin
- Result := (A >= MinCurrency) and (A <= MaxCurrency);
- end;
- {$ENDIF}
- {$IFNDEF ExtendedIsDouble}
- function FloatExponentBase2(const A: Extended; var Exponent: Integer): Boolean;
- var RecA : ExtendedRec absolute A;
- ExpA : Word;
- begin
- ExpA := RecA.Exponent and $7FFF;
- if ExpA = $7FFF then // A is NaN, Infinity, ...
- begin
- Exponent := 0;
- Result := False;
- end
- else
- begin
- Exponent := Integer(ExpA) - 16383;
- Result := True;
- end;
- end;
- function FloatExponentBase10(const A: Extended; var Exponent: Integer): Boolean;
- const Log2_10 = 3.32192809488736; // Log2(10)
- begin
- Result := FloatExponentBase2(A, Exponent);
- if Result then
- Exponent := Round(Exponent / Log2_10);
- end;
- {$ENDIF}
- function FloatIsInfinity(const A: Extended): Boolean;
- var Ext : ExtendedRec absolute A;
- begin
- if Ext.Exponent and $7FFF <> $7FFF then
- Result := False
- else
- Result := (Ext.Mantissa[1] = $80000000) and (Ext.Mantissa[0] = 0);
- end;
- function FloatIsNaN(const A: Extended): Boolean;
- var Ext : ExtendedRec absolute A;
- begin
- if Ext.Exponent and $7FFF <> $7FFF then
- Result := False
- else
- Result := (Ext.Mantissa[1] <> $80000000) or (Ext.Mantissa[0] <> 0)
- end;
- { }
- { Approximate comparison }
- { }
- function FloatZero(const A: Float; const CompareDelta: Float): Boolean;
- begin
- Assert(CompareDelta >= 0.0);
- Result := Abs(A) <= CompareDelta;
- end;
- function FloatOne(const A: Float; const CompareDelta: Float): Boolean;
- begin
- Assert(CompareDelta >= 0.0);
- Result := Abs(A - 1.0) <= CompareDelta;
- end;
- function FloatsEqual(const A, B: Float; const CompareDelta: Float): Boolean;
- begin
- Assert(CompareDelta >= 0.0);
- Result := Abs(A - B) <= CompareDelta;
- end;
- function FloatsCompare(const A, B: Float; const CompareDelta: Float): TCompareResult;
- var D : Float;
- begin
- Assert(CompareDelta >= 0.0);
- D := A - B;
- if Abs(D) <= CompareDelta then
- Result := crEqual else
- if D >= CompareDelta then
- Result := crGreater
- else
- Result := crLess;
- end;
- {$IFNDEF ExtendedIsDouble}
- { }
- { Scaled approximate comparison }
- { }
- { The ApproxEqual and ApproxCompare functions were taken from the freeware }
- { FltMath unit by Tempest Software, as taken from Knuth, Seminumerical }
- { Algorithms, 2nd ed., Addison-Wesley, 1981, pp. 217-220. }
- { }
- function ApproxEqual(const A, B: Extended; const CompareEpsilon: Double): Boolean;
- var ExtA : ExtendedRec absolute A;
- ExtB : ExtendedRec absolute B;
- ExpA : Word;
- ExpB : Word;
- Exp : ExtendedRec;
- begin
- ExpA := ExtA.Exponent and $7FFF;
- ExpB := ExtB.Exponent and $7FFF;
- if (ExpA = $7FFF) and
- ((ExtA.Mantissa[1] <> $80000000) or (ExtA.Mantissa[0] <> 0)) then
- { A is NaN }
- Result := False else
- if (ExpB = $7FFF) and
- ((ExtB.Mantissa[1] <> $80000000) or (ExtB.Mantissa[0] <> 0)) then
- { B is NaN }
- Result := False else
- if (ExpA = $7FFF) or (ExpB = $7FFF) then
- { A or B is infinity. Use the builtin comparison, which will }
- { properly account for signed infinities, comparing infinity with }
- { infinity, or comparing infinity with a finite value. }
- Result := A = B else
- begin
- { We are comparing two finite values, so take the difference and }
- { compare that against the scaled Epsilon. }
- Exp.Value := 1.0;
- if ExpA < ExpB then
- Exp.Exponent := ExpB
- else
- Exp.Exponent := ExpA;
- Result := Abs(A - B) <= (CompareEpsilon * Exp.Value);
- end;
- end;
- function ApproxCompare(const A, B: Extended; const CompareEpsilon: Double): TCompareResult;
- var ExtA : ExtendedRec absolute A;
- ExtB : ExtendedRec absolute B;
- ExpA : Word;
- ExpB : Word;
- Exp : ExtendedRec;
- D, E : Extended;
- begin
- ExpA := ExtA.Exponent and $7FFF;
- ExpB := ExtB.Exponent and $7FFF;
- if (ExpA = $7FFF) and
- ((ExtA.Mantissa[1] <> $80000000) or (ExtA.Mantissa[0] <> 0)) then
- { A is NaN }
- Result := crUndefined else
- if (ExpB = $7FFF) and
- ((ExtB.Mantissa[1] <> $80000000) or (ExtB.Mantissa[0] <> 0)) then
- { B is NaN }
- Result := crUndefined else
- if (ExpA = $7FFF) or (ExpB = $7FFF) then
- { A or B is infinity. Use the builtin comparison, which will }
- { properly account for signed infinities, comparing infinity with }
- { infinity, or comparing infinity with a finite value. }
- Result := Compare(A, B) else
- begin
- { We are comparing two finite values, so take the difference and }
- { compare that against the scaled Epsilon. }
- Exp.Value := 1.0;
- if ExpA < ExpB then
- Exp.Exponent := ExpB
- else
- Exp.Exponent := ExpA;
- E := CompareEpsilon * Exp.Value;
- D := A - B;
- if Abs(D) <= E then
- Result := crEqual else
- if D >= E then
- Result := crGreater
- else
- Result := crLess;
- end;
- end;
- {$ENDIF}
- { }
- { Bit functions }
- { }
- {$IFDEF ASM386_DELPHI}
- function ReverseBits(const Value: LongWord): LongWord; register; assembler;
- asm
- BSWAP EAX
- MOV EDX, EAX
- AND EAX, 0AAAAAAAAh
- SHR EAX, 1
- AND EDX, 055555555h
- SHL EDX, 1
- OR EAX, EDX
- MOV EDX, EAX
- AND EAX, 0CCCCCCCCh
- SHR EAX, 2
- AND EDX, 033333333h
- SHL EDX, 2
- OR EAX, EDX
- MOV EDX, EAX
- AND EAX, 0F0F0F0F0h
- SHR EAX, 4
- AND EDX, 00F0F0F0Fh
- SHL EDX, 4
- OR EAX, EDX
- end;
- {$ELSE}
- function ReverseBits(const Value: LongWord): LongWord;
- var I : Byte;
- begin
- Result := 0;
- for I := 0 to 31 do
- if Value and BitMaskTable[I] <> 0 then
- Result := Result or BitMaskTable[31 - I];
- end;
- {$ENDIF}
- function ReverseBits(const Value: LongWord; const BitCount: Integer): LongWord;
- var I : Integer;
- V : LongWord;
- begin
- V := Value;
- Result := 0;
- for I := 0 to MinI(BitCount, BitsPerLongWord) - 1 do
- begin
- Result := (Result shl 1) or (V and 1);
- V := V shr 1;
- end;
- end;
- {$IFDEF ASM386_DELPHI}
- function SwapEndian(const Value: LongWord): LongWord; register; assembler;
- asm
- XCHG AH, AL
- ROL EAX, 16
- XCHG AH, AL
- end;
- {$ELSE}
- function SwapEndian(const Value: LongWord): LongWord;
- begin
- Result := ((Value and $000000FF) shl 24) or
- ((Value and $0000FF00) shl 8) or
- ((Value and $00FF0000) shr 8) or
- ((Value and $FF000000) shr 24);
- end;
- {$ENDIF}
- {$IFDEF ManagedCode}
- procedure SwapEndianBuf(var Buf: array of LongWord);
- var I : Integer;
- begin
- for I := 0 to Length(Buf) - 1 do
- Buf[I] := SwapEndian(Buf[I]);
- end;
- {$ELSE}
- procedure SwapEndianBuf(var Buf; const Count: Integer);
- var P : PLongWord;
- I : Integer;
- begin
- P := @Buf;
- for I := 1 to Count do
- begin
- P^ := SwapEndian(P^);
- Inc(P);
- end;
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- function TwosComplement(const Value: LongWord): LongWord; register; assembler;
- asm
- NEG EAX
- end;
- {$ELSE}
- function TwosComplement(const Value: LongWord): LongWord;
- begin
- Result := LongWord(not Value + 1);
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- function RotateLeftBits16(const Value: Word; const Bits: Byte): Word;
- asm
- MOV CL, DL
- ROL AX, CL
- end;
- {$ELSE}
- function RotateLeftBits16(const Value: Word; const Bits: Byte): Word;
- var I, B : Integer;
- R : Word;
- begin
- R := Value;
- if Bits >= 16 then
- B := Bits mod 16
- else
- B := Bits;
- for I := 1 to B do
- if R and $8000 = 0 then
- R := Word(R shl 1)
- else
- R := Word(R shl 1) or 1;
- Result := R;
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- function RotateLeftBits32(const Value: LongWord; const Bits: Byte): LongWord;
- asm
- MOV CL, DL
- ROL EAX, CL
- end;
- {$ELSE}
- function RotateLeftBits32(const Value: LongWord; const Bits: Byte): LongWord;
- var I, B : Integer;
- R : LongWord;
- begin
- R := Value;
- if Bits >= 32 then
- B := Bits mod 32
- else
- B := Bits;
- for I := 1 to B do
- if R and $80000000 = 0 then
- R := LongWord(R shl 1)
- else
- R := LongWord(R shl 1) or 1;
- Result := R;
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- function RotateRightBits16(const Value: Word; const Bits: Byte): Word;
- asm
- MOV CL, DL
- ROR AX, CL
- end;
- {$ELSE}
- function RotateRightBits16(const Value: Word; const Bits: Byte): Word;
- var I, B : Integer;
- R : Word;
- begin
- R := Value;
- if Bits >= 16 then
- B := Bits mod 16
- else
- B := Bits;
- for I := 1 to B do
- if R and 1 = 0 then
- R := Word(R shr 1)
- else
- R := Word(R shr 1) or $8000;
- Result := R;
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- function RotateRightBits32(const Value: LongWord; const Bits: Byte): LongWord;
- asm
- MOV CL, DL
- ROR EAX, CL
- end;
- {$ELSE}
- function RotateRightBits32(const Value: LongWord; const Bits: Byte): LongWord;
- var I, B : Integer;
- R : LongWord;
- begin
- R := Value;
- if Bits >= 32 then
- B := Bits mod 32
- else
- B := Bits;
- for I := 1 to B do
- if R and 1 = 0 then
- R := LongWord(R shr 1)
- else
- R := LongWord(R shr 1) or $80000000;
- Result := R;
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- function SetBit(const Value, BitIndex: LongWord): LongWord;
- asm
- {$IFOPT R+}
- CMP BitIndex, BitsPerLongWord
- JB @RangeOk
- JMP RaiseRangeCheckError
- @RangeOk:
- {$ENDIF}
- OR EAX, DWORD PTR [BitIndex * 4 + BitMaskTable]
- end;
- {$ELSE}
- function SetBit(const Value, BitIndex: LongWord): LongWord;
- begin
- Result := Value or BitMaskTable[BitIndex];
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- function ClearBit(const Value, BitIndex: LongWord): LongWord;
- asm
- {$IFOPT R+}
- CMP BitIndex, BitsPerLongWord
- JB @RangeOk
- JMP RaiseRangeCheckError
- @RangeOk:
- {$ENDIF}
- MOV ECX, DWORD PTR [BitIndex * 4 + BitMaskTable]
- NOT ECX
- AND EAX, ECX
- @Fin:
- end;
- {$ELSE}
- function ClearBit(const Value, BitIndex: LongWord): LongWord;
- begin
- Result := Value and not BitMaskTable[BitIndex];
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- function ToggleBit(const Value, BitIndex: LongWord): LongWord;
- asm
- {$IFOPT R+}
- CMP BitIndex, BitsPerLongWord
- JB @RangeOk
- JMP RaiseRangeCheckError
- @RangeOk:
- {$ENDIF}
- XOR EAX, DWORD PTR [BitIndex * 4 + BitMaskTable]
- end;
- {$ELSE}
- function ToggleBit(const Value, BitIndex: LongWord): LongWord;
- begin
- Result := Value xor BitMaskTable[BitIndex];
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- function IsHighBitSet(const Value: LongWord): Boolean; register; assembler;
- asm
- TEST Value, $80000000
- SETNZ AL
- end;
- {$ELSE}
- function IsHighBitSet(const Value: LongWord): Boolean;
- begin
- Result := Value and $80000000 <> 0;
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- function IsBitSet(const Value, BitIndex: LongWord): Boolean;
- asm
- {$IFOPT R+}
- CMP BitIndex, BitsPerLongWord
- JB @RangeOk
- JMP RaiseRangeCheckError
- @RangeOk:
- {$ENDIF}
- MOV ECX, DWORD PTR BitMaskTable [BitIndex * 4]
- TEST Value, ECX
- SETNZ AL
- end;
- {$ELSE}
- function IsBitSet(const Value, BitIndex: LongWord): Boolean;
- begin
- Result := Value and BitMaskTable[BitIndex] <> 0;
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- function SetBitScanForward(const Value: LongWord): Integer;
- asm
- OR EAX, EAX
- JZ @NoBits
- BSF EAX, EAX
- RET
- @NoBits:
- MOV EAX, -1
- end;
- function SetBitScanForward(const Value, BitIndex: LongWord): Integer;
- asm
- CMP BitIndex, BitsPerLongWord
- JAE @NotFound
- MOV ECX, BitIndex
- MOV EDX, $FFFFFFFF
- SHL EDX, CL
- AND EDX, EAX
- JE @NotFound
- BSF EAX, EDX
- RET
- @NotFound:
- MOV EAX, -1
- end;
- {$ELSE}
- function SetBitScanForward(const Value, BitIndex: LongWord): Integer;
- var I : Integer;
- begin
- if BitIndex < BitsPerLongWord then
- for I := Integer(BitIndex) to 31 do
- if Value and BitMaskTable[I] <> 0 then
- begin
- Result := I;
- exit;
- end;
- Result := -1;
- end;
- function SetBitScanForward(const Value: LongWord): Integer;
- begin
- Result := SetBitScanForward(Value, 0);
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- function SetBitScanReverse(const Value: LongWord): Integer;
- asm
- OR EAX, EAX
- JZ @NoBits
- BSR EAX, EAX
- RET
- @NoBits:
- MOV EAX, -1
- end;
- function SetBitScanReverse(const Value, BitIndex: LongWord): Integer;
- asm
- CMP EDX, BitsPerLongWord
- JAE @NotFound
- LEA ECX, [EDX - 31]
- MOV EDX, $FFFFFFFF
- NEG ECX
- SHR EDX, CL
- AND EDX, EAX
- JE @NotFound
- BSR EAX, EDX
- RET
- @NotFound:
- MOV EAX, -1
- end;
- {$ELSE}
- function SetBitScanReverse(const Value, BitIndex: LongWord): Integer;
- var I : Integer;
- begin
- if BitIndex < BitsPerLongWord then
- for I := Integer(BitIndex) downto 0 do
- if Value and BitMaskTable[I] <> 0 then
- begin
- Result := I;
- exit;
- end;
- Result := -1;
- end;
- function SetBitScanReverse(const Value: LongWord): Integer;
- begin
- Result := SetBitScanReverse(Value, 31);
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- function ClearBitScanForward(const Value: LongWord): Integer;
- asm
- NOT EAX
- OR EAX, EAX
- JZ @NoBits
- BSF EAX, EAX
- RET
- @NoBits:
- MOV EAX, -1
- end;
- function ClearBitScanForward(const Value, BitIndex: LongWord): Integer;
- asm
- CMP EDX, BitsPerLongWord
- JAE @NotFound
- MOV ECX, EDX
- MOV EDX, $FFFFFFFF
- NOT EAX
- SHL EDX, CL
- AND EDX, EAX
- JE @NotFound
- BSF EAX, EDX
- RET
- @NotFound:
- MOV EAX, -1
- end;
- {$ELSE}
- function ClearBitScanForward(const Value, BitIndex: LongWord): Integer;
- var I : Integer;
- begin
- if BitIndex < BitsPerLongWord then
- for I := Integer(BitIndex) to 31 do
- if Value and BitMaskTable[I] = 0 then
- begin
- Result := I;
- exit;
- end;
- Result := -1;
- end;
- function ClearBitScanForward(const Value: LongWord): Integer;
- begin
- Result := ClearBitScanForward(Value, 0);
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- function ClearBitScanReverse(const Value: LongWord): Integer;
- asm
- NOT EAX
- OR EAX, EAX
- JZ @NoBits
- BSR EAX, EAX
- RET
- @NoBits:
- MOV EAX, -1
- end;
- function ClearBitScanReverse(const Value, BitIndex: LongWord): Integer;
- asm
- CMP EDX, BitsPerLongWord
- JAE @NotFound
- LEA ECX, [EDX - 31]
- MOV EDX, $FFFFFFFF
- NEG ECX
- NOT EAX
- SHR EDX, CL
- AND EDX, EAX
- JE @NotFound
- BSR EAX, EDX
- RET
- @NotFound:
- MOV EAX, -1
- end;
- {$ELSE}
- function ClearBitScanReverse(const Value, BitIndex: LongWord): Integer;
- var I : Integer;
- begin
- if BitIndex < BitsPerLongWord then
- for I := Integer(BitIndex) downto 0 do
- if Value and BitMaskTable[I] = 0 then
- begin
- Result := I;
- exit;
- end;
- Result := -1;
- end;
- function ClearBitScanReverse(const Value: LongWord): Integer;
- begin
- Result := ClearBitScanReverse(Value, 31);
- end;
- {$ENDIF}
- const
- BitCountTable : array[Byte] of Byte =
- (0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4,
- 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
- 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
- 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
- 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
- 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
- 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
- 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
- 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
- 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
- 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
- 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
- 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
- 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
- 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
- 4, 5, 5, 6, 5, 6, 6, 7, 5, 6, 6, 7, 6, 7, 7, 8);
- {$IFDEF ASM386_DELPHI}
- function BitCount(const Value: LongWord): LongWord; register; assembler;
- asm
- MOVZX EDX, AL
- MOVZX EDX, BYTE PTR [EDX + BitCountTable]
- MOVZX ECX, AH
- ADD DL, BYTE PTR [ECX + BitCountTable]
- SHR EAX, 16
- MOVZX ECX, AH
- ADD DL, BYTE PTR [ECX + BitCountTable]
- AND EAX, $FF
- ADD DL, BYTE PTR [EAX + BitCountTable]
- MOV AL, DL
- end;
- {$ELSE}
- function BitCount(const Value: LongWord): LongWord;
- begin
- Result := BitCountTable[(Value and $000000FF) ] +
- BitCountTable[(Value and $0000FF00) shr 8 ] +
- BitCountTable[(Value and $00FF0000) shr 16] +
- BitCountTable[(Value and $FF000000) shr 24];
- end;
- {$ENDIF}
- function IsPowerOfTwo(const Value: LongWord): Boolean;
- begin
- Result := BitCount(Value) = 1;
- end;
- function LowBitMask(const HighBitIndex: LongWord): LongWord;
- begin
- if HighBitIndex >= BitsPerLongWord then
- Result := 0
- else
- Result := BitMaskTable[HighBitIndex] - 1;
- end;
- function HighBitMask(const LowBitIndex: LongWord): LongWord;
- begin
- if LowBitIndex >= BitsPerLongWord then
- Result := 0
- else
- Result := not BitMaskTable[LowBitIndex] + 1;
- end;
- function RangeBitMask(const LowBitIndex, HighBitIndex: LongWord): LongWord;
- begin
- if (LowBitIndex >= BitsPerLongWord) and (HighBitIndex >= BitsPerLongWord) then
- begin
- Result := 0;
- exit;
- end;
- Result := $FFFFFFFF;
- if LowBitIndex > 0 then
- Result := Result xor (BitMaskTable[LowBitIndex] - 1);
- if HighBitIndex < 31 then
- Result := Result xor (not BitMaskTable[HighBitIndex + 1] + 1);
- end;
- function SetBitRange(const Value: LongWord; const LowBitIndex, HighBitIndex: LongWord): LongWord;
- begin
- Result := Value or RangeBitMask(LowBitIndex, HighBitIndex);
- end;
- function ClearBitRange(const Value: LongWord; const LowBitIndex, HighBitIndex: LongWord): LongWord;
- begin
- Result := Value and not RangeBitMask(LowBitIndex, HighBitIndex);
- end;
- function ToggleBitRange(const Value: LongWord; const LowBitIndex, HighBitIndex: LongWord): LongWord;
- begin
- Result := Value xor RangeBitMask(LowBitIndex, HighBitIndex);
- end;
- function IsBitRangeSet(const Value: LongWord; const LowBitIndex, HighBitIndex: LongWord): Boolean;
- var M: LongWord;
- begin
- M := RangeBitMask(LowBitIndex, HighBitIndex);
- Result := Value and M = M;
- end;
- function IsBitRangeClear(const Value: LongWord; const LowBitIndex, HighBitIndex: LongWord): Boolean;
- begin
- Result := Value and RangeBitMask(LowBitIndex, HighBitIndex) = 0;
- end;
- { }
- { Sets }
- { }
- function AsCharSet(const C: array of AnsiChar): CharSet;
- var I: Integer;
- begin
- Result := [];
- for I := 0 to High(C) do
- Include(Result, C[I]);
- end;
- function AsByteSet(const C: array of Byte): ByteSet;
- var I: Integer;
- begin
- Result := [];
- for I := 0 to High(C) do
- Include(Result, C[I]);
- end;
- {$IFDEF ASM386_DELPHI}
- procedure ComplementChar(var C: CharSet; const Ch: AnsiChar);
- asm
- MOVZX ECX, DL
- BTC [EAX], ECX
- end;
- {$ELSE}
- procedure ComplementChar(var C: CharSet; const Ch: AnsiChar);
- begin
- if Ch in C then
- Exclude(C, Ch)
- else
- Include(C, Ch);
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- procedure ClearCharSet(var C: CharSet);
- asm
- XOR EDX, EDX
- MOV [EAX], EDX
- MOV [EAX + 4], EDX
- MOV [EAX + 8], EDX
- MOV [EAX + 12], EDX
- MOV [EAX + 16], EDX
- MOV [EAX + 20], EDX
- MOV [EAX + 24], EDX
- MOV [EAX + 28], EDX
- end;
- {$ELSE}
- procedure ClearCharSet(var C: CharSet);
- begin
- C := [];
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- procedure FillCharSet(var C: CharSet);
- asm
- MOV EDX, $FFFFFFFF
- MOV [EAX], EDX
- MOV [EAX + 4], EDX
- MOV [EAX + 8], EDX
- MOV [EAX + 12], EDX
- MOV [EAX + 16], EDX
- MOV [EAX + 20], EDX
- MOV [EAX + 24], EDX
- MOV [EAX + 28], EDX
- end;
- {$ELSE}
- procedure FillCharSet(var C: CharSet);
- begin
- C := [#0..#255];
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- procedure ComplementCharSet(var C: CharSet);
- asm
- NOT DWORD PTR [EAX]
- NOT DWORD PTR [EAX + 4]
- NOT DWORD PTR [EAX + 8]
- NOT DWORD PTR [EAX + 12]
- NOT DWORD PTR [EAX + 16]
- NOT DWORD PTR [EAX + 20]
- NOT DWORD PTR [EAX + 24]
- NOT DWORD PTR [EAX + 28]
- end;
- {$ELSE}
- procedure ComplementCharSet(var C: CharSet);
- begin
- C := [#0..#255] - C;
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- procedure AssignCharSet(var DestSet: CharSet; const SourceSet: CharSet);
- asm
- MOV ECX, [EDX]
- MOV [EAX], ECX
- MOV ECX, [EDX + 4]
- MOV [EAX + 4], ECX
- MOV ECX, [EDX + 8]
- MOV [EAX + 8], ECX
- MOV ECX, [EDX + 12]
- MOV [EAX + 12], ECX
- MOV ECX, [EDX + 16]
- MOV [EAX + 16], ECX
- MOV ECX, [EDX + 20]
- MOV [EAX + 20], ECX
- MOV ECX, [EDX + 24]
- MOV [EAX + 24], ECX
- MOV ECX, [EDX + 28]
- MOV [EAX + 28], ECX
- end;
- {$ELSE}
- procedure AssignCharSet(var DestSet: CharSet; const SourceSet: CharSet);
- begin
- DestSet := SourceSet;
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- procedure Union(var DestSet: CharSet; const SourceSet: CharSet);
- asm
- MOV ECX, [EDX]
- OR [EAX], ECX
- MOV ECX, [EDX + 4]
- OR [EAX + 4], ECX
- MOV ECX, [EDX + 8]
- OR [EAX + 8], ECX
- MOV ECX, [EDX + 12]
- OR [EAX + 12], ECX
- MOV ECX, [EDX + 16]
- OR [EAX + 16], ECX
- MOV ECX, [EDX + 20]
- OR [EAX + 20], ECX
- MOV ECX, [EDX + 24]
- OR [EAX + 24], ECX
- MOV ECX, [EDX + 28]
- OR [EAX + 28], ECX
- end;
- {$ELSE}
- procedure Union(var DestSet: CharSet; const SourceSet: CharSet);
- begin
- DestSet := DestSet + SourceSet;
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- procedure Difference(var DestSet: CharSet; const SourceSet: CharSet);
- asm
- MOV ECX, [EDX]
- NOT ECX
- AND [EAX], ECX
- MOV ECX, [EDX + 4]
- NOT ECX
- AND [EAX + 4], ECX
- MOV ECX, [EDX + 8]
- NOT ECX
- AND [EAX + 8],ECX
- MOV ECX, [EDX + 12]
- NOT ECX
- AND [EAX + 12], ECX
- MOV ECX, [EDX + 16]
- NOT ECX
- AND [EAX + 16], ECX
- MOV ECX, [EDX + 20]
- NOT ECX
- AND [EAX + 20], ECX
- MOV ECX, [EDX + 24]
- NOT ECX
- AND [EAX + 24], ECX
- MOV ECX, [EDX + 28]
- NOT ECX
- AND [EAX + 28], ECX
- end;
- {$ELSE}
- procedure Difference(var DestSet: CharSet; const SourceSet: CharSet);
- begin
- DestSet := DestSet - SourceSet;
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- procedure Intersection(var DestSet: CharSet; const SourceSet: CharSet);
- asm
- MOV ECX, [EDX]
- AND [EAX], ECX
- MOV ECX, [EDX + 4]
- AND [EAX + 4], ECX
- MOV ECX, [EDX + 8]
- AND [EAX + 8], ECX
- MOV ECX, [EDX + 12]
- AND [EAX + 12], ECX
- MOV ECX, [EDX + 16]
- AND [EAX + 16], ECX
- MOV ECX, [EDX + 20]
- AND [EAX + 20], ECX
- MOV ECX, [EDX + 24]
- AND [EAX + 24], ECX
- MOV ECX, [EDX + 28]
- AND [EAX + 28], ECX
- end;
- {$ELSE}
- procedure Intersection(var DestSet: CharSet; const SourceSet: CharSet);
- begin
- DestSet := DestSet * SourceSet;
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- procedure XORCharSet(var DestSet: CharSet; const SourceSet: CharSet);
- asm
- MOV ECX, [EDX]
- XOR [EAX], ECX
- MOV ECX, [EDX + 4]
- XOR [EAX + 4], ECX
- MOV ECX, [EDX + 8]
- XOR [EAX + 8], ECX
- MOV ECX, [EDX + 12]
- XOR [EAX + 12], ECX
- MOV ECX, [EDX + 16]
- XOR [EAX + 16], ECX
- MOV ECX, [EDX + 20]
- XOR [EAX + 20], ECX
- MOV ECX, [EDX + 24]
- XOR [EAX + 24], ECX
- MOV ECX, [EDX + 28]
- XOR [EAX + 28], ECX
- end;
- {$ELSE}
- procedure XORCharSet(var DestSet: CharSet; const SourceSet: CharSet);
- var Ch: AnsiChar;
- begin
- for Ch := #0 to #255 do
- if Ch in DestSet then
- begin
- if Ch in SourceSet then
- Exclude(DestSet, Ch);
- end else
- if Ch in SourceSet then
- Include(DestSet, Ch);
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- function IsSubSet(const A, B: CharSet): Boolean;
- asm
- MOV ECX, [EDX]
- NOT ECX
- AND ECX, [EAX]
- JNE @Fin0
- MOV ECX, [EDX + 4]
- NOT ECX
- AND ECX, [EAX + 4]
- JNE @Fin0
- MOV ECX, [EDX + 8]
- NOT ECX
- AND ECX, [EAX + 8]
- JNE @Fin0
- MOV ECX, [EDX + 12]
- NOT ECX
- AND ECX, [EAX + 12]
- JNE @Fin0
- MOV ECX, [EDX + 16]
- NOT ECX
- AND ECX, [EAX + 16]
- JNE @Fin0
- MOV ECX, [EDX + 20]
- NOT ECX
- AND ECX, [EAX + 20]
- JNE @Fin0
- MOV ECX, [EDX + 24]
- NOT ECX
- AND ECX, [EAX + 24]
- JNE @Fin0
- MOV ECX, [EDX + 28]
- NOT ECX
- AND ECX, [EAX + 28]
- JNE @Fin0
- MOV EAX, 1
- RET
- @Fin0:
- XOR EAX, EAX
- end;
- {$ELSE}
- function IsSubSet(const A, B: CharSet): Boolean;
- begin
- Result := A <= B;
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- function IsEqual(const A, B: CharSet): Boolean;
- asm
- MOV ECX, [EDX]
- XOR ECX, [EAX]
- JNE @Fin0
- MOV ECX, [EDX + 4]
- XOR ECX, [EAX + 4]
- JNE @Fin0
- MOV ECX, [EDX + 8]
- XOR ECX, [EAX + 8]
- JNE @Fin0
- MOV ECX, [EDX + 12]
- XOR ECX, [EAX + 12]
- JNE @Fin0
- MOV ECX, [EDX + 16]
- XOR ECX, [EAX + 16]
- JNE @Fin0
- MOV ECX, [EDX + 20]
- XOR ECX, [EAX + 20]
- JNE @Fin0
- MOV ECX, [EDX + 24]
- XOR ECX, [EAX + 24]
- JNE @Fin0
- MOV ECX, [EDX + 28]
- XOR ECX, [EAX + 28]
- JNE @Fin0
- MOV EAX, 1
- RET
- @Fin0:
- XOR EAX, EAX
- end;
- {$ELSE}
- function IsEqual(const A, B: CharSet): Boolean;
- begin
- Result := A = B;
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- function IsEmpty(const C: CharSet): Boolean;
- asm
- MOV EDX, [EAX]
- OR EDX, [EAX + 4]
- OR EDX, [EAX + 8]
- OR EDX, [EAX + 12]
- OR EDX, [EAX + 16]
- OR EDX, [EAX + 20]
- OR EDX, [EAX + 24]
- OR EDX, [EAX + 28]
- JNE @Fin0
- MOV EAX, 1
- RET
- @Fin0:
- XOR EAX,EAX
- end;
- {$ELSE}
- function IsEmpty(const C: CharSet): Boolean;
- begin
- Result := C = [];
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- function IsComplete(const C: CharSet): Boolean;
- asm
- MOV EDX, [EAX]
- AND EDX, [EAX + 4]
- AND EDX, [EAX + 8]
- AND EDX, [EAX + 12]
- AND EDX, [EAX + 16]
- AND EDX, [EAX + 20]
- AND EDX, [EAX + 24]
- AND EDX, [EAX + 28]
- CMP EDX, $FFFFFFFF
- JNE @Fin0
- MOV EAX, 1
- RET
- @Fin0:
- XOR EAX, EAX
- end;
- {$ELSE}
- function IsComplete(const C: CharSet): Boolean;
- begin
- Result := C = CompleteCharSet;
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- function CharCount(const C: CharSet): Integer;
- asm
- PUSH EBX
- PUSH ESI
- MOV EBX, EAX
- XOR ESI, ESI
- MOV EAX, [EBX]
- CALL BitCount
- ADD ESI, EAX
- MOV EAX, [EBX + 4]
- CALL BitCount
- ADD ESI, EAX
- MOV EAX, [EBX + 8]
- CALL BitCount
- ADD ESI, EAX
- MOV EAX, [EBX + 12]
- CALL BitCount
- ADD ESI, EAX
- MOV EAX, [EBX + 16]
- CALL BitCount
- ADD ESI, EAX
- MOV EAX, [EBX + 20]
- CALL BitCount
- ADD ESI, EAX
- MOV EAX, [EBX + 24]
- CALL BitCount
- ADD ESI, EAX
- MOV EAX, [EBX + 28]
- CALL BitCount
- ADD EAX, ESI
- POP ESI
- POP EBX
- end;
- {$ELSE}
- function CharCount(const C: CharSet): Integer;
- var I : AnsiChar;
- begin
- Result := 0;
- for I := #0 to #255 do
- if I in C then
- Inc(Result);
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- procedure ConvertCaseInsensitive(var C: CharSet);
- asm
- MOV ECX, [EAX + 12]
- AND ECX, $3FFFFFF
- OR [EAX + 8], ECX
- MOV ECX, [EAX + 8]
- AND ECX, $3FFFFFF
- OR [EAX + 12], ECX
- end;
- {$ELSE}
- procedure ConvertCaseInsensitive(var C: CharSet);
- var Ch : AnsiChar;
- begin
- for Ch := 'A' to 'Z' do
- if Ch in C then
- Include(C, AnsiChar(Ord(Ch) + 32));
- for Ch := 'a' to 'z' do
- if Ch in C then
- Include(C, AnsiChar(Ord(Ch) - 32));
- end;
- {$ENDIF}
- function CaseInsensitiveCharSet(const C: CharSet): CharSet;
- begin
- AssignCharSet(Result, C);
- ConvertCaseInsensitive(Result);
- end;
- { }
- { Range functions }
- { }
- function IntRangeLength(const Low, High: Integer): Int64;
- begin
- if Low > High then
- Result := 0
- else
- Result := Int64(High - Low) + 1;
- end;
- function IntRangeAdjacent(const Low1, High1, Low2, High2: Integer): Boolean;
- begin
- Result := ((Low2 > MinInteger) and (High1 = Low2 - 1)) or
- ((High2 < MaxInteger) and (Low1 = High2 + 1));
- end;
- function IntRangeOverlap(const Low1, High1, Low2, High2: Integer): Boolean;
- begin
- Result := ((Low1 >= Low2) and (Low1 <= High2)) or
- ((Low2 >= Low1) and (Low2 <= High1));
- end;
- function IntRangeHasElement(const Low, High, Element: Integer): Boolean;
- begin
- Result := (Element >= Low) and (Element <= High);
- end;
- function IntRangeIncludeElement(var Low, High: Integer;
- const Element: Integer): Boolean;
- begin
- Result := (Element >= Low) and (Element <= High);
- if Result then
- exit;
- if (Element < Low) and (Element + 1 = Low) then
- begin
- Low := Element;
- Result := True;
- end else
- if (Element > High) and (Element - 1 = High) then
- begin
- High := Element;
- Result := True;
- end;
- end;
- function IntRangeIncludeElementRange(var Low, High: Integer;
- const LowElement, HighElement: Integer): Boolean;
- begin
- Result := (LowElement >= Low) and (HighElement <= High);
- if Result then
- exit;
- if ((Low >= LowElement) and (Low <= HighElement)) or
- ((Low > MinInteger) and (Low - 1 = HighElement)) then
- begin
- Low := LowElement;
- Result := True;
- end;
- if ((High >= LowElement) and (High <= HighElement)) or
- ((High < MaxInteger) and (High + 1 = LowElement)) then
- begin
- High := HighElement;
- Result := True;
- end;
- end;
- function CardRangeLength(const Low, High: Cardinal): Int64;
- begin
- if Low > High then
- Result := 0
- else
- Result := Int64(High - Low) + 1;
- end;
- function CardRangeAdjacent(const Low1, High1, Low2, High2: Cardinal): Boolean;
- begin
- Result := ((Low2 > MinCardinal) and (High1 = Low2 - 1)) or
- ((High2 < MaxCardinal) and (Low1 = High2 + 1));
- end;
- function CardRangeOverlap(const Low1, High1, Low2, High2: Cardinal): Boolean;
- begin
- Result := ((Low1 >= Low2) and (Low1 <= High2)) or
- ((Low2 >= Low1) and (Low2 <= High1));
- end;
- function CardRangeHasElement(const Low, High, Element: Cardinal): Boolean;
- begin
- Result := (Element >= Low) and (Element <= High);
- end;
- function CardRangeIncludeElement(var Low, High: Cardinal;
- const Element: Cardinal): Boolean;
- begin
- Result := (Element >= Low) and (Element <= High);
- if Result then
- exit;
- if (Element < Low) and (Element + 1 = Low) then
- begin
- Low := Element;
- Result := True;
- end else
- if (Element > High) and (Element - 1 = High) then
- begin
- High := Element;
- Result := True;
- end;
- end;
- function CardRangeIncludeElementRange(var Low, High: Cardinal;
- const LowElement, HighElement: Cardinal): Boolean;
- begin
- Result := (LowElement >= Low) and (HighElement <= High);
- if Result then
- exit;
- if ((Low >= LowElement) and (Low <= HighElement)) or
- ((Low > MinCardinal) and (Low - 1 = HighElement)) then
- begin
- Low := LowElement;
- Result := True;
- end;
- if ((High >= LowElement) and (High <= HighElement)) or
- ((High < MaxCardinal) and (High + 1 = LowElement)) then
- begin
- High := HighElement;
- Result := True;
- end;
- end;
- { }
- { Swap }
- { }
- {$IFDEF ASM386_DELPHI}
- procedure Swap(var X, Y: Boolean); register; assembler;
- asm
- MOV CL, [EDX]
- XCHG BYTE PTR [EAX], CL
- MOV [EDX], CL
- end;
- {$ELSE}
- procedure Swap(var X, Y: Boolean);
- var F : Boolean;
- begin
- F := X;
- X := Y;
- Y := F;
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- procedure Swap(var X, Y: Byte); register; assembler;
- asm
- MOV CL, [EDX]
- XCHG BYTE PTR [EAX], CL
- MOV [EDX], CL
- end;
- {$ELSE}
- procedure Swap(var X, Y: Byte);
- var F : Byte;
- begin
- F := X;
- X := Y;
- Y := F;
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- procedure Swap(var X, Y: ShortInt); register; assembler;
- asm
- MOV CL, [EDX]
- XCHG BYTE PTR [EAX], CL
- MOV [EDX], CL
- end;
- {$ELSE}
- procedure Swap(var X, Y: ShortInt);
- var F : ShortInt;
- begin
- F := X;
- X := Y;
- Y := F;
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- procedure Swap(var X, Y: Word); register; assembler;
- asm
- MOV CX, [EDX]
- XCHG WORD PTR [EAX], CX
- MOV [EDX], CX
- end;
- {$ELSE}
- procedure Swap(var X, Y: Word);
- var F : Word;
- begin
- F := X;
- X := Y;
- Y := F;
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- procedure Swap(var X, Y: SmallInt); register; assembler;
- asm
- MOV CX, [EDX]
- XCHG WORD PTR [EAX], CX
- MOV [EDX], CX
- end;
- {$ELSE}
- procedure Swap(var X, Y: SmallInt);
- var F : SmallInt;
- begin
- F := X;
- X := Y;
- Y := F;
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- procedure Swap(var X, Y: LongInt); register; assembler;
- asm
- MOV ECX, [EDX]
- XCHG [EAX], ECX
- MOV [EDX], ECX
- end;
- {$ELSE}
- procedure Swap(var X, Y: LongInt);
- var F : LongInt;
- begin
- F := X;
- X := Y;
- Y := F;
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- procedure Swap(var X, Y: LongWord); register; assembler;
- asm
- MOV ECX, [EDX]
- XCHG [EAX], ECX
- MOV [EDX], ECX
- end;
- {$ELSE}
- procedure Swap(var X, Y: LongWord);
- var F : LongWord;
- begin
- F := X;
- X := Y;
- Y := F;
- end;
- {$ENDIF}
- procedure Swap(var X, Y: NativeUInt);
- var F : NativeUInt;
- begin
- F := X;
- X := Y;
- Y := F;
- end;
- procedure Swap(var X, Y: NativeInt);
- var F : NativeInt;
- begin
- F := X;
- X := Y;
- Y := F;
- end;
- {$IFNDEF ManagedCode}
- {$IFDEF ASM386_DELPHI}
- procedure Swap(var X, Y: Pointer); register; assembler;
- asm
- MOV ECX, [EDX]
- XCHG [EAX], ECX
- MOV [EDX], ECX
- end;
- {$ELSE}
- procedure Swap(var X, Y: Pointer);
- var F : Pointer;
- begin
- F := X;
- X := Y;
- Y := F;
- end;
- {$ENDIF}
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- procedure Swap(var X, Y: TObject); register; assembler;
- asm
- MOV ECX, [EDX]
- XCHG [EAX], ECX
- MOV [EDX], ECX
- end;
- {$ELSE}
- procedure Swap(var X, Y: TObject);
- var F : TObject;
- begin
- F := X;
- X := Y;
- Y := F;
- end;
- {$ENDIF}
- procedure Swap(var X, Y: Int64);
- var F : Int64;
- begin
- F := X;
- X := Y;
- Y := F;
- end;
- procedure Swap(var X, Y: Single);
- var F : Single;
- begin
- F := X;
- X := Y;
- Y := F;
- end;
- procedure Swap(var X, Y: Double);
- var F : Double;
- begin
- F := X;
- X := Y;
- Y := F;
- end;
- procedure Swap(var X, Y: Extended);
- var F : Extended;
- begin
- F := X;
- X := Y;
- Y := F;
- end;
- procedure Swap(var X, Y: Currency);
- var F : Currency;
- begin
- F := X;
- X := Y;
- Y := F;
- end;
- procedure SwapA(var X, Y: AnsiString);
- var F : AnsiString;
- begin
- F := X;
- X := Y;
- Y := F;
- end;
- procedure SwapW(var X, Y: WideString);
- var F : WideString;
- begin
- F := X;
- X := Y;
- Y := F;
- end;
- procedure SwapU(var X, Y: UnicodeString);
- var F : UnicodeString;
- begin
- F := X;
- X := Y;
- Y := F;
- end;
- procedure Swap(var X, Y: String);
- var F : String;
- begin
- F := X;
- X := Y;
- Y := F;
- end;
- {$IFDEF ManagedCode}
- procedure SwapObjects(var X, Y: TObject);
- var F: TObject;
- begin
- F := X;
- X := Y;
- Y := F;
- end;
- {$ELSE}
- {$IFDEF ASM386_DELPHI}
- procedure SwapObjects(var X, Y); register; assembler;
- asm
- MOV ECX, [EDX]
- XCHG [EAX], ECX
- MOV [EDX], ECX
- end;
- {$ELSE}
- procedure SwapObjects(var X, Y);
- var F: TObject;
- begin
- F := TObject(X);
- TObject(X) := TObject(Y);
- TObject(Y) := F;
- end;
- {$ENDIF}{$ENDIF}
- { }
- { iif }
- { }
- function iif(const Expr: Boolean; const TrueValue, FalseValue: Integer): Integer;
- begin
- if Expr then
- Result := TrueValue
- else
- Result := FalseValue;
- end;
- function iif(const Expr: Boolean; const TrueValue, FalseValue: Int64): Int64;
- begin
- if Expr then
- Result := TrueValue
- else
- Result := FalseValue;
- end;
- function iif(const Expr: Boolean; const TrueValue, FalseValue: Extended): Extended;
- begin
- if Expr then
- Result := TrueValue
- else
- Result := FalseValue;
- end;
- function iif(const Expr: Boolean; const TrueValue, FalseValue: String): String;
- begin
- if Expr then
- Result := TrueValue
- else
- Result := FalseValue;
- end;
- function iifA(const Expr: Boolean; const TrueValue, FalseValue: AnsiString): AnsiString;
- begin
- if Expr then
- Result := TrueValue
- else
- Result := FalseValue;
- end;
- function iifW(const Expr: Boolean; const TrueValue, FalseValue: WideString): WideString;
- begin
- if Expr then
- Result := TrueValue
- else
- Result := FalseValue;
- end;
- function iifU(const Expr: Boolean; const TrueValue, FalseValue: UnicodeString): UnicodeString;
- begin
- if Expr then
- Result := TrueValue
- else
- Result := FalseValue;
- end;
- function iif(const Expr: Boolean; const TrueValue, FalseValue: TObject): TObject;
- begin
- if Expr then
- Result := TrueValue
- else
- Result := FalseValue;
- end;
- { }
- { Compare }
- { }
- function ReverseCompareResult(const C: TCompareResult): TCompareResult;
- begin
- if C = crLess then
- Result := crGreater else
- if C = crGreater then
- Result := crLess
- else
- Result := C;
- end;
- function Compare(const I1, I2: Integer): TCompareResult;
- begin
- if I1 < I2 then
- Result := crLess else
- if I1 > I2 then
- Result := crGreater
- else
- Result := crEqual;
- end;
- function Compare(const I1, I2: Int64): TCompareResult;
- begin
- if I1 < I2 then
- Result := crLess else
- if I1 > I2 then
- Result := crGreater
- else
- Result := crEqual;
- end;
- function Compare(const I1, I2: Extended): TCompareResult;
- begin
- if I1 < I2 then
- Result := crLess else
- if I1 > I2 then
- Result := crGreater
- else
- Result := crEqual;
- end;
- function Compare(const I1, I2: Boolean): TCompareResult;
- begin
- if I1 = I2 then
- Result := crEqual else
- if I1 then
- Result := crGreater
- else
- Result := crLess;
- end;
- function CompareA(const I1, I2: AnsiString): TCompareResult;
- begin
- if I1 = I2 then
- Result := crEqual else
- if I1 > I2 then
- Result := crGreater
- else
- Result := crLess;
- end;
- function CompareW(const I1, I2: WideString): TCompareResult;
- begin
- if I1 = I2 then
- Result := crEqual else
- if I1 > I2 then
- Result := crGreater
- else
- Result := crLess;
- end;
- function CompareU(const I1, I2: UnicodeString): TCompareResult;
- begin
- if I1 = I2 then
- Result := crEqual else
- if I1 > I2 then
- Result := crGreater
- else
- Result := crLess;
- end;
- function Sgn(const A: LongInt): Integer;
- begin
- if A < 0 then
- Result := -1 else
- if A > 0 then
- Result := 1
- else
- Result := 0;
- end;
- function Sgn(const A: Int64): Integer;
- begin
- if A < 0 then
- Result := -1 else
- if A > 0 then
- Result := 1
- else
- Result := 0;
- end;
- function Sgn(const A: Extended): Integer;
- begin
- if A < 0 then
- Result := -1 else
- if A > 0 then
- Result := 1
- else
- Result := 0;
- end;
- { }
- { Ascii char conversion lookup }
- { }
- const
- HexLookup: array[AnsiChar] of Byte = (
- $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
- $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
- $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
- 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, $FF, $FF, $FF, $FF, $FF, $FF,
- $FF, 10, 11, 12, 13, 14, 15, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
- $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
- $FF, 10, 11, 12, 13, 14, 15, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
- $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
- $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
- $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
- $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
- $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
- $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
- $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
- $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
- $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF);
- { }
- { Integer-String conversions }
- { }
- function AnsiCharToInt(const A: AnsiChar): Integer;
- begin
- if A in ['0'..'9'] then
- Result := Ord(A) - Ord('0')
- else
- Result := -1;
- end;
- function WideCharToInt(const A: WideChar): Integer;
- begin
- if (Ord(A) >= Ord('0')) and (Ord(A) <= Ord('9')) then
- Result := Ord(A) - Ord('0')
- else
- Result := -1;
- end;
- function CharToInt(const A: Char): Integer;
- begin
- {$IFDEF CharIsWide}
- Result := WideCharToInt(A);
- {$ELSE}
- Result := AnsiCharToInt(A);
- {$ENDIF}
- end;
- function IntToAnsiChar(const A: Integer): AnsiChar;
- begin
- if (A < 0) or (A > 9) then
- Result := #$00
- else
- Result := AnsiChar(48 + A);
- end;
- function IntToWideChar(const A: Integer): WideChar;
- begin
- if (A < 0) or (A > 9) then
- Result := #$00
- else
- Result := WideChar(48 + A);
- end;
- function IntToChar(const A: Integer): Char;
- begin
- {$IFDEF CharIsWide}
- Result := IntToWideChar(A);
- {$ELSE}
- Result := IntToAnsiChar(A);
- {$ENDIF}
- end;
- function IsHexAnsiChar(const Ch: AnsiChar): Boolean;
- begin
- Result := HexLookup[Ch] <= 15;
- end;
- function IsHexWideChar(const Ch: WideChar): Boolean;
- begin
- if Ord(Ch) <= $FF then
- Result := HexLookup[AnsiChar(Ch)] <= 15
- else
- Result := False;
- end;
- function IsHexChar(const Ch: Char): Boolean;
- begin
- {$IFDEF CharIsWide}
- Result := IsHexWideChar(Ch);
- {$ELSE}
- Result := IsHexAnsiChar(Ch);
- {$ENDIF}
- end;
- function HexAnsiCharToInt(const A: AnsiChar): Integer;
- var B : Byte;
- begin
- B := HexLookup[A];
- if B = $FF then
- Result := -1
- else
- Result := B;
- end;
- function HexWideCharToInt(const A: WideChar): Integer;
- var B : Byte;
- begin
- if Ord(A) > $FF then
- Result := -1
- else
- begin
- B := HexLookup[AnsiChar(Ord(A))];
- if B = $FF then
- Result := -1
- else
- Result := B;
- end;
- end;
- function HexCharToInt(const A: Char): Integer;
- begin
- {$IFDEF CharIsWide}
- Result := HexWideCharToInt(A);
- {$ELSE}
- Result := HexAnsiCharToInt(A);
- {$ENDIF}
- end;
- function IntToUpperHexAnsiChar(const A: Integer): AnsiChar;
- begin
- if (A < 0) or (A > 15) then
- Result := #$00
- else
- if A <= 9 then
- Result := AnsiChar(48 + A)
- else
- Result := AnsiChar(55 + A);
- end;
- function IntToUpperHexWideChar(const A: Integer): WideChar;
- begin
- if (A < 0) or (A > 15) then
- Result := #$00
- else
- if A <= 9 then
- Result := WideChar(48 + A)
- else
- Result := WideChar(55 + A);
- end;
- function IntToUpperHexChar(const A: Integer): Char;
- begin
- {$IFDEF CharIsWide}
- Result := IntToUpperHexWideChar(A);
- {$ELSE}
- Result := IntToUpperHexAnsiChar(A);
- {$ENDIF}
- end;
- function IntToLowerHexAnsiChar(const A: Integer): AnsiChar;
- begin
- if (A < 0) or (A > 15) then
- Result := #$00
- else
- if A <= 9 then
- Result := AnsiChar(48 + A)
- else
- Result := AnsiChar(87 + A);
- end;
- function IntToLowerHexWideChar(const A: Integer): WideChar;
- begin
- if (A < 0) or (A > 15) then
- Result := #$00
- else
- if A <= 9 then
- Result := WideChar(48 + A)
- else
- Result := WideChar(87 + A);
- end;
- function IntToLowerHexChar(const A: Integer): Char;
- begin
- {$IFDEF CharIsWide}
- Result := IntToLowerHexWideChar(A);
- {$ELSE}
- Result := IntToLowerHexAnsiChar(A);
- {$ENDIF}
- end;
- function IntToStringA(const A: Int64): AnsiString;
- var L, T, I : Integer;
- begin
- if A = 0 then
- begin
- Result := '0';
- exit;
- end;
- // calculate string length
- if A < 0 then
- L := 1
- else
- L := 0;
- T := A;
- while T <> 0 do
- begin
- T := T div 10;
- Inc(L);
- end;
- // convert
- SetLength(Result, L);
- I := 0;
- T := A;
- if T < 0 then
- begin
- Result[1] := '-';
- T := -T;
- end;
- while T > 0 do
- begin
- Result[L - I] := IntToAnsiChar(T mod 10);
- T := T div 10;
- Inc(I);
- end;
- end;
- function IntToStringW(const A: Int64): WideString;
- var L, T, I : Integer;
- begin
- if A = 0 then
- begin
- Result := '0';
- exit;
- end;
- // calculate string length
- if A < 0 then
- L := 1
- else
- L := 0;
- T := A;
- while T <> 0 do
- begin
- T := T div 10;
- Inc(L);
- end;
- // convert
- SetLength(Result, L);
- I := 0;
- T := A;
- if T < 0 then
- begin
- Result[1] := '-';
- T := -T;
- end;
- while T > 0 do
- begin
- Result[L - I] := IntToWideChar(T mod 10);
- T := T div 10;
- Inc(I);
- end;
- end;
- function IntToStringU(const A: Int64): UnicodeString;
- var L, T, I : Integer;
- begin
- if A = 0 then
- begin
- Result := '0';
- exit;
- end;
- // calculate string length
- if A < 0 then
- L := 1
- else
- L := 0;
- T := A;
- while T <> 0 do
- begin
- T := T div 10;
- Inc(L);
- end;
- // convert
- SetLength(Result, L);
- I := 0;
- T := A;
- if T < 0 then
- begin
- Result[1] := '-';
- T := -T;
- end;
- while T > 0 do
- begin
- Result[L - I] := IntToWideChar(T mod 10);
- T := T div 10;
- Inc(I);
- end;
- end;
- function IntToString(const A: Int64): String;
- var L, T, I : Integer;
- begin
- if A = 0 then
- begin
- Result := '0';
- exit;
- end;
- // calculate string length
- if A < 0 then
- L := 1
- else
- L := 0;
- T := A;
- while T <> 0 do
- begin
- T := T div 10;
- Inc(L);
- end;
- // convert
- SetLength(Result, L);
- I := 0;
- T := A;
- if T < 0 then
- begin
- Result[1] := '-';
- T := -T;
- end;
- while T > 0 do
- begin
- Result[L - I] := IntToChar(T mod 10);
- T := T div 10;
- Inc(I);
- end;
- end;
- function NativeUIntToBaseA(
- const Value: NativeUInt;
- const Digits: Integer;
- const Base: Byte;
- const UpperCase: Boolean = True): AnsiString;
- var D : NativeUInt;
- L : Integer;
- V : Byte;
- begin
- Assert((Base >= 2) and (Base <= 16));
- if Value = 0 then // handle zero value
- begin
- if Digits = 0 then
- L := 1
- else
- L := Digits;
- SetLength(Result, L);
- for V := 1 to L do
- Result[V] := '0';
- exit;
- end;
- // determine number of digits in result
- L := 0;
- D := Value;
- while D > 0 do
- begin
- Inc(L);
- D := D div Base;
- end;
- if L < Digits then
- L := Digits;
- // do conversion
- SetLength(Result, L);
- D := Value;
- while D > 0 do
- begin
- V := D mod Base + 1;
- if UpperCase then
- Result[L] := AnsiChar(StrHexDigitsUpper[V])
- else
- Result[L] := AnsiChar(StrHexDigitsLower[V]);
- Dec(L);
- D := D div Base;
- end;
- while L > 0 do
- begin
- Result[L] := '0';
- Dec(L);
- end;
- end;
- function NativeUIntToBaseW(
- const Value: NativeUInt;
- const Digits: Integer;
- const Base: Byte;
- const UpperCase: Boolean = True): WideString;
- var D : NativeUInt;
- L : Integer;
- V : Byte;
- begin
- Assert((Base >= 2) and (Base <= 16));
- if Value = 0 then // handle zero value
- begin
- if Digits = 0 then
- L := 1
- else
- L := Digits;
- SetLength(Result, L);
- for V := 1 to L do
- Result[V] := '0';
- exit;
- end;
- // determine number of digits in result
- L := 0;
- D := Value;
- while D > 0 do
- begin
- Inc(L);
- D := D div Base;
- end;
- if L < Digits then
- L := Digits;
- // do conversion
- SetLength(Result, L);
- D := Value;
- while D > 0 do
- begin
- V := D mod Base + 1;
- if UpperCase then
- Result[L] := WideChar(StrHexDigitsUpper[V])
- else
- Result[L] := WideChar(StrHexDigitsLower[V]);
- Dec(L);
- D := D div Base;
- end;
- while L > 0 do
- begin
- Result[L] := '0';
- Dec(L);
- end;
- end;
- function NativeUIntToBaseU(
- const Value: NativeUInt;
- const Digits: Integer;
- const Base: Byte;
- const UpperCase: Boolean = True): UnicodeString;
- var D : NativeUInt;
- L : Integer;
- V : Byte;
- begin
- Assert((Base >= 2) and (Base <= 16));
- if Value = 0 then // handle zero value
- begin
- if Digits = 0 then
- L := 1
- else
- L := Digits;
- SetLength(Result, L);
- for V := 1 to L do
- Result[V] := '0';
- exit;
- end;
- // determine number of digits in result
- L := 0;
- D := Value;
- while D > 0 do
- begin
- Inc(L);
- D := D div Base;
- end;
- if L < Digits then
- L := Digits;
- // do conversion
- SetLength(Result, L);
- D := Value;
- while D > 0 do
- begin
- V := D mod Base + 1;
- if UpperCase then
- Result[L] := WideChar(StrHexDigitsUpper[V])
- else
- Result[L] := WideChar(StrHexDigitsLower[V]);
- Dec(L);
- D := D div Base;
- end;
- while L > 0 do
- begin
- Result[L] := '0';
- Dec(L);
- end;
- end;
- function NativeUIntToBase(
- const Value: NativeUInt;
- const Digits: Integer;
- const Base: Byte;
- const UpperCase: Boolean = True): String;
- var D : NativeUInt;
- L : Integer;
- V : Byte;
- begin
- Assert((Base >= 2) and (Base <= 16));
- if Value = 0 then // handle zero value
- begin
- if Digits = 0 then
- L := 1
- else
- L := Digits;
- SetLength(Result, L);
- for V := 1 to L do
- Result[V] := '0';
- exit;
- end;
- // determine number of digits in result
- L := 0;
- D := Value;
- while D > 0 do
- begin
- Inc(L);
- D := D div Base;
- end;
- if L < Digits then
- L := Digits;
- // do conversion
- SetLength(Result, L);
- D := Value;
- while D > 0 do
- begin
- V := D mod Base + 1;
- if UpperCase then
- Result[L] := Char(StrHexDigitsUpper[V])
- else
- Result[L] := Char(StrHexDigitsLower[V]);
- Dec(L);
- D := D div Base;
- end;
- while L > 0 do
- begin
- Result[L] := '0';
- Dec(L);
- end;
- end;
- function UIntToStringA(const A: NativeUInt): AnsiString;
- begin
- Result := NativeUIntToBaseA(A, 0, 10);
- end;
- function UIntToStringW(const A: NativeUInt): WideString;
- begin
- Result := NativeUIntToBaseW(A, 0, 10);
- end;
- function UIntToStringU(const A: NativeUInt): UnicodeString;
- begin
- Result := NativeUIntToBaseU(A, 0, 10);
- end;
- function UIntToString(const A: NativeUInt): String;
- begin
- Result := NativeUIntToBase(A, 0, 10);
- end;
- function LongWordToStrA(const A: LongWord; const Digits: Integer): AnsiString;
- begin
- Result := NativeUIntToBaseA(A, Digits, 10);
- end;
- function LongWordToStrW(const A: LongWord; const Digits: Integer): WideString;
- begin
- Result := NativeUIntToBaseW(A, Digits, 10);
- end;
- function LongWordToStrU(const A: LongWord; const Digits: Integer): UnicodeString;
- begin
- Result := NativeUIntToBaseU(A, Digits, 10);
- end;
- function LongWordToStr(const A: LongWord; const Digits: Integer): String;
- begin
- Result := NativeUIntToBase(A, Digits, 10);
- end;
- function LongWordToHexA(const A: LongWord; const Digits: Integer; const UpperCase: Boolean): AnsiString;
- begin
- Result := NativeUIntToBaseA(A, Digits, 16, UpperCase);
- end;
- function LongWordToHexW(const A: LongWord; const Digits: Integer; const UpperCase: Boolean): WideString;
- begin
- Result := NativeUIntToBaseW(A, Digits, 16, UpperCase);
- end;
- function LongWordToHexU(const A: LongWord; const Digits: Integer; const UpperCase: Boolean): UnicodeString;
- begin
- Result := NativeUIntToBaseU(A, Digits, 16, UpperCase);
- end;
- function LongWordToHex(const A: LongWord; const Digits: Integer; const UpperCase: Boolean): String;
- begin
- Result := NativeUIntToBase(A, Digits, 16, UpperCase);
- end;
- function LongWordToOctA(const A: LongWord; const Digits: Integer): AnsiString;
- begin
- Result := NativeUIntToBaseA(A, Digits, 8);
- end;
- function LongWordToOctW(const A: LongWord; const Digits: Integer): WideString;
- begin
- Result := NativeUIntToBaseW(A, Digits, 8);
- end;
- function LongWordToOctU(const A: LongWord; const Digits: Integer): UnicodeString;
- begin
- Result := NativeUIntToBaseU(A, Digits, 8);
- end;
- function LongWordToOct(const A: LongWord; const Digits: Integer): String;
- begin
- Result := NativeUIntToBase(A, Digits, 8);
- end;
- function LongWordToBinA(const A: LongWord; const Digits: Integer): AnsiString;
- begin
- Result := NativeUIntToBaseA(A, Digits, 2);
- end;
- function LongWordToBinW(const A: LongWord; const Digits: Integer): WideString;
- begin
- Result := NativeUIntToBaseW(A, Digits, 2);
- end;
- function LongWordToBinU(const A: LongWord; const Digits: Integer): UnicodeString;
- begin
- Result := NativeUIntToBaseU(A, Digits, 2);
- end;
- function LongWordToBin(const A: LongWord; const Digits: Integer): String;
- begin
- Result := NativeUIntToBase(A, Digits, 2);
- end;
- function TryStringToInt64PA(const BufP: Pointer; const BufLen: Integer; out Value: Int64; out StrLen: Integer): TConvertResult;
- var Len : Integer;
- DigVal : Integer;
- P : PAnsiChar;
- Ch : AnsiChar;
- HasDig : Boolean;
- Neg : Boolean;
- Res : Int64;
- begin
- if BufLen <= 0 then
- begin
- Value := 0;
- StrLen := 0;
- Result := convertFormatError;
- exit;
- end;
- P := BufP;
- Len := 0;
- // check sign
- Ch := P^;
- if Ch in ['+', '-'] then
- begin
- Inc(Len);
- Inc(P);
- Neg := Ch = '-';
- end
- else
- Neg := False;
- // skip leading zeros
- HasDig := False;
- while (Len < BufLen) and (P^ = '0') do
- begin
- Inc(Len);
- Inc(P);
- HasDig := True;
- end;
- // convert digits
- Res := 0;
- while Len < BufLen do
- begin
- Ch := P^;
- if Ch in ['0'..'9'] then
- begin
- HasDig := True;
- if (Res > 922337203685477580) or
- (Res < -922337203685477580) then
- begin
- Value := 0;
- StrLen := Len;
- Result := convertOverflow;
- exit;
- end;
- {$IFOPT Q+}{$DEFINE QOn}{$Q-}{$ELSE}{$UNDEF QOn}{$ENDIF} // overflowing for -922337203685477580 * 10 ?
- Res := Res * 10;
- {$IFDEF QOn}{$Q+}{$ENDIF}
- DigVal := AnsiCharToInt(Ch);
- if ((Res = 9223372036854775800) and (DigVal > 7)) or
- ((Res = -9223372036854775800) and (DigVal > 8)) then
- begin
- Value := 0;
- StrLen := Len;
- Result := convertOverflow;
- exit;
- end;
- if Neg then
- Dec(Res, DigVal)
- else
- Inc(Res, DigVal);
- Inc(Len);
- Inc(P);
- end
- else
- break;
- end;
- StrLen := Len;
- if not HasDig then
- begin
- Value := 0;
- Result := convertFormatError;
- end
- else
- begin
- Value := Res;
- Result := convertOK;
- end;
- end;
- function TryStringToInt64PW(const BufP: Pointer; const BufLen: Integer; out Value: Int64; out StrLen: Integer): TConvertResult;
- var Len : Integer;
- DigVal : Integer;
- P : PWideChar;
- Ch : WideChar;
- HasDig : Boolean;
- Neg : Boolean;
- Res : Int64;
- begin
- if BufLen <= 0 then
- begin
- Value := 0;
- StrLen := 0;
- Result := convertFormatError;
- exit;
- end;
- P := BufP;
- Len := 0;
- // check sign
- Ch := P^;
- if (Ch = '+') or (Ch = '-') then
- begin
- Inc(Len);
- Inc(P);
- Neg := Ch = '-';
- end
- else
- Neg := False;
- // skip leading zeros
- HasDig := False;
- while (Len < BufLen) and (P^ = '0') do
- begin
- Inc(Len);
- Inc(P);
- HasDig := True;
- end;
- // convert digits
- Res := 0;
- while Len < BufLen do
- begin
- Ch := P^;
- if (Ch >= '0') and (Ch <= '9') then
- begin
- HasDig := True;
- if (Res > 922337203685477580) or
- (Res < -922337203685477580) then
- begin
- Value := 0;
- StrLen := Len;
- Result := convertOverflow;
- exit;
- end;
- {$IFOPT Q+}{$DEFINE QOn}{$Q-}{$ELSE}{$UNDEF QOn}{$ENDIF} // overflowing for -922337203685477580 * 10 ?
- Res := Res * 10;
- {$IFDEF QOn}{$Q+}{$ENDIF}
- DigVal := WideCharToInt(Ch);
- if ((Res = 9223372036854775800) and (DigVal > 7)) or
- ((Res = -9223372036854775800) and (DigVal > 8)) then
- begin
- Value := 0;
- StrLen := Len;
- Result := convertOverflow;
- exit;
- end;
- if Neg then
- Dec(Res, DigVal)
- else
- Inc(Res, DigVal);
- Inc(Len);
- Inc(P);
- end
- else
- break;
- end;
- StrLen := Len;
- if not HasDig then
- begin
- Value := 0;
- Result := convertFormatError;
- end
- else
- begin
- Value := Res;
- Result := convertOK;
- end;
- end;
- function TryStringToInt64P(const BufP: Pointer; const BufLen: Integer; out Value: Int64; out StrLen: Integer): TConvertResult;
- var Len : Integer;
- DigVal : Integer;
- P : PChar;
- Ch : Char;
- HasDig : Boolean;
- Neg : Boolean;
- Res : Int64;
- begin
- if BufLen <= 0 then
- begin
- Value := 0;
- StrLen := 0;
- Result := convertFormatError;
- exit;
- end;
- P := BufP;
- Len := 0;
- // check sign
- Ch := P^;
- if (Ch = '+') or (Ch = '-') then
- begin
- Inc(Len);
- Inc(P);
- Neg := Ch = '-';
- end
- else
- Neg := False;
- // skip leading zeros
- HasDig := False;
- while (Len < BufLen) and (P^ = '0') do
- begin
- Inc(Len);
- Inc(P);
- HasDig := True;
- end;
- // convert digits
- Res := 0;
- while Len < BufLen do
- begin
- Ch := P^;
- if (Ch >= '0') and (Ch <= '9') then
- begin
- HasDig := True;
- if (Res > 922337203685477580) or
- (Res < -922337203685477580) then
- begin
- Value := 0;
- StrLen := Len;
- Result := convertOverflow;
- exit;
- end;
- {$IFOPT Q+}{$DEFINE QOn}{$Q-}{$ELSE}{$UNDEF QOn}{$ENDIF} // overflowing for -922337203685477580 * 10 ?
- Res := Res * 10;
- {$IFDEF QOn}{$Q+}{$ENDIF}
- DigVal := CharToInt(Ch);
- if ((Res = 9223372036854775800) and (DigVal > 7)) or
- ((Res = -9223372036854775800) and (DigVal > 8)) then
- begin
- Value := 0;
- StrLen := Len;
- Result := convertOverflow;
- exit;
- end;
- if Neg then
- Dec(Res, DigVal)
- else
- Inc(Res, DigVal);
- Inc(Len);
- Inc(P);
- end
- else
- break;
- end;
- StrLen := Len;
- if not HasDig then
- begin
- Value := 0;
- Result := convertFormatError;
- end
- else
- begin
- Value := Res;
- Result := convertOK;
- end;
- end;
- function TryStringToInt64A(const S: AnsiString; out A: Int64): Boolean;
- var L, N : Integer;
- begin
- L := Length(S);
- Result := TryStringToInt64PA(PAnsiChar(S), L, A, N) = convertOK;
- if Result then
- if N < L then
- Result := False;
- end;
- function TryStringToInt64W(const S: WideString; out A: Int64): Boolean;
- var L, N : Integer;
- begin
- L := Length(S);
- Result := TryStringToInt64PW(PWideChar(S), L, A, N) = convertOK;
- if Result then
- if N < L then
- Result := False;
- end;
- function TryStringToInt64U(const S: UnicodeString; out A: Int64): Boolean;
- var L, N : Integer;
- begin
- L := Length(S);
- Result := TryStringToInt64PW(PWideChar(S), L, A, N) = convertOK;
- if Result then
- if N < L then
- Result := False;
- end;
- function TryStringToInt64(const S: String; out A: Int64): Boolean;
- var L, N : Integer;
- begin
- L := Length(S);
- Result := TryStringToInt64P(PChar(S), L, A, N) = convertOK;
- if Result then
- if N < L then
- Result := False;
- end;
- function StringToInt64DefA(const S: AnsiString; const Default: Int64): Int64;
- begin
- if not TryStringToInt64A(S, Result) then
- Result := Default;
- end;
- function StringToInt64DefW(const S: WideString; const Default: Int64): Int64;
- begin
- if not TryStringToInt64W(S, Result) then
- Result := Default;
- end;
- function StringToInt64DefU(const S: UnicodeString; const Default: Int64): Int64;
- begin
- if not TryStringToInt64U(S, Result) then
- Result := Default;
- end;
- function StringToInt64Def(const S: String; const Default: Int64): Int64;
- begin
- if not TryStringToInt64(S, Result) then
- Result := Default;
- end;
- function StringToInt64A(const S: AnsiString): Int64;
- begin
- if not TryStringToInt64A(S, Result) then
- RaiseRangeCheckError;
- end;
- function StringToInt64W(const S: WideString): Int64;
- begin
- if not TryStringToInt64W(S, Result) then
- RaiseRangeCheckError;
- end;
- function StringToInt64U(const S: UnicodeString): Int64;
- begin
- if not TryStringToInt64U(S, Result) then
- RaiseRangeCheckError;
- end;
- function StringToInt64(const S: String): Int64;
- begin
- if not TryStringToInt64(S, Result) then
- RaiseRangeCheckError;
- end;
- function TryStringToIntA(const S: AnsiString; out A: Integer): Boolean;
- var B : Int64;
- begin
- Result := TryStringToInt64A(S, B);
- if not Result then
- begin
- A := 0;
- exit;
- end;
- if (B < MinInteger) or (B > MaxInteger) then
- begin
- A := 0;
- Result := False;
- exit;
- end;
- A := Integer(B);
- Result := True;
- end;
- function TryStringToIntW(const S: WideString; out A: Integer): Boolean;
- var B : Int64;
- begin
- Result := TryStringToInt64W(S, B);
- if not Result then
- begin
- A := 0;
- exit;
- end;
- if (B < MinInteger) or (B > MaxInteger) then
- begin
- A := 0;
- Result := False;
- exit;
- end;
- A := Integer(B);
- Result := True;
- end;
- function TryStringToIntU(const S: UnicodeString; out A: Integer): Boolean;
- var B : Int64;
- begin
- Result := TryStringToInt64U(S, B);
- if not Result then
- begin
- A := 0;
- exit;
- end;
- if (B < MinInteger) or (B > MaxInteger) then
- begin
- A := 0;
- Result := False;
- exit;
- end;
- A := Integer(B);
- Result := True;
- end;
- function TryStringToInt(const S: String; out A: Integer): Boolean;
- var B : Int64;
- begin
- Result := TryStringToInt64(S, B);
- if not Result then
- begin
- A := 0;
- exit;
- end;
- if (B < MinInteger) or (B > MaxInteger) then
- begin
- A := 0;
- Result := False;
- exit;
- end;
- A := Integer(B);
- Result := True;
- end;
- function StringToIntDefA(const S: AnsiString; const Default: Integer): Integer;
- begin
- if not TryStringToIntA(S, Result) then
- Result := Default;
- end;
- function StringToIntDefW(const S: WideString; const Default: Integer): Integer;
- begin
- if not TryStringToIntW(S, Result) then
- Result := Default;
- end;
- function StringToIntDefU(const S: UnicodeString; const Default: Integer): Integer;
- begin
- if not TryStringToIntU(S, Result) then
- Result := Default;
- end;
- function StringToIntDef(const S: String; const Default: Integer): Integer;
- begin
- if not TryStringToInt(S, Result) then
- Result := Default;
- end;
- function StringToIntA(const S: AnsiString): Integer;
- begin
- if not TryStringToIntA(S, Result) then
- RaiseRangeCheckError;
- end;
- function StringToIntW(const S: WideString): Integer;
- begin
- if not TryStringToIntW(S, Result) then
- RaiseRangeCheckError;
- end;
- function StringToIntU(const S: UnicodeString): Integer;
- begin
- if not TryStringToIntU(S, Result) then
- RaiseRangeCheckError;
- end;
- function StringToInt(const S: String): Integer;
- begin
- if not TryStringToInt(S, Result) then
- RaiseRangeCheckError;
- end;
- function TryStringToLongWordA(const S: AnsiString; out A: LongWord): Boolean;
- var B : Int64;
- begin
- Result := TryStringToInt64A(S, B);
- if not Result then
- begin
- A := 0;
- exit;
- end;
- if (B < MinLongWord) or (B > MaxLongWord) then
- begin
- A := 0;
- Result := False;
- exit;
- end;
- A := LongWord(B);
- Result := True;
- end;
- function TryStringToLongWordW(const S: WideString; out A: LongWord): Boolean;
- var B : Int64;
- begin
- Result := TryStringToInt64W(S, B);
- if not Result then
- begin
- A := 0;
- exit;
- end;
- if (B < MinLongWord) or (B > MaxLongWord) then
- begin
- A := 0;
- Result := False;
- exit;
- end;
- A := LongWord(B);
- Result := True;
- end;
- function TryStringToLongWordU(const S: UnicodeString; out A: LongWord): Boolean;
- var B : Int64;
- begin
- Result := TryStringToInt64U(S, B);
- if not Result then
- begin
- A := 0;
- exit;
- end;
- if (B < MinLongWord) or (B > MaxLongWord) then
- begin
- A := 0;
- Result := False;
- exit;
- end;
- A := LongWord(B);
- Result := True;
- end;
- function TryStringToLongWord(const S: String; out A: LongWord): Boolean;
- var B : Int64;
- begin
- Result := TryStringToInt64(S, B);
- if not Result then
- begin
- A := 0;
- exit;
- end;
- if (B < MinLongWord) or (B > MaxLongWord) then
- begin
- A := 0;
- Result := False;
- exit;
- end;
- A := LongWord(B);
- Result := True;
- end;
- function StringToLongWordA(const S: AnsiString): LongWord;
- begin
- if not TryStringToLongWordA(S, Result) then
- RaiseRangeCheckError;
- end;
- function StringToLongWordW(const S: WideString): LongWord;
- begin
- if not TryStringToLongWordW(S, Result) then
- RaiseRangeCheckError;
- end;
- function StringToLongWordU(const S: UnicodeString): LongWord;
- begin
- if not TryStringToLongWordU(S, Result) then
- RaiseRangeCheckError;
- end;
- function StringToLongWord(const S: String): LongWord;
- begin
- if not TryStringToLongWord(S, Result) then
- RaiseRangeCheckError;
- end;
- function BaseStrToNativeUIntA(const S: AnsiString; const BaseLog2: Byte;
- var Valid: Boolean): NativeUInt;
- var N : Byte;
- L : Integer;
- M : Byte;
- C : Byte;
- begin
- Assert(BaseLog2 <= 4); // maximum base 16
- L := Length(S);
- if L = 0 then // empty string is invalid
- begin
- Valid := False;
- Result := 0;
- exit;
- end;
- M := (1 shl BaseLog2) - 1; // maximum digit value
- N := 0;
- Result := 0;
- repeat
- C := HexLookup[S[L]];
- if C > M then // invalid digit
- begin
- Valid := False;
- Result := 0;
- exit;
- end;
- {$IFDEF FPC}
- Result := Result + NativeUInt(C) shl N;
- {$ELSE}
- Inc(Result, NativeUInt(C) shl N);
- {$ENDIF}
- Inc(N, BaseLog2);
- if N > BitsPerNativeWord then // overflow
- begin
- Valid := False;
- Result := 0;
- exit;
- end;
- Dec(L);
- until L = 0;
- Valid := True;
- end;
- function BaseStrToNativeUIntW(const S: WideString; const BaseLog2: Byte;
- var Valid: Boolean): NativeUInt;
- var N : Byte;
- L : Integer;
- M : Byte;
- C : Byte;
- D : WideChar;
- begin
- Assert(BaseLog2 <= 4); // maximum base 16
- L := Length(S);
- if L = 0 then // empty string is invalid
- begin
- Valid := False;
- Result := 0;
- exit;
- end;
- M := (1 shl BaseLog2) - 1; // maximum digit value
- N := 0;
- Result := 0;
- repeat
- D := S[L];
- if Ord(D) > $FF then
- C := $FF
- else
- C := HexLookup[AnsiChar(Ord(D))];
- if C > M then // invalid digit
- begin
- Valid := False;
- Result := 0;
- exit;
- end;
- {$IFDEF FPC}
- Result := Result + NativeUInt(C) shl N;
- {$ELSE}
- Inc(Result, NativeUInt(C) shl N);
- {$ENDIF}
- Inc(N, BaseLog2);
- if N > BitsPerNativeWord then // overflow
- begin
- Valid := False;
- Result := 0;
- exit;
- end;
- Dec(L);
- until L = 0;
- Valid := True;
- end;
- function BaseStrToNativeUIntU(const S: UnicodeString; const BaseLog2: Byte;
- var Valid: Boolean): NativeUInt;
- var N : Byte;
- L : Integer;
- M : Byte;
- C : Byte;
- D : WideChar;
- begin
- Assert(BaseLog2 <= 4); // maximum base 16
- L := Length(S);
- if L = 0 then // empty string is invalid
- begin
- Valid := False;
- Result := 0;
- exit;
- end;
- M := (1 shl BaseLog2) - 1; // maximum digit value
- N := 0;
- Result := 0;
- repeat
- D := S[L];
- if Ord(D) > $FF then
- C := $FF
- else
- C := HexLookup[AnsiChar(Ord(D))];
- if C > M then // invalid digit
- begin
- Valid := False;
- Result := 0;
- exit;
- end;
- {$IFDEF FPC}
- Result := Result + NativeUInt(C) shl N;
- {$ELSE}
- Inc(Result, NativeUInt(C) shl N);
- {$ENDIF}
- Inc(N, BaseLog2);
- if N > BitsPerNativeWord then // overflow
- begin
- Valid := False;
- Result := 0;
- exit;
- end;
- Dec(L);
- until L = 0;
- Valid := True;
- end;
- function BaseStrToNativeUInt(const S: String; const BaseLog2: Byte;
- var Valid: Boolean): NativeUInt;
- var N : Byte;
- L : Integer;
- M : Byte;
- C : Byte;
- D : Char;
- begin
- Assert(BaseLog2 <= 4); // maximum base 16
- L := Length(S);
- if L = 0 then // empty string is invalid
- begin
- Valid := False;
- Result := 0;
- exit;
- end;
- M := (1 shl BaseLog2) - 1; // maximum digit value
- N := 0;
- Result := 0;
- repeat
- D := S[L];
- {$IFDEF CharIsWide}
- if Ord(D) > $FF then
- C := $FF
- else
- C := HexLookup[AnsiChar(Ord(D))];
- {$ELSE}
- C := HexLookup[D];
- {$ENDIF}
- if C > M then // invalid digit
- begin
- Valid := False;
- Result := 0;
- exit;
- end;
- {$IFDEF FPC}
- Result := Result + NativeUInt(C) shl N;
- {$ELSE}
- Inc(Result, NativeUInt(C) shl N);
- {$ENDIF}
- Inc(N, BaseLog2);
- if N > BitsPerNativeWord then // overflow
- begin
- Valid := False;
- Result := 0;
- exit;
- end;
- Dec(L);
- until L = 0;
- Valid := True;
- end;
- function HexToUIntA(const S: AnsiString): NativeUInt;
- var R : Boolean;
- begin
- Result := BaseStrToNativeUIntA(S, 4, R);
- if not R then
- RaiseRangeCheckError;
- end;
- function HexToUIntW(const S: WideString): NativeUInt;
- var R : Boolean;
- begin
- Result := BaseStrToNativeUIntW(S, 4, R);
- if not R then
- RaiseRangeCheckError;
- end;
- function HexToUIntU(const S: UnicodeString): NativeUInt;
- var R : Boolean;
- begin
- Result := BaseStrToNativeUIntU(S, 4, R);
- if not R then
- RaiseRangeCheckError;
- end;
- function HexToUInt(const S: String): NativeUInt;
- var R : Boolean;
- begin
- Result := BaseStrToNativeUInt(S, 4, R);
- if not R then
- RaiseRangeCheckError;
- end;
- function TryHexToLongWordA(const S: AnsiString; out A: LongWord): Boolean;
- begin
- A := BaseStrToNativeUIntA(S, 4, Result);
- end;
- function TryHexToLongWordW(const S: WideString; out A: LongWord): Boolean;
- begin
- A := BaseStrToNativeUIntW(S, 4, Result);
- end;
- function TryHexToLongWordU(const S: UnicodeString; out A: LongWord): Boolean;
- begin
- A := BaseStrToNativeUIntU(S, 4, Result);
- end;
- function TryHexToLongWord(const S: String; out A: LongWord): Boolean;
- begin
- A := BaseStrToNativeUInt(S, 4, Result);
- end;
- function HexToLongWordA(const S: AnsiString): LongWord;
- var R : Boolean;
- begin
- Result := BaseStrToNativeUIntA(S, 4, R);
- if not R then
- RaiseRangeCheckError;
- end;
- function HexToLongWordW(const S: WideString): LongWord;
- var R : Boolean;
- begin
- Result := BaseStrToNativeUIntW(S, 4, R);
- if not R then
- RaiseRangeCheckError;
- end;
- function HexToLongWordU(const S: UnicodeString): LongWord;
- var R : Boolean;
- begin
- Result := BaseStrToNativeUIntU(S, 4, R);
- if not R then
- RaiseRangeCheckError;
- end;
- function HexToLongWord(const S: String): LongWord;
- var R : Boolean;
- begin
- Result := BaseStrToNativeUInt(S, 4, R);
- if not R then
- RaiseRangeCheckError;
- end;
- function TryOctToLongWordA(const S: AnsiString; out A: LongWord): Boolean;
- begin
- A := BaseStrToNativeUIntA(S, 3, Result);
- end;
- function TryOctToLongWordW(const S: WideString; out A: LongWord): Boolean;
- begin
- A := BaseStrToNativeUIntW(S, 3, Result);
- end;
- function TryOctToLongWordU(const S: UnicodeString; out A: LongWord): Boolean;
- begin
- A := BaseStrToNativeUIntU(S, 3, Result);
- end;
- function TryOctToLongWord(const S: String; out A: LongWord): Boolean;
- begin
- A := BaseStrToNativeUInt(S, 3, Result);
- end;
- function OctToLongWordA(const S: AnsiString): LongWord;
- var R : Boolean;
- begin
- Result := BaseStrToNativeUIntA(S, 3, R);
- if not R then
- RaiseRangeCheckError;
- end;
- function OctToLongWordW(const S: WideString): LongWord;
- var R : Boolean;
- begin
- Result := BaseStrToNativeUIntW(S, 3, R);
- if not R then
- RaiseRangeCheckError;
- end;
- function OctToLongWordU(const S: UnicodeString): LongWord;
- var R : Boolean;
- begin
- Result := BaseStrToNativeUIntU(S, 3, R);
- if not R then
- RaiseRangeCheckError;
- end;
- function OctToLongWord(const S: String): LongWord;
- var R : Boolean;
- begin
- Result := BaseStrToNativeUIntW(S, 3, R);
- if not R then
- RaiseRangeCheckError;
- end;
- function TryBinToLongWordA(const S: AnsiString; out A: LongWord): Boolean;
- begin
- A := BaseStrToNativeUIntA(S, 1, Result);
- end;
- function TryBinToLongWordW(const S: WideString; out A: LongWord): Boolean;
- begin
- A := BaseStrToNativeUIntW(S, 1, Result);
- end;
- function TryBinToLongWordU(const S: UnicodeString; out A: LongWord): Boolean;
- begin
- A := BaseStrToNativeUIntU(S, 1, Result);
- end;
- function TryBinToLongWord(const S: String; out A: LongWord): Boolean;
- begin
- A := BaseStrToNativeUInt(S, 1, Result);
- end;
- function BinToLongWordA(const S: AnsiString): LongWord;
- var R : Boolean;
- begin
- Result := BaseStrToNativeUIntA(S, 1, R);
- if not R then
- RaiseRangeCheckError;
- end;
- function BinToLongWordW(const S: WideString): LongWord;
- var R : Boolean;
- begin
- Result := BaseStrToNativeUIntW(S, 1, R);
- if not R then
- RaiseRangeCheckError;
- end;
- function BinToLongWordU(const S: UnicodeString): LongWord;
- var R : Boolean;
- begin
- Result := BaseStrToNativeUIntU(S, 1, R);
- if not R then
- RaiseRangeCheckError;
- end;
- function BinToLongWord(const S: String): LongWord;
- var R : Boolean;
- begin
- Result := BaseStrToNativeUInt(S, 1, R);
- if not R then
- RaiseRangeCheckError;
- end;
- { }
- { Float-String conversions }
- { }
- function FloatToStringS(const A: Extended): ShortString;
- var B : Extended;
- S : ShortString;
- L, I : Integer;
- E : Integer;
- begin
- // handle special floating point values
- if FloatIsInfinity(A) or FloatIsNaN(A) then
- begin
- Result := '';
- exit;
- end;
- B := Abs(A);
- // very small numbers (Double precision) are zero
- if B < 1e-300 then
- begin
- Result := '0';
- exit;
- end;
- // up to 15 digits (around Double precsion) before or after decimal use non-scientific notation
- if (B < 1e-15) or (B >= 1e+15) then
- Str(A, S)
- else
- Str(A:0:15, S);
- // trim preceding spaces
- I := 1;
- while S[I] = ' ' do
- Inc(I);
- if I > 1 then
- S := Copy(S, I, Length(S) - I + 1);
- // find exponent
- L := Length(S);
- E := 0;
- for I := 1 to L do
- if S[I] = 'E' then
- begin
- E := I;
- break;
- end;
- if E = 0 then
- begin
- // trim trailing zeros
- I := L;
- while S[I] = '0' do
- Dec(I);
- if S[I] = '.' then
- Dec(I);
- if I < L then
- SetLength(S, I);
- end
- else
- begin
- // trim trailing zeros in mantissa
- I := E - 1;
- while S[I] = '0' do
- Dec(I);
- if S[I] = '.' then
- Dec(I);
- if I < E - 1 then
- S := Copy(S, 1, I) + Copy(S, E, L - E + 1);
- end;
- // return formatted float string
- Result := S;
- end;
- function FloatToStringA(const A: Extended): AnsiString;
- begin
- Result := AnsiString(FloatToStringS(A));
- end;
- function FloatToStringW(const A: Extended): WideString;
- begin
- Result := WideString(FloatToStringS(A));
- end;
- function FloatToStringU(const A: Extended): UnicodeString;
- begin
- Result := UnicodeString(FloatToStringS(A));
- end;
- function FloatToString(const A: Extended): String;
- begin
- Result := String(FloatToStringS(A));
- end;
- function TryStringToFloatPA(const BufP: Pointer; const BufLen: Integer; out Value: Extended; out StrLen: Integer): TConvertResult;
- var Len : Integer;
- DigVal : Integer;
- DigValF : Extended;
- P : PAnsiChar;
- Ch : AnsiChar;
- HasDig : Boolean;
- Neg : Boolean;
- Res : Extended;
- Ex : Extended;
- ExI : Int64;
- L : Integer;
- begin
- if BufLen <= 0 then
- begin
- Value := 0;
- StrLen := 0;
- Result := convertFormatError;
- exit;
- end;
- P := BufP;
- Len := 0;
- // check sign
- Ch := P^;
- if (Ch = '+') or (Ch = '-') then
- begin
- Inc(Len);
- Inc(P);
- Neg := Ch = '-';
- end
- else
- Neg := False;
- // skip leading zeros
- HasDig := False;
- while (Len < BufLen) and (P^ = '0') do
- begin
- Inc(Len);
- Inc(P);
- HasDig := True;
- end;
- // convert integer digits
- Res := 0.0;
- while Len < BufLen do
- begin
- Ch := P^;
- if (Ch >= '0') and (Ch <= '9') then
- begin
- HasDig := True;
- // maximum Extended is roughly 1.1e4932, maximum Double is roughly 1.7e308
- if Abs(Res) >= 1.0e+290 then
- begin
- Value := 0;
- StrLen := Len;
- Result := convertOverflow;
- exit;
- end;
- Res := Res * 10.0;
- DigVal := AnsiCharToInt(Ch);
- if Neg then
- Res := Res - DigVal
- else
- Res := Res + DigVal;
- Inc(Len);
- Inc(P);
- end
- else
- break;
- end;
- // convert decimal digits
- if (Len < BufLen) and (P^ = '.') then
- begin
- Inc(Len);
- Inc(P);
- ExI := 0;
- while Len < BufLen do
- begin
- Ch := P^;
- if (Ch >= '0') and (Ch <= '9') then
- begin
- HasDig := True;
- // minimum Extended is roughly 3.6e-4951, minimum Double is roughly 5e-324
- if ExI >= 1000 then
- begin
- Value := 0;
- StrLen := Len;
- Result := convertOverflow;
- exit;
- end;
- DigVal := AnsiCharToInt(Ch);
- Inc(ExI);
- DigValF := DigVal;
- DigValF := DigValF / Power(10.0, ExI);
- if Neg then
- Res := Res - DigValF
- else
- Res := Res + DigValF;
- Inc(Len);
- Inc(P);
- end
- else
- break;
- end;
- end;
- // check valid digit
- if not HasDig then
- begin
- Value := 0;
- StrLen := Len;
- Result := convertFormatError;
- exit;
- end;
- // convert exponent
- if Len < BufLen then
- begin
- Ch := P^;
- if (Ch = 'e') or (Ch = 'E') then
- begin
- Inc(Len);
- Inc(P);
- Result := TryStringToInt64PA(P, BufLen - Len, ExI, L);
- Inc(Len, L);
- if Result <> convertOK then
- begin
- Value := 0;
- StrLen := Len;
- exit;
- end;
- if ExI <> 0 then
- begin
- if (ExI > 1000) or (ExI < -1000) then
- begin
- Value := 0;
- StrLen := Len;
- Result := convertOverflow;
- exit;
- end;
- Ex := ExI;
- Ex := Power(10.0, Ex);
- Res := Res * Ex;
- end;
- end;
- end;
- // success
- Value := Res;
- StrLen := Len;
- Result := convertOK;
- end;
- function TryStringToFloatPW(const BufP: Pointer; const BufLen: Integer; out Value: Extended; out StrLen: Integer): TConvertResult;
- var Len : Integer;
- DigVal : Integer;
- DigValF : Extended;
- P : PWideChar;
- Ch : WideChar;
- HasDig : Boolean;
- Neg : Boolean;
- Res : Extended;
- Ex : Extended;
- ExI : Int64;
- L : Integer;
- begin
- if BufLen <= 0 then
- begin
- Value := 0;
- StrLen := 0;
- Result := convertFormatError;
- exit;
- end;
- P := BufP;
- Len := 0;
- // check sign
- Ch := P^;
- if (Ch = '+') or (Ch = '-') then
- begin
- Inc(Len);
- Inc(P);
- Neg := Ch = '-';
- end
- else
- Neg := False;
- // skip leading zeros
- HasDig := False;
- while (Len < BufLen) and (P^ = '0') do
- begin
- Inc(Len);
- Inc(P);
- HasDig := True;
- end;
- // convert integer digits
- Res := 0.0;
- while Len < BufLen do
- begin
- Ch := P^;
- if (Ch >= '0') and (Ch <= '9') then
- begin
- HasDig := True;
- // maximum Extended is roughly 1.1e4932, maximum Double is roughly 1.7e308
- if Abs(Res) >= 1.0e+1000 then
- begin
- Value := 0;
- StrLen := Len;
- Result := convertOverflow;
- exit;
- end;
- Res := Res * 10.0;
- DigVal := WideCharToInt(Ch);
- if Neg then
- Res := Res - DigVal
- else
- Res := Res + DigVal;
- Inc(Len);
- Inc(P);
- end
- else
- break;
- end;
- // convert decimal digits
- if (Len < BufLen) and (P^ = '.') then
- begin
- Inc(Len);
- Inc(P);
- ExI := 0;
- while Len < BufLen do
- begin
- Ch := P^;
- if (Ch >= '0') and (Ch <= '9') then
- begin
- HasDig := True;
- // minimum Extended is roughly 3.6e-4951, minimum Double is roughly 5e-324
- if ExI >= 1000 then
- begin
- Value := 0;
- StrLen := Len;
- Result := convertOverflow;
- exit;
- end;
- DigVal := WideCharToInt(Ch);
- Inc(ExI);
- DigValF := DigVal;
- DigValF := DigValF / Power(10.0, ExI);
- if Neg then
- Res := Res - DigValF
- else
- Res := Res + DigValF;
- Inc(Len);
- Inc(P);
- end
- else
- break;
- end;
- end;
- // check valid digit
- if not HasDig then
- begin
- Value := 0;
- StrLen := Len;
- Result := convertFormatError;
- exit;
- end;
- // convert exponent
- if Len < BufLen then
- begin
- Ch := P^;
- if (Ch = 'e') or (Ch = 'E') then
- begin
- Inc(Len);
- Inc(P);
- Result := TryStringToInt64PW(P, BufLen - Len, ExI, L);
- Inc(Len, L);
- if Result <> convertOK then
- begin
- Value := 0;
- StrLen := Len;
- exit;
- end;
- if ExI <> 0 then
- begin
- if (ExI > 1000) or (ExI < -1000) then
- begin
- Value := 0;
- StrLen := Len;
- Result := convertOverflow;
- exit;
- end;
- Ex := ExI;
- Ex := Power(10.0, Ex);
- Res := Res * Ex;
- end;
- end;
- end;
- // success
- Value := Res;
- StrLen := Len;
- Result := convertOK;
- end;
- function TryStringToFloatP(const BufP: Pointer; const BufLen: Integer; out Value: Extended; out StrLen: Integer): TConvertResult;
- var Len : Integer;
- DigVal : Integer;
- DigValF : Extended;
- P : PChar;
- Ch : Char;
- HasDig : Boolean;
- Neg : Boolean;
- Res : Extended;
- Ex : Extended;
- ExI : Int64;
- L : Integer;
- begin
- if BufLen <= 0 then
- begin
- Value := 0;
- StrLen := 0;
- Result := convertFormatError;
- exit;
- end;
- P := BufP;
- Len := 0;
- // check sign
- Ch := P^;
- if (Ch = '+') or (Ch = '-') then
- begin
- Inc(Len);
- Inc(P);
- Neg := Ch = '-';
- end
- else
- Neg := False;
- // skip leading zeros
- HasDig := False;
- while (Len < BufLen) and (P^ = '0') do
- begin
- Inc(Len);
- Inc(P);
- HasDig := True;
- end;
- // convert integer digits
- Res := 0.0;
- while Len < BufLen do
- begin
- Ch := P^;
- if (Ch >= '0') and (Ch <= '9') then
- begin
- HasDig := True;
- // maximum Extended is roughly 1.1e4932, maximum Double is roughly 1.7e308
- if Abs(Res) >= 1.0e+1000 then
- begin
- Value := 0;
- StrLen := Len;
- Result := convertOverflow;
- exit;
- end;
- Res := Res * 10.0;
- DigVal := CharToInt(Ch);
- if Neg then
- Res := Res - DigVal
- else
- Res := Res + DigVal;
- Inc(Len);
- Inc(P);
- end
- else
- break;
- end;
- // convert decimal digits
- if (Len < BufLen) and (P^ = '.') then
- begin
- Inc(Len);
- Inc(P);
- ExI := 0;
- while Len < BufLen do
- begin
- Ch := P^;
- if (Ch >= '0') and (Ch <= '9') then
- begin
- HasDig := True;
- // minimum Extended is roughly 3.6e-4951, minimum Double is roughly 5e-324
- if ExI >= 1000 then
- begin
- Value := 0;
- StrLen := Len;
- Result := convertOverflow;
- exit;
- end;
- DigVal := CharToInt(Ch);
- Inc(ExI);
- DigValF := DigVal;
- DigValF := DigValF / Power(10.0, ExI);
- if Neg then
- Res := Res - DigValF
- else
- Res := Res + DigValF;
- Inc(Len);
- Inc(P);
- end
- else
- break;
- end;
- end;
- // check valid digit
- if not HasDig then
- begin
- Value := 0;
- StrLen := Len;
- Result := convertFormatError;
- exit;
- end;
- // convert exponent
- if Len < BufLen then
- begin
- Ch := P^;
- if (Ch = 'e') or (Ch = 'E') then
- begin
- Inc(Len);
- Inc(P);
- Result := TryStringToInt64P(P, BufLen - Len, ExI, L);
- Inc(Len, L);
- if Result <> convertOK then
- begin
- Value := 0;
- StrLen := Len;
- exit;
- end;
- if ExI <> 0 then
- begin
- if (ExI > 1000) or (ExI < -1000) then
- begin
- Value := 0;
- StrLen := Len;
- Result := convertOverflow;
- exit;
- end;
- Ex := ExI;
- Ex := Power(10.0, Ex);
- Res := Res * Ex;
- end;
- end;
- end;
- // success
- Value := Res;
- StrLen := Len;
- Result := convertOK;
- end;
- function TryStringToFloatA(const A: AnsiString; out B: Extended): Boolean;
- var L, N : Integer;
- begin
- L := Length(A);
- Result := TryStringToFloatPA(PAnsiChar(A), L, B, N) = convertOK;
- if Result then
- if N < L then
- Result := False;
- end;
- function TryStringToFloatW(const A: WideString; out B: Extended): Boolean;
- var L, N : Integer;
- begin
- L := Length(A);
- Result := TryStringToFloatPW(PWideChar(A), L, B, N) = convertOK;
- if Result then
- if N < L then
- Result := False;
- end;
- function TryStringToFloatU(const A: UnicodeString; out B: Extended): Boolean;
- var L, N : Integer;
- begin
- L := Length(A);
- Result := TryStringToFloatPW(PWideChar(A), L, B, N) = convertOK;
- if Result then
- if N < L then
- Result := False;
- end;
- function TryStringToFloat(const A: String; out B: Extended): Boolean;
- var L, N : Integer;
- begin
- L := Length(A);
- Result := TryStringToFloatP(PChar(A), L, B, N) = convertOK;
- if Result then
- if N < L then
- Result := False;
- end;
- function StringToFloatA(const A: AnsiString): Extended;
- begin
- if not TryStringToFloatA(A, Result) then
- RaiseRangeCheckError;
- end;
- function StringToFloatW(const A: WideString): Extended;
- begin
- if not TryStringToFloatW(A, Result) then
- RaiseRangeCheckError;
- end;
- function StringToFloatU(const A: UnicodeString): Extended;
- begin
- if not TryStringToFloatU(A, Result) then
- RaiseRangeCheckError;
- end;
- function StringToFloat(const A: String): Extended;
- begin
- if not TryStringToFloat(A, Result) then
- RaiseRangeCheckError;
- end;
- function StringToFloatDefA(const A: AnsiString; const Default: Extended): Extended;
- begin
- if not TryStringToFloatA(A, Result) then
- Result := Default;
- end;
- function StringToFloatDefW(const A: WideString; const Default: Extended): Extended;
- begin
- if not TryStringToFloatW(A, Result) then
- Result := Default;
- end;
- function StringToFloatDefU(const A: UnicodeString; const Default: Extended): Extended;
- begin
- if not TryStringToFloatU(A, Result) then
- Result := Default;
- end;
- function StringToFloatDef(const A: String; const Default: Extended): Extended;
- begin
- if not TryStringToFloat(A, Result) then
- Result := Default;
- end;
- { }
- { Base64 }
- { }
- {$IFDEF CLR}
- function EncodeBase64(const S, Alphabet: AnsiString; const Pad: Boolean;
- const PadMultiple: Integer; const PadChar: AnsiChar): AnsiString;
- var R, C : Byte;
- I, F, L, M, N, U : Integer;
- T : Boolean;
- begin
- Assert(Length(Alphabet) = 64);
- {$IFOPT R+}
- if Length(Alphabet) <> 64 then
- begin
- Result := '';
- exit;
- end;
- {$ENDIF}
- L := Length(S);
- if L = 0 then
- begin
- Result := '';
- exit;
- end;
- M := L mod 3;
- N := (L div 3) * 4 + M;
- if M > 0 then
- Inc(N);
- T := Pad and (PadMultiple > 1);
- if T then
- begin
- U := N mod PadMultiple;
- if U > 0 then
- begin
- U := PadMultiple - U;
- Inc(N, U);
- end;
- end else
- U := 0;
- SetLength(Result, N);
- I := 1;
- R := 0;
- for F := 0 to L - 1 do
- begin
- C := Byte(S [F + 1]);
- case F mod 3 of
- 0 : begin
- Result[I] := Alphabet[C shr 2 + 1];
- Inc(I);
- R := (C and 3) shl 4;
- end;
- 1 : begin
- Result[I] := Alphabet[C shr 4 + R + 1];
- Inc(I);
- R := (C and $0F) shl 2;
- end;
- 2 : begin
- Result[I] := Alphabet[C shr 6 + R + 1];
- Inc(I);
- Result[I] := Alphabet[C and $3F + 1];
- Inc(I);
- end;
- end;
- end;
- if M > 0 then
- begin
- Result[I] := Alphabet[R + 1];
- Inc(I);
- end;
- for F := 1 to U do
- begin
- Result[I] := PadChar;
- Inc(I);
- end;
- end;
- {$ELSE}
- function EncodeBase64(const S, Alphabet: AnsiString; const Pad: Boolean;
- const PadMultiple: Integer; const PadChar: AnsiChar): AnsiString;
- var R, C : Byte;
- F, L, M, N, U : Integer;
- P : PAnsiChar;
- T : Boolean;
- begin
- Assert(Length(Alphabet) = 64);
- {$IFOPT R+}
- if Length(Alphabet) <> 64 then
- begin
- Result := '';
- exit;
- end;
- {$ENDIF}
- L := Length(S);
- if L = 0 then
- begin
- Result := '';
- exit;
- end;
- M := L mod 3;
- N := (L div 3) * 4 + M;
- if M > 0 then
- Inc(N);
- T := Pad and (PadMultiple > 1);
- if T then
- begin
- U := N mod PadMultiple;
- if U > 0 then
- begin
- U := PadMultiple - U;
- Inc(N, U);
- end;
- end else
- U := 0;
- SetLength(Result, N);
- P := Pointer(Result);
- R := 0;
- for F := 0 to L - 1 do
- begin
- C := Byte(S [F + 1]);
- case F mod 3 of
- 0 : begin
- P^ := Alphabet[C shr 2 + 1];
- Inc(P);
- R := (C and 3) shl 4;
- end;
- 1 : begin
- P^ := Alphabet[C shr 4 + R + 1];
- Inc(P);
- R := (C and $0F) shl 2;
- end;
- 2 : begin
- P^ := Alphabet[C shr 6 + R + 1];
- Inc(P);
- P^ := Alphabet[C and $3F + 1];
- Inc(P);
- end;
- end;
- end;
- if M > 0 then
- begin
- P^ := Alphabet[R + 1];
- Inc(P);
- end;
- for F := 1 to U do
- begin
- P^ := PadChar;
- Inc(P);
- end;
- end;
- {$ENDIF}
- {$IFDEF CLR}
- function DecodeBase64(const S, Alphabet: AnsiString; const PadSet: CharSet): AnsiString;
- var F, L, M, P : Integer;
- B, OutPos : Byte;
- C : AnsiChar;
- OutB : array[1..3] of Byte;
- Lookup : array[AnsiChar] of Byte;
- R : Integer;
- begin
- Assert(Length(Alphabet) = 64);
- {$IFOPT R+}
- if Length(Alphabet) <> 64 then
- begin
- Result := '';
- exit;
- end;
- {$ENDIF}
- L := Length(S);
- P := 0;
- if PadSet <> [] then
- while (L - P > 0) and (S[L - P] in PadSet) do
- Inc(P);
- M := L - P;
- if M = 0 then
- begin
- Result := '';
- exit;
- end;
- SetLength(Result, (M * 3) div 4);
- for C := #0 to #255 do
- Lookup[C] := 0;
- for F := 0 to 63 do
- Lookup[Alphabet[F + 1]] := Byte(F);
- R := 1;
- OutPos := 0;
- for F := 1 to L - P do
- begin
- B := Lookup[S[F]];
- case OutPos of
- 0 : OutB[1] := B shl 2;
- 1 : begin
- OutB[1] := OutB[1] or (B shr 4);
- Result[R] := AnsiChar(OutB[1]);
- Inc(R);
- OutB[2] := (B shl 4) and $FF;
- end;
- 2 : begin
- OutB[2] := OutB[2] or (B shr 2);
- Result[R] := AnsiChar(OutB[2]);
- Inc(R);
- OutB[3] := (B shl 6) and $FF;
- end;
- 3 : begin
- OutB[3] := OutB[3] or B;
- Result[R] := AnsiChar(OutB[3]);
- Inc(R);
- end;
- end;
- OutPos := (OutPos + 1) mod 4;
- end;
- if (OutPos > 0) and (P = 0) then // incomplete encoding, add the partial byte if not 0
- if OutB[OutPos] <> 0 then
- Result := Result + AnsiChar(OutB[OutPos]);
- end;
- {$ELSE}
- function DecodeBase64(const S, Alphabet: AnsiString; const PadSet: CharSet): AnsiString;
- var F, L, M, P : Integer;
- B, OutPos : Byte;
- OutB : array[1..3] of Byte;
- Lookup : array[AnsiChar] of Byte;
- R : PAnsiChar;
- begin
- Assert(Length(Alphabet) = 64);
- {$IFOPT R+}
- if Length(Alphabet) <> 64 then
- begin
- Result := '';
- exit;
- end;
- {$ENDIF}
- L := Length(S);
- P := 0;
- if PadSet <> [] then
- while (L - P > 0) and (S[L - P] in PadSet) do
- Inc(P);
- M := L - P;
- if M = 0 then
- begin
- Result := '';
- exit;
- end;
- SetLength(Result, (M * 3) div 4);
- FillChar(Lookup, Sizeof(Lookup), #0);
- for F := 0 to 63 do
- Lookup[Alphabet[F + 1]] := Byte(F);
- R := Pointer(Result);
- OutPos := 0;
- for F := 1 to L - P do
- begin
- B := Lookup[S[F]];
- case OutPos of
- 0 : OutB[1] := B shl 2;
- 1 : begin
- OutB[1] := OutB[1] or (B shr 4);
- R^ := AnsiChar(OutB[1]);
- Inc(R);
- OutB[2] := (B shl 4) and $FF;
- end;
- 2 : begin
- OutB[2] := OutB[2] or (B shr 2);
- R^ := AnsiChar(OutB[2]);
- Inc(R);
- OutB[3] := (B shl 6) and $FF;
- end;
- 3 : begin
- OutB[3] := OutB[3] or B;
- R^ := AnsiChar(OutB[3]);
- Inc(R);
- end;
- end;
- OutPos := (OutPos + 1) mod 4;
- end;
- if (OutPos > 0) and (P = 0) then // incomplete encoding, add the partial byte if not 0
- if OutB[OutPos] <> 0 then
- Result := Result + AnsiChar(OutB[OutPos]);
- end;
- {$ENDIF}
- function MIMEBase64Encode(const S: AnsiString): AnsiString;
- begin
- Result := EncodeBase64(S, b64_MIMEBase64, True, 4, '=');
- end;
- function UUDecode(const S: AnsiString): AnsiString;
- begin
- // Line without size indicator (first byte = length + 32)
- Result := DecodeBase64(S, b64_UUEncode, ['`']);
- end;
- function MIMEBase64Decode(const S: AnsiString): AnsiString;
- begin
- Result := DecodeBase64(S, b64_MIMEBase64, ['=']);
- end;
- function XXDecode(const S: AnsiString): AnsiString;
- begin
- Result := DecodeBase64(S, b64_XXEncode, []);
- end;
- {$IFDEF ManagedCode}
- function BytesToHex(const P: array of Byte; const UpperCase: Boolean): AnsiString;
- var D : Integer;
- E : Integer;
- L : Integer;
- V : Byte;
- W : Byte;
- begin
- L := Length(P);
- if L = 0 then
- begin
- Result := '';
- exit;
- end;
- SetLength(Result, L * 2);
- D := 1;
- E := 1;
- while L > 0 do
- begin
- W := P[E];
- V := W shr 4 + 1;
- Inc(E);
- if UpperCase then
- Result[D] := AnsiChar(StrHexDigitsUpper[V])
- else
- Result[D] := AnsiChar(StrHexDigitsLower[V]);
- Inc(D);
- V := W and $F + 1;
- if UpperCase then
- Result[D] := AnsiChar(StrHexDigitsUpper[V])
- else
- Result[D] := AnsiChar(StrHexDigitsLower[V]);
- Inc(D);
- Dec(L);
- end;
- end;
- {$ELSE}
- function BytesToHex(const P: Pointer; const Count: Integer;
- const UpperCase: Boolean): AnsiString;
- var Q : PByte;
- D : PAnsiChar;
- L : Integer;
- V : Byte;
- begin
- Q := P;
- L := Count;
- if (L <= 0) or not Assigned(Q) then
- begin
- Result := '';
- exit;
- end;
- SetLength(Result, Count * 2);
- D := Pointer(Result);
- while L > 0 do
- begin
- V := Q^ shr 4 + 1;
- if UpperCase then
- D^ := StrHexDigitsUpper[V]
- else
- D^ := StrHexDigitsLower[V];
- Inc(D);
- V := Q^ and $F + 1;
- if UpperCase then
- D^ := StrHexDigitsUpper[V]
- else
- D^ := StrHexDigitsLower[V];
- Inc(D);
- Inc(Q);
- Dec(L);
- end;
- end;
- {$ENDIF}
- { }
- { Type conversion }
- { }
- {$IFNDEF ManagedCode}
- function PointerToStrA(const P: Pointer): AnsiString;
- begin
- Result := NativeUIntToBaseA(NativeUInt(P), BytesPerNativeWord * 2, 16, True);
- end;
- function PointerToStrW(const P: Pointer): WideString;
- begin
- Result := NativeUIntToBaseW(NativeUInt(P), BytesPerNativeWord * 2, 16, True);
- end;
- function PointerToStr(const P: Pointer): String;
- begin
- Result := NativeUIntToBase(NativeUInt(P), BytesPerNativeWord * 2, 16, True);
- end;
- function StrToPointerA(const S: AnsiString): Pointer;
- var V : Boolean;
- begin
- Result := Pointer(BaseStrToNativeUIntA(S, 4, V));
- end;
- function StrToPointerW(const S: WideString): Pointer;
- var V : Boolean;
- begin
- Result := Pointer(BaseStrToNativeUIntW(S, 4, V));
- end;
- function StrToPointer(const S: String): Pointer;
- var V : Boolean;
- begin
- Result := Pointer(BaseStrToNativeUInt(S, 4, V));
- end;
- function InterfaceToStrA(const I: IInterface): AnsiString;
- begin
- Result := NativeUIntToBaseA(NativeUInt(I), BytesPerNativeWord * 2, 16, True);
- end;
- function InterfaceToStrW(const I: IInterface): WideString;
- begin
- Result := NativeUIntToBaseW(NativeUInt(I), BytesPerNativeWord * 2, 16, True);
- end;
- function InterfaceToStr(const I: IInterface): String;
- begin
- Result := NativeUIntToBase(NativeUInt(I), BytesPerNativeWord * 2, 16, True);
- end;
- {$ENDIF}
- function ObjectClassName(const O: TObject): String;
- begin
- if not Assigned(O) then
- Result := 'nil'
- else
- Result := O.ClassName;
- end;
- function ClassClassName(const C: TClass): String;
- begin
- if not Assigned(C) then
- Result := 'nil'
- else
- Result := C.ClassName;
- end;
- function ObjectToStr(const O: TObject): String;
- begin
- if not Assigned(O) then
- Result := 'nil'
- else
- Result := O.ClassName{$IFNDEF CLR} + '@' + LongWordToHex(LongWord(O), 8){$ENDIF};
- end;
- {$IFDEF ASM386_DELPHI}
- function CharSetToStr(const C: CharSet): AnsiString; // Andrew N. Driazgov
- asm
- PUSH EBX
- MOV ECX, $100
- MOV EBX, EAX
- PUSH ESI
- MOV EAX, EDX
- SUB ESP, ECX
- XOR ESI, ESI
- XOR EDX, EDX
- @@lp: BT [EBX], EDX
- JC @@mm
- @@nx: INC EDX
- DEC ECX
- JNE @@lp
- MOV ECX, ESI
- MOV EDX, ESP
- CALL System.@LStrFromPCharLen
- ADD ESP, $100
- POP ESI
- POP EBX
- RET
- @@mm: MOV [ESP + ESI], DL
- INC ESI
- JMP @@nx
- end;
- {$ELSE}
- function CharSetToStr(const C: CharSet): AnsiString;
- // Implemented recursively to avoid multiple memory allocations
- procedure CharMatch(const Start: AnsiChar; const Count: Integer);
- var Ch : AnsiChar;
- begin
- for Ch := Start to #255 do
- if Ch in C then
- begin
- if Ch = #255 then
- SetLength(Result, Count + 1)
- else
- CharMatch(AnsiChar(Byte(Ch) + 1), Count + 1);
- Result[Count + 1] := Ch;
- exit;
- end;
- SetLength(Result, Count);
- end;
- begin
- CharMatch(#0, 0);
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- function StrToCharSet(const S: AnsiString): CharSet; // Andrew N. Driazgov
- asm
- XOR ECX, ECX
- MOV [EDX], ECX
- MOV [EDX + 4], ECX
- MOV [EDX + 8], ECX
- MOV [EDX + 12], ECX
- MOV [EDX + 16], ECX
- MOV [EDX + 20], ECX
- MOV [EDX + 24], ECX
- MOV [EDX + 28], ECX
- TEST EAX, EAX
- JE @@qt
- MOV ECX, [EAX - 4]
- PUSH EBX
- SUB ECX, 8
- JS @@nx
- @@lp: MOVZX EBX, BYTE PTR [EAX]
- BTS [EDX], EBX
- MOVZX EBX, BYTE PTR [EAX + 1]
- BTS [EDX], EBX
- MOVZX EBX, BYTE PTR [EAX + 2]
- BTS [EDX], EBX
- MOVZX EBX, BYTE PTR [EAX + 3]
- BTS [EDX], EBX
- MOVZX EBX, BYTE PTR [EAX + 4]
- BTS [EDX], EBX
- MOVZX EBX, BYTE PTR [EAX + 5]
- BTS [EDX], EBX
- MOVZX EBX, BYTE PTR [EAX + 6]
- BTS [EDX], EBX
- MOVZX EBX, BYTE PTR [EAX + 7]
- BTS [EDX], EBX
- ADD EAX, 8
- SUB ECX, 8
- JNS @@lp
- @@nx: JMP DWORD PTR @@tV[ECX * 4 + 32]
- @@tV: DD @@ex, @@t1, @@t2, @@t3
- DD @@t4, @@t5, @@t6, @@t7
- @@t7: MOVZX EBX, BYTE PTR [EAX + 6]
- BTS [EDX], EBX
- @@t6: MOVZX EBX, BYTE PTR [EAX + 5]
- BTS [EDX], EBX
- @@t5: MOVZX EBX, BYTE PTR [EAX + 4]
- BTS [EDX], EBX
- @@t4: MOVZX EBX, BYTE PTR [EAX + 3]
- BTS [EDX], EBX
- @@t3: MOVZX EBX, BYTE PTR [EAX + 2]
- BTS [EDX], EBX
- @@t2: MOVZX EBX, BYTE PTR [EAX + 1]
- BTS [EDX], EBX
- @@t1: MOVZX EBX, BYTE PTR [EAX]
- BTS [EDX], EBX
- @@ex: POP EBX
- @@qt:
- end;
- {$ELSE}
- function StrToCharSet(const S: AnsiString): CharSet;
- var I : Integer;
- begin
- ClearCharSet(Result);
- for I := 1 to Length(S) do
- Include(Result, S[I]);
- end;
- {$ENDIF}
- { }
- { Hash functions }
- { Derived from a CRC32 algorithm. }
- { }
- var
- HashTableInit : Boolean = False;
- HashTable : array[Byte] of LongWord;
- HashPoly : LongWord = $EDB88320;
- procedure InitHashTable;
- var I, J : Byte;
- R : LongWord;
- begin
- for I := $00 to $FF do
- begin
- R := I;
- for J := 8 downto 1 do
- if R and 1 <> 0 then
- R := (R shr 1) xor HashPoly
- else
- R := R shr 1;
- HashTable[I] := R;
- end;
- HashTableInit := True;
- end;
- function HashByte(const Hash: LongWord; const C: Byte): LongWord; {$IFDEF UseInline}inline;{$ENDIF}
- begin
- Result := HashTable[Byte(Hash) xor C] xor (Hash shr 8);
- end;
- function HashCharA(const Hash: LongWord; const Ch: AnsiChar): LongWord; {$IFDEF UseInline}inline;{$ENDIF}
- begin
- Result := HashByte(Hash, Byte(Ch));
- end;
- function HashCharW(const Hash: LongWord; const Ch: WideChar): LongWord; {$IFDEF UseInline}inline;{$ENDIF}
- var C1, C2 : Byte;
- begin
- C1 := Byte(Ord(Ch) and $FF);
- C2 := Byte(Ord(Ch) shr 8);
- Result := Hash;
- Result := HashByte(Result, C1);
- Result := HashByte(Result, C2);
- end;
- function HashChar(const Hash: LongWord; const Ch: Char): LongWord; {$IFDEF UseInline}inline;{$ENDIF}
- begin
- {$IFDEF CharIsWide}
- Result := HashCharW(Hash, Ch);
- {$ELSE}
- Result := HashCharA(Hash, Ch);
- {$ENDIF}
- end;
- function HashCharNoAsciiCaseA(const Hash: LongWord; const Ch: AnsiChar): LongWord; {$IFDEF UseInline}inline;{$ENDIF}
- var C : Byte;
- begin
- C := Byte(Ch);
- if C in [Ord('A')..Ord('Z')] then
- C := C or 32;
- Result := HashCharA(Hash, AnsiChar(C));
- end;
- function HashCharNoAsciiCaseW(const Hash: LongWord; const Ch: WideChar): LongWord; {$IFDEF UseInline}inline;{$ENDIF}
- var C : Word;
- begin
- C := Word(Ch);
- if C <= $FF then
- if Byte(C) in [Ord('A')..Ord('Z')] then
- C := C or 32;
- Result := HashCharW(Hash, WideChar(C));
- end;
- function HashCharNoAsciiCase(const Hash: LongWord; const Ch: Char): LongWord; {$IFDEF UseInline}inline;{$ENDIF}
- begin
- {$IFDEF CharIsWide}
- Result := HashCharNoAsciiCaseW(Hash, Ch);
- {$ELSE}
- Result := HashCharNoAsciiCaseA(Hash, Ch);
- {$ENDIF}
- end;
- function HashBuf(const Hash: LongWord; const Buf; const BufSize: Integer): LongWord;
- var P : PByte;
- I : Integer;
- begin
- if not HashTableInit then
- InitHashTable;
- Result := Hash;
- P := @Buf;
- for I := 0 to BufSize - 1 do
- begin
- Result := HashByte(Result, P^);
- Inc(P);
- end;
- end;
- function HashStrA(const S: AnsiString;
- const Index: Integer; const Count: Integer;
- const AsciiCaseSensitive: Boolean;
- const Slots: LongWord): LongWord;
- var I, L, A, B : Integer;
- begin
- if not HashTableInit then
- InitHashTable;
- A := Index;
- if A < 1 then
- A := 1;
- L := Length(S);
- B := Count;
- if B < 0 then
- B := L
- else
- begin
- B := A + B - 1;
- if B > L then
- B := L;
- end;
- Result := $FFFFFFFF;
- if AsciiCaseSensitive then
- for I := A to B do
- Result := HashCharA(Result, S[I])
- else
- for I := A to B do
- Result := HashCharNoAsciiCaseA(Result, S[I]);
- if Slots > 0 then
- Result := Result mod Slots;
- end;
- function HashStrW(const S: WideString;
- const Index: Integer; const Count: Integer;
- const AsciiCaseSensitive: Boolean;
- const Slots: LongWord): LongWord;
- var I, L, A, B : Integer;
- begin
- if not HashTableInit then
- InitHashTable;
- A := Index;
- if A < 1 then
- A := 1;
- L := Length(S);
- B := Count;
- if B < 0 then
- B := L
- else
- begin
- B := A + B - 1;
- if B > L then
- B := L;
- end;
- Result := $FFFFFFFF;
- if AsciiCaseSensitive then
- for I := A to B do
- Result := HashCharW(Result, S[I])
- else
- for I := A to B do
- Result := HashCharNoAsciiCaseW(Result, S[I]);
- if Slots > 0 then
- Result := Result mod Slots;
- end;
- function HashStrU(const S: UnicodeString;
- const Index: Integer; const Count: Integer;
- const AsciiCaseSensitive: Boolean;
- const Slots: LongWord): LongWord;
- var I, L, A, B : Integer;
- begin
- if not HashTableInit then
- InitHashTable;
- A := Index;
- if A < 1 then
- A := 1;
- L := Length(S);
- B := Count;
- if B < 0 then
- B := L
- else
- begin
- B := A + B - 1;
- if B > L then
- B := L;
- end;
- Result := $FFFFFFFF;
- if AsciiCaseSensitive then
- for I := A to B do
- Result := HashCharW(Result, S[I])
- else
- for I := A to B do
- Result := HashCharNoAsciiCaseW(Result, S[I]);
- if Slots > 0 then
- Result := Result mod Slots;
- end;
- function HashStr(const S: String;
- const Index: Integer; const Count: Integer;
- const AsciiCaseSensitive: Boolean;
- const Slots: LongWord): LongWord;
- var I, L, A, B : Integer;
- begin
- if not HashTableInit then
- InitHashTable;
- A := Index;
- if A < 1 then
- A := 1;
- L := Length(S);
- B := Count;
- if B < 0 then
- B := L
- else
- begin
- B := A + B - 1;
- if B > L then
- B := L;
- end;
- Result := $FFFFFFFF;
- if AsciiCaseSensitive then
- for I := A to B do
- Result := HashChar(Result, S[I])
- else
- for I := A to B do
- Result := HashCharNoAsciiCase(Result, S[I]);
- if Slots > 0 then
- Result := Result mod Slots;
- end;
- { HashInteger based on the CRC32 algorithm. It is a very good all purpose hash }
- { with a highly uniform distribution of results. }
- {$IFDEF ManagedCode}
- function HashInteger(const I: Integer; const Slots: LongWord): LongWord;
- begin
- if not HashTableInit then
- InitHashTable;
- Result := $FFFFFFFF;
- Result := HashTable[Byte(Result) xor (I and $000000FF)] xor (Result shr 8);
- Result := HashTable[Byte(Result) xor ((I and $0000FF00) shr 8)] xor (Result shr 8);
- Result := HashTable[Byte(Result) xor ((I and $00FF0000) shr 16)] xor (Result shr 8);
- Result := HashTable[Byte(Result) xor ((I and $FF000000) shr 24)] xor (Result shr 8);
- if Slots <> 0 then
- Result := Result mod Slots;
- end;
- {$ELSE}
- function HashInteger(const I: Integer; const Slots: LongWord): LongWord;
- var P : PByte;
- begin
- if not HashTableInit then
- InitHashTable;
- Result := $FFFFFFFF;
- P := @I;
- Result := HashTable[Byte(Result) xor P^] xor (Result shr 8);
- Inc(P);
- Result := HashTable[Byte(Result) xor P^] xor (Result shr 8);
- Inc(P);
- Result := HashTable[Byte(Result) xor P^] xor (Result shr 8);
- Inc(P);
- Result := HashTable[Byte(Result) xor P^] xor (Result shr 8);
- if Slots <> 0 then
- Result := Result mod Slots;
- end;
- {$ENDIF}
- {$IFDEF ManagedCode}
- function HashLongWord(const I: LongWord; const Slots: LongWord): LongWord;
- begin
- if not HashTableInit then
- InitHashTable;
- Result := $FFFFFFFF;
- Result := HashTable[Byte(Result) xor (I and $000000FF)] xor (Result shr 8);
- Result := HashTable[Byte(Result) xor ((I and $0000FF00) shr 8)] xor (Result shr 8);
- Result := HashTable[Byte(Result) xor ((I and $00FF0000) shr 16)] xor (Result shr 8);
- Result := HashTable[Byte(Result) xor ((I and $FF000000) shr 24)] xor (Result shr 8);
- if Slots <> 0 then
- Result := Result mod Slots;
- end;
- {$ELSE}
- function HashLongWord(const I: LongWord; const Slots: LongWord): LongWord;
- var P : PByte;
- begin
- if not HashTableInit then
- InitHashTable;
- Result := $FFFFFFFF;
- P := @I;
- Result := HashTable[Byte(Result) xor P^] xor (Result shr 8);
- Inc(P);
- Result := HashTable[Byte(Result) xor P^] xor (Result shr 8);
- Inc(P);
- Result := HashTable[Byte(Result) xor P^] xor (Result shr 8);
- Inc(P);
- Result := HashTable[Byte(Result) xor P^] xor (Result shr 8);
- if Slots <> 0 then
- Result := Result mod Slots;
- end;
- {$ENDIF}
- {$IFNDEF ManagedCode}
- { }
- { Memory }
- { }
- {$IFDEF UseAsmMemFunction}
- procedure FillMem(var Buf; const Count: Integer; const Value: Byte);
- asm
- // EAX = Buf, EDX = Count, CL = Value
- OR EDX, EDX
- JLE @Fin
- // Set 4 bytes of ECX to Value byte
- MOV CH, CL
- SHL ECX, 8
- MOV CL, CH
- SHL ECX, 8
- MOV CL, CH
- CMP EDX, 16
- JBE @SmallFillMem
- // General purpose FillMem
- @GeneralFillMem:
- PUSH EDI
- MOV EDI, EAX
- MOV EAX, ECX
- MOV ECX, EDX
- SHR ECX, 2
- REP STOSD
- AND EDX, 3
- MOV ECX, EDX
- REP STOSB
- POP EDI
- RET
- // FillMem for small blocks
- @SmallFillMem:
- JMP DWORD PTR @JumpTable[EDX * 4]
- @JumpTable:
- DD @Fill0, @Fill1, @Fill2, @Fill3
- DD @Fill4, @Fill5, @Fill6, @Fill7
- DD @Fill8, @Fill9, @Fill10, @Fill11
- DD @Fill12, @Fill13, @Fill14, @Fill15
- DD @Fill16
- @Fill16:
- MOV DWORD PTR [EAX], ECX
- MOV DWORD PTR [EAX + 4], ECX
- MOV DWORD PTR [EAX + 8], ECX
- MOV DWORD PTR [EAX + 12], ECX
- RET
- @Fill15:
- MOV BYTE PTR [EAX + 14], CL
- @Fill14:
- MOV DWORD PTR [EAX], ECX
- MOV DWORD PTR [EAX + 4], ECX
- MOV DWORD PTR [EAX + 8], ECX
- MOV WORD PTR [EAX + 12], CX
- RET
- @Fill13:
- MOV BYTE PTR [EAX + 12], CL
- @Fill12:
- MOV DWORD PTR [EAX], ECX
- MOV DWORD PTR [EAX + 4], ECX
- MOV DWORD PTR [EAX + 8], ECX
- RET
- @Fill11:
- MOV BYTE PTR [EAX + 10], CL
- @Fill10:
- MOV DWORD PTR [EAX], ECX
- MOV DWORD PTR [EAX + 4], ECX
- MOV WORD PTR [EAX + 8], CX
- RET
- @Fill9:
- MOV BYTE PTR [EAX + 8], CL
- @Fill8:
- MOV DWORD PTR [EAX], ECX
- MOV DWORD PTR [EAX + 4], ECX
- RET
- @Fill7:
- MOV BYTE PTR [EAX + 6], CL
- @Fill6:
- MOV DWORD PTR [EAX], ECX
- MOV WORD PTR [EAX + 4], CX
- RET
- @Fill5:
- MOV BYTE PTR [EAX + 4], CL
- @Fill4:
- MOV DWORD PTR [EAX], ECX
- RET
- @Fill3:
- MOV BYTE PTR [EAX + 2], CL
- @Fill2:
- MOV WORD PTR [EAX], CX
- RET
- @Fill1:
- MOV BYTE PTR [EAX], CL
- @Fill0:
- @Fin:
- end;
- {$ELSE}
- procedure FillMem(var Buf; const Count: Integer; const Value: Byte);
- begin
- FillChar(Buf, Count, Value);
- end;
- {$ENDIF}
- {$IFDEF UseAsmMemFunction}
- procedure ZeroMem(var Buf; const Count: Integer);
- asm
- // EAX = Buf, EDX = Count
- OR EDX, EDX
- JLE @Zero0
- CMP EDX, 16
- JA @GeneralZeroMem
- XOR ECX, ECX
- JMP DWORD PTR @SmallZeroJumpTable[EDX * 4]
- @SmallZeroJumpTable:
- DD @Zero0, @Zero1, @Zero2, @Zero3
- DD @Zero4, @Zero5, @Zero6, @Zero7
- DD @Zero8, @Zero9, @Zero10, @Zero11
- DD @Zero12, @Zero13, @Zero14, @Zero15
- DD @Zero16
- @Zero16:
- MOV DWORD PTR [EAX], ECX
- MOV DWORD PTR [EAX + 4], ECX
- MOV DWORD PTR [EAX + 8], ECX
- MOV DWORD PTR [EAX + 12], ECX
- RET
- @Zero15:
- MOV BYTE PTR [EAX + 14], CL
- @Zero14:
- MOV DWORD PTR [EAX], ECX
- MOV DWORD PTR [EAX + 4], ECX
- MOV DWORD PTR [EAX + 8], ECX
- MOV WORD PTR [EAX + 12], CX
- RET
- @Zero13:
- MOV BYTE PTR [EAX + 12], CL
- @Zero12:
- MOV DWORD PTR [EAX], ECX
- MOV DWORD PTR [EAX + 4], ECX
- MOV DWORD PTR [EAX + 8], ECX
- RET
- @Zero11:
- MOV BYTE PTR [EAX + 10], CL
- @Zero10:
- MOV DWORD PTR [EAX], ECX
- MOV DWORD PTR [EAX + 4], ECX
- MOV WORD PTR [EAX + 8], CX
- RET
- @Zero9:
- MOV BYTE PTR [EAX + 8], CL
- @Zero8:
- MOV DWORD PTR [EAX], ECX
- MOV DWORD PTR [EAX + 4], ECX
- RET
- @Zero7:
- MOV BYTE PTR [EAX + 6], CL
- @Zero6:
- MOV DWORD PTR [EAX], ECX
- MOV WORD PTR [EAX + 4], CX
- RET
- @Zero5:
- MOV BYTE PTR [EAX + 4], CL
- @Zero4:
- MOV DWORD PTR [EAX], ECX
- RET
- @Zero3:
- MOV BYTE PTR [EAX + 2], CL
- @Zero2:
- MOV WORD PTR [EAX], CX
- RET
- @Zero1:
- MOV BYTE PTR [EAX], CL
- @Zero0:
- RET
- @GeneralZeroMem:
- PUSH EDI
- MOV EDI, EAX
- XOR EAX, EAX
- MOV ECX, EDX
- SHR ECX, 2
- REP STOSD
- MOV ECX, EDX
- AND ECX, 3
- REP STOSB
- POP EDI
- end;
- {$ELSE}
- procedure ZeroMem(var Buf; const Count: Integer);
- begin
- FillChar(Buf, Count, #0);
- end;
- {$ENDIF}
- procedure GetZeroMem(var P: Pointer; const Size: Integer);
- begin
- GetMem(P, Size);
- ZeroMem(P^, Size);
- end;
- {$IFDEF UseAsmMemFunction}
- { Note: MoveMem implements a "safe move", that is, the Source and Dest memory }
- { blocks are allowed to overlap. }
- procedure MoveMem(const Source; var Dest; const Count: Integer);
- asm
- // EAX = Source, EDX = Dest, ECX = Count
- OR ECX, ECX
- JLE @Move0
- CMP EAX, EDX
- JE @Move0
- JB @CheckSafe
- @GeneralMove:
- CMP ECX, 16
- JA @LargeMove
- JMP DWORD PTR @SmallMoveJumpTable[ECX * 4]
- @CheckSafe:
- ADD EAX, ECX
- CMP EAX, EDX
- JBE @IsSafe
- @NotSafe:
- SUB EAX, ECX
- CMP ECX, 10
- JA @LargeMoveReverse
- JMP DWORD PTR @SmallMoveJumpTable[ECX * 4]
- @IsSafe:
- SUB EAX, ECX
- CMP ECX, 16
- JA @LargeMove
- JMP DWORD PTR @SmallMoveJumpTable[ECX * 4]
- @SmallMoveJumpTable:
- DD @Move0, @Move1, @Move2, @Move3
- DD @Move4, @Move5, @Move6, @Move7
- DD @Move8, @Move9, @Move10, @Move11
- DD @Move12, @Move13, @Move14, @Move15
- DD @Move16
- @Move16:
- PUSH EBX
- MOV ECX, [EAX]
- MOV EBX, [EAX + 4]
- MOV [EDX], ECX
- MOV [EDX + 4], EBX
- MOV ECX, [EAX + 8]
- MOV EBX, [EAX + 12]
- MOV [EDX + 8], ECX
- MOV [EDX + 12], EBX
- POP EBX
- RET
- @Move15:
- PUSH EBX
- MOV ECX, [EAX]
- MOV EBX, [EAX + 4]
- MOV [EDX], ECX
- MOV [EDX + 4], EBX
- MOV ECX, [EAX + 8]
- MOV BX, [EAX + 12]
- MOV AL, [EAX + 14]
- MOV [EDX + 8], ECX
- MOV [EDX + 12], BX
- MOV [EDX + 14], AL
- POP EBX
- RET
- @Move14:
- PUSH EBX
- MOV ECX, [EAX]
- MOV EBX, [EAX + 4]
- MOV [EDX], ECX
- MOV [EDX + 4], EBX
- MOV ECX, [EAX + 8]
- MOV BX, [EAX + 12]
- MOV [EDX + 8], ECX
- MOV [EDX + 12], BX
- POP EBX
- RET
- @Move13:
- PUSH EBX
- MOV ECX, [EAX]
- MOV EBX, [EAX + 4]
- MOV [EDX], ECX
- MOV [EDX + 4], EBX
- MOV ECX, [EAX + 8]
- MOV BL, [EAX + 12]
- MOV [EDX + 8], ECX
- MOV [EDX + 12], BL
- POP EBX
- RET
- @Move12:
- PUSH EBX
- MOV ECX, [EAX]
- MOV EBX, [EAX + 4]
- MOV EAX, [EAX + 8]
- MOV [EDX], ECX
- MOV [EDX + 4], EBX
- MOV [EDX + 8], EAX
- POP EBX
- RET
- @Move11:
- PUSH EBX
- MOV ECX, [EAX]
- MOV EBX, [EAX + 4]
- MOV [EDX], ECX
- MOV [EDX + 4], EBX
- MOV CX, [EAX + 8]
- MOV BL, [EAX + 10]
- MOV [EDX + 8], CX
- MOV [EDX + 10], BL
- POP EBX
- RET
- @Move10:
- PUSH EBX
- MOV ECX, [EAX]
- MOV EBX, [EAX + 4]
- MOV AX, [EAX + 8]
- MOV [EDX], ECX
- MOV [EDX + 4], EBX
- MOV [EDX + 8], AX
- POP EBX
- RET
- @Move9:
- PUSH EBX
- MOV ECX, [EAX]
- MOV EBX, [EAX + 4]
- MOV AL, [EAX + 8]
- MOV [EDX], ECX
- MOV [EDX + 4], EBX
- MOV [EDX + 8], AL
- POP EBX
- RET
- @Move8:
- MOV ECX, [EAX]
- MOV EAX, [EAX + 4]
- MOV [EDX], ECX
- MOV [EDX + 4], EAX
- RET
- @Move7:
- PUSH EBX
- MOV ECX, [EAX]
- MOV BX, [EAX + 4]
- MOV AL, [EAX + 6]
- MOV [EDX], ECX
- MOV [EDX + 4], BX
- MOV [EDX + 6], AL
- POP EBX
- RET
- @Move6:
- MOV ECX, [EAX]
- MOV AX, [EAX + 4]
- MOV [EDX], ECX
- MOV [EDX + 4], AX
- RET
- @Move5:
- MOV ECX, [EAX]
- MOV AL, [EAX + 4]
- MOV [EDX], ECX
- MOV [EDX + 4], AL
- RET
- @Move4:
- MOV ECX, [EAX]
- MOV [EDX], ECX
- RET
- @Move3:
- MOV CX, [EAX]
- MOV AL, [EAX + 2]
- MOV [EDX], CX
- MOV [EDX + 2], AL
- RET
- @Move2:
- MOV CX, [EAX]
- MOV [EDX], CX
- RET
- @Move1:
- MOV CL, [EAX]
- MOV [EDX], CL
- @Move0:
- RET
- @LargeMove:
- PUSH ESI
- PUSH EDI
- MOV ESI, EAX
- MOV EDI, EDX
- MOV EDX, ECX
- SHR ECX, 2
- REP MOVSD
- MOV ECX, EDX
- AND ECX, 3
- REP MOVSB
- POP EDI
- POP ESI
- RET
- @LargeMoveReverse:
- PUSH ESI
- PUSH EDI
- MOV ESI, EAX
- MOV EDI, EDX
- LEA ESI, [ESI + ECX - 4]
- LEA EDI, [EDI + ECX - 4]
- MOV EDX, ECX
- SHR ECX, 2
- STD
- REP MOVSD
- ADD ESI, 3
- ADD EDI, 3
- MOV ECX, EDX
- AND ECX, 3
- REP MOVSB
- CLD
- POP EDI
- POP ESI
- end;
- {$ELSE}
- procedure MoveMem(const Source; var Dest; const Count: Integer);
- begin
- Move(Source, Dest, Count);
- end;
- {$ENDIF}
- {$IFDEF ASM386_DELPHI}
- function CompareMem(const Buf1; const Buf2; const Count: Integer): Boolean;
- asm
- // EAX = Buf1, EDX = Buf2, ECX = Count
- OR ECX, ECX
- JLE @Fin1
- CMP EAX, EDX
- JE @Fin1
- PUSH ESI
- PUSH EDI
- MOV ESI, EAX
- MOV EDI, EDX
- MOV EDX, ECX
- SHR ECX, 2
- XOR EAX, EAX
- REPE CMPSD
- JNE @Fin0
- MOV ECX, EDX
- AND ECX, 3
- REPE CMPSB
- JNE @Fin0
- INC EAX
- @Fin0:
- POP EDI
- POP ESI
- RET
- @Fin1:
- MOV AL, 1
- end;
- {$ELSE}
- function CompareMem(const Buf1; const Buf2; const Count: Integer): Boolean;
- var P, Q : Pointer;
- D, I : Integer;
- begin
- P := @Buf1;
- Q := @Buf2;
- if (Count <= 0) or (P = Q) then
- begin
- Result := True;
- exit;
- end;
- D := LongWord(Count) div 4;
- for I := 1 to D do
- if PLongWord(P)^ = PLongWord(Q)^ then
- begin
- Inc(PLongWord(P));
- Inc(PLongWord(Q));
- end
- else
- begin
- Result := False;
- exit;
- end;
- D := LongWord(Count) and 3;
- for I := 1 to D do
- if PByte(P)^ = PByte(Q)^ then
- begin
- Inc(PByte(P));
- Inc(PByte(Q));
- end
- else
- begin
- Result := False;
- exit;
- end;
- Result := True;
- end;
- {$ENDIF}
- function CompareMemNoCase(const Buf1; const Buf2; const Count: Integer): TCompareResult;
- var P, Q : Pointer;
- I : Integer;
- C, D : Byte;
- begin
- if Count <= 0 then
- begin
- Result := crEqual;
- exit;
- end;
- P := @Buf1;
- Q := @Buf2;
- for I := 1 to Count do
- begin
- C := PByte(P)^;
- D := PByte(Q)^;
- if C in [Ord('A')..Ord('Z')] then
- C := C or 32;
- if D in [Ord('A')..Ord('Z')] then
- D := D or 32;
- if C = D then
- begin
- Inc(PByte(P));
- Inc(PByte(Q));
- end
- else
- begin
- if C < D then
- Result := crLess
- else
- Result := crGreater;
- exit;
- end;
- end;
- Result := crEqual;
- end;
- function LocateMem(const Buf1; const Size1: Integer; const Buf2; const Size2: Integer): Integer;
- var P, Q : PByte;
- I : Integer;
- begin
- if (Size1 <= 0) or (Size2 <= 0) or (Size2 > Size1) then
- begin
- Result := -1;
- exit;
- end;
- for I := 0 to Size1 - Size2 do
- begin
- P := @Buf1;
- Inc(P, I);
- Q := @Buf2;
- if P = Q then
- begin
- Result := I;
- exit;
- end;
- if CompareMem(P^, Q^, Size2) then
- begin
- Result := I;
- exit;
- end;
- end;
- Result := -1;
- end;
- procedure ReverseMem(var Buf; const Size: Integer);
- var I : Integer;
- P : PByte;
- Q : PByte;
- T : Byte;
- begin
- P := @Buf;
- Q := P;
- Inc(Q, Size - 1);
- for I := 1 to Size div 2 do
- begin
- T := P^;
- P^ := Q^;
- Q^ := T;
- Inc(P);
- Dec(Q);
- end;
- end;
- {$ENDIF}
- { }
- { FreeAndNil }
- { }
- {$IFDEF ManagedCode}
- procedure FreeAndNil(var Obj: TObject);
- var Temp : TObject;
- begin
- Temp := Obj;
- Obj := nil;
- Temp.Free;
- end;
- {$ELSE}
- procedure FreeAndNil(var Obj);
- var Temp : TObject;
- begin
- Temp := TObject(Obj);
- Pointer(Obj) := nil;
- Temp.Free;
- end;
- {$ENDIF}
- {$IFDEF ManagedCode}
- procedure FreeObjectArray(var V: ObjectArray);
- var I : Integer;
- begin
- for I := Length(V) - 1 downto 0 do
- FreeAndNil(V[I]);
- end;
- procedure FreeObjectArray(var V: ObjectArray; const LoIdx, HiIdx: Integer);
- var I : Integer;
- begin
- for I := HiIdx downto LoIdx do
- FreeAndNil(V[I]);
- end;
- {$ELSE}
- procedure FreeObjectArray(var V);
- var I : Integer;
- A : ObjectArray absolute V;
- begin
- for I := Length(A) - 1 downto 0 do
- FreeAndNil(A[I]);
- end;
- procedure FreeObjectArray(var V; const LoIdx, HiIdx: Integer);
- var I : Integer;
- A : ObjectArray absolute V;
- begin
- for I := HiIdx downto LoIdx do
- FreeAndNil(A[I]);
- end;
- {$ENDIF}
- // Note: The parameter can not be changed to be untyped and then typecasted
- // using an absolute variable, as in FreeObjectArray. The reference counting
- // will be done incorrectly.
- procedure FreeAndNilObjectArray(var V: ObjectArray);
- var W : ObjectArray;
- begin
- W := V;
- V := nil;
- FreeObjectArray(W);
- end;
- {$IFNDEF CLR}
- { }
- { Generic quick sort algorithm }
- { }
- procedure GenericQuickSort(const Data: Pointer; const Count: Integer;
- const CompareFunc: TQuickSortCompareFunction;
- const SwapFunc: TQuickSortSwapFunction);
- procedure QuickSort(L, R: Integer);
- var I, J, M : Integer;
- begin
- repeat
- I := L;
- J := R;
- M := (L + R) shr 1;
- repeat
- while CompareFunc(Data, I, M) = crLess do
- Inc(I);
- while CompareFunc(Data, J, M) = crGreater do
- Dec(J);
- if I <= J then
- begin
- SwapFunc(Data, I, J);
- if M = I then
- M := J
- else
- if M = J then
- M := I;
- Inc(I);
- Dec(J);
- end;
- until I > J;
- if L < J then
- QuickSort(L, J);
- L := I;
- until I >= R;
- end;
- begin
- if Count > 0 then
- QuickSort(0, Count - 1);
- end;
- { }
- { Generic binary search algorithm }
- { }
- function GenericBinarySearch(const Data: Pointer; const Count: Integer;
- const Item: Pointer;
- const CompareFunc: TBinarySearchCompareFunction): Integer;
- var L, H, I : Integer;
- begin
- L := 0;
- H := Count - 1;
- while L <= H do
- begin
- I := (L + H) div 2;
- case CompareFunc(Data, I, Item) of
- crEqual :
- begin
- while (I > 0) and (CompareFunc(Data, I - 1, Item) = crEqual) do
- Dec(I);
- Result := I;
- exit;
- end;
- crGreater : H := I - 1;
- crLess : L := I + 1;
- end;
- end;
- Result := -1;
- end;
- {$ENDIF}
- { }
- { Test cases }
- { }
- {$IFDEF UTILS_SELFTEST}
- {$ASSERTIONS ON}
- procedure Test_Misc;
- var L, H : Cardinal;
- A, B : Byte;
- C, D : LongWord;
- P, Q : TObject;
- begin
- // Integer types
- {$IFNDEF ManagedCode}
- Assert(Sizeof(SmallIntRec) = Sizeof(SmallInt), 'SmallIntRec');
- Assert(Sizeof(LongIntRec) = Sizeof(LongInt), 'LongIntRec');
- {$ENDIF}
- // Min / Max
- Assert(MinI(-1, 1) = -1, 'MinI');
- Assert(MaxI(-1, 1) = 1, 'MaxI');
- Assert(MinC(1, 2) = 1, 'MinC');
- Assert(MaxC(1, 2) = 2, 'MaxC');
- Assert(MaxC($FFFFFFFF, 0) = $FFFFFFFF, 'MaxC');
- Assert(MinC($FFFFFFFF, 0) = 0, 'MinC');
- Assert(MinF(-1.0, 1.0) = -1.0, 'MinF');
- Assert(MaxF(-1.0, 1.0) = 1.0, 'MaxF');
- // Clip
- Assert(Clip(10, 5, 12) = 10, 'Clip');
- Assert(Clip(3, 5, 12) = 5, 'Clip');
- Assert(Clip(15, 5, 12) = 12, 'Clip');
- Assert(ClipByte(256) = 255, 'ClipByte');
- Assert(ClipWord(-5) = 0, 'ClipWord');
- Assert(ClipLongWord($100000000) = $FFFFFFFF, 'ClipWord');
- Assert(SumClipI(1, 2) = 3, 'SumClipI');
- Assert(SumClipI(1, -2) = -1, 'SumClipI');
- Assert(SumClipI(MaxInteger - 1, 0) = MaxInteger - 1, 'SumClipI');
- Assert(SumClipI(MaxInteger - 1, 1) = MaxInteger, 'SumClipI');
- Assert(SumClipI(MaxInteger - 1, 2) = MaxInteger, 'SumClipI');
- Assert(SumClipI(MinInteger + 1, 0) = MinInteger + 1, 'SumClipI');
- Assert(SumClipI(MinInteger + 1, -1) = MinInteger, 'SumClipI');
- Assert(SumClipI(MinInteger + 1, -2) = MinInteger, 'SumClipI');
- Assert(SumClipC(1, 2) = 3, 'SumClipC');
- Assert(SumClipC(3, -2) = 1, 'SumClipC');
- Assert(SumClipC(MaxCardinal - 1, 0) = MaxCardinal - 1, 'SumClipC');
- Assert(SumClipC(MaxCardinal - 1, 1) = MaxCardinal, 'SumClipC');
- Assert(SumClipC(MaxCardinal - 1, 2) = MaxCardinal, 'SumClipC');
- Assert(SumClipC(1, 0) = 1, 'SumClipC');
- Assert(SumClipC(1, -1) = 0, 'SumClipC');
- Assert(SumClipC(1, -2) = 0, 'SumClipC');
- Assert(not InByteRange(-1), 'InByteRange');
- Assert(not InByteRange(256), 'InByteRange');
- Assert(InByteRange(255), 'InByteRange');
- Assert(InWordRange($FFFF), 'InWordRange');
- Assert(not InWordRange($10000), 'InWordRange');
- Assert(InShortIntRange(-1), 'InShortIntRange');
- // Swap
- A := $11; B := $22;
- Swap(A, B);
- Assert((A = $22) and (B = $11), 'Swap');
- C := $11111111; D := $22222222;
- Swap(C, D);
- Assert((C = $22222222) and (D = $11111111), 'Swap');
- P := TObject.Create;
- Q := nil;
- SwapObjects(P, Q);
- Assert(Assigned(Q) and not Assigned(P), 'SwapObjects');
- Q.Free;
- // Ranges
- L := 10;
- H := 20;
- Assert(CardRangeIncludeElementRange(L, H, 10, 20), 'RangeInclude');
- Assert((L = 10) and (H = 20), 'RangeInclude');
- Assert(CardRangeIncludeElementRange(L, H, 9, 21), 'RangeInclude');
- Assert((L = 9) and (H = 21), 'RangeInclude');
- Assert(CardRangeIncludeElementRange(L, H, 7, 10), 'RangeInclude');
- Assert((L = 7) and (H = 21), 'RangeInclude');
- Assert(CardRangeIncludeElementRange(L, H, 5, 6), 'RangeInclude');
- Assert((L = 5) and (H = 21), 'RangeInclude');
- Assert(not CardRangeIncludeElementRange(L, H, 1, 3), 'RangeInclude');
- Assert((L = 5) and (H = 21), 'RangeInclude');
- Assert(CardRangeIncludeElementRange(L, H, 20, 22), 'RangeInclude');
- Assert((L = 5) and (H = 22), 'RangeInclude');
- Assert(CardRangeIncludeElementRange(L, H, 23, 24), 'RangeInclude');
- Assert((L = 5) and (H = 24), 'RangeInclude');
- Assert(not CardRangeIncludeElementRange(L, H, 26, 27), 'RangeInclude');
- Assert((L = 5) and (H = 24), 'RangeInclude');
- // iif
- Assert(iif(True, 1, 2) = 1, 'iif');
- Assert(iif(False, 1, 2) = 2, 'iif');
- Assert(iif(True, -1, -2) = -1, 'iif');
- Assert(iif(False, -1, -2) = -2, 'iif');
- Assert(iif(True, '1', '2') = '1', 'iif');
- Assert(iif(False, '1', '2') = '2', 'iif');
- Assert(iifW(True, '1', '2') = '1', 'iif');
- Assert(iifW(False, '1', '2') = '2', 'iif');
- Assert(iifU(True, '1', '2') = '1', 'iif');
- Assert(iifU(False, '1', '2') = '2', 'iif');
- Assert(iif(True, 1.1, 2.2) = 1.1, 'iif');
- Assert(iif(False, 1.1, 2.2) = 2.2, 'iif');
- // CharSet
- Assert(CharCount([]) = 0, 'CharCount');
- Assert(CharCount(['a'..'z']) = 26, 'CharCount');
- Assert(CharCount([#0, #255]) = 2, 'CharCount');
- // Compare
- Assert(Compare(1, 1) = crEqual, 'Compare');
- Assert(Compare(1, 2) = crLess, 'Compare');
- Assert(Compare(1, 0) = crGreater, 'Compare');
- Assert(Compare(1.0, 1.0) = crEqual, 'Compare');
- Assert(Compare(1.0, 1.1) = crLess, 'Compare');
- Assert(Compare(1.0, 0.9) = crGreater, 'Compare');
- Assert(Compare(False, False) = crEqual, 'Compare');
- Assert(Compare(True, True) = crEqual, 'Compare');
- Assert(Compare(False, True) = crLess, 'Compare');
- Assert(Compare(True, False) = crGreater, 'Compare');
- Assert(CompareA('', '') = crEqual, 'Compare');
- Assert(CompareA('a', 'a') = crEqual, 'Compare');
- Assert(CompareA('a', 'b') = crLess, 'Compare');
- Assert(CompareA('b', 'a') = crGreater, 'Compare');
- Assert(CompareA('', 'a') = crLess, 'Compare');
- Assert(CompareA('a', '') = crGreater, 'Compare');
- Assert(CompareA('aa', 'a') = crGreater, 'Compare');
- Assert(CompareW('', '') = crEqual, 'Compare');
- Assert(CompareW('a', 'a') = crEqual, 'Compare');
- Assert(CompareW('a', 'b') = crLess, 'Compare');
- Assert(CompareW('b', 'a') = crGreater, 'Compare');
- Assert(CompareW('', 'a') = crLess, 'Compare');
- Assert(CompareW('a', '') = crGreater, 'Compare');
- Assert(CompareW('aa', 'a') = crGreater, 'Compare');
- Assert(Sgn(1) = 1, 'Sign');
- Assert(Sgn(0) = 0, 'Sign');
- Assert(Sgn(-1) = -1, 'Sign');
- Assert(Sgn(2) = 1, 'Sign');
- Assert(Sgn(-2) = -1, 'Sign');
- Assert(Sgn(-1.5) = -1, 'Sign');
- Assert(Sgn(1.5) = 1, 'Sign');
- Assert(Sgn(0.0) = 0, 'Sign');
- Assert(ReverseCompareResult(crLess) = crGreater, 'ReverseCompareResult');
- Assert(ReverseCompareResult(crGreater) = crLess, 'ReverseCompareResult');
- end;
- procedure Test_BitFunctions;
- begin
- Assert(SetBit($100F, 5) = $102F, 'SetBit');
- Assert(ClearBit($102F, 5) = $100F, 'ClearBit');
- Assert(ToggleBit($102F, 5) = $100F, 'ToggleBit');
- Assert(ToggleBit($100F, 5) = $102F, 'ToggleBit');
- Assert(IsBitSet($102F, 5), 'IsBitSet');
- Assert(not IsBitSet($100F, 5), 'IsBitSet');
- Assert(IsHighBitSet($80000000), 'IsHighBitSet');
- Assert(not IsHighBitSet($00000001), 'IsHighBitSet');
- Assert(not IsHighBitSet($7FFFFFFF), 'IsHighBitSet');
- Assert(SetBitScanForward(0) = -1, 'SetBitScanForward');
- Assert(SetBitScanForward($1020) = 5, 'SetBitScanForward');
- Assert(SetBitScanReverse($1020) = 12, 'SetBitScanForward');
- Assert(SetBitScanForward($1020, 6) = 12, 'SetBitScanForward');
- Assert(SetBitScanReverse($1020, 11) = 5, 'SetBitScanForward');
- Assert(ClearBitScanForward($FFFFFFFF) = -1, 'ClearBitScanForward');
- Assert(ClearBitScanForward($1020) = 0, 'ClearBitScanForward');
- Assert(ClearBitScanReverse($1020) = 31, 'ClearBitScanForward');
- Assert(ClearBitScanForward($1020, 5) = 6, 'ClearBitScanForward');
- Assert(ClearBitScanReverse($1020, 12) = 11, 'ClearBitScanForward');
- Assert(ReverseBits($12345678) = $1E6A2C48, 'ReverseBits');
- Assert(ReverseBits($1) = $80000000, 'ReverseBits');
- Assert(ReverseBits($80000000) = $1, 'ReverseBits');
- Assert(SwapEndian($12345678) = $78563412, 'SwapEndian');
- Assert(BitCount($12341234) = 10, 'BitCount');
- Assert(IsPowerOfTwo(1), 'IsPowerOfTwo');
- Assert(IsPowerOfTwo(2), 'IsPowerOfTwo');
- Assert(not IsPowerOfTwo(3), 'IsPowerOfTwo');
- Assert(RotateLeftBits32(0, 1) = 0, 'RotateLeftBits32');
- Assert(RotateLeftBits32(1, 0) = 1, 'RotateLeftBits32');
- Assert(RotateLeftBits32(1, 1) = 2, 'RotateLeftBits32');
- Assert(RotateLeftBits32($80000000, 1) = 1, 'RotateLeftBits32');
- Assert(RotateLeftBits32($80000001, 1) = 3, 'RotateLeftBits32');
- Assert(RotateLeftBits32(1, 2) = 4, 'RotateLeftBits32');
- Assert(RotateLeftBits32(1, 31) = $80000000, 'RotateLeftBits32');
- Assert(RotateLeftBits32(5, 2) = 20, 'RotateLeftBits32');
- Assert(RotateRightBits32(0, 1) = 0, 'RotateRightBits32');
- Assert(RotateRightBits32(1, 0) = 1, 'RotateRightBits32');
- Assert(RotateRightBits32(1, 1) = $80000000, 'RotateRightBits32');
- Assert(RotateRightBits32(2, 1) = 1, 'RotateRightBits32');
- Assert(RotateRightBits32(4, 2) = 1, 'RotateRightBits32');
- Assert(LowBitMask(10) = $3FF, 'LowBitMask');
- Assert(HighBitMask(28) = $F0000000, 'HighBitMask');
- Assert(RangeBitMask(2, 6) = $7C, 'RangeBitMask');
- Assert(SetBitRange($101, 2, 6) = $17D, 'SetBitRange');
- Assert(ClearBitRange($17D, 2, 6) = $101, 'ClearBitRange');
- Assert(ToggleBitRange($17D, 2, 6) = $101, 'ToggleBitRange');
- Assert(IsBitRangeSet($17D, 2, 6), 'IsBitRangeSet');
- Assert(not IsBitRangeSet($101, 2, 6), 'IsBitRangeSet');
- Assert(not IsBitRangeClear($17D, 2, 6), 'IsBitRangeClear');
- Assert(IsBitRangeClear($101, 2, 6), 'IsBitRangeClear');
- end;
- procedure Test_Float;
- {$IFNDEF ExtendedIsDouble}
- var E : Integer;
- {$ENDIF}
- begin
- Assert(not FloatZero(1e-1, 1e-2), 'FloatZero');
- Assert(FloatZero(1e-2, 1e-2), 'FloatZero');
- Assert(not FloatZero(1e-1, 1e-9), 'FloatZero');
- Assert(not FloatZero(1e-8, 1e-9), 'FloatZero');
- Assert(FloatZero(1e-9, 1e-9), 'FloatZero');
- Assert(FloatZero(1e-10, 1e-9), 'FloatZero');
- Assert(not FloatZero(0.2, 1e-1), 'FloatZero');
- Assert(FloatZero(0.09, 1e-1), 'FloatZero');
- Assert(FloatOne(1.0, 1e-1), 'FloatOne');
- Assert(FloatOne(1.09999, 1e-1), 'FloatOne');
- Assert(FloatOne(0.90001, 1e-1), 'FloatOne');
- Assert(not FloatOne(1.10001, 1e-1), 'FloatOne');
- Assert(not FloatOne(1.2, 1e-1), 'FloatOne');
- Assert(not FloatOne(0.89999, 1e-1), 'FloatOne');
- Assert(not FloatsEqual(2.0, -2.0, 1e-1), 'FloatsEqual');
- Assert(not FloatsEqual(1.0, 0.0, 1e-1), 'FloatsEqual');
- Assert(FloatsEqual(2.0, 2.0, 1e-1), 'FloatsEqual');
- Assert(FloatsEqual(2.0, 2.09, 1e-1), 'FloatsEqual');
- Assert(FloatsEqual(2.0, 1.90000001, 1e-1), 'FloatsEqual');
- Assert(not FloatsEqual(2.0, 2.10001, 1e-1), 'FloatsEqual');
- Assert(not FloatsEqual(2.0, 2.2, 1e-1), 'FloatsEqual');
- Assert(not FloatsEqual(2.0, 1.8999999, 1e-1), 'FloatsEqual');
- Assert(FloatsEqual(2.00000000011, 2.0, 1e-2), 'FloatsEqual');
- Assert(FloatsEqual(2.00000000011, 2.0, 1e-9), 'FloatsEqual');
- Assert(not FloatsEqual(2.00000000011, 2.0, 1e-10), 'FloatsEqual');
- Assert(not FloatsEqual(2.00000000011, 2.0, 1e-11), 'FloatsEqual');
- {$IFNDEF ExtendedIsDouble}
- Assert(FloatsCompare(0.0, 0.0, MinExtended) = crEqual, 'FloatsCompare');
- Assert(FloatsCompare(1.2, 1.2, MinExtended) = crEqual, 'FloatsCompare');
- Assert(FloatsCompare(1.23456789e-300, 1.23456789e-300, MinExtended) = crEqual, 'FloatsCompare');
- Assert(FloatsCompare(1.23456780e-300, 1.23456789e-300, MinExtended) = crLess, 'FloatsCompare');
- {$ENDIF}
- Assert(FloatsCompare(1.4e-5, 1.5e-5, 1e-4) = crEqual, 'FloatsCompare');
- Assert(FloatsCompare(1.4e-5, 1.5e-5, 1e-5) = crEqual, 'FloatsCompare');
- Assert(FloatsCompare(1.4e-5, 1.5e-5, 1e-6) = crLess, 'FloatsCompare');
- Assert(FloatsCompare(1.4e-5, 1.5e-5, 1e-7) = crLess, 'FloatsCompare');
- Assert(FloatsCompare(0.5003, 0.5001, 1e-1) = crEqual, 'FloatsCompare');
- Assert(FloatsCompare(0.5003, 0.5001, 1e-2) = crEqual, 'FloatsCompare');
- Assert(FloatsCompare(0.5003, 0.5001, 1e-3) = crEqual, 'FloatsCompare');
- Assert(FloatsCompare(0.5003, 0.5001, 1e-4) = crGreater, 'FloatsCompare');
- Assert(FloatsCompare(0.5003, 0.5001, 1e-5) = crGreater, 'FloatsCompare');
- {$IFNDEF ExtendedIsDouble}
- Assert(ApproxEqual(0.0, 0.0), 'ApproxEqual');
- Assert(not ApproxEqual(0.0, 1e-100, 1e-10), 'ApproxEqual');
- Assert(not ApproxEqual(1.0, 1e-100, 1e-10), 'ApproxEqual');
- Assert(ApproxEqual(1.0, 1.0), 'ApproxEqual');
- Assert(ApproxEqual(-1.0, -1.0), 'ApproxEqual');
- Assert(not ApproxEqual(1.0, -1.0), 'ApproxEqual');
- Assert(ApproxEqual(1e-100, 1e-100, 1e-10), 'ApproxEqual');
- Assert(not ApproxEqual(0.0, 1.0, 1e-9), 'ApproxEqual');
- Assert(not ApproxEqual(-1.0, 1.0, 1e-9), 'ApproxEqual');
- Assert(ApproxEqual(0.12345, 0.12349, 1e-3), 'ApproxEqual');
- Assert(not ApproxEqual(0.12345, 0.12349, 1e-4), 'ApproxEqual');
- Assert(not ApproxEqual(0.12345, 0.12349, 1e-5), 'ApproxEqual');
- Assert(ApproxEqual(1.2345e+100, 1.2349e+100, 1e-3), 'ApproxEqual');
- Assert(not ApproxEqual(1.2345e+100, 1.2349e+100, 1e-4), 'ApproxEqual');
- Assert(not ApproxEqual(1.2345e+100, 1.2349e+100, 1e-5), 'ApproxEqual');
- Assert(ApproxEqual(1.2345e-100, 1.2349e-100, 1e-3), 'ApproxEqual');
- Assert(not ApproxEqual(1.2345e-100, 1.2349e-100, 1e-4), 'ApproxEqual');
- Assert(not ApproxEqual(1.2345e-100, 1.2349e-100, 1e-5), 'ApproxEqual');
- Assert(not ApproxEqual(1.0e+20, 1.00000001E+20, 1e-8), 'ApproxEqual');
- Assert(ApproxEqual(1.0e+20, 1.000000001E+20, 1e-8), 'ApproxEqual');
- Assert(not ApproxEqual(1.0e+20, 1.000000001E+20, 1e-9), 'ApproxEqual');
- Assert(ApproxEqual(1.0e+20, 1.0000000001E+20, 1e-9), 'ApproxEqual');
- Assert(not ApproxEqual(1.0e+20, 1.0000000001E+20, 1e-10), 'ApproxEqual');
- Assert(ApproxCompare(0.0, 0.0) = crEqual, 'ApproxCompare');
- Assert(ApproxCompare(0.0, 1.0) = crLess, 'ApproxCompare');
- Assert(ApproxCompare(1.0, 0.0) = crGreater, 'ApproxCompare');
- Assert(ApproxCompare(-1.0, 1.0) = crLess, 'ApproxCompare');
- Assert(ApproxCompare(1.2345e+10, 1.2349e+10, 1e-3) = crEqual, 'ApproxCompare');
- Assert(ApproxCompare(1.2345e+10, 1.2349e+10, 1e-4) = crLess, 'ApproxCompare');
- Assert(ApproxCompare(-1.2345e-10, -1.2349e-10, 1e-3) = crEqual, 'ApproxCompare');
- Assert(ApproxCompare(-1.2345e-10, -1.2349e-10, 1e-4) = crGreater, 'ApproxCompare');
- {$ENDIF}
- {$IFNDEF ExtendedIsDouble}
- Assert(FloatExponentBase10(1.0, E), 'FloatExponent');
- Assert(E = 0, 'FloatExponent');
- Assert(FloatExponentBase10(10.0, E), 'FloatExponent');
- Assert(E = 1, 'FloatExponent');
- Assert(FloatExponentBase10(0.1, E), 'FloatExponent');
- Assert(E = -1, 'FloatExponent');
- Assert(FloatExponentBase10(1e100, E), 'FloatExponent');
- Assert(E = 100, 'FloatExponent');
- Assert(FloatExponentBase10(1e-100, E), 'FloatExponent');
- Assert(E = -100, 'FloatExponent');
- Assert(FloatExponentBase10(0.999, E), 'FloatExponent');
- Assert(E = 0, 'FloatExponent');
- Assert(FloatExponentBase10(-0.999, E), 'FloatExponent');
- Assert(E = 0, 'FloatExponent');
- {$ENDIF}
- end;
- procedure Test_IntStr;
- var I : Int64;
- W : LongWord;
- L : Integer;
- A : AnsiString;
- begin
- Assert(HexCharToInt('A') = 10, 'HexCharToInt');
- Assert(HexCharToInt('a') = 10, 'HexCharToInt');
- Assert(HexCharToInt('1') = 1, 'HexCharToInt');
- Assert(HexCharToInt('0') = 0, 'HexCharToInt');
- Assert(HexCharToInt('F') = 15, 'HexCharToInt');
- Assert(HexCharToInt('G') = -1, 'HexCharToInt');
- Assert(IntToStringA(0) = '0', 'IntToAnsiString');
- Assert(IntToStringA(1) = '1', 'IntToAnsiString');
- Assert(IntToStringA(-1) = '-1', 'IntToAnsiString');
- Assert(IntToStringA(10) = '10', 'IntToAnsiString');
- Assert(IntToStringA(-10) = '-10', 'IntToAnsiString');
- Assert(IntToStringA(123) = '123', 'IntToAnsiString');
- Assert(IntToStringA(-123) = '-123', 'IntToAnsiString');
- Assert(IntToStringW(0) = '0', 'IntToWideString');
- Assert(IntToStringW(1) = '1', 'IntToWideString');
- Assert(IntToStringW(-1) = '-1', 'IntToWideString');
- Assert(IntToStringW(1234567890) = '1234567890', 'IntToWideString');
- Assert(IntToStringW(-1234567890) = '-1234567890', 'IntToWideString');
- Assert(IntToStringU(0) = '0', 'IntToString');
- Assert(IntToStringU(1) = '1', 'IntToString');
- Assert(IntToStringU(-1) = '-1', 'IntToString');
- Assert(IntToStringU(1234567890) = '1234567890', 'IntToString');
- Assert(IntToStringU(-1234567890) = '-1234567890', 'IntToString');
- Assert(IntToString(0) = '0', 'IntToString');
- Assert(IntToString(1) = '1', 'IntToString');
- Assert(IntToString(-1) = '-1', 'IntToString');
- Assert(IntToString(1234567890) = '1234567890', 'IntToString');
- Assert(IntToString(-1234567890) = '-1234567890', 'IntToString');
- Assert(UIntToStringA(0) = '0', 'UIntToString');
- Assert(UIntToStringA($FFFFFFFF) = '4294967295', 'UIntToString');
- Assert(UIntToStringW(0) = '0', 'UIntToString');
- Assert(UIntToStringW($FFFFFFFF) = '4294967295', 'UIntToString');
- Assert(UIntToStringU(0) = '0', 'UIntToString');
- Assert(UIntToStringU($FFFFFFFF) = '4294967295', 'UIntToString');
- Assert(UIntToString(0) = '0', 'UIntToString');
- Assert(UIntToString($FFFFFFFF) = '4294967295', 'UIntToString');
- Assert(LongWordToStrA(0, 8) = '00000000', 'LongWordToStr');
- Assert(LongWordToStrA($FFFFFFFF, 0) = '4294967295', 'LongWordToStr');
- Assert(LongWordToStrW(0, 8) = '00000000', 'LongWordToStr');
- Assert(LongWordToStrW($FFFFFFFF, 0) = '4294967295', 'LongWordToStr');
- Assert(LongWordToStrU(0, 8) = '00000000', 'LongWordToStr');
- Assert(LongWordToStrU($FFFFFFFF, 0) = '4294967295', 'LongWordToStr');
- Assert(LongWordToStr(0, 8) = '00000000', 'LongWordToStr');
- Assert(LongWordToStr($FFFFFFFF, 0) = '4294967295', 'LongWordToStr');
- Assert(LongWordToStr(123) = '123', 'LongWordToStr');
- Assert(LongWordToStr(10000) = '10000', 'LongWordToStr');
- Assert(LongWordToStr(99999) = '99999', 'LongWordToStr');
- Assert(LongWordToStr(1, 1) = '1', 'LongWordToStr');
- Assert(LongWordToStr(1, 3) = '001', 'LongWordToStr');
- Assert(LongWordToStr(1234, 3) = '1234', 'LongWordToStr');
- Assert(LongWordToHexA(0, 8) = '00000000', 'LongWordToHex');
- Assert(LongWordToHexA($FFFFFFFF, 0) = 'FFFFFFFF', 'LongWordToHex');
- Assert(LongWordToHexA($10000) = '10000', 'LongWordToHex');
- Assert(LongWordToHexA($12345678) = '12345678', 'LongWordToHex');
- Assert(LongWordToHexA($AB, 4) = '00AB', 'LongWordToHex');
- Assert(LongWordToHexA($ABCD, 8) = '0000ABCD', 'LongWordToHex');
- Assert(LongWordToHexA($CDEF, 2) = 'CDEF', 'LongWordToHex');
- Assert(LongWordToHexA($ABC3, 0, False) = 'abc3', 'LongWordToHex');
- Assert(LongWordToHexW(0, 8) = '00000000', 'LongWordToHex');
- Assert(LongWordToHexW(0) = '0', 'LongWordToHex');
- Assert(LongWordToHexW($FFFFFFFF, 0) = 'FFFFFFFF', 'LongWordToHex');
- Assert(LongWordToHexW($AB, 4) = '00AB', 'LongWordToHex');
- Assert(LongWordToHexW($ABC3, 0, False) = 'abc3', 'LongWordToHex');
- Assert(LongWordToHexU(0, 8) = '00000000', 'LongWordToHex');
- Assert(LongWordToHexU(0) = '0', 'LongWordToHex');
- Assert(LongWordToHexU($FFFFFFFF, 0) = 'FFFFFFFF', 'LongWordToHex');
- Assert(LongWordToHexU($AB, 4) = '00AB', 'LongWordToHex');
- Assert(LongWordToHexU($ABC3, 0, False) = 'abc3', 'LongWordToHex');
- Assert(LongWordToHex(0, 8) = '00000000', 'LongWordToHex');
- Assert(LongWordToHex($FFFFFFFF, 0) = 'FFFFFFFF', 'LongWordToHex');
- Assert(LongWordToHex(0) = '0', 'LongWordToHex');
- Assert(LongWordToHex($ABCD, 8) = '0000ABCD', 'LongWordToHex');
- Assert(LongWordToHex($ABC3, 0, False) = 'abc3', 'LongWordToHex');
- Assert(StringToIntA('0') = 0, 'StringToInt');
- Assert(StringToIntA('1') = 1, 'StringToInt');
- Assert(StringToIntA('-1') = -1, 'StringToInt');
- Assert(StringToIntA('10') = 10, 'StringToInt');
- Assert(StringToIntA('01') = 1, 'StringToInt');
- Assert(StringToIntA('-10') = -10, 'StringToInt');
- Assert(StringToIntA('-01') = -1, 'StringToInt');
- Assert(StringToIntA('123') = 123, 'StringToInt');
- Assert(StringToIntA('-123') = -123, 'StringToInt');
- Assert(StringToIntW('321') = 321, 'StringToInt');
- Assert(StringToIntW('-321') = -321, 'StringToInt');
- Assert(StringToIntU('321') = 321, 'StringToInt');
- Assert(StringToIntU('-321') = -321, 'StringToInt');
- A := '-012A';
- Assert(TryStringToInt64PA(PAnsiChar(A), Length(A), I, L) = convertOK, 'StringToInt');
- Assert((I = -12) and (L = 4), 'StringToInt');
- A := '-A012';
- Assert(TryStringToInt64PA(PAnsiChar(A), Length(A), I, L) = convertFormatError, 'StringToInt');
- Assert((I = 0) and (L = 1), 'StringToInt');
- Assert(TryStringToInt64A('0', I), 'StringToInt');
- Assert(I = 0, 'StringToInt');
- Assert(TryStringToInt64A('-0', I), 'StringToInt');
- Assert(I = 0, 'StringToInt');
- Assert(TryStringToInt64A('+0', I), 'StringToInt');
- Assert(I = 0, 'StringToInt');
- Assert(TryStringToInt64A('1234', I), 'StringToInt');
- Assert(I = 1234, 'StringToInt');
- Assert(TryStringToInt64A('-1234', I), 'StringToInt');
- Assert(I = -1234, 'StringToInt');
- Assert(TryStringToInt64A('000099999', I), 'StringToInt');
- Assert(I = 99999, 'StringToInt');
- Assert(TryStringToInt64A('999999999999999999', I), 'StringToInt');
- Assert(I = 999999999999999999, 'StringToInt');
- Assert(TryStringToInt64A('-999999999999999999', I), 'StringToInt');
- Assert(I = -999999999999999999, 'StringToInt');
- Assert(TryStringToInt64A('4294967295', I), 'StringToInt');
- Assert(I = $FFFFFFFF, 'StringToInt');
- Assert(TryStringToInt64A('4294967296', I), 'StringToInt');
- Assert(I = $100000000, 'StringToInt');
- Assert(TryStringToInt64A('9223372036854775807', I), 'StringToInt');
- Assert(I = 9223372036854775807, 'StringToInt');
- {$IFNDEF DELPHI7_DOWN}
- Assert(TryStringToInt64A('-9223372036854775808', I), 'StringToInt');
- Assert(I = -9223372036854775808, 'StringToInt');
- {$ENDIF}
- Assert(not TryStringToInt64A('', I), 'StringToInt');
- Assert(not TryStringToInt64A('-', I), 'StringToInt');
- Assert(not TryStringToInt64A('+', I), 'StringToInt');
- Assert(not TryStringToInt64A('+-0', I), 'StringToInt');
- Assert(not TryStringToInt64A('0A', I), 'StringToInt');
- Assert(not TryStringToInt64A('1A', I), 'StringToInt');
- Assert(not TryStringToInt64A(' 0', I), 'StringToInt');
- Assert(not TryStringToInt64A('0 ', I), 'StringToInt');
- Assert(not TryStringToInt64A('9223372036854775808', I), 'StringToInt');
- {$IFNDEF DELPHI7_DOWN}
- Assert(not TryStringToInt64A('-9223372036854775809', I), 'StringToInt');
- {$ENDIF}
- Assert(TryStringToInt64W('9223372036854775807', I), 'StringToInt');
- Assert(I = 9223372036854775807, 'StringToInt');
- {$IFNDEF DELPHI7_DOWN}
- Assert(TryStringToInt64W('-9223372036854775808', I), 'StringToInt');
- Assert(I = -9223372036854775808, 'StringToInt');
- {$ENDIF}
- Assert(not TryStringToInt64W('', I), 'StringToInt');
- Assert(not TryStringToInt64W('-', I), 'StringToInt');
- Assert(not TryStringToInt64W('0A', I), 'StringToInt');
- Assert(not TryStringToInt64W('9223372036854775808', I), 'StringToInt');
- {$IFNDEF DELPHI7_DOWN}
- Assert(not TryStringToInt64W('-9223372036854775809', I), 'StringToInt');
- {$ENDIF}
- Assert(TryStringToInt64U('9223372036854775807', I), 'StringToInt');
- Assert(I = 9223372036854775807, 'StringToInt');
- {$IFNDEF DELPHI7_DOWN}
- Assert(TryStringToInt64U('-9223372036854775808', I), 'StringToInt');
- Assert(I = -9223372036854775808, 'StringToInt');
- {$ENDIF}
- Assert(not TryStringToInt64U('', I), 'StringToInt');
- Assert(not TryStringToInt64U('-', I), 'StringToInt');
- Assert(not TryStringToInt64U('0A', I), 'StringToInt');
- Assert(not TryStringToInt64U('9223372036854775808', I), 'StringToInt');
- {$IFNDEF DELPHI7_DOWN}
- Assert(not TryStringToInt64U('-9223372036854775809', I), 'StringToInt');
- {$ENDIF}
- Assert(TryStringToInt64('9223372036854775807', I), 'StringToInt');
- Assert(I = 9223372036854775807, 'StringToInt');
- {$IFNDEF DELPHI7_DOWN}
- Assert(TryStringToInt64('-9223372036854775808', I), 'StringToInt');
- Assert(I = -9223372036854775808, 'StringToInt');
- {$ENDIF}
- Assert(not TryStringToInt64('', I), 'StringToInt');
- Assert(not TryStringToInt64('-', I), 'StringToInt');
- Assert(not TryStringToInt64('9223372036854775808', I), 'StringToInt');
- {$IFNDEF DELPHI7_DOWN}
- Assert(not TryStringToInt64('-9223372036854775809', I), 'StringToInt');
- {$ENDIF}
- Assert(HexToUIntA('FFFFFFFF') = $FFFFFFFF, 'HexStringToUInt');
- Assert(HexToUIntA('FFFFFFFF') = $FFFFFFFF, 'HexStringToUInt');
- Assert(HexToUInt('FFFFFFFF') = $FFFFFFFF, 'HexStringToUInt');
- Assert(HexToLongWord('FFFFFFFF') = $FFFFFFFF, 'HexToLongWord');
- Assert(HexToLongWord('0') = 0, 'HexToLongWord');
- Assert(HexToLongWord('123456') = $123456, 'HexToLongWord');
- Assert(HexToLongWord('ABC') = $ABC, 'HexToLongWord');
- Assert(HexToLongWord('abc') = $ABC, 'HexToLongWord');
- Assert(not TryHexToLongWord('', W), 'HexToLongWord');
- Assert(not TryHexToLongWord('x', W), 'HexToLongWord');
- Assert(HexToLongWordA('FFFFFFFF') = $FFFFFFFF, 'HexToLongWord');
- Assert(HexToLongWordA('0') = 0, 'HexToLongWord');
- Assert(HexToLongWordA('ABC') = $ABC, 'HexToLongWord');
- Assert(HexToLongWordA('abc') = $ABC, 'HexToLongWord');
- Assert(not TryHexToLongWordA('', W), 'HexToLongWord');
- Assert(not TryHexToLongWordA('x', W), 'HexToLongWord');
- Assert(HexToLongWordW('FFFFFFFF') = $FFFFFFFF, 'HexToLongWord');
- Assert(HexToLongWordW('0') = 0, 'HexToLongWord');
- Assert(HexToLongWordW('123456') = $123456, 'HexToLongWord');
- Assert(HexToLongWordW('ABC') = $ABC, 'HexToLongWord');
- Assert(HexToLongWordW('abc') = $ABC, 'HexToLongWord');
- Assert(not TryHexToLongWordW('', W), 'HexToLongWord');
- Assert(not TryHexToLongWordW('x', W), 'HexToLongWord');
- Assert(HexToLongWordU('FFFFFFFF') = $FFFFFFFF, 'HexToLongWord');
- Assert(HexToLongWordU('0') = 0, 'HexToLongWord');
- Assert(HexToLongWordU('123456') = $123456, 'HexToLongWord');
- Assert(HexToLongWordU('ABC') = $ABC, 'HexToLongWord');
- Assert(HexToLongWordU('abc') = $ABC, 'HexToLongWord');
- Assert(not TryHexToLongWordU('', W), 'HexToLongWord');
- Assert(not TryHexToLongWordU('x', W), 'HexToLongWord');
- Assert(not TryStringToLongWordA('', W), 'StringToLongWord');
- Assert(StringToLongWordA('123') = 123, 'StringToLongWord');
- Assert(StringToLongWordA('4294967295') = $FFFFFFFF, 'StringToLongWord');
- Assert(StringToLongWordA('999999999') = 999999999, 'StringToLongWord');
- Assert(StringToLongWordW('0') = 0, 'StringToLongWord');
- Assert(StringToLongWordW('4294967295') = $FFFFFFFF, 'StringToLongWord');
- Assert(StringToLongWordU('0') = 0, 'StringToLongWord');
- Assert(StringToLongWordU('4294967295') = $FFFFFFFF, 'StringToLongWord');
- Assert(StringToLongWord('0') = 0, 'StringToLongWord');
- Assert(StringToLongWord('4294967295') = $FFFFFFFF, 'StringToLongWord');
- end;
- procedure Test_FloatStr;
- var A : AnsiString;
- E : Extended;
- L : Integer;
- begin
- // FloatToStr
- {$IFNDEF FREEPASCAL}
- Assert(FloatToStringA(0.0) = '0');
- Assert(FloatToStringA(-1.5) = '-1.5');
- Assert(FloatToStringA(1.5) = '1.5');
- Assert(FloatToStringA(1.1) = '1.1');
- Assert(FloatToStringA(123) = '123');
- Assert(FloatToStringA(0.00000000000001) = '0.00000000000001');
- Assert(FloatToStringA(0.000000000000001) = '0.000000000000001');
- Assert(FloatToStringA(0.0000000000000001) = '1E-0016');
- Assert(FloatToStringA(0.0000000000000012345) = '0.000000000000001');
- Assert(FloatToStringA(0.00000000000000012345) = '1.2345E-0016');
- {$IFNDEF ExtendedIsDouble}
- Assert(FloatToStringA(123456789.123456789) = '123456789.123456789');
- Assert(FloatToStringA(123456789012345.1234567890123456789) = '123456789012345.1234');
- Assert(FloatToStringA(1234567890123456.1234567890123456789) = '1.23456789012346E+0015');
- {$ENDIF}
- Assert(FloatToStringA(0.12345) = '0.12345');
- Assert(FloatToStringA(1e100) = '1E+0100');
- Assert(FloatToStringA(1.234e+100) = '1.234E+0100');
- Assert(FloatToStringA(-1.5e-100) = '-1.5E-0100');
- {$IFNDEF ExtendedIsDouble}
- Assert(FloatToStringA(1.234e+1000) = '1.234E+1000');
- Assert(FloatToStringA(-1e-4000) = '0');
- {$ENDIF}
- Assert(FloatToStringW(0.0) = '0');
- Assert(FloatToStringW(-1.5) = '-1.5');
- Assert(FloatToStringW(1.5) = '1.5');
- Assert(FloatToStringW(1.1) = '1.1');
- {$IFNDEF ExtendedIsDouble}
- Assert(FloatToStringW(123456789.123456789) = '123456789.123456789');
- Assert(FloatToStringW(123456789012345.1234567890123456789) = '123456789012345.1234');
- Assert(FloatToStringW(1234567890123456.1234567890123456789) = '1.23456789012346E+0015');
- {$ENDIF}
- Assert(FloatToStringW(0.12345) = '0.12345');
- Assert(FloatToStringW(1e100) = '1E+0100');
- Assert(FloatToStringW(1.234e+100) = '1.234E+0100');
- Assert(FloatToStringW(1.5e-100) = '1.5E-0100');
- Assert(FloatToStringU(0.0) = '0');
- Assert(FloatToStringU(-1.5) = '-1.5');
- Assert(FloatToStringU(1.5) = '1.5');
- Assert(FloatToStringU(1.1) = '1.1');
- {$IFNDEF ExtendedIsDouble}
- Assert(FloatToStringU(123456789.123456789) = '123456789.123456789');
- Assert(FloatToStringU(123456789012345.1234567890123456789) = '123456789012345.1234');
- Assert(FloatToStringU(1234567890123456.1234567890123456789) = '1.23456789012346E+0015');
- {$ENDIF}
- Assert(FloatToStringU(0.12345) = '0.12345');
- Assert(FloatToStringU(1e100) = '1E+0100');
- Assert(FloatToStringU(1.234e+100) = '1.234E+0100');
- Assert(FloatToStringU(1.5e-100) = '1.5E-0100');
- Assert(FloatToString(0.0) = '0');
- Assert(FloatToString(-1.5) = '-1.5');
- Assert(FloatToString(1.5) = '1.5');
- Assert(FloatToString(1.1) = '1.1');
- {$IFNDEF ExtendedIsDouble}
- Assert(FloatToString(123456789.123456789) = '123456789.123456789');
- Assert(FloatToString(123456789012345.1234567890123456789) = '123456789012345.1234');
- Assert(FloatToString(1234567890123456.1234567890123456789) = '1.23456789012346E+0015');
- {$ENDIF}
- Assert(FloatToString(0.12345) = '0.12345');
- Assert(FloatToString(1e100) = '1E+0100');
- Assert(FloatToString(1.234e+100) = '1.234E+0100');
- Assert(FloatToString(1.5e-100) = '1.5E-0100');
- {$ENDIF}
- // StrToFloat
- A := '123.456';
- Assert(TryStringToFloatPA(PAnsiChar(A), Length(A), E, L) = convertOK);
- Assert((E = 123.456) and (L = 7));
- A := '-000.500A';
- Assert(TryStringToFloatPA(PAnsiChar(A), Length(A), E, L) = convertOK);
- Assert((E = -0.5) and (L = 8));
- A := '1.234e+002X';
- Assert(TryStringToFloatPA(PAnsiChar(A), Length(A), E, L) = convertOK);
- Assert((E = 123.4) and (L = 10));
- A := '1.2e300x';
- Assert(TryStringToFloatPA(PAnsiChar(A), Length(A), E, L) = convertOK);
- {$IFNDEF ExtendedIsDouble}
- Assert(ApproxEqual(E, 1.2e300, 1e-2) and (L = 7));
- {$ENDIF}
- A := '1.2e-300e';
- Assert(TryStringToFloatPA(PAnsiChar(A), Length(A), E, L) = convertOK);
- {$IFNDEF ExtendedIsDouble}
- Assert(ApproxEqual(E, 1.2e-300, 1e-2) and (L = 8));
- {$ENDIF}
- // 9999..9999 overflow
- {$IFNDEF ExtendedIsDouble}
- A := '';
- for L := 1 to 5000 do
- A := A + '9';
- Assert(TryStringToFloatPA(PAnsiChar(A), Length(A), E, L) = convertOverflow);
- Assert((E = 0.0) and (L >= 200));
- {$ENDIF}
- // 1200..0000
- {$IFNDEF ExtendedIsDouble}
- A := '12';
- for L := 1 to 100 do
- A := A + '0';
- Assert(TryStringToFloatPA(PAnsiChar(A), Length(A), E, L) = convertOK);
- Assert(ApproxEqual(E, 1.2e+101, 1e-2) and (L = 102));
- {$ENDIF}
- // 0.0000..0001 overflow
- {$IFNDEF ExtendedIsDouble}
- A := '0.';
- for L := 1 to 5000 do
- A := A + '0';
- A := A + '1';
- Assert(TryStringToFloatPA(PAnsiChar(A), Length(A), E, L) = convertOverflow);
- Assert((E = 0.0) and (L >= 500));
- {$ENDIF}
- // 0.0000..000123
- {$IFNDEF ExtendedIsDouble}
- A := '0.';
- for L := 1 to 100 do
- A := A + '0';
- A := A + '123';
- Assert(TryStringToFloatPA(PAnsiChar(A), Length(A), E, L) = convertOK);
- Assert(ApproxEqual(E, 1.23e-101, 1e-3) and (L = 105));
- {$ENDIF}
- // 1200..0000e100
- {$IFNDEF ExtendedIsDouble}
- A := '12';
- for L := 1 to 100 do
- A := A + '0';
- A := A + 'e100';
- Assert(TryStringToFloatPA(PAnsiChar(A), Length(A), E, L) = convertOK);
- Assert(ApproxEqual(E, 1.2e+201, 1e-1) and (L = 106));
- {$ENDIF}
- Assert(StringToFloatA('0') = 0.0);
- Assert(StringToFloatA('1') = 1.0);
- Assert(StringToFloatA('1.5') = 1.5);
- Assert(StringToFloatA('+1.5') = 1.5);
- Assert(StringToFloatA('-1.5') = -1.5);
- Assert(StringToFloatA('1.1') = 1.1);
- Assert(StringToFloatA('-00.00') = 0.0);
- Assert(StringToFloatA('+00.00') = 0.0);
- Assert(StringToFloatA('0000000000000000000000001.1000000000000000000000000') = 1.1);
- Assert(StringToFloatA('.5') = 0.5);
- Assert(StringToFloatA('-.5') = -0.5);
- {$IFNDEF ExtendedIsDouble}
- Assert(ApproxEqual(StringToFloatA('1.123456789'), 1.123456789, 1e-10));
- Assert(ApproxEqual(StringToFloatA('123456789.123456789'), 123456789.123456789, 1e-10));
- Assert(ApproxEqual(StringToFloatA('1.5e500'), 1.5e500, 1e-2));
- Assert(ApproxEqual(StringToFloatA('+1.5e+500'), 1.5e500, 1e-2));
- Assert(ApproxEqual(StringToFloatA('1.2E-500'), 1.2e-500, 1e-2));
- Assert(ApproxEqual(StringToFloatA('-1.2E-500'), -1.2e-500, 1e-2));
- Assert(ApproxEqual(StringToFloatA('-1.23456789E-500'), -1.23456789e-500, 1e-9));
- {$ENDIF}
- Assert(not TryStringToFloatA('', E));
- Assert(not TryStringToFloatA('+', E));
- Assert(not TryStringToFloatA('-', E));
- Assert(not TryStringToFloatA('.', E));
- Assert(not TryStringToFloatA(' ', E));
- Assert(not TryStringToFloatA(' 0', E));
- Assert(not TryStringToFloatA('0 ', E));
- Assert(not TryStringToFloatA('--0', E));
- Assert(not TryStringToFloatA('0X', E));
- end;
- procedure Test_Hash;
- begin
- // HashStr
- Assert(HashStrA('Fundamentals') = $3FB7796E, 'HashStr');
- Assert(HashStrA('0') = $B2420DE, 'HashStr');
- Assert(HashStrA('Fundamentals', 1, -1, False) = HashStrA('FUNdamentals', 1, -1, False), 'HashStr');
- Assert(HashStrA('Fundamentals', 1, -1, True) <> HashStrA('FUNdamentals', 1, -1, True), 'HashStr');
- Assert(HashStrW('Fundamentals') = $FD6ED837, 'HashStr');
- Assert(HashStrW('0') = $6160DBF3, 'HashStr');
- Assert(HashStrW('Fundamentals', 1, -1, False) = HashStrW('FUNdamentals', 1, -1, False), 'HashStr');
- Assert(HashStrW('Fundamentals', 1, -1, True) <> HashStrW('FUNdamentals', 1, -1, True), 'HashStr');
- {$IFDEF StringIsUnicode}
- Assert(HashStr('Fundamentals') = $FD6ED837, 'HashStr');
- Assert(HashStr('0') = $6160DBF3, 'HashStr');
- {$ELSE}
- Assert(HashStr('Fundamentals') = $3FB7796E, 'HashStr');
- Assert(HashStr('0') = $B2420DE, 'HashStr');
- {$ENDIF}
- Assert(HashStr('Fundamentals', 1, -1, False) = HashStr('FUNdamentals', 1, -1, False), 'HashStr');
- Assert(HashStr('Fundamentals', 1, -1, True) <> HashStr('FUNdamentals', 1, -1, True), 'HashStr');
- end;
- {$IFNDEF ManagedCode}
- procedure Test_Memory;
- var I, J : Integer;
- A, B : AnsiString;
- begin
- for I := -1 to 33 do
- begin
- A := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
- B := ' ';
- MoveMem(A[1], B[1], I);
- for J := 1 to MinI(I, 10) do
- Assert(B[J] = AnsiChar(48 + J - 1), 'MoveMem');
- for J := 11 to MinI(I, 36) do
- Assert(B[J] = AnsiChar(65 + J - 11), 'MoveMem');
- for J := MaxI(I + 1, 1) to 36 do
- Assert(B[J] = ' ', 'MoveMem');
- Assert(CompareMem(A[1], B[1], I), 'CompareMem');
- end;
- for J := 1000 to 1500 do
- begin
- SetLength(A, 4096);
- for I := 1 to 4096 do
- A[I] := 'A';
- SetLength(B, 4096);
- for I := 1 to 4096 do
- B[I] := 'B';
- MoveMem(A[1], B[1], J);
- for I := 1 to J do
- Assert(B[I] = 'A', 'MoveMem');
- for I := J + 1 to 4096 do
- Assert(B[I] = 'B', 'MoveMem');
- Assert(CompareMem(A[1], B[1], J), 'CompareMem');
- end;
- B := '1234567890';
- MoveMem(B[1], B[3], 4);
- Assert(B = '1212347890', 'MoveMem');
- MoveMem(B[3], B[2], 4);
- Assert(B = '1123447890', 'MoveMem');
- MoveMem(B[1], B[3], 2);
- Assert(B = '1111447890', 'MoveMem');
- MoveMem(B[5], B[7], 3);
- Assert(B = '1111444470', 'MoveMem');
- MoveMem(B[9], B[10], 1);
- Assert(B = '1111444477', 'MoveMem');
- for I := -1 to 33 do
- begin
- A := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
- ZeroMem(A[1], I);
- for J := 1 to I do
- Assert(A[J] = #0, 'ZeroMem');
- for J := MaxI(I + 1, 1) to 10 do
- Assert(A[J] = AnsiChar(48 + J - 1), 'ZeroMem');
- for J := MaxI(I + 1, 11) to 36 do
- Assert(A[J] = AnsiChar(65 + J - 11), 'ZeroMem');
- end;
- for I := -1 to 33 do
- begin
- A := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
- FillMem(A[1], I, Ord('!'));
- for J := 1 to I do
- Assert(A[J] = '!', 'FillMem');
- for J := MaxI(I + 1, 1) to 10 do
- Assert(A[J] = AnsiChar(48 + J - 1), 'FillMem');
- for J := MaxI(I + 1, 11) to 36 do
- Assert(A[J] = AnsiChar(65 + J - 11), 'FillMem');
- end;
- end;
- {$ENDIF}
- procedure SelfTest;
- begin
- {$IFDEF CPU_INTEL386}
- Set8087CW(Default8087CW);
- {$ENDIF}
- Test_Misc;
- Test_BitFunctions;
- Test_Float;
- Test_IntStr;
- Test_FloatStr;
- Test_Hash;
- {$IFNDEF ManagedCode}
- Test_Memory;
- {$ENDIF}
- end;
- {$ENDIF}
- end.
|