cUtils.pas 232 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415441644174418441944204421442244234424442544264427442844294430443144324433443444354436443744384439444044414442444344444445444644474448444944504451445244534454445544564457445844594460446144624463446444654466446744684469447044714472447344744475447644774478447944804481448244834484448544864487448844894490449144924493449444954496449744984499450045014502450345044505450645074508450945104511451245134514451545164517451845194520452145224523452445254526452745284529453045314532453345344535453645374538453945404541454245434544454545464547454845494550455145524553455445554556455745584559456045614562456345644565456645674568456945704571457245734574457545764577457845794580458145824583458445854586458745884589459045914592459345944595459645974598459946004601460246034604460546064607460846094610461146124613461446154616461746184619462046214622462346244625462646274628462946304631463246334634463546364637463846394640464146424643464446454646464746484649465046514652465346544655465646574658465946604661466246634664466546664667466846694670467146724673467446754676467746784679468046814682468346844685468646874688468946904691469246934694469546964697469846994700470147024703470447054706470747084709471047114712471347144715471647174718471947204721472247234724472547264727472847294730473147324733473447354736473747384739474047414742474347444745474647474748474947504751475247534754475547564757475847594760476147624763476447654766476747684769477047714772477347744775477647774778477947804781478247834784478547864787478847894790479147924793479447954796479747984799480048014802480348044805480648074808480948104811481248134814481548164817481848194820482148224823482448254826482748284829483048314832483348344835483648374838483948404841484248434844484548464847484848494850485148524853485448554856485748584859486048614862486348644865486648674868486948704871487248734874487548764877487848794880488148824883488448854886488748884889489048914892489348944895489648974898489949004901490249034904490549064907490849094910491149124913491449154916491749184919492049214922492349244925492649274928492949304931493249334934493549364937493849394940494149424943494449454946494749484949495049514952495349544955495649574958495949604961496249634964496549664967496849694970497149724973497449754976497749784979498049814982498349844985498649874988498949904991499249934994499549964997499849995000500150025003500450055006500750085009501050115012501350145015501650175018501950205021502250235024502550265027502850295030503150325033503450355036503750385039504050415042504350445045504650475048504950505051505250535054505550565057505850595060506150625063506450655066506750685069507050715072507350745075507650775078507950805081508250835084508550865087508850895090509150925093509450955096509750985099510051015102510351045105510651075108510951105111511251135114511551165117511851195120512151225123512451255126512751285129513051315132513351345135513651375138513951405141514251435144514551465147514851495150515151525153515451555156515751585159516051615162516351645165516651675168516951705171517251735174517551765177517851795180518151825183518451855186518751885189519051915192519351945195519651975198519952005201520252035204520552065207520852095210521152125213521452155216521752185219522052215222522352245225522652275228522952305231523252335234523552365237523852395240524152425243524452455246524752485249525052515252525352545255525652575258525952605261526252635264526552665267526852695270527152725273527452755276527752785279528052815282528352845285528652875288528952905291529252935294529552965297529852995300530153025303530453055306530753085309531053115312531353145315531653175318531953205321532253235324532553265327532853295330533153325333533453355336533753385339534053415342534353445345534653475348534953505351535253535354535553565357535853595360536153625363536453655366536753685369537053715372537353745375537653775378537953805381538253835384538553865387538853895390539153925393539453955396539753985399540054015402540354045405540654075408540954105411541254135414541554165417541854195420542154225423542454255426542754285429543054315432543354345435543654375438543954405441544254435444544554465447544854495450545154525453545454555456545754585459546054615462546354645465546654675468546954705471547254735474547554765477547854795480548154825483548454855486548754885489549054915492549354945495549654975498549955005501550255035504550555065507550855095510551155125513551455155516551755185519552055215522552355245525552655275528552955305531553255335534553555365537553855395540554155425543554455455546554755485549555055515552555355545555555655575558555955605561556255635564556555665567556855695570557155725573557455755576557755785579558055815582558355845585558655875588558955905591559255935594559555965597559855995600560156025603560456055606560756085609561056115612561356145615561656175618561956205621562256235624562556265627562856295630563156325633563456355636563756385639564056415642564356445645564656475648564956505651565256535654565556565657565856595660566156625663566456655666566756685669567056715672567356745675567656775678567956805681568256835684568556865687568856895690569156925693569456955696569756985699570057015702570357045705570657075708570957105711571257135714571557165717571857195720572157225723572457255726572757285729573057315732573357345735573657375738573957405741574257435744574557465747574857495750575157525753575457555756575757585759576057615762576357645765576657675768576957705771577257735774577557765777577857795780578157825783578457855786578757885789579057915792579357945795579657975798579958005801580258035804580558065807580858095810581158125813581458155816581758185819582058215822582358245825582658275828582958305831583258335834583558365837583858395840584158425843584458455846584758485849585058515852585358545855585658575858585958605861586258635864586558665867586858695870587158725873587458755876587758785879588058815882588358845885588658875888588958905891589258935894589558965897589858995900590159025903590459055906590759085909591059115912591359145915591659175918591959205921592259235924592559265927592859295930593159325933593459355936593759385939594059415942594359445945594659475948594959505951595259535954595559565957595859595960596159625963596459655966596759685969597059715972597359745975597659775978597959805981598259835984598559865987598859895990599159925993599459955996599759985999600060016002600360046005600660076008600960106011601260136014601560166017601860196020602160226023602460256026602760286029603060316032603360346035603660376038603960406041604260436044604560466047604860496050605160526053605460556056605760586059606060616062606360646065606660676068606960706071607260736074607560766077607860796080608160826083608460856086608760886089609060916092609360946095609660976098609961006101610261036104610561066107610861096110611161126113611461156116611761186119612061216122612361246125612661276128612961306131613261336134613561366137613861396140614161426143614461456146614761486149615061516152615361546155615661576158615961606161616261636164616561666167616861696170617161726173617461756176617761786179618061816182618361846185618661876188618961906191619261936194619561966197619861996200620162026203620462056206620762086209621062116212621362146215621662176218621962206221622262236224622562266227622862296230623162326233623462356236623762386239624062416242624362446245624662476248624962506251625262536254625562566257625862596260626162626263626462656266626762686269627062716272627362746275627662776278627962806281628262836284628562866287628862896290629162926293629462956296629762986299630063016302630363046305630663076308630963106311631263136314631563166317631863196320632163226323632463256326632763286329633063316332633363346335633663376338633963406341634263436344634563466347634863496350635163526353635463556356635763586359636063616362636363646365636663676368636963706371637263736374637563766377637863796380638163826383638463856386638763886389639063916392639363946395639663976398639964006401640264036404640564066407640864096410641164126413641464156416641764186419642064216422642364246425642664276428642964306431643264336434643564366437643864396440644164426443644464456446644764486449645064516452645364546455645664576458645964606461646264636464646564666467646864696470647164726473647464756476647764786479648064816482648364846485648664876488648964906491649264936494649564966497649864996500650165026503650465056506650765086509651065116512651365146515651665176518651965206521652265236524652565266527652865296530653165326533653465356536653765386539654065416542654365446545654665476548654965506551655265536554655565566557655865596560656165626563656465656566656765686569657065716572657365746575657665776578657965806581658265836584658565866587658865896590659165926593659465956596659765986599660066016602660366046605660666076608660966106611661266136614661566166617661866196620662166226623662466256626662766286629663066316632663366346635663666376638663966406641664266436644664566466647664866496650665166526653665466556656665766586659666066616662666366646665666666676668666966706671667266736674667566766677667866796680668166826683668466856686668766886689669066916692669366946695669666976698669967006701670267036704670567066707670867096710671167126713671467156716671767186719672067216722672367246725672667276728672967306731673267336734673567366737673867396740674167426743674467456746674767486749675067516752675367546755675667576758675967606761676267636764676567666767676867696770677167726773677467756776677767786779678067816782678367846785678667876788678967906791679267936794679567966797679867996800680168026803680468056806680768086809681068116812681368146815681668176818681968206821682268236824682568266827682868296830683168326833683468356836683768386839684068416842684368446845684668476848684968506851685268536854685568566857685868596860686168626863686468656866686768686869687068716872687368746875687668776878687968806881688268836884688568866887688868896890689168926893689468956896689768986899690069016902690369046905690669076908690969106911691269136914691569166917691869196920692169226923692469256926692769286929693069316932693369346935693669376938693969406941694269436944694569466947694869496950695169526953695469556956695769586959696069616962696369646965696669676968696969706971697269736974697569766977697869796980698169826983698469856986698769886989699069916992699369946995699669976998699970007001700270037004700570067007700870097010701170127013701470157016701770187019702070217022702370247025702670277028702970307031703270337034703570367037703870397040704170427043704470457046704770487049705070517052705370547055705670577058705970607061706270637064706570667067706870697070707170727073707470757076707770787079708070817082708370847085708670877088708970907091709270937094709570967097709870997100710171027103710471057106710771087109711071117112711371147115711671177118711971207121712271237124712571267127712871297130713171327133713471357136713771387139714071417142714371447145714671477148714971507151715271537154715571567157715871597160716171627163716471657166716771687169717071717172717371747175717671777178717971807181718271837184718571867187718871897190719171927193719471957196719771987199720072017202720372047205720672077208720972107211721272137214721572167217721872197220722172227223722472257226722772287229723072317232723372347235723672377238723972407241724272437244724572467247724872497250725172527253725472557256725772587259726072617262726372647265726672677268726972707271727272737274727572767277727872797280728172827283728472857286728772887289729072917292729372947295729672977298729973007301730273037304730573067307730873097310731173127313731473157316731773187319732073217322732373247325732673277328732973307331733273337334733573367337733873397340734173427343734473457346734773487349735073517352735373547355735673577358735973607361736273637364736573667367736873697370737173727373737473757376737773787379738073817382738373847385738673877388738973907391739273937394739573967397739873997400740174027403740474057406740774087409741074117412741374147415741674177418741974207421742274237424742574267427742874297430743174327433743474357436743774387439744074417442744374447445744674477448744974507451745274537454745574567457745874597460746174627463746474657466746774687469747074717472747374747475747674777478747974807481748274837484748574867487748874897490749174927493749474957496749774987499750075017502750375047505750675077508750975107511751275137514751575167517751875197520752175227523752475257526752775287529753075317532753375347535753675377538753975407541754275437544754575467547754875497550755175527553755475557556755775587559756075617562756375647565756675677568756975707571757275737574757575767577757875797580758175827583758475857586758775887589759075917592759375947595759675977598759976007601760276037604760576067607760876097610761176127613761476157616761776187619762076217622762376247625762676277628762976307631763276337634763576367637763876397640764176427643764476457646764776487649765076517652765376547655765676577658765976607661766276637664766576667667766876697670767176727673767476757676767776787679768076817682768376847685768676877688768976907691769276937694769576967697769876997700770177027703770477057706770777087709771077117712771377147715771677177718771977207721772277237724772577267727772877297730773177327733773477357736773777387739774077417742774377447745774677477748774977507751775277537754775577567757775877597760776177627763776477657766776777687769777077717772777377747775777677777778777977807781778277837784778577867787778877897790779177927793779477957796779777987799780078017802780378047805780678077808780978107811781278137814781578167817781878197820782178227823782478257826782778287829783078317832783378347835783678377838783978407841784278437844784578467847784878497850785178527853785478557856785778587859786078617862786378647865786678677868786978707871787278737874787578767877787878797880788178827883788478857886788778887889789078917892789378947895789678977898789979007901790279037904790579067907790879097910791179127913791479157916791779187919792079217922792379247925792679277928792979307931793279337934793579367937793879397940794179427943794479457946794779487949795079517952795379547955795679577958795979607961796279637964796579667967796879697970797179727973797479757976797779787979798079817982798379847985798679877988798979907991799279937994799579967997799879998000
  1. {******************************************************************************}
  2. { }
  3. { Library: Fundamentals 4.00 }
  4. { File name: cUtils.pas }
  5. { File version: 4.51 }
  6. { Description: Utility functions for simple data types }
  7. { }
  8. { Copyright: Copyright © 2000-2013, David J Butler }
  9. { All rights reserved. }
  10. { Redistribution and use in source and binary forms, with }
  11. { or without modification, are permitted provided that }
  12. { the following conditions are met: }
  13. { Redistributions of source code must retain the above }
  14. { copyright notice, this list of conditions and the }
  15. { following disclaimer. }
  16. { THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND }
  17. { CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED }
  18. { WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED }
  19. { WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A }
  20. { PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL }
  21. { THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, }
  22. { INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR }
  23. { CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, }
  24. { PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF }
  25. { USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) }
  26. { HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER }
  27. { IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING }
  28. { NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE }
  29. { USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE }
  30. { POSSIBILITY OF SUCH DAMAGE. }
  31. { }
  32. { Home page: http://fundementals.sourceforge.net }
  33. { Forum: http://sourceforge.net/forum/forum.php?forum_id=2117 }
  34. { E-mail: fundamentalslib at gmail.com }
  35. { }
  36. { Revision history: }
  37. { }
  38. { 2000/02/02 0.01 Initial version. }
  39. { 2000/03/08 1.02 Added array functions. }
  40. { 2000/04/10 1.03 Added Append, Renamed Delete to Remove and added }
  41. { StringArrays. }
  42. { 2000/05/03 1.04 Added Path functions. }
  43. { 2000/05/08 1.05 Revision. }
  44. { 2000/06/01 1.06 Added Range and Dup constructors for dynamic arrays. }
  45. { 2000/06/03 1.07 Added ArrayInsert functions. }
  46. { 2000/06/06 1.08 Added bit functions from cMaths. }
  47. { 2000/06/08 1.09 Removed data structure classes. }
  48. { 2000/06/10 1.10 Added linked lists for Integer, Int64, Extended and }
  49. { String. }
  50. { 2000/06/14 1.11 cUtils now generated from a template using a source }
  51. { pre-processor. }
  52. { 2000/07/04 1.12 Revision for first Fundamentals release. }
  53. { 2000/07/24 1.13 Added TrimArray functions. }
  54. { 2000/07/26 1.14 Added Difference functions. }
  55. { 2000/09/02 1.15 Added RemoveDuplicates functions. }
  56. { Added Count functions. }
  57. { Fixed bug in Sort. }
  58. { 2000/09/27 1.16 Fixed bug in ArrayInsert. }
  59. { 2000/11/29 1.17 Moved SetFPUPrecision to cSysUtils. }
  60. { 2001/05/03 1.18 Improved bit functions. Added Pascal versions of }
  61. { assembly routines. }
  62. { 2001/05/13 1.19 Added CharCount. }
  63. { 2001/05/15 1.20 Added PosNext (ClassType, ObjectArray). }
  64. { 2001/05/18 1.21 Added hashing functions from cMaths. }
  65. { 2001/07/07 1.22 Added TBinaryTreeNode. }
  66. { 2001/11/11 2.23 Revision. }
  67. { 2002/01/03 2.24 Added EncodeBase64, DecodeBase64 from cMaths and }
  68. { optimized. Added LongWordToHex, HexToLongWord. }
  69. { 2002/03/30 2.25 Fixed bug in DecodeBase64. }
  70. { 2002/04/02 2.26 Removed dependencies on all other units to remove }
  71. { initialization code associated with SysUtils. This }
  72. { allows usage of cUtils in projects and still have }
  73. { very small binaries. }
  74. { Fixed bug in LongWordToHex. }
  75. { 2002/05/31 3.27 Refactored for Fundamentals 3. }
  76. { Moved linked lists to cLinkedLists. }
  77. { 2002/08/09 3.28 Added HashInteger. }
  78. { 2002/10/06 3.29 Renamed Cond to iif. }
  79. { 2002/12/12 3.30 Small revisions. }
  80. { 2003/03/14 3.31 Removed ApproxZero. Added FloatZero, FloatsEqual and }
  81. { FloatsCompare. Added documentation and test cases for }
  82. { comparison functions. }
  83. { Added support for Currency type. }
  84. { 2003/07/27 3.32 Added fast ZeroMem and FillMem routines. }
  85. { 2003/09/11 3.33 Added InterfaceArray functions. }
  86. { 2004/01/18 3.34 Added WideStringArray functions. }
  87. { 2004/07/24 3.35 Optimizations of Sort functions. }
  88. { 2004/08/01 3.36 Improved validation in base conversion routines. }
  89. { 2004/08/22 3.37 Compilable with Delphi 8. }
  90. { 2005/06/10 4.38 Compilable with FreePascal 2 Win32 i386. }
  91. { 2005/08/19 4.39 Compilable with FreePascal 2 Linux i386. }
  92. { 2005/09/21 4.40 Revised for Fundamentals 4. }
  93. { 2006/03/04 4.41 Compilable with Delphi 2006 Win32/.NET. }
  94. { 2007/06/08 4.42 Compilable with FreePascal 2.04 Win32 i386 }
  95. { 2007/08/08 4.43 Changes to memory functions for Delphi 2006/2007. }
  96. { 2008/06/06 4.44 Fixed bug in case insensitive hashing functions. }
  97. { 2009/10/09 4.45 Compilable with Delphi 2009 Win32/.NET. }
  98. { 2010/06/27 4.46 Compilable with FreePascal 2.4.0 OSX x86-64. }
  99. { 2012/04/03 4.47 Support for Delphi XE string and integer types. }
  100. { 2012/04/04 4.48 Moved dynamic arrays functions to cDynArrays. }
  101. { 2012/04/11 4.49 StringToFloat/FloatToStr functions. }
  102. { 2012/08/26 4.50 UnicodeString versions of functions. }
  103. { 2013/01/29 4.51 Compilable with Delphi XE3 x86-64. }
  104. { }
  105. { Supported compilers: }
  106. { }
  107. { Delphi 5 Win32 i386 }
  108. { Delphi 6 Win32 i386 }
  109. { Delphi 7 Win32 i386 4.50 2012/08/30 }
  110. { Delphi 8 .NET }
  111. { Delphi 2005 Win32 i386 }
  112. { Delphi 2006 Win32 i386 }
  113. { Delphi 2007 Win32 i386 4.50 2012/08/26 }
  114. { Delphi 2009 Win32 i386 4.46 2011/09/27 }
  115. { Delphi 2009 .NET 4.45 2009/10/09 }
  116. { Delphi XE 4.51 2013/01/29 }
  117. { Delphi XE3 x86-64 4.51 2013/01/29 }
  118. { FreePascal 2.0.4 Linux i386 }
  119. { FreePascal 2.4.0 OSX x86-64 4.46 2010/06/27 }
  120. { FreePascal 2.6.0 Win32 4.50 2012/08/30 }
  121. { }
  122. {******************************************************************************}
  123. {$INCLUDE cDefines.inc}
  124. {$IFDEF FREEPASCAL}
  125. {$WARNINGS OFF}
  126. {$HINTS OFF}
  127. {$ENDIF}
  128. {$IFDEF DEBUG}
  129. {$IFDEF SELFTEST}
  130. {$DEFINE UTILS_SELFTEST}
  131. {$ENDIF}
  132. {$ENDIF}
  133. unit cUtils;
  134. interface
  135. { }
  136. { Fundamentals Library constants }
  137. { }
  138. const
  139. LibraryVersion = '4.00';
  140. LibraryMajorVersion = 4;
  141. LibraryMinorVersion = 0;
  142. LibraryName = 'Fundamentals ' + LibraryVersion;
  143. LibraryCopyright = 'Copyright (c) 1998-2013 David J Butler';
  144. { }
  145. { Integer types }
  146. { }
  147. { Unsigned integers Signed integers }
  148. { -------------------------------- -------------------------------- }
  149. { Byte unsigned 8 bits ShortInt signed 8 bits }
  150. { Word unsigned 16 bits SmallInt signed 16 bits }
  151. { LongWord unsigned 32 bits LongInt signed 32 bits }
  152. { - Int64 signed 64 bits }
  153. { Cardinal unsigned 32 bits Integer signed 32 bits }
  154. { NativeUInt unsigned system word NativeInt signed system word }
  155. { }
  156. type
  157. Int8 = ShortInt;
  158. Int16 = SmallInt;
  159. Int32 = LongInt;
  160. UInt8 = Byte;
  161. UInt16 = Word;
  162. UInt32 = LongWord;
  163. {$IFNDEF SupportUInt64}
  164. UInt64 = type Int64;
  165. {$ENDIF}
  166. Word8 = UInt8;
  167. Word16 = UInt16;
  168. Word32 = UInt32;
  169. Word64 = UInt64;
  170. LargeInt = Int64;
  171. {$IFNDEF SupportNativeInt}
  172. NativeInt = type Integer;
  173. NativeUInt = type Cardinal;
  174. PNativeUInt = ^NativeUInt;
  175. PNativeInt = ^NativeInt;
  176. {$ENDIF}
  177. {$IFDEF DELPHI5_DOWN}
  178. PByte = ^Byte;
  179. PWord = ^Word;
  180. PLongWord = ^LongWord;
  181. PShortInt = ^ShortInt;
  182. PSmallInt = ^SmallInt;
  183. PLongInt = ^LongInt;
  184. PInteger = ^Integer;
  185. PInt64 = ^Int64;
  186. {$ENDIF}
  187. PInt8 = ^Int8;
  188. PInt16 = ^Int16;
  189. PInt32 = ^Int32;
  190. PLargeInt = ^LargeInt;
  191. PWord8 = ^Word8;
  192. PWord16 = ^Word16;
  193. PWord32 = ^Word32;
  194. PUInt8 = ^UInt8;
  195. PUInt16 = ^UInt16;
  196. PUInt32 = ^UInt32;
  197. PUInt64 = ^UInt64;
  198. {$IFNDEF ManagedCode}
  199. SmallIntRec = packed record
  200. case Integer of
  201. 0 : (Lo, Hi : Byte);
  202. 1 : (Bytes : array[0..1] of Byte);
  203. end;
  204. LongIntRec = packed record
  205. case Integer of
  206. 0 : (Lo, Hi : Word);
  207. 1 : (Words : array[0..1] of Word);
  208. 2 : (Bytes : array[0..3] of Byte);
  209. end;
  210. PLongIntRec = ^LongIntRec;
  211. {$ENDIF}
  212. const
  213. MinByte = Low(Byte);
  214. MaxByte = High(Byte);
  215. MinWord = Low(Word);
  216. MaxWord = High(Word);
  217. MinShortInt = Low(ShortInt);
  218. MaxShortInt = High(ShortInt);
  219. MinSmallInt = Low(SmallInt);
  220. MaxSmallInt = High(SmallInt);
  221. MinLongWord = LongWord(Low(LongWord));
  222. MaxLongWord = LongWord(High(LongWord));
  223. MinLongInt = LongInt(Low(LongInt));
  224. MaxLongInt = LongInt(High(LongInt));
  225. MinInt64 = Int64(Low(Int64));
  226. MaxInt64 = Int64(High(Int64));
  227. MinInteger = Integer(Low(Integer));
  228. MaxInteger = Integer(High(Integer));
  229. MinCardinal = Cardinal(Low(Cardinal));
  230. MaxCardinal = Cardinal(High(Cardinal));
  231. MinNativeUInt = NativeUInt(Low(NativeUInt));
  232. MaxNativeUInt = NativeUInt(High(NativeUInt));
  233. MinNativeInt = NativeInt(Low(NativeInt));
  234. MaxNativeInt = NativeInt(High(NativeInt));
  235. const
  236. BitsPerByte = 8;
  237. BitsPerWord = 16;
  238. BitsPerLongWord = 32;
  239. BytesPerCardinal = Sizeof(Cardinal);
  240. BitsPerCardinal = BytesPerCardinal * 8;
  241. BytesPerNativeWord = SizeOf(NativeInt);
  242. BitsPerNativeWord = BytesPerNativeWord * 8;
  243. { Min returns smallest of A and B }
  244. { Max returns greatest of A and B }
  245. function MinI(const A, B: Integer): Integer; {$IFDEF UseInline}inline;{$ENDIF}
  246. function MaxI(const A, B: Integer): Integer; {$IFDEF UseInline}inline;{$ENDIF}
  247. function MinC(const A, B: Cardinal): Cardinal; {$IFDEF UseInline}inline;{$ENDIF}
  248. function MaxC(const A, B: Cardinal): Cardinal; {$IFDEF UseInline}inline;{$ENDIF}
  249. { Clip returns Value if in Low..High range, otherwise Low or High }
  250. function Clip(const Value: LongInt; const Low, High: LongInt): LongInt; overload; {$IFDEF UseInline}inline;{$ENDIF}
  251. function Clip(const Value: Int64; const Low, High: Int64): Int64; overload; {$IFDEF UseInline}inline;{$ENDIF}
  252. function ClipByte(const Value: LongInt): LongInt; overload; {$IFDEF UseInline}inline;{$ENDIF}
  253. function ClipByte(const Value: Int64): Int64; overload; {$IFDEF UseInline}inline;{$ENDIF}
  254. function ClipWord(const Value: LongInt): LongInt; overload; {$IFDEF UseInline}inline;{$ENDIF}
  255. function ClipWord(const Value: Int64): Int64; overload; {$IFDEF UseInline}inline;{$ENDIF}
  256. function ClipLongWord(const Value: Int64): LongWord; {$IFDEF UseInline}inline;{$ENDIF}
  257. function SumClipI(const A, I: Integer): Integer;
  258. function SumClipC(const A: Cardinal; const I: Integer): Cardinal;
  259. { InXXXRange returns True if A in range of type XXX }
  260. function InByteRange(const A: Int64): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
  261. function InWordRange(const A: Int64): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
  262. function InLongWordRange(const A: Int64): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
  263. function InShortIntRange(const A: Int64): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
  264. function InSmallIntRange(const A: Int64): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
  265. function InLongIntRange(const A: Int64): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
  266. { }
  267. { Boolean types }
  268. { }
  269. { Boolean - - }
  270. { ByteBool Bool8 8 bits }
  271. { WordBool Bool16 16 bits }
  272. { LongBool Bool32 32 bits }
  273. { }
  274. type
  275. Bool8 = ByteBool;
  276. Bool16 = WordBool;
  277. Bool32 = LongBool;
  278. {$IFDEF DELPHI5_DOWN}
  279. PBoolean = ^Boolean;
  280. PByteBool = ^ByteBool;
  281. PWordBool = ^WordBool;
  282. {$ENDIF}
  283. {$IFNDEF FREEPASCAL}
  284. PLongBool = ^LongBool;
  285. {$ENDIF}
  286. PBool8 = ^Bool8;
  287. PBool16 = ^Bool16;
  288. PBool32 = ^Bool32;
  289. { }
  290. { Comparison }
  291. { }
  292. type
  293. TCompareResult = (
  294. crLess,
  295. crEqual,
  296. crGreater,
  297. crUndefined);
  298. TCompareResultSet = set of TCompareResult;
  299. function ReverseCompareResult(const C: TCompareResult): TCompareResult;
  300. { }
  301. { Real types }
  302. { }
  303. { Floating point }
  304. { Single 32 bits 7-8 significant digits }
  305. { Double 64 bits 15-16 significant digits }
  306. { Extended 80 bits 19-20 significant digits (mapped to Double in .NET) }
  307. { }
  308. { Fixed point }
  309. { Currency 64 bits 19-20 significant digits, 4 after the decimal point. }
  310. { }
  311. const
  312. MinSingle : Single = 1.5E-45;
  313. MaxSingle : Single = 3.4E+38;
  314. MinDouble : Double = 5.0E-324;
  315. MaxDouble : Double = 1.7E+308;
  316. {$IFDEF ExtendedIsDouble}
  317. MinExtended : Extended = 5.0E-324;
  318. MaxExtended : Extended = 1.7E+308;
  319. {$ELSE}
  320. MinExtended : Extended = 3.4E-4932;
  321. MaxExtended : Extended = 1.1E+4932;
  322. {$ENDIF}
  323. {$IFNDEF CLR}
  324. MinCurrency : Currency = -922337203685477.5807;
  325. MaxCurrency : Currency = 922337203685477.5807;
  326. {$ENDIF}
  327. type
  328. {$IFDEF DELPHI5_DOWN}
  329. PSingle = ^Single;
  330. PDouble = ^Double;
  331. PExtended = ^Extended;
  332. PCurrency = ^Currency;
  333. {$ENDIF}
  334. {$IFNDEF ManagedCode}
  335. {$IFNDEF ExtendedIsDouble}
  336. ExtendedRec = packed record
  337. case Boolean of
  338. True: (
  339. Mantissa : packed array[0..1] of LongWord; { MSB of [1] is the normalized 1 bit }
  340. Exponent : Word; { MSB is the sign bit }
  341. );
  342. False: (Value: Extended);
  343. end;
  344. {$ENDIF}
  345. {$ENDIF}
  346. {$IFDEF CLR}
  347. Float = Double;
  348. {$ELSE}
  349. Float = Extended;
  350. {$ENDIF}
  351. PFloat = ^Float;
  352. {$IFNDEF ManagedCode}
  353. const
  354. ExtendedNan : ExtendedRec = (Mantissa:($FFFFFFFF, $FFFFFFFF); Exponent:$7FFF);
  355. ExtendedInfinity : ExtendedRec = (Mantissa:($00000000, $80000000); Exponent:$7FFF);
  356. {$ENDIF}
  357. { Min returns smallest of A and B }
  358. { Max returns greatest of A and B }
  359. { Clip returns Value if in Low..High range, otherwise Low or High }
  360. function MinF(const A, B: Float): Float; {$IFDEF UseInline}inline;{$ENDIF}
  361. function MaxF(const A, B: Float): Float; {$IFDEF UseInline}inline;{$ENDIF}
  362. function ClipF(const Value: Float; const Low, High: Float): Float;
  363. { InXXXRange returns True if A in range of type XXX }
  364. function InSingleRange(const A: Float): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
  365. function InDoubleRange(const A: Float): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
  366. {$IFNDEF CLR}
  367. function InCurrencyRange(const A: Float): Boolean; overload;
  368. function InCurrencyRange(const A: Int64): Boolean; overload;
  369. {$ENDIF}
  370. { FloatExponent returns the exponent component of an Extended value }
  371. {$IFNDEF ExtendedIsDouble}
  372. function FloatExponentBase2(const A: Extended; var Exponent: Integer): Boolean;
  373. function FloatExponentBase10(const A: Extended; var Exponent: Integer): Boolean;
  374. {$ENDIF}
  375. { FloatIsInfinity is True if A is a positive or negative infinity. }
  376. { FloatIsNaN is True if A is Not-a-Number. }
  377. function FloatIsInfinity(const A: Extended): Boolean;
  378. function FloatIsNaN(const A: Extended): Boolean;
  379. { }
  380. { Approximate comparison of floating point values }
  381. { }
  382. { FloatZero, FloatOne, FloatsEqual and FloatsCompare are functions for }
  383. { comparing floating point numbers based on a fixed CompareDelta difference }
  384. { between the values. This means that values are considered equal if the }
  385. { unsigned difference between the values are less than CompareDelta. }
  386. { }
  387. const
  388. // Minimum CompareDelta values for the different floating point types:
  389. // The values were chosen to be slightly higher than the minimum value that
  390. // the floating-point type can store.
  391. SingleCompareDelta = 1.0E-34;
  392. DoubleCompareDelta = 1.0E-280;
  393. {$IFDEF ExtendedIsDouble}
  394. ExtendedCompareDelta = DoubleCompareDelta;
  395. {$ELSE}
  396. ExtendedCompareDelta = 1.0E-4400;
  397. {$ENDIF}
  398. // Default CompareDelta is set to SingleCompareDelta. This allows any type
  399. // of floating-point value to be compared with any other.
  400. DefaultCompareDelta = SingleCompareDelta;
  401. function FloatZero(const A: Float;
  402. const CompareDelta: Float = DefaultCompareDelta): Boolean;
  403. function FloatOne(const A: Float;
  404. const CompareDelta: Float = DefaultCompareDelta): Boolean;
  405. function FloatsEqual(const A, B: Float;
  406. const CompareDelta: Float = DefaultCompareDelta): Boolean;
  407. function FloatsCompare(const A, B: Float;
  408. const CompareDelta: Float = DefaultCompareDelta): TCompareResult;
  409. {$IFNDEF ExtendedIsDouble}
  410. { }
  411. { Scaled approximate comparison of floating point values }
  412. { }
  413. { ApproxEqual and ApproxCompare are functions for comparing floating point }
  414. { numbers based on a scaled order of magnitude difference between the }
  415. { values. CompareEpsilon is the ratio applied to the largest of the two }
  416. { exponents to give the maximum difference (CompareDelta) for comparison. }
  417. { }
  418. { For example: }
  419. { }
  420. { When the CompareEpsilon is 1.0E-9, the result of }
  421. { }
  422. { ApproxEqual(1.0E+20, 1.000000001E+20) = False, but the result of }
  423. { ApproxEqual(1.0E+20, 1.0000000001E+20) = True, ie the first 9 digits of }
  424. { the mantissas of the values must be the same. }
  425. { }
  426. { Note that for A <> 0.0, the value of ApproxEqual(A, 0.0) will always be }
  427. { False. Rather use the unscaled FloatZero, FloatsEqual and FloatsCompare }
  428. { functions when specifically testing for zero. }
  429. { }
  430. const
  431. // Smallest (most sensitive) CompareEpsilon values allowed for the different
  432. // floating point types:
  433. SingleCompareEpsilon = 1.0E-5;
  434. DoubleCompareEpsilon = 1.0E-13;
  435. ExtendedCompareEpsilon = 1.0E-17;
  436. // Default CompareEpsilon is set for half the significant digits of the
  437. // Extended type.
  438. DefaultCompareEpsilon = 1.0E-10;
  439. function ApproxEqual(const A, B: Extended;
  440. const CompareEpsilon: Double = DefaultCompareEpsilon): Boolean;
  441. function ApproxCompare(const A, B: Extended;
  442. const CompareEpsilon: Double = DefaultCompareEpsilon): TCompareResult;
  443. {$ENDIF}
  444. { }
  445. { Bit functions }
  446. { }
  447. function ClearBit(const Value, BitIndex: LongWord): LongWord;
  448. function SetBit(const Value, BitIndex: LongWord): LongWord;
  449. function IsBitSet(const Value, BitIndex: LongWord): Boolean;
  450. function ToggleBit(const Value, BitIndex: LongWord): LongWord;
  451. function IsHighBitSet(const Value: LongWord): Boolean;
  452. function SetBitScanForward(const Value: LongWord): Integer; overload;
  453. function SetBitScanForward(const Value, BitIndex: LongWord): Integer; overload;
  454. function SetBitScanReverse(const Value: LongWord): Integer; overload;
  455. function SetBitScanReverse(const Value, BitIndex: LongWord): Integer; overload;
  456. function ClearBitScanForward(const Value: LongWord): Integer; overload;
  457. function ClearBitScanForward(const Value, BitIndex: LongWord): Integer; overload;
  458. function ClearBitScanReverse(const Value: LongWord): Integer; overload;
  459. function ClearBitScanReverse(const Value, BitIndex: LongWord): Integer; overload;
  460. function ReverseBits(const Value: LongWord): LongWord; overload;
  461. function ReverseBits(const Value: LongWord; const BitCount: Integer): LongWord; overload;
  462. function SwapEndian(const Value: LongWord): LongWord;
  463. {$IFDEF ManagedCode}
  464. procedure SwapEndianBuf(var Buf: array of LongWord);
  465. {$ELSE}
  466. procedure SwapEndianBuf(var Buf; const Count: Integer);
  467. {$ENDIF}
  468. function TwosComplement(const Value: LongWord): LongWord;
  469. function RotateLeftBits16(const Value: Word; const Bits: Byte): Word;
  470. function RotateLeftBits32(const Value: LongWord; const Bits: Byte): LongWord;
  471. function RotateRightBits16(const Value: Word; const Bits: Byte): Word;
  472. function RotateRightBits32(const Value: LongWord; const Bits: Byte): LongWord;
  473. function BitCount(const Value: LongWord): LongWord;
  474. function IsPowerOfTwo(const Value: LongWord): Boolean;
  475. function LowBitMask(const HighBitIndex: LongWord): LongWord;
  476. function HighBitMask(const LowBitIndex: LongWord): LongWord;
  477. function RangeBitMask(const LowBitIndex, HighBitIndex: LongWord): LongWord;
  478. function SetBitRange(const Value: LongWord;
  479. const LowBitIndex, HighBitIndex: LongWord): LongWord;
  480. function ClearBitRange(const Value: LongWord;
  481. const LowBitIndex, HighBitIndex: LongWord): LongWord;
  482. function ToggleBitRange(const Value: LongWord;
  483. const LowBitIndex, HighBitIndex: LongWord): LongWord;
  484. function IsBitRangeSet(const Value: LongWord;
  485. const LowBitIndex, HighBitIndex: LongWord): Boolean;
  486. function IsBitRangeClear(const Value: LongWord;
  487. const LowBitIndex, HighBitIndex: LongWord): Boolean;
  488. const
  489. BitMaskTable: array[0..31] of LongWord =
  490. ($00000001, $00000002, $00000004, $00000008,
  491. $00000010, $00000020, $00000040, $00000080,
  492. $00000100, $00000200, $00000400, $00000800,
  493. $00001000, $00002000, $00004000, $00008000,
  494. $00010000, $00020000, $00040000, $00080000,
  495. $00100000, $00200000, $00400000, $00800000,
  496. $01000000, $02000000, $04000000, $08000000,
  497. $10000000, $20000000, $40000000, $80000000);
  498. { }
  499. { Sets }
  500. { Operations on byte and character sets. }
  501. { }
  502. type
  503. CharSet = set of AnsiChar;
  504. AnsiCharSet = CharSet;
  505. ByteSet = set of Byte;
  506. PCharSet = ^CharSet;
  507. PByteSet = ^ByteSet;
  508. const
  509. CompleteCharSet = [AnsiChar(#0)..AnsiChar(#255)];
  510. CompleteByteSet = [0..255];
  511. function AsCharSet(const C: array of AnsiChar): CharSet;
  512. function AsByteSet(const C: array of Byte): ByteSet;
  513. procedure ComplementChar(var C: CharSet; const Ch: AnsiChar);
  514. procedure ClearCharSet(var C: CharSet);
  515. procedure FillCharSet(var C: CharSet);
  516. procedure ComplementCharSet(var C: CharSet);
  517. procedure AssignCharSet(var DestSet: CharSet; const SourceSet: CharSet); overload;
  518. procedure Union(var DestSet: CharSet; const SourceSet: CharSet); overload;
  519. procedure Difference(var DestSet: CharSet; const SourceSet: CharSet); overload;
  520. procedure Intersection(var DestSet: CharSet; const SourceSet: CharSet); overload;
  521. procedure XORCharSet(var DestSet: CharSet; const SourceSet: CharSet);
  522. function IsSubSet(const A, B: CharSet): Boolean;
  523. function IsEqual(const A, B: CharSet): Boolean; overload;
  524. function IsEmpty(const C: CharSet): Boolean;
  525. function IsComplete(const C: CharSet): Boolean;
  526. function CharCount(const C: CharSet): Integer; overload;
  527. procedure ConvertCaseInsensitive(var C: CharSet);
  528. function CaseInsensitiveCharSet(const C: CharSet): CharSet;
  529. { }
  530. { Range functions }
  531. { }
  532. { RangeLength Length of a range }
  533. { RangeAdjacent True if ranges are adjacent }
  534. { RangeOverlap True if ranges overlap }
  535. { RangeHasElement True if element is in range }
  536. { }
  537. function IntRangeLength(const Low, High: Integer): Int64;
  538. function IntRangeAdjacent(const Low1, High1, Low2, High2: Integer): Boolean;
  539. function IntRangeOverlap(const Low1, High1, Low2, High2: Integer): Boolean;
  540. function IntRangeHasElement(const Low, High, Element: Integer): Boolean;
  541. function IntRangeIncludeElement(var Low, High: Integer;
  542. const Element: Integer): Boolean;
  543. function IntRangeIncludeElementRange(var Low, High: Integer;
  544. const LowElement, HighElement: Integer): Boolean;
  545. function CardRangeLength(const Low, High: Cardinal): Int64;
  546. function CardRangeAdjacent(const Low1, High1, Low2, High2: Cardinal): Boolean;
  547. function CardRangeOverlap(const Low1, High1, Low2, High2: Cardinal): Boolean;
  548. function CardRangeHasElement(const Low, High, Element: Cardinal): Boolean;
  549. function CardRangeIncludeElement(var Low, High: Cardinal;
  550. const Element: Cardinal): Boolean;
  551. function CardRangeIncludeElementRange(var Low, High: Cardinal;
  552. const LowElement, HighElement: Cardinal): Boolean;
  553. { }
  554. { UnicodeString }
  555. { UnicodeString in Delphi 2009 is reference counted, code page aware, }
  556. { variable character length unicode string. Defaults to UTF-16 encoding. }
  557. { WideString is not reference counted. }
  558. { }
  559. type
  560. UnicodeChar = WideChar;
  561. PUnicodeChar = ^UnicodeChar;
  562. {$IFNDEF SupportUnicodeString}
  563. UnicodeString = WideString;
  564. PUnicodeString = ^UnicodeString;
  565. {$ENDIF}
  566. { }
  567. { Swap }
  568. { }
  569. procedure Swap(var X, Y: Boolean); overload;
  570. procedure Swap(var X, Y: Byte); overload;
  571. procedure Swap(var X, Y: Word); overload;
  572. procedure Swap(var X, Y: LongWord); overload;
  573. procedure Swap(var X, Y: NativeUInt); overload;
  574. procedure Swap(var X, Y: ShortInt); overload;
  575. procedure Swap(var X, Y: SmallInt); overload;
  576. procedure Swap(var X, Y: LongInt); overload;
  577. procedure Swap(var X, Y: Int64); overload;
  578. procedure Swap(var X, Y: NativeInt); overload;
  579. procedure Swap(var X, Y: Single); overload;
  580. procedure Swap(var X, Y: Double); overload;
  581. procedure Swap(var X, Y: Extended); overload;
  582. procedure Swap(var X, Y: Currency); overload;
  583. procedure SwapA(var X, Y: AnsiString); overload;
  584. procedure SwapW(var X, Y: WideString); overload;
  585. procedure SwapU(var X, Y: UnicodeString); overload;
  586. procedure Swap(var X, Y: String); overload;
  587. procedure Swap(var X, Y: TObject); overload;
  588. {$IFDEF ManagedCode}
  589. procedure SwapObjects(var X, Y: TObject);
  590. {$ELSE}
  591. procedure SwapObjects(var X, Y);
  592. {$ENDIF}
  593. {$IFNDEF ManagedCode}
  594. procedure Swap(var X, Y: Pointer); overload;
  595. {$ENDIF}
  596. { }
  597. { Inline if }
  598. { }
  599. { iif returns TrueValue if Expr is True, otherwise it returns FalseValue. }
  600. { }
  601. function iif(const Expr: Boolean; const TrueValue: Integer;
  602. const FalseValue: Integer = 0): Integer; overload; {$IFDEF UseInline}inline;{$ENDIF}
  603. function iif(const Expr: Boolean; const TrueValue: Int64;
  604. const FalseValue: Int64 = 0): Int64; overload; {$IFDEF UseInline}inline;{$ENDIF}
  605. function iif(const Expr: Boolean; const TrueValue: Extended;
  606. const FalseValue: Extended = 0.0): Extended; overload; {$IFDEF UseInline}inline;{$ENDIF}
  607. function iifA(const Expr: Boolean; const TrueValue: AnsiString;
  608. const FalseValue: AnsiString = ''): AnsiString; overload; {$IFDEF UseInline}inline;{$ENDIF}
  609. function iifW(const Expr: Boolean; const TrueValue: WideString;
  610. const FalseValue: WideString = ''): WideString; overload; {$IFDEF UseInline}inline;{$ENDIF}
  611. function iifU(const Expr: Boolean; const TrueValue: UnicodeString;
  612. const FalseValue: UnicodeString = ''): UnicodeString; overload; {$IFDEF UseInline}inline;{$ENDIF}
  613. function iif(const Expr: Boolean; const TrueValue: String;
  614. const FalseValue: String = ''): String; overload; {$IFDEF UseInline}inline;{$ENDIF}
  615. function iif(const Expr: Boolean; const TrueValue: TObject;
  616. const FalseValue: TObject = nil): TObject; overload; {$IFDEF UseInline}inline;{$ENDIF}
  617. { }
  618. { Direct comparison }
  619. { }
  620. { Compare(I1, I2) returns crLess if I1 < I2, crEqual if I1 = I2 or }
  621. { crGreater if I1 > I2. }
  622. { }
  623. function Compare(const I1, I2: Boolean): TCompareResult; overload;
  624. function Compare(const I1, I2: Integer): TCompareResult; overload;
  625. function Compare(const I1, I2: Int64): TCompareResult; overload;
  626. function Compare(const I1, I2: Extended): TCompareResult; overload;
  627. function CompareA(const I1, I2: AnsiString): TCompareResult;
  628. function CompareW(const I1, I2: WideString): TCompareResult;
  629. function CompareU(const I1, I2: UnicodeString): TCompareResult;
  630. function Sgn(const A: LongInt): Integer; overload;
  631. function Sgn(const A: Int64): Integer; overload;
  632. function Sgn(const A: Extended): Integer; overload;
  633. { }
  634. { Convert result }
  635. { }
  636. type
  637. TConvertResult = (
  638. convertOK,
  639. convertFormatError,
  640. convertOverflow
  641. );
  642. { }
  643. { Integer-String conversions }
  644. { }
  645. const
  646. StrHexDigitsUpper: String[16] = '0123456789ABCDEF';
  647. StrHexDigitsLower: String[16] = '0123456789abcdef';
  648. function AnsiCharToInt(const A: AnsiChar): Integer; {$IFDEF UseInline}inline;{$ENDIF}
  649. function WideCharToInt(const A: WideChar): Integer; {$IFDEF UseInline}inline;{$ENDIF}
  650. function CharToInt(const A: Char): Integer; {$IFDEF UseInline}inline;{$ENDIF}
  651. function IntToAnsiChar(const A: Integer): AnsiChar; {$IFDEF UseInline}inline;{$ENDIF}
  652. function IntToWideChar(const A: Integer): WideChar; {$IFDEF UseInline}inline;{$ENDIF}
  653. function IntToChar(const A: Integer): Char; {$IFDEF UseInline}inline;{$ENDIF}
  654. function IsHexAnsiChar(const Ch: AnsiChar): Boolean;
  655. function IsHexWideChar(const Ch: WideChar): Boolean;
  656. function IsHexChar(const Ch: Char): Boolean; {$IFDEF UseInline}inline;{$ENDIF}
  657. function HexAnsiCharToInt(const A: AnsiChar): Integer;
  658. function HexWideCharToInt(const A: WideChar): Integer;
  659. function HexCharToInt(const A: Char): Integer; {$IFDEF UseInline}inline;{$ENDIF}
  660. function IntToUpperHexAnsiChar(const A: Integer): AnsiChar;
  661. function IntToUpperHexWideChar(const A: Integer): WideChar;
  662. function IntToUpperHexChar(const A: Integer): Char; {$IFDEF UseInline}inline;{$ENDIF}
  663. function IntToLowerHexAnsiChar(const A: Integer): AnsiChar;
  664. function IntToLowerHexWideChar(const A: Integer): WideChar;
  665. function IntToLowerHexChar(const A: Integer): Char; {$IFDEF UseInline}inline;{$ENDIF}
  666. function IntToStringA(const A: Int64): AnsiString;
  667. function IntToStringW(const A: Int64): WideString;
  668. function IntToStringU(const A: Int64): UnicodeString;
  669. function IntToString(const A: Int64): String;
  670. function UIntToStringA(const A: NativeUInt): AnsiString;
  671. function UIntToStringW(const A: NativeUInt): WideString;
  672. function UIntToStringU(const A: NativeUInt): UnicodeString;
  673. function UIntToString(const A: NativeUInt): String;
  674. function LongWordToStrA(const A: LongWord; const Digits: Integer = 0): AnsiString;
  675. function LongWordToStrW(const A: LongWord; const Digits: Integer = 0): WideString;
  676. function LongWordToStrU(const A: LongWord; const Digits: Integer = 0): UnicodeString;
  677. function LongWordToStr(const A: LongWord; const Digits: Integer = 0): String;
  678. function LongWordToHexA(const A: LongWord; const Digits: Integer = 0; const UpperCase: Boolean = True): AnsiString;
  679. function LongWordToHexW(const A: LongWord; const Digits: Integer = 0; const UpperCase: Boolean = True): WideString;
  680. function LongWordToHexU(const A: LongWord; const Digits: Integer = 0; const UpperCase: Boolean = True): UnicodeString;
  681. function LongWordToHex(const A: LongWord; const Digits: Integer = 0; const UpperCase: Boolean = True): String;
  682. function LongWordToOctA(const A: LongWord; const Digits: Integer = 0): AnsiString;
  683. function LongWordToOctW(const A: LongWord; const Digits: Integer = 0): WideString;
  684. function LongWordToOctU(const A: LongWord; const Digits: Integer = 0): UnicodeString;
  685. function LongWordToOct(const A: LongWord; const Digits: Integer = 0): String;
  686. function LongWordToBinA(const A: LongWord; const Digits: Integer = 0): AnsiString;
  687. function LongWordToBinW(const A: LongWord; const Digits: Integer = 0): WideString;
  688. function LongWordToBinU(const A: LongWord; const Digits: Integer = 0): UnicodeString;
  689. function LongWordToBin(const A: LongWord; const Digits: Integer = 0): String;
  690. function TryStringToInt64PA(const BufP: Pointer; const BufLen: Integer; out Value: Int64; out StrLen: Integer): TConvertResult;
  691. function TryStringToInt64PW(const BufP: Pointer; const BufLen: Integer; out Value: Int64; out StrLen: Integer): TConvertResult;
  692. function TryStringToInt64P(const BufP: Pointer; const BufLen: Integer; out Value: Int64; out StrLen: Integer): TConvertResult;
  693. function TryStringToInt64A(const S: AnsiString; out A: Int64): Boolean;
  694. function TryStringToInt64W(const S: WideString; out A: Int64): Boolean;
  695. function TryStringToInt64U(const S: UnicodeString; out A: Int64): Boolean;
  696. function TryStringToInt64(const S: String; out A: Int64): Boolean;
  697. function StringToInt64DefA(const S: AnsiString; const Default: Int64): Int64;
  698. function StringToInt64DefW(const S: WideString; const Default: Int64): Int64;
  699. function StringToInt64DefU(const S: UnicodeString; const Default: Int64): Int64;
  700. function StringToInt64Def(const S: String; const Default: Int64): Int64;
  701. function StringToInt64A(const S: AnsiString): Int64;
  702. function StringToInt64W(const S: WideString): Int64;
  703. function StringToInt64U(const S: UnicodeString): Int64;
  704. function StringToInt64(const S: String): Int64;
  705. function TryStringToIntA(const S: AnsiString; out A: Integer): Boolean;
  706. function TryStringToIntW(const S: WideString; out A: Integer): Boolean;
  707. function TryStringToIntU(const S: UnicodeString; out A: Integer): Boolean;
  708. function TryStringToInt(const S: String; out A: Integer): Boolean;
  709. function StringToIntDefA(const S: AnsiString; const Default: Integer): Integer;
  710. function StringToIntDefW(const S: WideString; const Default: Integer): Integer;
  711. function StringToIntDefU(const S: UnicodeString; const Default: Integer): Integer;
  712. function StringToIntDef(const S: String; const Default: Integer): Integer;
  713. function StringToIntA(const S: AnsiString): Integer;
  714. function StringToIntW(const S: WideString): Integer;
  715. function StringToIntU(const S: UnicodeString): Integer;
  716. function StringToInt(const S: String): Integer;
  717. function TryStringToLongWordA(const S: AnsiString; out A: LongWord): Boolean;
  718. function TryStringToLongWordW(const S: WideString; out A: LongWord): Boolean;
  719. function TryStringToLongWordU(const S: UnicodeString; out A: LongWord): Boolean;
  720. function TryStringToLongWord(const S: String; out A: LongWord): Boolean;
  721. function StringToLongWordA(const S: AnsiString): LongWord;
  722. function StringToLongWordW(const S: WideString): LongWord;
  723. function StringToLongWordU(const S: UnicodeString): LongWord;
  724. function StringToLongWord(const S: String): LongWord;
  725. function HexToUIntA(const S: AnsiString): NativeUInt;
  726. function HexToUIntW(const S: WideString): NativeUInt;
  727. function HexToUIntU(const S: UnicodeString): NativeUInt;
  728. function HexToUInt(const S: String): NativeUInt;
  729. function TryHexToLongWordA(const S: AnsiString; out A: LongWord): Boolean;
  730. function TryHexToLongWordW(const S: WideString; out A: LongWord): Boolean;
  731. function TryHexToLongWordU(const S: UnicodeString; out A: LongWord): Boolean;
  732. function TryHexToLongWord(const S: String; out A: LongWord): Boolean;
  733. function HexToLongWordA(const S: AnsiString): LongWord;
  734. function HexToLongWordW(const S: WideString): LongWord;
  735. function HexToLongWordU(const S: UnicodeString): LongWord;
  736. function HexToLongWord(const S: String): LongWord;
  737. function TryOctToLongWordA(const S: AnsiString; out A: LongWord): Boolean;
  738. function TryOctToLongWordW(const S: WideString; out A: LongWord): Boolean;
  739. function TryOctToLongWordU(const S: UnicodeString; out A: LongWord): Boolean;
  740. function TryOctToLongWord(const S: String; out A: LongWord): Boolean;
  741. function OctToLongWordA(const S: AnsiString): LongWord;
  742. function OctToLongWordW(const S: WideString): LongWord;
  743. function OctToLongWordU(const S: UnicodeString): LongWord;
  744. function OctToLongWord(const S: String): LongWord;
  745. function TryBinToLongWordA(const S: AnsiString; out A: LongWord): Boolean;
  746. function TryBinToLongWordW(const S: WideString; out A: LongWord): Boolean;
  747. function TryBinToLongWordU(const S: UnicodeString; out A: LongWord): Boolean;
  748. function TryBinToLongWord(const S: String; out A: LongWord): Boolean;
  749. function BinToLongWordA(const S: AnsiString): LongWord;
  750. function BinToLongWordW(const S: WideString): LongWord;
  751. function BinToLongWordU(const S: UnicodeString): LongWord;
  752. function BinToLongWord(const S: String): LongWord;
  753. { }
  754. { Float-String conversions }
  755. { }
  756. function FloatToStringA(const A: Extended): AnsiString;
  757. function FloatToStringW(const A: Extended): WideString;
  758. function FloatToStringU(const A: Extended): UnicodeString;
  759. function FloatToString(const A: Extended): String;
  760. function TryStringToFloatPA(const BufP: Pointer; const BufLen: Integer; out Value: Extended; out StrLen: Integer): TConvertResult;
  761. function TryStringToFloatPW(const BufP: Pointer; const BufLen: Integer; out Value: Extended; out StrLen: Integer): TConvertResult;
  762. function TryStringToFloatP(const BufP: Pointer; const BufLen: Integer; out Value: Extended; out StrLen: Integer): TConvertResult;
  763. function TryStringToFloatA(const A: AnsiString; out B: Extended): Boolean;
  764. function TryStringToFloatW(const A: WideString; out B: Extended): Boolean;
  765. function TryStringToFloatU(const A: UnicodeString; out B: Extended): Boolean;
  766. function TryStringToFloat(const A: String; out B: Extended): Boolean;
  767. function StringToFloatA(const A: AnsiString): Extended;
  768. function StringToFloatW(const A: WideString): Extended;
  769. function StringToFloatU(const A: UnicodeString): Extended;
  770. function StringToFloat(const A: String): Extended;
  771. function StringToFloatDefA(const A: AnsiString; const Default: Extended): Extended;
  772. function StringToFloatDefW(const A: WideString; const Default: Extended): Extended;
  773. function StringToFloatDefU(const A: UnicodeString; const Default: Extended): Extended;
  774. function StringToFloatDef(const A: String; const Default: Extended): Extended;
  775. { }
  776. { Base64 }
  777. { }
  778. { EncodeBase64 converts a binary string (S) to a base 64 string using }
  779. { Alphabet. if Pad is True, the result will be padded with PadChar to be a }
  780. { multiple of PadMultiple. }
  781. { }
  782. { DecodeBase64 converts a base 64 string using Alphabet (64 characters for }
  783. { values 0-63) to a binary string. }
  784. { }
  785. function EncodeBase64(const S, Alphabet: AnsiString;
  786. const Pad: Boolean = False;
  787. const PadMultiple: Integer = 4;
  788. const PadChar: AnsiChar = '='): AnsiString;
  789. function DecodeBase64(const S, Alphabet: AnsiString;
  790. const PadSet: CharSet{$IFNDEF CLR} = []{$ENDIF}): AnsiString;
  791. const
  792. b64_MIMEBase64 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  793. b64_UUEncode = ' !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
  794. b64_XXEncode = '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
  795. function MIMEBase64Decode(const S: AnsiString): AnsiString;
  796. function MIMEBase64Encode(const S: AnsiString): AnsiString;
  797. function UUDecode(const S: AnsiString): AnsiString;
  798. function XXDecode(const S: AnsiString): AnsiString;
  799. function BytesToHex(
  800. {$IFDEF ManagedCode}const P: array of Byte;
  801. {$ELSE} const P: Pointer; const Count: Integer;{$ENDIF}
  802. const UpperCase: Boolean = True): AnsiString;
  803. { }
  804. { Type conversion }
  805. { }
  806. {$IFNDEF ManagedCode}
  807. function PointerToStrA(const P: Pointer): AnsiString;
  808. function PointerToStrW(const P: Pointer): WideString;
  809. function PointerToStr(const P: Pointer): String;
  810. function StrToPointerA(const S: AnsiString): Pointer;
  811. function StrToPointerW(const S: WideString): Pointer;
  812. function StrToPointer(const S: String): Pointer;
  813. function InterfaceToStrA(const I: IInterface): AnsiString;
  814. function InterfaceToStrW(const I: IInterface): WideString;
  815. function InterfaceToStr(const I: IInterface): String;
  816. {$ENDIF}
  817. function ObjectClassName(const O: TObject): String;
  818. function ClassClassName(const C: TClass): String;
  819. function ObjectToStr(const O: TObject): String;
  820. function CharSetToStr(const C: CharSet): AnsiString;
  821. function StrToCharSet(const S: AnsiString): CharSet;
  822. { }
  823. { Hashing functions }
  824. { }
  825. { HashBuf uses a every byte in the buffer to calculate a hash. }
  826. { }
  827. { HashStr is a general purpose string hashing function. }
  828. { }
  829. { If Slots = 0 the hash value is in the LongWord range (0-$FFFFFFFF), }
  830. { otherwise the value is in the range from 0 to Slots-1. Note that the }
  831. { 'mod' operation, which is used when Slots <> 0, is comparitively slow. }
  832. { }
  833. function HashBuf(const Hash: LongWord; const Buf; const BufSize: Integer): LongWord;
  834. function HashStrA(const S: AnsiString;
  835. const Index: Integer = 1; const Count: Integer = -1;
  836. const AsciiCaseSensitive: Boolean = True;
  837. const Slots: LongWord = 0): LongWord;
  838. function HashStrW(const S: WideString;
  839. const Index: Integer = 1; const Count: Integer = -1;
  840. const AsciiCaseSensitive: Boolean = True;
  841. const Slots: LongWord = 0): LongWord;
  842. function HashStrU(const S: UnicodeString;
  843. const Index: Integer = 1; const Count: Integer = -1;
  844. const AsciiCaseSensitive: Boolean = True;
  845. const Slots: LongWord = 0): LongWord;
  846. function HashStr(const S: String;
  847. const Index: Integer = 1; const Count: Integer = -1;
  848. const AsciiCaseSensitive: Boolean = True;
  849. const Slots: LongWord = 0): LongWord;
  850. function HashInteger(const I: Integer; const Slots: LongWord = 0): LongWord;
  851. function HashLongWord(const I: LongWord; const Slots: LongWord = 0): LongWord;
  852. { }
  853. { Memory operations }
  854. { }
  855. {$IFDEF DELPHI5_DOWN}
  856. type
  857. PPointer = ^Pointer;
  858. {$ENDIF}
  859. const
  860. Bytes1KB = 1024;
  861. Bytes1MB = 1024 * Bytes1KB;
  862. Bytes1GB = 1024 * Bytes1MB;
  863. Bytes64KB = 64 * Bytes1KB;
  864. Bytes64MB = 64 * Bytes1MB;
  865. Bytes2GB = 2 * LongWord(Bytes1GB);
  866. {$IFNDEF ManagedCode}
  867. {$IFDEF ASM386_DELPHI}{$IFNDEF DELPHI2006_UP}
  868. {$DEFINE UseAsmMemFunction}
  869. {$ENDIF}{$ENDIF}
  870. {$IFDEF UseInline}{$IFNDEF UseAsmMemFunction}
  871. {$DEFINE InlineMemFunction}
  872. {$ENDIF}{$ENDIF}
  873. procedure FillMem(var Buf; const Count: Integer; const Value: Byte); {$IFDEF InlineMemFunction}inline;{$ENDIF}
  874. procedure ZeroMem(var Buf; const Count: Integer); {$IFDEF InlineMemFunction}inline;{$ENDIF}
  875. procedure GetZeroMem(var P: Pointer; const Size: Integer); {$IFDEF InlineMemFunction}inline;{$ENDIF}
  876. procedure MoveMem(const Source; var Dest; const Count: Integer); {$IFDEF InlineMemFunction}inline;{$ENDIF}
  877. function CompareMem(const Buf1; const Buf2; const Count: Integer): Boolean;
  878. function CompareMemNoCase(const Buf1; const Buf2; const Count: Integer): TCompareResult;
  879. function LocateMem(const Buf1; const Size1: Integer; const Buf2; const Size2: Integer): Integer;
  880. procedure ReverseMem(var Buf; const Size: Integer);
  881. {$ENDIF}
  882. { }
  883. { IInterface }
  884. { }
  885. {$IFDEF DELPHI5_DOWN}
  886. type
  887. IInterface = interface
  888. ['{00000000-0000-0000-C000-000000000046}']
  889. function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
  890. function _AddRef: Integer; stdcall;
  891. function _Release: Integer; stdcall;
  892. end;
  893. {$ENDIF}
  894. { }
  895. { Array pointers }
  896. { }
  897. { Maximum array elements }
  898. const
  899. MaxArraySize = $7FFFFFFF; // 2 Gigabytes
  900. MaxByteArrayElements = MaxArraySize div Sizeof(Byte);
  901. MaxWordArrayElements = MaxArraySize div Sizeof(Word);
  902. MaxLongWordArrayElements = MaxArraySize div Sizeof(LongWord);
  903. MaxCardinalArrayElements = MaxArraySize div Sizeof(Cardinal);
  904. MaxNativeUIntArrayElements = MaxArraySize div Sizeof(NativeUInt);
  905. MaxShortIntArrayElements = MaxArraySize div Sizeof(ShortInt);
  906. MaxSmallIntArrayElements = MaxArraySize div Sizeof(SmallInt);
  907. MaxLongIntArrayElements = MaxArraySize div Sizeof(LongInt);
  908. MaxIntegerArrayElements = MaxArraySize div Sizeof(Integer);
  909. MaxInt64ArrayElements = MaxArraySize div Sizeof(Int64);
  910. MaxNativeIntArrayElements = MaxArraySize div Sizeof(NativeInt);
  911. MaxSingleArrayElements = MaxArraySize div Sizeof(Single);
  912. MaxDoubleArrayElements = MaxArraySize div Sizeof(Double);
  913. MaxExtendedArrayElements = MaxArraySize div Sizeof(Extended);
  914. MaxBooleanArrayElements = MaxArraySize div Sizeof(Boolean);
  915. {$IFNDEF CLR}
  916. MaxCurrencyArrayElements = MaxArraySize div Sizeof(Currency);
  917. MaxAnsiStringArrayElements = MaxArraySize div Sizeof(AnsiString);
  918. MaxWideStringArrayElements = MaxArraySize div Sizeof(WideString);
  919. MaxUnicodeStringArrayElements = MaxArraySize div Sizeof(UnicodeString);
  920. {$IFDEF StringIsUnicode}
  921. MaxStringArrayElements = MaxArraySize div Sizeof(UnicodeString);
  922. {$ELSE}
  923. MaxStringArrayElements = MaxArraySize div Sizeof(AnsiString);
  924. {$ENDIF}
  925. MaxPointerArrayElements = MaxArraySize div Sizeof(Pointer);
  926. MaxObjectArrayElements = MaxArraySize div Sizeof(TObject);
  927. MaxInterfaceArrayElements = MaxArraySize div Sizeof(IInterface);
  928. MaxCharSetArrayElements = MaxArraySize div Sizeof(CharSet);
  929. MaxByteSetArrayElements = MaxArraySize div Sizeof(ByteSet);
  930. {$ENDIF}
  931. { Static array types }
  932. type
  933. TStaticByteArray = array[0..MaxByteArrayElements - 1] of Byte;
  934. TStaticWordArray = array[0..MaxWordArrayElements - 1] of Word;
  935. TStaticLongWordArray = array[0..MaxLongWordArrayElements - 1] of LongWord;
  936. TStaticNativeUIntArray = array[0..MaxNativeUIntArrayElements - 1] of NativeUInt;
  937. TStaticShortIntArray = array[0..MaxShortIntArrayElements - 1] of ShortInt;
  938. TStaticSmallIntArray = array[0..MaxSmallIntArrayElements - 1] of SmallInt;
  939. TStaticLongIntArray = array[0..MaxLongIntArrayElements - 1] of LongInt;
  940. TStaticInt64Array = array[0..MaxInt64ArrayElements - 1] of Int64;
  941. TStaticNativeIntArray = array[0..MaxNativeIntArrayElements - 1] of NativeInt;
  942. TStaticSingleArray = array[0..MaxSingleArrayElements - 1] of Single;
  943. TStaticDoubleArray = array[0..MaxDoubleArrayElements - 1] of Double;
  944. TStaticExtendedArray = array[0..MaxExtendedArrayElements - 1] of Extended;
  945. TStaticBooleanArray = array[0..MaxBooleanArrayElements - 1] of Boolean;
  946. {$IFNDEF CLR}
  947. TStaticCurrencyArray = array[0..MaxCurrencyArrayElements - 1] of Currency;
  948. TStaticAnsiStringArray = array[0..MaxAnsiStringArrayElements - 1] of AnsiString;
  949. TStaticWideStringArray = array[0..MaxWideStringArrayElements - 1] of WideString;
  950. TStaticUnicodeStringArray = array[0..MaxUnicodeStringArrayElements - 1] of UnicodeString;
  951. {$IFDEF StringIsUnicode}
  952. TStaticStringArray = TStaticWideStringArray;
  953. {$ELSE}
  954. TStaticStringArray = TStaticAnsiStringArray;
  955. {$ENDIF}
  956. TStaticPointerArray = array[0..MaxPointerArrayElements - 1] of Pointer;
  957. TStaticObjectArray = array[0..MaxObjectArrayElements - 1] of TObject;
  958. TStaticInterfaceArray = array[0..MaxInterfaceArrayElements - 1] of IInterface;
  959. TStaticCharSetArray = array[0..MaxCharSetArrayElements - 1] of CharSet;
  960. TStaticByteSetArray = array[0..MaxByteSetArrayElements - 1] of ByteSet;
  961. {$ENDIF}
  962. TStaticCardinalArray = TStaticLongWordArray;
  963. TStaticIntegerArray = TStaticLongIntArray;
  964. { Static array pointers }
  965. type
  966. PStaticByteArray = ^TStaticByteArray;
  967. PStaticWordArray = ^TStaticWordArray;
  968. PStaticLongWordArray = ^TStaticLongWordArray;
  969. PStaticCardinalArray = ^TStaticCardinalArray;
  970. PStaticNativeUIntArray = ^TStaticNativeUIntArray;
  971. PStaticShortIntArray = ^TStaticShortIntArray;
  972. PStaticSmallIntArray = ^TStaticSmallIntArray;
  973. PStaticLongIntArray = ^TStaticLongIntArray;
  974. PStaticIntegerArray = ^TStaticIntegerArray;
  975. PStaticInt64Array = ^TStaticInt64Array;
  976. PStaticNativeIntArray = ^TStaticNativeIntArray;
  977. PStaticSingleArray = ^TStaticSingleArray;
  978. PStaticDoubleArray = ^TStaticDoubleArray;
  979. PStaticExtendedArray = ^TStaticExtendedArray;
  980. PStaticBooleanArray = ^TStaticBooleanArray;
  981. {$IFNDEF CLR}
  982. PStaticCurrencyArray = ^TStaticCurrencyArray;
  983. PStaticAnsiStringArray = ^TStaticAnsiStringArray;
  984. PStaticWideStringArray = ^TStaticWideStringArray;
  985. PStaticUnicodeStringArray = ^TStaticUnicodeStringArray;
  986. PStaticStringArray = ^TStaticStringArray;
  987. PStaticPointerArray = ^TStaticPointerArray;
  988. PStaticObjectArray = ^TStaticObjectArray;
  989. PStaticInterfaceArray = ^TStaticInterfaceArray;
  990. PStaticCharSetArray = ^TStaticCharSetArray;
  991. PStaticByteSetArray = ^TStaticByteSetArray;
  992. {$ENDIF}
  993. { }
  994. { Dynamic arrays }
  995. { }
  996. type
  997. ByteArray = array of Byte;
  998. WordArray = array of Word;
  999. LongWordArray = array of LongWord;
  1000. CardinalArray = LongWordArray;
  1001. NativeUIntArray = array of NativeUInt;
  1002. ShortIntArray = array of ShortInt;
  1003. SmallIntArray = array of SmallInt;
  1004. LongIntArray = array of LongInt;
  1005. IntegerArray = LongIntArray;
  1006. NativeIntArray = array of NativeInt;
  1007. Int64Array = array of Int64;
  1008. SingleArray = array of Single;
  1009. DoubleArray = array of Double;
  1010. ExtendedArray = array of Extended;
  1011. CurrencyArray = array of Currency;
  1012. BooleanArray = array of Boolean;
  1013. AnsiStringArray = array of AnsiString;
  1014. WideStringArray = array of WideString;
  1015. UnicodeStringArray = array of UnicodeString;
  1016. StringArray = array of String;
  1017. {$IFNDEF ManagedCode}
  1018. PointerArray = array of Pointer;
  1019. {$ENDIF}
  1020. ObjectArray = array of TObject;
  1021. InterfaceArray = array of IInterface;
  1022. CharSetArray = array of CharSet;
  1023. ByteSetArray = array of ByteSet;
  1024. {$IFDEF ManagedCode}
  1025. procedure FreeObjectArray(var V: ObjectArray); overload;
  1026. procedure FreeObjectArray(var V: ObjectArray; const LoIdx, HiIdx: Integer); overload;
  1027. {$ELSE}
  1028. procedure FreeObjectArray(var V); overload;
  1029. procedure FreeObjectArray(var V; const LoIdx, HiIdx: Integer); overload;
  1030. {$ENDIF}
  1031. procedure FreeAndNilObjectArray(var V: ObjectArray);
  1032. {$IFNDEF CLR}
  1033. { }
  1034. { Generic quick sort algorithm }
  1035. { }
  1036. type
  1037. TQuickSortCompareFunction =
  1038. function (const Data: Pointer; const Index1, Index2: Integer): TCompareResult;
  1039. TQuickSortSwapFunction =
  1040. procedure (const Data: Pointer; const Index1, Index2: Integer);
  1041. procedure GenericQuickSort(const Data: Pointer; const Count: Integer;
  1042. const CompareFunc: TQuickSortCompareFunction;
  1043. const SwapFunc: TQuickSortSwapFunction);
  1044. { }
  1045. { Generic binary search algorithm }
  1046. { }
  1047. type
  1048. TBinarySearchCompareFunction =
  1049. function (const Data: Pointer; const Index: Integer;
  1050. const Item: Pointer): TCompareResult;
  1051. function GenericBinarySearch(const Data: Pointer; const Count: Integer;
  1052. const Item: Pointer;
  1053. const CompareFunc: TBinarySearchCompareFunction): Integer;
  1054. {$ENDIF}
  1055. { }
  1056. { Test cases }
  1057. { }
  1058. {$IFDEF UTILS_SELFTEST}
  1059. procedure SelfTest;
  1060. {$ENDIF}
  1061. implementation
  1062. uses
  1063. { System }
  1064. SysUtils,
  1065. Math;
  1066. { }
  1067. { CPU identification }
  1068. { }
  1069. {$IFDEF ASM386_DELPHI}
  1070. var
  1071. CPUIDInitialised : Boolean = False;
  1072. CPUIDSupport : Boolean = False;
  1073. MMXSupport : Boolean = False;
  1074. procedure InitialiseCPUID; assembler;
  1075. asm
  1076. // Set CPUID flag
  1077. PUSHFD
  1078. POP EAX
  1079. OR EAX, $200000
  1080. PUSH EAX
  1081. POPFD
  1082. // Check if CPUID flag is still set
  1083. PUSHFD
  1084. POP EAX
  1085. AND EAX, $200000
  1086. JNZ @CPUIDSupported
  1087. // CPUID not supported
  1088. MOV BYTE PTR [CPUIDSupport], 0
  1089. MOV BYTE PTR [MMXSupport], 0
  1090. JMP @CPUIDFin
  1091. // CPUID supported
  1092. @CPUIDSupported:
  1093. MOV BYTE PTR [CPUIDSupport], 1
  1094. PUSH EBX
  1095. // Perform CPUID function 1
  1096. MOV EAX, 1
  1097. {$IFDEF DELPHI5_DOWN}
  1098. DW 0FA2h
  1099. {$ELSE}
  1100. CPUID
  1101. {$ENDIF}
  1102. // Check if MMX feature flag is set
  1103. AND EDX, $800000
  1104. SETNZ AL
  1105. MOV BYTE PTR [MMXSupport], AL
  1106. POP EBX
  1107. @CPUIDFin:
  1108. MOV BYTE PTR [CPUIDInitialised], 1
  1109. end;
  1110. {$ENDIF}
  1111. { }
  1112. { Range check error }
  1113. { }
  1114. resourcestring
  1115. SRangeCheckError = 'Range check error';
  1116. procedure RaiseRangeCheckError; {$IFDEF UseInline}inline;{$ENDIF}
  1117. begin
  1118. raise ERangeError.Create(SRangeCheckError);
  1119. end;
  1120. { }
  1121. { Integer }
  1122. { }
  1123. function MinI(const A, B: Integer): Integer;
  1124. begin
  1125. if A < B then
  1126. Result := A
  1127. else
  1128. Result := B;
  1129. end;
  1130. function MaxI(const A, B: Integer): Integer;
  1131. begin
  1132. if A > B then
  1133. Result := A
  1134. else
  1135. Result := B;
  1136. end;
  1137. function MinC(const A, B: Cardinal): Cardinal;
  1138. begin
  1139. if A < B then
  1140. Result := A
  1141. else
  1142. Result := B;
  1143. end;
  1144. function MaxC(const A, B: Cardinal): Cardinal;
  1145. begin
  1146. if A > B then
  1147. Result := A
  1148. else
  1149. Result := B;
  1150. end;
  1151. function Clip(const Value: LongInt; const Low, High: LongInt): LongInt;
  1152. begin
  1153. if Value < Low then
  1154. Result := Low else
  1155. if Value > High then
  1156. Result := High
  1157. else
  1158. Result := Value;
  1159. end;
  1160. function Clip(const Value: Int64; const Low, High: Int64): Int64;
  1161. begin
  1162. if Value < Low then
  1163. Result := Low else
  1164. if Value > High then
  1165. Result := High
  1166. else
  1167. Result := Value;
  1168. end;
  1169. function ClipByte(const Value: LongInt): LongInt;
  1170. begin
  1171. if Value < MinByte then
  1172. Result := MinByte else
  1173. if Value > MaxByte then
  1174. Result := MaxByte
  1175. else
  1176. Result := Value;
  1177. end;
  1178. function ClipByte(const Value: Int64): Int64;
  1179. begin
  1180. if Value < MinByte then
  1181. Result := MinByte else
  1182. if Value > MaxByte then
  1183. Result := MaxByte
  1184. else
  1185. Result := Value;
  1186. end;
  1187. function ClipWord(const Value: LongInt): LongInt;
  1188. begin
  1189. if Value < MinWord then
  1190. Result := MinWord else
  1191. if Value > MaxWord then
  1192. Result := MaxWord
  1193. else
  1194. Result := Value;
  1195. end;
  1196. function ClipWord(const Value: Int64): Int64;
  1197. begin
  1198. if Value < MinWord then
  1199. Result := MinWord else
  1200. if Value > MaxWord then
  1201. Result := MaxWord
  1202. else
  1203. Result := Value;
  1204. end;
  1205. function ClipLongWord(const Value: Int64): LongWord;
  1206. begin
  1207. if Value < MinLongWord then
  1208. Result := MinLongWord else
  1209. if Value > MaxLongWord then
  1210. Result := MaxLongWord
  1211. else
  1212. Result := LongWord(Value);
  1213. end;
  1214. function SumClipI(const A, I: Integer): Integer;
  1215. begin
  1216. if I >= 0 then
  1217. if A >= MaxInteger - I then
  1218. Result := MaxInteger
  1219. else
  1220. Result := A + I
  1221. else
  1222. if A <= MinInteger - I then
  1223. Result := MinInteger
  1224. else
  1225. Result := A + I;
  1226. end;
  1227. function SumClipC(const A: Cardinal; const I: Integer): Cardinal;
  1228. var B : Cardinal;
  1229. begin
  1230. if I >= 0 then
  1231. if A >= MaxCardinal - Cardinal(I) then
  1232. Result := MaxCardinal
  1233. else
  1234. Result := A + Cardinal(I)
  1235. else
  1236. begin
  1237. B := Cardinal(-I);
  1238. if A <= B then
  1239. Result := 0
  1240. else
  1241. Result := A - B;
  1242. end;
  1243. end;
  1244. function InByteRange(const A: Int64): Boolean;
  1245. begin
  1246. Result := (A >= MinByte) and (A <= MaxByte);
  1247. end;
  1248. function InWordRange(const A: Int64): Boolean;
  1249. begin
  1250. Result := (A >= MinWord) and (A <= MaxWord);
  1251. end;
  1252. function InLongWordRange(const A: Int64): Boolean;
  1253. begin
  1254. Result := (A >= MinLongWord) and (A <= MaxLongWord);
  1255. end;
  1256. function InShortIntRange(const A: Int64): Boolean;
  1257. begin
  1258. Result := (A >= MinShortInt) and (A <= MaxShortInt);
  1259. end;
  1260. function InSmallIntRange(const A: Int64): Boolean;
  1261. begin
  1262. Result := (A >= MinSmallInt) and (A <= MaxSmallInt);
  1263. end;
  1264. function InLongIntRange(const A: Int64): Boolean;
  1265. begin
  1266. Result := (A >= MinLongInt) and (A <= MaxLongInt);
  1267. end;
  1268. { }
  1269. { Real }
  1270. { }
  1271. function MinF(const A, B: Float): Float;
  1272. begin
  1273. if A < B then
  1274. Result := A
  1275. else
  1276. Result := B;
  1277. end;
  1278. function MaxF(const A, B: Float): Float;
  1279. begin
  1280. if A > B then
  1281. Result := A
  1282. else
  1283. Result := B;
  1284. end;
  1285. function ClipF(const Value: Float; const Low, High: Float): Float;
  1286. begin
  1287. if Value < Low then
  1288. Result := Low else
  1289. if Value > High then
  1290. Result := High
  1291. else
  1292. Result := Value;
  1293. end;
  1294. function InSingleRange(const A: Float): Boolean;
  1295. var B : Float;
  1296. begin
  1297. B := Abs(A);
  1298. Result := (B >= MinSingle) and (B <= MaxSingle);
  1299. end;
  1300. {$IFDEF CLR}
  1301. function InDoubleRange(const A: Float): Boolean;
  1302. begin
  1303. Result := True;
  1304. end;
  1305. {$ELSE}
  1306. function InDoubleRange(const A: Float): Boolean;
  1307. var B : Float;
  1308. begin
  1309. B := Abs(A);
  1310. Result := (B >= MinDouble) and (B <= MaxDouble);
  1311. end;
  1312. {$ENDIF}
  1313. {$IFNDEF CLR}
  1314. function InCurrencyRange(const A: Float): Boolean;
  1315. begin
  1316. Result := (A >= MinCurrency) and (A <= MaxCurrency);
  1317. end;
  1318. function InCurrencyRange(const A: Int64): Boolean;
  1319. begin
  1320. Result := (A >= MinCurrency) and (A <= MaxCurrency);
  1321. end;
  1322. {$ENDIF}
  1323. {$IFNDEF ExtendedIsDouble}
  1324. function FloatExponentBase2(const A: Extended; var Exponent: Integer): Boolean;
  1325. var RecA : ExtendedRec absolute A;
  1326. ExpA : Word;
  1327. begin
  1328. ExpA := RecA.Exponent and $7FFF;
  1329. if ExpA = $7FFF then // A is NaN, Infinity, ...
  1330. begin
  1331. Exponent := 0;
  1332. Result := False;
  1333. end
  1334. else
  1335. begin
  1336. Exponent := Integer(ExpA) - 16383;
  1337. Result := True;
  1338. end;
  1339. end;
  1340. function FloatExponentBase10(const A: Extended; var Exponent: Integer): Boolean;
  1341. const Log2_10 = 3.32192809488736; // Log2(10)
  1342. begin
  1343. Result := FloatExponentBase2(A, Exponent);
  1344. if Result then
  1345. Exponent := Round(Exponent / Log2_10);
  1346. end;
  1347. {$ENDIF}
  1348. function FloatIsInfinity(const A: Extended): Boolean;
  1349. var Ext : ExtendedRec absolute A;
  1350. begin
  1351. if Ext.Exponent and $7FFF <> $7FFF then
  1352. Result := False
  1353. else
  1354. Result := (Ext.Mantissa[1] = $80000000) and (Ext.Mantissa[0] = 0);
  1355. end;
  1356. function FloatIsNaN(const A: Extended): Boolean;
  1357. var Ext : ExtendedRec absolute A;
  1358. begin
  1359. if Ext.Exponent and $7FFF <> $7FFF then
  1360. Result := False
  1361. else
  1362. Result := (Ext.Mantissa[1] <> $80000000) or (Ext.Mantissa[0] <> 0)
  1363. end;
  1364. { }
  1365. { Approximate comparison }
  1366. { }
  1367. function FloatZero(const A: Float; const CompareDelta: Float): Boolean;
  1368. begin
  1369. Assert(CompareDelta >= 0.0);
  1370. Result := Abs(A) <= CompareDelta;
  1371. end;
  1372. function FloatOne(const A: Float; const CompareDelta: Float): Boolean;
  1373. begin
  1374. Assert(CompareDelta >= 0.0);
  1375. Result := Abs(A - 1.0) <= CompareDelta;
  1376. end;
  1377. function FloatsEqual(const A, B: Float; const CompareDelta: Float): Boolean;
  1378. begin
  1379. Assert(CompareDelta >= 0.0);
  1380. Result := Abs(A - B) <= CompareDelta;
  1381. end;
  1382. function FloatsCompare(const A, B: Float; const CompareDelta: Float): TCompareResult;
  1383. var D : Float;
  1384. begin
  1385. Assert(CompareDelta >= 0.0);
  1386. D := A - B;
  1387. if Abs(D) <= CompareDelta then
  1388. Result := crEqual else
  1389. if D >= CompareDelta then
  1390. Result := crGreater
  1391. else
  1392. Result := crLess;
  1393. end;
  1394. {$IFNDEF ExtendedIsDouble}
  1395. { }
  1396. { Scaled approximate comparison }
  1397. { }
  1398. { The ApproxEqual and ApproxCompare functions were taken from the freeware }
  1399. { FltMath unit by Tempest Software, as taken from Knuth, Seminumerical }
  1400. { Algorithms, 2nd ed., Addison-Wesley, 1981, pp. 217-220. }
  1401. { }
  1402. function ApproxEqual(const A, B: Extended; const CompareEpsilon: Double): Boolean;
  1403. var ExtA : ExtendedRec absolute A;
  1404. ExtB : ExtendedRec absolute B;
  1405. ExpA : Word;
  1406. ExpB : Word;
  1407. Exp : ExtendedRec;
  1408. begin
  1409. ExpA := ExtA.Exponent and $7FFF;
  1410. ExpB := ExtB.Exponent and $7FFF;
  1411. if (ExpA = $7FFF) and
  1412. ((ExtA.Mantissa[1] <> $80000000) or (ExtA.Mantissa[0] <> 0)) then
  1413. { A is NaN }
  1414. Result := False else
  1415. if (ExpB = $7FFF) and
  1416. ((ExtB.Mantissa[1] <> $80000000) or (ExtB.Mantissa[0] <> 0)) then
  1417. { B is NaN }
  1418. Result := False else
  1419. if (ExpA = $7FFF) or (ExpB = $7FFF) then
  1420. { A or B is infinity. Use the builtin comparison, which will }
  1421. { properly account for signed infinities, comparing infinity with }
  1422. { infinity, or comparing infinity with a finite value. }
  1423. Result := A = B else
  1424. begin
  1425. { We are comparing two finite values, so take the difference and }
  1426. { compare that against the scaled Epsilon. }
  1427. Exp.Value := 1.0;
  1428. if ExpA < ExpB then
  1429. Exp.Exponent := ExpB
  1430. else
  1431. Exp.Exponent := ExpA;
  1432. Result := Abs(A - B) <= (CompareEpsilon * Exp.Value);
  1433. end;
  1434. end;
  1435. function ApproxCompare(const A, B: Extended; const CompareEpsilon: Double): TCompareResult;
  1436. var ExtA : ExtendedRec absolute A;
  1437. ExtB : ExtendedRec absolute B;
  1438. ExpA : Word;
  1439. ExpB : Word;
  1440. Exp : ExtendedRec;
  1441. D, E : Extended;
  1442. begin
  1443. ExpA := ExtA.Exponent and $7FFF;
  1444. ExpB := ExtB.Exponent and $7FFF;
  1445. if (ExpA = $7FFF) and
  1446. ((ExtA.Mantissa[1] <> $80000000) or (ExtA.Mantissa[0] <> 0)) then
  1447. { A is NaN }
  1448. Result := crUndefined else
  1449. if (ExpB = $7FFF) and
  1450. ((ExtB.Mantissa[1] <> $80000000) or (ExtB.Mantissa[0] <> 0)) then
  1451. { B is NaN }
  1452. Result := crUndefined else
  1453. if (ExpA = $7FFF) or (ExpB = $7FFF) then
  1454. { A or B is infinity. Use the builtin comparison, which will }
  1455. { properly account for signed infinities, comparing infinity with }
  1456. { infinity, or comparing infinity with a finite value. }
  1457. Result := Compare(A, B) else
  1458. begin
  1459. { We are comparing two finite values, so take the difference and }
  1460. { compare that against the scaled Epsilon. }
  1461. Exp.Value := 1.0;
  1462. if ExpA < ExpB then
  1463. Exp.Exponent := ExpB
  1464. else
  1465. Exp.Exponent := ExpA;
  1466. E := CompareEpsilon * Exp.Value;
  1467. D := A - B;
  1468. if Abs(D) <= E then
  1469. Result := crEqual else
  1470. if D >= E then
  1471. Result := crGreater
  1472. else
  1473. Result := crLess;
  1474. end;
  1475. end;
  1476. {$ENDIF}
  1477. { }
  1478. { Bit functions }
  1479. { }
  1480. {$IFDEF ASM386_DELPHI}
  1481. function ReverseBits(const Value: LongWord): LongWord; register; assembler;
  1482. asm
  1483. BSWAP EAX
  1484. MOV EDX, EAX
  1485. AND EAX, 0AAAAAAAAh
  1486. SHR EAX, 1
  1487. AND EDX, 055555555h
  1488. SHL EDX, 1
  1489. OR EAX, EDX
  1490. MOV EDX, EAX
  1491. AND EAX, 0CCCCCCCCh
  1492. SHR EAX, 2
  1493. AND EDX, 033333333h
  1494. SHL EDX, 2
  1495. OR EAX, EDX
  1496. MOV EDX, EAX
  1497. AND EAX, 0F0F0F0F0h
  1498. SHR EAX, 4
  1499. AND EDX, 00F0F0F0Fh
  1500. SHL EDX, 4
  1501. OR EAX, EDX
  1502. end;
  1503. {$ELSE}
  1504. function ReverseBits(const Value: LongWord): LongWord;
  1505. var I : Byte;
  1506. begin
  1507. Result := 0;
  1508. for I := 0 to 31 do
  1509. if Value and BitMaskTable[I] <> 0 then
  1510. Result := Result or BitMaskTable[31 - I];
  1511. end;
  1512. {$ENDIF}
  1513. function ReverseBits(const Value: LongWord; const BitCount: Integer): LongWord;
  1514. var I : Integer;
  1515. V : LongWord;
  1516. begin
  1517. V := Value;
  1518. Result := 0;
  1519. for I := 0 to MinI(BitCount, BitsPerLongWord) - 1 do
  1520. begin
  1521. Result := (Result shl 1) or (V and 1);
  1522. V := V shr 1;
  1523. end;
  1524. end;
  1525. {$IFDEF ASM386_DELPHI}
  1526. function SwapEndian(const Value: LongWord): LongWord; register; assembler;
  1527. asm
  1528. XCHG AH, AL
  1529. ROL EAX, 16
  1530. XCHG AH, AL
  1531. end;
  1532. {$ELSE}
  1533. function SwapEndian(const Value: LongWord): LongWord;
  1534. begin
  1535. Result := ((Value and $000000FF) shl 24) or
  1536. ((Value and $0000FF00) shl 8) or
  1537. ((Value and $00FF0000) shr 8) or
  1538. ((Value and $FF000000) shr 24);
  1539. end;
  1540. {$ENDIF}
  1541. {$IFDEF ManagedCode}
  1542. procedure SwapEndianBuf(var Buf: array of LongWord);
  1543. var I : Integer;
  1544. begin
  1545. for I := 0 to Length(Buf) - 1 do
  1546. Buf[I] := SwapEndian(Buf[I]);
  1547. end;
  1548. {$ELSE}
  1549. procedure SwapEndianBuf(var Buf; const Count: Integer);
  1550. var P : PLongWord;
  1551. I : Integer;
  1552. begin
  1553. P := @Buf;
  1554. for I := 1 to Count do
  1555. begin
  1556. P^ := SwapEndian(P^);
  1557. Inc(P);
  1558. end;
  1559. end;
  1560. {$ENDIF}
  1561. {$IFDEF ASM386_DELPHI}
  1562. function TwosComplement(const Value: LongWord): LongWord; register; assembler;
  1563. asm
  1564. NEG EAX
  1565. end;
  1566. {$ELSE}
  1567. function TwosComplement(const Value: LongWord): LongWord;
  1568. begin
  1569. Result := LongWord(not Value + 1);
  1570. end;
  1571. {$ENDIF}
  1572. {$IFDEF ASM386_DELPHI}
  1573. function RotateLeftBits16(const Value: Word; const Bits: Byte): Word;
  1574. asm
  1575. MOV CL, DL
  1576. ROL AX, CL
  1577. end;
  1578. {$ELSE}
  1579. function RotateLeftBits16(const Value: Word; const Bits: Byte): Word;
  1580. var I, B : Integer;
  1581. R : Word;
  1582. begin
  1583. R := Value;
  1584. if Bits >= 16 then
  1585. B := Bits mod 16
  1586. else
  1587. B := Bits;
  1588. for I := 1 to B do
  1589. if R and $8000 = 0 then
  1590. R := Word(R shl 1)
  1591. else
  1592. R := Word(R shl 1) or 1;
  1593. Result := R;
  1594. end;
  1595. {$ENDIF}
  1596. {$IFDEF ASM386_DELPHI}
  1597. function RotateLeftBits32(const Value: LongWord; const Bits: Byte): LongWord;
  1598. asm
  1599. MOV CL, DL
  1600. ROL EAX, CL
  1601. end;
  1602. {$ELSE}
  1603. function RotateLeftBits32(const Value: LongWord; const Bits: Byte): LongWord;
  1604. var I, B : Integer;
  1605. R : LongWord;
  1606. begin
  1607. R := Value;
  1608. if Bits >= 32 then
  1609. B := Bits mod 32
  1610. else
  1611. B := Bits;
  1612. for I := 1 to B do
  1613. if R and $80000000 = 0 then
  1614. R := LongWord(R shl 1)
  1615. else
  1616. R := LongWord(R shl 1) or 1;
  1617. Result := R;
  1618. end;
  1619. {$ENDIF}
  1620. {$IFDEF ASM386_DELPHI}
  1621. function RotateRightBits16(const Value: Word; const Bits: Byte): Word;
  1622. asm
  1623. MOV CL, DL
  1624. ROR AX, CL
  1625. end;
  1626. {$ELSE}
  1627. function RotateRightBits16(const Value: Word; const Bits: Byte): Word;
  1628. var I, B : Integer;
  1629. R : Word;
  1630. begin
  1631. R := Value;
  1632. if Bits >= 16 then
  1633. B := Bits mod 16
  1634. else
  1635. B := Bits;
  1636. for I := 1 to B do
  1637. if R and 1 = 0 then
  1638. R := Word(R shr 1)
  1639. else
  1640. R := Word(R shr 1) or $8000;
  1641. Result := R;
  1642. end;
  1643. {$ENDIF}
  1644. {$IFDEF ASM386_DELPHI}
  1645. function RotateRightBits32(const Value: LongWord; const Bits: Byte): LongWord;
  1646. asm
  1647. MOV CL, DL
  1648. ROR EAX, CL
  1649. end;
  1650. {$ELSE}
  1651. function RotateRightBits32(const Value: LongWord; const Bits: Byte): LongWord;
  1652. var I, B : Integer;
  1653. R : LongWord;
  1654. begin
  1655. R := Value;
  1656. if Bits >= 32 then
  1657. B := Bits mod 32
  1658. else
  1659. B := Bits;
  1660. for I := 1 to B do
  1661. if R and 1 = 0 then
  1662. R := LongWord(R shr 1)
  1663. else
  1664. R := LongWord(R shr 1) or $80000000;
  1665. Result := R;
  1666. end;
  1667. {$ENDIF}
  1668. {$IFDEF ASM386_DELPHI}
  1669. function SetBit(const Value, BitIndex: LongWord): LongWord;
  1670. asm
  1671. {$IFOPT R+}
  1672. CMP BitIndex, BitsPerLongWord
  1673. JB @RangeOk
  1674. JMP RaiseRangeCheckError
  1675. @RangeOk:
  1676. {$ENDIF}
  1677. OR EAX, DWORD PTR [BitIndex * 4 + BitMaskTable]
  1678. end;
  1679. {$ELSE}
  1680. function SetBit(const Value, BitIndex: LongWord): LongWord;
  1681. begin
  1682. Result := Value or BitMaskTable[BitIndex];
  1683. end;
  1684. {$ENDIF}
  1685. {$IFDEF ASM386_DELPHI}
  1686. function ClearBit(const Value, BitIndex: LongWord): LongWord;
  1687. asm
  1688. {$IFOPT R+}
  1689. CMP BitIndex, BitsPerLongWord
  1690. JB @RangeOk
  1691. JMP RaiseRangeCheckError
  1692. @RangeOk:
  1693. {$ENDIF}
  1694. MOV ECX, DWORD PTR [BitIndex * 4 + BitMaskTable]
  1695. NOT ECX
  1696. AND EAX, ECX
  1697. @Fin:
  1698. end;
  1699. {$ELSE}
  1700. function ClearBit(const Value, BitIndex: LongWord): LongWord;
  1701. begin
  1702. Result := Value and not BitMaskTable[BitIndex];
  1703. end;
  1704. {$ENDIF}
  1705. {$IFDEF ASM386_DELPHI}
  1706. function ToggleBit(const Value, BitIndex: LongWord): LongWord;
  1707. asm
  1708. {$IFOPT R+}
  1709. CMP BitIndex, BitsPerLongWord
  1710. JB @RangeOk
  1711. JMP RaiseRangeCheckError
  1712. @RangeOk:
  1713. {$ENDIF}
  1714. XOR EAX, DWORD PTR [BitIndex * 4 + BitMaskTable]
  1715. end;
  1716. {$ELSE}
  1717. function ToggleBit(const Value, BitIndex: LongWord): LongWord;
  1718. begin
  1719. Result := Value xor BitMaskTable[BitIndex];
  1720. end;
  1721. {$ENDIF}
  1722. {$IFDEF ASM386_DELPHI}
  1723. function IsHighBitSet(const Value: LongWord): Boolean; register; assembler;
  1724. asm
  1725. TEST Value, $80000000
  1726. SETNZ AL
  1727. end;
  1728. {$ELSE}
  1729. function IsHighBitSet(const Value: LongWord): Boolean;
  1730. begin
  1731. Result := Value and $80000000 <> 0;
  1732. end;
  1733. {$ENDIF}
  1734. {$IFDEF ASM386_DELPHI}
  1735. function IsBitSet(const Value, BitIndex: LongWord): Boolean;
  1736. asm
  1737. {$IFOPT R+}
  1738. CMP BitIndex, BitsPerLongWord
  1739. JB @RangeOk
  1740. JMP RaiseRangeCheckError
  1741. @RangeOk:
  1742. {$ENDIF}
  1743. MOV ECX, DWORD PTR BitMaskTable [BitIndex * 4]
  1744. TEST Value, ECX
  1745. SETNZ AL
  1746. end;
  1747. {$ELSE}
  1748. function IsBitSet(const Value, BitIndex: LongWord): Boolean;
  1749. begin
  1750. Result := Value and BitMaskTable[BitIndex] <> 0;
  1751. end;
  1752. {$ENDIF}
  1753. {$IFDEF ASM386_DELPHI}
  1754. function SetBitScanForward(const Value: LongWord): Integer;
  1755. asm
  1756. OR EAX, EAX
  1757. JZ @NoBits
  1758. BSF EAX, EAX
  1759. RET
  1760. @NoBits:
  1761. MOV EAX, -1
  1762. end;
  1763. function SetBitScanForward(const Value, BitIndex: LongWord): Integer;
  1764. asm
  1765. CMP BitIndex, BitsPerLongWord
  1766. JAE @NotFound
  1767. MOV ECX, BitIndex
  1768. MOV EDX, $FFFFFFFF
  1769. SHL EDX, CL
  1770. AND EDX, EAX
  1771. JE @NotFound
  1772. BSF EAX, EDX
  1773. RET
  1774. @NotFound:
  1775. MOV EAX, -1
  1776. end;
  1777. {$ELSE}
  1778. function SetBitScanForward(const Value, BitIndex: LongWord): Integer;
  1779. var I : Integer;
  1780. begin
  1781. if BitIndex < BitsPerLongWord then
  1782. for I := Integer(BitIndex) to 31 do
  1783. if Value and BitMaskTable[I] <> 0 then
  1784. begin
  1785. Result := I;
  1786. exit;
  1787. end;
  1788. Result := -1;
  1789. end;
  1790. function SetBitScanForward(const Value: LongWord): Integer;
  1791. begin
  1792. Result := SetBitScanForward(Value, 0);
  1793. end;
  1794. {$ENDIF}
  1795. {$IFDEF ASM386_DELPHI}
  1796. function SetBitScanReverse(const Value: LongWord): Integer;
  1797. asm
  1798. OR EAX, EAX
  1799. JZ @NoBits
  1800. BSR EAX, EAX
  1801. RET
  1802. @NoBits:
  1803. MOV EAX, -1
  1804. end;
  1805. function SetBitScanReverse(const Value, BitIndex: LongWord): Integer;
  1806. asm
  1807. CMP EDX, BitsPerLongWord
  1808. JAE @NotFound
  1809. LEA ECX, [EDX - 31]
  1810. MOV EDX, $FFFFFFFF
  1811. NEG ECX
  1812. SHR EDX, CL
  1813. AND EDX, EAX
  1814. JE @NotFound
  1815. BSR EAX, EDX
  1816. RET
  1817. @NotFound:
  1818. MOV EAX, -1
  1819. end;
  1820. {$ELSE}
  1821. function SetBitScanReverse(const Value, BitIndex: LongWord): Integer;
  1822. var I : Integer;
  1823. begin
  1824. if BitIndex < BitsPerLongWord then
  1825. for I := Integer(BitIndex) downto 0 do
  1826. if Value and BitMaskTable[I] <> 0 then
  1827. begin
  1828. Result := I;
  1829. exit;
  1830. end;
  1831. Result := -1;
  1832. end;
  1833. function SetBitScanReverse(const Value: LongWord): Integer;
  1834. begin
  1835. Result := SetBitScanReverse(Value, 31);
  1836. end;
  1837. {$ENDIF}
  1838. {$IFDEF ASM386_DELPHI}
  1839. function ClearBitScanForward(const Value: LongWord): Integer;
  1840. asm
  1841. NOT EAX
  1842. OR EAX, EAX
  1843. JZ @NoBits
  1844. BSF EAX, EAX
  1845. RET
  1846. @NoBits:
  1847. MOV EAX, -1
  1848. end;
  1849. function ClearBitScanForward(const Value, BitIndex: LongWord): Integer;
  1850. asm
  1851. CMP EDX, BitsPerLongWord
  1852. JAE @NotFound
  1853. MOV ECX, EDX
  1854. MOV EDX, $FFFFFFFF
  1855. NOT EAX
  1856. SHL EDX, CL
  1857. AND EDX, EAX
  1858. JE @NotFound
  1859. BSF EAX, EDX
  1860. RET
  1861. @NotFound:
  1862. MOV EAX, -1
  1863. end;
  1864. {$ELSE}
  1865. function ClearBitScanForward(const Value, BitIndex: LongWord): Integer;
  1866. var I : Integer;
  1867. begin
  1868. if BitIndex < BitsPerLongWord then
  1869. for I := Integer(BitIndex) to 31 do
  1870. if Value and BitMaskTable[I] = 0 then
  1871. begin
  1872. Result := I;
  1873. exit;
  1874. end;
  1875. Result := -1;
  1876. end;
  1877. function ClearBitScanForward(const Value: LongWord): Integer;
  1878. begin
  1879. Result := ClearBitScanForward(Value, 0);
  1880. end;
  1881. {$ENDIF}
  1882. {$IFDEF ASM386_DELPHI}
  1883. function ClearBitScanReverse(const Value: LongWord): Integer;
  1884. asm
  1885. NOT EAX
  1886. OR EAX, EAX
  1887. JZ @NoBits
  1888. BSR EAX, EAX
  1889. RET
  1890. @NoBits:
  1891. MOV EAX, -1
  1892. end;
  1893. function ClearBitScanReverse(const Value, BitIndex: LongWord): Integer;
  1894. asm
  1895. CMP EDX, BitsPerLongWord
  1896. JAE @NotFound
  1897. LEA ECX, [EDX - 31]
  1898. MOV EDX, $FFFFFFFF
  1899. NEG ECX
  1900. NOT EAX
  1901. SHR EDX, CL
  1902. AND EDX, EAX
  1903. JE @NotFound
  1904. BSR EAX, EDX
  1905. RET
  1906. @NotFound:
  1907. MOV EAX, -1
  1908. end;
  1909. {$ELSE}
  1910. function ClearBitScanReverse(const Value, BitIndex: LongWord): Integer;
  1911. var I : Integer;
  1912. begin
  1913. if BitIndex < BitsPerLongWord then
  1914. for I := Integer(BitIndex) downto 0 do
  1915. if Value and BitMaskTable[I] = 0 then
  1916. begin
  1917. Result := I;
  1918. exit;
  1919. end;
  1920. Result := -1;
  1921. end;
  1922. function ClearBitScanReverse(const Value: LongWord): Integer;
  1923. begin
  1924. Result := ClearBitScanReverse(Value, 31);
  1925. end;
  1926. {$ENDIF}
  1927. const
  1928. BitCountTable : array[Byte] of Byte =
  1929. (0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4,
  1930. 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
  1931. 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
  1932. 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
  1933. 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
  1934. 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
  1935. 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
  1936. 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
  1937. 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
  1938. 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
  1939. 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
  1940. 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
  1941. 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
  1942. 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
  1943. 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
  1944. 4, 5, 5, 6, 5, 6, 6, 7, 5, 6, 6, 7, 6, 7, 7, 8);
  1945. {$IFDEF ASM386_DELPHI}
  1946. function BitCount(const Value: LongWord): LongWord; register; assembler;
  1947. asm
  1948. MOVZX EDX, AL
  1949. MOVZX EDX, BYTE PTR [EDX + BitCountTable]
  1950. MOVZX ECX, AH
  1951. ADD DL, BYTE PTR [ECX + BitCountTable]
  1952. SHR EAX, 16
  1953. MOVZX ECX, AH
  1954. ADD DL, BYTE PTR [ECX + BitCountTable]
  1955. AND EAX, $FF
  1956. ADD DL, BYTE PTR [EAX + BitCountTable]
  1957. MOV AL, DL
  1958. end;
  1959. {$ELSE}
  1960. function BitCount(const Value: LongWord): LongWord;
  1961. begin
  1962. Result := BitCountTable[(Value and $000000FF) ] +
  1963. BitCountTable[(Value and $0000FF00) shr 8 ] +
  1964. BitCountTable[(Value and $00FF0000) shr 16] +
  1965. BitCountTable[(Value and $FF000000) shr 24];
  1966. end;
  1967. {$ENDIF}
  1968. function IsPowerOfTwo(const Value: LongWord): Boolean;
  1969. begin
  1970. Result := BitCount(Value) = 1;
  1971. end;
  1972. function LowBitMask(const HighBitIndex: LongWord): LongWord;
  1973. begin
  1974. if HighBitIndex >= BitsPerLongWord then
  1975. Result := 0
  1976. else
  1977. Result := BitMaskTable[HighBitIndex] - 1;
  1978. end;
  1979. function HighBitMask(const LowBitIndex: LongWord): LongWord;
  1980. begin
  1981. if LowBitIndex >= BitsPerLongWord then
  1982. Result := 0
  1983. else
  1984. Result := not BitMaskTable[LowBitIndex] + 1;
  1985. end;
  1986. function RangeBitMask(const LowBitIndex, HighBitIndex: LongWord): LongWord;
  1987. begin
  1988. if (LowBitIndex >= BitsPerLongWord) and (HighBitIndex >= BitsPerLongWord) then
  1989. begin
  1990. Result := 0;
  1991. exit;
  1992. end;
  1993. Result := $FFFFFFFF;
  1994. if LowBitIndex > 0 then
  1995. Result := Result xor (BitMaskTable[LowBitIndex] - 1);
  1996. if HighBitIndex < 31 then
  1997. Result := Result xor (not BitMaskTable[HighBitIndex + 1] + 1);
  1998. end;
  1999. function SetBitRange(const Value: LongWord; const LowBitIndex, HighBitIndex: LongWord): LongWord;
  2000. begin
  2001. Result := Value or RangeBitMask(LowBitIndex, HighBitIndex);
  2002. end;
  2003. function ClearBitRange(const Value: LongWord; const LowBitIndex, HighBitIndex: LongWord): LongWord;
  2004. begin
  2005. Result := Value and not RangeBitMask(LowBitIndex, HighBitIndex);
  2006. end;
  2007. function ToggleBitRange(const Value: LongWord; const LowBitIndex, HighBitIndex: LongWord): LongWord;
  2008. begin
  2009. Result := Value xor RangeBitMask(LowBitIndex, HighBitIndex);
  2010. end;
  2011. function IsBitRangeSet(const Value: LongWord; const LowBitIndex, HighBitIndex: LongWord): Boolean;
  2012. var M: LongWord;
  2013. begin
  2014. M := RangeBitMask(LowBitIndex, HighBitIndex);
  2015. Result := Value and M = M;
  2016. end;
  2017. function IsBitRangeClear(const Value: LongWord; const LowBitIndex, HighBitIndex: LongWord): Boolean;
  2018. begin
  2019. Result := Value and RangeBitMask(LowBitIndex, HighBitIndex) = 0;
  2020. end;
  2021. { }
  2022. { Sets }
  2023. { }
  2024. function AsCharSet(const C: array of AnsiChar): CharSet;
  2025. var I: Integer;
  2026. begin
  2027. Result := [];
  2028. for I := 0 to High(C) do
  2029. Include(Result, C[I]);
  2030. end;
  2031. function AsByteSet(const C: array of Byte): ByteSet;
  2032. var I: Integer;
  2033. begin
  2034. Result := [];
  2035. for I := 0 to High(C) do
  2036. Include(Result, C[I]);
  2037. end;
  2038. {$IFDEF ASM386_DELPHI}
  2039. procedure ComplementChar(var C: CharSet; const Ch: AnsiChar);
  2040. asm
  2041. MOVZX ECX, DL
  2042. BTC [EAX], ECX
  2043. end;
  2044. {$ELSE}
  2045. procedure ComplementChar(var C: CharSet; const Ch: AnsiChar);
  2046. begin
  2047. if Ch in C then
  2048. Exclude(C, Ch)
  2049. else
  2050. Include(C, Ch);
  2051. end;
  2052. {$ENDIF}
  2053. {$IFDEF ASM386_DELPHI}
  2054. procedure ClearCharSet(var C: CharSet);
  2055. asm
  2056. XOR EDX, EDX
  2057. MOV [EAX], EDX
  2058. MOV [EAX + 4], EDX
  2059. MOV [EAX + 8], EDX
  2060. MOV [EAX + 12], EDX
  2061. MOV [EAX + 16], EDX
  2062. MOV [EAX + 20], EDX
  2063. MOV [EAX + 24], EDX
  2064. MOV [EAX + 28], EDX
  2065. end;
  2066. {$ELSE}
  2067. procedure ClearCharSet(var C: CharSet);
  2068. begin
  2069. C := [];
  2070. end;
  2071. {$ENDIF}
  2072. {$IFDEF ASM386_DELPHI}
  2073. procedure FillCharSet(var C: CharSet);
  2074. asm
  2075. MOV EDX, $FFFFFFFF
  2076. MOV [EAX], EDX
  2077. MOV [EAX + 4], EDX
  2078. MOV [EAX + 8], EDX
  2079. MOV [EAX + 12], EDX
  2080. MOV [EAX + 16], EDX
  2081. MOV [EAX + 20], EDX
  2082. MOV [EAX + 24], EDX
  2083. MOV [EAX + 28], EDX
  2084. end;
  2085. {$ELSE}
  2086. procedure FillCharSet(var C: CharSet);
  2087. begin
  2088. C := [#0..#255];
  2089. end;
  2090. {$ENDIF}
  2091. {$IFDEF ASM386_DELPHI}
  2092. procedure ComplementCharSet(var C: CharSet);
  2093. asm
  2094. NOT DWORD PTR [EAX]
  2095. NOT DWORD PTR [EAX + 4]
  2096. NOT DWORD PTR [EAX + 8]
  2097. NOT DWORD PTR [EAX + 12]
  2098. NOT DWORD PTR [EAX + 16]
  2099. NOT DWORD PTR [EAX + 20]
  2100. NOT DWORD PTR [EAX + 24]
  2101. NOT DWORD PTR [EAX + 28]
  2102. end;
  2103. {$ELSE}
  2104. procedure ComplementCharSet(var C: CharSet);
  2105. begin
  2106. C := [#0..#255] - C;
  2107. end;
  2108. {$ENDIF}
  2109. {$IFDEF ASM386_DELPHI}
  2110. procedure AssignCharSet(var DestSet: CharSet; const SourceSet: CharSet);
  2111. asm
  2112. MOV ECX, [EDX]
  2113. MOV [EAX], ECX
  2114. MOV ECX, [EDX + 4]
  2115. MOV [EAX + 4], ECX
  2116. MOV ECX, [EDX + 8]
  2117. MOV [EAX + 8], ECX
  2118. MOV ECX, [EDX + 12]
  2119. MOV [EAX + 12], ECX
  2120. MOV ECX, [EDX + 16]
  2121. MOV [EAX + 16], ECX
  2122. MOV ECX, [EDX + 20]
  2123. MOV [EAX + 20], ECX
  2124. MOV ECX, [EDX + 24]
  2125. MOV [EAX + 24], ECX
  2126. MOV ECX, [EDX + 28]
  2127. MOV [EAX + 28], ECX
  2128. end;
  2129. {$ELSE}
  2130. procedure AssignCharSet(var DestSet: CharSet; const SourceSet: CharSet);
  2131. begin
  2132. DestSet := SourceSet;
  2133. end;
  2134. {$ENDIF}
  2135. {$IFDEF ASM386_DELPHI}
  2136. procedure Union(var DestSet: CharSet; const SourceSet: CharSet);
  2137. asm
  2138. MOV ECX, [EDX]
  2139. OR [EAX], ECX
  2140. MOV ECX, [EDX + 4]
  2141. OR [EAX + 4], ECX
  2142. MOV ECX, [EDX + 8]
  2143. OR [EAX + 8], ECX
  2144. MOV ECX, [EDX + 12]
  2145. OR [EAX + 12], ECX
  2146. MOV ECX, [EDX + 16]
  2147. OR [EAX + 16], ECX
  2148. MOV ECX, [EDX + 20]
  2149. OR [EAX + 20], ECX
  2150. MOV ECX, [EDX + 24]
  2151. OR [EAX + 24], ECX
  2152. MOV ECX, [EDX + 28]
  2153. OR [EAX + 28], ECX
  2154. end;
  2155. {$ELSE}
  2156. procedure Union(var DestSet: CharSet; const SourceSet: CharSet);
  2157. begin
  2158. DestSet := DestSet + SourceSet;
  2159. end;
  2160. {$ENDIF}
  2161. {$IFDEF ASM386_DELPHI}
  2162. procedure Difference(var DestSet: CharSet; const SourceSet: CharSet);
  2163. asm
  2164. MOV ECX, [EDX]
  2165. NOT ECX
  2166. AND [EAX], ECX
  2167. MOV ECX, [EDX + 4]
  2168. NOT ECX
  2169. AND [EAX + 4], ECX
  2170. MOV ECX, [EDX + 8]
  2171. NOT ECX
  2172. AND [EAX + 8],ECX
  2173. MOV ECX, [EDX + 12]
  2174. NOT ECX
  2175. AND [EAX + 12], ECX
  2176. MOV ECX, [EDX + 16]
  2177. NOT ECX
  2178. AND [EAX + 16], ECX
  2179. MOV ECX, [EDX + 20]
  2180. NOT ECX
  2181. AND [EAX + 20], ECX
  2182. MOV ECX, [EDX + 24]
  2183. NOT ECX
  2184. AND [EAX + 24], ECX
  2185. MOV ECX, [EDX + 28]
  2186. NOT ECX
  2187. AND [EAX + 28], ECX
  2188. end;
  2189. {$ELSE}
  2190. procedure Difference(var DestSet: CharSet; const SourceSet: CharSet);
  2191. begin
  2192. DestSet := DestSet - SourceSet;
  2193. end;
  2194. {$ENDIF}
  2195. {$IFDEF ASM386_DELPHI}
  2196. procedure Intersection(var DestSet: CharSet; const SourceSet: CharSet);
  2197. asm
  2198. MOV ECX, [EDX]
  2199. AND [EAX], ECX
  2200. MOV ECX, [EDX + 4]
  2201. AND [EAX + 4], ECX
  2202. MOV ECX, [EDX + 8]
  2203. AND [EAX + 8], ECX
  2204. MOV ECX, [EDX + 12]
  2205. AND [EAX + 12], ECX
  2206. MOV ECX, [EDX + 16]
  2207. AND [EAX + 16], ECX
  2208. MOV ECX, [EDX + 20]
  2209. AND [EAX + 20], ECX
  2210. MOV ECX, [EDX + 24]
  2211. AND [EAX + 24], ECX
  2212. MOV ECX, [EDX + 28]
  2213. AND [EAX + 28], ECX
  2214. end;
  2215. {$ELSE}
  2216. procedure Intersection(var DestSet: CharSet; const SourceSet: CharSet);
  2217. begin
  2218. DestSet := DestSet * SourceSet;
  2219. end;
  2220. {$ENDIF}
  2221. {$IFDEF ASM386_DELPHI}
  2222. procedure XORCharSet(var DestSet: CharSet; const SourceSet: CharSet);
  2223. asm
  2224. MOV ECX, [EDX]
  2225. XOR [EAX], ECX
  2226. MOV ECX, [EDX + 4]
  2227. XOR [EAX + 4], ECX
  2228. MOV ECX, [EDX + 8]
  2229. XOR [EAX + 8], ECX
  2230. MOV ECX, [EDX + 12]
  2231. XOR [EAX + 12], ECX
  2232. MOV ECX, [EDX + 16]
  2233. XOR [EAX + 16], ECX
  2234. MOV ECX, [EDX + 20]
  2235. XOR [EAX + 20], ECX
  2236. MOV ECX, [EDX + 24]
  2237. XOR [EAX + 24], ECX
  2238. MOV ECX, [EDX + 28]
  2239. XOR [EAX + 28], ECX
  2240. end;
  2241. {$ELSE}
  2242. procedure XORCharSet(var DestSet: CharSet; const SourceSet: CharSet);
  2243. var Ch: AnsiChar;
  2244. begin
  2245. for Ch := #0 to #255 do
  2246. if Ch in DestSet then
  2247. begin
  2248. if Ch in SourceSet then
  2249. Exclude(DestSet, Ch);
  2250. end else
  2251. if Ch in SourceSet then
  2252. Include(DestSet, Ch);
  2253. end;
  2254. {$ENDIF}
  2255. {$IFDEF ASM386_DELPHI}
  2256. function IsSubSet(const A, B: CharSet): Boolean;
  2257. asm
  2258. MOV ECX, [EDX]
  2259. NOT ECX
  2260. AND ECX, [EAX]
  2261. JNE @Fin0
  2262. MOV ECX, [EDX + 4]
  2263. NOT ECX
  2264. AND ECX, [EAX + 4]
  2265. JNE @Fin0
  2266. MOV ECX, [EDX + 8]
  2267. NOT ECX
  2268. AND ECX, [EAX + 8]
  2269. JNE @Fin0
  2270. MOV ECX, [EDX + 12]
  2271. NOT ECX
  2272. AND ECX, [EAX + 12]
  2273. JNE @Fin0
  2274. MOV ECX, [EDX + 16]
  2275. NOT ECX
  2276. AND ECX, [EAX + 16]
  2277. JNE @Fin0
  2278. MOV ECX, [EDX + 20]
  2279. NOT ECX
  2280. AND ECX, [EAX + 20]
  2281. JNE @Fin0
  2282. MOV ECX, [EDX + 24]
  2283. NOT ECX
  2284. AND ECX, [EAX + 24]
  2285. JNE @Fin0
  2286. MOV ECX, [EDX + 28]
  2287. NOT ECX
  2288. AND ECX, [EAX + 28]
  2289. JNE @Fin0
  2290. MOV EAX, 1
  2291. RET
  2292. @Fin0:
  2293. XOR EAX, EAX
  2294. end;
  2295. {$ELSE}
  2296. function IsSubSet(const A, B: CharSet): Boolean;
  2297. begin
  2298. Result := A <= B;
  2299. end;
  2300. {$ENDIF}
  2301. {$IFDEF ASM386_DELPHI}
  2302. function IsEqual(const A, B: CharSet): Boolean;
  2303. asm
  2304. MOV ECX, [EDX]
  2305. XOR ECX, [EAX]
  2306. JNE @Fin0
  2307. MOV ECX, [EDX + 4]
  2308. XOR ECX, [EAX + 4]
  2309. JNE @Fin0
  2310. MOV ECX, [EDX + 8]
  2311. XOR ECX, [EAX + 8]
  2312. JNE @Fin0
  2313. MOV ECX, [EDX + 12]
  2314. XOR ECX, [EAX + 12]
  2315. JNE @Fin0
  2316. MOV ECX, [EDX + 16]
  2317. XOR ECX, [EAX + 16]
  2318. JNE @Fin0
  2319. MOV ECX, [EDX + 20]
  2320. XOR ECX, [EAX + 20]
  2321. JNE @Fin0
  2322. MOV ECX, [EDX + 24]
  2323. XOR ECX, [EAX + 24]
  2324. JNE @Fin0
  2325. MOV ECX, [EDX + 28]
  2326. XOR ECX, [EAX + 28]
  2327. JNE @Fin0
  2328. MOV EAX, 1
  2329. RET
  2330. @Fin0:
  2331. XOR EAX, EAX
  2332. end;
  2333. {$ELSE}
  2334. function IsEqual(const A, B: CharSet): Boolean;
  2335. begin
  2336. Result := A = B;
  2337. end;
  2338. {$ENDIF}
  2339. {$IFDEF ASM386_DELPHI}
  2340. function IsEmpty(const C: CharSet): Boolean;
  2341. asm
  2342. MOV EDX, [EAX]
  2343. OR EDX, [EAX + 4]
  2344. OR EDX, [EAX + 8]
  2345. OR EDX, [EAX + 12]
  2346. OR EDX, [EAX + 16]
  2347. OR EDX, [EAX + 20]
  2348. OR EDX, [EAX + 24]
  2349. OR EDX, [EAX + 28]
  2350. JNE @Fin0
  2351. MOV EAX, 1
  2352. RET
  2353. @Fin0:
  2354. XOR EAX,EAX
  2355. end;
  2356. {$ELSE}
  2357. function IsEmpty(const C: CharSet): Boolean;
  2358. begin
  2359. Result := C = [];
  2360. end;
  2361. {$ENDIF}
  2362. {$IFDEF ASM386_DELPHI}
  2363. function IsComplete(const C: CharSet): Boolean;
  2364. asm
  2365. MOV EDX, [EAX]
  2366. AND EDX, [EAX + 4]
  2367. AND EDX, [EAX + 8]
  2368. AND EDX, [EAX + 12]
  2369. AND EDX, [EAX + 16]
  2370. AND EDX, [EAX + 20]
  2371. AND EDX, [EAX + 24]
  2372. AND EDX, [EAX + 28]
  2373. CMP EDX, $FFFFFFFF
  2374. JNE @Fin0
  2375. MOV EAX, 1
  2376. RET
  2377. @Fin0:
  2378. XOR EAX, EAX
  2379. end;
  2380. {$ELSE}
  2381. function IsComplete(const C: CharSet): Boolean;
  2382. begin
  2383. Result := C = CompleteCharSet;
  2384. end;
  2385. {$ENDIF}
  2386. {$IFDEF ASM386_DELPHI}
  2387. function CharCount(const C: CharSet): Integer;
  2388. asm
  2389. PUSH EBX
  2390. PUSH ESI
  2391. MOV EBX, EAX
  2392. XOR ESI, ESI
  2393. MOV EAX, [EBX]
  2394. CALL BitCount
  2395. ADD ESI, EAX
  2396. MOV EAX, [EBX + 4]
  2397. CALL BitCount
  2398. ADD ESI, EAX
  2399. MOV EAX, [EBX + 8]
  2400. CALL BitCount
  2401. ADD ESI, EAX
  2402. MOV EAX, [EBX + 12]
  2403. CALL BitCount
  2404. ADD ESI, EAX
  2405. MOV EAX, [EBX + 16]
  2406. CALL BitCount
  2407. ADD ESI, EAX
  2408. MOV EAX, [EBX + 20]
  2409. CALL BitCount
  2410. ADD ESI, EAX
  2411. MOV EAX, [EBX + 24]
  2412. CALL BitCount
  2413. ADD ESI, EAX
  2414. MOV EAX, [EBX + 28]
  2415. CALL BitCount
  2416. ADD EAX, ESI
  2417. POP ESI
  2418. POP EBX
  2419. end;
  2420. {$ELSE}
  2421. function CharCount(const C: CharSet): Integer;
  2422. var I : AnsiChar;
  2423. begin
  2424. Result := 0;
  2425. for I := #0 to #255 do
  2426. if I in C then
  2427. Inc(Result);
  2428. end;
  2429. {$ENDIF}
  2430. {$IFDEF ASM386_DELPHI}
  2431. procedure ConvertCaseInsensitive(var C: CharSet);
  2432. asm
  2433. MOV ECX, [EAX + 12]
  2434. AND ECX, $3FFFFFF
  2435. OR [EAX + 8], ECX
  2436. MOV ECX, [EAX + 8]
  2437. AND ECX, $3FFFFFF
  2438. OR [EAX + 12], ECX
  2439. end;
  2440. {$ELSE}
  2441. procedure ConvertCaseInsensitive(var C: CharSet);
  2442. var Ch : AnsiChar;
  2443. begin
  2444. for Ch := 'A' to 'Z' do
  2445. if Ch in C then
  2446. Include(C, AnsiChar(Ord(Ch) + 32));
  2447. for Ch := 'a' to 'z' do
  2448. if Ch in C then
  2449. Include(C, AnsiChar(Ord(Ch) - 32));
  2450. end;
  2451. {$ENDIF}
  2452. function CaseInsensitiveCharSet(const C: CharSet): CharSet;
  2453. begin
  2454. AssignCharSet(Result, C);
  2455. ConvertCaseInsensitive(Result);
  2456. end;
  2457. { }
  2458. { Range functions }
  2459. { }
  2460. function IntRangeLength(const Low, High: Integer): Int64;
  2461. begin
  2462. if Low > High then
  2463. Result := 0
  2464. else
  2465. Result := Int64(High - Low) + 1;
  2466. end;
  2467. function IntRangeAdjacent(const Low1, High1, Low2, High2: Integer): Boolean;
  2468. begin
  2469. Result := ((Low2 > MinInteger) and (High1 = Low2 - 1)) or
  2470. ((High2 < MaxInteger) and (Low1 = High2 + 1));
  2471. end;
  2472. function IntRangeOverlap(const Low1, High1, Low2, High2: Integer): Boolean;
  2473. begin
  2474. Result := ((Low1 >= Low2) and (Low1 <= High2)) or
  2475. ((Low2 >= Low1) and (Low2 <= High1));
  2476. end;
  2477. function IntRangeHasElement(const Low, High, Element: Integer): Boolean;
  2478. begin
  2479. Result := (Element >= Low) and (Element <= High);
  2480. end;
  2481. function IntRangeIncludeElement(var Low, High: Integer;
  2482. const Element: Integer): Boolean;
  2483. begin
  2484. Result := (Element >= Low) and (Element <= High);
  2485. if Result then
  2486. exit;
  2487. if (Element < Low) and (Element + 1 = Low) then
  2488. begin
  2489. Low := Element;
  2490. Result := True;
  2491. end else
  2492. if (Element > High) and (Element - 1 = High) then
  2493. begin
  2494. High := Element;
  2495. Result := True;
  2496. end;
  2497. end;
  2498. function IntRangeIncludeElementRange(var Low, High: Integer;
  2499. const LowElement, HighElement: Integer): Boolean;
  2500. begin
  2501. Result := (LowElement >= Low) and (HighElement <= High);
  2502. if Result then
  2503. exit;
  2504. if ((Low >= LowElement) and (Low <= HighElement)) or
  2505. ((Low > MinInteger) and (Low - 1 = HighElement)) then
  2506. begin
  2507. Low := LowElement;
  2508. Result := True;
  2509. end;
  2510. if ((High >= LowElement) and (High <= HighElement)) or
  2511. ((High < MaxInteger) and (High + 1 = LowElement)) then
  2512. begin
  2513. High := HighElement;
  2514. Result := True;
  2515. end;
  2516. end;
  2517. function CardRangeLength(const Low, High: Cardinal): Int64;
  2518. begin
  2519. if Low > High then
  2520. Result := 0
  2521. else
  2522. Result := Int64(High - Low) + 1;
  2523. end;
  2524. function CardRangeAdjacent(const Low1, High1, Low2, High2: Cardinal): Boolean;
  2525. begin
  2526. Result := ((Low2 > MinCardinal) and (High1 = Low2 - 1)) or
  2527. ((High2 < MaxCardinal) and (Low1 = High2 + 1));
  2528. end;
  2529. function CardRangeOverlap(const Low1, High1, Low2, High2: Cardinal): Boolean;
  2530. begin
  2531. Result := ((Low1 >= Low2) and (Low1 <= High2)) or
  2532. ((Low2 >= Low1) and (Low2 <= High1));
  2533. end;
  2534. function CardRangeHasElement(const Low, High, Element: Cardinal): Boolean;
  2535. begin
  2536. Result := (Element >= Low) and (Element <= High);
  2537. end;
  2538. function CardRangeIncludeElement(var Low, High: Cardinal;
  2539. const Element: Cardinal): Boolean;
  2540. begin
  2541. Result := (Element >= Low) and (Element <= High);
  2542. if Result then
  2543. exit;
  2544. if (Element < Low) and (Element + 1 = Low) then
  2545. begin
  2546. Low := Element;
  2547. Result := True;
  2548. end else
  2549. if (Element > High) and (Element - 1 = High) then
  2550. begin
  2551. High := Element;
  2552. Result := True;
  2553. end;
  2554. end;
  2555. function CardRangeIncludeElementRange(var Low, High: Cardinal;
  2556. const LowElement, HighElement: Cardinal): Boolean;
  2557. begin
  2558. Result := (LowElement >= Low) and (HighElement <= High);
  2559. if Result then
  2560. exit;
  2561. if ((Low >= LowElement) and (Low <= HighElement)) or
  2562. ((Low > MinCardinal) and (Low - 1 = HighElement)) then
  2563. begin
  2564. Low := LowElement;
  2565. Result := True;
  2566. end;
  2567. if ((High >= LowElement) and (High <= HighElement)) or
  2568. ((High < MaxCardinal) and (High + 1 = LowElement)) then
  2569. begin
  2570. High := HighElement;
  2571. Result := True;
  2572. end;
  2573. end;
  2574. { }
  2575. { Swap }
  2576. { }
  2577. {$IFDEF ASM386_DELPHI}
  2578. procedure Swap(var X, Y: Boolean); register; assembler;
  2579. asm
  2580. MOV CL, [EDX]
  2581. XCHG BYTE PTR [EAX], CL
  2582. MOV [EDX], CL
  2583. end;
  2584. {$ELSE}
  2585. procedure Swap(var X, Y: Boolean);
  2586. var F : Boolean;
  2587. begin
  2588. F := X;
  2589. X := Y;
  2590. Y := F;
  2591. end;
  2592. {$ENDIF}
  2593. {$IFDEF ASM386_DELPHI}
  2594. procedure Swap(var X, Y: Byte); register; assembler;
  2595. asm
  2596. MOV CL, [EDX]
  2597. XCHG BYTE PTR [EAX], CL
  2598. MOV [EDX], CL
  2599. end;
  2600. {$ELSE}
  2601. procedure Swap(var X, Y: Byte);
  2602. var F : Byte;
  2603. begin
  2604. F := X;
  2605. X := Y;
  2606. Y := F;
  2607. end;
  2608. {$ENDIF}
  2609. {$IFDEF ASM386_DELPHI}
  2610. procedure Swap(var X, Y: ShortInt); register; assembler;
  2611. asm
  2612. MOV CL, [EDX]
  2613. XCHG BYTE PTR [EAX], CL
  2614. MOV [EDX], CL
  2615. end;
  2616. {$ELSE}
  2617. procedure Swap(var X, Y: ShortInt);
  2618. var F : ShortInt;
  2619. begin
  2620. F := X;
  2621. X := Y;
  2622. Y := F;
  2623. end;
  2624. {$ENDIF}
  2625. {$IFDEF ASM386_DELPHI}
  2626. procedure Swap(var X, Y: Word); register; assembler;
  2627. asm
  2628. MOV CX, [EDX]
  2629. XCHG WORD PTR [EAX], CX
  2630. MOV [EDX], CX
  2631. end;
  2632. {$ELSE}
  2633. procedure Swap(var X, Y: Word);
  2634. var F : Word;
  2635. begin
  2636. F := X;
  2637. X := Y;
  2638. Y := F;
  2639. end;
  2640. {$ENDIF}
  2641. {$IFDEF ASM386_DELPHI}
  2642. procedure Swap(var X, Y: SmallInt); register; assembler;
  2643. asm
  2644. MOV CX, [EDX]
  2645. XCHG WORD PTR [EAX], CX
  2646. MOV [EDX], CX
  2647. end;
  2648. {$ELSE}
  2649. procedure Swap(var X, Y: SmallInt);
  2650. var F : SmallInt;
  2651. begin
  2652. F := X;
  2653. X := Y;
  2654. Y := F;
  2655. end;
  2656. {$ENDIF}
  2657. {$IFDEF ASM386_DELPHI}
  2658. procedure Swap(var X, Y: LongInt); register; assembler;
  2659. asm
  2660. MOV ECX, [EDX]
  2661. XCHG [EAX], ECX
  2662. MOV [EDX], ECX
  2663. end;
  2664. {$ELSE}
  2665. procedure Swap(var X, Y: LongInt);
  2666. var F : LongInt;
  2667. begin
  2668. F := X;
  2669. X := Y;
  2670. Y := F;
  2671. end;
  2672. {$ENDIF}
  2673. {$IFDEF ASM386_DELPHI}
  2674. procedure Swap(var X, Y: LongWord); register; assembler;
  2675. asm
  2676. MOV ECX, [EDX]
  2677. XCHG [EAX], ECX
  2678. MOV [EDX], ECX
  2679. end;
  2680. {$ELSE}
  2681. procedure Swap(var X, Y: LongWord);
  2682. var F : LongWord;
  2683. begin
  2684. F := X;
  2685. X := Y;
  2686. Y := F;
  2687. end;
  2688. {$ENDIF}
  2689. procedure Swap(var X, Y: NativeUInt);
  2690. var F : NativeUInt;
  2691. begin
  2692. F := X;
  2693. X := Y;
  2694. Y := F;
  2695. end;
  2696. procedure Swap(var X, Y: NativeInt);
  2697. var F : NativeInt;
  2698. begin
  2699. F := X;
  2700. X := Y;
  2701. Y := F;
  2702. end;
  2703. {$IFNDEF ManagedCode}
  2704. {$IFDEF ASM386_DELPHI}
  2705. procedure Swap(var X, Y: Pointer); register; assembler;
  2706. asm
  2707. MOV ECX, [EDX]
  2708. XCHG [EAX], ECX
  2709. MOV [EDX], ECX
  2710. end;
  2711. {$ELSE}
  2712. procedure Swap(var X, Y: Pointer);
  2713. var F : Pointer;
  2714. begin
  2715. F := X;
  2716. X := Y;
  2717. Y := F;
  2718. end;
  2719. {$ENDIF}
  2720. {$ENDIF}
  2721. {$IFDEF ASM386_DELPHI}
  2722. procedure Swap(var X, Y: TObject); register; assembler;
  2723. asm
  2724. MOV ECX, [EDX]
  2725. XCHG [EAX], ECX
  2726. MOV [EDX], ECX
  2727. end;
  2728. {$ELSE}
  2729. procedure Swap(var X, Y: TObject);
  2730. var F : TObject;
  2731. begin
  2732. F := X;
  2733. X := Y;
  2734. Y := F;
  2735. end;
  2736. {$ENDIF}
  2737. procedure Swap(var X, Y: Int64);
  2738. var F : Int64;
  2739. begin
  2740. F := X;
  2741. X := Y;
  2742. Y := F;
  2743. end;
  2744. procedure Swap(var X, Y: Single);
  2745. var F : Single;
  2746. begin
  2747. F := X;
  2748. X := Y;
  2749. Y := F;
  2750. end;
  2751. procedure Swap(var X, Y: Double);
  2752. var F : Double;
  2753. begin
  2754. F := X;
  2755. X := Y;
  2756. Y := F;
  2757. end;
  2758. procedure Swap(var X, Y: Extended);
  2759. var F : Extended;
  2760. begin
  2761. F := X;
  2762. X := Y;
  2763. Y := F;
  2764. end;
  2765. procedure Swap(var X, Y: Currency);
  2766. var F : Currency;
  2767. begin
  2768. F := X;
  2769. X := Y;
  2770. Y := F;
  2771. end;
  2772. procedure SwapA(var X, Y: AnsiString);
  2773. var F : AnsiString;
  2774. begin
  2775. F := X;
  2776. X := Y;
  2777. Y := F;
  2778. end;
  2779. procedure SwapW(var X, Y: WideString);
  2780. var F : WideString;
  2781. begin
  2782. F := X;
  2783. X := Y;
  2784. Y := F;
  2785. end;
  2786. procedure SwapU(var X, Y: UnicodeString);
  2787. var F : UnicodeString;
  2788. begin
  2789. F := X;
  2790. X := Y;
  2791. Y := F;
  2792. end;
  2793. procedure Swap(var X, Y: String);
  2794. var F : String;
  2795. begin
  2796. F := X;
  2797. X := Y;
  2798. Y := F;
  2799. end;
  2800. {$IFDEF ManagedCode}
  2801. procedure SwapObjects(var X, Y: TObject);
  2802. var F: TObject;
  2803. begin
  2804. F := X;
  2805. X := Y;
  2806. Y := F;
  2807. end;
  2808. {$ELSE}
  2809. {$IFDEF ASM386_DELPHI}
  2810. procedure SwapObjects(var X, Y); register; assembler;
  2811. asm
  2812. MOV ECX, [EDX]
  2813. XCHG [EAX], ECX
  2814. MOV [EDX], ECX
  2815. end;
  2816. {$ELSE}
  2817. procedure SwapObjects(var X, Y);
  2818. var F: TObject;
  2819. begin
  2820. F := TObject(X);
  2821. TObject(X) := TObject(Y);
  2822. TObject(Y) := F;
  2823. end;
  2824. {$ENDIF}{$ENDIF}
  2825. { }
  2826. { iif }
  2827. { }
  2828. function iif(const Expr: Boolean; const TrueValue, FalseValue: Integer): Integer;
  2829. begin
  2830. if Expr then
  2831. Result := TrueValue
  2832. else
  2833. Result := FalseValue;
  2834. end;
  2835. function iif(const Expr: Boolean; const TrueValue, FalseValue: Int64): Int64;
  2836. begin
  2837. if Expr then
  2838. Result := TrueValue
  2839. else
  2840. Result := FalseValue;
  2841. end;
  2842. function iif(const Expr: Boolean; const TrueValue, FalseValue: Extended): Extended;
  2843. begin
  2844. if Expr then
  2845. Result := TrueValue
  2846. else
  2847. Result := FalseValue;
  2848. end;
  2849. function iif(const Expr: Boolean; const TrueValue, FalseValue: String): String;
  2850. begin
  2851. if Expr then
  2852. Result := TrueValue
  2853. else
  2854. Result := FalseValue;
  2855. end;
  2856. function iifA(const Expr: Boolean; const TrueValue, FalseValue: AnsiString): AnsiString;
  2857. begin
  2858. if Expr then
  2859. Result := TrueValue
  2860. else
  2861. Result := FalseValue;
  2862. end;
  2863. function iifW(const Expr: Boolean; const TrueValue, FalseValue: WideString): WideString;
  2864. begin
  2865. if Expr then
  2866. Result := TrueValue
  2867. else
  2868. Result := FalseValue;
  2869. end;
  2870. function iifU(const Expr: Boolean; const TrueValue, FalseValue: UnicodeString): UnicodeString;
  2871. begin
  2872. if Expr then
  2873. Result := TrueValue
  2874. else
  2875. Result := FalseValue;
  2876. end;
  2877. function iif(const Expr: Boolean; const TrueValue, FalseValue: TObject): TObject;
  2878. begin
  2879. if Expr then
  2880. Result := TrueValue
  2881. else
  2882. Result := FalseValue;
  2883. end;
  2884. { }
  2885. { Compare }
  2886. { }
  2887. function ReverseCompareResult(const C: TCompareResult): TCompareResult;
  2888. begin
  2889. if C = crLess then
  2890. Result := crGreater else
  2891. if C = crGreater then
  2892. Result := crLess
  2893. else
  2894. Result := C;
  2895. end;
  2896. function Compare(const I1, I2: Integer): TCompareResult;
  2897. begin
  2898. if I1 < I2 then
  2899. Result := crLess else
  2900. if I1 > I2 then
  2901. Result := crGreater
  2902. else
  2903. Result := crEqual;
  2904. end;
  2905. function Compare(const I1, I2: Int64): TCompareResult;
  2906. begin
  2907. if I1 < I2 then
  2908. Result := crLess else
  2909. if I1 > I2 then
  2910. Result := crGreater
  2911. else
  2912. Result := crEqual;
  2913. end;
  2914. function Compare(const I1, I2: Extended): TCompareResult;
  2915. begin
  2916. if I1 < I2 then
  2917. Result := crLess else
  2918. if I1 > I2 then
  2919. Result := crGreater
  2920. else
  2921. Result := crEqual;
  2922. end;
  2923. function Compare(const I1, I2: Boolean): TCompareResult;
  2924. begin
  2925. if I1 = I2 then
  2926. Result := crEqual else
  2927. if I1 then
  2928. Result := crGreater
  2929. else
  2930. Result := crLess;
  2931. end;
  2932. function CompareA(const I1, I2: AnsiString): TCompareResult;
  2933. begin
  2934. if I1 = I2 then
  2935. Result := crEqual else
  2936. if I1 > I2 then
  2937. Result := crGreater
  2938. else
  2939. Result := crLess;
  2940. end;
  2941. function CompareW(const I1, I2: WideString): TCompareResult;
  2942. begin
  2943. if I1 = I2 then
  2944. Result := crEqual else
  2945. if I1 > I2 then
  2946. Result := crGreater
  2947. else
  2948. Result := crLess;
  2949. end;
  2950. function CompareU(const I1, I2: UnicodeString): TCompareResult;
  2951. begin
  2952. if I1 = I2 then
  2953. Result := crEqual else
  2954. if I1 > I2 then
  2955. Result := crGreater
  2956. else
  2957. Result := crLess;
  2958. end;
  2959. function Sgn(const A: LongInt): Integer;
  2960. begin
  2961. if A < 0 then
  2962. Result := -1 else
  2963. if A > 0 then
  2964. Result := 1
  2965. else
  2966. Result := 0;
  2967. end;
  2968. function Sgn(const A: Int64): Integer;
  2969. begin
  2970. if A < 0 then
  2971. Result := -1 else
  2972. if A > 0 then
  2973. Result := 1
  2974. else
  2975. Result := 0;
  2976. end;
  2977. function Sgn(const A: Extended): Integer;
  2978. begin
  2979. if A < 0 then
  2980. Result := -1 else
  2981. if A > 0 then
  2982. Result := 1
  2983. else
  2984. Result := 0;
  2985. end;
  2986. { }
  2987. { Ascii char conversion lookup }
  2988. { }
  2989. const
  2990. HexLookup: array[AnsiChar] of Byte = (
  2991. $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  2992. $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  2993. $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  2994. 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, $FF, $FF, $FF, $FF, $FF, $FF,
  2995. $FF, 10, 11, 12, 13, 14, 15, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  2996. $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  2997. $FF, 10, 11, 12, 13, 14, 15, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  2998. $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  2999. $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  3000. $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  3001. $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  3002. $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  3003. $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  3004. $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  3005. $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  3006. $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF);
  3007. { }
  3008. { Integer-String conversions }
  3009. { }
  3010. function AnsiCharToInt(const A: AnsiChar): Integer;
  3011. begin
  3012. if A in ['0'..'9'] then
  3013. Result := Ord(A) - Ord('0')
  3014. else
  3015. Result := -1;
  3016. end;
  3017. function WideCharToInt(const A: WideChar): Integer;
  3018. begin
  3019. if (Ord(A) >= Ord('0')) and (Ord(A) <= Ord('9')) then
  3020. Result := Ord(A) - Ord('0')
  3021. else
  3022. Result := -1;
  3023. end;
  3024. function CharToInt(const A: Char): Integer;
  3025. begin
  3026. {$IFDEF CharIsWide}
  3027. Result := WideCharToInt(A);
  3028. {$ELSE}
  3029. Result := AnsiCharToInt(A);
  3030. {$ENDIF}
  3031. end;
  3032. function IntToAnsiChar(const A: Integer): AnsiChar;
  3033. begin
  3034. if (A < 0) or (A > 9) then
  3035. Result := #$00
  3036. else
  3037. Result := AnsiChar(48 + A);
  3038. end;
  3039. function IntToWideChar(const A: Integer): WideChar;
  3040. begin
  3041. if (A < 0) or (A > 9) then
  3042. Result := #$00
  3043. else
  3044. Result := WideChar(48 + A);
  3045. end;
  3046. function IntToChar(const A: Integer): Char;
  3047. begin
  3048. {$IFDEF CharIsWide}
  3049. Result := IntToWideChar(A);
  3050. {$ELSE}
  3051. Result := IntToAnsiChar(A);
  3052. {$ENDIF}
  3053. end;
  3054. function IsHexAnsiChar(const Ch: AnsiChar): Boolean;
  3055. begin
  3056. Result := HexLookup[Ch] <= 15;
  3057. end;
  3058. function IsHexWideChar(const Ch: WideChar): Boolean;
  3059. begin
  3060. if Ord(Ch) <= $FF then
  3061. Result := HexLookup[AnsiChar(Ch)] <= 15
  3062. else
  3063. Result := False;
  3064. end;
  3065. function IsHexChar(const Ch: Char): Boolean;
  3066. begin
  3067. {$IFDEF CharIsWide}
  3068. Result := IsHexWideChar(Ch);
  3069. {$ELSE}
  3070. Result := IsHexAnsiChar(Ch);
  3071. {$ENDIF}
  3072. end;
  3073. function HexAnsiCharToInt(const A: AnsiChar): Integer;
  3074. var B : Byte;
  3075. begin
  3076. B := HexLookup[A];
  3077. if B = $FF then
  3078. Result := -1
  3079. else
  3080. Result := B;
  3081. end;
  3082. function HexWideCharToInt(const A: WideChar): Integer;
  3083. var B : Byte;
  3084. begin
  3085. if Ord(A) > $FF then
  3086. Result := -1
  3087. else
  3088. begin
  3089. B := HexLookup[AnsiChar(Ord(A))];
  3090. if B = $FF then
  3091. Result := -1
  3092. else
  3093. Result := B;
  3094. end;
  3095. end;
  3096. function HexCharToInt(const A: Char): Integer;
  3097. begin
  3098. {$IFDEF CharIsWide}
  3099. Result := HexWideCharToInt(A);
  3100. {$ELSE}
  3101. Result := HexAnsiCharToInt(A);
  3102. {$ENDIF}
  3103. end;
  3104. function IntToUpperHexAnsiChar(const A: Integer): AnsiChar;
  3105. begin
  3106. if (A < 0) or (A > 15) then
  3107. Result := #$00
  3108. else
  3109. if A <= 9 then
  3110. Result := AnsiChar(48 + A)
  3111. else
  3112. Result := AnsiChar(55 + A);
  3113. end;
  3114. function IntToUpperHexWideChar(const A: Integer): WideChar;
  3115. begin
  3116. if (A < 0) or (A > 15) then
  3117. Result := #$00
  3118. else
  3119. if A <= 9 then
  3120. Result := WideChar(48 + A)
  3121. else
  3122. Result := WideChar(55 + A);
  3123. end;
  3124. function IntToUpperHexChar(const A: Integer): Char;
  3125. begin
  3126. {$IFDEF CharIsWide}
  3127. Result := IntToUpperHexWideChar(A);
  3128. {$ELSE}
  3129. Result := IntToUpperHexAnsiChar(A);
  3130. {$ENDIF}
  3131. end;
  3132. function IntToLowerHexAnsiChar(const A: Integer): AnsiChar;
  3133. begin
  3134. if (A < 0) or (A > 15) then
  3135. Result := #$00
  3136. else
  3137. if A <= 9 then
  3138. Result := AnsiChar(48 + A)
  3139. else
  3140. Result := AnsiChar(87 + A);
  3141. end;
  3142. function IntToLowerHexWideChar(const A: Integer): WideChar;
  3143. begin
  3144. if (A < 0) or (A > 15) then
  3145. Result := #$00
  3146. else
  3147. if A <= 9 then
  3148. Result := WideChar(48 + A)
  3149. else
  3150. Result := WideChar(87 + A);
  3151. end;
  3152. function IntToLowerHexChar(const A: Integer): Char;
  3153. begin
  3154. {$IFDEF CharIsWide}
  3155. Result := IntToLowerHexWideChar(A);
  3156. {$ELSE}
  3157. Result := IntToLowerHexAnsiChar(A);
  3158. {$ENDIF}
  3159. end;
  3160. function IntToStringA(const A: Int64): AnsiString;
  3161. var L, T, I : Integer;
  3162. begin
  3163. if A = 0 then
  3164. begin
  3165. Result := '0';
  3166. exit;
  3167. end;
  3168. // calculate string length
  3169. if A < 0 then
  3170. L := 1
  3171. else
  3172. L := 0;
  3173. T := A;
  3174. while T <> 0 do
  3175. begin
  3176. T := T div 10;
  3177. Inc(L);
  3178. end;
  3179. // convert
  3180. SetLength(Result, L);
  3181. I := 0;
  3182. T := A;
  3183. if T < 0 then
  3184. begin
  3185. Result[1] := '-';
  3186. T := -T;
  3187. end;
  3188. while T > 0 do
  3189. begin
  3190. Result[L - I] := IntToAnsiChar(T mod 10);
  3191. T := T div 10;
  3192. Inc(I);
  3193. end;
  3194. end;
  3195. function IntToStringW(const A: Int64): WideString;
  3196. var L, T, I : Integer;
  3197. begin
  3198. if A = 0 then
  3199. begin
  3200. Result := '0';
  3201. exit;
  3202. end;
  3203. // calculate string length
  3204. if A < 0 then
  3205. L := 1
  3206. else
  3207. L := 0;
  3208. T := A;
  3209. while T <> 0 do
  3210. begin
  3211. T := T div 10;
  3212. Inc(L);
  3213. end;
  3214. // convert
  3215. SetLength(Result, L);
  3216. I := 0;
  3217. T := A;
  3218. if T < 0 then
  3219. begin
  3220. Result[1] := '-';
  3221. T := -T;
  3222. end;
  3223. while T > 0 do
  3224. begin
  3225. Result[L - I] := IntToWideChar(T mod 10);
  3226. T := T div 10;
  3227. Inc(I);
  3228. end;
  3229. end;
  3230. function IntToStringU(const A: Int64): UnicodeString;
  3231. var L, T, I : Integer;
  3232. begin
  3233. if A = 0 then
  3234. begin
  3235. Result := '0';
  3236. exit;
  3237. end;
  3238. // calculate string length
  3239. if A < 0 then
  3240. L := 1
  3241. else
  3242. L := 0;
  3243. T := A;
  3244. while T <> 0 do
  3245. begin
  3246. T := T div 10;
  3247. Inc(L);
  3248. end;
  3249. // convert
  3250. SetLength(Result, L);
  3251. I := 0;
  3252. T := A;
  3253. if T < 0 then
  3254. begin
  3255. Result[1] := '-';
  3256. T := -T;
  3257. end;
  3258. while T > 0 do
  3259. begin
  3260. Result[L - I] := IntToWideChar(T mod 10);
  3261. T := T div 10;
  3262. Inc(I);
  3263. end;
  3264. end;
  3265. function IntToString(const A: Int64): String;
  3266. var L, T, I : Integer;
  3267. begin
  3268. if A = 0 then
  3269. begin
  3270. Result := '0';
  3271. exit;
  3272. end;
  3273. // calculate string length
  3274. if A < 0 then
  3275. L := 1
  3276. else
  3277. L := 0;
  3278. T := A;
  3279. while T <> 0 do
  3280. begin
  3281. T := T div 10;
  3282. Inc(L);
  3283. end;
  3284. // convert
  3285. SetLength(Result, L);
  3286. I := 0;
  3287. T := A;
  3288. if T < 0 then
  3289. begin
  3290. Result[1] := '-';
  3291. T := -T;
  3292. end;
  3293. while T > 0 do
  3294. begin
  3295. Result[L - I] := IntToChar(T mod 10);
  3296. T := T div 10;
  3297. Inc(I);
  3298. end;
  3299. end;
  3300. function NativeUIntToBaseA(
  3301. const Value: NativeUInt;
  3302. const Digits: Integer;
  3303. const Base: Byte;
  3304. const UpperCase: Boolean = True): AnsiString;
  3305. var D : NativeUInt;
  3306. L : Integer;
  3307. V : Byte;
  3308. begin
  3309. Assert((Base >= 2) and (Base <= 16));
  3310. if Value = 0 then // handle zero value
  3311. begin
  3312. if Digits = 0 then
  3313. L := 1
  3314. else
  3315. L := Digits;
  3316. SetLength(Result, L);
  3317. for V := 1 to L do
  3318. Result[V] := '0';
  3319. exit;
  3320. end;
  3321. // determine number of digits in result
  3322. L := 0;
  3323. D := Value;
  3324. while D > 0 do
  3325. begin
  3326. Inc(L);
  3327. D := D div Base;
  3328. end;
  3329. if L < Digits then
  3330. L := Digits;
  3331. // do conversion
  3332. SetLength(Result, L);
  3333. D := Value;
  3334. while D > 0 do
  3335. begin
  3336. V := D mod Base + 1;
  3337. if UpperCase then
  3338. Result[L] := AnsiChar(StrHexDigitsUpper[V])
  3339. else
  3340. Result[L] := AnsiChar(StrHexDigitsLower[V]);
  3341. Dec(L);
  3342. D := D div Base;
  3343. end;
  3344. while L > 0 do
  3345. begin
  3346. Result[L] := '0';
  3347. Dec(L);
  3348. end;
  3349. end;
  3350. function NativeUIntToBaseW(
  3351. const Value: NativeUInt;
  3352. const Digits: Integer;
  3353. const Base: Byte;
  3354. const UpperCase: Boolean = True): WideString;
  3355. var D : NativeUInt;
  3356. L : Integer;
  3357. V : Byte;
  3358. begin
  3359. Assert((Base >= 2) and (Base <= 16));
  3360. if Value = 0 then // handle zero value
  3361. begin
  3362. if Digits = 0 then
  3363. L := 1
  3364. else
  3365. L := Digits;
  3366. SetLength(Result, L);
  3367. for V := 1 to L do
  3368. Result[V] := '0';
  3369. exit;
  3370. end;
  3371. // determine number of digits in result
  3372. L := 0;
  3373. D := Value;
  3374. while D > 0 do
  3375. begin
  3376. Inc(L);
  3377. D := D div Base;
  3378. end;
  3379. if L < Digits then
  3380. L := Digits;
  3381. // do conversion
  3382. SetLength(Result, L);
  3383. D := Value;
  3384. while D > 0 do
  3385. begin
  3386. V := D mod Base + 1;
  3387. if UpperCase then
  3388. Result[L] := WideChar(StrHexDigitsUpper[V])
  3389. else
  3390. Result[L] := WideChar(StrHexDigitsLower[V]);
  3391. Dec(L);
  3392. D := D div Base;
  3393. end;
  3394. while L > 0 do
  3395. begin
  3396. Result[L] := '0';
  3397. Dec(L);
  3398. end;
  3399. end;
  3400. function NativeUIntToBaseU(
  3401. const Value: NativeUInt;
  3402. const Digits: Integer;
  3403. const Base: Byte;
  3404. const UpperCase: Boolean = True): UnicodeString;
  3405. var D : NativeUInt;
  3406. L : Integer;
  3407. V : Byte;
  3408. begin
  3409. Assert((Base >= 2) and (Base <= 16));
  3410. if Value = 0 then // handle zero value
  3411. begin
  3412. if Digits = 0 then
  3413. L := 1
  3414. else
  3415. L := Digits;
  3416. SetLength(Result, L);
  3417. for V := 1 to L do
  3418. Result[V] := '0';
  3419. exit;
  3420. end;
  3421. // determine number of digits in result
  3422. L := 0;
  3423. D := Value;
  3424. while D > 0 do
  3425. begin
  3426. Inc(L);
  3427. D := D div Base;
  3428. end;
  3429. if L < Digits then
  3430. L := Digits;
  3431. // do conversion
  3432. SetLength(Result, L);
  3433. D := Value;
  3434. while D > 0 do
  3435. begin
  3436. V := D mod Base + 1;
  3437. if UpperCase then
  3438. Result[L] := WideChar(StrHexDigitsUpper[V])
  3439. else
  3440. Result[L] := WideChar(StrHexDigitsLower[V]);
  3441. Dec(L);
  3442. D := D div Base;
  3443. end;
  3444. while L > 0 do
  3445. begin
  3446. Result[L] := '0';
  3447. Dec(L);
  3448. end;
  3449. end;
  3450. function NativeUIntToBase(
  3451. const Value: NativeUInt;
  3452. const Digits: Integer;
  3453. const Base: Byte;
  3454. const UpperCase: Boolean = True): String;
  3455. var D : NativeUInt;
  3456. L : Integer;
  3457. V : Byte;
  3458. begin
  3459. Assert((Base >= 2) and (Base <= 16));
  3460. if Value = 0 then // handle zero value
  3461. begin
  3462. if Digits = 0 then
  3463. L := 1
  3464. else
  3465. L := Digits;
  3466. SetLength(Result, L);
  3467. for V := 1 to L do
  3468. Result[V] := '0';
  3469. exit;
  3470. end;
  3471. // determine number of digits in result
  3472. L := 0;
  3473. D := Value;
  3474. while D > 0 do
  3475. begin
  3476. Inc(L);
  3477. D := D div Base;
  3478. end;
  3479. if L < Digits then
  3480. L := Digits;
  3481. // do conversion
  3482. SetLength(Result, L);
  3483. D := Value;
  3484. while D > 0 do
  3485. begin
  3486. V := D mod Base + 1;
  3487. if UpperCase then
  3488. Result[L] := Char(StrHexDigitsUpper[V])
  3489. else
  3490. Result[L] := Char(StrHexDigitsLower[V]);
  3491. Dec(L);
  3492. D := D div Base;
  3493. end;
  3494. while L > 0 do
  3495. begin
  3496. Result[L] := '0';
  3497. Dec(L);
  3498. end;
  3499. end;
  3500. function UIntToStringA(const A: NativeUInt): AnsiString;
  3501. begin
  3502. Result := NativeUIntToBaseA(A, 0, 10);
  3503. end;
  3504. function UIntToStringW(const A: NativeUInt): WideString;
  3505. begin
  3506. Result := NativeUIntToBaseW(A, 0, 10);
  3507. end;
  3508. function UIntToStringU(const A: NativeUInt): UnicodeString;
  3509. begin
  3510. Result := NativeUIntToBaseU(A, 0, 10);
  3511. end;
  3512. function UIntToString(const A: NativeUInt): String;
  3513. begin
  3514. Result := NativeUIntToBase(A, 0, 10);
  3515. end;
  3516. function LongWordToStrA(const A: LongWord; const Digits: Integer): AnsiString;
  3517. begin
  3518. Result := NativeUIntToBaseA(A, Digits, 10);
  3519. end;
  3520. function LongWordToStrW(const A: LongWord; const Digits: Integer): WideString;
  3521. begin
  3522. Result := NativeUIntToBaseW(A, Digits, 10);
  3523. end;
  3524. function LongWordToStrU(const A: LongWord; const Digits: Integer): UnicodeString;
  3525. begin
  3526. Result := NativeUIntToBaseU(A, Digits, 10);
  3527. end;
  3528. function LongWordToStr(const A: LongWord; const Digits: Integer): String;
  3529. begin
  3530. Result := NativeUIntToBase(A, Digits, 10);
  3531. end;
  3532. function LongWordToHexA(const A: LongWord; const Digits: Integer; const UpperCase: Boolean): AnsiString;
  3533. begin
  3534. Result := NativeUIntToBaseA(A, Digits, 16, UpperCase);
  3535. end;
  3536. function LongWordToHexW(const A: LongWord; const Digits: Integer; const UpperCase: Boolean): WideString;
  3537. begin
  3538. Result := NativeUIntToBaseW(A, Digits, 16, UpperCase);
  3539. end;
  3540. function LongWordToHexU(const A: LongWord; const Digits: Integer; const UpperCase: Boolean): UnicodeString;
  3541. begin
  3542. Result := NativeUIntToBaseU(A, Digits, 16, UpperCase);
  3543. end;
  3544. function LongWordToHex(const A: LongWord; const Digits: Integer; const UpperCase: Boolean): String;
  3545. begin
  3546. Result := NativeUIntToBase(A, Digits, 16, UpperCase);
  3547. end;
  3548. function LongWordToOctA(const A: LongWord; const Digits: Integer): AnsiString;
  3549. begin
  3550. Result := NativeUIntToBaseA(A, Digits, 8);
  3551. end;
  3552. function LongWordToOctW(const A: LongWord; const Digits: Integer): WideString;
  3553. begin
  3554. Result := NativeUIntToBaseW(A, Digits, 8);
  3555. end;
  3556. function LongWordToOctU(const A: LongWord; const Digits: Integer): UnicodeString;
  3557. begin
  3558. Result := NativeUIntToBaseU(A, Digits, 8);
  3559. end;
  3560. function LongWordToOct(const A: LongWord; const Digits: Integer): String;
  3561. begin
  3562. Result := NativeUIntToBase(A, Digits, 8);
  3563. end;
  3564. function LongWordToBinA(const A: LongWord; const Digits: Integer): AnsiString;
  3565. begin
  3566. Result := NativeUIntToBaseA(A, Digits, 2);
  3567. end;
  3568. function LongWordToBinW(const A: LongWord; const Digits: Integer): WideString;
  3569. begin
  3570. Result := NativeUIntToBaseW(A, Digits, 2);
  3571. end;
  3572. function LongWordToBinU(const A: LongWord; const Digits: Integer): UnicodeString;
  3573. begin
  3574. Result := NativeUIntToBaseU(A, Digits, 2);
  3575. end;
  3576. function LongWordToBin(const A: LongWord; const Digits: Integer): String;
  3577. begin
  3578. Result := NativeUIntToBase(A, Digits, 2);
  3579. end;
  3580. function TryStringToInt64PA(const BufP: Pointer; const BufLen: Integer; out Value: Int64; out StrLen: Integer): TConvertResult;
  3581. var Len : Integer;
  3582. DigVal : Integer;
  3583. P : PAnsiChar;
  3584. Ch : AnsiChar;
  3585. HasDig : Boolean;
  3586. Neg : Boolean;
  3587. Res : Int64;
  3588. begin
  3589. if BufLen <= 0 then
  3590. begin
  3591. Value := 0;
  3592. StrLen := 0;
  3593. Result := convertFormatError;
  3594. exit;
  3595. end;
  3596. P := BufP;
  3597. Len := 0;
  3598. // check sign
  3599. Ch := P^;
  3600. if Ch in ['+', '-'] then
  3601. begin
  3602. Inc(Len);
  3603. Inc(P);
  3604. Neg := Ch = '-';
  3605. end
  3606. else
  3607. Neg := False;
  3608. // skip leading zeros
  3609. HasDig := False;
  3610. while (Len < BufLen) and (P^ = '0') do
  3611. begin
  3612. Inc(Len);
  3613. Inc(P);
  3614. HasDig := True;
  3615. end;
  3616. // convert digits
  3617. Res := 0;
  3618. while Len < BufLen do
  3619. begin
  3620. Ch := P^;
  3621. if Ch in ['0'..'9'] then
  3622. begin
  3623. HasDig := True;
  3624. if (Res > 922337203685477580) or
  3625. (Res < -922337203685477580) then
  3626. begin
  3627. Value := 0;
  3628. StrLen := Len;
  3629. Result := convertOverflow;
  3630. exit;
  3631. end;
  3632. {$IFOPT Q+}{$DEFINE QOn}{$Q-}{$ELSE}{$UNDEF QOn}{$ENDIF} // overflowing for -922337203685477580 * 10 ?
  3633. Res := Res * 10;
  3634. {$IFDEF QOn}{$Q+}{$ENDIF}
  3635. DigVal := AnsiCharToInt(Ch);
  3636. if ((Res = 9223372036854775800) and (DigVal > 7)) or
  3637. ((Res = -9223372036854775800) and (DigVal > 8)) then
  3638. begin
  3639. Value := 0;
  3640. StrLen := Len;
  3641. Result := convertOverflow;
  3642. exit;
  3643. end;
  3644. if Neg then
  3645. Dec(Res, DigVal)
  3646. else
  3647. Inc(Res, DigVal);
  3648. Inc(Len);
  3649. Inc(P);
  3650. end
  3651. else
  3652. break;
  3653. end;
  3654. StrLen := Len;
  3655. if not HasDig then
  3656. begin
  3657. Value := 0;
  3658. Result := convertFormatError;
  3659. end
  3660. else
  3661. begin
  3662. Value := Res;
  3663. Result := convertOK;
  3664. end;
  3665. end;
  3666. function TryStringToInt64PW(const BufP: Pointer; const BufLen: Integer; out Value: Int64; out StrLen: Integer): TConvertResult;
  3667. var Len : Integer;
  3668. DigVal : Integer;
  3669. P : PWideChar;
  3670. Ch : WideChar;
  3671. HasDig : Boolean;
  3672. Neg : Boolean;
  3673. Res : Int64;
  3674. begin
  3675. if BufLen <= 0 then
  3676. begin
  3677. Value := 0;
  3678. StrLen := 0;
  3679. Result := convertFormatError;
  3680. exit;
  3681. end;
  3682. P := BufP;
  3683. Len := 0;
  3684. // check sign
  3685. Ch := P^;
  3686. if (Ch = '+') or (Ch = '-') then
  3687. begin
  3688. Inc(Len);
  3689. Inc(P);
  3690. Neg := Ch = '-';
  3691. end
  3692. else
  3693. Neg := False;
  3694. // skip leading zeros
  3695. HasDig := False;
  3696. while (Len < BufLen) and (P^ = '0') do
  3697. begin
  3698. Inc(Len);
  3699. Inc(P);
  3700. HasDig := True;
  3701. end;
  3702. // convert digits
  3703. Res := 0;
  3704. while Len < BufLen do
  3705. begin
  3706. Ch := P^;
  3707. if (Ch >= '0') and (Ch <= '9') then
  3708. begin
  3709. HasDig := True;
  3710. if (Res > 922337203685477580) or
  3711. (Res < -922337203685477580) then
  3712. begin
  3713. Value := 0;
  3714. StrLen := Len;
  3715. Result := convertOverflow;
  3716. exit;
  3717. end;
  3718. {$IFOPT Q+}{$DEFINE QOn}{$Q-}{$ELSE}{$UNDEF QOn}{$ENDIF} // overflowing for -922337203685477580 * 10 ?
  3719. Res := Res * 10;
  3720. {$IFDEF QOn}{$Q+}{$ENDIF}
  3721. DigVal := WideCharToInt(Ch);
  3722. if ((Res = 9223372036854775800) and (DigVal > 7)) or
  3723. ((Res = -9223372036854775800) and (DigVal > 8)) then
  3724. begin
  3725. Value := 0;
  3726. StrLen := Len;
  3727. Result := convertOverflow;
  3728. exit;
  3729. end;
  3730. if Neg then
  3731. Dec(Res, DigVal)
  3732. else
  3733. Inc(Res, DigVal);
  3734. Inc(Len);
  3735. Inc(P);
  3736. end
  3737. else
  3738. break;
  3739. end;
  3740. StrLen := Len;
  3741. if not HasDig then
  3742. begin
  3743. Value := 0;
  3744. Result := convertFormatError;
  3745. end
  3746. else
  3747. begin
  3748. Value := Res;
  3749. Result := convertOK;
  3750. end;
  3751. end;
  3752. function TryStringToInt64P(const BufP: Pointer; const BufLen: Integer; out Value: Int64; out StrLen: Integer): TConvertResult;
  3753. var Len : Integer;
  3754. DigVal : Integer;
  3755. P : PChar;
  3756. Ch : Char;
  3757. HasDig : Boolean;
  3758. Neg : Boolean;
  3759. Res : Int64;
  3760. begin
  3761. if BufLen <= 0 then
  3762. begin
  3763. Value := 0;
  3764. StrLen := 0;
  3765. Result := convertFormatError;
  3766. exit;
  3767. end;
  3768. P := BufP;
  3769. Len := 0;
  3770. // check sign
  3771. Ch := P^;
  3772. if (Ch = '+') or (Ch = '-') then
  3773. begin
  3774. Inc(Len);
  3775. Inc(P);
  3776. Neg := Ch = '-';
  3777. end
  3778. else
  3779. Neg := False;
  3780. // skip leading zeros
  3781. HasDig := False;
  3782. while (Len < BufLen) and (P^ = '0') do
  3783. begin
  3784. Inc(Len);
  3785. Inc(P);
  3786. HasDig := True;
  3787. end;
  3788. // convert digits
  3789. Res := 0;
  3790. while Len < BufLen do
  3791. begin
  3792. Ch := P^;
  3793. if (Ch >= '0') and (Ch <= '9') then
  3794. begin
  3795. HasDig := True;
  3796. if (Res > 922337203685477580) or
  3797. (Res < -922337203685477580) then
  3798. begin
  3799. Value := 0;
  3800. StrLen := Len;
  3801. Result := convertOverflow;
  3802. exit;
  3803. end;
  3804. {$IFOPT Q+}{$DEFINE QOn}{$Q-}{$ELSE}{$UNDEF QOn}{$ENDIF} // overflowing for -922337203685477580 * 10 ?
  3805. Res := Res * 10;
  3806. {$IFDEF QOn}{$Q+}{$ENDIF}
  3807. DigVal := CharToInt(Ch);
  3808. if ((Res = 9223372036854775800) and (DigVal > 7)) or
  3809. ((Res = -9223372036854775800) and (DigVal > 8)) then
  3810. begin
  3811. Value := 0;
  3812. StrLen := Len;
  3813. Result := convertOverflow;
  3814. exit;
  3815. end;
  3816. if Neg then
  3817. Dec(Res, DigVal)
  3818. else
  3819. Inc(Res, DigVal);
  3820. Inc(Len);
  3821. Inc(P);
  3822. end
  3823. else
  3824. break;
  3825. end;
  3826. StrLen := Len;
  3827. if not HasDig then
  3828. begin
  3829. Value := 0;
  3830. Result := convertFormatError;
  3831. end
  3832. else
  3833. begin
  3834. Value := Res;
  3835. Result := convertOK;
  3836. end;
  3837. end;
  3838. function TryStringToInt64A(const S: AnsiString; out A: Int64): Boolean;
  3839. var L, N : Integer;
  3840. begin
  3841. L := Length(S);
  3842. Result := TryStringToInt64PA(PAnsiChar(S), L, A, N) = convertOK;
  3843. if Result then
  3844. if N < L then
  3845. Result := False;
  3846. end;
  3847. function TryStringToInt64W(const S: WideString; out A: Int64): Boolean;
  3848. var L, N : Integer;
  3849. begin
  3850. L := Length(S);
  3851. Result := TryStringToInt64PW(PWideChar(S), L, A, N) = convertOK;
  3852. if Result then
  3853. if N < L then
  3854. Result := False;
  3855. end;
  3856. function TryStringToInt64U(const S: UnicodeString; out A: Int64): Boolean;
  3857. var L, N : Integer;
  3858. begin
  3859. L := Length(S);
  3860. Result := TryStringToInt64PW(PWideChar(S), L, A, N) = convertOK;
  3861. if Result then
  3862. if N < L then
  3863. Result := False;
  3864. end;
  3865. function TryStringToInt64(const S: String; out A: Int64): Boolean;
  3866. var L, N : Integer;
  3867. begin
  3868. L := Length(S);
  3869. Result := TryStringToInt64P(PChar(S), L, A, N) = convertOK;
  3870. if Result then
  3871. if N < L then
  3872. Result := False;
  3873. end;
  3874. function StringToInt64DefA(const S: AnsiString; const Default: Int64): Int64;
  3875. begin
  3876. if not TryStringToInt64A(S, Result) then
  3877. Result := Default;
  3878. end;
  3879. function StringToInt64DefW(const S: WideString; const Default: Int64): Int64;
  3880. begin
  3881. if not TryStringToInt64W(S, Result) then
  3882. Result := Default;
  3883. end;
  3884. function StringToInt64DefU(const S: UnicodeString; const Default: Int64): Int64;
  3885. begin
  3886. if not TryStringToInt64U(S, Result) then
  3887. Result := Default;
  3888. end;
  3889. function StringToInt64Def(const S: String; const Default: Int64): Int64;
  3890. begin
  3891. if not TryStringToInt64(S, Result) then
  3892. Result := Default;
  3893. end;
  3894. function StringToInt64A(const S: AnsiString): Int64;
  3895. begin
  3896. if not TryStringToInt64A(S, Result) then
  3897. RaiseRangeCheckError;
  3898. end;
  3899. function StringToInt64W(const S: WideString): Int64;
  3900. begin
  3901. if not TryStringToInt64W(S, Result) then
  3902. RaiseRangeCheckError;
  3903. end;
  3904. function StringToInt64U(const S: UnicodeString): Int64;
  3905. begin
  3906. if not TryStringToInt64U(S, Result) then
  3907. RaiseRangeCheckError;
  3908. end;
  3909. function StringToInt64(const S: String): Int64;
  3910. begin
  3911. if not TryStringToInt64(S, Result) then
  3912. RaiseRangeCheckError;
  3913. end;
  3914. function TryStringToIntA(const S: AnsiString; out A: Integer): Boolean;
  3915. var B : Int64;
  3916. begin
  3917. Result := TryStringToInt64A(S, B);
  3918. if not Result then
  3919. begin
  3920. A := 0;
  3921. exit;
  3922. end;
  3923. if (B < MinInteger) or (B > MaxInteger) then
  3924. begin
  3925. A := 0;
  3926. Result := False;
  3927. exit;
  3928. end;
  3929. A := Integer(B);
  3930. Result := True;
  3931. end;
  3932. function TryStringToIntW(const S: WideString; out A: Integer): Boolean;
  3933. var B : Int64;
  3934. begin
  3935. Result := TryStringToInt64W(S, B);
  3936. if not Result then
  3937. begin
  3938. A := 0;
  3939. exit;
  3940. end;
  3941. if (B < MinInteger) or (B > MaxInteger) then
  3942. begin
  3943. A := 0;
  3944. Result := False;
  3945. exit;
  3946. end;
  3947. A := Integer(B);
  3948. Result := True;
  3949. end;
  3950. function TryStringToIntU(const S: UnicodeString; out A: Integer): Boolean;
  3951. var B : Int64;
  3952. begin
  3953. Result := TryStringToInt64U(S, B);
  3954. if not Result then
  3955. begin
  3956. A := 0;
  3957. exit;
  3958. end;
  3959. if (B < MinInteger) or (B > MaxInteger) then
  3960. begin
  3961. A := 0;
  3962. Result := False;
  3963. exit;
  3964. end;
  3965. A := Integer(B);
  3966. Result := True;
  3967. end;
  3968. function TryStringToInt(const S: String; out A: Integer): Boolean;
  3969. var B : Int64;
  3970. begin
  3971. Result := TryStringToInt64(S, B);
  3972. if not Result then
  3973. begin
  3974. A := 0;
  3975. exit;
  3976. end;
  3977. if (B < MinInteger) or (B > MaxInteger) then
  3978. begin
  3979. A := 0;
  3980. Result := False;
  3981. exit;
  3982. end;
  3983. A := Integer(B);
  3984. Result := True;
  3985. end;
  3986. function StringToIntDefA(const S: AnsiString; const Default: Integer): Integer;
  3987. begin
  3988. if not TryStringToIntA(S, Result) then
  3989. Result := Default;
  3990. end;
  3991. function StringToIntDefW(const S: WideString; const Default: Integer): Integer;
  3992. begin
  3993. if not TryStringToIntW(S, Result) then
  3994. Result := Default;
  3995. end;
  3996. function StringToIntDefU(const S: UnicodeString; const Default: Integer): Integer;
  3997. begin
  3998. if not TryStringToIntU(S, Result) then
  3999. Result := Default;
  4000. end;
  4001. function StringToIntDef(const S: String; const Default: Integer): Integer;
  4002. begin
  4003. if not TryStringToInt(S, Result) then
  4004. Result := Default;
  4005. end;
  4006. function StringToIntA(const S: AnsiString): Integer;
  4007. begin
  4008. if not TryStringToIntA(S, Result) then
  4009. RaiseRangeCheckError;
  4010. end;
  4011. function StringToIntW(const S: WideString): Integer;
  4012. begin
  4013. if not TryStringToIntW(S, Result) then
  4014. RaiseRangeCheckError;
  4015. end;
  4016. function StringToIntU(const S: UnicodeString): Integer;
  4017. begin
  4018. if not TryStringToIntU(S, Result) then
  4019. RaiseRangeCheckError;
  4020. end;
  4021. function StringToInt(const S: String): Integer;
  4022. begin
  4023. if not TryStringToInt(S, Result) then
  4024. RaiseRangeCheckError;
  4025. end;
  4026. function TryStringToLongWordA(const S: AnsiString; out A: LongWord): Boolean;
  4027. var B : Int64;
  4028. begin
  4029. Result := TryStringToInt64A(S, B);
  4030. if not Result then
  4031. begin
  4032. A := 0;
  4033. exit;
  4034. end;
  4035. if (B < MinLongWord) or (B > MaxLongWord) then
  4036. begin
  4037. A := 0;
  4038. Result := False;
  4039. exit;
  4040. end;
  4041. A := LongWord(B);
  4042. Result := True;
  4043. end;
  4044. function TryStringToLongWordW(const S: WideString; out A: LongWord): Boolean;
  4045. var B : Int64;
  4046. begin
  4047. Result := TryStringToInt64W(S, B);
  4048. if not Result then
  4049. begin
  4050. A := 0;
  4051. exit;
  4052. end;
  4053. if (B < MinLongWord) or (B > MaxLongWord) then
  4054. begin
  4055. A := 0;
  4056. Result := False;
  4057. exit;
  4058. end;
  4059. A := LongWord(B);
  4060. Result := True;
  4061. end;
  4062. function TryStringToLongWordU(const S: UnicodeString; out A: LongWord): Boolean;
  4063. var B : Int64;
  4064. begin
  4065. Result := TryStringToInt64U(S, B);
  4066. if not Result then
  4067. begin
  4068. A := 0;
  4069. exit;
  4070. end;
  4071. if (B < MinLongWord) or (B > MaxLongWord) then
  4072. begin
  4073. A := 0;
  4074. Result := False;
  4075. exit;
  4076. end;
  4077. A := LongWord(B);
  4078. Result := True;
  4079. end;
  4080. function TryStringToLongWord(const S: String; out A: LongWord): Boolean;
  4081. var B : Int64;
  4082. begin
  4083. Result := TryStringToInt64(S, B);
  4084. if not Result then
  4085. begin
  4086. A := 0;
  4087. exit;
  4088. end;
  4089. if (B < MinLongWord) or (B > MaxLongWord) then
  4090. begin
  4091. A := 0;
  4092. Result := False;
  4093. exit;
  4094. end;
  4095. A := LongWord(B);
  4096. Result := True;
  4097. end;
  4098. function StringToLongWordA(const S: AnsiString): LongWord;
  4099. begin
  4100. if not TryStringToLongWordA(S, Result) then
  4101. RaiseRangeCheckError;
  4102. end;
  4103. function StringToLongWordW(const S: WideString): LongWord;
  4104. begin
  4105. if not TryStringToLongWordW(S, Result) then
  4106. RaiseRangeCheckError;
  4107. end;
  4108. function StringToLongWordU(const S: UnicodeString): LongWord;
  4109. begin
  4110. if not TryStringToLongWordU(S, Result) then
  4111. RaiseRangeCheckError;
  4112. end;
  4113. function StringToLongWord(const S: String): LongWord;
  4114. begin
  4115. if not TryStringToLongWord(S, Result) then
  4116. RaiseRangeCheckError;
  4117. end;
  4118. function BaseStrToNativeUIntA(const S: AnsiString; const BaseLog2: Byte;
  4119. var Valid: Boolean): NativeUInt;
  4120. var N : Byte;
  4121. L : Integer;
  4122. M : Byte;
  4123. C : Byte;
  4124. begin
  4125. Assert(BaseLog2 <= 4); // maximum base 16
  4126. L := Length(S);
  4127. if L = 0 then // empty string is invalid
  4128. begin
  4129. Valid := False;
  4130. Result := 0;
  4131. exit;
  4132. end;
  4133. M := (1 shl BaseLog2) - 1; // maximum digit value
  4134. N := 0;
  4135. Result := 0;
  4136. repeat
  4137. C := HexLookup[S[L]];
  4138. if C > M then // invalid digit
  4139. begin
  4140. Valid := False;
  4141. Result := 0;
  4142. exit;
  4143. end;
  4144. {$IFDEF FPC}
  4145. Result := Result + NativeUInt(C) shl N;
  4146. {$ELSE}
  4147. Inc(Result, NativeUInt(C) shl N);
  4148. {$ENDIF}
  4149. Inc(N, BaseLog2);
  4150. if N > BitsPerNativeWord then // overflow
  4151. begin
  4152. Valid := False;
  4153. Result := 0;
  4154. exit;
  4155. end;
  4156. Dec(L);
  4157. until L = 0;
  4158. Valid := True;
  4159. end;
  4160. function BaseStrToNativeUIntW(const S: WideString; const BaseLog2: Byte;
  4161. var Valid: Boolean): NativeUInt;
  4162. var N : Byte;
  4163. L : Integer;
  4164. M : Byte;
  4165. C : Byte;
  4166. D : WideChar;
  4167. begin
  4168. Assert(BaseLog2 <= 4); // maximum base 16
  4169. L := Length(S);
  4170. if L = 0 then // empty string is invalid
  4171. begin
  4172. Valid := False;
  4173. Result := 0;
  4174. exit;
  4175. end;
  4176. M := (1 shl BaseLog2) - 1; // maximum digit value
  4177. N := 0;
  4178. Result := 0;
  4179. repeat
  4180. D := S[L];
  4181. if Ord(D) > $FF then
  4182. C := $FF
  4183. else
  4184. C := HexLookup[AnsiChar(Ord(D))];
  4185. if C > M then // invalid digit
  4186. begin
  4187. Valid := False;
  4188. Result := 0;
  4189. exit;
  4190. end;
  4191. {$IFDEF FPC}
  4192. Result := Result + NativeUInt(C) shl N;
  4193. {$ELSE}
  4194. Inc(Result, NativeUInt(C) shl N);
  4195. {$ENDIF}
  4196. Inc(N, BaseLog2);
  4197. if N > BitsPerNativeWord then // overflow
  4198. begin
  4199. Valid := False;
  4200. Result := 0;
  4201. exit;
  4202. end;
  4203. Dec(L);
  4204. until L = 0;
  4205. Valid := True;
  4206. end;
  4207. function BaseStrToNativeUIntU(const S: UnicodeString; const BaseLog2: Byte;
  4208. var Valid: Boolean): NativeUInt;
  4209. var N : Byte;
  4210. L : Integer;
  4211. M : Byte;
  4212. C : Byte;
  4213. D : WideChar;
  4214. begin
  4215. Assert(BaseLog2 <= 4); // maximum base 16
  4216. L := Length(S);
  4217. if L = 0 then // empty string is invalid
  4218. begin
  4219. Valid := False;
  4220. Result := 0;
  4221. exit;
  4222. end;
  4223. M := (1 shl BaseLog2) - 1; // maximum digit value
  4224. N := 0;
  4225. Result := 0;
  4226. repeat
  4227. D := S[L];
  4228. if Ord(D) > $FF then
  4229. C := $FF
  4230. else
  4231. C := HexLookup[AnsiChar(Ord(D))];
  4232. if C > M then // invalid digit
  4233. begin
  4234. Valid := False;
  4235. Result := 0;
  4236. exit;
  4237. end;
  4238. {$IFDEF FPC}
  4239. Result := Result + NativeUInt(C) shl N;
  4240. {$ELSE}
  4241. Inc(Result, NativeUInt(C) shl N);
  4242. {$ENDIF}
  4243. Inc(N, BaseLog2);
  4244. if N > BitsPerNativeWord then // overflow
  4245. begin
  4246. Valid := False;
  4247. Result := 0;
  4248. exit;
  4249. end;
  4250. Dec(L);
  4251. until L = 0;
  4252. Valid := True;
  4253. end;
  4254. function BaseStrToNativeUInt(const S: String; const BaseLog2: Byte;
  4255. var Valid: Boolean): NativeUInt;
  4256. var N : Byte;
  4257. L : Integer;
  4258. M : Byte;
  4259. C : Byte;
  4260. D : Char;
  4261. begin
  4262. Assert(BaseLog2 <= 4); // maximum base 16
  4263. L := Length(S);
  4264. if L = 0 then // empty string is invalid
  4265. begin
  4266. Valid := False;
  4267. Result := 0;
  4268. exit;
  4269. end;
  4270. M := (1 shl BaseLog2) - 1; // maximum digit value
  4271. N := 0;
  4272. Result := 0;
  4273. repeat
  4274. D := S[L];
  4275. {$IFDEF CharIsWide}
  4276. if Ord(D) > $FF then
  4277. C := $FF
  4278. else
  4279. C := HexLookup[AnsiChar(Ord(D))];
  4280. {$ELSE}
  4281. C := HexLookup[D];
  4282. {$ENDIF}
  4283. if C > M then // invalid digit
  4284. begin
  4285. Valid := False;
  4286. Result := 0;
  4287. exit;
  4288. end;
  4289. {$IFDEF FPC}
  4290. Result := Result + NativeUInt(C) shl N;
  4291. {$ELSE}
  4292. Inc(Result, NativeUInt(C) shl N);
  4293. {$ENDIF}
  4294. Inc(N, BaseLog2);
  4295. if N > BitsPerNativeWord then // overflow
  4296. begin
  4297. Valid := False;
  4298. Result := 0;
  4299. exit;
  4300. end;
  4301. Dec(L);
  4302. until L = 0;
  4303. Valid := True;
  4304. end;
  4305. function HexToUIntA(const S: AnsiString): NativeUInt;
  4306. var R : Boolean;
  4307. begin
  4308. Result := BaseStrToNativeUIntA(S, 4, R);
  4309. if not R then
  4310. RaiseRangeCheckError;
  4311. end;
  4312. function HexToUIntW(const S: WideString): NativeUInt;
  4313. var R : Boolean;
  4314. begin
  4315. Result := BaseStrToNativeUIntW(S, 4, R);
  4316. if not R then
  4317. RaiseRangeCheckError;
  4318. end;
  4319. function HexToUIntU(const S: UnicodeString): NativeUInt;
  4320. var R : Boolean;
  4321. begin
  4322. Result := BaseStrToNativeUIntU(S, 4, R);
  4323. if not R then
  4324. RaiseRangeCheckError;
  4325. end;
  4326. function HexToUInt(const S: String): NativeUInt;
  4327. var R : Boolean;
  4328. begin
  4329. Result := BaseStrToNativeUInt(S, 4, R);
  4330. if not R then
  4331. RaiseRangeCheckError;
  4332. end;
  4333. function TryHexToLongWordA(const S: AnsiString; out A: LongWord): Boolean;
  4334. begin
  4335. A := BaseStrToNativeUIntA(S, 4, Result);
  4336. end;
  4337. function TryHexToLongWordW(const S: WideString; out A: LongWord): Boolean;
  4338. begin
  4339. A := BaseStrToNativeUIntW(S, 4, Result);
  4340. end;
  4341. function TryHexToLongWordU(const S: UnicodeString; out A: LongWord): Boolean;
  4342. begin
  4343. A := BaseStrToNativeUIntU(S, 4, Result);
  4344. end;
  4345. function TryHexToLongWord(const S: String; out A: LongWord): Boolean;
  4346. begin
  4347. A := BaseStrToNativeUInt(S, 4, Result);
  4348. end;
  4349. function HexToLongWordA(const S: AnsiString): LongWord;
  4350. var R : Boolean;
  4351. begin
  4352. Result := BaseStrToNativeUIntA(S, 4, R);
  4353. if not R then
  4354. RaiseRangeCheckError;
  4355. end;
  4356. function HexToLongWordW(const S: WideString): LongWord;
  4357. var R : Boolean;
  4358. begin
  4359. Result := BaseStrToNativeUIntW(S, 4, R);
  4360. if not R then
  4361. RaiseRangeCheckError;
  4362. end;
  4363. function HexToLongWordU(const S: UnicodeString): LongWord;
  4364. var R : Boolean;
  4365. begin
  4366. Result := BaseStrToNativeUIntU(S, 4, R);
  4367. if not R then
  4368. RaiseRangeCheckError;
  4369. end;
  4370. function HexToLongWord(const S: String): LongWord;
  4371. var R : Boolean;
  4372. begin
  4373. Result := BaseStrToNativeUInt(S, 4, R);
  4374. if not R then
  4375. RaiseRangeCheckError;
  4376. end;
  4377. function TryOctToLongWordA(const S: AnsiString; out A: LongWord): Boolean;
  4378. begin
  4379. A := BaseStrToNativeUIntA(S, 3, Result);
  4380. end;
  4381. function TryOctToLongWordW(const S: WideString; out A: LongWord): Boolean;
  4382. begin
  4383. A := BaseStrToNativeUIntW(S, 3, Result);
  4384. end;
  4385. function TryOctToLongWordU(const S: UnicodeString; out A: LongWord): Boolean;
  4386. begin
  4387. A := BaseStrToNativeUIntU(S, 3, Result);
  4388. end;
  4389. function TryOctToLongWord(const S: String; out A: LongWord): Boolean;
  4390. begin
  4391. A := BaseStrToNativeUInt(S, 3, Result);
  4392. end;
  4393. function OctToLongWordA(const S: AnsiString): LongWord;
  4394. var R : Boolean;
  4395. begin
  4396. Result := BaseStrToNativeUIntA(S, 3, R);
  4397. if not R then
  4398. RaiseRangeCheckError;
  4399. end;
  4400. function OctToLongWordW(const S: WideString): LongWord;
  4401. var R : Boolean;
  4402. begin
  4403. Result := BaseStrToNativeUIntW(S, 3, R);
  4404. if not R then
  4405. RaiseRangeCheckError;
  4406. end;
  4407. function OctToLongWordU(const S: UnicodeString): LongWord;
  4408. var R : Boolean;
  4409. begin
  4410. Result := BaseStrToNativeUIntU(S, 3, R);
  4411. if not R then
  4412. RaiseRangeCheckError;
  4413. end;
  4414. function OctToLongWord(const S: String): LongWord;
  4415. var R : Boolean;
  4416. begin
  4417. Result := BaseStrToNativeUIntW(S, 3, R);
  4418. if not R then
  4419. RaiseRangeCheckError;
  4420. end;
  4421. function TryBinToLongWordA(const S: AnsiString; out A: LongWord): Boolean;
  4422. begin
  4423. A := BaseStrToNativeUIntA(S, 1, Result);
  4424. end;
  4425. function TryBinToLongWordW(const S: WideString; out A: LongWord): Boolean;
  4426. begin
  4427. A := BaseStrToNativeUIntW(S, 1, Result);
  4428. end;
  4429. function TryBinToLongWordU(const S: UnicodeString; out A: LongWord): Boolean;
  4430. begin
  4431. A := BaseStrToNativeUIntU(S, 1, Result);
  4432. end;
  4433. function TryBinToLongWord(const S: String; out A: LongWord): Boolean;
  4434. begin
  4435. A := BaseStrToNativeUInt(S, 1, Result);
  4436. end;
  4437. function BinToLongWordA(const S: AnsiString): LongWord;
  4438. var R : Boolean;
  4439. begin
  4440. Result := BaseStrToNativeUIntA(S, 1, R);
  4441. if not R then
  4442. RaiseRangeCheckError;
  4443. end;
  4444. function BinToLongWordW(const S: WideString): LongWord;
  4445. var R : Boolean;
  4446. begin
  4447. Result := BaseStrToNativeUIntW(S, 1, R);
  4448. if not R then
  4449. RaiseRangeCheckError;
  4450. end;
  4451. function BinToLongWordU(const S: UnicodeString): LongWord;
  4452. var R : Boolean;
  4453. begin
  4454. Result := BaseStrToNativeUIntU(S, 1, R);
  4455. if not R then
  4456. RaiseRangeCheckError;
  4457. end;
  4458. function BinToLongWord(const S: String): LongWord;
  4459. var R : Boolean;
  4460. begin
  4461. Result := BaseStrToNativeUInt(S, 1, R);
  4462. if not R then
  4463. RaiseRangeCheckError;
  4464. end;
  4465. { }
  4466. { Float-String conversions }
  4467. { }
  4468. function FloatToStringS(const A: Extended): ShortString;
  4469. var B : Extended;
  4470. S : ShortString;
  4471. L, I : Integer;
  4472. E : Integer;
  4473. begin
  4474. // handle special floating point values
  4475. if FloatIsInfinity(A) or FloatIsNaN(A) then
  4476. begin
  4477. Result := '';
  4478. exit;
  4479. end;
  4480. B := Abs(A);
  4481. // very small numbers (Double precision) are zero
  4482. if B < 1e-300 then
  4483. begin
  4484. Result := '0';
  4485. exit;
  4486. end;
  4487. // up to 15 digits (around Double precsion) before or after decimal use non-scientific notation
  4488. if (B < 1e-15) or (B >= 1e+15) then
  4489. Str(A, S)
  4490. else
  4491. Str(A:0:15, S);
  4492. // trim preceding spaces
  4493. I := 1;
  4494. while S[I] = ' ' do
  4495. Inc(I);
  4496. if I > 1 then
  4497. S := Copy(S, I, Length(S) - I + 1);
  4498. // find exponent
  4499. L := Length(S);
  4500. E := 0;
  4501. for I := 1 to L do
  4502. if S[I] = 'E' then
  4503. begin
  4504. E := I;
  4505. break;
  4506. end;
  4507. if E = 0 then
  4508. begin
  4509. // trim trailing zeros
  4510. I := L;
  4511. while S[I] = '0' do
  4512. Dec(I);
  4513. if S[I] = '.' then
  4514. Dec(I);
  4515. if I < L then
  4516. SetLength(S, I);
  4517. end
  4518. else
  4519. begin
  4520. // trim trailing zeros in mantissa
  4521. I := E - 1;
  4522. while S[I] = '0' do
  4523. Dec(I);
  4524. if S[I] = '.' then
  4525. Dec(I);
  4526. if I < E - 1 then
  4527. S := Copy(S, 1, I) + Copy(S, E, L - E + 1);
  4528. end;
  4529. // return formatted float string
  4530. Result := S;
  4531. end;
  4532. function FloatToStringA(const A: Extended): AnsiString;
  4533. begin
  4534. Result := AnsiString(FloatToStringS(A));
  4535. end;
  4536. function FloatToStringW(const A: Extended): WideString;
  4537. begin
  4538. Result := WideString(FloatToStringS(A));
  4539. end;
  4540. function FloatToStringU(const A: Extended): UnicodeString;
  4541. begin
  4542. Result := UnicodeString(FloatToStringS(A));
  4543. end;
  4544. function FloatToString(const A: Extended): String;
  4545. begin
  4546. Result := String(FloatToStringS(A));
  4547. end;
  4548. function TryStringToFloatPA(const BufP: Pointer; const BufLen: Integer; out Value: Extended; out StrLen: Integer): TConvertResult;
  4549. var Len : Integer;
  4550. DigVal : Integer;
  4551. DigValF : Extended;
  4552. P : PAnsiChar;
  4553. Ch : AnsiChar;
  4554. HasDig : Boolean;
  4555. Neg : Boolean;
  4556. Res : Extended;
  4557. Ex : Extended;
  4558. ExI : Int64;
  4559. L : Integer;
  4560. begin
  4561. if BufLen <= 0 then
  4562. begin
  4563. Value := 0;
  4564. StrLen := 0;
  4565. Result := convertFormatError;
  4566. exit;
  4567. end;
  4568. P := BufP;
  4569. Len := 0;
  4570. // check sign
  4571. Ch := P^;
  4572. if (Ch = '+') or (Ch = '-') then
  4573. begin
  4574. Inc(Len);
  4575. Inc(P);
  4576. Neg := Ch = '-';
  4577. end
  4578. else
  4579. Neg := False;
  4580. // skip leading zeros
  4581. HasDig := False;
  4582. while (Len < BufLen) and (P^ = '0') do
  4583. begin
  4584. Inc(Len);
  4585. Inc(P);
  4586. HasDig := True;
  4587. end;
  4588. // convert integer digits
  4589. Res := 0.0;
  4590. while Len < BufLen do
  4591. begin
  4592. Ch := P^;
  4593. if (Ch >= '0') and (Ch <= '9') then
  4594. begin
  4595. HasDig := True;
  4596. // maximum Extended is roughly 1.1e4932, maximum Double is roughly 1.7e308
  4597. if Abs(Res) >= 1.0e+290 then
  4598. begin
  4599. Value := 0;
  4600. StrLen := Len;
  4601. Result := convertOverflow;
  4602. exit;
  4603. end;
  4604. Res := Res * 10.0;
  4605. DigVal := AnsiCharToInt(Ch);
  4606. if Neg then
  4607. Res := Res - DigVal
  4608. else
  4609. Res := Res + DigVal;
  4610. Inc(Len);
  4611. Inc(P);
  4612. end
  4613. else
  4614. break;
  4615. end;
  4616. // convert decimal digits
  4617. if (Len < BufLen) and (P^ = '.') then
  4618. begin
  4619. Inc(Len);
  4620. Inc(P);
  4621. ExI := 0;
  4622. while Len < BufLen do
  4623. begin
  4624. Ch := P^;
  4625. if (Ch >= '0') and (Ch <= '9') then
  4626. begin
  4627. HasDig := True;
  4628. // minimum Extended is roughly 3.6e-4951, minimum Double is roughly 5e-324
  4629. if ExI >= 1000 then
  4630. begin
  4631. Value := 0;
  4632. StrLen := Len;
  4633. Result := convertOverflow;
  4634. exit;
  4635. end;
  4636. DigVal := AnsiCharToInt(Ch);
  4637. Inc(ExI);
  4638. DigValF := DigVal;
  4639. DigValF := DigValF / Power(10.0, ExI);
  4640. if Neg then
  4641. Res := Res - DigValF
  4642. else
  4643. Res := Res + DigValF;
  4644. Inc(Len);
  4645. Inc(P);
  4646. end
  4647. else
  4648. break;
  4649. end;
  4650. end;
  4651. // check valid digit
  4652. if not HasDig then
  4653. begin
  4654. Value := 0;
  4655. StrLen := Len;
  4656. Result := convertFormatError;
  4657. exit;
  4658. end;
  4659. // convert exponent
  4660. if Len < BufLen then
  4661. begin
  4662. Ch := P^;
  4663. if (Ch = 'e') or (Ch = 'E') then
  4664. begin
  4665. Inc(Len);
  4666. Inc(P);
  4667. Result := TryStringToInt64PA(P, BufLen - Len, ExI, L);
  4668. Inc(Len, L);
  4669. if Result <> convertOK then
  4670. begin
  4671. Value := 0;
  4672. StrLen := Len;
  4673. exit;
  4674. end;
  4675. if ExI <> 0 then
  4676. begin
  4677. if (ExI > 1000) or (ExI < -1000) then
  4678. begin
  4679. Value := 0;
  4680. StrLen := Len;
  4681. Result := convertOverflow;
  4682. exit;
  4683. end;
  4684. Ex := ExI;
  4685. Ex := Power(10.0, Ex);
  4686. Res := Res * Ex;
  4687. end;
  4688. end;
  4689. end;
  4690. // success
  4691. Value := Res;
  4692. StrLen := Len;
  4693. Result := convertOK;
  4694. end;
  4695. function TryStringToFloatPW(const BufP: Pointer; const BufLen: Integer; out Value: Extended; out StrLen: Integer): TConvertResult;
  4696. var Len : Integer;
  4697. DigVal : Integer;
  4698. DigValF : Extended;
  4699. P : PWideChar;
  4700. Ch : WideChar;
  4701. HasDig : Boolean;
  4702. Neg : Boolean;
  4703. Res : Extended;
  4704. Ex : Extended;
  4705. ExI : Int64;
  4706. L : Integer;
  4707. begin
  4708. if BufLen <= 0 then
  4709. begin
  4710. Value := 0;
  4711. StrLen := 0;
  4712. Result := convertFormatError;
  4713. exit;
  4714. end;
  4715. P := BufP;
  4716. Len := 0;
  4717. // check sign
  4718. Ch := P^;
  4719. if (Ch = '+') or (Ch = '-') then
  4720. begin
  4721. Inc(Len);
  4722. Inc(P);
  4723. Neg := Ch = '-';
  4724. end
  4725. else
  4726. Neg := False;
  4727. // skip leading zeros
  4728. HasDig := False;
  4729. while (Len < BufLen) and (P^ = '0') do
  4730. begin
  4731. Inc(Len);
  4732. Inc(P);
  4733. HasDig := True;
  4734. end;
  4735. // convert integer digits
  4736. Res := 0.0;
  4737. while Len < BufLen do
  4738. begin
  4739. Ch := P^;
  4740. if (Ch >= '0') and (Ch <= '9') then
  4741. begin
  4742. HasDig := True;
  4743. // maximum Extended is roughly 1.1e4932, maximum Double is roughly 1.7e308
  4744. if Abs(Res) >= 1.0e+1000 then
  4745. begin
  4746. Value := 0;
  4747. StrLen := Len;
  4748. Result := convertOverflow;
  4749. exit;
  4750. end;
  4751. Res := Res * 10.0;
  4752. DigVal := WideCharToInt(Ch);
  4753. if Neg then
  4754. Res := Res - DigVal
  4755. else
  4756. Res := Res + DigVal;
  4757. Inc(Len);
  4758. Inc(P);
  4759. end
  4760. else
  4761. break;
  4762. end;
  4763. // convert decimal digits
  4764. if (Len < BufLen) and (P^ = '.') then
  4765. begin
  4766. Inc(Len);
  4767. Inc(P);
  4768. ExI := 0;
  4769. while Len < BufLen do
  4770. begin
  4771. Ch := P^;
  4772. if (Ch >= '0') and (Ch <= '9') then
  4773. begin
  4774. HasDig := True;
  4775. // minimum Extended is roughly 3.6e-4951, minimum Double is roughly 5e-324
  4776. if ExI >= 1000 then
  4777. begin
  4778. Value := 0;
  4779. StrLen := Len;
  4780. Result := convertOverflow;
  4781. exit;
  4782. end;
  4783. DigVal := WideCharToInt(Ch);
  4784. Inc(ExI);
  4785. DigValF := DigVal;
  4786. DigValF := DigValF / Power(10.0, ExI);
  4787. if Neg then
  4788. Res := Res - DigValF
  4789. else
  4790. Res := Res + DigValF;
  4791. Inc(Len);
  4792. Inc(P);
  4793. end
  4794. else
  4795. break;
  4796. end;
  4797. end;
  4798. // check valid digit
  4799. if not HasDig then
  4800. begin
  4801. Value := 0;
  4802. StrLen := Len;
  4803. Result := convertFormatError;
  4804. exit;
  4805. end;
  4806. // convert exponent
  4807. if Len < BufLen then
  4808. begin
  4809. Ch := P^;
  4810. if (Ch = 'e') or (Ch = 'E') then
  4811. begin
  4812. Inc(Len);
  4813. Inc(P);
  4814. Result := TryStringToInt64PW(P, BufLen - Len, ExI, L);
  4815. Inc(Len, L);
  4816. if Result <> convertOK then
  4817. begin
  4818. Value := 0;
  4819. StrLen := Len;
  4820. exit;
  4821. end;
  4822. if ExI <> 0 then
  4823. begin
  4824. if (ExI > 1000) or (ExI < -1000) then
  4825. begin
  4826. Value := 0;
  4827. StrLen := Len;
  4828. Result := convertOverflow;
  4829. exit;
  4830. end;
  4831. Ex := ExI;
  4832. Ex := Power(10.0, Ex);
  4833. Res := Res * Ex;
  4834. end;
  4835. end;
  4836. end;
  4837. // success
  4838. Value := Res;
  4839. StrLen := Len;
  4840. Result := convertOK;
  4841. end;
  4842. function TryStringToFloatP(const BufP: Pointer; const BufLen: Integer; out Value: Extended; out StrLen: Integer): TConvertResult;
  4843. var Len : Integer;
  4844. DigVal : Integer;
  4845. DigValF : Extended;
  4846. P : PChar;
  4847. Ch : Char;
  4848. HasDig : Boolean;
  4849. Neg : Boolean;
  4850. Res : Extended;
  4851. Ex : Extended;
  4852. ExI : Int64;
  4853. L : Integer;
  4854. begin
  4855. if BufLen <= 0 then
  4856. begin
  4857. Value := 0;
  4858. StrLen := 0;
  4859. Result := convertFormatError;
  4860. exit;
  4861. end;
  4862. P := BufP;
  4863. Len := 0;
  4864. // check sign
  4865. Ch := P^;
  4866. if (Ch = '+') or (Ch = '-') then
  4867. begin
  4868. Inc(Len);
  4869. Inc(P);
  4870. Neg := Ch = '-';
  4871. end
  4872. else
  4873. Neg := False;
  4874. // skip leading zeros
  4875. HasDig := False;
  4876. while (Len < BufLen) and (P^ = '0') do
  4877. begin
  4878. Inc(Len);
  4879. Inc(P);
  4880. HasDig := True;
  4881. end;
  4882. // convert integer digits
  4883. Res := 0.0;
  4884. while Len < BufLen do
  4885. begin
  4886. Ch := P^;
  4887. if (Ch >= '0') and (Ch <= '9') then
  4888. begin
  4889. HasDig := True;
  4890. // maximum Extended is roughly 1.1e4932, maximum Double is roughly 1.7e308
  4891. if Abs(Res) >= 1.0e+1000 then
  4892. begin
  4893. Value := 0;
  4894. StrLen := Len;
  4895. Result := convertOverflow;
  4896. exit;
  4897. end;
  4898. Res := Res * 10.0;
  4899. DigVal := CharToInt(Ch);
  4900. if Neg then
  4901. Res := Res - DigVal
  4902. else
  4903. Res := Res + DigVal;
  4904. Inc(Len);
  4905. Inc(P);
  4906. end
  4907. else
  4908. break;
  4909. end;
  4910. // convert decimal digits
  4911. if (Len < BufLen) and (P^ = '.') then
  4912. begin
  4913. Inc(Len);
  4914. Inc(P);
  4915. ExI := 0;
  4916. while Len < BufLen do
  4917. begin
  4918. Ch := P^;
  4919. if (Ch >= '0') and (Ch <= '9') then
  4920. begin
  4921. HasDig := True;
  4922. // minimum Extended is roughly 3.6e-4951, minimum Double is roughly 5e-324
  4923. if ExI >= 1000 then
  4924. begin
  4925. Value := 0;
  4926. StrLen := Len;
  4927. Result := convertOverflow;
  4928. exit;
  4929. end;
  4930. DigVal := CharToInt(Ch);
  4931. Inc(ExI);
  4932. DigValF := DigVal;
  4933. DigValF := DigValF / Power(10.0, ExI);
  4934. if Neg then
  4935. Res := Res - DigValF
  4936. else
  4937. Res := Res + DigValF;
  4938. Inc(Len);
  4939. Inc(P);
  4940. end
  4941. else
  4942. break;
  4943. end;
  4944. end;
  4945. // check valid digit
  4946. if not HasDig then
  4947. begin
  4948. Value := 0;
  4949. StrLen := Len;
  4950. Result := convertFormatError;
  4951. exit;
  4952. end;
  4953. // convert exponent
  4954. if Len < BufLen then
  4955. begin
  4956. Ch := P^;
  4957. if (Ch = 'e') or (Ch = 'E') then
  4958. begin
  4959. Inc(Len);
  4960. Inc(P);
  4961. Result := TryStringToInt64P(P, BufLen - Len, ExI, L);
  4962. Inc(Len, L);
  4963. if Result <> convertOK then
  4964. begin
  4965. Value := 0;
  4966. StrLen := Len;
  4967. exit;
  4968. end;
  4969. if ExI <> 0 then
  4970. begin
  4971. if (ExI > 1000) or (ExI < -1000) then
  4972. begin
  4973. Value := 0;
  4974. StrLen := Len;
  4975. Result := convertOverflow;
  4976. exit;
  4977. end;
  4978. Ex := ExI;
  4979. Ex := Power(10.0, Ex);
  4980. Res := Res * Ex;
  4981. end;
  4982. end;
  4983. end;
  4984. // success
  4985. Value := Res;
  4986. StrLen := Len;
  4987. Result := convertOK;
  4988. end;
  4989. function TryStringToFloatA(const A: AnsiString; out B: Extended): Boolean;
  4990. var L, N : Integer;
  4991. begin
  4992. L := Length(A);
  4993. Result := TryStringToFloatPA(PAnsiChar(A), L, B, N) = convertOK;
  4994. if Result then
  4995. if N < L then
  4996. Result := False;
  4997. end;
  4998. function TryStringToFloatW(const A: WideString; out B: Extended): Boolean;
  4999. var L, N : Integer;
  5000. begin
  5001. L := Length(A);
  5002. Result := TryStringToFloatPW(PWideChar(A), L, B, N) = convertOK;
  5003. if Result then
  5004. if N < L then
  5005. Result := False;
  5006. end;
  5007. function TryStringToFloatU(const A: UnicodeString; out B: Extended): Boolean;
  5008. var L, N : Integer;
  5009. begin
  5010. L := Length(A);
  5011. Result := TryStringToFloatPW(PWideChar(A), L, B, N) = convertOK;
  5012. if Result then
  5013. if N < L then
  5014. Result := False;
  5015. end;
  5016. function TryStringToFloat(const A: String; out B: Extended): Boolean;
  5017. var L, N : Integer;
  5018. begin
  5019. L := Length(A);
  5020. Result := TryStringToFloatP(PChar(A), L, B, N) = convertOK;
  5021. if Result then
  5022. if N < L then
  5023. Result := False;
  5024. end;
  5025. function StringToFloatA(const A: AnsiString): Extended;
  5026. begin
  5027. if not TryStringToFloatA(A, Result) then
  5028. RaiseRangeCheckError;
  5029. end;
  5030. function StringToFloatW(const A: WideString): Extended;
  5031. begin
  5032. if not TryStringToFloatW(A, Result) then
  5033. RaiseRangeCheckError;
  5034. end;
  5035. function StringToFloatU(const A: UnicodeString): Extended;
  5036. begin
  5037. if not TryStringToFloatU(A, Result) then
  5038. RaiseRangeCheckError;
  5039. end;
  5040. function StringToFloat(const A: String): Extended;
  5041. begin
  5042. if not TryStringToFloat(A, Result) then
  5043. RaiseRangeCheckError;
  5044. end;
  5045. function StringToFloatDefA(const A: AnsiString; const Default: Extended): Extended;
  5046. begin
  5047. if not TryStringToFloatA(A, Result) then
  5048. Result := Default;
  5049. end;
  5050. function StringToFloatDefW(const A: WideString; const Default: Extended): Extended;
  5051. begin
  5052. if not TryStringToFloatW(A, Result) then
  5053. Result := Default;
  5054. end;
  5055. function StringToFloatDefU(const A: UnicodeString; const Default: Extended): Extended;
  5056. begin
  5057. if not TryStringToFloatU(A, Result) then
  5058. Result := Default;
  5059. end;
  5060. function StringToFloatDef(const A: String; const Default: Extended): Extended;
  5061. begin
  5062. if not TryStringToFloat(A, Result) then
  5063. Result := Default;
  5064. end;
  5065. { }
  5066. { Base64 }
  5067. { }
  5068. {$IFDEF CLR}
  5069. function EncodeBase64(const S, Alphabet: AnsiString; const Pad: Boolean;
  5070. const PadMultiple: Integer; const PadChar: AnsiChar): AnsiString;
  5071. var R, C : Byte;
  5072. I, F, L, M, N, U : Integer;
  5073. T : Boolean;
  5074. begin
  5075. Assert(Length(Alphabet) = 64);
  5076. {$IFOPT R+}
  5077. if Length(Alphabet) <> 64 then
  5078. begin
  5079. Result := '';
  5080. exit;
  5081. end;
  5082. {$ENDIF}
  5083. L := Length(S);
  5084. if L = 0 then
  5085. begin
  5086. Result := '';
  5087. exit;
  5088. end;
  5089. M := L mod 3;
  5090. N := (L div 3) * 4 + M;
  5091. if M > 0 then
  5092. Inc(N);
  5093. T := Pad and (PadMultiple > 1);
  5094. if T then
  5095. begin
  5096. U := N mod PadMultiple;
  5097. if U > 0 then
  5098. begin
  5099. U := PadMultiple - U;
  5100. Inc(N, U);
  5101. end;
  5102. end else
  5103. U := 0;
  5104. SetLength(Result, N);
  5105. I := 1;
  5106. R := 0;
  5107. for F := 0 to L - 1 do
  5108. begin
  5109. C := Byte(S [F + 1]);
  5110. case F mod 3 of
  5111. 0 : begin
  5112. Result[I] := Alphabet[C shr 2 + 1];
  5113. Inc(I);
  5114. R := (C and 3) shl 4;
  5115. end;
  5116. 1 : begin
  5117. Result[I] := Alphabet[C shr 4 + R + 1];
  5118. Inc(I);
  5119. R := (C and $0F) shl 2;
  5120. end;
  5121. 2 : begin
  5122. Result[I] := Alphabet[C shr 6 + R + 1];
  5123. Inc(I);
  5124. Result[I] := Alphabet[C and $3F + 1];
  5125. Inc(I);
  5126. end;
  5127. end;
  5128. end;
  5129. if M > 0 then
  5130. begin
  5131. Result[I] := Alphabet[R + 1];
  5132. Inc(I);
  5133. end;
  5134. for F := 1 to U do
  5135. begin
  5136. Result[I] := PadChar;
  5137. Inc(I);
  5138. end;
  5139. end;
  5140. {$ELSE}
  5141. function EncodeBase64(const S, Alphabet: AnsiString; const Pad: Boolean;
  5142. const PadMultiple: Integer; const PadChar: AnsiChar): AnsiString;
  5143. var R, C : Byte;
  5144. F, L, M, N, U : Integer;
  5145. P : PAnsiChar;
  5146. T : Boolean;
  5147. begin
  5148. Assert(Length(Alphabet) = 64);
  5149. {$IFOPT R+}
  5150. if Length(Alphabet) <> 64 then
  5151. begin
  5152. Result := '';
  5153. exit;
  5154. end;
  5155. {$ENDIF}
  5156. L := Length(S);
  5157. if L = 0 then
  5158. begin
  5159. Result := '';
  5160. exit;
  5161. end;
  5162. M := L mod 3;
  5163. N := (L div 3) * 4 + M;
  5164. if M > 0 then
  5165. Inc(N);
  5166. T := Pad and (PadMultiple > 1);
  5167. if T then
  5168. begin
  5169. U := N mod PadMultiple;
  5170. if U > 0 then
  5171. begin
  5172. U := PadMultiple - U;
  5173. Inc(N, U);
  5174. end;
  5175. end else
  5176. U := 0;
  5177. SetLength(Result, N);
  5178. P := Pointer(Result);
  5179. R := 0;
  5180. for F := 0 to L - 1 do
  5181. begin
  5182. C := Byte(S [F + 1]);
  5183. case F mod 3 of
  5184. 0 : begin
  5185. P^ := Alphabet[C shr 2 + 1];
  5186. Inc(P);
  5187. R := (C and 3) shl 4;
  5188. end;
  5189. 1 : begin
  5190. P^ := Alphabet[C shr 4 + R + 1];
  5191. Inc(P);
  5192. R := (C and $0F) shl 2;
  5193. end;
  5194. 2 : begin
  5195. P^ := Alphabet[C shr 6 + R + 1];
  5196. Inc(P);
  5197. P^ := Alphabet[C and $3F + 1];
  5198. Inc(P);
  5199. end;
  5200. end;
  5201. end;
  5202. if M > 0 then
  5203. begin
  5204. P^ := Alphabet[R + 1];
  5205. Inc(P);
  5206. end;
  5207. for F := 1 to U do
  5208. begin
  5209. P^ := PadChar;
  5210. Inc(P);
  5211. end;
  5212. end;
  5213. {$ENDIF}
  5214. {$IFDEF CLR}
  5215. function DecodeBase64(const S, Alphabet: AnsiString; const PadSet: CharSet): AnsiString;
  5216. var F, L, M, P : Integer;
  5217. B, OutPos : Byte;
  5218. C : AnsiChar;
  5219. OutB : array[1..3] of Byte;
  5220. Lookup : array[AnsiChar] of Byte;
  5221. R : Integer;
  5222. begin
  5223. Assert(Length(Alphabet) = 64);
  5224. {$IFOPT R+}
  5225. if Length(Alphabet) <> 64 then
  5226. begin
  5227. Result := '';
  5228. exit;
  5229. end;
  5230. {$ENDIF}
  5231. L := Length(S);
  5232. P := 0;
  5233. if PadSet <> [] then
  5234. while (L - P > 0) and (S[L - P] in PadSet) do
  5235. Inc(P);
  5236. M := L - P;
  5237. if M = 0 then
  5238. begin
  5239. Result := '';
  5240. exit;
  5241. end;
  5242. SetLength(Result, (M * 3) div 4);
  5243. for C := #0 to #255 do
  5244. Lookup[C] := 0;
  5245. for F := 0 to 63 do
  5246. Lookup[Alphabet[F + 1]] := Byte(F);
  5247. R := 1;
  5248. OutPos := 0;
  5249. for F := 1 to L - P do
  5250. begin
  5251. B := Lookup[S[F]];
  5252. case OutPos of
  5253. 0 : OutB[1] := B shl 2;
  5254. 1 : begin
  5255. OutB[1] := OutB[1] or (B shr 4);
  5256. Result[R] := AnsiChar(OutB[1]);
  5257. Inc(R);
  5258. OutB[2] := (B shl 4) and $FF;
  5259. end;
  5260. 2 : begin
  5261. OutB[2] := OutB[2] or (B shr 2);
  5262. Result[R] := AnsiChar(OutB[2]);
  5263. Inc(R);
  5264. OutB[3] := (B shl 6) and $FF;
  5265. end;
  5266. 3 : begin
  5267. OutB[3] := OutB[3] or B;
  5268. Result[R] := AnsiChar(OutB[3]);
  5269. Inc(R);
  5270. end;
  5271. end;
  5272. OutPos := (OutPos + 1) mod 4;
  5273. end;
  5274. if (OutPos > 0) and (P = 0) then // incomplete encoding, add the partial byte if not 0
  5275. if OutB[OutPos] <> 0 then
  5276. Result := Result + AnsiChar(OutB[OutPos]);
  5277. end;
  5278. {$ELSE}
  5279. function DecodeBase64(const S, Alphabet: AnsiString; const PadSet: CharSet): AnsiString;
  5280. var F, L, M, P : Integer;
  5281. B, OutPos : Byte;
  5282. OutB : array[1..3] of Byte;
  5283. Lookup : array[AnsiChar] of Byte;
  5284. R : PAnsiChar;
  5285. begin
  5286. Assert(Length(Alphabet) = 64);
  5287. {$IFOPT R+}
  5288. if Length(Alphabet) <> 64 then
  5289. begin
  5290. Result := '';
  5291. exit;
  5292. end;
  5293. {$ENDIF}
  5294. L := Length(S);
  5295. P := 0;
  5296. if PadSet <> [] then
  5297. while (L - P > 0) and (S[L - P] in PadSet) do
  5298. Inc(P);
  5299. M := L - P;
  5300. if M = 0 then
  5301. begin
  5302. Result := '';
  5303. exit;
  5304. end;
  5305. SetLength(Result, (M * 3) div 4);
  5306. FillChar(Lookup, Sizeof(Lookup), #0);
  5307. for F := 0 to 63 do
  5308. Lookup[Alphabet[F + 1]] := Byte(F);
  5309. R := Pointer(Result);
  5310. OutPos := 0;
  5311. for F := 1 to L - P do
  5312. begin
  5313. B := Lookup[S[F]];
  5314. case OutPos of
  5315. 0 : OutB[1] := B shl 2;
  5316. 1 : begin
  5317. OutB[1] := OutB[1] or (B shr 4);
  5318. R^ := AnsiChar(OutB[1]);
  5319. Inc(R);
  5320. OutB[2] := (B shl 4) and $FF;
  5321. end;
  5322. 2 : begin
  5323. OutB[2] := OutB[2] or (B shr 2);
  5324. R^ := AnsiChar(OutB[2]);
  5325. Inc(R);
  5326. OutB[3] := (B shl 6) and $FF;
  5327. end;
  5328. 3 : begin
  5329. OutB[3] := OutB[3] or B;
  5330. R^ := AnsiChar(OutB[3]);
  5331. Inc(R);
  5332. end;
  5333. end;
  5334. OutPos := (OutPos + 1) mod 4;
  5335. end;
  5336. if (OutPos > 0) and (P = 0) then // incomplete encoding, add the partial byte if not 0
  5337. if OutB[OutPos] <> 0 then
  5338. Result := Result + AnsiChar(OutB[OutPos]);
  5339. end;
  5340. {$ENDIF}
  5341. function MIMEBase64Encode(const S: AnsiString): AnsiString;
  5342. begin
  5343. Result := EncodeBase64(S, b64_MIMEBase64, True, 4, '=');
  5344. end;
  5345. function UUDecode(const S: AnsiString): AnsiString;
  5346. begin
  5347. // Line without size indicator (first byte = length + 32)
  5348. Result := DecodeBase64(S, b64_UUEncode, ['`']);
  5349. end;
  5350. function MIMEBase64Decode(const S: AnsiString): AnsiString;
  5351. begin
  5352. Result := DecodeBase64(S, b64_MIMEBase64, ['=']);
  5353. end;
  5354. function XXDecode(const S: AnsiString): AnsiString;
  5355. begin
  5356. Result := DecodeBase64(S, b64_XXEncode, []);
  5357. end;
  5358. {$IFDEF ManagedCode}
  5359. function BytesToHex(const P: array of Byte; const UpperCase: Boolean): AnsiString;
  5360. var D : Integer;
  5361. E : Integer;
  5362. L : Integer;
  5363. V : Byte;
  5364. W : Byte;
  5365. begin
  5366. L := Length(P);
  5367. if L = 0 then
  5368. begin
  5369. Result := '';
  5370. exit;
  5371. end;
  5372. SetLength(Result, L * 2);
  5373. D := 1;
  5374. E := 1;
  5375. while L > 0 do
  5376. begin
  5377. W := P[E];
  5378. V := W shr 4 + 1;
  5379. Inc(E);
  5380. if UpperCase then
  5381. Result[D] := AnsiChar(StrHexDigitsUpper[V])
  5382. else
  5383. Result[D] := AnsiChar(StrHexDigitsLower[V]);
  5384. Inc(D);
  5385. V := W and $F + 1;
  5386. if UpperCase then
  5387. Result[D] := AnsiChar(StrHexDigitsUpper[V])
  5388. else
  5389. Result[D] := AnsiChar(StrHexDigitsLower[V]);
  5390. Inc(D);
  5391. Dec(L);
  5392. end;
  5393. end;
  5394. {$ELSE}
  5395. function BytesToHex(const P: Pointer; const Count: Integer;
  5396. const UpperCase: Boolean): AnsiString;
  5397. var Q : PByte;
  5398. D : PAnsiChar;
  5399. L : Integer;
  5400. V : Byte;
  5401. begin
  5402. Q := P;
  5403. L := Count;
  5404. if (L <= 0) or not Assigned(Q) then
  5405. begin
  5406. Result := '';
  5407. exit;
  5408. end;
  5409. SetLength(Result, Count * 2);
  5410. D := Pointer(Result);
  5411. while L > 0 do
  5412. begin
  5413. V := Q^ shr 4 + 1;
  5414. if UpperCase then
  5415. D^ := StrHexDigitsUpper[V]
  5416. else
  5417. D^ := StrHexDigitsLower[V];
  5418. Inc(D);
  5419. V := Q^ and $F + 1;
  5420. if UpperCase then
  5421. D^ := StrHexDigitsUpper[V]
  5422. else
  5423. D^ := StrHexDigitsLower[V];
  5424. Inc(D);
  5425. Inc(Q);
  5426. Dec(L);
  5427. end;
  5428. end;
  5429. {$ENDIF}
  5430. { }
  5431. { Type conversion }
  5432. { }
  5433. {$IFNDEF ManagedCode}
  5434. function PointerToStrA(const P: Pointer): AnsiString;
  5435. begin
  5436. Result := NativeUIntToBaseA(NativeUInt(P), BytesPerNativeWord * 2, 16, True);
  5437. end;
  5438. function PointerToStrW(const P: Pointer): WideString;
  5439. begin
  5440. Result := NativeUIntToBaseW(NativeUInt(P), BytesPerNativeWord * 2, 16, True);
  5441. end;
  5442. function PointerToStr(const P: Pointer): String;
  5443. begin
  5444. Result := NativeUIntToBase(NativeUInt(P), BytesPerNativeWord * 2, 16, True);
  5445. end;
  5446. function StrToPointerA(const S: AnsiString): Pointer;
  5447. var V : Boolean;
  5448. begin
  5449. Result := Pointer(BaseStrToNativeUIntA(S, 4, V));
  5450. end;
  5451. function StrToPointerW(const S: WideString): Pointer;
  5452. var V : Boolean;
  5453. begin
  5454. Result := Pointer(BaseStrToNativeUIntW(S, 4, V));
  5455. end;
  5456. function StrToPointer(const S: String): Pointer;
  5457. var V : Boolean;
  5458. begin
  5459. Result := Pointer(BaseStrToNativeUInt(S, 4, V));
  5460. end;
  5461. function InterfaceToStrA(const I: IInterface): AnsiString;
  5462. begin
  5463. Result := NativeUIntToBaseA(NativeUInt(I), BytesPerNativeWord * 2, 16, True);
  5464. end;
  5465. function InterfaceToStrW(const I: IInterface): WideString;
  5466. begin
  5467. Result := NativeUIntToBaseW(NativeUInt(I), BytesPerNativeWord * 2, 16, True);
  5468. end;
  5469. function InterfaceToStr(const I: IInterface): String;
  5470. begin
  5471. Result := NativeUIntToBase(NativeUInt(I), BytesPerNativeWord * 2, 16, True);
  5472. end;
  5473. {$ENDIF}
  5474. function ObjectClassName(const O: TObject): String;
  5475. begin
  5476. if not Assigned(O) then
  5477. Result := 'nil'
  5478. else
  5479. Result := O.ClassName;
  5480. end;
  5481. function ClassClassName(const C: TClass): String;
  5482. begin
  5483. if not Assigned(C) then
  5484. Result := 'nil'
  5485. else
  5486. Result := C.ClassName;
  5487. end;
  5488. function ObjectToStr(const O: TObject): String;
  5489. begin
  5490. if not Assigned(O) then
  5491. Result := 'nil'
  5492. else
  5493. Result := O.ClassName{$IFNDEF CLR} + '@' + LongWordToHex(LongWord(O), 8){$ENDIF};
  5494. end;
  5495. {$IFDEF ASM386_DELPHI}
  5496. function CharSetToStr(const C: CharSet): AnsiString; // Andrew N. Driazgov
  5497. asm
  5498. PUSH EBX
  5499. MOV ECX, $100
  5500. MOV EBX, EAX
  5501. PUSH ESI
  5502. MOV EAX, EDX
  5503. SUB ESP, ECX
  5504. XOR ESI, ESI
  5505. XOR EDX, EDX
  5506. @@lp: BT [EBX], EDX
  5507. JC @@mm
  5508. @@nx: INC EDX
  5509. DEC ECX
  5510. JNE @@lp
  5511. MOV ECX, ESI
  5512. MOV EDX, ESP
  5513. CALL System.@LStrFromPCharLen
  5514. ADD ESP, $100
  5515. POP ESI
  5516. POP EBX
  5517. RET
  5518. @@mm: MOV [ESP + ESI], DL
  5519. INC ESI
  5520. JMP @@nx
  5521. end;
  5522. {$ELSE}
  5523. function CharSetToStr(const C: CharSet): AnsiString;
  5524. // Implemented recursively to avoid multiple memory allocations
  5525. procedure CharMatch(const Start: AnsiChar; const Count: Integer);
  5526. var Ch : AnsiChar;
  5527. begin
  5528. for Ch := Start to #255 do
  5529. if Ch in C then
  5530. begin
  5531. if Ch = #255 then
  5532. SetLength(Result, Count + 1)
  5533. else
  5534. CharMatch(AnsiChar(Byte(Ch) + 1), Count + 1);
  5535. Result[Count + 1] := Ch;
  5536. exit;
  5537. end;
  5538. SetLength(Result, Count);
  5539. end;
  5540. begin
  5541. CharMatch(#0, 0);
  5542. end;
  5543. {$ENDIF}
  5544. {$IFDEF ASM386_DELPHI}
  5545. function StrToCharSet(const S: AnsiString): CharSet; // Andrew N. Driazgov
  5546. asm
  5547. XOR ECX, ECX
  5548. MOV [EDX], ECX
  5549. MOV [EDX + 4], ECX
  5550. MOV [EDX + 8], ECX
  5551. MOV [EDX + 12], ECX
  5552. MOV [EDX + 16], ECX
  5553. MOV [EDX + 20], ECX
  5554. MOV [EDX + 24], ECX
  5555. MOV [EDX + 28], ECX
  5556. TEST EAX, EAX
  5557. JE @@qt
  5558. MOV ECX, [EAX - 4]
  5559. PUSH EBX
  5560. SUB ECX, 8
  5561. JS @@nx
  5562. @@lp: MOVZX EBX, BYTE PTR [EAX]
  5563. BTS [EDX], EBX
  5564. MOVZX EBX, BYTE PTR [EAX + 1]
  5565. BTS [EDX], EBX
  5566. MOVZX EBX, BYTE PTR [EAX + 2]
  5567. BTS [EDX], EBX
  5568. MOVZX EBX, BYTE PTR [EAX + 3]
  5569. BTS [EDX], EBX
  5570. MOVZX EBX, BYTE PTR [EAX + 4]
  5571. BTS [EDX], EBX
  5572. MOVZX EBX, BYTE PTR [EAX + 5]
  5573. BTS [EDX], EBX
  5574. MOVZX EBX, BYTE PTR [EAX + 6]
  5575. BTS [EDX], EBX
  5576. MOVZX EBX, BYTE PTR [EAX + 7]
  5577. BTS [EDX], EBX
  5578. ADD EAX, 8
  5579. SUB ECX, 8
  5580. JNS @@lp
  5581. @@nx: JMP DWORD PTR @@tV[ECX * 4 + 32]
  5582. @@tV: DD @@ex, @@t1, @@t2, @@t3
  5583. DD @@t4, @@t5, @@t6, @@t7
  5584. @@t7: MOVZX EBX, BYTE PTR [EAX + 6]
  5585. BTS [EDX], EBX
  5586. @@t6: MOVZX EBX, BYTE PTR [EAX + 5]
  5587. BTS [EDX], EBX
  5588. @@t5: MOVZX EBX, BYTE PTR [EAX + 4]
  5589. BTS [EDX], EBX
  5590. @@t4: MOVZX EBX, BYTE PTR [EAX + 3]
  5591. BTS [EDX], EBX
  5592. @@t3: MOVZX EBX, BYTE PTR [EAX + 2]
  5593. BTS [EDX], EBX
  5594. @@t2: MOVZX EBX, BYTE PTR [EAX + 1]
  5595. BTS [EDX], EBX
  5596. @@t1: MOVZX EBX, BYTE PTR [EAX]
  5597. BTS [EDX], EBX
  5598. @@ex: POP EBX
  5599. @@qt:
  5600. end;
  5601. {$ELSE}
  5602. function StrToCharSet(const S: AnsiString): CharSet;
  5603. var I : Integer;
  5604. begin
  5605. ClearCharSet(Result);
  5606. for I := 1 to Length(S) do
  5607. Include(Result, S[I]);
  5608. end;
  5609. {$ENDIF}
  5610. { }
  5611. { Hash functions }
  5612. { Derived from a CRC32 algorithm. }
  5613. { }
  5614. var
  5615. HashTableInit : Boolean = False;
  5616. HashTable : array[Byte] of LongWord;
  5617. HashPoly : LongWord = $EDB88320;
  5618. procedure InitHashTable;
  5619. var I, J : Byte;
  5620. R : LongWord;
  5621. begin
  5622. for I := $00 to $FF do
  5623. begin
  5624. R := I;
  5625. for J := 8 downto 1 do
  5626. if R and 1 <> 0 then
  5627. R := (R shr 1) xor HashPoly
  5628. else
  5629. R := R shr 1;
  5630. HashTable[I] := R;
  5631. end;
  5632. HashTableInit := True;
  5633. end;
  5634. function HashByte(const Hash: LongWord; const C: Byte): LongWord; {$IFDEF UseInline}inline;{$ENDIF}
  5635. begin
  5636. Result := HashTable[Byte(Hash) xor C] xor (Hash shr 8);
  5637. end;
  5638. function HashCharA(const Hash: LongWord; const Ch: AnsiChar): LongWord; {$IFDEF UseInline}inline;{$ENDIF}
  5639. begin
  5640. Result := HashByte(Hash, Byte(Ch));
  5641. end;
  5642. function HashCharW(const Hash: LongWord; const Ch: WideChar): LongWord; {$IFDEF UseInline}inline;{$ENDIF}
  5643. var C1, C2 : Byte;
  5644. begin
  5645. C1 := Byte(Ord(Ch) and $FF);
  5646. C2 := Byte(Ord(Ch) shr 8);
  5647. Result := Hash;
  5648. Result := HashByte(Result, C1);
  5649. Result := HashByte(Result, C2);
  5650. end;
  5651. function HashChar(const Hash: LongWord; const Ch: Char): LongWord; {$IFDEF UseInline}inline;{$ENDIF}
  5652. begin
  5653. {$IFDEF CharIsWide}
  5654. Result := HashCharW(Hash, Ch);
  5655. {$ELSE}
  5656. Result := HashCharA(Hash, Ch);
  5657. {$ENDIF}
  5658. end;
  5659. function HashCharNoAsciiCaseA(const Hash: LongWord; const Ch: AnsiChar): LongWord; {$IFDEF UseInline}inline;{$ENDIF}
  5660. var C : Byte;
  5661. begin
  5662. C := Byte(Ch);
  5663. if C in [Ord('A')..Ord('Z')] then
  5664. C := C or 32;
  5665. Result := HashCharA(Hash, AnsiChar(C));
  5666. end;
  5667. function HashCharNoAsciiCaseW(const Hash: LongWord; const Ch: WideChar): LongWord; {$IFDEF UseInline}inline;{$ENDIF}
  5668. var C : Word;
  5669. begin
  5670. C := Word(Ch);
  5671. if C <= $FF then
  5672. if Byte(C) in [Ord('A')..Ord('Z')] then
  5673. C := C or 32;
  5674. Result := HashCharW(Hash, WideChar(C));
  5675. end;
  5676. function HashCharNoAsciiCase(const Hash: LongWord; const Ch: Char): LongWord; {$IFDEF UseInline}inline;{$ENDIF}
  5677. begin
  5678. {$IFDEF CharIsWide}
  5679. Result := HashCharNoAsciiCaseW(Hash, Ch);
  5680. {$ELSE}
  5681. Result := HashCharNoAsciiCaseA(Hash, Ch);
  5682. {$ENDIF}
  5683. end;
  5684. function HashBuf(const Hash: LongWord; const Buf; const BufSize: Integer): LongWord;
  5685. var P : PByte;
  5686. I : Integer;
  5687. begin
  5688. if not HashTableInit then
  5689. InitHashTable;
  5690. Result := Hash;
  5691. P := @Buf;
  5692. for I := 0 to BufSize - 1 do
  5693. begin
  5694. Result := HashByte(Result, P^);
  5695. Inc(P);
  5696. end;
  5697. end;
  5698. function HashStrA(const S: AnsiString;
  5699. const Index: Integer; const Count: Integer;
  5700. const AsciiCaseSensitive: Boolean;
  5701. const Slots: LongWord): LongWord;
  5702. var I, L, A, B : Integer;
  5703. begin
  5704. if not HashTableInit then
  5705. InitHashTable;
  5706. A := Index;
  5707. if A < 1 then
  5708. A := 1;
  5709. L := Length(S);
  5710. B := Count;
  5711. if B < 0 then
  5712. B := L
  5713. else
  5714. begin
  5715. B := A + B - 1;
  5716. if B > L then
  5717. B := L;
  5718. end;
  5719. Result := $FFFFFFFF;
  5720. if AsciiCaseSensitive then
  5721. for I := A to B do
  5722. Result := HashCharA(Result, S[I])
  5723. else
  5724. for I := A to B do
  5725. Result := HashCharNoAsciiCaseA(Result, S[I]);
  5726. if Slots > 0 then
  5727. Result := Result mod Slots;
  5728. end;
  5729. function HashStrW(const S: WideString;
  5730. const Index: Integer; const Count: Integer;
  5731. const AsciiCaseSensitive: Boolean;
  5732. const Slots: LongWord): LongWord;
  5733. var I, L, A, B : Integer;
  5734. begin
  5735. if not HashTableInit then
  5736. InitHashTable;
  5737. A := Index;
  5738. if A < 1 then
  5739. A := 1;
  5740. L := Length(S);
  5741. B := Count;
  5742. if B < 0 then
  5743. B := L
  5744. else
  5745. begin
  5746. B := A + B - 1;
  5747. if B > L then
  5748. B := L;
  5749. end;
  5750. Result := $FFFFFFFF;
  5751. if AsciiCaseSensitive then
  5752. for I := A to B do
  5753. Result := HashCharW(Result, S[I])
  5754. else
  5755. for I := A to B do
  5756. Result := HashCharNoAsciiCaseW(Result, S[I]);
  5757. if Slots > 0 then
  5758. Result := Result mod Slots;
  5759. end;
  5760. function HashStrU(const S: UnicodeString;
  5761. const Index: Integer; const Count: Integer;
  5762. const AsciiCaseSensitive: Boolean;
  5763. const Slots: LongWord): LongWord;
  5764. var I, L, A, B : Integer;
  5765. begin
  5766. if not HashTableInit then
  5767. InitHashTable;
  5768. A := Index;
  5769. if A < 1 then
  5770. A := 1;
  5771. L := Length(S);
  5772. B := Count;
  5773. if B < 0 then
  5774. B := L
  5775. else
  5776. begin
  5777. B := A + B - 1;
  5778. if B > L then
  5779. B := L;
  5780. end;
  5781. Result := $FFFFFFFF;
  5782. if AsciiCaseSensitive then
  5783. for I := A to B do
  5784. Result := HashCharW(Result, S[I])
  5785. else
  5786. for I := A to B do
  5787. Result := HashCharNoAsciiCaseW(Result, S[I]);
  5788. if Slots > 0 then
  5789. Result := Result mod Slots;
  5790. end;
  5791. function HashStr(const S: String;
  5792. const Index: Integer; const Count: Integer;
  5793. const AsciiCaseSensitive: Boolean;
  5794. const Slots: LongWord): LongWord;
  5795. var I, L, A, B : Integer;
  5796. begin
  5797. if not HashTableInit then
  5798. InitHashTable;
  5799. A := Index;
  5800. if A < 1 then
  5801. A := 1;
  5802. L := Length(S);
  5803. B := Count;
  5804. if B < 0 then
  5805. B := L
  5806. else
  5807. begin
  5808. B := A + B - 1;
  5809. if B > L then
  5810. B := L;
  5811. end;
  5812. Result := $FFFFFFFF;
  5813. if AsciiCaseSensitive then
  5814. for I := A to B do
  5815. Result := HashChar(Result, S[I])
  5816. else
  5817. for I := A to B do
  5818. Result := HashCharNoAsciiCase(Result, S[I]);
  5819. if Slots > 0 then
  5820. Result := Result mod Slots;
  5821. end;
  5822. { HashInteger based on the CRC32 algorithm. It is a very good all purpose hash }
  5823. { with a highly uniform distribution of results. }
  5824. {$IFDEF ManagedCode}
  5825. function HashInteger(const I: Integer; const Slots: LongWord): LongWord;
  5826. begin
  5827. if not HashTableInit then
  5828. InitHashTable;
  5829. Result := $FFFFFFFF;
  5830. Result := HashTable[Byte(Result) xor (I and $000000FF)] xor (Result shr 8);
  5831. Result := HashTable[Byte(Result) xor ((I and $0000FF00) shr 8)] xor (Result shr 8);
  5832. Result := HashTable[Byte(Result) xor ((I and $00FF0000) shr 16)] xor (Result shr 8);
  5833. Result := HashTable[Byte(Result) xor ((I and $FF000000) shr 24)] xor (Result shr 8);
  5834. if Slots <> 0 then
  5835. Result := Result mod Slots;
  5836. end;
  5837. {$ELSE}
  5838. function HashInteger(const I: Integer; const Slots: LongWord): LongWord;
  5839. var P : PByte;
  5840. begin
  5841. if not HashTableInit then
  5842. InitHashTable;
  5843. Result := $FFFFFFFF;
  5844. P := @I;
  5845. Result := HashTable[Byte(Result) xor P^] xor (Result shr 8);
  5846. Inc(P);
  5847. Result := HashTable[Byte(Result) xor P^] xor (Result shr 8);
  5848. Inc(P);
  5849. Result := HashTable[Byte(Result) xor P^] xor (Result shr 8);
  5850. Inc(P);
  5851. Result := HashTable[Byte(Result) xor P^] xor (Result shr 8);
  5852. if Slots <> 0 then
  5853. Result := Result mod Slots;
  5854. end;
  5855. {$ENDIF}
  5856. {$IFDEF ManagedCode}
  5857. function HashLongWord(const I: LongWord; const Slots: LongWord): LongWord;
  5858. begin
  5859. if not HashTableInit then
  5860. InitHashTable;
  5861. Result := $FFFFFFFF;
  5862. Result := HashTable[Byte(Result) xor (I and $000000FF)] xor (Result shr 8);
  5863. Result := HashTable[Byte(Result) xor ((I and $0000FF00) shr 8)] xor (Result shr 8);
  5864. Result := HashTable[Byte(Result) xor ((I and $00FF0000) shr 16)] xor (Result shr 8);
  5865. Result := HashTable[Byte(Result) xor ((I and $FF000000) shr 24)] xor (Result shr 8);
  5866. if Slots <> 0 then
  5867. Result := Result mod Slots;
  5868. end;
  5869. {$ELSE}
  5870. function HashLongWord(const I: LongWord; const Slots: LongWord): LongWord;
  5871. var P : PByte;
  5872. begin
  5873. if not HashTableInit then
  5874. InitHashTable;
  5875. Result := $FFFFFFFF;
  5876. P := @I;
  5877. Result := HashTable[Byte(Result) xor P^] xor (Result shr 8);
  5878. Inc(P);
  5879. Result := HashTable[Byte(Result) xor P^] xor (Result shr 8);
  5880. Inc(P);
  5881. Result := HashTable[Byte(Result) xor P^] xor (Result shr 8);
  5882. Inc(P);
  5883. Result := HashTable[Byte(Result) xor P^] xor (Result shr 8);
  5884. if Slots <> 0 then
  5885. Result := Result mod Slots;
  5886. end;
  5887. {$ENDIF}
  5888. {$IFNDEF ManagedCode}
  5889. { }
  5890. { Memory }
  5891. { }
  5892. {$IFDEF UseAsmMemFunction}
  5893. procedure FillMem(var Buf; const Count: Integer; const Value: Byte);
  5894. asm
  5895. // EAX = Buf, EDX = Count, CL = Value
  5896. OR EDX, EDX
  5897. JLE @Fin
  5898. // Set 4 bytes of ECX to Value byte
  5899. MOV CH, CL
  5900. SHL ECX, 8
  5901. MOV CL, CH
  5902. SHL ECX, 8
  5903. MOV CL, CH
  5904. CMP EDX, 16
  5905. JBE @SmallFillMem
  5906. // General purpose FillMem
  5907. @GeneralFillMem:
  5908. PUSH EDI
  5909. MOV EDI, EAX
  5910. MOV EAX, ECX
  5911. MOV ECX, EDX
  5912. SHR ECX, 2
  5913. REP STOSD
  5914. AND EDX, 3
  5915. MOV ECX, EDX
  5916. REP STOSB
  5917. POP EDI
  5918. RET
  5919. // FillMem for small blocks
  5920. @SmallFillMem:
  5921. JMP DWORD PTR @JumpTable[EDX * 4]
  5922. @JumpTable:
  5923. DD @Fill0, @Fill1, @Fill2, @Fill3
  5924. DD @Fill4, @Fill5, @Fill6, @Fill7
  5925. DD @Fill8, @Fill9, @Fill10, @Fill11
  5926. DD @Fill12, @Fill13, @Fill14, @Fill15
  5927. DD @Fill16
  5928. @Fill16:
  5929. MOV DWORD PTR [EAX], ECX
  5930. MOV DWORD PTR [EAX + 4], ECX
  5931. MOV DWORD PTR [EAX + 8], ECX
  5932. MOV DWORD PTR [EAX + 12], ECX
  5933. RET
  5934. @Fill15:
  5935. MOV BYTE PTR [EAX + 14], CL
  5936. @Fill14:
  5937. MOV DWORD PTR [EAX], ECX
  5938. MOV DWORD PTR [EAX + 4], ECX
  5939. MOV DWORD PTR [EAX + 8], ECX
  5940. MOV WORD PTR [EAX + 12], CX
  5941. RET
  5942. @Fill13:
  5943. MOV BYTE PTR [EAX + 12], CL
  5944. @Fill12:
  5945. MOV DWORD PTR [EAX], ECX
  5946. MOV DWORD PTR [EAX + 4], ECX
  5947. MOV DWORD PTR [EAX + 8], ECX
  5948. RET
  5949. @Fill11:
  5950. MOV BYTE PTR [EAX + 10], CL
  5951. @Fill10:
  5952. MOV DWORD PTR [EAX], ECX
  5953. MOV DWORD PTR [EAX + 4], ECX
  5954. MOV WORD PTR [EAX + 8], CX
  5955. RET
  5956. @Fill9:
  5957. MOV BYTE PTR [EAX + 8], CL
  5958. @Fill8:
  5959. MOV DWORD PTR [EAX], ECX
  5960. MOV DWORD PTR [EAX + 4], ECX
  5961. RET
  5962. @Fill7:
  5963. MOV BYTE PTR [EAX + 6], CL
  5964. @Fill6:
  5965. MOV DWORD PTR [EAX], ECX
  5966. MOV WORD PTR [EAX + 4], CX
  5967. RET
  5968. @Fill5:
  5969. MOV BYTE PTR [EAX + 4], CL
  5970. @Fill4:
  5971. MOV DWORD PTR [EAX], ECX
  5972. RET
  5973. @Fill3:
  5974. MOV BYTE PTR [EAX + 2], CL
  5975. @Fill2:
  5976. MOV WORD PTR [EAX], CX
  5977. RET
  5978. @Fill1:
  5979. MOV BYTE PTR [EAX], CL
  5980. @Fill0:
  5981. @Fin:
  5982. end;
  5983. {$ELSE}
  5984. procedure FillMem(var Buf; const Count: Integer; const Value: Byte);
  5985. begin
  5986. FillChar(Buf, Count, Value);
  5987. end;
  5988. {$ENDIF}
  5989. {$IFDEF UseAsmMemFunction}
  5990. procedure ZeroMem(var Buf; const Count: Integer);
  5991. asm
  5992. // EAX = Buf, EDX = Count
  5993. OR EDX, EDX
  5994. JLE @Zero0
  5995. CMP EDX, 16
  5996. JA @GeneralZeroMem
  5997. XOR ECX, ECX
  5998. JMP DWORD PTR @SmallZeroJumpTable[EDX * 4]
  5999. @SmallZeroJumpTable:
  6000. DD @Zero0, @Zero1, @Zero2, @Zero3
  6001. DD @Zero4, @Zero5, @Zero6, @Zero7
  6002. DD @Zero8, @Zero9, @Zero10, @Zero11
  6003. DD @Zero12, @Zero13, @Zero14, @Zero15
  6004. DD @Zero16
  6005. @Zero16:
  6006. MOV DWORD PTR [EAX], ECX
  6007. MOV DWORD PTR [EAX + 4], ECX
  6008. MOV DWORD PTR [EAX + 8], ECX
  6009. MOV DWORD PTR [EAX + 12], ECX
  6010. RET
  6011. @Zero15:
  6012. MOV BYTE PTR [EAX + 14], CL
  6013. @Zero14:
  6014. MOV DWORD PTR [EAX], ECX
  6015. MOV DWORD PTR [EAX + 4], ECX
  6016. MOV DWORD PTR [EAX + 8], ECX
  6017. MOV WORD PTR [EAX + 12], CX
  6018. RET
  6019. @Zero13:
  6020. MOV BYTE PTR [EAX + 12], CL
  6021. @Zero12:
  6022. MOV DWORD PTR [EAX], ECX
  6023. MOV DWORD PTR [EAX + 4], ECX
  6024. MOV DWORD PTR [EAX + 8], ECX
  6025. RET
  6026. @Zero11:
  6027. MOV BYTE PTR [EAX + 10], CL
  6028. @Zero10:
  6029. MOV DWORD PTR [EAX], ECX
  6030. MOV DWORD PTR [EAX + 4], ECX
  6031. MOV WORD PTR [EAX + 8], CX
  6032. RET
  6033. @Zero9:
  6034. MOV BYTE PTR [EAX + 8], CL
  6035. @Zero8:
  6036. MOV DWORD PTR [EAX], ECX
  6037. MOV DWORD PTR [EAX + 4], ECX
  6038. RET
  6039. @Zero7:
  6040. MOV BYTE PTR [EAX + 6], CL
  6041. @Zero6:
  6042. MOV DWORD PTR [EAX], ECX
  6043. MOV WORD PTR [EAX + 4], CX
  6044. RET
  6045. @Zero5:
  6046. MOV BYTE PTR [EAX + 4], CL
  6047. @Zero4:
  6048. MOV DWORD PTR [EAX], ECX
  6049. RET
  6050. @Zero3:
  6051. MOV BYTE PTR [EAX + 2], CL
  6052. @Zero2:
  6053. MOV WORD PTR [EAX], CX
  6054. RET
  6055. @Zero1:
  6056. MOV BYTE PTR [EAX], CL
  6057. @Zero0:
  6058. RET
  6059. @GeneralZeroMem:
  6060. PUSH EDI
  6061. MOV EDI, EAX
  6062. XOR EAX, EAX
  6063. MOV ECX, EDX
  6064. SHR ECX, 2
  6065. REP STOSD
  6066. MOV ECX, EDX
  6067. AND ECX, 3
  6068. REP STOSB
  6069. POP EDI
  6070. end;
  6071. {$ELSE}
  6072. procedure ZeroMem(var Buf; const Count: Integer);
  6073. begin
  6074. FillChar(Buf, Count, #0);
  6075. end;
  6076. {$ENDIF}
  6077. procedure GetZeroMem(var P: Pointer; const Size: Integer);
  6078. begin
  6079. GetMem(P, Size);
  6080. ZeroMem(P^, Size);
  6081. end;
  6082. {$IFDEF UseAsmMemFunction}
  6083. { Note: MoveMem implements a "safe move", that is, the Source and Dest memory }
  6084. { blocks are allowed to overlap. }
  6085. procedure MoveMem(const Source; var Dest; const Count: Integer);
  6086. asm
  6087. // EAX = Source, EDX = Dest, ECX = Count
  6088. OR ECX, ECX
  6089. JLE @Move0
  6090. CMP EAX, EDX
  6091. JE @Move0
  6092. JB @CheckSafe
  6093. @GeneralMove:
  6094. CMP ECX, 16
  6095. JA @LargeMove
  6096. JMP DWORD PTR @SmallMoveJumpTable[ECX * 4]
  6097. @CheckSafe:
  6098. ADD EAX, ECX
  6099. CMP EAX, EDX
  6100. JBE @IsSafe
  6101. @NotSafe:
  6102. SUB EAX, ECX
  6103. CMP ECX, 10
  6104. JA @LargeMoveReverse
  6105. JMP DWORD PTR @SmallMoveJumpTable[ECX * 4]
  6106. @IsSafe:
  6107. SUB EAX, ECX
  6108. CMP ECX, 16
  6109. JA @LargeMove
  6110. JMP DWORD PTR @SmallMoveJumpTable[ECX * 4]
  6111. @SmallMoveJumpTable:
  6112. DD @Move0, @Move1, @Move2, @Move3
  6113. DD @Move4, @Move5, @Move6, @Move7
  6114. DD @Move8, @Move9, @Move10, @Move11
  6115. DD @Move12, @Move13, @Move14, @Move15
  6116. DD @Move16
  6117. @Move16:
  6118. PUSH EBX
  6119. MOV ECX, [EAX]
  6120. MOV EBX, [EAX + 4]
  6121. MOV [EDX], ECX
  6122. MOV [EDX + 4], EBX
  6123. MOV ECX, [EAX + 8]
  6124. MOV EBX, [EAX + 12]
  6125. MOV [EDX + 8], ECX
  6126. MOV [EDX + 12], EBX
  6127. POP EBX
  6128. RET
  6129. @Move15:
  6130. PUSH EBX
  6131. MOV ECX, [EAX]
  6132. MOV EBX, [EAX + 4]
  6133. MOV [EDX], ECX
  6134. MOV [EDX + 4], EBX
  6135. MOV ECX, [EAX + 8]
  6136. MOV BX, [EAX + 12]
  6137. MOV AL, [EAX + 14]
  6138. MOV [EDX + 8], ECX
  6139. MOV [EDX + 12], BX
  6140. MOV [EDX + 14], AL
  6141. POP EBX
  6142. RET
  6143. @Move14:
  6144. PUSH EBX
  6145. MOV ECX, [EAX]
  6146. MOV EBX, [EAX + 4]
  6147. MOV [EDX], ECX
  6148. MOV [EDX + 4], EBX
  6149. MOV ECX, [EAX + 8]
  6150. MOV BX, [EAX + 12]
  6151. MOV [EDX + 8], ECX
  6152. MOV [EDX + 12], BX
  6153. POP EBX
  6154. RET
  6155. @Move13:
  6156. PUSH EBX
  6157. MOV ECX, [EAX]
  6158. MOV EBX, [EAX + 4]
  6159. MOV [EDX], ECX
  6160. MOV [EDX + 4], EBX
  6161. MOV ECX, [EAX + 8]
  6162. MOV BL, [EAX + 12]
  6163. MOV [EDX + 8], ECX
  6164. MOV [EDX + 12], BL
  6165. POP EBX
  6166. RET
  6167. @Move12:
  6168. PUSH EBX
  6169. MOV ECX, [EAX]
  6170. MOV EBX, [EAX + 4]
  6171. MOV EAX, [EAX + 8]
  6172. MOV [EDX], ECX
  6173. MOV [EDX + 4], EBX
  6174. MOV [EDX + 8], EAX
  6175. POP EBX
  6176. RET
  6177. @Move11:
  6178. PUSH EBX
  6179. MOV ECX, [EAX]
  6180. MOV EBX, [EAX + 4]
  6181. MOV [EDX], ECX
  6182. MOV [EDX + 4], EBX
  6183. MOV CX, [EAX + 8]
  6184. MOV BL, [EAX + 10]
  6185. MOV [EDX + 8], CX
  6186. MOV [EDX + 10], BL
  6187. POP EBX
  6188. RET
  6189. @Move10:
  6190. PUSH EBX
  6191. MOV ECX, [EAX]
  6192. MOV EBX, [EAX + 4]
  6193. MOV AX, [EAX + 8]
  6194. MOV [EDX], ECX
  6195. MOV [EDX + 4], EBX
  6196. MOV [EDX + 8], AX
  6197. POP EBX
  6198. RET
  6199. @Move9:
  6200. PUSH EBX
  6201. MOV ECX, [EAX]
  6202. MOV EBX, [EAX + 4]
  6203. MOV AL, [EAX + 8]
  6204. MOV [EDX], ECX
  6205. MOV [EDX + 4], EBX
  6206. MOV [EDX + 8], AL
  6207. POP EBX
  6208. RET
  6209. @Move8:
  6210. MOV ECX, [EAX]
  6211. MOV EAX, [EAX + 4]
  6212. MOV [EDX], ECX
  6213. MOV [EDX + 4], EAX
  6214. RET
  6215. @Move7:
  6216. PUSH EBX
  6217. MOV ECX, [EAX]
  6218. MOV BX, [EAX + 4]
  6219. MOV AL, [EAX + 6]
  6220. MOV [EDX], ECX
  6221. MOV [EDX + 4], BX
  6222. MOV [EDX + 6], AL
  6223. POP EBX
  6224. RET
  6225. @Move6:
  6226. MOV ECX, [EAX]
  6227. MOV AX, [EAX + 4]
  6228. MOV [EDX], ECX
  6229. MOV [EDX + 4], AX
  6230. RET
  6231. @Move5:
  6232. MOV ECX, [EAX]
  6233. MOV AL, [EAX + 4]
  6234. MOV [EDX], ECX
  6235. MOV [EDX + 4], AL
  6236. RET
  6237. @Move4:
  6238. MOV ECX, [EAX]
  6239. MOV [EDX], ECX
  6240. RET
  6241. @Move3:
  6242. MOV CX, [EAX]
  6243. MOV AL, [EAX + 2]
  6244. MOV [EDX], CX
  6245. MOV [EDX + 2], AL
  6246. RET
  6247. @Move2:
  6248. MOV CX, [EAX]
  6249. MOV [EDX], CX
  6250. RET
  6251. @Move1:
  6252. MOV CL, [EAX]
  6253. MOV [EDX], CL
  6254. @Move0:
  6255. RET
  6256. @LargeMove:
  6257. PUSH ESI
  6258. PUSH EDI
  6259. MOV ESI, EAX
  6260. MOV EDI, EDX
  6261. MOV EDX, ECX
  6262. SHR ECX, 2
  6263. REP MOVSD
  6264. MOV ECX, EDX
  6265. AND ECX, 3
  6266. REP MOVSB
  6267. POP EDI
  6268. POP ESI
  6269. RET
  6270. @LargeMoveReverse:
  6271. PUSH ESI
  6272. PUSH EDI
  6273. MOV ESI, EAX
  6274. MOV EDI, EDX
  6275. LEA ESI, [ESI + ECX - 4]
  6276. LEA EDI, [EDI + ECX - 4]
  6277. MOV EDX, ECX
  6278. SHR ECX, 2
  6279. STD
  6280. REP MOVSD
  6281. ADD ESI, 3
  6282. ADD EDI, 3
  6283. MOV ECX, EDX
  6284. AND ECX, 3
  6285. REP MOVSB
  6286. CLD
  6287. POP EDI
  6288. POP ESI
  6289. end;
  6290. {$ELSE}
  6291. procedure MoveMem(const Source; var Dest; const Count: Integer);
  6292. begin
  6293. Move(Source, Dest, Count);
  6294. end;
  6295. {$ENDIF}
  6296. {$IFDEF ASM386_DELPHI}
  6297. function CompareMem(const Buf1; const Buf2; const Count: Integer): Boolean;
  6298. asm
  6299. // EAX = Buf1, EDX = Buf2, ECX = Count
  6300. OR ECX, ECX
  6301. JLE @Fin1
  6302. CMP EAX, EDX
  6303. JE @Fin1
  6304. PUSH ESI
  6305. PUSH EDI
  6306. MOV ESI, EAX
  6307. MOV EDI, EDX
  6308. MOV EDX, ECX
  6309. SHR ECX, 2
  6310. XOR EAX, EAX
  6311. REPE CMPSD
  6312. JNE @Fin0
  6313. MOV ECX, EDX
  6314. AND ECX, 3
  6315. REPE CMPSB
  6316. JNE @Fin0
  6317. INC EAX
  6318. @Fin0:
  6319. POP EDI
  6320. POP ESI
  6321. RET
  6322. @Fin1:
  6323. MOV AL, 1
  6324. end;
  6325. {$ELSE}
  6326. function CompareMem(const Buf1; const Buf2; const Count: Integer): Boolean;
  6327. var P, Q : Pointer;
  6328. D, I : Integer;
  6329. begin
  6330. P := @Buf1;
  6331. Q := @Buf2;
  6332. if (Count <= 0) or (P = Q) then
  6333. begin
  6334. Result := True;
  6335. exit;
  6336. end;
  6337. D := LongWord(Count) div 4;
  6338. for I := 1 to D do
  6339. if PLongWord(P)^ = PLongWord(Q)^ then
  6340. begin
  6341. Inc(PLongWord(P));
  6342. Inc(PLongWord(Q));
  6343. end
  6344. else
  6345. begin
  6346. Result := False;
  6347. exit;
  6348. end;
  6349. D := LongWord(Count) and 3;
  6350. for I := 1 to D do
  6351. if PByte(P)^ = PByte(Q)^ then
  6352. begin
  6353. Inc(PByte(P));
  6354. Inc(PByte(Q));
  6355. end
  6356. else
  6357. begin
  6358. Result := False;
  6359. exit;
  6360. end;
  6361. Result := True;
  6362. end;
  6363. {$ENDIF}
  6364. function CompareMemNoCase(const Buf1; const Buf2; const Count: Integer): TCompareResult;
  6365. var P, Q : Pointer;
  6366. I : Integer;
  6367. C, D : Byte;
  6368. begin
  6369. if Count <= 0 then
  6370. begin
  6371. Result := crEqual;
  6372. exit;
  6373. end;
  6374. P := @Buf1;
  6375. Q := @Buf2;
  6376. for I := 1 to Count do
  6377. begin
  6378. C := PByte(P)^;
  6379. D := PByte(Q)^;
  6380. if C in [Ord('A')..Ord('Z')] then
  6381. C := C or 32;
  6382. if D in [Ord('A')..Ord('Z')] then
  6383. D := D or 32;
  6384. if C = D then
  6385. begin
  6386. Inc(PByte(P));
  6387. Inc(PByte(Q));
  6388. end
  6389. else
  6390. begin
  6391. if C < D then
  6392. Result := crLess
  6393. else
  6394. Result := crGreater;
  6395. exit;
  6396. end;
  6397. end;
  6398. Result := crEqual;
  6399. end;
  6400. function LocateMem(const Buf1; const Size1: Integer; const Buf2; const Size2: Integer): Integer;
  6401. var P, Q : PByte;
  6402. I : Integer;
  6403. begin
  6404. if (Size1 <= 0) or (Size2 <= 0) or (Size2 > Size1) then
  6405. begin
  6406. Result := -1;
  6407. exit;
  6408. end;
  6409. for I := 0 to Size1 - Size2 do
  6410. begin
  6411. P := @Buf1;
  6412. Inc(P, I);
  6413. Q := @Buf2;
  6414. if P = Q then
  6415. begin
  6416. Result := I;
  6417. exit;
  6418. end;
  6419. if CompareMem(P^, Q^, Size2) then
  6420. begin
  6421. Result := I;
  6422. exit;
  6423. end;
  6424. end;
  6425. Result := -1;
  6426. end;
  6427. procedure ReverseMem(var Buf; const Size: Integer);
  6428. var I : Integer;
  6429. P : PByte;
  6430. Q : PByte;
  6431. T : Byte;
  6432. begin
  6433. P := @Buf;
  6434. Q := P;
  6435. Inc(Q, Size - 1);
  6436. for I := 1 to Size div 2 do
  6437. begin
  6438. T := P^;
  6439. P^ := Q^;
  6440. Q^ := T;
  6441. Inc(P);
  6442. Dec(Q);
  6443. end;
  6444. end;
  6445. {$ENDIF}
  6446. { }
  6447. { FreeAndNil }
  6448. { }
  6449. {$IFDEF ManagedCode}
  6450. procedure FreeAndNil(var Obj: TObject);
  6451. var Temp : TObject;
  6452. begin
  6453. Temp := Obj;
  6454. Obj := nil;
  6455. Temp.Free;
  6456. end;
  6457. {$ELSE}
  6458. procedure FreeAndNil(var Obj);
  6459. var Temp : TObject;
  6460. begin
  6461. Temp := TObject(Obj);
  6462. Pointer(Obj) := nil;
  6463. Temp.Free;
  6464. end;
  6465. {$ENDIF}
  6466. {$IFDEF ManagedCode}
  6467. procedure FreeObjectArray(var V: ObjectArray);
  6468. var I : Integer;
  6469. begin
  6470. for I := Length(V) - 1 downto 0 do
  6471. FreeAndNil(V[I]);
  6472. end;
  6473. procedure FreeObjectArray(var V: ObjectArray; const LoIdx, HiIdx: Integer);
  6474. var I : Integer;
  6475. begin
  6476. for I := HiIdx downto LoIdx do
  6477. FreeAndNil(V[I]);
  6478. end;
  6479. {$ELSE}
  6480. procedure FreeObjectArray(var V);
  6481. var I : Integer;
  6482. A : ObjectArray absolute V;
  6483. begin
  6484. for I := Length(A) - 1 downto 0 do
  6485. FreeAndNil(A[I]);
  6486. end;
  6487. procedure FreeObjectArray(var V; const LoIdx, HiIdx: Integer);
  6488. var I : Integer;
  6489. A : ObjectArray absolute V;
  6490. begin
  6491. for I := HiIdx downto LoIdx do
  6492. FreeAndNil(A[I]);
  6493. end;
  6494. {$ENDIF}
  6495. // Note: The parameter can not be changed to be untyped and then typecasted
  6496. // using an absolute variable, as in FreeObjectArray. The reference counting
  6497. // will be done incorrectly.
  6498. procedure FreeAndNilObjectArray(var V: ObjectArray);
  6499. var W : ObjectArray;
  6500. begin
  6501. W := V;
  6502. V := nil;
  6503. FreeObjectArray(W);
  6504. end;
  6505. {$IFNDEF CLR}
  6506. { }
  6507. { Generic quick sort algorithm }
  6508. { }
  6509. procedure GenericQuickSort(const Data: Pointer; const Count: Integer;
  6510. const CompareFunc: TQuickSortCompareFunction;
  6511. const SwapFunc: TQuickSortSwapFunction);
  6512. procedure QuickSort(L, R: Integer);
  6513. var I, J, M : Integer;
  6514. begin
  6515. repeat
  6516. I := L;
  6517. J := R;
  6518. M := (L + R) shr 1;
  6519. repeat
  6520. while CompareFunc(Data, I, M) = crLess do
  6521. Inc(I);
  6522. while CompareFunc(Data, J, M) = crGreater do
  6523. Dec(J);
  6524. if I <= J then
  6525. begin
  6526. SwapFunc(Data, I, J);
  6527. if M = I then
  6528. M := J
  6529. else
  6530. if M = J then
  6531. M := I;
  6532. Inc(I);
  6533. Dec(J);
  6534. end;
  6535. until I > J;
  6536. if L < J then
  6537. QuickSort(L, J);
  6538. L := I;
  6539. until I >= R;
  6540. end;
  6541. begin
  6542. if Count > 0 then
  6543. QuickSort(0, Count - 1);
  6544. end;
  6545. { }
  6546. { Generic binary search algorithm }
  6547. { }
  6548. function GenericBinarySearch(const Data: Pointer; const Count: Integer;
  6549. const Item: Pointer;
  6550. const CompareFunc: TBinarySearchCompareFunction): Integer;
  6551. var L, H, I : Integer;
  6552. begin
  6553. L := 0;
  6554. H := Count - 1;
  6555. while L <= H do
  6556. begin
  6557. I := (L + H) div 2;
  6558. case CompareFunc(Data, I, Item) of
  6559. crEqual :
  6560. begin
  6561. while (I > 0) and (CompareFunc(Data, I - 1, Item) = crEqual) do
  6562. Dec(I);
  6563. Result := I;
  6564. exit;
  6565. end;
  6566. crGreater : H := I - 1;
  6567. crLess : L := I + 1;
  6568. end;
  6569. end;
  6570. Result := -1;
  6571. end;
  6572. {$ENDIF}
  6573. { }
  6574. { Test cases }
  6575. { }
  6576. {$IFDEF UTILS_SELFTEST}
  6577. {$ASSERTIONS ON}
  6578. procedure Test_Misc;
  6579. var L, H : Cardinal;
  6580. A, B : Byte;
  6581. C, D : LongWord;
  6582. P, Q : TObject;
  6583. begin
  6584. // Integer types
  6585. {$IFNDEF ManagedCode}
  6586. Assert(Sizeof(SmallIntRec) = Sizeof(SmallInt), 'SmallIntRec');
  6587. Assert(Sizeof(LongIntRec) = Sizeof(LongInt), 'LongIntRec');
  6588. {$ENDIF}
  6589. // Min / Max
  6590. Assert(MinI(-1, 1) = -1, 'MinI');
  6591. Assert(MaxI(-1, 1) = 1, 'MaxI');
  6592. Assert(MinC(1, 2) = 1, 'MinC');
  6593. Assert(MaxC(1, 2) = 2, 'MaxC');
  6594. Assert(MaxC($FFFFFFFF, 0) = $FFFFFFFF, 'MaxC');
  6595. Assert(MinC($FFFFFFFF, 0) = 0, 'MinC');
  6596. Assert(MinF(-1.0, 1.0) = -1.0, 'MinF');
  6597. Assert(MaxF(-1.0, 1.0) = 1.0, 'MaxF');
  6598. // Clip
  6599. Assert(Clip(10, 5, 12) = 10, 'Clip');
  6600. Assert(Clip(3, 5, 12) = 5, 'Clip');
  6601. Assert(Clip(15, 5, 12) = 12, 'Clip');
  6602. Assert(ClipByte(256) = 255, 'ClipByte');
  6603. Assert(ClipWord(-5) = 0, 'ClipWord');
  6604. Assert(ClipLongWord($100000000) = $FFFFFFFF, 'ClipWord');
  6605. Assert(SumClipI(1, 2) = 3, 'SumClipI');
  6606. Assert(SumClipI(1, -2) = -1, 'SumClipI');
  6607. Assert(SumClipI(MaxInteger - 1, 0) = MaxInteger - 1, 'SumClipI');
  6608. Assert(SumClipI(MaxInteger - 1, 1) = MaxInteger, 'SumClipI');
  6609. Assert(SumClipI(MaxInteger - 1, 2) = MaxInteger, 'SumClipI');
  6610. Assert(SumClipI(MinInteger + 1, 0) = MinInteger + 1, 'SumClipI');
  6611. Assert(SumClipI(MinInteger + 1, -1) = MinInteger, 'SumClipI');
  6612. Assert(SumClipI(MinInteger + 1, -2) = MinInteger, 'SumClipI');
  6613. Assert(SumClipC(1, 2) = 3, 'SumClipC');
  6614. Assert(SumClipC(3, -2) = 1, 'SumClipC');
  6615. Assert(SumClipC(MaxCardinal - 1, 0) = MaxCardinal - 1, 'SumClipC');
  6616. Assert(SumClipC(MaxCardinal - 1, 1) = MaxCardinal, 'SumClipC');
  6617. Assert(SumClipC(MaxCardinal - 1, 2) = MaxCardinal, 'SumClipC');
  6618. Assert(SumClipC(1, 0) = 1, 'SumClipC');
  6619. Assert(SumClipC(1, -1) = 0, 'SumClipC');
  6620. Assert(SumClipC(1, -2) = 0, 'SumClipC');
  6621. Assert(not InByteRange(-1), 'InByteRange');
  6622. Assert(not InByteRange(256), 'InByteRange');
  6623. Assert(InByteRange(255), 'InByteRange');
  6624. Assert(InWordRange($FFFF), 'InWordRange');
  6625. Assert(not InWordRange($10000), 'InWordRange');
  6626. Assert(InShortIntRange(-1), 'InShortIntRange');
  6627. // Swap
  6628. A := $11; B := $22;
  6629. Swap(A, B);
  6630. Assert((A = $22) and (B = $11), 'Swap');
  6631. C := $11111111; D := $22222222;
  6632. Swap(C, D);
  6633. Assert((C = $22222222) and (D = $11111111), 'Swap');
  6634. P := TObject.Create;
  6635. Q := nil;
  6636. SwapObjects(P, Q);
  6637. Assert(Assigned(Q) and not Assigned(P), 'SwapObjects');
  6638. Q.Free;
  6639. // Ranges
  6640. L := 10;
  6641. H := 20;
  6642. Assert(CardRangeIncludeElementRange(L, H, 10, 20), 'RangeInclude');
  6643. Assert((L = 10) and (H = 20), 'RangeInclude');
  6644. Assert(CardRangeIncludeElementRange(L, H, 9, 21), 'RangeInclude');
  6645. Assert((L = 9) and (H = 21), 'RangeInclude');
  6646. Assert(CardRangeIncludeElementRange(L, H, 7, 10), 'RangeInclude');
  6647. Assert((L = 7) and (H = 21), 'RangeInclude');
  6648. Assert(CardRangeIncludeElementRange(L, H, 5, 6), 'RangeInclude');
  6649. Assert((L = 5) and (H = 21), 'RangeInclude');
  6650. Assert(not CardRangeIncludeElementRange(L, H, 1, 3), 'RangeInclude');
  6651. Assert((L = 5) and (H = 21), 'RangeInclude');
  6652. Assert(CardRangeIncludeElementRange(L, H, 20, 22), 'RangeInclude');
  6653. Assert((L = 5) and (H = 22), 'RangeInclude');
  6654. Assert(CardRangeIncludeElementRange(L, H, 23, 24), 'RangeInclude');
  6655. Assert((L = 5) and (H = 24), 'RangeInclude');
  6656. Assert(not CardRangeIncludeElementRange(L, H, 26, 27), 'RangeInclude');
  6657. Assert((L = 5) and (H = 24), 'RangeInclude');
  6658. // iif
  6659. Assert(iif(True, 1, 2) = 1, 'iif');
  6660. Assert(iif(False, 1, 2) = 2, 'iif');
  6661. Assert(iif(True, -1, -2) = -1, 'iif');
  6662. Assert(iif(False, -1, -2) = -2, 'iif');
  6663. Assert(iif(True, '1', '2') = '1', 'iif');
  6664. Assert(iif(False, '1', '2') = '2', 'iif');
  6665. Assert(iifW(True, '1', '2') = '1', 'iif');
  6666. Assert(iifW(False, '1', '2') = '2', 'iif');
  6667. Assert(iifU(True, '1', '2') = '1', 'iif');
  6668. Assert(iifU(False, '1', '2') = '2', 'iif');
  6669. Assert(iif(True, 1.1, 2.2) = 1.1, 'iif');
  6670. Assert(iif(False, 1.1, 2.2) = 2.2, 'iif');
  6671. // CharSet
  6672. Assert(CharCount([]) = 0, 'CharCount');
  6673. Assert(CharCount(['a'..'z']) = 26, 'CharCount');
  6674. Assert(CharCount([#0, #255]) = 2, 'CharCount');
  6675. // Compare
  6676. Assert(Compare(1, 1) = crEqual, 'Compare');
  6677. Assert(Compare(1, 2) = crLess, 'Compare');
  6678. Assert(Compare(1, 0) = crGreater, 'Compare');
  6679. Assert(Compare(1.0, 1.0) = crEqual, 'Compare');
  6680. Assert(Compare(1.0, 1.1) = crLess, 'Compare');
  6681. Assert(Compare(1.0, 0.9) = crGreater, 'Compare');
  6682. Assert(Compare(False, False) = crEqual, 'Compare');
  6683. Assert(Compare(True, True) = crEqual, 'Compare');
  6684. Assert(Compare(False, True) = crLess, 'Compare');
  6685. Assert(Compare(True, False) = crGreater, 'Compare');
  6686. Assert(CompareA('', '') = crEqual, 'Compare');
  6687. Assert(CompareA('a', 'a') = crEqual, 'Compare');
  6688. Assert(CompareA('a', 'b') = crLess, 'Compare');
  6689. Assert(CompareA('b', 'a') = crGreater, 'Compare');
  6690. Assert(CompareA('', 'a') = crLess, 'Compare');
  6691. Assert(CompareA('a', '') = crGreater, 'Compare');
  6692. Assert(CompareA('aa', 'a') = crGreater, 'Compare');
  6693. Assert(CompareW('', '') = crEqual, 'Compare');
  6694. Assert(CompareW('a', 'a') = crEqual, 'Compare');
  6695. Assert(CompareW('a', 'b') = crLess, 'Compare');
  6696. Assert(CompareW('b', 'a') = crGreater, 'Compare');
  6697. Assert(CompareW('', 'a') = crLess, 'Compare');
  6698. Assert(CompareW('a', '') = crGreater, 'Compare');
  6699. Assert(CompareW('aa', 'a') = crGreater, 'Compare');
  6700. Assert(Sgn(1) = 1, 'Sign');
  6701. Assert(Sgn(0) = 0, 'Sign');
  6702. Assert(Sgn(-1) = -1, 'Sign');
  6703. Assert(Sgn(2) = 1, 'Sign');
  6704. Assert(Sgn(-2) = -1, 'Sign');
  6705. Assert(Sgn(-1.5) = -1, 'Sign');
  6706. Assert(Sgn(1.5) = 1, 'Sign');
  6707. Assert(Sgn(0.0) = 0, 'Sign');
  6708. Assert(ReverseCompareResult(crLess) = crGreater, 'ReverseCompareResult');
  6709. Assert(ReverseCompareResult(crGreater) = crLess, 'ReverseCompareResult');
  6710. end;
  6711. procedure Test_BitFunctions;
  6712. begin
  6713. Assert(SetBit($100F, 5) = $102F, 'SetBit');
  6714. Assert(ClearBit($102F, 5) = $100F, 'ClearBit');
  6715. Assert(ToggleBit($102F, 5) = $100F, 'ToggleBit');
  6716. Assert(ToggleBit($100F, 5) = $102F, 'ToggleBit');
  6717. Assert(IsBitSet($102F, 5), 'IsBitSet');
  6718. Assert(not IsBitSet($100F, 5), 'IsBitSet');
  6719. Assert(IsHighBitSet($80000000), 'IsHighBitSet');
  6720. Assert(not IsHighBitSet($00000001), 'IsHighBitSet');
  6721. Assert(not IsHighBitSet($7FFFFFFF), 'IsHighBitSet');
  6722. Assert(SetBitScanForward(0) = -1, 'SetBitScanForward');
  6723. Assert(SetBitScanForward($1020) = 5, 'SetBitScanForward');
  6724. Assert(SetBitScanReverse($1020) = 12, 'SetBitScanForward');
  6725. Assert(SetBitScanForward($1020, 6) = 12, 'SetBitScanForward');
  6726. Assert(SetBitScanReverse($1020, 11) = 5, 'SetBitScanForward');
  6727. Assert(ClearBitScanForward($FFFFFFFF) = -1, 'ClearBitScanForward');
  6728. Assert(ClearBitScanForward($1020) = 0, 'ClearBitScanForward');
  6729. Assert(ClearBitScanReverse($1020) = 31, 'ClearBitScanForward');
  6730. Assert(ClearBitScanForward($1020, 5) = 6, 'ClearBitScanForward');
  6731. Assert(ClearBitScanReverse($1020, 12) = 11, 'ClearBitScanForward');
  6732. Assert(ReverseBits($12345678) = $1E6A2C48, 'ReverseBits');
  6733. Assert(ReverseBits($1) = $80000000, 'ReverseBits');
  6734. Assert(ReverseBits($80000000) = $1, 'ReverseBits');
  6735. Assert(SwapEndian($12345678) = $78563412, 'SwapEndian');
  6736. Assert(BitCount($12341234) = 10, 'BitCount');
  6737. Assert(IsPowerOfTwo(1), 'IsPowerOfTwo');
  6738. Assert(IsPowerOfTwo(2), 'IsPowerOfTwo');
  6739. Assert(not IsPowerOfTwo(3), 'IsPowerOfTwo');
  6740. Assert(RotateLeftBits32(0, 1) = 0, 'RotateLeftBits32');
  6741. Assert(RotateLeftBits32(1, 0) = 1, 'RotateLeftBits32');
  6742. Assert(RotateLeftBits32(1, 1) = 2, 'RotateLeftBits32');
  6743. Assert(RotateLeftBits32($80000000, 1) = 1, 'RotateLeftBits32');
  6744. Assert(RotateLeftBits32($80000001, 1) = 3, 'RotateLeftBits32');
  6745. Assert(RotateLeftBits32(1, 2) = 4, 'RotateLeftBits32');
  6746. Assert(RotateLeftBits32(1, 31) = $80000000, 'RotateLeftBits32');
  6747. Assert(RotateLeftBits32(5, 2) = 20, 'RotateLeftBits32');
  6748. Assert(RotateRightBits32(0, 1) = 0, 'RotateRightBits32');
  6749. Assert(RotateRightBits32(1, 0) = 1, 'RotateRightBits32');
  6750. Assert(RotateRightBits32(1, 1) = $80000000, 'RotateRightBits32');
  6751. Assert(RotateRightBits32(2, 1) = 1, 'RotateRightBits32');
  6752. Assert(RotateRightBits32(4, 2) = 1, 'RotateRightBits32');
  6753. Assert(LowBitMask(10) = $3FF, 'LowBitMask');
  6754. Assert(HighBitMask(28) = $F0000000, 'HighBitMask');
  6755. Assert(RangeBitMask(2, 6) = $7C, 'RangeBitMask');
  6756. Assert(SetBitRange($101, 2, 6) = $17D, 'SetBitRange');
  6757. Assert(ClearBitRange($17D, 2, 6) = $101, 'ClearBitRange');
  6758. Assert(ToggleBitRange($17D, 2, 6) = $101, 'ToggleBitRange');
  6759. Assert(IsBitRangeSet($17D, 2, 6), 'IsBitRangeSet');
  6760. Assert(not IsBitRangeSet($101, 2, 6), 'IsBitRangeSet');
  6761. Assert(not IsBitRangeClear($17D, 2, 6), 'IsBitRangeClear');
  6762. Assert(IsBitRangeClear($101, 2, 6), 'IsBitRangeClear');
  6763. end;
  6764. procedure Test_Float;
  6765. {$IFNDEF ExtendedIsDouble}
  6766. var E : Integer;
  6767. {$ENDIF}
  6768. begin
  6769. Assert(not FloatZero(1e-1, 1e-2), 'FloatZero');
  6770. Assert(FloatZero(1e-2, 1e-2), 'FloatZero');
  6771. Assert(not FloatZero(1e-1, 1e-9), 'FloatZero');
  6772. Assert(not FloatZero(1e-8, 1e-9), 'FloatZero');
  6773. Assert(FloatZero(1e-9, 1e-9), 'FloatZero');
  6774. Assert(FloatZero(1e-10, 1e-9), 'FloatZero');
  6775. Assert(not FloatZero(0.2, 1e-1), 'FloatZero');
  6776. Assert(FloatZero(0.09, 1e-1), 'FloatZero');
  6777. Assert(FloatOne(1.0, 1e-1), 'FloatOne');
  6778. Assert(FloatOne(1.09999, 1e-1), 'FloatOne');
  6779. Assert(FloatOne(0.90001, 1e-1), 'FloatOne');
  6780. Assert(not FloatOne(1.10001, 1e-1), 'FloatOne');
  6781. Assert(not FloatOne(1.2, 1e-1), 'FloatOne');
  6782. Assert(not FloatOne(0.89999, 1e-1), 'FloatOne');
  6783. Assert(not FloatsEqual(2.0, -2.0, 1e-1), 'FloatsEqual');
  6784. Assert(not FloatsEqual(1.0, 0.0, 1e-1), 'FloatsEqual');
  6785. Assert(FloatsEqual(2.0, 2.0, 1e-1), 'FloatsEqual');
  6786. Assert(FloatsEqual(2.0, 2.09, 1e-1), 'FloatsEqual');
  6787. Assert(FloatsEqual(2.0, 1.90000001, 1e-1), 'FloatsEqual');
  6788. Assert(not FloatsEqual(2.0, 2.10001, 1e-1), 'FloatsEqual');
  6789. Assert(not FloatsEqual(2.0, 2.2, 1e-1), 'FloatsEqual');
  6790. Assert(not FloatsEqual(2.0, 1.8999999, 1e-1), 'FloatsEqual');
  6791. Assert(FloatsEqual(2.00000000011, 2.0, 1e-2), 'FloatsEqual');
  6792. Assert(FloatsEqual(2.00000000011, 2.0, 1e-9), 'FloatsEqual');
  6793. Assert(not FloatsEqual(2.00000000011, 2.0, 1e-10), 'FloatsEqual');
  6794. Assert(not FloatsEqual(2.00000000011, 2.0, 1e-11), 'FloatsEqual');
  6795. {$IFNDEF ExtendedIsDouble}
  6796. Assert(FloatsCompare(0.0, 0.0, MinExtended) = crEqual, 'FloatsCompare');
  6797. Assert(FloatsCompare(1.2, 1.2, MinExtended) = crEqual, 'FloatsCompare');
  6798. Assert(FloatsCompare(1.23456789e-300, 1.23456789e-300, MinExtended) = crEqual, 'FloatsCompare');
  6799. Assert(FloatsCompare(1.23456780e-300, 1.23456789e-300, MinExtended) = crLess, 'FloatsCompare');
  6800. {$ENDIF}
  6801. Assert(FloatsCompare(1.4e-5, 1.5e-5, 1e-4) = crEqual, 'FloatsCompare');
  6802. Assert(FloatsCompare(1.4e-5, 1.5e-5, 1e-5) = crEqual, 'FloatsCompare');
  6803. Assert(FloatsCompare(1.4e-5, 1.5e-5, 1e-6) = crLess, 'FloatsCompare');
  6804. Assert(FloatsCompare(1.4e-5, 1.5e-5, 1e-7) = crLess, 'FloatsCompare');
  6805. Assert(FloatsCompare(0.5003, 0.5001, 1e-1) = crEqual, 'FloatsCompare');
  6806. Assert(FloatsCompare(0.5003, 0.5001, 1e-2) = crEqual, 'FloatsCompare');
  6807. Assert(FloatsCompare(0.5003, 0.5001, 1e-3) = crEqual, 'FloatsCompare');
  6808. Assert(FloatsCompare(0.5003, 0.5001, 1e-4) = crGreater, 'FloatsCompare');
  6809. Assert(FloatsCompare(0.5003, 0.5001, 1e-5) = crGreater, 'FloatsCompare');
  6810. {$IFNDEF ExtendedIsDouble}
  6811. Assert(ApproxEqual(0.0, 0.0), 'ApproxEqual');
  6812. Assert(not ApproxEqual(0.0, 1e-100, 1e-10), 'ApproxEqual');
  6813. Assert(not ApproxEqual(1.0, 1e-100, 1e-10), 'ApproxEqual');
  6814. Assert(ApproxEqual(1.0, 1.0), 'ApproxEqual');
  6815. Assert(ApproxEqual(-1.0, -1.0), 'ApproxEqual');
  6816. Assert(not ApproxEqual(1.0, -1.0), 'ApproxEqual');
  6817. Assert(ApproxEqual(1e-100, 1e-100, 1e-10), 'ApproxEqual');
  6818. Assert(not ApproxEqual(0.0, 1.0, 1e-9), 'ApproxEqual');
  6819. Assert(not ApproxEqual(-1.0, 1.0, 1e-9), 'ApproxEqual');
  6820. Assert(ApproxEqual(0.12345, 0.12349, 1e-3), 'ApproxEqual');
  6821. Assert(not ApproxEqual(0.12345, 0.12349, 1e-4), 'ApproxEqual');
  6822. Assert(not ApproxEqual(0.12345, 0.12349, 1e-5), 'ApproxEqual');
  6823. Assert(ApproxEqual(1.2345e+100, 1.2349e+100, 1e-3), 'ApproxEqual');
  6824. Assert(not ApproxEqual(1.2345e+100, 1.2349e+100, 1e-4), 'ApproxEqual');
  6825. Assert(not ApproxEqual(1.2345e+100, 1.2349e+100, 1e-5), 'ApproxEqual');
  6826. Assert(ApproxEqual(1.2345e-100, 1.2349e-100, 1e-3), 'ApproxEqual');
  6827. Assert(not ApproxEqual(1.2345e-100, 1.2349e-100, 1e-4), 'ApproxEqual');
  6828. Assert(not ApproxEqual(1.2345e-100, 1.2349e-100, 1e-5), 'ApproxEqual');
  6829. Assert(not ApproxEqual(1.0e+20, 1.00000001E+20, 1e-8), 'ApproxEqual');
  6830. Assert(ApproxEqual(1.0e+20, 1.000000001E+20, 1e-8), 'ApproxEqual');
  6831. Assert(not ApproxEqual(1.0e+20, 1.000000001E+20, 1e-9), 'ApproxEqual');
  6832. Assert(ApproxEqual(1.0e+20, 1.0000000001E+20, 1e-9), 'ApproxEqual');
  6833. Assert(not ApproxEqual(1.0e+20, 1.0000000001E+20, 1e-10), 'ApproxEqual');
  6834. Assert(ApproxCompare(0.0, 0.0) = crEqual, 'ApproxCompare');
  6835. Assert(ApproxCompare(0.0, 1.0) = crLess, 'ApproxCompare');
  6836. Assert(ApproxCompare(1.0, 0.0) = crGreater, 'ApproxCompare');
  6837. Assert(ApproxCompare(-1.0, 1.0) = crLess, 'ApproxCompare');
  6838. Assert(ApproxCompare(1.2345e+10, 1.2349e+10, 1e-3) = crEqual, 'ApproxCompare');
  6839. Assert(ApproxCompare(1.2345e+10, 1.2349e+10, 1e-4) = crLess, 'ApproxCompare');
  6840. Assert(ApproxCompare(-1.2345e-10, -1.2349e-10, 1e-3) = crEqual, 'ApproxCompare');
  6841. Assert(ApproxCompare(-1.2345e-10, -1.2349e-10, 1e-4) = crGreater, 'ApproxCompare');
  6842. {$ENDIF}
  6843. {$IFNDEF ExtendedIsDouble}
  6844. Assert(FloatExponentBase10(1.0, E), 'FloatExponent');
  6845. Assert(E = 0, 'FloatExponent');
  6846. Assert(FloatExponentBase10(10.0, E), 'FloatExponent');
  6847. Assert(E = 1, 'FloatExponent');
  6848. Assert(FloatExponentBase10(0.1, E), 'FloatExponent');
  6849. Assert(E = -1, 'FloatExponent');
  6850. Assert(FloatExponentBase10(1e100, E), 'FloatExponent');
  6851. Assert(E = 100, 'FloatExponent');
  6852. Assert(FloatExponentBase10(1e-100, E), 'FloatExponent');
  6853. Assert(E = -100, 'FloatExponent');
  6854. Assert(FloatExponentBase10(0.999, E), 'FloatExponent');
  6855. Assert(E = 0, 'FloatExponent');
  6856. Assert(FloatExponentBase10(-0.999, E), 'FloatExponent');
  6857. Assert(E = 0, 'FloatExponent');
  6858. {$ENDIF}
  6859. end;
  6860. procedure Test_IntStr;
  6861. var I : Int64;
  6862. W : LongWord;
  6863. L : Integer;
  6864. A : AnsiString;
  6865. begin
  6866. Assert(HexCharToInt('A') = 10, 'HexCharToInt');
  6867. Assert(HexCharToInt('a') = 10, 'HexCharToInt');
  6868. Assert(HexCharToInt('1') = 1, 'HexCharToInt');
  6869. Assert(HexCharToInt('0') = 0, 'HexCharToInt');
  6870. Assert(HexCharToInt('F') = 15, 'HexCharToInt');
  6871. Assert(HexCharToInt('G') = -1, 'HexCharToInt');
  6872. Assert(IntToStringA(0) = '0', 'IntToAnsiString');
  6873. Assert(IntToStringA(1) = '1', 'IntToAnsiString');
  6874. Assert(IntToStringA(-1) = '-1', 'IntToAnsiString');
  6875. Assert(IntToStringA(10) = '10', 'IntToAnsiString');
  6876. Assert(IntToStringA(-10) = '-10', 'IntToAnsiString');
  6877. Assert(IntToStringA(123) = '123', 'IntToAnsiString');
  6878. Assert(IntToStringA(-123) = '-123', 'IntToAnsiString');
  6879. Assert(IntToStringW(0) = '0', 'IntToWideString');
  6880. Assert(IntToStringW(1) = '1', 'IntToWideString');
  6881. Assert(IntToStringW(-1) = '-1', 'IntToWideString');
  6882. Assert(IntToStringW(1234567890) = '1234567890', 'IntToWideString');
  6883. Assert(IntToStringW(-1234567890) = '-1234567890', 'IntToWideString');
  6884. Assert(IntToStringU(0) = '0', 'IntToString');
  6885. Assert(IntToStringU(1) = '1', 'IntToString');
  6886. Assert(IntToStringU(-1) = '-1', 'IntToString');
  6887. Assert(IntToStringU(1234567890) = '1234567890', 'IntToString');
  6888. Assert(IntToStringU(-1234567890) = '-1234567890', 'IntToString');
  6889. Assert(IntToString(0) = '0', 'IntToString');
  6890. Assert(IntToString(1) = '1', 'IntToString');
  6891. Assert(IntToString(-1) = '-1', 'IntToString');
  6892. Assert(IntToString(1234567890) = '1234567890', 'IntToString');
  6893. Assert(IntToString(-1234567890) = '-1234567890', 'IntToString');
  6894. Assert(UIntToStringA(0) = '0', 'UIntToString');
  6895. Assert(UIntToStringA($FFFFFFFF) = '4294967295', 'UIntToString');
  6896. Assert(UIntToStringW(0) = '0', 'UIntToString');
  6897. Assert(UIntToStringW($FFFFFFFF) = '4294967295', 'UIntToString');
  6898. Assert(UIntToStringU(0) = '0', 'UIntToString');
  6899. Assert(UIntToStringU($FFFFFFFF) = '4294967295', 'UIntToString');
  6900. Assert(UIntToString(0) = '0', 'UIntToString');
  6901. Assert(UIntToString($FFFFFFFF) = '4294967295', 'UIntToString');
  6902. Assert(LongWordToStrA(0, 8) = '00000000', 'LongWordToStr');
  6903. Assert(LongWordToStrA($FFFFFFFF, 0) = '4294967295', 'LongWordToStr');
  6904. Assert(LongWordToStrW(0, 8) = '00000000', 'LongWordToStr');
  6905. Assert(LongWordToStrW($FFFFFFFF, 0) = '4294967295', 'LongWordToStr');
  6906. Assert(LongWordToStrU(0, 8) = '00000000', 'LongWordToStr');
  6907. Assert(LongWordToStrU($FFFFFFFF, 0) = '4294967295', 'LongWordToStr');
  6908. Assert(LongWordToStr(0, 8) = '00000000', 'LongWordToStr');
  6909. Assert(LongWordToStr($FFFFFFFF, 0) = '4294967295', 'LongWordToStr');
  6910. Assert(LongWordToStr(123) = '123', 'LongWordToStr');
  6911. Assert(LongWordToStr(10000) = '10000', 'LongWordToStr');
  6912. Assert(LongWordToStr(99999) = '99999', 'LongWordToStr');
  6913. Assert(LongWordToStr(1, 1) = '1', 'LongWordToStr');
  6914. Assert(LongWordToStr(1, 3) = '001', 'LongWordToStr');
  6915. Assert(LongWordToStr(1234, 3) = '1234', 'LongWordToStr');
  6916. Assert(LongWordToHexA(0, 8) = '00000000', 'LongWordToHex');
  6917. Assert(LongWordToHexA($FFFFFFFF, 0) = 'FFFFFFFF', 'LongWordToHex');
  6918. Assert(LongWordToHexA($10000) = '10000', 'LongWordToHex');
  6919. Assert(LongWordToHexA($12345678) = '12345678', 'LongWordToHex');
  6920. Assert(LongWordToHexA($AB, 4) = '00AB', 'LongWordToHex');
  6921. Assert(LongWordToHexA($ABCD, 8) = '0000ABCD', 'LongWordToHex');
  6922. Assert(LongWordToHexA($CDEF, 2) = 'CDEF', 'LongWordToHex');
  6923. Assert(LongWordToHexA($ABC3, 0, False) = 'abc3', 'LongWordToHex');
  6924. Assert(LongWordToHexW(0, 8) = '00000000', 'LongWordToHex');
  6925. Assert(LongWordToHexW(0) = '0', 'LongWordToHex');
  6926. Assert(LongWordToHexW($FFFFFFFF, 0) = 'FFFFFFFF', 'LongWordToHex');
  6927. Assert(LongWordToHexW($AB, 4) = '00AB', 'LongWordToHex');
  6928. Assert(LongWordToHexW($ABC3, 0, False) = 'abc3', 'LongWordToHex');
  6929. Assert(LongWordToHexU(0, 8) = '00000000', 'LongWordToHex');
  6930. Assert(LongWordToHexU(0) = '0', 'LongWordToHex');
  6931. Assert(LongWordToHexU($FFFFFFFF, 0) = 'FFFFFFFF', 'LongWordToHex');
  6932. Assert(LongWordToHexU($AB, 4) = '00AB', 'LongWordToHex');
  6933. Assert(LongWordToHexU($ABC3, 0, False) = 'abc3', 'LongWordToHex');
  6934. Assert(LongWordToHex(0, 8) = '00000000', 'LongWordToHex');
  6935. Assert(LongWordToHex($FFFFFFFF, 0) = 'FFFFFFFF', 'LongWordToHex');
  6936. Assert(LongWordToHex(0) = '0', 'LongWordToHex');
  6937. Assert(LongWordToHex($ABCD, 8) = '0000ABCD', 'LongWordToHex');
  6938. Assert(LongWordToHex($ABC3, 0, False) = 'abc3', 'LongWordToHex');
  6939. Assert(StringToIntA('0') = 0, 'StringToInt');
  6940. Assert(StringToIntA('1') = 1, 'StringToInt');
  6941. Assert(StringToIntA('-1') = -1, 'StringToInt');
  6942. Assert(StringToIntA('10') = 10, 'StringToInt');
  6943. Assert(StringToIntA('01') = 1, 'StringToInt');
  6944. Assert(StringToIntA('-10') = -10, 'StringToInt');
  6945. Assert(StringToIntA('-01') = -1, 'StringToInt');
  6946. Assert(StringToIntA('123') = 123, 'StringToInt');
  6947. Assert(StringToIntA('-123') = -123, 'StringToInt');
  6948. Assert(StringToIntW('321') = 321, 'StringToInt');
  6949. Assert(StringToIntW('-321') = -321, 'StringToInt');
  6950. Assert(StringToIntU('321') = 321, 'StringToInt');
  6951. Assert(StringToIntU('-321') = -321, 'StringToInt');
  6952. A := '-012A';
  6953. Assert(TryStringToInt64PA(PAnsiChar(A), Length(A), I, L) = convertOK, 'StringToInt');
  6954. Assert((I = -12) and (L = 4), 'StringToInt');
  6955. A := '-A012';
  6956. Assert(TryStringToInt64PA(PAnsiChar(A), Length(A), I, L) = convertFormatError, 'StringToInt');
  6957. Assert((I = 0) and (L = 1), 'StringToInt');
  6958. Assert(TryStringToInt64A('0', I), 'StringToInt');
  6959. Assert(I = 0, 'StringToInt');
  6960. Assert(TryStringToInt64A('-0', I), 'StringToInt');
  6961. Assert(I = 0, 'StringToInt');
  6962. Assert(TryStringToInt64A('+0', I), 'StringToInt');
  6963. Assert(I = 0, 'StringToInt');
  6964. Assert(TryStringToInt64A('1234', I), 'StringToInt');
  6965. Assert(I = 1234, 'StringToInt');
  6966. Assert(TryStringToInt64A('-1234', I), 'StringToInt');
  6967. Assert(I = -1234, 'StringToInt');
  6968. Assert(TryStringToInt64A('000099999', I), 'StringToInt');
  6969. Assert(I = 99999, 'StringToInt');
  6970. Assert(TryStringToInt64A('999999999999999999', I), 'StringToInt');
  6971. Assert(I = 999999999999999999, 'StringToInt');
  6972. Assert(TryStringToInt64A('-999999999999999999', I), 'StringToInt');
  6973. Assert(I = -999999999999999999, 'StringToInt');
  6974. Assert(TryStringToInt64A('4294967295', I), 'StringToInt');
  6975. Assert(I = $FFFFFFFF, 'StringToInt');
  6976. Assert(TryStringToInt64A('4294967296', I), 'StringToInt');
  6977. Assert(I = $100000000, 'StringToInt');
  6978. Assert(TryStringToInt64A('9223372036854775807', I), 'StringToInt');
  6979. Assert(I = 9223372036854775807, 'StringToInt');
  6980. {$IFNDEF DELPHI7_DOWN}
  6981. Assert(TryStringToInt64A('-9223372036854775808', I), 'StringToInt');
  6982. Assert(I = -9223372036854775808, 'StringToInt');
  6983. {$ENDIF}
  6984. Assert(not TryStringToInt64A('', I), 'StringToInt');
  6985. Assert(not TryStringToInt64A('-', I), 'StringToInt');
  6986. Assert(not TryStringToInt64A('+', I), 'StringToInt');
  6987. Assert(not TryStringToInt64A('+-0', I), 'StringToInt');
  6988. Assert(not TryStringToInt64A('0A', I), 'StringToInt');
  6989. Assert(not TryStringToInt64A('1A', I), 'StringToInt');
  6990. Assert(not TryStringToInt64A(' 0', I), 'StringToInt');
  6991. Assert(not TryStringToInt64A('0 ', I), 'StringToInt');
  6992. Assert(not TryStringToInt64A('9223372036854775808', I), 'StringToInt');
  6993. {$IFNDEF DELPHI7_DOWN}
  6994. Assert(not TryStringToInt64A('-9223372036854775809', I), 'StringToInt');
  6995. {$ENDIF}
  6996. Assert(TryStringToInt64W('9223372036854775807', I), 'StringToInt');
  6997. Assert(I = 9223372036854775807, 'StringToInt');
  6998. {$IFNDEF DELPHI7_DOWN}
  6999. Assert(TryStringToInt64W('-9223372036854775808', I), 'StringToInt');
  7000. Assert(I = -9223372036854775808, 'StringToInt');
  7001. {$ENDIF}
  7002. Assert(not TryStringToInt64W('', I), 'StringToInt');
  7003. Assert(not TryStringToInt64W('-', I), 'StringToInt');
  7004. Assert(not TryStringToInt64W('0A', I), 'StringToInt');
  7005. Assert(not TryStringToInt64W('9223372036854775808', I), 'StringToInt');
  7006. {$IFNDEF DELPHI7_DOWN}
  7007. Assert(not TryStringToInt64W('-9223372036854775809', I), 'StringToInt');
  7008. {$ENDIF}
  7009. Assert(TryStringToInt64U('9223372036854775807', I), 'StringToInt');
  7010. Assert(I = 9223372036854775807, 'StringToInt');
  7011. {$IFNDEF DELPHI7_DOWN}
  7012. Assert(TryStringToInt64U('-9223372036854775808', I), 'StringToInt');
  7013. Assert(I = -9223372036854775808, 'StringToInt');
  7014. {$ENDIF}
  7015. Assert(not TryStringToInt64U('', I), 'StringToInt');
  7016. Assert(not TryStringToInt64U('-', I), 'StringToInt');
  7017. Assert(not TryStringToInt64U('0A', I), 'StringToInt');
  7018. Assert(not TryStringToInt64U('9223372036854775808', I), 'StringToInt');
  7019. {$IFNDEF DELPHI7_DOWN}
  7020. Assert(not TryStringToInt64U('-9223372036854775809', I), 'StringToInt');
  7021. {$ENDIF}
  7022. Assert(TryStringToInt64('9223372036854775807', I), 'StringToInt');
  7023. Assert(I = 9223372036854775807, 'StringToInt');
  7024. {$IFNDEF DELPHI7_DOWN}
  7025. Assert(TryStringToInt64('-9223372036854775808', I), 'StringToInt');
  7026. Assert(I = -9223372036854775808, 'StringToInt');
  7027. {$ENDIF}
  7028. Assert(not TryStringToInt64('', I), 'StringToInt');
  7029. Assert(not TryStringToInt64('-', I), 'StringToInt');
  7030. Assert(not TryStringToInt64('9223372036854775808', I), 'StringToInt');
  7031. {$IFNDEF DELPHI7_DOWN}
  7032. Assert(not TryStringToInt64('-9223372036854775809', I), 'StringToInt');
  7033. {$ENDIF}
  7034. Assert(HexToUIntA('FFFFFFFF') = $FFFFFFFF, 'HexStringToUInt');
  7035. Assert(HexToUIntA('FFFFFFFF') = $FFFFFFFF, 'HexStringToUInt');
  7036. Assert(HexToUInt('FFFFFFFF') = $FFFFFFFF, 'HexStringToUInt');
  7037. Assert(HexToLongWord('FFFFFFFF') = $FFFFFFFF, 'HexToLongWord');
  7038. Assert(HexToLongWord('0') = 0, 'HexToLongWord');
  7039. Assert(HexToLongWord('123456') = $123456, 'HexToLongWord');
  7040. Assert(HexToLongWord('ABC') = $ABC, 'HexToLongWord');
  7041. Assert(HexToLongWord('abc') = $ABC, 'HexToLongWord');
  7042. Assert(not TryHexToLongWord('', W), 'HexToLongWord');
  7043. Assert(not TryHexToLongWord('x', W), 'HexToLongWord');
  7044. Assert(HexToLongWordA('FFFFFFFF') = $FFFFFFFF, 'HexToLongWord');
  7045. Assert(HexToLongWordA('0') = 0, 'HexToLongWord');
  7046. Assert(HexToLongWordA('ABC') = $ABC, 'HexToLongWord');
  7047. Assert(HexToLongWordA('abc') = $ABC, 'HexToLongWord');
  7048. Assert(not TryHexToLongWordA('', W), 'HexToLongWord');
  7049. Assert(not TryHexToLongWordA('x', W), 'HexToLongWord');
  7050. Assert(HexToLongWordW('FFFFFFFF') = $FFFFFFFF, 'HexToLongWord');
  7051. Assert(HexToLongWordW('0') = 0, 'HexToLongWord');
  7052. Assert(HexToLongWordW('123456') = $123456, 'HexToLongWord');
  7053. Assert(HexToLongWordW('ABC') = $ABC, 'HexToLongWord');
  7054. Assert(HexToLongWordW('abc') = $ABC, 'HexToLongWord');
  7055. Assert(not TryHexToLongWordW('', W), 'HexToLongWord');
  7056. Assert(not TryHexToLongWordW('x', W), 'HexToLongWord');
  7057. Assert(HexToLongWordU('FFFFFFFF') = $FFFFFFFF, 'HexToLongWord');
  7058. Assert(HexToLongWordU('0') = 0, 'HexToLongWord');
  7059. Assert(HexToLongWordU('123456') = $123456, 'HexToLongWord');
  7060. Assert(HexToLongWordU('ABC') = $ABC, 'HexToLongWord');
  7061. Assert(HexToLongWordU('abc') = $ABC, 'HexToLongWord');
  7062. Assert(not TryHexToLongWordU('', W), 'HexToLongWord');
  7063. Assert(not TryHexToLongWordU('x', W), 'HexToLongWord');
  7064. Assert(not TryStringToLongWordA('', W), 'StringToLongWord');
  7065. Assert(StringToLongWordA('123') = 123, 'StringToLongWord');
  7066. Assert(StringToLongWordA('4294967295') = $FFFFFFFF, 'StringToLongWord');
  7067. Assert(StringToLongWordA('999999999') = 999999999, 'StringToLongWord');
  7068. Assert(StringToLongWordW('0') = 0, 'StringToLongWord');
  7069. Assert(StringToLongWordW('4294967295') = $FFFFFFFF, 'StringToLongWord');
  7070. Assert(StringToLongWordU('0') = 0, 'StringToLongWord');
  7071. Assert(StringToLongWordU('4294967295') = $FFFFFFFF, 'StringToLongWord');
  7072. Assert(StringToLongWord('0') = 0, 'StringToLongWord');
  7073. Assert(StringToLongWord('4294967295') = $FFFFFFFF, 'StringToLongWord');
  7074. end;
  7075. procedure Test_FloatStr;
  7076. var A : AnsiString;
  7077. E : Extended;
  7078. L : Integer;
  7079. begin
  7080. // FloatToStr
  7081. {$IFNDEF FREEPASCAL}
  7082. Assert(FloatToStringA(0.0) = '0');
  7083. Assert(FloatToStringA(-1.5) = '-1.5');
  7084. Assert(FloatToStringA(1.5) = '1.5');
  7085. Assert(FloatToStringA(1.1) = '1.1');
  7086. Assert(FloatToStringA(123) = '123');
  7087. Assert(FloatToStringA(0.00000000000001) = '0.00000000000001');
  7088. Assert(FloatToStringA(0.000000000000001) = '0.000000000000001');
  7089. Assert(FloatToStringA(0.0000000000000001) = '1E-0016');
  7090. Assert(FloatToStringA(0.0000000000000012345) = '0.000000000000001');
  7091. Assert(FloatToStringA(0.00000000000000012345) = '1.2345E-0016');
  7092. {$IFNDEF ExtendedIsDouble}
  7093. Assert(FloatToStringA(123456789.123456789) = '123456789.123456789');
  7094. Assert(FloatToStringA(123456789012345.1234567890123456789) = '123456789012345.1234');
  7095. Assert(FloatToStringA(1234567890123456.1234567890123456789) = '1.23456789012346E+0015');
  7096. {$ENDIF}
  7097. Assert(FloatToStringA(0.12345) = '0.12345');
  7098. Assert(FloatToStringA(1e100) = '1E+0100');
  7099. Assert(FloatToStringA(1.234e+100) = '1.234E+0100');
  7100. Assert(FloatToStringA(-1.5e-100) = '-1.5E-0100');
  7101. {$IFNDEF ExtendedIsDouble}
  7102. Assert(FloatToStringA(1.234e+1000) = '1.234E+1000');
  7103. Assert(FloatToStringA(-1e-4000) = '0');
  7104. {$ENDIF}
  7105. Assert(FloatToStringW(0.0) = '0');
  7106. Assert(FloatToStringW(-1.5) = '-1.5');
  7107. Assert(FloatToStringW(1.5) = '1.5');
  7108. Assert(FloatToStringW(1.1) = '1.1');
  7109. {$IFNDEF ExtendedIsDouble}
  7110. Assert(FloatToStringW(123456789.123456789) = '123456789.123456789');
  7111. Assert(FloatToStringW(123456789012345.1234567890123456789) = '123456789012345.1234');
  7112. Assert(FloatToStringW(1234567890123456.1234567890123456789) = '1.23456789012346E+0015');
  7113. {$ENDIF}
  7114. Assert(FloatToStringW(0.12345) = '0.12345');
  7115. Assert(FloatToStringW(1e100) = '1E+0100');
  7116. Assert(FloatToStringW(1.234e+100) = '1.234E+0100');
  7117. Assert(FloatToStringW(1.5e-100) = '1.5E-0100');
  7118. Assert(FloatToStringU(0.0) = '0');
  7119. Assert(FloatToStringU(-1.5) = '-1.5');
  7120. Assert(FloatToStringU(1.5) = '1.5');
  7121. Assert(FloatToStringU(1.1) = '1.1');
  7122. {$IFNDEF ExtendedIsDouble}
  7123. Assert(FloatToStringU(123456789.123456789) = '123456789.123456789');
  7124. Assert(FloatToStringU(123456789012345.1234567890123456789) = '123456789012345.1234');
  7125. Assert(FloatToStringU(1234567890123456.1234567890123456789) = '1.23456789012346E+0015');
  7126. {$ENDIF}
  7127. Assert(FloatToStringU(0.12345) = '0.12345');
  7128. Assert(FloatToStringU(1e100) = '1E+0100');
  7129. Assert(FloatToStringU(1.234e+100) = '1.234E+0100');
  7130. Assert(FloatToStringU(1.5e-100) = '1.5E-0100');
  7131. Assert(FloatToString(0.0) = '0');
  7132. Assert(FloatToString(-1.5) = '-1.5');
  7133. Assert(FloatToString(1.5) = '1.5');
  7134. Assert(FloatToString(1.1) = '1.1');
  7135. {$IFNDEF ExtendedIsDouble}
  7136. Assert(FloatToString(123456789.123456789) = '123456789.123456789');
  7137. Assert(FloatToString(123456789012345.1234567890123456789) = '123456789012345.1234');
  7138. Assert(FloatToString(1234567890123456.1234567890123456789) = '1.23456789012346E+0015');
  7139. {$ENDIF}
  7140. Assert(FloatToString(0.12345) = '0.12345');
  7141. Assert(FloatToString(1e100) = '1E+0100');
  7142. Assert(FloatToString(1.234e+100) = '1.234E+0100');
  7143. Assert(FloatToString(1.5e-100) = '1.5E-0100');
  7144. {$ENDIF}
  7145. // StrToFloat
  7146. A := '123.456';
  7147. Assert(TryStringToFloatPA(PAnsiChar(A), Length(A), E, L) = convertOK);
  7148. Assert((E = 123.456) and (L = 7));
  7149. A := '-000.500A';
  7150. Assert(TryStringToFloatPA(PAnsiChar(A), Length(A), E, L) = convertOK);
  7151. Assert((E = -0.5) and (L = 8));
  7152. A := '1.234e+002X';
  7153. Assert(TryStringToFloatPA(PAnsiChar(A), Length(A), E, L) = convertOK);
  7154. Assert((E = 123.4) and (L = 10));
  7155. A := '1.2e300x';
  7156. Assert(TryStringToFloatPA(PAnsiChar(A), Length(A), E, L) = convertOK);
  7157. {$IFNDEF ExtendedIsDouble}
  7158. Assert(ApproxEqual(E, 1.2e300, 1e-2) and (L = 7));
  7159. {$ENDIF}
  7160. A := '1.2e-300e';
  7161. Assert(TryStringToFloatPA(PAnsiChar(A), Length(A), E, L) = convertOK);
  7162. {$IFNDEF ExtendedIsDouble}
  7163. Assert(ApproxEqual(E, 1.2e-300, 1e-2) and (L = 8));
  7164. {$ENDIF}
  7165. // 9999..9999 overflow
  7166. {$IFNDEF ExtendedIsDouble}
  7167. A := '';
  7168. for L := 1 to 5000 do
  7169. A := A + '9';
  7170. Assert(TryStringToFloatPA(PAnsiChar(A), Length(A), E, L) = convertOverflow);
  7171. Assert((E = 0.0) and (L >= 200));
  7172. {$ENDIF}
  7173. // 1200..0000
  7174. {$IFNDEF ExtendedIsDouble}
  7175. A := '12';
  7176. for L := 1 to 100 do
  7177. A := A + '0';
  7178. Assert(TryStringToFloatPA(PAnsiChar(A), Length(A), E, L) = convertOK);
  7179. Assert(ApproxEqual(E, 1.2e+101, 1e-2) and (L = 102));
  7180. {$ENDIF}
  7181. // 0.0000..0001 overflow
  7182. {$IFNDEF ExtendedIsDouble}
  7183. A := '0.';
  7184. for L := 1 to 5000 do
  7185. A := A + '0';
  7186. A := A + '1';
  7187. Assert(TryStringToFloatPA(PAnsiChar(A), Length(A), E, L) = convertOverflow);
  7188. Assert((E = 0.0) and (L >= 500));
  7189. {$ENDIF}
  7190. // 0.0000..000123
  7191. {$IFNDEF ExtendedIsDouble}
  7192. A := '0.';
  7193. for L := 1 to 100 do
  7194. A := A + '0';
  7195. A := A + '123';
  7196. Assert(TryStringToFloatPA(PAnsiChar(A), Length(A), E, L) = convertOK);
  7197. Assert(ApproxEqual(E, 1.23e-101, 1e-3) and (L = 105));
  7198. {$ENDIF}
  7199. // 1200..0000e100
  7200. {$IFNDEF ExtendedIsDouble}
  7201. A := '12';
  7202. for L := 1 to 100 do
  7203. A := A + '0';
  7204. A := A + 'e100';
  7205. Assert(TryStringToFloatPA(PAnsiChar(A), Length(A), E, L) = convertOK);
  7206. Assert(ApproxEqual(E, 1.2e+201, 1e-1) and (L = 106));
  7207. {$ENDIF}
  7208. Assert(StringToFloatA('0') = 0.0);
  7209. Assert(StringToFloatA('1') = 1.0);
  7210. Assert(StringToFloatA('1.5') = 1.5);
  7211. Assert(StringToFloatA('+1.5') = 1.5);
  7212. Assert(StringToFloatA('-1.5') = -1.5);
  7213. Assert(StringToFloatA('1.1') = 1.1);
  7214. Assert(StringToFloatA('-00.00') = 0.0);
  7215. Assert(StringToFloatA('+00.00') = 0.0);
  7216. Assert(StringToFloatA('0000000000000000000000001.1000000000000000000000000') = 1.1);
  7217. Assert(StringToFloatA('.5') = 0.5);
  7218. Assert(StringToFloatA('-.5') = -0.5);
  7219. {$IFNDEF ExtendedIsDouble}
  7220. Assert(ApproxEqual(StringToFloatA('1.123456789'), 1.123456789, 1e-10));
  7221. Assert(ApproxEqual(StringToFloatA('123456789.123456789'), 123456789.123456789, 1e-10));
  7222. Assert(ApproxEqual(StringToFloatA('1.5e500'), 1.5e500, 1e-2));
  7223. Assert(ApproxEqual(StringToFloatA('+1.5e+500'), 1.5e500, 1e-2));
  7224. Assert(ApproxEqual(StringToFloatA('1.2E-500'), 1.2e-500, 1e-2));
  7225. Assert(ApproxEqual(StringToFloatA('-1.2E-500'), -1.2e-500, 1e-2));
  7226. Assert(ApproxEqual(StringToFloatA('-1.23456789E-500'), -1.23456789e-500, 1e-9));
  7227. {$ENDIF}
  7228. Assert(not TryStringToFloatA('', E));
  7229. Assert(not TryStringToFloatA('+', E));
  7230. Assert(not TryStringToFloatA('-', E));
  7231. Assert(not TryStringToFloatA('.', E));
  7232. Assert(not TryStringToFloatA(' ', E));
  7233. Assert(not TryStringToFloatA(' 0', E));
  7234. Assert(not TryStringToFloatA('0 ', E));
  7235. Assert(not TryStringToFloatA('--0', E));
  7236. Assert(not TryStringToFloatA('0X', E));
  7237. end;
  7238. procedure Test_Hash;
  7239. begin
  7240. // HashStr
  7241. Assert(HashStrA('Fundamentals') = $3FB7796E, 'HashStr');
  7242. Assert(HashStrA('0') = $B2420DE, 'HashStr');
  7243. Assert(HashStrA('Fundamentals', 1, -1, False) = HashStrA('FUNdamentals', 1, -1, False), 'HashStr');
  7244. Assert(HashStrA('Fundamentals', 1, -1, True) <> HashStrA('FUNdamentals', 1, -1, True), 'HashStr');
  7245. Assert(HashStrW('Fundamentals') = $FD6ED837, 'HashStr');
  7246. Assert(HashStrW('0') = $6160DBF3, 'HashStr');
  7247. Assert(HashStrW('Fundamentals', 1, -1, False) = HashStrW('FUNdamentals', 1, -1, False), 'HashStr');
  7248. Assert(HashStrW('Fundamentals', 1, -1, True) <> HashStrW('FUNdamentals', 1, -1, True), 'HashStr');
  7249. {$IFDEF StringIsUnicode}
  7250. Assert(HashStr('Fundamentals') = $FD6ED837, 'HashStr');
  7251. Assert(HashStr('0') = $6160DBF3, 'HashStr');
  7252. {$ELSE}
  7253. Assert(HashStr('Fundamentals') = $3FB7796E, 'HashStr');
  7254. Assert(HashStr('0') = $B2420DE, 'HashStr');
  7255. {$ENDIF}
  7256. Assert(HashStr('Fundamentals', 1, -1, False) = HashStr('FUNdamentals', 1, -1, False), 'HashStr');
  7257. Assert(HashStr('Fundamentals', 1, -1, True) <> HashStr('FUNdamentals', 1, -1, True), 'HashStr');
  7258. end;
  7259. {$IFNDEF ManagedCode}
  7260. procedure Test_Memory;
  7261. var I, J : Integer;
  7262. A, B : AnsiString;
  7263. begin
  7264. for I := -1 to 33 do
  7265. begin
  7266. A := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  7267. B := ' ';
  7268. MoveMem(A[1], B[1], I);
  7269. for J := 1 to MinI(I, 10) do
  7270. Assert(B[J] = AnsiChar(48 + J - 1), 'MoveMem');
  7271. for J := 11 to MinI(I, 36) do
  7272. Assert(B[J] = AnsiChar(65 + J - 11), 'MoveMem');
  7273. for J := MaxI(I + 1, 1) to 36 do
  7274. Assert(B[J] = ' ', 'MoveMem');
  7275. Assert(CompareMem(A[1], B[1], I), 'CompareMem');
  7276. end;
  7277. for J := 1000 to 1500 do
  7278. begin
  7279. SetLength(A, 4096);
  7280. for I := 1 to 4096 do
  7281. A[I] := 'A';
  7282. SetLength(B, 4096);
  7283. for I := 1 to 4096 do
  7284. B[I] := 'B';
  7285. MoveMem(A[1], B[1], J);
  7286. for I := 1 to J do
  7287. Assert(B[I] = 'A', 'MoveMem');
  7288. for I := J + 1 to 4096 do
  7289. Assert(B[I] = 'B', 'MoveMem');
  7290. Assert(CompareMem(A[1], B[1], J), 'CompareMem');
  7291. end;
  7292. B := '1234567890';
  7293. MoveMem(B[1], B[3], 4);
  7294. Assert(B = '1212347890', 'MoveMem');
  7295. MoveMem(B[3], B[2], 4);
  7296. Assert(B = '1123447890', 'MoveMem');
  7297. MoveMem(B[1], B[3], 2);
  7298. Assert(B = '1111447890', 'MoveMem');
  7299. MoveMem(B[5], B[7], 3);
  7300. Assert(B = '1111444470', 'MoveMem');
  7301. MoveMem(B[9], B[10], 1);
  7302. Assert(B = '1111444477', 'MoveMem');
  7303. for I := -1 to 33 do
  7304. begin
  7305. A := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  7306. ZeroMem(A[1], I);
  7307. for J := 1 to I do
  7308. Assert(A[J] = #0, 'ZeroMem');
  7309. for J := MaxI(I + 1, 1) to 10 do
  7310. Assert(A[J] = AnsiChar(48 + J - 1), 'ZeroMem');
  7311. for J := MaxI(I + 1, 11) to 36 do
  7312. Assert(A[J] = AnsiChar(65 + J - 11), 'ZeroMem');
  7313. end;
  7314. for I := -1 to 33 do
  7315. begin
  7316. A := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  7317. FillMem(A[1], I, Ord('!'));
  7318. for J := 1 to I do
  7319. Assert(A[J] = '!', 'FillMem');
  7320. for J := MaxI(I + 1, 1) to 10 do
  7321. Assert(A[J] = AnsiChar(48 + J - 1), 'FillMem');
  7322. for J := MaxI(I + 1, 11) to 36 do
  7323. Assert(A[J] = AnsiChar(65 + J - 11), 'FillMem');
  7324. end;
  7325. end;
  7326. {$ENDIF}
  7327. procedure SelfTest;
  7328. begin
  7329. {$IFDEF CPU_INTEL386}
  7330. Set8087CW(Default8087CW);
  7331. {$ENDIF}
  7332. Test_Misc;
  7333. Test_BitFunctions;
  7334. Test_Float;
  7335. Test_IntStr;
  7336. Test_FloatStr;
  7337. Test_Hash;
  7338. {$IFNDEF ManagedCode}
  7339. Test_Memory;
  7340. {$ENDIF}
  7341. end;
  7342. {$ENDIF}
  7343. end.