| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415441644174418441944204421442244234424442544264427442844294430443144324433443444354436443744384439444044414442444344444445444644474448444944504451445244534454445544564457445844594460446144624463446444654466446744684469447044714472447344744475447644774478447944804481448244834484448544864487448844894490449144924493449444954496449744984499450045014502450345044505450645074508450945104511451245134514451545164517451845194520452145224523452445254526452745284529453045314532453345344535453645374538453945404541454245434544454545464547454845494550455145524553455445554556455745584559456045614562456345644565456645674568456945704571457245734574457545764577457845794580458145824583458445854586458745884589459045914592459345944595459645974598459946004601460246034604460546064607460846094610461146124613461446154616461746184619462046214622462346244625462646274628462946304631463246334634463546364637463846394640464146424643464446454646464746484649465046514652465346544655465646574658465946604661466246634664466546664667466846694670467146724673467446754676467746784679468046814682468346844685468646874688468946904691469246934694469546964697469846994700470147024703470447054706470747084709471047114712471347144715471647174718471947204721472247234724472547264727472847294730473147324733473447354736473747384739474047414742474347444745474647474748474947504751475247534754475547564757475847594760476147624763476447654766476747684769477047714772477347744775477647774778477947804781478247834784478547864787478847894790479147924793479447954796479747984799480048014802480348044805480648074808480948104811481248134814481548164817481848194820482148224823482448254826482748284829483048314832483348344835483648374838483948404841484248434844484548464847484848494850485148524853485448554856485748584859486048614862486348644865486648674868486948704871487248734874487548764877487848794880488148824883488448854886488748884889489048914892489348944895489648974898489949004901490249034904490549064907490849094910491149124913491449154916491749184919492049214922492349244925492649274928492949304931493249334934493549364937493849394940494149424943494449454946494749484949495049514952495349544955495649574958495949604961496249634964496549664967496849694970497149724973497449754976497749784979498049814982498349844985498649874988498949904991499249934994499549964997499849995000500150025003500450055006500750085009501050115012501350145015501650175018501950205021502250235024502550265027502850295030503150325033503450355036503750385039504050415042504350445045504650475048504950505051505250535054505550565057505850595060506150625063506450655066506750685069507050715072507350745075507650775078507950805081508250835084508550865087508850895090509150925093509450955096509750985099510051015102510351045105510651075108510951105111511251135114511551165117511851195120512151225123512451255126512751285129513051315132513351345135513651375138513951405141514251435144514551465147514851495150515151525153515451555156515751585159516051615162516351645165516651675168516951705171517251735174517551765177517851795180518151825183518451855186518751885189519051915192519351945195519651975198519952005201520252035204520552065207520852095210521152125213521452155216521752185219522052215222522352245225522652275228522952305231523252335234523552365237523852395240524152425243524452455246524752485249525052515252525352545255525652575258525952605261526252635264526552665267526852695270527152725273527452755276527752785279528052815282528352845285528652875288528952905291529252935294529552965297529852995300530153025303530453055306530753085309531053115312531353145315531653175318531953205321532253235324532553265327532853295330533153325333533453355336533753385339534053415342534353445345534653475348534953505351535253535354535553565357535853595360536153625363536453655366536753685369537053715372537353745375537653775378537953805381538253835384538553865387538853895390539153925393539453955396539753985399540054015402540354045405540654075408540954105411541254135414541554165417541854195420542154225423542454255426542754285429543054315432543354345435543654375438543954405441544254435444544554465447544854495450545154525453545454555456545754585459546054615462546354645465546654675468546954705471547254735474547554765477547854795480548154825483548454855486548754885489549054915492549354945495549654975498549955005501550255035504550555065507550855095510551155125513551455155516551755185519552055215522552355245525552655275528552955305531553255335534553555365537553855395540554155425543554455455546554755485549555055515552555355545555555655575558555955605561556255635564556555665567556855695570557155725573557455755576557755785579558055815582558355845585558655875588558955905591559255935594559555965597559855995600560156025603560456055606560756085609561056115612561356145615561656175618561956205621562256235624562556265627562856295630563156325633563456355636563756385639564056415642564356445645564656475648564956505651565256535654565556565657565856595660566156625663566456655666566756685669567056715672567356745675567656775678567956805681568256835684568556865687568856895690569156925693569456955696569756985699570057015702570357045705570657075708570957105711571257135714571557165717571857195720572157225723572457255726572757285729573057315732573357345735573657375738573957405741574257435744574557465747574857495750575157525753575457555756575757585759576057615762576357645765576657675768576957705771577257735774577557765777577857795780578157825783578457855786578757885789579057915792579357945795579657975798579958005801580258035804580558065807580858095810581158125813581458155816581758185819582058215822582358245825582658275828582958305831583258335834583558365837583858395840584158425843584458455846584758485849585058515852585358545855585658575858585958605861586258635864586558665867586858695870587158725873587458755876587758785879588058815882588358845885588658875888588958905891589258935894589558965897589858995900590159025903590459055906590759085909591059115912591359145915591659175918591959205921592259235924592559265927592859295930593159325933593459355936593759385939594059415942594359445945594659475948594959505951595259535954595559565957595859595960596159625963596459655966596759685969597059715972597359745975597659775978597959805981598259835984598559865987598859895990599159925993599459955996599759985999600060016002600360046005600660076008600960106011601260136014601560166017601860196020602160226023602460256026602760286029603060316032603360346035603660376038603960406041604260436044604560466047604860496050605160526053605460556056605760586059606060616062606360646065606660676068606960706071607260736074607560766077607860796080608160826083608460856086608760886089609060916092609360946095609660976098609961006101610261036104610561066107610861096110611161126113611461156116611761186119612061216122612361246125612661276128612961306131613261336134613561366137613861396140614161426143614461456146614761486149615061516152615361546155615661576158615961606161616261636164616561666167616861696170617161726173617461756176617761786179618061816182618361846185618661876188618961906191619261936194619561966197619861996200620162026203620462056206620762086209621062116212621362146215621662176218621962206221622262236224622562266227622862296230623162326233623462356236623762386239624062416242624362446245624662476248624962506251625262536254625562566257625862596260626162626263626462656266626762686269627062716272627362746275627662776278627962806281628262836284628562866287628862896290629162926293629462956296629762986299630063016302630363046305630663076308630963106311631263136314631563166317631863196320632163226323632463256326632763286329633063316332633363346335633663376338633963406341634263436344634563466347634863496350635163526353635463556356635763586359636063616362636363646365636663676368636963706371637263736374637563766377637863796380638163826383638463856386638763886389639063916392639363946395639663976398639964006401640264036404640564066407640864096410641164126413641464156416641764186419642064216422642364246425642664276428642964306431643264336434643564366437643864396440644164426443644464456446644764486449645064516452645364546455645664576458645964606461646264636464646564666467646864696470647164726473647464756476647764786479648064816482648364846485648664876488648964906491649264936494649564966497649864996500650165026503650465056506650765086509651065116512651365146515651665176518651965206521652265236524652565266527652865296530653165326533653465356536653765386539654065416542654365446545654665476548654965506551655265536554655565566557655865596560656165626563656465656566656765686569657065716572657365746575657665776578657965806581658265836584658565866587658865896590659165926593659465956596659765986599660066016602660366046605660666076608660966106611661266136614661566166617661866196620662166226623662466256626662766286629663066316632663366346635663666376638663966406641664266436644664566466647664866496650665166526653665466556656665766586659666066616662666366646665666666676668666966706671667266736674667566766677667866796680668166826683668466856686668766886689669066916692669366946695669666976698669967006701670267036704670567066707670867096710671167126713671467156716671767186719672067216722672367246725672667276728672967306731673267336734673567366737673867396740674167426743674467456746674767486749675067516752675367546755675667576758675967606761676267636764676567666767676867696770677167726773677467756776677767786779678067816782678367846785678667876788678967906791679267936794679567966797679867996800680168026803680468056806680768086809681068116812681368146815681668176818681968206821682268236824682568266827682868296830683168326833683468356836683768386839684068416842684368446845684668476848684968506851685268536854685568566857685868596860686168626863686468656866686768686869687068716872687368746875687668776878687968806881688268836884688568866887688868896890689168926893689468956896689768986899690069016902690369046905690669076908690969106911691269136914691569166917691869196920692169226923692469256926692769286929693069316932693369346935693669376938693969406941694269436944694569466947694869496950695169526953695469556956695769586959696069616962696369646965696669676968696969706971697269736974697569766977697869796980698169826983698469856986698769886989699069916992699369946995699669976998699970007001700270037004700570067007700870097010701170127013701470157016701770187019702070217022702370247025702670277028702970307031703270337034703570367037703870397040704170427043704470457046704770487049705070517052705370547055705670577058705970607061706270637064706570667067706870697070707170727073707470757076707770787079708070817082708370847085708670877088708970907091709270937094709570967097709870997100710171027103710471057106710771087109711071117112711371147115711671177118711971207121712271237124712571267127712871297130713171327133713471357136713771387139714071417142714371447145714671477148714971507151715271537154715571567157715871597160716171627163716471657166716771687169717071717172717371747175717671777178717971807181718271837184718571867187718871897190719171927193719471957196719771987199720072017202720372047205720672077208720972107211721272137214721572167217721872197220722172227223722472257226722772287229723072317232723372347235723672377238723972407241724272437244724572467247724872497250725172527253725472557256725772587259726072617262726372647265726672677268726972707271727272737274727572767277727872797280728172827283728472857286728772887289729072917292729372947295729672977298729973007301730273037304730573067307730873097310731173127313731473157316731773187319732073217322732373247325732673277328732973307331733273337334733573367337733873397340734173427343734473457346734773487349735073517352735373547355735673577358735973607361736273637364736573667367736873697370737173727373737473757376737773787379738073817382738373847385738673877388738973907391739273937394739573967397739873997400740174027403740474057406740774087409741074117412741374147415741674177418741974207421742274237424742574267427742874297430743174327433743474357436743774387439744074417442744374447445744674477448744974507451745274537454745574567457745874597460746174627463746474657466746774687469747074717472747374747475747674777478747974807481748274837484748574867487748874897490749174927493749474957496749774987499750075017502750375047505750675077508750975107511751275137514751575167517751875197520752175227523752475257526752775287529753075317532753375347535753675377538753975407541754275437544754575467547754875497550755175527553755475557556755775587559756075617562756375647565756675677568756975707571757275737574757575767577757875797580758175827583758475857586758775887589759075917592759375947595759675977598759976007601760276037604760576067607760876097610761176127613761476157616761776187619762076217622762376247625762676277628762976307631763276337634763576367637763876397640764176427643764476457646764776487649765076517652765376547655765676577658765976607661766276637664766576667667766876697670767176727673767476757676767776787679768076817682768376847685768676877688768976907691769276937694769576967697769876997700770177027703770477057706770777087709771077117712771377147715771677177718771977207721772277237724772577267727772877297730773177327733773477357736773777387739774077417742774377447745774677477748774977507751775277537754775577567757775877597760776177627763776477657766776777687769777077717772777377747775777677777778777977807781778277837784778577867787778877897790779177927793779477957796779777987799780078017802780378047805780678077808780978107811781278137814781578167817781878197820782178227823782478257826782778287829783078317832783378347835783678377838783978407841784278437844784578467847784878497850785178527853785478557856785778587859786078617862786378647865786678677868786978707871787278737874787578767877787878797880788178827883788478857886788778887889789078917892789378947895789678977898789979007901790279037904790579067907790879097910791179127913791479157916791779187919792079217922792379247925792679277928792979307931793279337934793579367937793879397940794179427943794479457946794779487949795079517952795379547955795679577958795979607961796279637964796579667967796879697970797179727973797479757976797779787979798079817982798379847985798679877988798979907991799279937994799579967997799879998000800180028003800480058006800780088009801080118012801380148015801680178018801980208021802280238024802580268027802880298030803180328033803480358036803780388039804080418042804380448045804680478048804980508051805280538054805580568057805880598060806180628063806480658066806780688069807080718072807380748075807680778078807980808081808280838084808580868087808880898090809180928093809480958096809780988099810081018102810381048105810681078108810981108111811281138114811581168117811881198120812181228123812481258126812781288129813081318132813381348135813681378138813981408141814281438144814581468147814881498150815181528153815481558156815781588159816081618162816381648165816681678168816981708171817281738174817581768177817881798180818181828183818481858186818781888189819081918192819381948195819681978198819982008201820282038204820582068207820882098210821182128213821482158216821782188219822082218222822382248225822682278228822982308231823282338234823582368237823882398240824182428243824482458246824782488249825082518252825382548255825682578258825982608261826282638264826582668267826882698270827182728273827482758276827782788279828082818282828382848285828682878288828982908291829282938294829582968297829882998300830183028303830483058306830783088309831083118312831383148315831683178318831983208321832283238324832583268327832883298330833183328333833483358336833783388339834083418342834383448345834683478348834983508351835283538354835583568357835883598360836183628363836483658366836783688369837083718372837383748375837683778378837983808381838283838384838583868387838883898390839183928393839483958396839783988399840084018402840384048405840684078408840984108411841284138414841584168417841884198420842184228423842484258426842784288429843084318432843384348435843684378438843984408441844284438444844584468447844884498450845184528453845484558456845784588459846084618462846384648465846684678468846984708471847284738474847584768477847884798480848184828483848484858486848784888489849084918492849384948495849684978498849985008501850285038504850585068507850885098510851185128513851485158516851785188519852085218522852385248525852685278528852985308531853285338534853585368537853885398540854185428543854485458546854785488549855085518552855385548555855685578558855985608561856285638564856585668567856885698570857185728573857485758576857785788579858085818582858385848585858685878588858985908591859285938594859585968597859885998600860186028603860486058606860786088609861086118612861386148615861686178618861986208621862286238624862586268627862886298630863186328633863486358636863786388639864086418642864386448645864686478648864986508651865286538654865586568657865886598660866186628663866486658666866786688669867086718672867386748675867686778678867986808681868286838684868586868687868886898690869186928693869486958696869786988699870087018702870387048705870687078708870987108711871287138714871587168717871887198720872187228723872487258726872787288729873087318732873387348735873687378738873987408741874287438744874587468747874887498750875187528753875487558756875787588759876087618762876387648765876687678768876987708771877287738774877587768777877887798780878187828783878487858786878787888789879087918792879387948795879687978798879988008801880288038804880588068807880888098810881188128813881488158816881788188819882088218822882388248825882688278828882988308831883288338834883588368837883888398840884188428843884488458846884788488849885088518852885388548855885688578858885988608861886288638864886588668867886888698870887188728873887488758876887788788879888088818882888388848885888688878888888988908891889288938894889588968897889888998900890189028903890489058906890789088909891089118912891389148915891689178918891989208921892289238924892589268927892889298930893189328933893489358936893789388939894089418942894389448945894689478948894989508951895289538954895589568957895889598960896189628963896489658966896789688969897089718972897389748975897689778978897989808981898289838984898589868987898889898990899189928993899489958996899789988999900090019002900390049005900690079008900990109011901290139014901590169017901890199020902190229023902490259026902790289029903090319032903390349035903690379038903990409041904290439044904590469047904890499050905190529053905490559056905790589059906090619062906390649065906690679068906990709071907290739074907590769077907890799080908190829083908490859086908790889089909090919092909390949095909690979098909991009101910291039104910591069107910891099110911191129113911491159116911791189119912091219122912391249125912691279128912991309131913291339134913591369137913891399140914191429143914491459146914791489149915091519152915391549155915691579158915991609161916291639164916591669167916891699170917191729173917491759176917791789179918091819182918391849185918691879188918991909191919291939194919591969197919891999200920192029203920492059206920792089209921092119212921392149215921692179218921992209221922292239224922592269227922892299230923192329233923492359236923792389239924092419242924392449245924692479248924992509251925292539254925592569257925892599260926192629263926492659266926792689269927092719272927392749275927692779278927992809281928292839284928592869287928892899290929192929293929492959296929792989299930093019302930393049305930693079308930993109311931293139314931593169317931893199320932193229323932493259326932793289329933093319332933393349335933693379338933993409341934293439344934593469347934893499350935193529353935493559356935793589359936093619362936393649365936693679368936993709371937293739374937593769377937893799380938193829383938493859386938793889389939093919392939393949395939693979398939994009401940294039404940594069407940894099410941194129413941494159416941794189419942094219422942394249425942694279428942994309431943294339434943594369437943894399440944194429443944494459446944794489449945094519452945394549455945694579458945994609461946294639464946594669467946894699470947194729473947494759476947794789479948094819482948394849485948694879488948994909491949294939494949594969497949894999500950195029503950495059506950795089509951095119512951395149515951695179518951995209521952295239524952595269527952895299530953195329533953495359536953795389539954095419542954395449545954695479548954995509551955295539554955595569557955895599560956195629563956495659566956795689569957095719572957395749575957695779578957995809581958295839584958595869587958895899590959195929593959495959596959795989599960096019602960396049605960696079608960996109611961296139614961596169617961896199620962196229623962496259626962796289629963096319632963396349635963696379638963996409641964296439644964596469647964896499650965196529653965496559656965796589659966096619662966396649665966696679668966996709671967296739674967596769677967896799680968196829683968496859686968796889689969096919692969396949695969696979698969997009701970297039704970597069707970897099710971197129713971497159716971797189719972097219722972397249725972697279728972997309731973297339734973597369737973897399740974197429743974497459746974797489749975097519752975397549755975697579758975997609761976297639764976597669767976897699770977197729773977497759776977797789779978097819782978397849785978697879788978997909791979297939794979597969797979897999800980198029803980498059806980798089809981098119812981398149815981698179818981998209821982298239824982598269827982898299830983198329833983498359836983798389839984098419842984398449845984698479848984998509851985298539854985598569857985898599860986198629863986498659866986798689869987098719872987398749875987698779878987998809881988298839884988598869887988898899890989198929893989498959896989798989899990099019902990399049905990699079908990999109911991299139914991599169917991899199920992199229923992499259926992799289929993099319932993399349935993699379938993999409941994299439944994599469947994899499950995199529953995499559956995799589959996099619962996399649965996699679968996999709971997299739974997599769977997899799980998199829983998499859986998799889989999099919992999399949995999699979998999910000100011000210003100041000510006100071000810009100101001110012100131001410015100161001710018100191002010021100221002310024100251002610027100281002910030100311003210033100341003510036100371003810039100401004110042100431004410045100461004710048100491005010051100521005310054100551005610057100581005910060100611006210063100641006510066100671006810069100701007110072100731007410075100761007710078100791008010081 |
- {
- $Project$
- $Workfile$
- $Revision$
- $DateUTC$
- $Id$
- This file is part of the Indy (Internet Direct) project, and is offered
- under the dual-licensing agreement described on the Indy website.
- (http://www.indyproject.org/)
- Copyright:
- (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
- }
- {
- $Log$
- }
- {
- Rev 1.54 2/9/2005 8:45:38 PM JPMugaas
- Should work.
- Rev 1.53 2/8/05 6:37:38 PM RLebeau
- Added default value to ASize parameter of ReadStringFromStream()
- Rev 1.52 2/8/05 5:57:10 PM RLebeau
- added AppendString(), CopyTIdLongWord(), and CopyTIdString() functions
- Rev 1.51 1/31/05 6:01:40 PM RLebeau
- Renamed GetCurrentThreadHandle() to CurrentThreadId() and changed the return
- type from THandle to to TIdPID.
- Reworked conditionals for SetThreadName() and updated the implementation to
- support naming threads under DotNet.
- Rev 1.50 1/27/05 3:40:04 PM RLebeau
- Updated BytesToShort() to actually use the AIndex parameter that was added
- earlier.
- Rev 1.49 1/24/2005 7:35:36 PM JPMugaas
- Foxed ma,e om CopyTIdIPV6Address/
- Rev 1.48 1/17/2005 7:26:44 PM JPMugaas
- Made an IPv6 address byte copy function.
- Rev 1.47 1/15/2005 6:01:38 PM JPMugaas
- Removed some new procedures for extracting int values from a TIdBytes and
- made some other procedures have an optional index paramter.
- Rev 1.46 1/13/05 11:11:20 AM RLebeau
- Changed BytesToRaw() to pass TIdBytes by 'const' rather than by 'var'
- Rev 1.45 1/8/2005 3:56:58 PM JPMugaas
- Added routiens for copying integer values to and from TIdBytes. These are
- useful for some protocols.
- Rev 1.44 24/11/2004 16:26:24 ANeillans
- GetTickCount corrected, as per Paul Cooper's post in
- atozedsoftware.indy.general.
- Rev 1.43 11/13/04 10:47:28 PM RLebeau
- Fixed compiler errors
- Rev 1.42 11/12/04 1:02:42 PM RLebeau
- Added RawToBytesF() and BytesToRaw() functions
- Added asserts to BytesTo...() functions
- Rev 1.41 10/26/2004 8:20:02 PM JPMugaas
- Fixed some oversights with conversion. OOPS!!!
- Rev 1.40 10/26/2004 8:00:54 PM JPMugaas
- Now uses TIdStrings for DotNET portability.
- Rev 1.39 2004.10.26 7:35:16 PM czhower
- Moved IndyCat to CType in IdBaseComponent
- Rev 1.38 24/10/2004 21:29:52 ANeillans
- Corrected error in GetTickCount,
- was Result := Trunc(nTime / (Freq * 1000))
- should be Result := Trunc((nTime / Freq) * 1000)
- Rev 1.37 20/10/2004 01:08:20 CCostelloe
- Bug fix
- Rev 1.36 28.09.2004 20:36:58 Andreas Hausladen
- Works now with Delphi 5
- Rev 1.35 9/23/2004 11:36:04 PM DSiders
- Modified Ticks function (Win32) to correct RangeOverflow error. (Reported by
- Mike Potter)
- Rev 1.34 24.09.2004 02:16:04 Andreas Hausladen
- Added ReadTIdBytesFromStream and ReadCharFromStream function to supress .NET
- warnings.
- Rev 1.33 9/5/2004 2:55:00 AM JPMugaas
- function BytesToWord(const AValue: TIdBytes): Word; was not listed in the
- interface.
- Rev 1.32 04.09.2004 17:12:56 Andreas Hausladen
- New PosIdx function (without pointers)
- Rev 1.31 27.08.2004 22:02:20 Andreas Hausladen
- Speed optimization ("const" for string parameters)
- rewritten PosIdx function with AStartPos = 0 handling
- new ToArrayF() functions (faster in native code because the TIdBytes array
- must have the required len before the ToArrayF function is called)
- Rev 1.30 24.08.2004 19:48:28 Andreas Hausladen
- Some optimizations
- Removed IFDEF for IdDelete and IdInsert
- Rev 1.29 8/17/2004 2:54:08 PM JPMugaas
- Fix compiler warning about widening operends. Int64 can sometimes incur a
- performance penalty.
- Rev 1.28 8/15/04 5:57:06 PM RLebeau
- Tweaks to PosIdx()
- Rev 1.27 7/23/04 10:13:16 PM RLebeau
- Updated ReadStringFromStream() to resize the result using the actual number
- of bytes read from the stream
- Rev 1.26 7/18/2004 2:45:38 PM DSiders
- Added localization comments.
- Rev 1.25 7/9/04 4:25:20 PM RLebeau
- Renamed ToBytes(raw) to RawToBytes() to fix an ambiquity error with
- ToBytes(TIdBytes)
- Rev 1.24 7/9/04 4:07:06 PM RLebeau
- Compiler fix for TIdBaseStream.Write()
- Rev 1.23 09/07/2004 22:17:52 ANeillans
- Fixed IdGlobal.pas(761) Error: ';', ')' or '=' expected but ':=' found
- Rev 1.22 7/8/04 11:56:10 PM RLebeau
- Added additional parameters to BytesToString()
- Bug fix for ReadStringFromStream()
- Updated TIdBaseStream.Write() to use ToBytes()
- Rev 1.21 7/8/04 4:22:36 PM RLebeau
- Added ToBytes() overload for raw pointers under non-DotNet platfoms.
- Rev 1.20 2004.07.03 19:39:38 czhower
- UTF8
- Rev 1.19 6/15/2004 7:18:06 PM JPMugaas
- IdInsert for stuff needing to call the Insert procedure.
- Rev 1.18 2004.06.13 8:06:46 PM czhower
- .NET update
- Rev 1.17 6/11/2004 8:28:30 AM DSiders
- Added "Do not Localize" comments.
- Rev 1.16 2004.06.08 7:11:14 PM czhower
- Typo fix.
- Rev 1.15 2004.06.08 6:34:48 PM czhower
- .NET bug with Ticks workaround.
- Rev 1.14 07/06/2004 21:30:32 CCostelloe
- Kylix 3 changes
- Rev 1.13 5/3/04 12:17:44 PM RLebeau
- Updated ToBytes(string) and BytesToString() under DotNet to use
- System.Text.Encoding.ASCII instead of AnsiEncoding
- Rev 1.12 4/24/04 12:41:36 PM RLebeau
- Conversion support to/from TIdBytes for Char values
- Rev 1.11 4/18/04 2:45:14 PM RLebeau
- Conversion support to/from TIdBytes for Int64 values
- Rev 1.10 2004.04.08 4:50:06 PM czhower
- Comments
- Rev 1.9 2004.04.08 1:45:42 AM czhower
- tiny string optimization
- Rev 1.8 4/7/2004 3:20:50 PM JPMugaas
- PosIdx was not working in DotNET. In DotNET, it was returning a Pos value
- without adding the startvalue -1. It was throwing off the FTP list parsers.
- Two uneeded IFDEF's were removed.
- Rev 1.7 2004.03.13 5:51:28 PM czhower
- Fixed stack overflow in Sleep for .net
- Rev 1.6 3/6/2004 5:16:02 PM JPMugaas
- Bug 67 fixes. Do not write to const values.
- Rev 1.5 3/6/2004 4:54:12 PM JPMugaas
- Write to const bug fix.
- Rev 1.4 2/17/2004 12:02:44 AM JPMugaas
- A few routines that might be needed later for RFC 3490 support.
- Rev 1.3 2/16/2004 1:56:04 PM JPMugaas
- Moved some routines here to lay the groundwork for RFC 3490 support. Started
- work on RFC 3490 support.
- Rev 1.2 2/11/2004 5:12:30 AM JPMugaas
- Moved IPv6 address definition here.
- I also made a function for converting a TIdBytes to an IPv6 address.
- Rev 1.1 2004.02.03 3:15:52 PM czhower
- Updates to move to System.
- Rev 1.0 2004.02.03 2:28:30 PM czhower
- Move
- Rev 1.91 2/1/2004 11:16:04 PM BGooijen
- ToBytes
- Rev 1.90 2/1/2004 1:28:46 AM JPMugaas
- Disabled IdPort functionality in DotNET. It can't work there in it's current
- form and trying to get it to work will introduce more problems than it
- solves. It was only used by the bindings editor and we did something
- different in DotNET so IdPorts wouldn't used there.
- Rev 1.89 2004.01.31 1:51:10 AM czhower
- IndyCast for VB.
- Rev 1.88 30/1/2004 4:47:46 PM SGrobety
- Added "WriteMemoryStreamToStream" to take care of Win32/dotnet difference in
- the TMemoryStream.Memory type and the Write buffer parameter
- Rev 1.87 1/30/2004 11:59:24 AM BGooijen
- Added WriteTIdBytesToStream, because we can convert almost everything to
- TIdBytes, and TIdBytes couldn't be written to streams easily
- Rev 1.86 2004.01.27 11:44:36 PM czhower
- .Net Updates
- Rev 1.85 2004.01.27 8:15:54 PM czhower
- Fixed compile error + .net helper.
- Rev 1.84 27/1/2004 1:55:10 PM SGrobety
- TIdStringStream introduced to fix a bug in DOTNET TStringStream
- implementation.
- Rev 1.83 2004.01.27 1:42:00 AM czhower
- Added parameter check
- Rev 1.82 25/01/2004 21:55:40 CCostelloe
- Added portable IdFromBeginning/FromCurrent/FromEnd, to be used instead of
- soFromBeginning/soBeginning, etc.
- Rev 1.81 24/01/2004 20:18:46 CCostelloe
- Added IndyCompareStr (to be used in place of AnsiCompareStr for .NET
- compatibility)
- Rev 1.80 2004.01.23 9:56:30 PM czhower
- CharIsInSet now checks length and returns false if no character.
- Rev 1.79 2004.01.23 9:49:40 PM czhower
- CharInSet no longer accepts -1, was unneeded and redundant.
- Rev 1.78 1/22/2004 5:47:46 PM SPerry
- fixed CharIsInSet
- Rev 1.77 2004.01.22 5:33:46 PM czhower
- TIdCriticalSection
- Rev 1.76 2004.01.22 3:23:18 PM czhower
- IsCharInSet
- Rev 1.75 2004.01.22 2:00:14 PM czhower
- iif change
- Rev 1.74 14/01/2004 00:17:34 CCostelloe
- Added IndyLowerCase/IndyUpperCase to replace AnsiLowerCase/AnsiUpperCase for
- .NET code
- Rev 1.73 1/11/2004 9:50:54 PM BGooijen
- Added ToBytes function for Socks
- Rev 1.72 2003.12.31 7:32:40 PM czhower
- InMainThread now for .net too.
- Rev 1.71 2003.12.29 6:48:38 PM czhower
- TextIsSame
- Rev 1.70 2003.12.28 1:11:04 PM czhower
- Conditional typo fixed.
- Rev 1.69 2003.12.28 1:05:48 PM czhower
- .Net changes.
- Rev 1.68 5/12/2003 9:11:00 AM GGrieve
- Add WriteStringToStream
- Rev 1.67 5/12/2003 12:32:48 AM GGrieve
- fix DotNet warnings
- Rev 1.66 22/11/2003 12:03:02 AM GGrieve
- fix IdMultiPathFormData.pas implementation
- Rev 1.65 11/15/2003 1:15:36 PM VVassiliev
- Move AppendByte from IdDNSCommon to IdCoreGlobal
- Rev 1.64 10/28/2003 8:43:48 PM BGooijen
- compiles, and removed call to setstring
- Rev 1.63 2003.10.24 10:44:50 AM czhower
- IdStream implementation, bug fixes.
- Rev 1.62 10/18/2003 4:53:18 PM BGooijen
- Added ToHex
- Rev 1.61 2003.10.17 6:17:24 PM czhower
- Some parts moved to stream
- Rev 1.60 10/15/2003 8:28:16 PM DSiders
- Added localization comments.
- Rev 1.59 2003.10.14 9:27:12 PM czhower
- Fixed compile erorr with missing )
- Rev 1.58 10/14/2003 3:31:04 PM SPerry
- Modified ByteToHex() and IPv4ToHex
- Rev 1.57 10/13/2003 5:06:46 PM BGooijen
- Removed local constant IdOctalDigits in favor of the unit constant. - attempt
- 2
- Rev 1.56 10/13/2003 10:07:12 AM DSiders
- Reverted prior change; local constant for IdOctalDigits is restored.
- Rev 1.55 10/12/2003 11:55:42 AM DSiders
- Removed local constant IdOctalDigits in favor of the unit constant.
- Rev 1.54 2003.10.11 5:47:22 PM czhower
- -VCL fixes for servers
- -Chain suport for servers (Super core)
- -Scheduler upgrades
- -Full yarn support
- Rev 1.53 10/8/2003 10:14:34 PM GGrieve
- add WriteStringToStream
- Rev 1.52 10/8/2003 9:55:30 PM GGrieve
- Add IdDelete
- Rev 1.51 10/7/2003 11:33:30 PM GGrieve
- Fix ReadStringFromStream
- Rev 1.50 10/7/2003 10:07:30 PM GGrieve
- Get IdHTTP compiling for DotNet
- Rev 1.49 6/10/2003 5:48:48 PM SGrobety
- DotNet updates
- Rev 1.48 10/5/2003 12:26:46 PM BGooijen
- changed parameter names at some places
- Rev 1.47 10/4/2003 7:08:26 PM BGooijen
- added some conversion routines type->TIdBytes->type, and fixed existing ones
- Rev 1.46 10/4/2003 3:53:40 PM BGooijen
- added some ToBytes functions
- Rev 1.45 04/10/2003 13:38:28 HHariri
- Write(Integer) support
- Rev 1.44 10/3/2003 10:44:54 PM BGooijen
- Added WriteBytesToStream
- Rev 1.43 2003.10.02 8:29:14 PM czhower
- Changed names of byte conversion routines to be more readily understood and
- not to conflict with already in use ones.
- Rev 1.42 10/2/2003 5:15:16 PM BGooijen
- Added Grahame's functions
- Rev 1.41 10/1/2003 8:02:20 PM BGooijen
- Removed some ifdefs and improved code
- Rev 1.40 2003.10.01 9:10:58 PM czhower
- .Net
- Rev 1.39 2003.10.01 2:46:36 PM czhower
- .Net
- Rev 1.38 2003.10.01 2:30:36 PM czhower
- .Net
- Rev 1.37 2003.10.01 12:30:02 PM czhower
- .Net
- Rev 1.35 2003.10.01 1:12:32 AM czhower
- .Net
- Rev 1.34 2003.09.30 7:37:14 PM czhower
- Typo fix.
- Rev 1.33 30/9/2003 3:58:08 PM SGrobety
- More .net updates
- Rev 1.31 2003.09.30 3:19:30 PM czhower
- Updates for .net
- Rev 1.30 2003.09.30 1:22:54 PM czhower
- Stack split for DotNet
- Rev 1.29 2003.09.30 12:09:36 PM czhower
- DotNet changes.
- Rev 1.28 2003.09.30 10:36:02 AM czhower
- Moved stack creation to IdStack
- Added DotNet stack.
- Rev 1.27 9/29/2003 03:03:28 PM JPMugaas
- Changed CIL to DOTNET.
- Rev 1.26 9/28/2003 04:22:00 PM JPMugaas
- IFDEF'ed out MemoryPos in NET because that will not work there.
- Rev 1.25 9/26/03 11:20:50 AM RLebeau
- Updated defines used with SetThreadName() to allow it to work under BCB6.
- Rev 1.24 9/24/2003 11:42:42 PM JPMugaas
- Minor changes to help compile under NET
- Rev 1.23 2003.09.20 10:25:42 AM czhower
- Added comment and chaned for D6 compat.
- Rev 1.22 9/18/2003 07:43:12 PM JPMugaas
- Moved GetThreadHandle to IdGlobals so the ThreadComponent can be in this
- package.
- Rev 1.21 9/8/2003 11:44:38 AM JPMugaas
- Fix for problem that was introduced in an optimization.
- Rev 1.20 2003.08.19 1:54:34 PM czhower
- Removed warning
- Rev 1.19 11/8/2003 6:25:44 PM SGrobety
- IPv4ToDWord: Added overflow checking disabling ($Q+) and changed "* 256" by
- "SHL 8".
- Rev 1.18 2003.07.08 2:41:42 PM czhower
- This time I saved the file before checking in.
- Rev 1.16 7/1/2003 03:39:38 PM JPMugaas
- Started numeric IP function API calls for more efficiency.
- Rev 1.15 2003.07.01 3:49:56 PM czhower
- Added SetThreadName
- Rev 1.14 7/1/2003 12:03:56 AM BGooijen
- Added functions to switch between IPv6 addresses in string and in
- TIdIPv6Address form
- Rev 1.13 6/30/2003 06:33:58 AM JPMugaas
- Fix for range check error.
- Rev 1.12 6/27/2003 04:43:30 PM JPMugaas
- Made IPv4ToDWord overload that returns a flag for an error message.
- Moved MakeCanonicalIPv4Address code into IPv4ToDWord because most of that
- simply reduces IPv4 addresses into a DWord. That also should make the
- function more useful in reducing various alternative forms of IPv4 addresses
- down to DWords.
- Rev 1.11 6/27/2003 01:19:38 PM JPMugaas
- Added MakeCanonicalIPv4Address for converting various IPv4 address forms
- (mentioned at http://www.pc-help.org/obscure.htm) into a standard dotted IP
- address. Hopefully, we should soon support octal and hexidecimal addresses.
- Rev 1.9 6/27/2003 04:36:08 AM JPMugaas
- Function for converting DWord to IP adcdress.
- Rev 1.8 6/26/2003 07:54:38 PM JPMugaas
- Routines for converting standard dotted IPv4 addresses into dword,
- hexidecimal, and octal forms.
- Rev 1.7 5/11/2003 11:57:06 AM BGooijen
- Added RaiseLastOSError
- Rev 1.6 4/28/2003 03:19:00 PM JPMugaas
- Made a function for obtaining the services file FQN. That's in case
- something else besides IdPorts needs it.
- Rev 1.5 2003.04.16 10:06:42 PM czhower
- Moved DebugOutput to IdCoreGlobal
- Rev 1.4 12/29/2002 2:15:30 PM JPMugaas
- GetCurrentThreadHandle function created as per Bas's instructions. Moved
- THandle to IdCoreGlobal for this function.
- Rev 1.3 12-15-2002 17:02:58 BGooijen
- Added comments to TIdExtList
- Rev 1.2 12-15-2002 16:45:42 BGooijen
- Added TIdList
- Rev 1.1 29/11/2002 10:08:50 AM SGrobety Version: 1.1
- Changed GetTickCount to use high-performance timer if available under windows
- Rev 1.0 21/11/2002 12:36:18 PM SGrobety Version: Indy 10
- Rev 1.0 11/13/2002 08:41:24 AM JPMugaas
- }
- unit IdGlobal;
- interface
- {$I IdCompilerDefines.inc}
- uses
- SysUtils,
- {$IFDEF DOTNET}
- System.Collections.Specialized,
- System.net,
- System.net.Sockets,
- System.Diagnostics,
- System.Threading,
- System.IO,
- System.Text,
- {$ELSE}
- {$IFDEF HAS_UNIT_Generics_Collections}
- System.Generics.Collections,
- {$ENDIF}
- {$ENDIF}
- {$IFDEF WINDOWS}
- {$IFDEF FPC}
- windows,
- {$ELSE}
- Windows,
- {$ENDIF}
- {$ENDIF}
- Classes,
- syncobjs,
- {$IFDEF UNIX}
- {$IFDEF KYLIXCOMPAT}
- Libc,
- {$ELSE}
- {$IFDEF FPC}
- DynLibs, // better add DynLibs only for fpc
- {$ENDIF}
- {$IFDEF USE_VCL_POSIX}
- Posix.SysTypes, Posix.Pthread, Posix.Unistd,
- {$ENDIF}
- {$IFDEF USE_BASEUNIX}
- BaseUnix, Unix, Sockets, UnixType,
- {$ENDIF}
- {$IFDEF USE_ICONV_ENC}iconvenc, {$ENDIF}
- {$IFDEF USE_LCONVENC}LConvEncoding, {$ENDIF}
- {$ENDIF}
- {$IFDEF OSX}
- {$IFNDEF FPC}
- //RLebeau: FPC does not provide mach_timebase_info() and mach_absolute_time() yet...
- Macapi.Mach,
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- IdException;
- {$IFNDEF DOTNET}
- {$IFNDEF HAS_PCardinal}
- type
- PCardinal = ^Cardinal;
- {$ENDIF}
- {$ENDIF}
- {$IFDEF HAS_QWord}
- {$IFNDEF HAS_PQWord}
- type
- PQWord = ^QWord;
- {$ENDIF}
- {$ENDIF}
- {$IFNDEF HAS_Int8}
- type
- Int8 = {$IFDEF DOTNET}System.SByte{$ELSE}Shortint{$ENDIF};
- {$NODEFINE Int8}
- {$ENDIF}
- {$IFNDEF HAS_PInt8}
- {$IFNDEF DOTNET}
- type
- PInt8 = PShortint;
- {$NODEFINE PInt8}
- {$ENDIF}
- {$ENDIF}
- {$IFNDEF HAS_UInt8}
- type
- UInt8 = {$IFDEF DOTNET}System.Byte{$ELSE}Byte{$ENDIF};
- {$NODEFINE UInt8}
- {$ENDIF}
- {$IFNDEF HAS_PUInt8}
- {$IFNDEF DOTNET}
- type
- PUInt8 = PByte;
- {$NODEFINE PUInt8}
- {$ENDIF}
- {$ENDIF}
- {$IFNDEF HAS_Int16}
- type
- Int16 = Smallint;
- {$NODEFINE Int16}
- {$ENDIF}
- {$IFNDEF HAS_PInt16}
- {$IFNDEF DOTNET}
- type
- PInt16 = PSmallint;
- {$NODEFINE PInt16}
- {$ENDIF}
- {$ENDIF}
- {$IFNDEF HAS_UInt16}
- type
- UInt16 = Word;
- {$NODEFINE UInt16}
- {$ENDIF}
- {$IFNDEF HAS_PUInt16}
- {$IFNDEF DOTNET}
- type
- PUInt16 = PWord;
- {$NODEFINE PUInt16}
- {$ENDIF}
- {$ENDIF}
- {$IFNDEF HAS_Int32}
- type
- Int32 = Integer;
- {$NODEFINE Int32}
- {$ENDIF}
- {$IFNDEF HAS_PInt32}
- {$IFNDEF DOTNET}
- type
- PInt32 = PInteger;
- {$NODEFINE PInt32}
- {$ENDIF}
- {$ENDIF}
- {$IFNDEF HAS_UInt32}
- type
- UInt32 = Cardinal;
- {$NODEFINE UInt32}
- {$ENDIF}
- {$IFNDEF HAS_PUInt32}
- {$IFNDEF DOTNET}
- type
- PUInt32 = PCardinal;
- {$NODEFINE PUInt32}
- {$ENDIF}
- {$ENDIF}
- {$IFDEF HAS_UInt64}
- {$DEFINE UInt64_IS_NATIVE}
- // In C++Builder 2006 and 2007, UInt64 is emitted as signed __int64 in HPP
- // files instead of as unsigned __int64. This causes conflicts in overloaded
- // routines that have (U)Int64 parameters. This was fixed in C++Builder 2009...
- {$IFNDEF TIdUInt64_HAS_QuadPart}
- type
- TIdUInt64 = UInt64;
- {$ENDIF}
- {$ELSE}
- {$IFDEF HAS_QWord}
- {$DEFINE UInt64_IS_NATIVE}
- type
- UInt64 = QWord;
- {$NODEFINE UInt64}
- TIdUInt64 = QWord;
- {$ELSE}
- type
- UInt64 = Int64;
- {$NODEFINE UInt64}
- {$ENDIF}
- {$ENDIF}
- {$IFDEF HAS_UInt64}
- {$IFNDEF HAS_PUInt64}
- type
- PUInt64 = ^UInt64;
- {$ENDIF}
- {$ELSE}
- type
- PUInt64 = {$IFDEF HAS_QWord}PQWord{$ELSE}PInt64{$ENDIF};
- {$ENDIF}
- {$IFDEF TIdUInt64_HAS_QuadPart}
- // For compilers that do not have a native UInt64 type, or for C++Builder
- // 2006/2007 with its broken UInt64 HPP emit, let's define a record type
- // that can hold UInt64 values, and then use it wherever UInt64 parameters
- // are needed...
- type
- TIdUInt64 = packed record
- case Integer of
- 0: (
- {$IFDEF ENDIAN_BIG}
- HighPart: UInt32;
- LowPart: UInt32
- {$ELSE}
- LowPart: UInt32;
- HighPart: UInt32
- {$ENDIF}
- );
- 1: (
- QuadPart: UInt64
- );
- end;
- {$NODEFINE TIdUInt64}
- (*$HPPEMIT 'namespace Idglobal'*)
- (*$HPPEMIT '{'*)
- (*$HPPEMIT ' #pragma pack(push, 1)' *)
- (*$HPPEMIT ' struct TIdUInt64'*)
- (*$HPPEMIT ' {'*)
- (*$HPPEMIT ' union {'*)
- (*$HPPEMIT ' struct {'*)
- // TODO: move the endian check to the C++ side using #if...
- {$IFDEF ENDIAN_BIG}
- (*$HPPEMIT ' unsigned __int32 HighPart;'*)
- (*$HPPEMIT ' unsigned __int32 LowPart;'*)
- {$ELSE}
- (*$HPPEMIT ' unsigned __int32 LowPart;'*)
- (*$HPPEMIT ' unsigned __int32 HighPart;'*)
- {$ENDIF}
- (*$HPPEMIT ' };'*)
- (*$HPPEMIT ' unsigned __int64 QuadPart;'*)
- (*$HPPEMIT ' };'*)
- (*$HPPEMIT ' TIdUInt64(unsigned __int64 value) { QuadPart = value; }'*)
- (*$HPPEMIT ' operator unsigned __int64() const { return QuadPart; }'*)
- (*$HPPEMIT ' TIdUInt64& operator=(unsigned __int64 value) { QuadPart = value; return *this; }'*)
- (*$HPPEMIT ' };'*)
- (*$HPPEMIT ' #pragma pack(pop)' *)
- (*$HPPEMIT '}'*)
- {$ENDIF}
- const
- {This is the only unit with references to OS specific units and IFDEFs. NO OTHER units
- are permitted to do so except .pas files which are counterparts to dfm/xfm files, and only for
- support of that.}
- //We make the version things an Inc so that they can be managed independantly
- //by the package builder.
- {$I IdVers.inc}
- {$IFNDEF HAS_TIMEUNITS}
- HoursPerDay = 24;
- MinsPerHour = 60;
- SecsPerMin = 60;
- MSecsPerSec = 1000;
- MinsPerDay = HoursPerDay * MinsPerHour;
- SecsPerDay = MinsPerDay * SecsPerMin;
- MSecsPerDay = SecsPerDay * MSecsPerSec;
- {$ENDIF}
- {$IFDEF DOTNET}
- // Timeout.Infinite is -1 which violates Cardinal which VCL uses for parameter
- // so we are just setting it to this as a hard coded constant until
- // the synchro classes and other are all ported directly to portable classes
- // (SyncObjs is platform specific)
- //Infinite = Timeout.Infinite;
- INFINITE = UInt32($FFFFFFFF); { Infinite timeout }
- {$ENDIF}
- // FPC's DynLibs unit is not included in this unit's interface 'uses' clause on
- // all platforms, so map to what DynLibs.NilHandle maps to...
- {$IFDEF FPC}
- IdNilHandle = {DynLibs.NilHandle}{$IFDEF WINDOWS}PtrUInt(0){$ELSE}PtrInt(0){$ENDIF};
- {$ELSE}
- IdNilHandle = THandle(0);
- {$ENDIF}
- LF = #10;
- CR = #13;
- // RLebeau: EOL is NOT to be used as a platform-specific line break! Most
- // text-based protocols that Indy implements are defined to use CRLF line
- // breaks. DO NOT change this! If you need a platform-based line break,
- // use sLineBreak instead.
- EOL = CR + LF;
- //
- CHAR0 = #0;
- BACKSPACE = #8;
- TAB = #9;
- CHAR32 = #32;
- //Timeout values
- IdTimeoutDefault = -1;
- IdTimeoutInfinite = -2;
- //Fetch Defaults
- IdFetchDelimDefault = ' '; {Do not Localize}
- IdFetchDeleteDefault = True;
- IdFetchCaseSensitiveDefault = True;
- IdWhiteSpace = [0..12, 14..32]; {do not localize}
- IdHexDigits: array [0..15] of Char = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'); {do not localize}
- IdOctalDigits: array [0..7] of Char = ('0','1','2','3','4','5','6','7'); {do not localize}
- IdHexPrefix = '0x'; {Do not translate}
- type
- //thread and PID stuff
- {$IFDEF DOTNET}
- TIdPID = UInt32;
- TIdThreadId = UInt32;
- TIdThreadHandle = System.Threading.Thread;
- {$IFDEF DOTNETDISTRO}
- TIdThreadPriority = System.Threading.ThreadPriority;
- {$ELSE}
- TIdThreadPriority = TThreadPriority;
- {$ENDIF}
- {$ENDIF}
- {$IFDEF UNIX}
- {$IFDEF KYLIXCOMPAT}
- TIdPID = Int32;
- TIdThreadId = Int32;
- {$IFDEF FPC}
- TIdThreadHandle = TThreadID;
- {$ELSE}
- TIdThreadHandle = UInt32;
- {$ENDIF}
- {$IFDEF INT_THREAD_PRIORITY}
- TIdThreadPriority = -20..19;
- {$ELSE}
- TIdThreadPriority = TThreadPriority;
- {$ENDIF}
- {$ENDIF}
- {$IFDEF USE_BASEUNIX}
- TIdPID = TPid;
- TIdThreadId = TThreadId;
- TIdThreadHandle = TIdThreadId;
- TIdThreadPriority = TThreadPriority;
- {$ENDIF}
- {$IFDEF USE_VCL_POSIX}
- TIdPID = pid_t;
- TIdThreadId = NativeUInt;
- TIdThreadHandle = NativeUInt;
- {$IFDEF INT_THREAD_PRIORITY}
- TIdThreadPriority = -20..19;
- {$ELSE}
- TIdThreadPriority = TThreadPriority;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$IFDEF WINDOWS}
- TIdPID = UInt32;
- TIdThreadId = UInt32;
- TIdThreadHandle = THandle;
- {$I IdSymbolPlatformOff.inc}
- TIdThreadPriority = TThreadPriority;
- {$I IdSymbolPlatformOn.inc}
- {$ENDIF}
- TIdTicks = UInt64;
- {$IFDEF INT_THREAD_PRIORITY}
- const
- // approximate values, its finer grained on Linux
- tpIdle = 19;
- tpLowest = 12;
- tpLower = 6;
- tpNormal = 0;
- tpHigher = -7;
- tpHighest = -13;
- tpTimeCritical = -20;
- {$ENDIF}
- {CH tpIdLowest = tpLowest; }
- {CH tpIdBelowNormal = tpLower; }
- {CH tpIdNormal = tpNormal; }
- {CH tpIdAboveNormal = tpHigher; }
- {CH tpIdHighest = tpHighest; }
- //end thread stuff
- const
- //leave this as zero. It's significant in many socket calls that specify ports
- DEF_PORT_ANY = 0;
- type
- {$IFDEF DOTNET}
- TIdUnicodeString = System.String;
- {$ELSE}
- {$IFDEF HAS_UnicodeString}
- TIdUnicodeString = UnicodeString;
- {$ELSE}
- TIdUnicodeString = WideString;
- // RP 9/12/2014: Synopse just released a unit that patches the System unit
- // in pre-Unicode versions of Delphi to redirect WideString memory management
- // to the RTL's memory manager (FastMM, etc) instead of the Win32 COM API!
- //
- // http://blog.synopse.info/post/2014/09/12/Faster-WideString-process-for-good-old-non-Unicode-Delphi-6-2007
- // https://github.com/synopse/mORMot/blob/master/SynFastWideString.pas
- //
- // We should consider providing an optional setting to enable that patch
- // so we can get a performance boost for Unicode-enabled code that uses
- // TIdUnicodeString...
- {$ENDIF}
- {$ENDIF}
- // the Delphi next-gen compiler eliminates AnsiString/AnsiChar/PAnsiChar,
- // but we still need to deal with Ansi data. Unfortunately, the compiler
- // won't let us use its secret _AnsiChr types either, so we have to use
- // Byte instead unless we can find a better solution...
- {$IFDEF HAS_AnsiChar}
- TIdAnsiChar = AnsiChar;
- {$ELSE}
- TIdAnsiChar = Byte;
- {$ENDIF}
- {$IFDEF HAS_PAnsiChar}
- PIdAnsiChar = PAnsiChar;
- {$ELSE}
- {$IFDEF HAS_MarshaledAString}
- PIdAnsiChar = MarshaledAString;
- {$ELSE}
- PIdAnsiChar = PByte;
- {$ENDIF}
- {$ENDIF}
- {$IFDEF HAS_PPAnsiChar}
- PPIdAnsiChar = PPAnsiChar;
- {$ELSE}
- PPIdAnsiChar = ^PIdAnsiChar;
- {$ENDIF}
- {$IFDEF HAS_SetCodePage}
- {$IFNDEF HAS_PRawByteString}
- {$EXTERNALSYM PRawByteString}
- PRawByteString = ^RawByteString;
- {$ENDIF}
- {$ENDIF}
- {$IFDEF STRING_IS_UNICODE}
- TIdWideChar = Char;
- PIdWideChar = PChar;
- {$ELSE}
- TIdWideChar = WideChar;
- PIdWideChar = PWideChar;
- {$ENDIF}
- {$IFDEF WINDOWS}
- // .NET and Delphi 2009+ support UNICODE strings natively!
- //
- // FreePascal 2.4.0+ supports UnicodeString, but does not map its native
- // String type to UnicodeString except when {$MODE DelphiUnicode} or
- // {$MODESWITCH UnicodeStrings} is enabled. However, UNICODE is not
- // defined in that mode yet until FreePascal's RTL has been updated to
- // support UnicodeString. STRING_UNICODE_MISMATCH is defined in
- // IdCompilerDefines.inc when the compiler's native String/Char types do
- // not map to the same types that API functions are expecting based on
- // whether UNICODE is defined or not. So we will create special Platform
- // typedefs here to help with API function calls when dealing with that
- // mismatch...
- {$IFDEF UNICODE}
- TIdPlatformString = TIdUnicodeString;
- TIdPlatformChar = TIdWideChar;
- PIdPlatformChar = PIdWideChar;
- {$ELSE}
- TIdPlatformString = AnsiString;
- TIdPlatformChar = TIdAnsiChar;
- PIdPlatformChar = PIdAnsiChar;
- {$ENDIF}
- {$ENDIF}
- TIdBytes = array of Byte;
- TIdWideChars = array of TIdWideChar;
- //NOTE: The code below assumes a 32bit Linux architecture (such as target i386-linux)
- {$UNDEF CPU32_OR_KYLIX}
- {$IFNDEF DOTNET}
- {$IFDEF CPU32}
- {$DEFINE CPU32_OR_KYLIX}
- {$ENDIF}
- {$IFDEF KYLIX}
- {$DEFINE CPU32_OR_KYLIX}
- {$ENDIF}
- {$ENDIF}
- // native signed and unsigned integer sized pointer types
- {$IFDEF DOTNET}
- TIdNativeInt = IntPtr;
- TIdNativeUInt = UIntPtr;
- {$ELSE}
- {$IFDEF HAS_NativeInt}
- TIdNativeInt = NativeInt;
- {$ELSE}
- {$IFDEF CPU32}
- TIdNativeInt = Int32;
- {$ENDIF}
- {$IFDEF CPU64}
- TIdNativeInt = Int64;
- {$ENDIF}
- {$ENDIF}
- {$IFDEF HAS_NativeUInt}
- TIdNativeUInt = NativeUInt;
- {$ELSE}
- {$IFDEF CPU32}
- TIdNativeUInt = UInt32;
- {$ENDIF}
- {$IFDEF CPU64}
- TIdNativeUInt = UInt64;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$IFNDEF HAS_PtrInt}
- PtrInt = TIdNativeInt;
- {$ENDIF}
- {$IFNDEF HAS_PtrUInt}
- PtrUInt = TIdNativeUInt;
- {$ENDIF}
- {$IFDEF STREAM_SIZE_64}
- TIdStreamSize = Int64;
- {$ELSE}
- TIdStreamSize = Int32;
- {$ENDIF}
- {$IFNDEF HAS_SIZE_T}
- {$EXTERNALSYM size_t}
- size_t = PtrUInt;
- {$ENDIF}
- {$IFNDEF HAS_PSIZE_T}
- {$EXTERNALSYM Psize_t}
- Psize_t = ^size_t;
- {$ENDIF}
- // RLebeau 12/1/2018: FPC's System unit defines an HMODULE type as a PtrUInt. But,
- // the DynLibs unit defines its own HModule type that is a TLibHandle, which is a
- // PtrInt instead. And to make matters worse, although FPC's System.THandle is a
- // platform-dependant type, it is not always defined as 8 bytes on 64bit platforms
- // (https://bugs.freepascal.org/view.php?id=21669), which has been known to cause
- // overflows when dynamic libraries are loaded at high addresses! (FPC bug?) So,
- // we can't rely on THandle to hold correct handles for libraries that we load
- // dynamically at runtime (which is probably why FPC defines TLibHandle in the first
- // place, but why is it signed instead of unsigned?).
- //
- // Delphi's HMODULE is a System.THandle, which is a NativeUInt, and so is defined
- // with a proper byte size across all 32bit and 64bit platforms.
- //
- // Since (Safe)LoadLibrary(), GetProcAddress(), etc all use TLibHandle in FPC, but
- // use HMODULE in Delphi. this does mean we have a small descrepency between using
- // signed vs unsigned library handles. I would prefer to use unsigned everywhere,
- // but we should use what is more natural for each compiler...
- // FPC's DynLibs unit is not included in this unit's interface 'uses' clause on all
- // platforms, so map to what DynLibs.TLibHandle maps to...
- // RLebeau 4/29/2020: to make metters worse, FPC defines TLibHandle as System.THandle
- // on Windows, not as PtrInt as previously observed! And FPC's Windows.GetProcAddress()
- // uses HINST, which is also defined as System.THandle. But, as we know from above,
- // FPC's System.THandle has problems on some 64bit systems! But does that apply on
- // Windows? I THINK the latest FPC uses QWord/DWord (aka PtrUInt) for all Windows
- // platforms, which is good...
- {$IFDEF FPC}
- // TODO: use the THANDLE_(32|64|CPUBITS) defines in IdCompilerDefines.inc to decide
- // how to define TIdLibHandle when not using the DynLibs unit?
- TIdLibHandle = {DynLibs.TLibHandle}{$IFDEF WINDOWS}PtrUInt{$ELSE}PtrInt{$ENDIF};
- {$ELSE}
- TIdLibHandle = THandle;
- {$ENDIF}
- { IMPORTANT!!!
- WindowsCE only has a Unicode (WideChar) version of GetProcAddress. We could use
- a version of GetProcAddress in the FreePascal dynlibs unit but that does a
- conversion from ASCII to Unicode which might not be necessary since most calls
- pass a constant anyway.
- }
- {$IFDEF WINCE}
- TIdLibFuncName = TIdUnicodeString;
- PIdLibFuncNameChar = PWideChar;
- {$ELSE}
- TIdLibFuncName = String;
- PIdLibFuncNameChar = PChar;
- {$ENDIF}
- {$IFDEF STRING_IS_IMMUTABLE}
- // In .NET and Delphi next-gen, strings are immutable (and zero-indexed), so we
- // need to use a StringBuilder whenever we need to modify individual characters
- // of a string...
- TIdStringBuilder = {$IFDEF DOTNET}System.Text.StringBuilder{$ELSE}TStringBuilder{$ENDIF};
- {$ENDIF}
- {
- Delphi/C++Builder 2009+ have a TEncoding class which mirrors System.Text.Encoding
- in .NET, but does not have a TDecoder class which mirrors System.Text.Decoder
- in .NET. TEncoding's interface changes from version to version, in some ways
- that cause compatibility issues when trying to write portable code, so we will
- not rely on it. IIdTextEncoding is our own wrapper so we have control over
- text encodings.
- This way, Indy can have a unified internal interface for String<->Byte conversions
- without using IFDEFs everywhere.
- Note: Having the wrapper class use WideString in earlier versions adds extra
- overhead to string operations, but this is the only way to ensure that strings
- are encoded properly. Later on, perhaps we can optimize the operations when
- Ansi-compatible encodings are being used with AnsiString values.
- }
- {$IFNDEF HAS_IInterface}
- IInterface = IUnknown;
- {$ENDIF}
- IIdTextEncoding = interface(IInterface)
- ['{FA87FAE5-E3E3-4632-8FCA-2FB786848655}']
- function GetByteCount(const AChars: TIdWideChars): Integer; overload;
- function GetByteCount(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): Integer; overload;
- {$IFNDEF DOTNET}
- function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; overload;
- {$ENDIF}
- function GetByteCount(const AStr: TIdUnicodeString): Integer; overload;
- function GetByteCount(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): Integer; overload;
- function GetBytes(const AChars: TIdWideChars): TIdBytes; overload;
- function GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): TIdBytes; overload;
- function GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
- {$IFNDEF DOTNET}
- function GetBytes(const AChars: PIdWideChar; ACharCount: Integer): TIdBytes; overload;
- function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
- function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; overload;
- {$ENDIF}
- function GetBytes(const AStr: TIdUnicodeString): TIdBytes; overload;
- function GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): TIdBytes; overload;
- function GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
- function GetCharCount(const ABytes: TIdBytes): Integer; overload;
- function GetCharCount(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): Integer; overload;
- {$IFNDEF DOTNET}
- function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; overload;
- {$ENDIF}
- function GetChars(const ABytes: TIdBytes): TIdWideChars; overload;
- function GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdWideChars; overload;
- function GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer; overload;
- {$IFNDEF DOTNET}
- function GetChars(const ABytes: PByte; AByteCount: Integer): TIdWideChars; overload;
- function GetChars(const ABytes: PByte; AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer; overload;
- function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; overload;
- {$ENDIF}
- function GetIsSingleByte: Boolean;
- function GetMaxByteCount(ACharCount: Integer): Integer;
- function GetMaxCharCount(AByteCount: Integer): Integer;
- function GetPreamble: TIdBytes;
- function GetString(const ABytes: TIdBytes): TIdUnicodeString; overload;
- function GetString(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdUnicodeString; overload;
- {$IFNDEF DOTNET}
- function GetString(const ABytes: PByte; AByteCount: Integer): TIdUnicodeString; overload;
- {$ENDIF}
- property IsSingleByte: Boolean read GetIsSingleByte;
- end;
- IdTextEncodingType = (encIndyDefault, encOSDefault, enc8Bit, encASCII, encUTF16BE, encUTF16LE, encUTF7, encUTF8);
- function IndyTextEncoding(AType: IdTextEncodingType): IIdTextEncoding; overload;
- function IndyTextEncoding(ACodepage: UInt16): IIdTextEncoding; overload;
- function IndyTextEncoding(const ACharSet: String): IIdTextEncoding; overload;
- {$IFDEF DOTNET}
- function IndyTextEncoding(AEncoding: System.Text.Encoding): IIdTextEncoding; overload;
- {$ENDIF}
- {$IFDEF HAS_TEncoding}
- function IndyTextEncoding(AEncoding: TEncoding; AFreeEncoding: Boolean = False): IIdTextEncoding; overload;
- {$ENDIF}
- function IndyTextEncoding_Default: IIdTextEncoding;
- function IndyTextEncoding_OSDefault: IIdTextEncoding;
- function IndyTextEncoding_8Bit: IIdTextEncoding;
- function IndyTextEncoding_ASCII: IIdTextEncoding;
- function IndyTextEncoding_UTF16BE: IIdTextEncoding;
- function IndyTextEncoding_UTF16LE: IIdTextEncoding;
- function IndyTextEncoding_UTF7: IIdTextEncoding;
- function IndyTextEncoding_UTF8: IIdTextEncoding;
- // These are for backwards compatibility with past Indy 10 releases
- function enDefault: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_Default() or a nil IIdTextEncoding pointer'{$ENDIF};{$ENDIF}
- {$NODEFINE enDefault}
- function en7Bit: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_ASCII()'{$ENDIF};{$ENDIF}
- {$NODEFINE en7Bit}
- function en8Bit: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_8Bit()'{$ENDIF};{$ENDIF}
- {$NODEFINE en8Bit}
- function enUTF8: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_UTF8()'{$ENDIF};{$ENDIF}
- {$NODEFINE enUTF8}
- function Indy8BitEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_8Bit()'{$ENDIF};{$ENDIF}
- function IndyASCIIEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_ASCII()'{$ENDIF};{$ENDIF}
- function IndyUTF16BigEndianEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_UTF16BE()'{$ENDIF};{$ENDIF}
- function IndyUTF16LittleEndianEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_UTF16LE()'{$ENDIF};{$ENDIF}
- function IndyOSDefaultEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_OSDefault()'{$ENDIF};{$ENDIF}
- function IndyUTF7Encoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_UTF7()'{$ENDIF};{$ENDIF}
- function IndyUTF8Encoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_UTF8()'{$ENDIF};{$ENDIF}
- (*$HPPEMIT '// These are helper macros to handle differences between C++Builder versions'*)
- (*$HPPEMIT '#define TIdTextEncoding_ASCII IndyTextEncoding_ASCII()'*)
- (*$HPPEMIT '#define TIdTextEncoding_BigEndianUnicode IndyTextEncoding_UTF16BE()'*)
- (*$HPPEMIT '#define TIdTextEncoding_Default IndyTextEncoding_OSDefault()'*)
- (*$HPPEMIT '#define TIdTextEncoding_Unicode IndyTextEncoding_UTF16LE()'*)
- (*$HPPEMIT '#define TIdTextEncoding_UTF7 IndyTextEncoding_UTF7()'*)
- (*$HPPEMIT '#define TIdTextEncoding_UTF8 IndyTextEncoding_UTF8()'*)
- (*$HPPEMIT ''*)
- (*$HPPEMIT '// These are for backwards compatibility with earlier Indy 10 releases'*)
- (*$HPPEMIT '#define enDefault ( ( IIdTextEncoding* )NULL )'*)
- (*$HPPEMIT '#define en8Bit IndyTextEncoding_8Bit()'*)
- (*$HPPEMIT '#define en7Bit IndyTextEncoding_ASCII()'*)
- (*$HPPEMIT '#define enUTF8 IndyTextEncoding_UTF8()'*)
- (*$HPPEMIT ''*)
- var
- {RLebeau: using ASCII by default because most Internet protocols that Indy
- implements are based on ASCII specifically, not Ansi. Non-ASCII data has
- to be explicitally allowed by RFCs, in which case the caller should not be
- using nil IIdTextEncoding objects to begin with...}
- GIdDefaultTextEncoding: IdTextEncodingType = encASCII;
- {$IFDEF USE_ICONV}
- // This indicates whether encOSDefault should map to an OS dependant Ansi
- // locale or to ASCII. Defaulting to ASCII for now to maintain compatibility
- // with earlier Indy 10 releases...
- GIdIconvUseLocaleDependantAnsiEncoding: Boolean = False;
- // This indicates whether Iconv should ignore characters that cannot be
- // converted. Defaulting to false for now to maintain compatibility with
- // earlier Indy 10 releases...
- GIdIconvIgnoreIllegalChars: Boolean = False;
- // This indicates whether Iconv should transliterate characters that cannot
- // be converted. Defaulting to false for now to maintain compatibility with
- // earlier Indy 10 releases...
- GIdIconvUseTransliteration: Boolean = False;
- {$ENDIF}
- procedure EnsureEncoding(var VEncoding : IIdTextEncoding; ADefEncoding: IdTextEncodingType = encIndyDefault);
- procedure CheckByteEncoding(var VBytes: TIdBytes; ASrcEncoding, ADestEncoding: IIdTextEncoding);
- {$IFNDEF DOTNET}
- function GetEncodingCodePage(AEncoding: IIdTextEncoding): UInt16;
- {$ENDIF}
- type
- TIdAppendFileStream = class(TFileStream)
- public
- constructor Create(const AFile : String);
- end;
- TIdReadFileExclusiveStream = class(TFileStream)
- public
- constructor Create(const AFile : String);
- end;
- TIdReadFileNonExclusiveStream = class(TFileStream)
- public
- constructor Create(const AFile : String);
- end;
- TIdFileCreateStream = class(TFileStream)
- public
- constructor Create(const AFile : String);
- end;
- {$IFDEF DOTNET}
- {$IFNDEF DOTNET_2_OR_ABOVE}
- // dotNET implementation
- TWaitResult = (wrSignaled, wrTimeout, wrAbandoned, wrError);
- TEvent = class(TObject)
- protected
- FEvent: WaitHandle;
- public
- constructor Create(EventAttributes: IntPtr; ManualReset,
- InitialState: Boolean; const Name: string = ''); overload;
- constructor Create; overload;
- destructor Destroy; override;
- procedure SetEvent;
- procedure ResetEvent;
- function WaitFor(Timeout: UInt32): TWaitResult; virtual;
- end;
- TCriticalSection = class(TObject)
- public
- procedure Acquire; virtual;
- procedure Release; virtual;
- function TryEnter: Boolean;
- procedure Enter;
- procedure Leave;
- end;
- {$ENDIF}
- {$ELSE}
- {$IFNDEF NO_REDECLARE}
- // TCriticalSection = SyncObjs.TCriticalSection;
- {$ENDIF}
- {$ENDIF}
- TIdLocalEvent = class(TEvent)
- public
- constructor Create(const AInitialState: Boolean = False;
- const AManualReset: Boolean = False); reintroduce;
- function WaitForEver: TWaitResult; overload;
- end;
- // This is here to reduce all the warnings about imports. We may also ifdef
- // it to provide a non warning implementatino on this unit too later.
- TIdCriticalSection = class(TCriticalSection)
- end;
- //Only needed for ToBytes(Short) and BytesToShort
- {$IFDEF DOTNET}
- Short = System.Int16 {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use Int16'{$ENDIF}{$ENDIF};
- {$ENDIF}
- {$IFDEF UNIX}
- Short = Int16 {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use Int16'{$ENDIF}{$ENDIF};
- {$ENDIF}
- {$IFNDEF DOTNET}
- {$IFNDEF NO_REDECLARE}
- PShort = ^Short;
- {$ENDIF}
- {$ENDIF}
- //This usually is a property editor exception
- EIdCorruptServicesFile = class(EIdException);
- EIdEndOfStream = class(EIdException);
- EIdInvalidIPv6Address = class(EIdException);
- EIdNoEncodingSpecified = class(EIdException);
- //This is called whenever there is a failure to retreive the time zone information
- EIdFailedToRetreiveTimeZoneInfo = class(EIdException);
- TIdPort = UInt16;
- //We don't have a native type that can hold an IPv6 address.
- {$NODEFINE TIdIPv6Address}
- TIdIPv6Address = array [0..7] of UInt16;
- // C++ does not allow an array to be returned by a function,
- // so wrapping the array in a struct as a workaround...
- //
- // This is one place where Word is being used instead of UInt16.
- // On OSX/iOS, UInt16 is defined in mactypes.h, not in System.hpp!
- // don't want to use a bunch of IFDEF's trying to figure out where
- // UInt16 is coming from...
- //
- (*$HPPEMIT 'namespace Idglobal'*)
- (*$HPPEMIT '{'*)
- (*$HPPEMIT ' struct TIdIPv6Address'*)
- (*$HPPEMIT ' {'*)
- (*$HPPEMIT ' ::System::Word data[8];'*)
- (*$HPPEMIT ' ::System::Word& operator[](int index) { return data[index]; }'*)
- (*$HPPEMIT ' const ::System::Word& operator[](int index) const { return data[index]; }'*)
- (*$HPPEMIT ' operator const ::System::Word*() const { return data; }'*)
- (*$HPPEMIT ' operator ::System::Word*() { return data; }'*)
- (*$HPPEMIT ' };'*)
- (*$HPPEMIT '}'*)
- {This way instead of a boolean for future expansion of other actions}
- TIdMaxLineAction = (maException, maSplit);
- TIdOSType = (otUnknown, otUnix, otWindows, otDotNet);
- //This is for IPv6 support when merged into the core
- TIdIPVersion = (Id_IPv4, Id_IPv6);
- {$IFNDEF NO_REDECLARE}
- {$IFDEF LINUX}
- {$IFNDEF VCL_6_OR_ABOVE}
- THandle = UInt32; //D6.System
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$IFDEF DOTNET}
- THandle = Int32;
- {$ELSE}
- {$IFDEF WINDOWS}
- // THandle = Windows.THandle;
- {$ENDIF}
- {$ENDIF}
- TPosProc = function(const substr, str: String): Integer;
- {$IFNDEF DOTNET}
- TStrScanProc = function(Str: PChar; Chr: Char): PChar;
- {$ENDIF}
- TIdReuseSocket = (rsOSDependent, rsTrue, rsFalse);
- {$IFNDEF STREAM_SIZE_64}
- type
- TSeekOrigin = (soBeginning, soCurrent, soEnd);
- {$ENDIF}
- // TIdBaseStream is defined here to allow TIdMultiPartFormData to be defined
- // without any $IFDEFs in the unit IdMultiPartFormData - in accordance with Indy Coding rules
- TIdBaseStream = class(TStream)
- protected
- function IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint; virtual; abstract;
- function IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint; virtual; abstract;
- function IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; virtual; abstract;
- procedure IdSetSize(ASize: Int64); virtual; abstract;
- {$IFDEF DOTNET}
- procedure SetSize(ASize: Int64); override;
- {$ELSE}
- {$IFDEF STREAM_SIZE_64}
- procedure SetSize(const NewSize: Int64); override;
- {$ELSE}
- procedure SetSize(ASize: Integer); override;
- {$ENDIF}
- {$ENDIF}
- public
- {$IFDEF DOTNET}
- function Read(var VBuffer: array of Byte; AOffset, ACount: Longint): Longint; override;
- function Write(const ABuffer: array of Byte; AOffset, ACount: Longint): Longint; override;
- function Seek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; override;
- {$ELSE}
- function Read(var Buffer; Count: Longint): Longint; override;
- function Write(const Buffer; Count: Longint): Longint; override;
- {$IFDEF STREAM_SIZE_64}
- function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
- {$ELSE}
- function Seek(Offset: Longint; Origin: Word): Longint; override;
- {$ENDIF}
- {$ENDIF}
- end;
- TIdCalculateSizeStream = class(TIdBaseStream)
- protected
- FPosition: Int64;
- FSize: Int64;
- function IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint; override;
- function IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint; override;
- function IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; override;
- procedure IdSetSize(ASize: Int64); override;
- end;
- TIdStreamReadEvent = procedure(var VBuffer: TIdBytes; AOffset, ACount: Longint; var VResult: Longint) of object;
- TIdStreamWriteEvent = procedure(const ABuffer: TIdBytes; AOffset, ACount: Longint; var VResult: Longint) of object;
- TIdStreamSeekEvent = procedure(const AOffset: Int64; AOrigin: TSeekOrigin; var VPosition: Int64) of object;
- TIdStreamSetSizeEvent = procedure(const ANewSize: Int64) of object;
- TIdEventStream = class(TIdBaseStream)
- protected
- FOnRead: TIdStreamReadEvent;
- FOnWrite: TIdStreamWriteEvent;
- FOnSeek: TIdStreamSeekEvent;
- FOnSetSize: TIdStreamSetSizeEvent;
- function IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint; override;
- function IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint; override;
- function IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; override;
- procedure IdSetSize(ASize: Int64); override;
- public
- property OnRead: TIdStreamReadEvent read FOnRead write FOnRead;
- property OnWrite: TIdStreamWriteEvent read FOnWrite write FOnWrite;
- property OnSeek: TIdStreamSeekEvent read FOnSeek write FOnSeek;
- property OnSetSize: TIdStreamSetSizeEvent read FOnSetSize write FOnSetSize;
- end;
- {$IFNDEF DOTNET} // what is the .NET equivilent?
- TIdMemoryBufferStream = class(TCustomMemoryStream)
- public
- constructor Create(APtr: Pointer; ASize: TIdNativeInt);
- function Write(const Buffer; Count: Longint): Longint; override;
- end;
- TIdReadOnlyMemoryBufferStream = class(TIdMemoryBufferStream)
- public
- function Write(const Buffer; Count: Longint): Longint; override;
- end;
- {$ENDIF}
- const
- {$IFDEF UNIX}
- GOSType = otUnix;
- GPathDelim = '/'; {do not localize}
- INFINITE = UInt32($FFFFFFFF); { Infinite timeout }
- {$ENDIF}
- {$IFDEF WINDOWS}
- GOSType = otWindows;
- GPathDelim = '\'; {do not localize}
- Infinite = Windows.INFINITE; { redeclare here for use elsewhere without using Windows.pas } // cls modified 1/23/2002
- {$ENDIF}
- {$IFDEF DOTNET}
- GOSType = otDotNet;
- GPathDelim = '\'; {do not localize}
- // Infinite = ?; { redeclare here for use elsewhere without using Windows.pas } // cls modified 1/23/2002
- {$ENDIF}
- // S.G. 4/9/2002: IP version general switch for defaults
- {$IFDEF IdIPv6}
- ID_DEFAULT_IP_VERSION = Id_IPv6;
- {$ELSE}
- ID_DEFAULT_IP_VERSION = Id_IPv4;
- {$ENDIF}
- {$IFNDEF HAS_sLineBreak}
- {$IFDEF WINDOWS}
- sLineBreak = CR + LF;
- {$ELSE}
- sLineBreak = LF;
- {$ENDIF}
- {$ENDIF}
- //The power constants are for processing IP addresses
- //They are powers of 255.
- const
- POWER_1 = $000000FF;
- POWER_2 = $0000FFFF;
- POWER_3 = $00FFFFFF;
- POWER_4 = $FFFFFFFF;
- // utility functions to calculate the usable length of a given buffer.
- // If ALength is <0 then the actual Buffer length is returned,
- // otherwise the minimum of the two lengths is returned instead.
- function IndyLength(const ABuffer: String; const ALength: Integer = -1; const AIndex: Integer = 1): Integer; overload;
- function IndyLength(const ABuffer: TIdBytes; const ALength: Integer = -1; const AIndex: Integer = 0): Integer; overload;
- function IndyLength(const ABuffer: TStream; const ALength: TIdStreamSize = -1): TIdStreamSize; overload;
- function IndyFormat(const AFormat: string; const Args: array of const): string;
- function IndyIncludeTrailingPathDelimiter(const S: string): string;
- function IndyExcludeTrailingPathDelimiter(const S: string): string;
- procedure IndyRaiseLastError;
- // This can only be called inside of an 'except' block! This is so that
- // Exception.RaiseOuterException() (when available) can capture the current
- // exception into the InnerException property of a new Exception that is
- // being raised...
- procedure IndyRaiseOuterException(AOuterException: Exception);
- //You could possibly use the standard StrInt and StrIntDef but these
- //also remove spaces from the string using the trim functions.
- function IndyStrToInt(const S: string): Integer; overload;
- function IndyStrToInt(const S: string; ADefault: Integer): Integer; overload;
- function IndyFileAge(const AFileName: string): TDateTime;
- function IndyDirectoryExists(const ADirectory: string): Boolean;
- //You could possibly use the standard StrToInt and StrToInt64Def
- //functions but these also remove spaces using the trim function
- function IndyStrToInt64(const S: string; const ADefault: Int64): Int64; overload;
- function IndyStrToInt64(const S: string): Int64; overload;
- //This converts the string to an Integer or Int64 depending on the bit size TStream uses
- function IndyStrToStreamSize(const S: string; const ADefault: TIdStreamSize): TIdStreamSize; overload;
- function IndyStrToStreamSize(const S: string): TIdStreamSize; overload;
- function AddMSecToTime(const ADateTime: TDateTime; const AMSec: Integer): TDateTime;
- // To and From Bytes conversion routines
- function ToBytes(const AValue: string; ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ): TIdBytes; overload;
- function ToBytes(const AValue: string; const ALength: Integer; const AIndex: Integer = 1;
- ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ): TIdBytes; overload;
- function ToBytes(const AValue: Char; ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ): TIdBytes; overload;
- function ToBytes(const AValue: Int8): TIdBytes; overload;
- function ToBytes(const AValue: UInt8): TIdBytes; overload;
- function ToBytes(const AValue: Int16): TIdBytes; overload;
- function ToBytes(const AValue: UInt16): TIdBytes; overload;
- function ToBytes(const AValue: Int32): TIdBytes; overload;
- function ToBytes(const AValue: UInt32): TIdBytes; overload;
- function ToBytes(const AValue: Int64): TIdBytes; overload;
- function ToBytes(const AValue: TIdUInt64): TIdBytes; overload;
- function ToBytes(const AValue: TIdBytes; const ASize: Integer; const AIndex: Integer = 0): TIdBytes; overload;
- {$IFNDEF DOTNET}
- // RLebeau - not using the same "ToBytes" naming convention for RawToBytes()
- // in order to prevent ambiquious errors with ToBytes(TIdBytes) above
- function RawToBytes(const AValue; const ASize: Integer): TIdBytes;
- {$ENDIF}
- // The following functions are faster but except that Bytes[] must have enough
- // space for at least SizeOf(AValue) bytes.
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: Char; ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ); overload;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int8); overload;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: UInt8); overload;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int16); overload;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: UInt16); overload;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int32); overload;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: UInt32); overload;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int64); overload;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: TIdUInt64); overload;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: TIdBytes; const ASize: Integer; const AIndex: Integer = 0); overload;
- {$IFNDEF DOTNET}
- // RLebeau - not using the same "ToBytesF" naming convention for RawToBytesF()
- // in order to prevent ambiquious errors with ToBytesF(TIdBytes) above
- procedure RawToBytesF(var Bytes: TIdBytes; const AValue; const ASize: Integer);
- {$ENDIF}
- function ToHex(const AValue: TIdBytes; const ACount: Integer = -1; const AIndex: Integer = 0): string; overload;
- function ToHex(const AValue: array of UInt32): string; overload; // for IdHash
- function BytesToString(const AValue: TIdBytes; AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): string; overload;
- function BytesToString(const AValue: TIdBytes; const AStartIndex: Integer;
- const ALength: Integer = -1; AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): string; overload;
- // BytesToStringRaw() differs from BytesToString() in that it stores the
- // byte octets as-is, whereas BytesToString() may decode character encodings
- function BytesToStringRaw(const AValue: TIdBytes): string; overload;
- function BytesToStringRaw(const AValue: TIdBytes; const AStartIndex: Integer;
- const ALength: Integer = -1): string; overload;
- function BytesToChar(const AValue: TIdBytes; const AIndex: Integer = 0;
- AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): Char; overload;
- function BytesToChar(const AValue: TIdBytes; var VChar: Char; const AIndex: Integer = 0;
- AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): Integer; overload;
- function BytesToInt16(const AValue: TIdBytes; const AIndex: Integer = 0): Int16;
- function BytesToUInt16(const AValue: TIdBytes; const AIndex : Integer = 0): UInt16;
- function BytesToInt32(const AValue: TIdBytes; const AIndex: Integer = 0): Int32;
- function BytesToUInt32(const AValue: TIdBytes; const AIndex : Integer = 0): UInt32;
- function BytesToInt64(const AValue: TIdBytes; const AIndex: Integer = 0): Int64;
- function BytesToUInt64(const AValue: TIdBytes; const AIndex: Integer = 0): TIdUInt64;
- function BytesToShort(const AValue: TIdBytes; const AIndex: Integer = 0): Int16; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use BytesToInt16()'{$ENDIF};{$ENDIF}
- function BytesToWord(const AValue: TIdBytes; const AIndex : Integer = 0): UInt16; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use BytesToUInt16()'{$ENDIF};{$ENDIF}
- function BytesToLongInt(const AValue: TIdBytes; const AIndex: Integer = 0): Int32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use BytesToInt32()'{$ENDIF};{$ENDIF}
- function BytesToLongWord(const AValue: TIdBytes; const AIndex : Integer = 0): UInt32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use BytesToUInt32()'{$ENDIF};{$ENDIF}
- function BytesToIPv4Str(const AValue: TIdBytes; const AIndex: Integer = 0): String;
- procedure BytesToIPv6(const AValue: TIdBytes; var VAddress: TIdIPv6Address; const AIndex: Integer = 0);
- function BytesToTicks(const AValue: TIdBytes; const AIndex: Integer = 0): TIdTicks;
- {$IFNDEF DOTNET}
- procedure BytesToRaw(const AValue: TIdBytes; var VBuffer; const ASize: Integer);
- {$ENDIF}
- // TIdBytes utilities
- procedure AppendBytes(var VBytes: TIdBytes; const AToAdd: TIdBytes; const AIndex: Integer = 0; const ALength: Integer = -1);
- procedure AppendByte(var VBytes: TIdBytes; const AByte: Byte);
- procedure AppendString(var VBytes: TIdBytes; const AStr: String; const ALength: Integer = -1;
- ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- );
- procedure ExpandBytes(var VBytes: TIdBytes; const AIndex: Integer; const ACount: Integer; const AFillByte: Byte = 0);
- procedure InsertBytes(var VBytes: TIdBytes; const ADestIndex: Integer; const ASource: TIdBytes; const ASourceIndex: Integer = 0);
- procedure InsertByte(var VBytes: TIdBytes; const AByte: Byte; const AIndex: Integer);
- procedure RemoveBytes(var VBytes: TIdBytes; const ACount: Integer; const AIndex: Integer = 0);
- // Common Streaming routines
- function ReadLnFromStream(AStream: TStream; var VLine: String; AMaxLineLength: Integer = -1;
- AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): Boolean; overload;
- function ReadLnFromStream(AStream: TStream; AMaxLineLength: Integer = -1;
- AExceptionIfEOF: Boolean = False; AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): string; overload;
- function ReadStringFromStream(AStream: TStream; ASize: Integer = -1; AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): string; overload;
- procedure WriteStringToStream(AStream: TStream; const AStr: string; ADestEncoding: IIdTextEncoding
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ); overload;
- procedure WriteStringToStream(AStream: TStream; const AStr: string; const ALength: Integer = -1;
- const AIndex: Integer = 1; ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ); overload;
- function ReadCharFromStream(AStream: TStream; var VChar: Char; AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): Integer;
- function ReadTIdBytesFromStream(const AStream: TStream; var ABytes: TIdBytes;
- const Count: TIdStreamSize; const AIndex: Integer = 0): TIdStreamSize;
- procedure WriteTIdBytesToStream(const AStream: TStream; const ABytes: TIdBytes;
- const ASize: Integer = -1; const AIndex: Integer = 0);
- function ByteToHex(const AByte: Byte): string;
- function ByteToOctal(const AByte: Byte): string;
- function UInt32ToHex(const ALongWord : UInt32) : String;
- function LongWordToHex(const ALongWord : UInt32) : String; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use UInt32ToHex()'{$ENDIF};{$ENDIF}
- procedure CopyTIdBytes(const ASource: TIdBytes; const ASourceIndex: Integer;
- var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer);
- procedure CopyTIdByteArray(const ASource: array of Byte; const ASourceIndex: Integer;
- var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer);
- procedure CopyTIdChar(const ASource: Char; var VDest: TIdBytes; const ADestIndex: Integer;
- ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- );
- procedure CopyTIdInt16(const ASource: Int16; var VDest: TIdBytes; const ADestIndex: Integer);
- procedure CopyTIdUInt16(const ASource: UInt16; var VDest: TIdBytes; const ADestIndex: Integer);
- procedure CopyTIdInt32(const ASource: Int32; var VDest: TIdBytes; const ADestIndex: Integer);
- procedure CopyTIdUInt32(const ASource: UInt32; var VDest: TIdBytes; const ADestIndex: Integer);
- procedure CopyTIdInt64(const ASource: Int64; var VDest: TIdBytes; const ADestIndex: Integer);
- procedure CopyTIdUInt64(const ASource: TIdUInt64; var VDest: TIdBytes; const ADestIndex: Integer);
- procedure CopyTIdShort(const ASource: Int16; var VDest: TIdBytes; const ADestIndex: Integer); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use CopyTIdInt16()'{$ENDIF};{$ENDIF}
- procedure CopyTIdWord(const ASource: UInt16; var VDest: TIdBytes; const ADestIndex: Integer); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use CopyTIdUInt16()'{$ENDIF};{$ENDIF}
- procedure CopyTIdLongInt(const ASource: Int32; var VDest: TIdBytes; const ADestIndex: Integer); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use CopyTIdInt32()'{$ENDIF};{$ENDIF}
- procedure CopyTIdLongWord(const ASource: UInt32; var VDest: TIdBytes; const ADestIndex: Integer); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use CopyTIdUInt32()'{$ENDIF};{$ENDIF}
- procedure CopyTIdIPV6Address(const ASource: TIdIPv6Address; var VDest: TIdBytes; const ADestIndex: Integer);
- procedure CopyTIdTicks(const ASource: TIdTicks; var VDest: TIdBytes; const ADestIndex: Integer);
- procedure CopyTIdString(const ASource: String; var VDest: TIdBytes; const ADestIndex: Integer;
- const ALength: Integer = -1; ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ); overload;
- procedure CopyTIdString(const ASource: String; const ASourceIndex: Integer;
- var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer = -1;
- ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ); overload;
- // Need to change prob not to use this set
- function CharPosInSet(const AString: string; const ACharPos: Integer; const ASet: String): Integer; {$IFDEF STRING_IS_IMMUTABLE}overload;{$ENDIF}
- function CharIsInSet(const AString: string; const ACharPos: Integer; const ASet: String): Boolean; {$IFDEF STRING_IS_IMMUTABLE}overload;{$ENDIF}
- function CharIsInEOL(const AString: string; const ACharPos: Integer): Boolean; {$IFDEF STRING_IS_IMMUTABLE}overload;{$ENDIF}
- function CharEquals(const AString: string; const ACharPos: Integer; const AValue: Char): Boolean; {$IFDEF STRING_IS_IMMUTABLE}overload;{$ENDIF}
- {$IFDEF STRING_IS_IMMUTABLE}
- function CharPosInSet(const ASB: TIdStringBuilder; const ACharPos: Integer; const ASet: String): Integer; overload;
- function CharIsInSet(const ASB: TIdStringBuilder; const ACharPos: Integer; const ASet: String): Boolean; overload;
- function CharIsInEOL(const ASB: TIdStringBuilder; const ACharPos: Integer): Boolean; overload;
- function CharEquals(const ASB: TIdStringBuilder; const ACharPos: Integer; const AValue: Char): Boolean; overload;
- {$ENDIF}
- function ByteIndex(const AByte: Byte; const ABytes: TIdBytes; const AStartIndex: Integer = 0): Integer;
- function ByteIdxInSet(const ABytes: TIdBytes; const AIndex: Integer; const ASet: TIdBytes): Integer;
- function ByteIsInSet(const ABytes: TIdBytes; const AIndex: Integer; const ASet: TIdBytes): Boolean;
- function ByteIsInEOL(const ABytes: TIdBytes; const AIndex: Integer): Boolean;
- function CompareDate(const D1, D2: TDateTime): Integer;
- function CurrentProcessId: TIdPID;
- // RLebeau: the input of these functions must be in GMT
- function DateTimeGMTToHttpStr(const GMTValue: TDateTime) : String;
- function DateTimeGMTToCookieStr(const GMTValue: TDateTime; const AUseNetscapeFmt: Boolean = True) : String;
- function DateTimeGMTToImapStr(const GMTValue: TDateTime) : String;
- // RLebeau: the input of these functions must be in local time
- function DateTimeToInternetStr(const Value: TDateTime; const AUseGMTStr: Boolean = False) : String; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use LocalDateTimeToGMT()'{$ENDIF};{$ENDIF}
- function DateTimeToGmtOffSetStr(ADateTime: TDateTime; const AUseGMTStr: Boolean = False): string; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use UTCOffsetToStr()'{$ENDIF};{$ENDIF}
- function LocalDateTimeToHttpStr(const Value: TDateTime) : String;
- function LocalDateTimeToCookieStr(const Value: TDateTime; const AUseNetscapeFmt: Boolean = True) : String;
- function LocalDateTimeToImapStr(const Value: TDateTime) : String;
- function LocalDateTimeToGMT(const Value: TDateTime; const AUseGMTStr: Boolean = False) : String;
- procedure DebugOutput(const AText: string);
- function Fetch(var AInput: string; const ADelim: string = IdFetchDelimDefault;
- const ADelete: Boolean = IdFetchDeleteDefault;
- const ACaseSensitive: Boolean = IdFetchCaseSensitiveDefault): string;
- function FetchCaseInsensitive(var AInput: string; const ADelim: string = IdFetchDelimDefault;
- const ADelete: Boolean = IdFetchDeleteDefault): string;
- // TODO: add an index parameter
- procedure FillBytes(var VBytes : TIdBytes; const ACount : Integer; const AValue : Byte);
- function CurrentThreadId: TIdThreadID;
- function GetThreadHandle(AThread: TThread): TIdThreadHandle;
- //GetTickDiff required because GetTickCount will wrap (IdICMP uses this)
- function GetTickDiff(const AOldTickCount, ANewTickCount: UInt32): UInt32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use GetTickDiff64()'{$ENDIF};{$ENDIF}
- function GetTickDiff64(const AOldTickCount, ANewTickCount: TIdTicks): TIdTicks;
- // Most operations that use tick counters will never run anywhere near the
- // 49.7 day limit that UInt32 imposes. If an operation really were to
- // run that long, use GetElapsedTicks64()...
- function GetElapsedTicks(const AOldTickCount: TIdTicks): UInt32;
- function GetElapsedTicks64(const AOldTickCount: TIdTicks): TIdTicks;
- procedure IdDelete(var s: string; AOffset, ACount: Integer);
- procedure IdInsert(const Source: string; var S: string; Index: Integer);
- {$IFNDEF DOTNET}
- type
- // TODO: use "array of Integer" instead?
- {$IFDEF HAS_GENERICS_TList}
- TIdPortList = TList<Integer>; // TODO: use TIdPort instead?
- {$ELSE}
- // TODO: flesh out to match TList<Integer> for non-Generics compilers
- TIdPortList = TList;
- {$ENDIF}
- function IdPorts: TIdPortList;
- {$ENDIF}
- function iif(ATest: Boolean; const ATrue: Integer; const AFalse: Integer): Integer; overload;
- function iif(ATest: Boolean; const ATrue: string; const AFalse: string = ''): string; overload; { do not localize }
- function iif(ATest: Boolean; const ATrue: Boolean; const AFalse: Boolean): Boolean; overload;
- function iif(const AEncoding, ADefEncoding: IIdTextEncoding; ADefEncodingType: IdTextEncodingType = encASCII): IIdTextEncoding; overload;
- function InMainThread: Boolean;
- function IPv6AddressToStr(const AValue: TIdIPv6Address): string;
- //Note that there is NO need for Big Endian byte order functions because
- //that's done through HostToNetwork byte order functions.
- function HostToLittleEndian(const AValue : UInt16) : UInt16; overload;
- function HostToLittleEndian(const AValue : UInt32): UInt32; overload;
- function HostToLittleEndian(const AValue : Int32): Int32; overload;
- function LittleEndianToHost(const AValue : UInt16) : UInt16; overload;
- function LittleEndianToHost(const AValue : UInt32): UInt32; overload;
- function LittleEndianToHost(const AValue : Int32): Int32; overload;
- procedure WriteMemoryStreamToStream(Src: TMemoryStream; Dest: TStream; Count: TIdStreamSize);
- {$IFNDEF DOTNET_EXCLUDE}
- function IsCurrentThread(AThread: TThread): boolean;
- {$ENDIF}
- function IPv4ToUInt32(const AIPAddress: string): UInt32; overload;
- function IPv4ToUInt32(const AIPAddress: string; var VErr: Boolean): UInt32; overload;
- function IPv4ToDWord(const AIPAddress: string): UInt32; overload; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IPv4ToUInt32()'{$ENDIF};{$ENDIF}
- function IPv4ToDWord(const AIPAddress: string; var VErr: Boolean): UInt32; overload; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IPv4ToUInt32()'{$ENDIF};{$ENDIF}
- function IPv4ToHex(const AIPAddress: string; const ADotted: Boolean = False): string;
- function IPv4ToOctal(const AIPAddress: string): string;
- procedure IPv6ToIdIPv6Address(const AIPAddress: String; var VAddress: TIdIPv6Address); overload;
- procedure IPv6ToIdIPv6Address(const AIPAddress: String; var VAddress: TIdIPv6Address; var VErr : Boolean); overload;
- function IsAlpha(const AChar: Char): Boolean; overload;
- function IsAlpha(const AString: String; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean; overload;
- function IsAlphaNumeric(const AChar: Char): Boolean; overload;
- function IsAlphaNumeric(const AString: String; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean; overload;
- function IsASCII(const AByte: Byte): Boolean; overload;
- function IsASCII(const ABytes: TIdBytes): Boolean; overload;
- function IsASCIILDH(const AByte: Byte): Boolean; overload;
- function IsASCIILDH(const ABytes: TIdBytes): Boolean; overload;
- function IsHexidecimal(const AChar: Char): Boolean; overload;
- function IsHexidecimal(const AString: string; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean; overload;
- function IsNumeric(const AChar: Char): Boolean; overload;
- function IsNumeric(const AString: string): Boolean; overload;
- function IsNumeric(const AString: string; const ALength: Integer; const AIndex: Integer = 1): Boolean; overload;
- function IsOctal(const AChar: Char): Boolean; overload;
- function IsOctal(const AString: string; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean; overload;
- {$IFNDEF DOTNET}
- function InterlockedExchangeTHandle(var VTarget: THandle; const AValue: THandle): THandle;
- function InterlockedExchangeTLibHandle(var VTarget: TIdLibHandle; const AValue: TIdLibHandle): TIdLibHandle;
- function InterlockedCompareExchangePtr(var VTarget: Pointer; const AValue, Compare: Pointer): Pointer;
- function InterlockedCompareExchangeObj(var VTarget: TObject; const AValue, Compare: TObject): TObject;
- function InterlockedCompareExchangeIntf(var VTarget: IInterface; const AValue, Compare: IInterface): IInterface;
- {$ENDIF}
- function MakeCanonicalIPv4Address(const AAddr: string): string;
- function MakeCanonicalIPv6Address(const AAddr: string): string;
- function MakeUInt32IntoIPv4Address(const ADWord: UInt32): string;
- function MakeDWordIntoIPv4Address(const ADWord: UInt32): string; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use MakeUInt32IntoIPv4Address()'{$ENDIF};{$ENDIF}
- function IndyMin(const AValueOne, AValueTwo: Int64): Int64; overload;
- function IndyMin(const AValueOne, AValueTwo: Int32): Int32; overload;
- function IndyMin(const AValueOne, AValueTwo: UInt16): UInt16; overload;
- function IndyMax(const AValueOne, AValueTwo: Int64): Int64; overload;
- function IndyMax(const AValueOne, AValueTwo: Int32): Int32; overload;
- function IndyMax(const AValueOne, AValueTwo: UInt16): UInt16; overload;
- function IPv4MakeUInt32InRange(const AInt: Int64; const A256Power: Integer): UInt32;
- function IPv4MakeLongWordInRange(const AInt: Int64; const A256Power: Integer): UInt32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IPv4MakeUInt32InRange()'{$ENDIF};{$ENDIF}
- {$IFDEF REGISTER_EXPECTED_MEMORY_LEAK}
- function IndyRegisterExpectedMemoryLeak(AAddress: Pointer): Boolean;
- {$ENDIF}
- function LoadLibFunction(const ALibHandle: TIdLibHandle; const AProcName: TIdLibFuncName): Pointer;
- {$IFDEF UNIX}
- function HackLoad(const ALibName : String; const ALibVersions : array of String) : TIdLibHandle;
- {$ENDIF}
- {$IFNDEF DOTNET}
- function MemoryPos(const ASubStr: string; MemBuff: PChar; MemorySize: Integer): Integer;
- {$ENDIF}
- // TODO: have OffsetFromUTC() return minutes as an integer instead, and
- // then use DateUtils.IncMinutes() when adding the offset to a TDateTime...
- function OffsetFromUTC: TDateTime;
- function UTCOffsetToStr(const AOffset: TDateTime; const AUseGMTStr: Boolean = False): string;
- function LocalTimeToUTCTime(const Value: TDateTime): TDateTime;
- function UTCTimeToLocalTime(const Value: TDateTime): TDateTime;
- function PosIdx(const ASubStr, AStr: string; AStartPos: UInt32 = 0): UInt32; //For "ignoreCase" use AnsiUpperCase
- function PosInSmallIntArray(const ASearchInt: Int16; const AArray: array of Int16): Integer;
- function PosInStrArray(const SearchStr: string; const Contents: array of string; const CaseSensitive: Boolean = True): Integer;
- {$IFNDEF DOTNET}
- function ServicesFilePath: string;
- {$ENDIF}
- procedure IndySetThreadPriority(AThread: TThread; const APriority: TIdThreadPriority; const APolicy: Integer = -MaxInt);
- procedure SetThreadName(const AName: string; {$IFDEF DOTNET}AThread: System.Threading.Thread = nil{$ELSE}AThreadID: UInt32 = $FFFFFFFF{$ENDIF});
- procedure IndySleep(ATime: UInt32);
- // TODO: create TIdStringPositionList for non-Nextgen compilers...
- {$IFDEF USE_OBJECT_ARC}
- type
- TIdStringPosition = record
- Value: String;
- Position: Integer;
- constructor Create(const AValue: String; const APosition: Integer);
- end;
- TIdStringPositionList = TList<TIdStringPosition>;
- {$ENDIF}
- //For non-Nextgen compilers: Integer(TStrings.Objects[i]) = column position in AData
- //For Nextgen compilers: use SplitDelimitedString() if column positions are needed
- procedure SplitColumnsNoTrim(const AData: string; AStrings: TStrings; const ADelim: string = ' '); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use SplitDelimitedString()'{$ENDIF};{$ENDIF} {Do not Localize}
- procedure SplitColumns(const AData: string; AStrings: TStrings; const ADelim: string = ' '); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use SplitDelimitedString()'{$ENDIF};{$ENDIF} {Do not Localize}
- procedure SplitDelimitedString(const AData: string; AStrings: TStrings; ATrim: Boolean; const ADelim: string = ' '{$IFNDEF USE_OBJECT_ARC}; AIncludePositions: Boolean = False{$ENDIF}); {$IFDEF USE_OBJECT_ARC}overload;{$ENDIF} {Do not Localize}
- {$IFDEF USE_OBJECT_ARC}
- procedure SplitDelimitedString(const AData: string; AStrings: TIdStringPositionList; ATrim: Boolean; const ADelim: string = ' '); overload; {Do not Localize}
- {$ENDIF}
- function StartsWithACE(const ABytes: TIdBytes): Boolean;
- function StringsReplace(const S: String; const OldPattern, NewPattern: array of string): string;
- function ReplaceAll(const S, OldPattern, NewPattern: string): string;
- function ReplaceOnlyFirst(const S, OldPattern, NewPattern: string): string;
- function TextIsSame(const A1, A2: string): Boolean;
- function TextStartsWith(const S, SubS: string): Boolean;
- function TextEndsWith(const S, SubS: string): Boolean;
- function IndyUpperCase(const A1: string): string;
- function IndyLowerCase(const A1: string): string;
- function IndyCompareStr(const A1: string; const A2: string): Integer;
- function Ticks: UInt32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use Ticks64()'{$ENDIF};{$ENDIF}
- function Ticks64: TIdTicks;
- procedure ToDo(const AMsg: string);
- function TwoByteToUInt16(AByte1, AByte2: Byte): UInt16;
- function TwoByteToWord(AByte1, AByte2: Byte): UInt16; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use TwoByteToUInt16()'{$ENDIF};{$ENDIF}
- function IndyAddPair(AStrings: TStrings; const AName, AValue: String): TStrings; overload;
- function IndyAddPair(AStrings: TStrings; const AName, AValue: String; AObject: TObject): TStrings; overload;
- function IndyIndexOf(AStrings: TStrings; const AStr: string; const ACaseSensitive: Boolean = False): Integer;{$IFDEF HAS_TStringList_CaseSensitive} overload;{$ENDIF}
- {$IFDEF HAS_TStringList_CaseSensitive}
- function IndyIndexOf(AStrings: TStringList; const AStr: string; const ACaseSensitive: Boolean = False): Integer; overload;
- {$ENDIF}
- function IndyIndexOfName(AStrings: TStrings; const AName: string; const ACaseSensitive: Boolean = False): Integer;{$IFDEF HAS_TStringList_CaseSensitive} overload;{$ENDIF}
- {$IFDEF HAS_TStringList_CaseSensitive}
- function IndyIndexOfName(AStrings: TStringList; const AName: string; const ACaseSensitive: Boolean = False): Integer; overload;
- {$ENDIF}
- function IndyValueFromIndex(AStrings: TStrings; const AIndex: Integer): String;
- {$IFDEF WINDOWS}
- function IndyWindowsMajorVersion: Integer;
- function IndyWindowsMinorVersion: Integer;
- function IndyWindowsBuildNumber: Integer;
- function IndyWindowsPlatform: Integer;
- function IndyCheckWindowsVersion(const AMajor: Integer; const AMinor: Integer = 0): Boolean;
- {$ENDIF}
- // For non-Nextgen compilers: IdDisposeAndNil is the same as FreeAndNil()
- // For Nextgen compilers: IdDisposeAndNil calls TObject.DisposeOf() to ensure
- // the object is freed immediately even if it has active references to it,
- // for instance when freeing an Owned component
- // Embarcadero changed the signature of FreeAndNil() in 10.4 Denali:
- // procedure FreeAndNil(const [ref] Obj: TObject); inline;
- // TODO: Change the signature of IdDisposeAndNil() to match FreeAndNil() in 10.4+...
- procedure IdDisposeAndNil(var Obj); {$IFDEF USE_INLINE}inline;{$ENDIF}
- //RLebeau: FPC does not provide mach_timebase_info() and mach_absolute_time() yet...
- {$IFDEF UNIX}
- {$IFDEF OSX}
- {$IFDEF FPC}
- type
- TTimebaseInfoData = record
- numer: UInt32;
- denom: UInt32;
- end;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- var
- {$IFDEF UNIX}
- // For linux the user needs to set this variable to be accurate where used (mail, etc)
- GOffsetFromUTC: TDateTime = 0{$IFDEF HAS_DEPRECATED}{$IFDEF USE_SEMICOLON_BEFORE_DEPRECATED};{$ENDIF} deprecated{$ENDIF};
- {$IFDEF OSX}
- GMachTimeBaseInfo: TTimebaseInfoData;
- {$ENDIF}
- {$ENDIF}
- IndyPos: TPosProc = nil;
- {$IFDEF UNIX}
- {$UNDEF OSX_OR_IOS}
- {$IFDEF OSX}
- {$DEFINE OSX_OR_IOS}
- {$ENDIF}
- {$IFDEF IOS}
- {$DEFINE OSX_OR_IOS}
- {$ENDIF}
- {$ENDIF}
- {$IFDEF UNIX}
- const
- {$IFDEF HAS_SharedSuffix}
- LIBEXT = '.' + SharedSuffix; {do not localize}
- {$ELSE}
- {$IFDEF OSX_OR_IOS}
- LIBEXT = '.dylib'; {do not localize}
- {$ELSE}
- LIBEXT = '.so'; {do not localize}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- implementation
- {$IFDEF UNIX}
- {$IFDEF LINUX}
- {$DEFINE USE_clock_gettime}
- {$IFDEF FPC}
- {$linklib rt}
- {$ENDIF}
- {$ENDIF}
- {$IFDEF FREEBSD}
- {$DEFINE USE_clock_gettime}
- {$ENDIF}
- {$ENDIF}
- {$IFDEF ANDROID}
- {$DEFINE USE_clock_gettime}
- {$ENDIF}
- uses
- {$IFDEF USE_VCL_POSIX}
- Posix.SysSelect,
- Posix.SysSocket,
- Posix.Time,
- Posix.SysTime,
- {$ENDIF}
- {$IFDEF USE_VCL_POSIX}
- {$IFDEF OSX}
- Macapi.CoreServices,
- {$ENDIF}
- {$ENDIF}
- {$IFDEF REGISTER_EXPECTED_MEMORY_LEAK}
- {$IFNDEF HAS_System_RegisterExpectedMemoryLeak}
- {$IFDEF USE_FASTMM4}FastMM4,{$ENDIF}
- {$IFDEF USE_MADEXCEPT}madExcept,{$ENDIF}
- {$IFDEF USE_LEAKCHECK}LeakCheck,{$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$IFDEF USE_LIBC}Libc,{$ENDIF}
- {$IFDEF HAS_UNIT_DateUtils}
- // to facilitate inlining
- {$IFNDEF DOTNET}
- {$IFNDEF HAS_GetLocalTimeOffset}
- {$IFDEF HAS_DateUtils_TTimeZone}
- {$IFDEF VCL_XE2_OR_ABOVE}System.TimeSpan{$ELSE}TimeSpan{$ENDIF},
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- DateUtils,
- {$ENDIF}
- //do not bring in our IdIconv unit if we are using the libc unit directly.
- {$IFDEF USE_ICONV_UNIT}IdIconv, {$ENDIF}
- IdResourceStrings,
- IdStream,
- {$IFDEF DOTNET}
- IdStreamNET
- {$ELSE}
- IdStreamVCL
- {$ENDIF}
- {$IFDEF HAS_PosEx}
- {$IFDEF HAS_UNIT_StrUtils}
- ,StrUtils
- {$ENDIF}
- {$ENDIF}
- ;
- {$IFDEF FPC}
- {$IFDEF WINCE}
- //FreePascal for WindowsCE may not define these.
- const
- CP_UTF7 = 65000;
- CP_UTF8 = 65001;
- {$ENDIF}
- {$ENDIF}
- {$IFDEF REGISTER_EXPECTED_MEMORY_LEAK}
- {$IFNDEF HAS_System_RegisterExpectedMemoryLeak}
- {$IFDEF USE_FASTMM4}
- // RLebeau 7/5/2018: Prior to Delphi 2009+, FastMM manually defines several of
- // Delphi's native types. Most importantly, it defines PByte, which then causes
- // problems for IIdTextEncoding implementations below. So, lets make sure that
- // our definitions below are using the same RTL types that their declarations
- // above were using, and not use FastMM's types by mistake, otherwise we get
- // compiler errors!
- type
- PByte = System.PByte;
- //NativeInt = System.NativeInt;
- //NativeUInt = System.NativeUInt;
- //PNativeUInt = System.PNativeUInt;
- {$IFDEF DOTNET}
- IntPtr = System.IntPtr;
- {$ENDIF}
- //UIntPtr = System.UIntPtr;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- procedure EnsureEncoding(var VEncoding : IIdTextEncoding; ADefEncoding: IdTextEncodingType = encIndyDefault);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if VEncoding = nil then begin
- VEncoding := IndyTextEncoding(ADefEncoding);
- end;
- end;
- procedure CheckByteEncoding(var VBytes: TIdBytes; ASrcEncoding, ADestEncoding: IIdTextEncoding);
- begin
- if ASrcEncoding <> ADestEncoding then begin
- VBytes := ADestEncoding.GetBytes(ASrcEncoding.GetChars(VBytes));
- end;
- end;
- {$IFNDEF WINDOWS}
- //FreePascal may not define this for non-Windows systems.
- //#define MAKEWORD(a, b) ((WORD)(((BYTE)(a)) | ((WORD)((BYTE)(b))) << 8))
- function MakeWord(const a, b : Byte) : Word;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := Word(a) or (Word(b) shl 8);
- end;
- {$ENDIF}
- {$IFNDEF DOTNET}
- var
- // TODO: use "array of Integer" instead?
- GIdPorts: TIdPortList = nil;
- GIdOSDefaultEncoding: IIdTextEncoding = nil;
- GId8BitEncoding: IIdTextEncoding = nil;
- GIdASCIIEncoding: IIdTextEncoding = nil;
- GIdUTF16BigEndianEncoding: IIdTextEncoding = nil;
- GIdUTF16LittleEndianEncoding: IIdTextEncoding = nil;
- GIdUTF7Encoding: IIdTextEncoding = nil;
- GIdUTF8Encoding: IIdTextEncoding = nil;
- {$ENDIF}
- { IIdTextEncoding implementations }
- {$IFDEF DOTNET}
- type
- TIdDotNetEncoding = class(TInterfacedObject, IIdTextEncoding)
- protected
- FEncoding: System.Text.Encoding;
- public
- constructor Create(AEncoding: System.Text.Encoding); overload;
- constructor Create(const ACharset: String); overload;
- constructor Create(const ACodepage: UInt16); overload;
- function GetByteCount(const AChars: TIdWideChars): Integer; overload;
- function GetByteCount(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): Integer; overload;
- function GetByteCount(const AStr: TIdUnicodeString): Integer; overload;
- function GetByteCount(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): Integer; overload;
- function GetBytes(const AChars: TIdWideChars): TIdBytes; overload;
- function GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): TIdBytes; overload;
- function GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
- function GetBytes(const AStr: TIdUnicodeString): TIdBytes; overload;
- function GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): TIdBytes; overload;
- function GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
- function GetCharCount(const ABytes: TIdBytes): Integer; overload;
- function GetCharCount(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): Integer; overload;
- function GetChars(const ABytes: TIdBytes): TIdWideChars; overload;
- function GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdWideChars; overload;
- function GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer; overload;
- function GetIsSingleByte: Boolean;
- function GetMaxByteCount(ACharCount: Integer): Integer;
- function GetMaxCharCount(AByteCount: Integer): Integer;
- function GetPreamble: TIdBytes;
- function GetString(const ABytes: TIdBytes): TIdUnicodeString; overload;
- function GetString(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdUnicodeString; overload;
- end;
- constructor TIdDotNetEncoding.Create(AEncoding: System.Text.Encoding);
- begin
- inherited Create;
- FEncoding := AEncoding;
- end;
- constructor TIdDotNetEncoding.Create(const ACharset: String);
- begin
- inherited Create;
- // RLebeau 5/2/2017: have seen some malformed emails that use 'utf8'
- // instead of 'utf-8', so let's check for that...
- // RLebeau 9/27/2017: updating to handle a few more UTFs without hyphens...
- case PosInStrArray(ACharset, ['UTF7', 'UTF8', 'UTF16', 'UTF16LE', 'UTF16BE', 'UTF32', 'UTF32LE', 'UTF32BE'], False) of {Do not Localize}
- 0: FEncoding := System.Text.Encoding.UTF7;
- 1: FEncoding := System.Text.Encoding.UTF8;
- 2,3: FEncoding := System.Text.Encoding.Unicode;
- 4: FEncoding := System.Text.Encoding.BigEndianUnicode;
- 5,6: FEncoding := System.Text.Encoding.UTF32;
- 7: FEncoding := System.Text.Encoding.GetEncoding(12001);
- else
- FEncoding := System.Text.Encoding.GetEncoding(ACharset);
- end;
- end;
- constructor TIdDotNetEncoding.Create(const ACodepage: UInt16);
- begin
- inherited Create;
- FEncoding := System.Text.Encoding.GetEncoding(ACodepage);
- end;
- function TIdDotNetEncoding.GetByteCount(const AChars: TIdWideChars): Integer;
- begin
- Result := FEncoding.GetByteCount(AChars);
- end;
- function TIdDotNetEncoding.GetByteCount(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): Integer;
- begin
- Result := FEncoding.GetByteCount(AChars, ACharIndex, ACharCount);
- end;
- function TIdDotNetEncoding.GetByteCount(const AStr: TIdUnicodeString): Integer;
- begin
- Result := FEncoding.GetByteCount(AStr);
- end;
- function TIdDotNetEncoding.GetByteCount(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): Integer;
- begin
- Result := FEncoding.GetByteCount(AStr.Substring(ACharIndex-1, ACharCount));
- end;
- function TIdDotNetEncoding.GetBytes(const AChars: TIdWideChars): TIdBytes;
- begin
- Result := FEncoding.GetBytes(AChars);
- end;
- function TIdDotNetEncoding.GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): TIdBytes;
- begin
- Result := FEncoding.GetBytes(AChars, ACharIndex, ACharCount);
- end;
- function TIdDotNetEncoding.GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer;
- begin
- Result := FEncoding.GetBytes(AChars, ACharIndex, ACharCount, VBytes, AByteIndex);
- end;
- function TIdDotNetEncoding.GetBytes(const AStr: TIdUnicodeString): TIdBytes;
- begin
- Result := FEncoding.GetBytes(AStr);
- end;
- function TIdDotNetEncoding.GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): TIdBytes;
- begin
- Result := FEncoding.GetByteCount(AStr.Substring(ACharIndex-1, ACharCount));
- end;
- function TIdDotNetEncoding.GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer;
- begin
- Result := FEncoding.GetBytes(AStr, ACharIndex-1, ACharCount, VBytes, AByteIndex);
- end;
- function TIdDotNetEncoding.GetCharCount(const ABytes: TIdBytes): Integer;
- begin
- Result := FEncoding.GetCharCount(ABytes);
- end;
- function TIdDotNetEncoding.GetCharCount(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): Integer;
- begin
- Result := FEncoding.GetCharCount(ABytes, AByteIndex, AByteCount);
- end;
- function TIdDotNetEncoding.GetChars(const ABytes: TIdBytes): TIdWideChars;
- begin
- Result := FEncoding.GetChars(ABytes);
- end;
- function TIdDotNetEncoding.GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdWideChars;
- begin
- Result := FEncoding.GetChars(ABytes, AByteIndex, AByteCount);
- end;
- function TIdDotNetEncoding.GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer;
- begin
- Result := FEncoding.GetChars(ABytes, AByteIndex, AByteCount, VChars, ACharIndex);
- end;
- function TIdDotNetEncoding.GetIsSingleByte: Boolean;
- begin
- Result := FEncoding.IsSingleByte;
- end;
- function TIdDotNetEncoding.GetMaxByteCount(ACharCount: Integer): Integer;
- begin
- Result := FEncoding.GetMaxByteCount(ACharCount);
- end;
- function TIdDotNetEncoding.GetMaxCharCount(AByteCount: Integer): Integer;
- begin
- Result := FEncoding.GetMaxCharCount(AByteCount);
- end;
- function TIdDotNetEncoding.GetPreamble: TIdBytes;
- begin
- Result := fEncoding.GetPreamble;
- end;
- function TIdDotNetEncoding.GetString(const ABytes: TIdBytes): TIdUnicodeString;
- begin
- Result := FEncoding.GetString(ABytes);
- end;
- function TIdDotNetEncoding.GetString(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdUnicodeString;
- begin
- Result := FEncoding.GetString(ABytes, AByteIndex, AByteCount);
- end;
- {$ELSE}
- type
- TIdTextEncodingBase = class(TInterfacedObject, IIdTextEncoding)
- protected
- FIsSingleByte: Boolean;
- FMaxCharSize: Integer;
- public
- function GetByteCount(const AChars: TIdWideChars): Integer; overload;
- function GetByteCount(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): Integer; overload;
- function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; overload; virtual; abstract;
- function GetByteCount(const AStr: TIdUnicodeString): Integer; overload;
- function GetByteCount(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): Integer; overload;
- function GetBytes(const AChars: TIdWideChars): TIdBytes; overload;
- function GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): TIdBytes; overload;
- function GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
- function GetBytes(const AChars: PIdWideChar; ACharCount: Integer): TIdBytes; overload;
- function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
- function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; overload; virtual; abstract;
- function GetBytes(const AStr: TIdUnicodeString): TIdBytes; overload;
- function GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): TIdBytes; overload;
- function GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
- function GetCharCount(const ABytes: TIdBytes): Integer; overload;
- function GetCharCount(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): Integer; overload;
- function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; overload; virtual; abstract;
- function GetChars(const ABytes: TIdBytes): TIdWideChars; overload;
- function GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdWideChars; overload;
- function GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer; overload;
- function GetChars(const ABytes: PByte; AByteCount: Integer): TIdWideChars; overload;
- function GetChars(const ABytes: PByte; AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer; overload;
- function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; overload; virtual; abstract;
- function GetIsSingleByte: Boolean;
- function GetMaxByteCount(ACharCount: Integer): Integer; virtual; abstract;
- function GetMaxCharCount(AByteCount: Integer): Integer; virtual; abstract;
- function GetPreamble: TIdBytes; virtual;
- function GetString(const ABytes: TIdBytes): TIdUnicodeString; overload;
- function GetString(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdUnicodeString; overload;
- function GetString(const ABytes: PByte; AByteCount: Integer): TIdUnicodeString; overload;
- end;
- {$UNDEF SUPPORTS_CHARSET_ENCODING}
- {$IFDEF USE_ICONV}
- {$DEFINE SUPPORTS_CHARSET_ENCODING}
- {$ENDIF}
- {$IFDEF USE_LCONVENC}
- {$DEFINE SUPPORTS_CHARSET_ENCODING}
- {$ENDIF}
- {$UNDEF SUPPORTS_CODEPAGE_ENCODING}
- {$IFNDEF SUPPORTS_CHARSET_ENCODING}
- {$IFDEF WINDOWS}
- {$DEFINE SUPPORTS_CODEPAGE_ENCODING}
- {$ENDIF}
- {$IFDEF HAS_LocaleCharsFromUnicode}
- {$DEFINE SUPPORTS_CODEPAGE_ENCODING}
- {$ENDIF}
- {$ENDIF}
- TIdMBCSEncoding = class(TIdTextEncodingBase)
- private
- {$IFDEF SUPPORTS_CHARSET_ENCODING}
- FCharSet: String;
- {$ELSE}
- {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
- FCodePage: UInt32;
- FMBToWCharFlags: UInt32;
- FWCharToMBFlags: UInt32;
- {$ENDIF}
- {$ENDIF}
- public
- constructor Create; overload; virtual;
- {$IFDEF SUPPORTS_CHARSET_ENCODING}
- constructor Create(const CharSet: String); overload; virtual;
- {$ELSE}
- {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
- constructor Create(CodePage: Integer); overload; virtual;
- constructor Create(CodePage, MBToWCharFlags, WCharToMBFlags: Integer); overload; virtual;
- {$ENDIF}
- {$ENDIF}
- function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; overload; override;
- function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; overload; override;
- function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; overload; override;
- function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; overload; override;
- function GetMaxByteCount(CharCount: Integer): Integer; override;
- function GetMaxCharCount(ByteCount: Integer): Integer; override;
- function GetPreamble: TIdBytes; override;
- end;
- TIdUTF7Encoding = class(TIdMBCSEncoding)
- public
- constructor Create; override;
- function GetMaxByteCount(CharCount: Integer): Integer; override;
- function GetMaxCharCount(ByteCount: Integer): Integer; override;
- end;
- TIdUTF8Encoding = class(TIdMBCSEncoding)
- public
- constructor Create; override;
- function GetMaxByteCount(CharCount: Integer): Integer; override;
- function GetMaxCharCount(ByteCount: Integer): Integer; override;
- function GetPreamble: TIdBytes; override;
- end;
- TIdUTF16LittleEndianEncoding = class(TIdTextEncodingBase)
- public
- constructor Create; virtual;
- function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; overload; override;
- function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; overload; override;
- function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; overload; override;
- function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; overload; override;
- function GetMaxByteCount(CharCount: Integer): Integer; override;
- function GetMaxCharCount(ByteCount: Integer): Integer; override;
- function GetPreamble: TIdBytes; override;
- end;
- TIdUTF16BigEndianEncoding = class(TIdUTF16LittleEndianEncoding)
- public
- function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; overload; override;
- function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; overload; override;
- function GetPreamble: TIdBytes; override;
- end;
- TIdASCIIEncoding = class(TIdTextEncodingBase)
- public
- constructor Create; virtual;
- function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; override;
- function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; override;
- function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; override;
- function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; override;
- function GetMaxByteCount(ACharCount: Integer): Integer; override;
- function GetMaxCharCount(AByteCount: Integer): Integer; override;
- end;
- TId8BitEncoding = class(TIdTextEncodingBase)
- public
- constructor Create; virtual;
- function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; override;
- function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; override;
- function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; override;
- function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; override;
- function GetMaxByteCount(ACharCount: Integer): Integer; override;
- function GetMaxCharCount(AByteCount: Integer): Integer; override;
- end;
- {$IFDEF HAS_TEncoding}
- TIdVCLEncoding = class(TIdTextEncodingBase)
- protected
- FEncoding: TEncoding;
- FFreeEncoding: Boolean;
- public
- constructor Create(AEncoding: TEncoding; AFreeEncoding: Boolean); overload;
- {$IFDEF HAS_TEncoding_GetEncoding_ByEncodingName}
- constructor Create(const ACharset: String); overload;
- {$ENDIF}
- constructor Create(const ACodepage: UInt16); overload;
- destructor Destroy; override;
- function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; override;
- function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; override;
- function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; override;
- function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; override;
- function GetMaxByteCount(ACharCount: Integer): Integer; override;
- function GetMaxCharCount(AByteCount: Integer): Integer; override;
- end;
- {$ENDIF}
- { TIdTextEncodingBase }
- function ValidateChars(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): PIdWideChar;
- var
- Len: Integer;
- begin
- Len := Length(AChars);
- if (ACharIndex < 0) or (ACharIndex >= Len) then begin
- raise Exception.CreateResFmt(PResStringRec(@RSCharIndexOutOfBounds), [ACharIndex]);
- end;
- if ACharCount < 0 then begin
- raise Exception.CreateResFmt(PResStringRec(@RSInvalidCharCount), [ACharCount]);
- end;
- if (Len - ACharIndex) < ACharCount then begin
- raise Exception.CreateResFmt(PResStringRec(@RSInvalidCharCount), [ACharCount]);
- end;
- if ACharCount > 0 then begin
- Result := @AChars[ACharIndex];
- end else begin
- Result := nil;
- end;
- end;
- function ValidateBytes(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): PByte; overload;
- var
- Len: Integer;
- begin
- Len := Length(ABytes);
- if (AByteIndex < 0) or (AByteIndex >= Len) then begin
- raise Exception.CreateResFmt(PResStringRec(@RSInvalidDestinationIndex), [AByteIndex]);
- end;
- if (Len - AByteIndex) < AByteCount then begin
- raise Exception.CreateRes(PResStringRec(@RSInvalidDestinationArray));
- end;
- if AByteCount > 0 then begin
- Result := @ABytes[AByteIndex];
- end else begin
- Result := nil;
- end;
- end;
- function ValidateBytes(const ABytes: TIdBytes; AByteIndex, AByteCount, ANeeded: Integer): PByte; overload;
- var
- Len: Integer;
- begin
- Len := Length(ABytes);
- if (AByteIndex < 0) or (AByteIndex >= Len) then begin
- raise Exception.CreateResFmt(PResStringRec(@RSInvalidDestinationIndex), [AByteIndex]);
- end;
- if (Len - AByteIndex) < ANeeded then begin
- raise Exception.CreateRes(PResStringRec(@RSInvalidDestinationArray));
- end;
- if AByteCount > 0 then begin
- Result := @ABytes[AByteIndex];
- end else begin
- Result := nil;
- end;
- end;
- function ValidateStr(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): PIdWideChar;
- begin
- if ACharIndex < 1 then begin
- raise Exception.CreateResFmt(PResStringRec(@RSCharIndexOutOfBounds), [ACharIndex]);
- end;
- if ACharCount < 0 then begin
- raise Exception.CreateResFmt(PResStringRec(@RSInvalidCharCount), [ACharCount]);
- end;
- if (Length(AStr) - ACharIndex + 1) < ACharCount then begin
- raise Exception.CreateResFmt(PResStringRec(@RSInvalidCharCount), [ACharCount]);
- end;
- if ACharCount > 0 then begin
- Result := @AStr[ACharIndex];
- end else begin
- Result := nil;
- end;
- end;
- function TIdTextEncodingBase.GetByteCount(const AChars: TIdWideChars): Integer;
- begin
- if AChars <> nil then begin
- Result := GetByteCount(PIdWideChar(AChars), Length(AChars));
- end else begin
- Result := 0;
- end;
- end;
- function TIdTextEncodingBase.GetByteCount(const AChars: TIdWideChars;
- ACharIndex, ACharCount: Integer): Integer;
- var
- LChars: PIdWideChar;
- begin
- LChars := ValidateChars(AChars, ACharIndex, ACharCount);
- if LChars <> nil then begin
- Result := GetByteCount(LChars, ACharCount);
- end else begin
- Result := 0;
- end;
- end;
- function TIdTextEncodingBase.GetByteCount(const AStr: TIdUnicodeString): Integer;
- begin
- if AStr <> '' then begin
- Result := GetByteCount(PIdWideChar(AStr), Length(AStr));
- end else begin
- Result := 0;
- end;
- end;
- function TIdTextEncodingBase.GetByteCount(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): Integer;
- var
- LChars: PIdWideChar;
- begin
- LChars := ValidateStr(AStr, ACharIndex, ACharCount);
- if LChars <> nil then begin
- Result := GetByteCount(LChars, ACharCount);
- end else begin
- Result := 0;
- end;
- end;
- function TIdTextEncodingBase.GetBytes(const AChars: TIdWideChars): TIdBytes;
- begin
- if AChars <> nil then begin
- Result := GetBytes(PIdWideChar(AChars), Length(AChars));
- end else begin
- Result := nil;
- end;
- end;
- function TIdTextEncodingBase.GetBytes(const AChars: TIdWideChars;
- ACharIndex, ACharCount: Integer): TIdBytes;
- var
- Len: Integer;
- begin
- Result := nil;
- Len := GetByteCount(AChars, ACharIndex, ACharCount);
- if Len > 0 then begin
- SetLength(Result, Len);
- GetBytes(@AChars[ACharIndex], ACharCount, PByte(Result), Len);
- end;
- end;
- function TIdTextEncodingBase.GetBytes(const AChars: TIdWideChars;
- ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer;
- begin
- Result := GetBytes(
- ValidateChars(AChars, ACharIndex, ACharCount),
- ACharCount, VBytes, AByteIndex);
- end;
- function TIdTextEncodingBase.GetBytes(const AChars: PIdWideChar; ACharCount: Integer): TIdBytes;
- var
- Len: Integer;
- begin
- Result := nil;
- Len := GetByteCount(AChars, ACharCount);
- if Len > 0 then begin
- SetLength(Result, Len);
- GetBytes(AChars, ACharCount, PByte(Result), Len);
- end;
- end;
- function TIdTextEncodingBase.GetBytes(const AChars: PIdWideChar; ACharCount: Integer;
- var VBytes: TIdBytes; AByteIndex: Integer): Integer;
- var
- Len, LByteCount: Integer;
- LBytes: PByte;
- begin
- if (AChars = nil) and (ACharCount <> 0) then begin
- raise Exception.CreateRes(PResStringRec(@RSInvalidSourceArray));
- end;
- if (VBytes = nil) and (ACharCount <> 0) then begin
- raise Exception.CreateRes(PResStringRec(@RSInvalidDestinationArray));
- end;
- if ACharCount < 0 then begin
- raise Exception.CreateResFmt(PResStringRec(@RSInvalidCharCount), [ACharCount]);
- end;
- Len := Length(VBytes);
- LByteCount := GetByteCount(AChars, ACharCount);
- LBytes := ValidateBytes(VBytes, AByteIndex, Len, LByteCount);
- Dec(Len, AByteIndex);
- if (ACharCount > 0) and (Len > 0) then begin
- Result := GetBytes(AChars, ACharCount, LBytes, LByteCount);
- end else begin
- Result := 0;
- end;
- end;
- function TIdTextEncodingBase.GetBytes(const AStr: TIdUnicodeString): TIdBytes;
- var
- Len: Integer;
- begin
- Result := nil;
- Len := GetByteCount(AStr);
- if Len > 0 then begin
- SetLength(Result, Len);
- GetBytes(PIdWideChar(AStr), Length(AStr), PByte(Result), Len);
- end;
- end;
- function TIdTextEncodingBase.GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): TIdBytes;
- var
- Len: Integer;
- LChars: PIdWideChar;
- begin
- Result := nil;
- LChars := ValidateStr(AStr, ACharIndex, ACharCount);
- if LChars <> nil then begin
- Len := GetByteCount(LChars, ACharCount);
- if Len > 0 then begin
- SetLength(Result, Len);
- GetBytes(LChars, ACharCount, PByte(Result), Len);
- end;
- end;
- end;
- function TIdTextEncodingBase.GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer;
- var VBytes: TIdBytes; AByteIndex: Integer): Integer;
- var
- LChars: PIdWideChar;
- begin
- LChars := ValidateStr(AStr, ACharIndex, ACharCount);
- if LChars <> nil then begin
- Result := GetBytes(LChars, ACharCount, VBytes, AByteIndex);
- end else begin
- Result := 0;
- end;
- end;
- function TIdTextEncodingBase.GetCharCount(const ABytes: TIdBytes): Integer;
- begin
- if ABytes <> nil then begin
- Result := GetCharCount(PByte(ABytes), Length(ABytes));
- end else begin
- Result := 0;
- end;
- end;
- function TIdTextEncodingBase.GetCharCount(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): Integer;
- var
- LBytes: PByte;
- begin
- LBytes := ValidateBytes(ABytes, AByteIndex, AByteCount);
- if LBytes <> nil then begin
- Result := GetCharCount(LBytes, AByteCount);
- end else begin
- Result := 0;
- end;
- end;
- function TIdTextEncodingBase.GetChars(const ABytes: TIdBytes): TIdWideChars;
- begin
- if ABytes <> nil then begin
- Result := GetChars(PByte(ABytes), Length(ABytes));
- end else begin
- Result := nil;
- end;
- end;
- function TIdTextEncodingBase.GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdWideChars;
- var
- Len: Integer;
- begin
- Result := nil;
- Len := GetCharCount(ABytes, AByteIndex, AByteCount);
- if Len > 0 then begin
- SetLength(Result, Len);
- GetChars(@ABytes[AByteIndex], AByteCount, PIdWideChar(Result), Len);
- end;
- end;
- function TIdTextEncodingBase.GetChars(const ABytes: TIdBytes;
- AByteIndex, AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer;
- var
- LBytes: PByte;
- begin
- LBytes := ValidateBytes(ABytes, AByteIndex, AByteCount);
- if LBytes <> nil then begin
- Result := GetChars(LBytes, AByteCount, VChars, ACharIndex);
- end else begin
- Result := 0;
- end;
- end;
- function TIdTextEncodingBase.GetChars(const ABytes: PByte; AByteCount: Integer): TIdWideChars;
- var
- Len: Integer;
- begin
- Len := GetCharCount(ABytes, AByteCount);
- if Len > 0 then begin
- SetLength(Result, Len);
- GetChars(ABytes, AByteCount, PIdWideChar(Result), Len);
- end;
- end;
- function TIdTextEncodingBase.GetChars(const ABytes: PByte; AByteCount: Integer;
- var VChars: TIdWideChars; ACharIndex: Integer): Integer;
- var
- LCharCount: Integer;
- begin
- if (ABytes = nil) and (AByteCount <> 0) then begin
- raise Exception.CreateRes(PResStringRec(@RSInvalidSourceArray));
- end;
- if AByteCount < 0 then begin
- raise Exception.CreateResFmt(PResStringRec(@RSInvalidCharCount), [AByteCount]);
- end;
- if (ACharIndex < 0) or (ACharIndex > Length(VChars)) then begin
- raise Exception.CreateResFmt(PResStringRec(@RSInvalidDestinationIndex), [ACharIndex]);
- end;
- LCharCount := GetCharCount(ABytes, AByteCount);
- if LCharCount > 0 then begin
- if (ACharIndex + LCharCount) > Length(VChars) then begin
- raise Exception.CreateRes(PResStringRec(@RSInvalidDestinationArray));
- end;
- Result := GetChars(ABytes, AByteCount, @VChars[ACharIndex], LCharCount);
- end else begin
- Result := 0;
- end;
- end;
- function TIdTextEncodingBase.GetIsSingleByte: Boolean;
- begin
- Result := FIsSingleByte;
- end;
- function TIdTextEncodingBase.GetPreamble: TIdBytes;
- begin
- SetLength(Result, 0);
- end;
- function TIdTextEncodingBase.GetString(const ABytes: TIdBytes): TIdUnicodeString;
- begin
- if ABytes <> nil then begin
- Result := GetString(PByte(ABytes), Length(ABytes));
- end else begin
- Result := '';
- end;
- end;
- function TIdTextEncodingBase.GetString(const ABytes: TIdBytes;
- AByteIndex, AByteCount: Integer): TIdUnicodeString;
- var
- Len: Integer;
- begin
- Result := '';
- Len := GetCharCount(ABytes, AByteIndex, AByteCount);
- if Len > 0 then begin
- SetLength(Result, Len);
- GetChars(@ABytes[AByteIndex], AByteCount, PIdWideChar(Result), Len);
- end;
- end;
- function TIdTextEncodingBase.GetString(const ABytes: PByte; AByteCount: Integer): TIdUnicodeString;
- var
- Len: Integer;
- begin
- Result := '';
- Len := GetCharCount(ABytes, AByteCount);
- if Len > 0 then begin
- SetLength(Result, Len);
- GetChars(ABytes, AByteCount, PIdWideChar(Result), Len);
- end;
- end;
- { TIdMBCSEncoding }
- function IsCharsetASCII(const ACharSet: string): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // TODO: when the IdCharsets unit is moved to the System
- // package, use CharsetToCodePage() here...
- Result := PosInStrArray(ACharSet,
- [
- 'US-ASCII', {do not localize}
- 'ANSI_X3.4-1968', {do not localize}
- 'iso-ir-6', {do not localize}
- 'ANSI_X3.4-1986', {do not localize}
- 'ISO_646.irv:1991', {do not localize}
- 'ASCII', {do not localize}
- 'ISO646-US', {do not localize}
- 'us', {do not localize}
- 'IBM367', {do not localize}
- 'cp367', {do not localize}
- 'csASCII' {do not localize}
- ], False) <> -1;
- end;
- {$IFNDEF SUPPORTS_CHARSET_ENCODING}
- {$IFNDEF HAS_LocaleCharsFromUnicode}
- {$IFDEF WINDOWS}
- {$IFNDEF HAS_PLongBool}
- type
- PLongBool = ^LongBool;
- {$ENDIF}
- function LocaleCharsFromUnicode(CodePage, Flags: Cardinal;
- UnicodeStr: PWideChar; UnicodeStrLen: Integer; LocaleStr: PAnsiChar;
- LocaleStrLen: Integer; DefaultChar: PAnsiChar; UsedDefaultChar: PLongBool): Integer; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := WideCharToMultiByte(CodePage, Flags, UnicodeStr, UnicodeStrLen, LocaleStr, LocaleStrLen, DefaultChar, PBOOL(UsedDefaultChar));
- end;
- {$DEFINE HAS_LocaleCharsFromUnicode}
- {$ENDIF}
- {$ENDIF}
- {$IFNDEF HAS_UnicodeFromLocaleChars}
- {$IFDEF WINDOWS}
- function UnicodeFromLocaleChars(CodePage, Flags: Cardinal; LocaleStr: PAnsiChar;
- LocaleStrLen: Integer; UnicodeStr: PWideChar; UnicodeStrLen: Integer): Integer; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := MultiByteToWideChar(CodePage, Flags, LocaleStr, LocaleStrLen, UnicodeStr, UnicodeStrLen);
- end;
- {$DEFINE HAS_UnicodeFromLocaleChars}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- constructor TIdMBCSEncoding.Create;
- begin
- {$IFDEF USE_ICONV}
- Create(iif(GIdIconvUseLocaleDependantAnsiEncoding, 'char', 'ASCII')); {do not localize}
- {$ELSE}
- {$IFDEF USE_LCONVENC}
- Create(GetDefaultTextEncoding());
- {$ELSE}
- {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
- Create(CP_ACP, 0, 0);
- {$ELSE}
- ToDo('Constructor of TIdMBCSEncoding class is not implemented for this platform yet'); {do not localize}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- end;
- {$IFDEF SUPPORTS_CHARSET_ENCODING}
- constructor TIdMBCSEncoding.Create(const CharSet: String);
- const
- // RLebeau: iconv() does not provide a maximum character byte size like
- // Microsoft does, so have to determine the max bytes by manually encoding
- // an actual Unicode codepoint. We'll encode the largest codepoint that
- // UTF-16 supports, U+10FFFF, for now...
- //
- cValue: array[0..3] of Byte = ({$IFDEF ENDIAN_BIG}$DB, $FF, $DF, $FF{$ELSE}$FF, $DB, $FF, $DF{$ENDIF});
- //cValue: array[0..1] of UInt16 = ($DBFF, $DFFF);
- begin
- inherited Create;
- // RLebeau 5/2/2017: have seen some malformed emails that use 'utf8'
- // instead of 'utf-8', so let's check for that...
- // RLebeau 9/27/2017: updating to handle a few more UTFs without hyphens...
- // RLebeau 7/6/2018: iconv does not have a way to query the highest Unicode
- // codepoint a charset supports, let alone the max bytes needed to encode such
- // a codepoint, so use known values for select charsets, and calculate
- // MaxCharSize dynamically for the rest...
- // TODO: normalize the FCharSet to make comparisons easier...
- case PosInStrArray(CharSet, ['UTF-7', 'UTF7', 'UTF-8', 'UTF8', 'UTF-16', 'UTF16', 'UTF-16LE', 'UTF16LE', 'UTF-16BE', 'UTF16BE', 'UTF-32', 'UTF32', 'UTF-32LE', 'UTF32LE', 'UTF-32BE', 'UTF32BE'], False) of {Do not Localize}
- 0, 1: begin
- FCharSet := 'UTF-7'; {Do not Localize}
- FMaxCharSize := 5;
- end;
- 2, 3: begin
- FCharSet := 'UTF-8'; {Do not Localize}
- FMaxCharSize := 4;
- end;
- 4..7: begin
- FCharSet := 'UTF-16LE'; {Do not Localize}
- FMaxCharSize := 4;
- end;
- 8, 9: begin
- FCharSet := 'UTF-16BE'; {Do not Localize}
- FMaxCharSize := 4;
- end;
- 10..13: begin
- FCharSet := 'UTF-32LE'; {Do not Localize}
- FMaxCharSize := 4;
- end;
- 14, 15: begin
- FCharSet := 'UTF-32BE'; {Do not Localize}
- FMaxCharSize := 4;
- end;
- else
- FCharSet := CharSet;
- if TextStartsWith(CharSet, 'ISO-8859') or {Do not Localize}
- TextStartsWith(CharSet, 'Windows') or {Do not Localize}
- TextStartsWith(CharSet, 'KOI8') or {Do not Localize}
- IsCharsetASCII(CharSet) then
- begin
- FMaxCharSize := 1;
- end
- else begin
- FMaxCharSize := GetByteCount(PWideChar(@cValue[0]), 2);
- // Not all charsets support all codepoints. For example, ISO-8859-1 does
- // not support U+10FFFF. If GetByteCount() fails above, FMaxCharSize gets
- // set to 0, preventing any character conversions. So force FMaxCharSize
- // to 1 if GetByteCount() fails, until a better solution can be found.
- // Maybe loop through the codepoints until we find the largest one that is
- // supported by this charset..
- if FMaxCharSize = 0 then begin
- FMaxCharSize := 1;
- end;
- end;
- end;
- FIsSingleByte := (FMaxCharSize = 1);
- end;
- {$ELSE}
- {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
- constructor TIdMBCSEncoding.Create(CodePage: Integer);
- begin
- Create(CodePage, 0, 0);
- end;
- {$IFDEF WINDOWS}
- // TODO: move this into IdCompilerDefines.inc?
- {$IFNDEF WINCE}
- {$IFDEF DCC}
- {$IFDEF VCL_2009_OR_ABOVE}
- {$DEFINE HAS_GetCPInfoEx}
- {$ELSE}
- {$UNDEF HAS_GetCPInfoEx}
- {$ENDIF}
- {$ELSE}
- // TODO: when was GetCPInfoEx() added to FreePascal?
- {$DEFINE HAS_GetCPInfoEx}
- {$ENDIF}
- {$IFNDEF HAS_GetCPInfoEx}
- // TODO: implement GetCPInfoEx() as a stub that falls back to GetCPInfo() if needed
- type
- TCPInfoEx = record
- MaxCharSize: UINT; { max length (bytes) of a char }
- DefaultChar: array[0..MAX_DEFAULTCHAR - 1] of Byte; { default character }
- LeadByte: array[0..MAX_LEADBYTES - 1] of Byte; { lead byte ranges }
- UnicodeDefaultChar: WideChar;
- Codepage: UINT;
- CodePageName: array[0..MAX_PATH -1] of {$IFDEF UNICODE}WideChar{$ELSE}AnsiChar{$ENDIF};
- end;
- function GetCPInfoEx(CodePage: UINT; dwFlags: DWORD; var lpCPInfoEx: TCPInfoEx): BOOL; stdcall; external 'KERNEL32' name {$IFDEF UNICODE}'GetCPInfoExW'{$ELSE}'GetCPInfoExA'{$ENDIF};
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- constructor TIdMBCSEncoding.Create(CodePage, MBToWCharFlags, WCharToMBFlags: Integer);
- {$IFNDEF WINDOWS}
- const
- // RLebeau: have to determine the max bytes by manually encoding an actual
- // Unicode codepoint. We'll encode the largest codepoint that UTF-16 supports,
- // U+10FFFF, for now...
- //
- cValue: array[0..1] of UInt16 = ($DBFF, $DFFF);
- {$ELSE}
- var
- LCPInfo: {$IFDEF WINCE}TCPInfo{$ELSE}TCPInfoEx{$ENDIF};
- LError: Boolean;
- {$ENDIF}
- begin
- inherited Create;
- FCodePage := CodePage;
- FMBToWCharFlags := MBToWCharFlags;
- FWCharToMBFlags := WCharToMBFlags;
- {$IFDEF FPC} // TODO: do this for Delphi 2009+, too...
- if FCodePage = CP_ACP then begin
- FCodePage := DefaultSystemCodePage;
- end;
- {$ENDIF}
- {$IFDEF WINDOWS}
- LError := not {$IFDEF WINCE}GetCPInfo(FCodePage, LCPInfo){$ELSE}GetCPInfoEx(FCodePage, 0, LCPInfo){$ENDIF};
- if LError and (FCodePage = 20127) then begin
- // RLebeau: 20127 is the official codepage for ASCII, but not
- // all OS versions support that codepage, so fallback to 1252
- // or even 437...
- LError := not {$IFDEF WINCE}GetCPInfo(1252, LCPInfo){$ELSE}GetCPInfoEx(1252, 0, LCPInfo){$ENDIF};
- // just in case...
- if LError then begin
- LError := not {$IFDEF WINCE}GetCPInfo(437, LCPInfo){$ELSE}GetCPInfoEx(437, 0, LCPInfo){$ENDIF};
- end;
- end;
- if LError then begin
- raise EIdException.CreateResFmt(PResStringRec(@RSInvalidCodePage), [FCodePage]);
- end;
- {$IFNDEF WINCE}
- FCodePage := LCPInfo.CodePage;
- {$ENDIF}
- FMaxCharSize := LCPInfo.MaxCharSize;
- {$ELSE}
- case FCodePage of
- 65000: begin
- FMaxCharSize := 5;
- end;
- 65001: begin
- FMaxCharSize := 4;
- end;
- 1200: begin
- FMaxCharSize := 4;
- end;
- 1201: begin
- FMaxCharSize := 4;
- end;
- // TODO: add support for UTF-32...
- // TODO: add cases for 'ISO-8859-X', 'Windows-X', 'KOI8-X', and ASCII charsets...
- else
- FMaxCharSize := LocaleCharsFromUnicode(FCodePage, FWCharToMBFlags, @cValue[0], 2, nil, 0, nil, nil);
- if FMaxCharSize < 1 then begin
- raise EIdException.CreateResFmt(@RSInvalidCodePage, [FCodePage]);
- end;
- // Not all charsets support all codepoints. For example, ISO-8859-1 does
- // not support U+10FFFF. If LocaleCharsFromUnicode() fails above,
- // FMaxCharSize gets set to 0, preventing any character conversions. So
- // force FMaxCharSize to 1 if GetByteCount() fails, until a better solution
- // can be found. Maybe loop through the codepoints until we find the largest
- // one that is supported by this codepage (though that will take time). Or
- // at least implement a lookup table for the more commonly used charsets...
- if FMaxCharSize = 0 then begin
- FMaxCharSize := 1;
- end;
- end;
- {$ENDIF}
- FIsSingleByte := (FMaxCharSize = 1);
- end;
- {$ENDIF}
- {$ENDIF}
- {$IFDEF USE_ICONV}
- function CreateIconvHandle(const ACharSet: String; AToUTF16: Boolean): iconv_t;
- const
- // RLebeau: iconv() outputs a UTF-16 BOM if data is converted to the generic
- // "UTF-16" charset. We do not want that, so we will use the "UTF-16LE/BE"
- // charset explicitally instead so no BOM is outputted. This also saves us
- // from having to manually detect the presense of a BOM and strip it out.
- //
- // TODO: should we be using UTF-16LE or UTF-16BE on big-endian systems?
- // Delphi uses UTF-16LE, but what does FreePascal use? Let's err on the
- // side of caution until we know otherwise...
- //
- cUTF16CharSet = {$IFDEF ENDIAN_BIG}'UTF-16BE'{$ELSE}'UTF-16LE'{$ENDIF}; {do not localize}
- var
- LToCharSet, LFromCharSet, LFlags: String;
- {$IFDEF USE_MARSHALLED_PTRS}
- M: TMarshaller;
- {$ENDIF}
- begin
- // on some systems, //IGNORE must be specified before //TRANSLIT if they
- // are used together, otherwise //IGNORE gets ignored!
- LFlags := '';
- if GIdIconvIgnoreIllegalChars then begin
- LFlags := LFlags + '//IGNORE'; {do not localize}
- end;
- if GIdIconvUseTransliteration then begin
- LFlags := LFlags + '//TRANSLIT'; {do not localize}
- end;
- if AToUTF16 then begin
- LToCharSet := cUTF16CharSet + LFlags;
- LFromCharSet := ACharSet;
- end else begin
- LToCharSet := ACharSet + LFlags;
- LFromCharSet := cUTF16CharSet;
- end;
- Result := iconv_open(
- {$IFDEF USE_MARSHALLED_PTRS}
- M.AsAnsi(LToCharSet).ToPointer,
- M.AsAnsi(LFromCharSet).ToPointer
- {$ELSE}
- PAnsiChar(
- {$IFDEF STRING_IS_ANSI}
- LToCharSet
- {$ELSE}
- AnsiString(LToCharSet) // explicit convert to Ansi
- {$ENDIF}
- ),
- PAnsiChar(
- {$IFDEF STRING_IS_ANSI}
- LFromCharSet
- {$ELSE}
- AnsiString(LFromCharSet) // explicit convert to Ansi
- {$ENDIF}
- )
- {$ENDIF}
- );
- if Result = iconv_t(-1) then begin
- if LFlags <> '' then begin
- raise EIdException.CreateResFmt(@RSInvalidCharSetConvWithFlags, [ACharSet, cUTF16CharSet, LFlags]);
- end else begin
- raise EIdException.CreateResFmt(@RSInvalidCharSetConv, [ACharSet, cUTF16CharSet]);
- end;
- end;
- end;
- function CalcUTF16ByteSize(AChars: PWideChar; ACharCount: Integer): Integer;
- var
- C: WideChar;
- LCount: Integer;
- begin
- C := AChars^;
- if (C >= #$D800) and (C <= #$DFFF) then
- begin
- Result := 0;
- if C > #$DBFF then begin
- // invalid high surrogate
- Exit;
- end;
- if ACharCount = 1 then begin
- // missing low surrogate
- Exit;
- end;
- Inc(AChars);
- C := AChars^;
- if (C < #$DC00) or (C > #$DFFF) then begin
- // invalid low surrogate
- Exit;
- end;
- LCount := 2;
- end else begin
- LCount := 1;
- end;
- Result := LCount * SizeOf(WideChar);
- end;
- {$ENDIF}
- {$IFDEF USE_ICONV}
- function DoIconvCharsToBytes(const ACharset: string; AChars: PIdWideChar; ACharCount: Integer;
- ABytes: PByte; AByteCount: Integer; ABytesIsTemp: Boolean): Integer;
- var
- LSrcCharsPtr: PIdWideChar;
- LCharsPtr, LBytesPtr: PAnsiChar;
- LSrcCharSize, LCharSize, LByteSize: size_t;
- LCharsRead, LBytesWritten: Integer;
- LIconv: iconv_t;
- begin
- Result := 0;
- if (AChars = nil) or (ACharCount < 1) or ((ABytes <> nil) and (AByteCount < 1)) then begin
- Exit;
- end;
- LIconv := CreateIconvHandle(ACharSet, False);
- try
- // RLebeau: iconv() does not allow for querying a pre-calculated byte size
- // for the input like Microsoft does, so have to determine the max bytes
- // by actually encoding the Unicode data to a real buffer. When ABytesIsTemp
- // is True, we are encoding to a small local buffer so we don't have to use
- // a lot of memory. We also have to encode the input 1 Unicode codepoint at
- // a time to avoid iconv() returning an E2BIG error if multiple UTF-16
- // sequences were decoded to a length that would exceed the size of the
- // local buffer.
- //Kylix has an odd definition in iconv. In Kylix, __outbytesleft is defined as a var
- //while in FreePascal's libc and our IdIconv units define it as a pSize_t
- // reset to initial state
- LByteSize := 0;
- if iconv(LIconv, nil, nil, nil, {$IFNDEF KYLIX}@{$ENDIF}LByteSize) = size_t(-1) then begin
- Exit;
- end;
- // do the conversion
- LSrcCharsPtr := AChars;
- repeat
- if LSrcCharsPtr <> nil then begin
- LSrcCharSize := CalcUTF16ByteSize(LSrcCharsPtr, ACharCount);
- if LSrcCharSize = 0 then begin
- Result := 0;
- Exit;
- end;
- end else begin
- LSrcCharSize := 0;
- end;
- LCharsPtr := PAnsiChar(LSrcCharsPtr);
- LCharSize := LSrcCharSize;
- LBytesPtr := PAnsiChar(ABytes);
- LByteSize := AByteCount;
- if iconv(LIconv, @LCharsPtr, @LCharSize, @LBytesPtr, {$IFNDEF KYLIX}@{$ENDIF}LByteSize) = size_t(-1) then
- begin
- Exit;
- end;
- // LByteSize was decremented by the number of bytes stored in the output buffer
- LBytesWritten := AByteCount - LByteSize;
- Inc(Result, LBytesWritten);
- if LSrcCharsPtr = nil then begin
- Exit;
- end;
- if not ABytesIsTemp then begin
- Inc(ABytes, LBytesWritten);
- Dec(AByteCount, LBytesWritten);
- end;
- // LCharSize was decremented by the number of bytes read from the input buffer
- LCharsRead := (LSrcCharSize-LCharSize) div SizeOf(WideChar);
- Inc(LSrcCharsPtr, LCharsRead);
- Dec(ACharCount, LCharsRead);
- if ACharCount < 1 then
- begin
- // After all characters are handled, the output buffer has to be flushed
- // This is done by running one more iteration, without an input buffer
- LSrcCharsPtr := nil;
- end;
- until False;
- finally
- iconv_close(LIconv);
- end;
- end;
- {$ENDIF}
- {$IFDEF USE_LCONVENC}
- function DoLconvCharsToBytes(const ACharset: string; AChars: PIdWideChar; ACharCount: Integer;
- ABytes: PByte; AByteCount: Integer): Integer;
- var
- LTmpStr : TIdUnicodeString;
- LUTF8, LConverted : RawByteString;
- LEncoded : Boolean;
- begin
- Result := 0;
- if (AChars = nil) or (ACharCount < 1) or ((ABytes <> nil) and (AByteCount < 1)) then begin
- Exit;
- end;
-
- // TODO: encode the input chars directly to UTF-8 without
- // having to create a temp UnicodeString first...
- SetString(LTmpStr, PIdWideChar(AChars), ACharCount);
- LUTF8 := UTF8Encode(LTmpStr);
- case PosInStrArray(ACharSet, ['UTF-8', 'UTF8', EncodingAnsi], False) of {do not localize}
- 0, 1: begin
- // For UTF-8 to UTF-8, ConvertEncodingFromUTF8() does nothing and returns False (FPC bug?).
- // The input has already been converted above, so let's just use the existing bytes as-is...
- LConverted := LUTF8;
- end;
- 2: begin
- // For UTF-8 to ANSI (system enc), ConvertEncodingFromUTF8() does nothing and returns False
- // if ConvertUTF8ToAnsi is not assigned, so let's just assume UTF-8 for now...
- LConverted := ConvertEncodingFromUTF8(LUTF8, ACharSet, LEncoded);
- if not LEncoded then begin
- LConverted := LUTF8;
- end;
- end;
- else
- LConverted := ConvertEncodingFromUTF8(LUTF8, ACharSet, LEncoded);
- if not LEncoded then begin
- // TODO: uncomment this?
- //raise EIdException.CreateResFmt(@RSInvalidCharSetConv, [ACharSet, cUTF16CharSet]);
- Exit;
- end;
- end;
- Result := Length(LConverted);
- if (ABytes <> nil) and (Result > 0) then begin
- Result := IndyMin(Result, AByteCount);
- // TODO: don't output partial character sequences...
- Move(PIdAnsiChar(LConverted)^, ABytes^, Result * SizeOf(TIdAnsiChar));
- end;
- end;
- {$ENDIF}
- function TIdMBCSEncoding.GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer;
- {$IFDEF USE_ICONV}
- var
- // TODO: size this dynamically to accomodate FMaxCharSize, plus some extra padding for safety...
- LBytes: array[0..7] of Byte;
- {$ENDIF}
- begin
- {$IFDEF USE_ICONV}
- Result := DoIconvCharsToBytes(FCharset, AChars, ACharCount, @LBytes[0], Length(LBytes), True);
- {$ELSE}
- {$IFDEF USE_LCONVENC}
- Result := DoLconvCharsToBytes(FCharset, AChars, ACharCount, nil, 0);
- {$ELSE}
- {$IFDEF HAS_LocaleCharsFromUnicode}
- Result := LocaleCharsFromUnicode(FCodePage, FWCharToMBFlags, AChars, ACharCount, nil, 0, nil, nil);
- {$ELSE}
- Result := 0;
- ToDo('GetByteCount() method of TIdMBCSEncoding class is not implemented for this platform yet'); {do not localize}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- end;
- function TIdMBCSEncoding.GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte;
- AByteCount: Integer): Integer;
- begin
- {$IFDEF USE_ICONV}
- Assert (ABytes <> nil, 'TIdMBCSEncoding.GetBytes Bytes can not be nil');
- Result := DoIconvCharsToBytes(FCharset, AChars, ACharCount, ABytes, AByteCount, False);
- {$ELSE}
- {$IFDEF USE_LCONVENC}
- Result := DoLconvCharsToBytes(FCharset, AChars, ACharCount, ABytes, AByteCount);
- {$ELSE}
- {$IFDEF HAS_LocaleCharsFromUnicode}
- Result := LocaleCharsFromUnicode(FCodePage, FWCharToMBFlags, AChars, ACharCount, {$IFNDEF HAS_PAnsiChar}Pointer{$ELSE}PAnsiChar{$ENDIF}(ABytes), AByteCount, nil, nil);
- {$ELSE}
- Result := 0;
- ToDo('GetBytes() method of TIdMBCSEncoding class is not implemented for this platform yet'); {do not localize}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- end;
- {$IFDEF USE_ICONV}
- function DoIconvBytesToChars(const ACharset: string; const ABytes: PByte; AByteCount: Integer;
- AChars: PWideChar; ACharCount: Integer; AMaxCharSize: Integer; ACharsIsTemp: Boolean): Integer;
- var
- LSrcBytesPtr: PByte;
- LBytesPtr, LCharsPtr: PAnsiChar;
- LByteSize, LCharsSize: size_t;
- I, LDestCharSize, LMaxBytesSize, LBytesRead, LCharsWritten: Integer;
- LConverted: Boolean;
- LIconv: iconv_t;
- begin
- Result := 0;
- if (ABytes = nil) or (AByteCount = 0) or ((AChars <> nil) and (ACharCount < 1)) then begin
- Exit;
- end;
- LIconv := CreateIconvHandle(ACharset, True);
- try
- // RLebeau: iconv() does not allow for querying a pre-calculated character count
- // for the input like Microsoft does, so have to determine the max characters
- // by actually encoding the Ansi data to a real buffer. If ACharsIsTemp is True
- // then we are encoding to a small local buffer so we don't have to use a lot of
- // memory. We also have to encode the input 1 Unicode codepoint at a time to
- // avoid iconv() returning an E2BIG error if multiple MBCS sequences were decoded
- // to a length that would exceed the size of the local buffer.
- //Kylix has an odd definition in iconv. In Kylix, __outbytesleft is defined as a var
- //while in FreePascal's libc and our IdIconv units define it as a pSize_t
- // reset to initial state
- LCharsSize := 0;
- if iconv(LIconv, nil, nil, nil, {$IFNDEF KYLIX}@{$ENDIF}LCharsSize) = size_t(-1) then
- begin
- Exit;
- end;
- // do the conversion
- LSrcBytesPtr := ABytes;
- repeat
- LMaxBytesSize := IndyMin(AByteCount, AMaxCharSize);
- LDestCharSize := ACharCount * SizeOf(WideChar);
- if LSrcBytesPtr = nil then
- begin
- LBytesPtr := nil;
- LByteSize := 0;
- LCharsPtr := PAnsiChar(AChars);
- LCharsSize := LDestCharSize;
- if iconv(LIconv, @LBytesPtr, @LByteSize, @LCharsPtr, {$IFNDEF KYLIX}@{$ENDIF}LCharsSize) = size_t(-1) then
- begin
- Result := 0;
- end else
- begin
- // LCharsSize was decremented by the number of bytes stored in the output buffer
- Inc(Result, (LDestCharSize-LCharsSize) div SizeOf(WideChar));
- end;
- Exit;
- end;
- // TODO: figure out a better way to calculate the number of input bytes
- // needed to generate a single UTF-16 output sequence...
- LMaxBytesSize := IndyMin(AByteCount, AMaxCharSize);
- LConverted := False;
- for I := 1 to LMaxBytesSize do
- begin
- LBytesPtr := PAnsiChar(LSrcBytesPtr);
- LByteSize := I;
- LCharsPtr := PAnsiChar(AChars);
- LCharsSize := LDestCharSize;
- if iconv(LIconv, @LBytesPtr, @LByteSize, @LCharsPtr, {$IFNDEF KYLIX}@{$ENDIF}LCharsSize) <> size_t(-1) then
- begin
- LConverted := True;
- // LCharsSize was decremented by the number of bytes stored in the output buffer
- LCharsWritten := (LDestCharSize-LCharsSize) div SizeOf(WideChar);
- Inc(Result, LCharsWritten);
- if LSrcBytesPtr = nil then begin
- Exit;
- end;
- if not ACharsIsTemp then begin
- Inc(AChars, LCharsWritten);
- Dec(ACharCount, LCharsWritten);
- end;
- // LByteSize was decremented by the number of bytes read from the input buffer
- LBytesRead := I - LByteSize;
- Inc(LSrcBytesPtr, LBytesRead);
- Dec(AByteCount, LBytesRead);
- if AByteCount < 1 then begin
- // After all bytes are handled, the output buffer has to be flushed
- // This is done by running one more iteration, without an input buffer
- LSrcBytesPtr := nil;
- end;
- Break;
- end;
- end;
- if not LConverted then begin
- Result := 0;
- Exit;
- end;
- until False;
- finally
- iconv_close(LIconv);
- end;
- end;
- {$ENDIF}
- {$IFDEF USE_LCONVENC}
- function DoLconvBytesToChars(const ACharset: string; const ABytes: PByte; AByteCount: Integer;
- AChars: PWideChar; ACharCount: Integer): Integer;
- var
- LBytes, LConverted: RawByteString;
- LDecoded : TIdUnicodeString;
- LEncoded : Boolean;
- C: TIdWideChar;
- begin
- Result := 0;
- if (ABytes = nil) or (AByteCount < 1) or ((AChars <> nil) and (ACharCount < 1)) then begin
- Exit;
- end;
- SetString(LBytes, PIdAnsiChar(ABytes), AByteCount);
- case PosInStrArray(ACharSet, ['UTF-8', 'UTF8', EncodingAnsi], False) of {do not localize}
- 0, 1: begin
- // For UTF-8 to UTF-8, ConvertEncodingToUTF8() does nothing and returns False (FPC bug?).
- // The input is already in UTF-8, so let's just use the existing bytes as-is...
- LConverted := LBytes;
- end;
- 2: begin
- // For ANSI (system enc) to UTF-8, ConvertEncodingToUTF8() does nothing and returns False
- // if ConvertAnsiToUTF8 is not assigned, so let's just assume UTF-8 for now...
- LConverted := ConvertEncodingToUTF8(LBytes, ACharSet, LEncoded);
- if not LEncoded then begin
- LConverted := LBytes;
- end;
- end;
- else
- LConverted := ConvertEncodingToUTF8(LBytes, ACharSet, LEncoded);
- if not LEncoded then begin
- // TODO: uncomment this?
- //raise EIdException.CreateResFmt(@RSInvalidCharSetConv, [ACharSet, cUTF16CharSet]);
- Exit;
- end;
- end;
- // TODO: decode the UTF-8 directly to the output chars without
- // having to create a temp UnicodeString first...
- LDecoded := UTF8Decode(LConverted);
- Result := Length(LDecoded);
- if (AChars <> nil) and (Result > 0) then begin
- Result := IndyMin(Result, ACharCount);
- // RLebeau: if the last encoded character is a UTF-16 high surrogate, don't output it...
- if Result > 0 then begin
- C := LDecoded[Result];
- if (C >= #$D800) and (C <= #$DBFF) then begin
- Dec(Result);
- end;
- end;
- Move(PIdWideChar(LDecoded)^, AChars^, Result * SizeOf(TIdWideChar));
- end;
- end;
- {$ENDIF}
- function TIdMBCSEncoding.GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer;
- {$IFDEF USE_ICONV}
- var
- LChars: array[0..3] of WideChar;
- {$ENDIF}
- begin
- {$IFDEF USE_ICONV}
- Result := DoIconvBytesToChars(FCharSet, ABytes, AByteCount, @LChars[0], Length(LChars), FMaxCharSize, True);
- {$ELSE}
- {$IFDEF USE_LCONVENC}
- Result := DoLconvBytesToChars(FCharSet, ABytes, AByteCount, nil, 0);
- {$ELSE}
- {$IFDEF HAS_UnicodeFromLocaleChars}
- Result := UnicodeFromLocaleChars(FCodePage, FMBToWCharFlags, {$IFNDEF HAS_PAnsiChar}Pointer{$ELSE}PAnsiChar{$ENDIF}(ABytes), AByteCount, nil, 0);
- {$ELSE}
- Result := 0;
- ToDo('GetCharCount() method of TIdMBCSEncoding class is not implemented for this platform yet'); {do not localize}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- end;
- function TIdMBCSEncoding.GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PWideChar;
- ACharCount: Integer): Integer;
- begin
- {$IFDEF USE_ICONV}
- Result := DoIconvBytesToChars(FCharSet, ABytes, AByteCount, AChars, ACharCount, FMaxCharSize, False);
- {$ELSE}
- {$IFDEF USE_LCONVENC}
- Result := DoLconvBytesToChars(FCharSet, ABytes, AByteCount, AChars, ACharCount);
- {$ELSE}
- {$IFDEF HAS_UnicodeFromLocaleChars}
- Result := UnicodeFromLocaleChars(FCodePage, FMBToWCharFlags, {$IFNDEF HAS_PAnsiChar}Pointer{$ELSE}PAnsiChar{$ENDIF}(ABytes), AByteCount, AChars, ACharCount);
- {$ELSE}
- Result := 0;
- ToDo('GetChars() method of TIdMBCSEncoding class is not implemented for this platform yet'); {do not localize}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- end;
- function TIdMBCSEncoding.GetMaxByteCount(CharCount: Integer): Integer;
- begin
- Result := (CharCount + 1) * FMaxCharSize;
- end;
- function TIdMBCSEncoding.GetMaxCharCount(ByteCount: Integer): Integer;
- begin
- Result := ByteCount;
- end;
- function TIdMBCSEncoding.GetPreamble: TIdBytes;
- begin
- {$IFDEF SUPPORTS_CHARSET_ENCODING}
- // RLebeau 5/2/2017: have seen some malformed emails that use 'utf8'
- // instead of 'utf-8', so let's check for that...
- // RLebeau 9/27/2017: updating to handle a few more UTFs without hyphens...
- // TODO: normalize the FCharSet to make comparisons easier...
- case PosInStrArray(FCharSet, ['UTF-8', 'UTF8', 'UTF-16', 'UTF16', 'UTF-16LE', 'UTF16LE', 'UTF-16BE', 'UTF16BE', 'UTF-32', 'UTF32', 'UTF-32LE', 'UTF32LE', 'UTF-32BE', 'UTF32BE'], False) of {do not localize}
- 0, 1: begin
- SetLength(Result, 3);
- Result[0] := $EF;
- Result[1] := $BB;
- Result[2] := $BF;
- end;
- 2..5: begin
- SetLength(Result, 2);
- Result[0] := $FF;
- Result[1] := $FE;
- end;
- 6, 7: begin
- SetLength(Result, 2);
- Result[0] := $FE;
- Result[1] := $FF;
- end;
- 8..11: begin
- SetLength(Result, 4);
- Result[0] := $FF;
- Result[1] := $FE;
- Result[2] := $00;
- Result[3] := $00;
- end;
- 12, 13: begin
- SetLength(Result, 4);
- Result[0] := $00;
- Result[1] := $00;
- Result[2] := $FE;
- Result[3] := $FF;
- end;
- else
- SetLength(Result, 0);
- end;
- {$ELSE}
- {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
- case FCodePage of
- CP_UTF8: begin
- SetLength(Result, 3);
- Result[0] := $EF;
- Result[1] := $BB;
- Result[2] := $BF;
- end;
- 1200: begin
- SetLength(Result, 2);
- Result[0] := $FF;
- Result[1] := $FE;
- end;
- 1201: begin
- SetLength(Result, 2);
- Result[0] := $FE;
- Result[1] := $FF;
- end;
- 12000: begin
- SetLength(Result, 4);
- Result[0] := $FF;
- Result[1] := $FE;
- Result[2] := $00;
- Result[3] := $00;
- end;
- 12001: begin
- SetLength(Result, 4);
- Result[0] := $00;
- Result[1] := $00;
- Result[2] := $FE;
- Result[3] := $FF;
- end;
- else
- SetLength(Result, 0);
- end;
- {$ELSE}
- SetLength(Result, 0);
- ToDo('GetPreamble() method of TIdMBCSEncoding class is not implemented for this platform yet'); {do not localize}
- {$ENDIF}
- {$ENDIF}
- end;
- { TIdUTF7Encoding }
- constructor TIdUTF7Encoding.Create;
- begin
- {$IFDEF SUPPORTS_CHARSET_ENCODING}
- // RLebeau 7/6/2018: iconv does not have a way to query the highest Unicode codepoint
- // a charset supports, let alone the max bytes needed to encode such a codepoint, so
- // the inherited constructor tries to calculate MaxCharSize dynamically, which doesn't
- // work very well for most charsets. Since we already know the exact value to use for
- // this charset, let's just skip the inherited constructor and hard-code the value here...
- //
- //inherited Create('UTF-7'); {do not localize}
- FCharSet := 'UTF-7'; {do not localize};
- FIsSingleByte := False;
- FMaxCharSize := 5;
- {$ELSE}
- {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
- inherited Create(CP_UTF7);
- {$ELSE}
- ToDo('Constructor of TIdUTF7Encoding class is not implemented for this platform yet'); {do not localize}
- {$ENDIF}
- {$ENDIF}
- end;
- function TIdUTF7Encoding.GetMaxByteCount(CharCount: Integer): Integer;
- begin
- Result := (CharCount * 3) + 2;
- end;
- function TIdUTF7Encoding.GetMaxCharCount(ByteCount: Integer): Integer;
- begin
- Result := ByteCount;
- end;
- { TIdUTF8Encoding }
- // TODO: implement UTF-8 manually so we don't have to deal with codepage issues...
- constructor TIdUTF8Encoding.Create;
- begin
- {$IFDEF SUPPORTS_CHARSET_ENCODING}
- // RLebeau 7/6/2018: iconv does not have a way to query the highest Unicode codepoint
- // a charset supports, let alone the max bytes needed to encode such a codepoint, so
- // the inherited constructor tries to calculate MaxCharSize dynamically, which doesn't
- // work very well for most charsets. Since we already know the exact value to use for
- // this charset, let's just skip the inherited constructor and hard-code the value here...
- //
- //inherited Create('UTF-8'); {do not localize}
- FCharSet := 'UTF-8'; {do not localize};
- FIsSingleByte := False;
- FMaxCharSize := 4;
- {$ELSE}
- {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
- inherited Create(CP_UTF8);
- {$ELSE}
- ToDo('Constructor of TIdUTF8Encoding class is not implemented for this platform yet'); {do not localize}
- {$ENDIF}
- {$ENDIF}
- end;
- function TIdUTF8Encoding.GetMaxByteCount(CharCount: Integer): Integer;
- begin
- Result := (CharCount + 1) * 3;
- end;
- function TIdUTF8Encoding.GetMaxCharCount(ByteCount: Integer): Integer;
- begin
- Result := ByteCount + 1;
- end;
- function TIdUTF8Encoding.GetPreamble: TIdBytes;
- begin
- SetLength(Result, 3);
- Result[0] := $EF;
- Result[1] := $BB;
- Result[2] := $BF;
- end;
- { TIdUTF16LittleEndianEncoding }
- constructor TIdUTF16LittleEndianEncoding.Create;
- begin
- inherited Create;
- FIsSingleByte := False;
- FMaxCharSize := 4;
- end;
- function TIdUTF16LittleEndianEncoding.GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer;
- begin
- // TODO: verify UTF-16 sequences
- Result := ACharCount * SizeOf(WideChar);
- end;
- function TIdUTF16LittleEndianEncoding.GetBytes(const AChars: PIdWideChar; ACharCount: Integer;
- ABytes: PByte; AByteCount: Integer): Integer;
- {$IFDEF ENDIAN_BIG}
- var
- I: Integer;
- LChars: PIdWideChar;
- C: UInt16;
- {$ENDIF}
- begin
- // TODO: verify UTF-16 sequences
- {$IFDEF ENDIAN_BIG}
- LChars := AChars;
- for I := ACharCount - 1 downto 0 do
- begin
- C := UInt16(LChars^);
- ABytes^ := Hi(C);
- Inc(ABytes);
- ABytes^ := Lo(C);
- Inc(ABytes);
- Inc(LChars);
- end;
- Result := ACharCount * SizeOf(WideChar);
- {$ELSE}
- Result := ACharCount * SizeOf(WideChar);
- Move(AChars^, ABytes^, Result);
- {$ENDIF}
- end;
- function TIdUTF16LittleEndianEncoding.GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer;
- begin
- // TODO: verify UTF-16 sequences
- Result := AByteCount div SizeOf(WideChar);
- end;
- function TIdUTF16LittleEndianEncoding.GetChars(const ABytes: PByte; AByteCount: Integer;
- AChars: PIdWideChar; ACharCount: Integer): Integer;
- {$IFDEF ENDIAN_BIG}
- var
- LBytes1, LBytes2: PByte;
- I: Integer;
- {$ENDIF}
- begin
- // TODO: verify UTF-16 sequences
- {$IFDEF ENDIAN_BIG}
- LBytes1 := ABytes;
- LBytes2 := ABytes;
- Inc(LBytes2);
- for I := 0 to ACharCount - 1 do
- begin
- AChars^ := WideChar(MakeWord(LBytes2^, LBytes1^));
- Inc(LBytes1, 2);
- Inc(LBytes2, 2);
- Inc(AChars);
- end;
- Result := ACharCount;
- {$ELSE}
- Result := AByteCount div SizeOf(WideChar);
- Move(ABytes^, AChars^, Result * SizeOf(WideChar));
- {$ENDIF}
- end;
- function TIdUTF16LittleEndianEncoding.GetMaxByteCount(CharCount: Integer): Integer;
- begin
- Result := (CharCount + 1) * 2;
- end;
- function TIdUTF16LittleEndianEncoding.GetMaxCharCount(ByteCount: Integer): Integer;
- begin
- Result := (ByteCount div SizeOf(WideChar)) + (ByteCount and 1) + 1;
- end;
- function TIdUTF16LittleEndianEncoding.GetPreamble: TIdBytes;
- begin
- SetLength(Result, 2);
- Result[0] := $FF;
- Result[1] := $FE;
- end;
- { TIdUTF16BigEndianEncoding }
- function TIdUTF16BigEndianEncoding.GetBytes(const AChars: PIdWideChar; ACharCount: Integer;
- ABytes: PByte; AByteCount: Integer): Integer;
- {$IFDEF ENDIAN_LITTLE}
- var
- I: Integer;
- P: PIdWideChar;
- C: UInt16;
- {$ENDIF}
- begin
- {$IFDEF ENDIAN_LITTLE}
- P := AChars;
- for I := ACharCount - 1 downto 0 do
- begin
- C := UInt16(P^);
- ABytes^ := Hi(C);
- Inc(ABytes);
- ABytes^ := Lo(C);
- Inc(ABytes);
- Inc(P);
- end;
- Result := ACharCount * SizeOf(WideChar);
- {$ELSE}
- Result := ACharCount * SizeOf(WideChar);
- Move(AChars^, ABytes^, Result);
- {$ENDIF}
- end;
- function TIdUTF16BigEndianEncoding.GetChars(const ABytes: PByte; AByteCount: Integer;
- AChars: PIdWideChar; ACharCount: Integer): Integer;
- {$IFDEF ENDIAN_LITTLE}
- var
- P1, P2: PByte;
- I: Integer;
- {$ENDIF}
- begin
- {$IFDEF ENDIAN_LITTLE}
- P1 := ABytes;
- P2 := P1;
- Inc(P1);
- for I := 0 to ACharCount - 1 do
- begin
- AChars^ := WideChar(MakeWord(P1^, P2^));
- Inc(P2, 2);
- Inc(P1, 2);
- Inc(AChars);
- end;
- Result := ACharCount;
- {$ELSE}
- Result := AByteCount div SizeOf(WideChar);
- Move(ABytes^, AChars^, Result * SizeOf(WideChar));
- {$ENDIF}
- end;
- function TIdUTF16BigEndianEncoding.GetPreamble: TIdBytes;
- begin
- SetLength(Result, 2);
- Result[0] := $FE;
- Result[1] := $FF;
- end;
- { TIdASCIIEncoding }
- constructor TIdASCIIEncoding.Create;
- begin
- inherited Create;
- FIsSingleByte := True;
- FMaxCharSize := 1;
- end;
- function TIdASCIIEncoding.GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer;
- begin
- // TODO: decode UTF-16 surrogates...
- Result := ACharCount;
- end;
- function TIdASCIIEncoding.GetBytes(const AChars: PIdWideChar; ACharCount: Integer;
- ABytes: PByte; AByteCount: Integer): Integer;
- var
- P: PIdWideChar;
- i : Integer;
- begin
- // TODO: decode UTF-16 surrogates...
- P := AChars;
- Result := IndyMin(ACharCount, AByteCount);
- for i := 1 to Result do begin
- // replace illegal characters > $7F
- if UInt16(P^) > $007F then begin
- ABytes^ := Byte(Ord('?'));
- end else begin
- ABytes^ := Byte(P^);
- end;
- //advance to next char
- Inc(P);
- Inc(ABytes);
- end;
- end;
- function TIdASCIIEncoding.GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer;
- begin
- Result := AByteCount;
- end;
- function TIdASCIIEncoding.GetChars(const ABytes: PByte; AByteCount: Integer;
- AChars: PIdWideChar; ACharCount: Integer): Integer;
- var
- P: PByte;
- i : Integer;
- begin
- P := ABytes;
- Result := IndyMin(ACharCount, AByteCount);
- for i := 1 to Result do begin
- // This is an invalid byte in the ASCII encoding.
- if P^ > $7F then begin
- UInt16(AChars^) := $FFFD;
- end else begin
- UInt16(AChars^) := P^;
- end;
- //advance to next byte
- Inc(AChars);
- Inc(P);
- end;
- end;
- function TIdASCIIEncoding.GetMaxByteCount(ACharCount: Integer): Integer;
- begin
- Result := ACharCount;
- end;
- function TIdASCIIEncoding.GetMaxCharCount(AByteCount: Integer): Integer;
- begin
- Result := AByteCount;
- end;
- { TId8BitEncoding }
- constructor TId8BitEncoding.Create;
- begin
- inherited Create;
- FIsSingleByte := True;
- FMaxCharSize := 1;
- end;
- function TId8BitEncoding.GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer;
- begin
- // TODO: decode UTF-16 surrogates...
- Result := ACharCount;
- end;
- function TId8BitEncoding.GetBytes(const AChars: PIdWideChar; ACharCount: Integer;
- ABytes: PByte; AByteCount: Integer): Integer;
- var
- P: PIdWideChar;
- i : Integer;
- begin
- // TODO: decode UTF-16 surrogates...
- P := AChars;
- Result := IndyMin(ACharCount, AByteCount);
- for i := 1 to Result do begin
- // replace illegal characters > $FF
- if UInt16(P^) > $00FF then begin
- ABytes^ := Byte(Ord('?'));
- end else begin
- ABytes^ := Byte(P^);
- end;
- //advance to next char
- Inc(P);
- Inc(ABytes);
- end;
- end;
- function TId8BitEncoding.GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer;
- begin
- Result := AByteCount;
- end;
- function TId8BitEncoding.GetChars(const ABytes: PByte; AByteCount: Integer;
- AChars: PIdWideChar; ACharCount: Integer): Integer;
- var
- P: PByte;
- i : Integer;
- begin
- P := ABytes;
- Result := IndyMin(ACharCount, AByteCount);
- for i := 1 to Result do begin
- UInt16(AChars^) := P^;
- //advance to next char
- Inc(AChars);
- Inc(P);
- end;
- end;
- function TId8BitEncoding.GetMaxByteCount(ACharCount: Integer): Integer;
- begin
- Result := ACharCount;
- end;
- function TId8BitEncoding.GetMaxCharCount(AByteCount: Integer): Integer;
- begin
- Result := AByteCount;
- end;
- { TIdVCLEncoding }
- {$IFDEF HAS_TEncoding}
- // RLebeau: this is a hack. The protected members of SysUtils.TEncoding are
- // declared as 'STRICT protected', so a regular accessor will not work here.
- // Only descendants can call them, so we have to expose our own methods that
- // this unit can call, and have them call the inherited methods internally.
- type
- TEncodingAccess = class(TEncoding)
- public
- function IndyGetByteCount(Chars: PChar; CharCount: Integer): Integer;
- function IndyGetBytes(Chars: PChar; CharCount: Integer; Bytes: PByte; ByteCount: Integer): Integer;
- function IndyGetCharCount(Bytes: PByte; ByteCount: Integer): Integer;
- function IndyGetChars(Bytes: PByte; ByteCount: Integer; Chars: PChar; CharCount: Integer): Integer;
- end;
- function TEncodingAccess.IndyGetByteCount(Chars: PChar; CharCount: Integer): Integer;
- begin
- Result := GetByteCount(Chars, CharCount);
- end;
- function TEncodingAccess.IndyGetBytes(Chars: PChar; CharCount: Integer; Bytes: PByte; ByteCount: Integer): Integer;
- begin
- Result := GetBytes(Chars, CharCount, Bytes, ByteCount);
- end;
- function TEncodingAccess.IndyGetCharCount(Bytes: PByte; ByteCount: Integer): Integer;
- begin
- Result := GetCharCount(Bytes, ByteCount);
- end;
- function TEncodingAccess.IndyGetChars(Bytes: PByte; ByteCount: Integer;
- Chars: PChar; CharCount: Integer): Integer;
- begin
- Result := GetChars(Bytes, ByteCount, Chars, CharCount);
- end;
- constructor TIdVCLEncoding.Create(AEncoding: TEncoding; AFreeEncoding: Boolean);
- begin
- inherited Create;
- FEncoding := AEncoding;
- FFreeEncoding := AFreeEncoding and not TEncoding.IsStandardEncoding(AEncoding);
- FIsSingleByte := FEncoding.IsSingleByte;
- end;
- {$IFDEF HAS_TEncoding_GetEncoding_ByEncodingName}
- constructor TIdVCLEncoding.Create(const ACharset: String);
- var
- LCharset: string;
- begin
- // RLebeau 5/2/2017: have seen some malformed emails that use 'utf8'
- // instead of 'utf-8', so let's check for that...
- // RLebeau 9/27/2017: updating to handle a few more UTFs without hyphens...
- // normalize ACharset for easier comparisons...
- case PosInStrArray(ACharset, ['UTF7', 'UTF8', 'UTF16', 'UTF16LE', 'UTF16BE', 'UTF32', 'UTF32LE', 'UTF32BE'], False) of {Do not Localize}
- 0: LCharset := 'UTF-7'; {Do not Localize}
- 1: LCharset := 'UTF-8'; {Do not Localize}
- 2,3: LCharset := 'UTF-16LE'; {Do not Localize}
- 4: LCharset := 'UTF-16BE'; {Do not Localize}
- 5,6: LCharset := 'UTF-32LE'; {Do not Localize}
- 7: LCharset := 'UTF-32BE'; {Do not Localize}
- else
- LCharset := ACharset;
- end;
- Create(TEncoding.GetEncoding(LCharset), True);
- end;
- {$ENDIF}
- constructor TIdVCLEncoding.Create(const ACodepage: UInt16);
- begin
- Create(TEncoding.GetEncoding(ACodepage), True);
- end;
- destructor TIdVCLEncoding.Destroy;
- begin
- if FFreeEncoding then begin
- FEncoding.Free;
- end;
- inherited Destroy;
- end;
- function TIdVCLEncoding.GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer;
- begin
- Result := TEncodingAccess(FEncoding).IndyGetByteCount(AChars, ACharCount);
- end;
- function TIdVCLEncoding.GetBytes(const AChars: PIdWideChar; ACharCount: Integer;
- ABytes: PByte; AByteCount: Integer): Integer;
- begin
- Result := TEncodingAccess(FEncoding).IndyGetBytes(AChars, ACharCount, ABytes, AByteCount);
- end;
- function TIdVCLEncoding.GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer;
- begin
- Result := TEncodingAccess(FEncoding).IndyGetCharCount(ABytes, AByteCount);
- end;
- function TIdVCLEncoding.GetChars(const ABytes: PByte; AByteCount: Integer;
- AChars: PIdWideChar; ACharCount: Integer): Integer;
- begin
- Result := TEncodingAccess(FEncoding).IndyGetChars(ABytes, AByteCount, AChars, ACharCount);
- end;
- function TIdVCLEncoding.GetMaxByteCount(ACharCount: Integer): Integer;
- begin
- Result := FEncoding.GetMaxByteCount(ACharCount);
- end;
- function TIdVCLEncoding.GetMaxCharCount(AByteCount: Integer): Integer;
- begin
- Result := FEncoding.GetMaxCharCount(AByteCount);
- end;
- {$ENDIF}
- {$ENDIF}
- function IndyTextEncoding(AType: IdTextEncodingType): IIdTextEncoding;
- begin
- case AType of
- encIndyDefault: Result := IndyTextEncoding_Default;
- // encOSDefault handled further below
- enc8Bit: Result := IndyTextEncoding_8Bit;
- encASCII: Result := IndyTextEncoding_ASCII;
- encUTF16BE: Result := IndyTextEncoding_UTF16BE;
- encUTF16LE: Result := IndyTextEncoding_UTF16LE;
- encUTF7: Result := IndyTextEncoding_UTF7;
- encUTF8: Result := IndyTextEncoding_UTF8;
- else
- // encOSDefault
- Result := IndyTextEncoding_OSDefault;
- end;
- end;
- function IndyTextEncoding(ACodepage: UInt16): IIdTextEncoding;
- begin
- {$IFDEF DOTNET}
- Result := TIdDotNetEncoding.Create(ACodepage);
- {$ELSE}
- case ACodepage of
- 20127:
- Result := IndyTextEncoding_ASCII;
- 1200:
- Result := IndyTextEncoding_UTF16LE;
- 1201:
- Result := IndyTextEncoding_UTF16BE;
- 65000:
- Result := IndyTextEncoding_UTF7;
- 65001:
- Result := IndyTextEncoding_UTF8;
- // TODO: add support for UTF-32...
- else
- {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
- Result := TIdMBCSEncoding.Create(ACodepage);
- {$ELSE}
- {$IFDEF HAS_TEncoding}
- Result := TIdVCLEncoding.Create(ACodepage);
- {$ELSE}
- Result := nil;
- raise EIdException.CreateResFmt(@RSUnsupportedCodePage, [ACodepage]);
- {$ENDIF}
- {$ENDIF}
- end;
- {$ENDIF}
- end;
- function IndyTextEncoding(const ACharSet: String): IIdTextEncoding;
- begin
- {$IFDEF DOTNET}
- Result := TIdDotNetEncoding.Create(ACharSet);
- {$ELSE}
- // TODO: move IdCharsets unit into the System package so the
- // IdGlobalProtocols.CharsetToEncoding() function can be moved
- // into this unit...
- if IsCharsetASCII(ACharSet) then begin
- Result := IndyTextEncoding_ASCII;
- end else begin
- // RLebeau 5/2/2017: have seen some malformed emails that use 'utf8'
- // instead of 'utf-8', so let's check for that...
- // RLebeau 9/27/2017: updating to handle a few more UTFs without hyphens...
- // TODO: normalize ACharSet for easier comparisons...
- case PosInStrArray(ACharSet, ['UTF-7', 'UTF7', 'UTF-8', 'UTF8', 'UTF-16', 'UTF16', 'UTF-16LE', 'UTF16LE', 'UTF-16BE', 'UTF16BE'], False) of {Do not Localize}
- 0, 1: Result := IndyTextEncoding_UTF7;
- 2, 3: Result := IndyTextEncoding_UTF8;
- 4..7: Result := IndyTextEncoding_UTF16LE;
- 8, 9: Result := IndyTextEncoding_UTF16BE;
- // TODO: add support for UTF-32...
- else
- {$IFDEF SUPPORTS_CHARSET_ENCODING}
- Result := TIdMBCSEncoding.Create(ACharSet);
- {$ELSE}
- {$IFDEF HAS_TEncoding_GetEncoding_ByEncodingName}
- Result := TIdVCLEncoding.Create(ACharSet);
- {$ELSE}
- // TODO: provide a hook that IdGlobalProtocols can assign to so we can call
- // CharsetToCodePage() here, at least until CharsetToEncoding() can be moved
- // to this unit once IdCharsets has been moved to the System package...
- Result := nil;
- raise EIdException.CreateFmt(RSUnsupportedCharSet, [ACharSet]);
- {$ENDIF}
- {$ENDIF}
- end;
- end;
- {$ENDIF}
- end;
- {$IFDEF DOTNET}
- function IndyTextEncoding(AEncoding: System.Text.Encoding): IIdTextEncoding;
- begin
- Result := TIdDotNetEncoding.Create(AEncoding);
- end;
- {$ENDIF}
- {$IFDEF HAS_TEncoding}
- function IndyTextEncoding(AEncoding: TEncoding; AFreeEncoding: Boolean = False): IIdTextEncoding;
- begin
- Result := TIdVCLEncoding.Create(AEncoding, AFreeEncoding);
- end;
- {$ENDIF}
- function IndyTextEncoding_Default: IIdTextEncoding;
- var
- LType: IdTextEncodingType;
- begin
- LType := GIdDefaultTextEncoding;
- if LType = encIndyDefault then begin
- LType := encASCII;
- end;
- Result := IndyTextEncoding(LType);
- end;
- function IndyTextEncoding_OSDefault: IIdTextEncoding;
- {$IFNDEF DOTNET}
- var
- LEncoding: IIdTextEncoding;
- {$ENDIF}
- begin
- if GIdOSDefaultEncoding = nil then begin
- {$IFDEF DOTNET}
- // TODO: use thread-safe assignment
- GIdOSDefaultEncoding := TIdDotNetEncoding.Create(System.Text.Encoding.Default);
- {$ELSE}
- // TODO: SysUtils.TEncoding.Default uses ANSI on Windows
- // but uses UTF-8 on POSIX, so we should do the same...
- //LEncoding := {$IFDEF WINDOWS}TIdMBCSEncoding{$ELSE}TIdUTF8Encoding{$ENDIF}.Create;
- LEncoding := TIdMBCSEncoding.Create;
- if InterlockedCompareExchangeIntf(IInterface(GIdOSDefaultEncoding), LEncoding, nil) <> nil then begin
- LEncoding := nil;
- end;
- {$ENDIF}
- end;
- Result := GIdOSDefaultEncoding;
- end;
- function IndyTextEncoding_8Bit: IIdTextEncoding;
- {$IFNDEF DOTNET}
- var
- LEncoding: IIdTextEncoding;
- {$ENDIF}
- begin
- if GId8BitEncoding = nil then begin
- {$IFDEF DOTNET}
- // We need a charset that converts UTF-16 codeunits in the $00-$FF range
- // to/from their numeric values as-is. Was previously using "Windows-1252"
- // which does so for most codeunits, however codeunits $80-$9F in
- // Windows-1252 map to different codepoints in Unicode, which we don't want.
- // "ISO-8859-1" aka "ISO_8859-1:1987" (not to be confused with the older
- // "ISO 8859-1" charset), on the other hand, treats codeunits $00-$FF as-is,
- // and seems to be just as widely supported as Windows-1252 on most systems,
- // so we'll use that for now...
- // TODO: use thread-safe assignment
- GId8BitEncoding := TIdDotNetEncoding.Create('ISO-8859-1');
- {$ELSE}
- LEncoding := TId8BitEncoding.Create;
- if InterlockedCompareExchangeIntf(IInterface(GId8BitEncoding), LEncoding, nil) <> nil then begin
- LEncoding := nil;
- end;
- {$ENDIF}
- end;
- Result := GId8BitEncoding;
- end;
- function IndyTextEncoding_ASCII: IIdTextEncoding;
- {$IFNDEF DOTNET}
- var
- LEncoding: IIdTextEncoding;
- {$ENDIF}
- begin
- if GIdASCIIEncoding = nil then begin
- {$IFDEF DOTNET}
- // TODO: use thread-safe assignment
- GIdASCIIEncoding := TIdDotNetEncoding.Creeate(System.Text.Encoding.ASCII);
- {$ELSE}
- LEncoding := TIdASCIIEncoding.Create;
- if InterlockedCompareExchangeIntf(IInterface(GIdASCIIEncoding), LEncoding, nil) <> nil then begin
- LEncoding := nil;
- end;
- {$ENDIF}
- end;
- Result := GIdASCIIEncoding;
- end;
- function IndyTextEncoding_UTF16BE: IIdTextEncoding;
- {$IFNDEF DOTNET}
- var
- LEncoding: IIdTextEncoding;
- {$ENDIF}
- begin
- if GIdUTF16BigEndianEncoding = nil then begin
- {$IFDEF DOTNET}
- // TODO: use thread-safe assignment
- GIdUTF16BigEndianEncoding := TIdDotNetEncoding.Create(System.Text.Encoding.BigEndianUnicode);
- {$ELSE}
- LEncoding := TIdUTF16BigEndianEncoding.Create;
- if InterlockedCompareExchangeIntf(IInterface(GIdUTF16BigEndianEncoding), LEncoding, nil) <> nil then begin
- LEncoding := nil;
- end;
- {$ENDIF}
- end;
- Result := GIdUTF16BigEndianEncoding;
- end;
- function IndyTextEncoding_UTF16LE: IIdTextEncoding;
- {$IFNDEF DOTNET}
- var
- LEncoding: IIdTextEncoding;
- {$ENDIF}
- begin
- if GIdUTF16LittleEndianEncoding = nil then begin
- {$IFDEF DOTNET}
- // TODO: use thread-safe assignment
- GIdUTF16LittleEndianEncoding := TIdDotNetEncoding.Create(System.Text.Encoding.Unicode);
- {$ELSE}
- LEncoding := TIdUTF16LittleEndianEncoding.Create;
- if InterlockedCompareExchangeIntf(IInterface(GIdUTF16LittleEndianEncoding), LEncoding, nil) <> nil then begin
- LEncoding := nil;
- end;
- {$ENDIF}
- end;
- Result := GIdUTF16LittleEndianEncoding;
- end;
- function IndyTextEncoding_UTF7: IIdTextEncoding;
- {$IFNDEF DOTNET}
- var
- LEncoding: IIdTextEncoding;
- {$ENDIF}
- begin
- if GIdUTF7Encoding = nil then begin
- {$IFDEF DOTNET}
- // TODO: use thread-safe assignment
- GIdUTF7Encoding := TIdDotNetEncoding.Create(System.Text.Encoding.UTF7);
- {$ELSE}
- LEncoding := TIdUTF7Encoding.Create;
- if InterlockedCompareExchangeIntf(IInterface(GIdUTF7Encoding), LEncoding, nil) <> nil then begin
- LEncoding := nil;
- end;
- {$ENDIF}
- end;
- Result := GIdUTF7Encoding;
- end;
- function IndyTextEncoding_UTF8: IIdTextEncoding;
- {$IFNDEF DOTNET}
- var
- LEncoding: IIdTextEncoding;
- {$ENDIF}
- begin
- if GIdUTF8Encoding = nil then begin
- {$IFDEF DOTNET}
- // TODO: use thread-safe assignment
- GIdUTF8Encoding := TIdDotNetEncoding.Create(System.Text.Encoding.UTF8);
- {$ELSE}
- LEncoding := TIdUTF8Encoding.Create;
- if InterlockedCompareExchangeIntf(IInterface(GIdUTF8Encoding), LEncoding, nil) <> nil then begin
- LEncoding := nil;
- end;
- {$ENDIF}
- end;
- Result := GIdUTF8Encoding;
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function enDefault: IIdTextEncoding;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := nil;
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function en7Bit: IIdTextEncoding;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := IndyTextEncoding_ASCII;
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function en8Bit: IIdTextEncoding;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := IndyTextEncoding_8Bit;
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function enUTF8: IIdTextEncoding;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := IndyTextEncoding_UTF8;
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function Indy8BitEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
- {$I IdDeprecatedImplBugOn.inc}
- begin
- {$IFNDEF DOTNET}
- if not AOwnedByIndy then begin
- Result := TId8BitEncoding.Create;
- Exit;
- end;
- {$ENDIF}
- Result := IndyTextEncoding_8Bit;
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function IndyASCIIEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
- {$I IdDeprecatedImplBugOn.inc}
- begin
- {$IFNDEF DOTNET}
- if not AOwnedByIndy then begin
- Result := TIdASCIIEncoding.Create;
- Exit;
- end;
- {$ENDIF}
- Result := IndyTextEncoding_ASCII;
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function IndyUTF16BigEndianEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
- {$I IdDeprecatedImplBugOn.inc}
- begin
- {$IFNDEF DOTNET}
- if not AOwnedByIndy then begin
- Result := TIdUTF16BigEndianEncoding.Create;
- Exit;
- end;
- {$ENDIF}
- Result := IndyTextEncoding_UTF16BE;
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function IndyUTF16LittleEndianEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
- {$I IdDeprecatedImplBugOn.inc}
- begin
- {$IFNDEF DOTNET}
- if not AOwnedByIndy then begin
- Result := TIdUTF16LittleEndianEncoding.Create;
- Exit;
- end;
- {$ENDIF}
- Result := IndyTextEncoding_UTF16LE;
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function IndyOSDefaultEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
- {$I IdDeprecatedImplBugOn.inc}
- begin
- {$IFNDEF DOTNET}
- if not AOwnedByIndy then begin
- // TODO: SysUtils.TEncoding.Default uses ANSI on Windows
- // but uses UTF-8 on POSIX, so we should do the same...
- //Result := {$IFDEF WINDOWS}TIdMBCSEncoding{$ELSE}TIdUTF8Encoding{$ENDIF}.Create;
- Result := TIdMBCSEncoding.Create;
- Exit;
- end;
- {$ENDIF}
- Result := IndyTextEncoding_OSDefault;
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function IndyUTF7Encoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
- {$I IdDeprecatedImplBugOn.inc}
- begin
- {$IFNDEF DOTNET}
- if not AOwnedByIndy then begin
- Result := TIdUTF7Encoding.Create;
- Exit;
- end;
- {$ENDIF}
- Result := IndyTextEncoding_UTF7;
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function IndyUTF8Encoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
- {$I IdDeprecatedImplBugOn.inc}
- begin
- {$IFNDEF DOTNET}
- if not AOwnedByIndy then begin
- Result := TIdUTF8Encoding.Create;
- Exit;
- end;
- {$ENDIF}
- Result := IndyTextEncoding_UTF8;
- end;
- {$IFNDEF DOTNET}
- function GetEncodingCodePage(AEncoding: IIdTextEncoding): UInt16;
- begin
- Result := 0;
- if AEncoding = nil then begin
- Exit;
- end;
- // RLebeau 2/15/2019: AEncoding is checked this way until IIdTextEncoding is updated to expose its assigned CodePage...
- {$IFDEF SUPPORTS_CHARSET_ENCODING}
- {
- if AEncoding is TIdMBCSEncoding then begin
- // TODO: normalize FCharSet for easier comparisons...
- case PosInStrArray(TIdMBCSEncoding(AEncoding).FCharSet, ['UTF-7', 'UTF7', 'UTF-8', 'UTF8', 'UTF-16', 'UTF16', 'UTF-16LE', 'UTF16LE', 'UTF-16BE', 'UTF16BE', 'char', 'ISO-8859-1'], False) of
- 0, 1: Result := 65000;
- 2, 3: Result := 65001;
- 4..7: Result := 1200;
- 8, 9: Result := 1201;
- 10: Result := ($IFDEF HAS_SetCodePage)DefaultSystemCodePage($ELSE)0($ENDIF);
- 11: Result := 28591;
- // TODO: add support for UTF-32...
- else
- if IsCharsetASCII(TIdMBCSEncoding(AEncoding).FCharSet) then begin
- Result := 20127;
- end;
- end;
- end
- else
- }
- {$ELSE}
- {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
- {
- if AEncoding is TIdMBCSEncoding then begin
- Result := TIdMBCSEncoding(AEncoding).FCodePage;
- end
- else
- }
- {$ENDIF}
- {$ENDIF}
- if (AEncoding = GIdOSDefaultEncoding) then
- begin
- {$IFDEF HAS_SetCodePage}
- Result := DefaultSystemCodePage;
- {$ELSE}
- {$IFDEF WINDOWS}
- Result := GetACP();
- {$ENDIF}
- {$ENDIF}
- end
- else if (AEncoding = GId8BitEncoding) {or (AEncoding is TId8BitEncoding)} then
- begin
- Result := 28591;
- end
- else if (AEncoding = GIdASCIIEncoding) {or (AEncoding is TIdASCIIEncoding)} then
- begin
- Result := 20127;
- end
- else if (AEncoding = GIdUTF16BigEndianEncoding) {or (AEncoding is TIdUTF16BigEndianEncoding)} then
- begin
- Result := 1201;
- end
- else if (AEncoding = GIdUTF16LittleEndianEncoding) {or (AEncoding is TIdUTF16LittleEndianEncoding)} then
- begin
- Result := 1200;
- end
- else if (AEncoding = GIdUTF7Encoding) {or (AEncoding is TIdUTF7Encoding)} then
- begin
- Result := 65000;
- end
- else if (AEncoding = GIdUTF8Encoding) {or (AEncoding is TIdUTF8Encoding)} then
- begin
- Result := 65001;
- end;
- end;
- {$ENDIF}
- function LoadLibFunction(const ALibHandle: TIdLibHandle; const AProcName: TIdLibFuncName): Pointer;
- begin
- {$I IdRangeCheckingOff.inc}
- Result := {$IFDEF WINDOWS}Windows.{$ENDIF}GetProcAddress(ALibHandle, PIdLibFuncNameChar(AProcName));
- {$I IdRangeCheckingOn.inc}
- end;
- {$IFDEF UNIX}
- function HackLoadFileName(const ALibName, ALibVer : String) : string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF OSX_OR_IOS}
- Result := ALibName + ALibVer + LIBEXT;
- {$ELSE}
- Result := ALibName + LIBEXT + ALibVer;
- {$ENDIF}
- end;
- function HackLoad(const ALibName : String; const ALibVersions : array of String) : TIdLibHandle;
- var
- i : Integer;
- function LoadLibVer(const ALibVer: string): TIdLibHandle;
- var
- FileName: string;
- begin
- FileName := HackLoadFileName(ALibName, ALibVer);
- {$IFDEF USE_SAFELOADLIBRARY}
- Result := SafeLoadLibrary(FileName);
- {$ELSE}
- {$IFDEF KYLIXCOMPAT}
- // Workaround that is required under Linux (changed RTLD_GLOBAL with RTLD_LAZY Note: also work with LoadLibrary())
- // TODO: use ToSingleByteFileSystemEncodedFileName() to encode the filename:
- // Result := TIdLibHandle(dlopen(PAnsiChar(ToSingleByteFileSystemEncodedFileName(FileName)), RTLD_LAZY));
- // TODO: use dynlibs.SysLoadLibraryU() instead:
- // Result := SysLoadLibraryU(FileName);
- Result := TIdLibHandle(dlopen(PAnsiChar(FileName), RTLD_LAZY));
- {$ELSE}
- Result := LoadLibrary(FileName);
- {$ENDIF}
- {$ENDIF}
- {$IFDEF USE_INVALIDATE_MOD_CACHE}
- InvalidateModuleCache;
- {$ENDIF}
- end;
- begin
- if High(ALibVersions) > -1 then begin
- Result := IdNilHandle;
- for i := Low(ALibVersions) to High(ALibVersions) do
- begin
- Result := LoadLibVer(ALibVersions[i]);
- if Result <> IdNilHandle then begin
- Break;
- end;
- end;
- end else begin
- Result := LoadLibVer('');
- end;
- end;
- {$ENDIF}
- procedure IndyRaiseLastError;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFNDEF HAS_RaiseLastOSError}
- RaiseLastWin32Error;
- {$ELSE}
- RaiseLastOSError;
- {$ENDIF}
- end;
- {$IFDEF HAS_Exception_RaiseOuterException}
- procedure IndyRaiseOuterException(AOuterException: Exception);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Exception.RaiseOuterException(AOuterException);
- end;
- {$ELSE}
- {$IFDEF DCC}
- // RLebeau: There is no Exception.InnerException property to capture the inner
- // exception into, but we can still raise the outer exception using Delphi's
- // 'raise ... at [address]' syntax, at least. This way, the debugger (and
- // exception loggers) can show the outer exception occuring in the caller
- // rather than inside this function...
- {$IFDEF HAS_System_ReturnAddress}
- procedure IndyRaiseOuterException(AOuterException: Exception);
- begin
- raise AOuterException at ReturnAddress;
- end;
- {$ELSE}
- // RLebeau: Delphi RTL functions like SysUtils.Abort(), Classes.TList.Error(),
- // and Classes.TStrings.Error() raise their respective exceptions at the
- // caller's return address using Delphi's 'raise ... at [address]' syntax,
- // however they do so in different ways depending on Delphi version!
- //
- // ----------------
- // SysUtils.Abort()
- // ----------------
- // Delphi 5-2007: Abort() calls an internal helper function that returns the
- // caller's return address from the call stack - [EBP-4] in Delphi 5, [EBP+4]
- // in Delphi 6+ - and then passes that value to 'raise'. Not sure why [EBP-4]
- // was being used in Delphi 5. Maybe a typo?
- //
- // Delphi 2009-XE: Abort() JMP's into an internal helper procedure that takes
- // a Pointer parameter as input (passed in EAX) and passes it to 'raise'.
- // Delphi 2009-2010 POP's the caller's return address from the call stack
- // into EAX. Delphi XE simply MOV's [ESP] into EAX instead.
- // ----------------
- // TList.Error()
- // TStrings.Error()
- // ----------------
- // Delphi 5-2010: Error() calls an internal helper function that returns the
- // caller's return address from the call stack - always [EBP+4] - and then passes
- // that value to 'raise'.
- //
- // Delphi XE: no helper is used. Error() is wrapped with {$O-} to force a stack
- // frame, and then reads the caller's return address directly from the call stack
- // (using pointer math to find it) and passes it to 'raise'.
- // ----------------
- //
- // To be safe, we will use the MOV [ESP] approach here, as it is the simplest.
- // We only have to worry about this in Delphi's Windows 32bit compiler, as the
- // 64bit and mobile compilers have System.ReturnAddress available...
- // disable stack frames to reduce instructions
- {$I IdStackFramesOff.inc}
- procedure IndyRaiseOuterException(AOuterException: Exception);
- procedure RaiseE(E: Exception; ReturnAddr: Pointer);
- begin
- raise E at ReturnAddr;
- end;
- asm
- // AOuterException is already in EAX...
- // MOV EAX, AOuterException
- MOV EDX, [ESP]
- JMP RaiseE
- end;
- {$I IdStackFramesOn.inc}
- {$ENDIF}
- {$ELSE}
- // Not Delphi, so just raise the exception as-is until we know what else to do with it...
- procedure IndyRaiseOuterException(AOuterException: Exception);
- begin
- raise AOuterException;
- end;
- {$ENDIF}
- {$ENDIF}
- {$IFNDEF DOTNET}
- function InterlockedExchangeTHandle(var VTarget: THandle; const AValue: THandle): THandle;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF HAS_TInterlocked}
- {$IFDEF THANDLE_32}
- Result := THandle(TInterlocked.Exchange(Integer(VTarget), Integer(AValue)));
- {$ENDIF}
- //Temporary workaround. TInterlocked for Emb really should accept 64 bit unsigned values as set of parameters
- //for TInterlocked.Exchange since 64-bit wide integers are common on 64 bit platforms.
- {$IFDEF THANDLE_64}
- Result := THandle(TInterlocked.Exchange(Int64(VTarget), Int64(AValue)));
- {$ENDIF}
- {$ELSE}
- {$IFDEF THANDLE_32}
- Result := THandle(InterlockedExchange(Integer(VTarget), Integer(AValue)));
- {$ENDIF}
- {$IFDEF THANDLE_64}
- Result := THandle(InterlockedExchange64(Int64(VTarget), Int64(AValue)));
- {$ENDIF}
- {$ENDIF}
- end;
- function InterlockedExchangeTLibHandle(var VTarget: TIdLibHandle; const AValue: TIdLibHandle): TIdLibHandle;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := TIdLibHandle(
- {$IFDEF HAS_TInterlocked}
- TInterlocked.Exchange(
- {$IFDEF CPU64}
- Int64(VTarget), Int64(AValue)
- {$ELSE}
- Integer(VTarget), Integer(AValue)
- {$ENDIF}
- )
- {$ELSE}
- {$IFDEF CPU64}
- InterlockedExchange64(Int64(VTarget), Int64(AValue))
- {$ELSE}
- InterlockedExchange(Integer(VTarget), Integer(AValue))
- {$ENDIF}
- {$ENDIF}
- );
- end;
- {$UNDEF DYNAMICLOAD_InterlockedCompareExchange}
- {$IFNDEF HAS_TInterlocked}
- {$IFNDEF FPC}
- // RLebeau: InterlockedCompareExchange() is not available prior to Win2K,
- // so need to fallback to some other logic on older systems. Not too many
- // people still support those systems anymore, so we will make this optional.
- //
- // InterlockedCompareExchange64(), on the other hand, is not available until
- // Windows Vista (and not defined in any version of Windows.pas up to Delphi
- // XE), so always dynamically load it in order to support WinXP 64-bit...
- {$IFDEF CPU64}
- {$DEFINE DYNAMICLOAD_InterlockedCompareExchange}
- {$ELSE}
- {.$DEFINE STATICLOAD_InterlockedCompareExchange}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$IFDEF DYNAMICLOAD_InterlockedCompareExchange}
- // See http://code.google.com/p/delphi-toolbox/source/browse/trunk/RTLEx/RTLEx.BasicOp.Atomic.pas
- // for how to perform interlocked operations in assembler...
- type
- TInterlockedCompareExchangeFunc = function(var Destination: PtrInt; Exchange, Comparand: PtrInt): PtrInt; stdcall;
- var
- InterlockedCompareExchange: TInterlockedCompareExchangeFunc = nil;
- function Impl_InterlockedCompareExchange(var Destination: PtrInt; Exchange, Comparand: PtrInt): PtrInt; stdcall;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF CPU64}
- // TODO: use LOCK CMPXCHG8B directly so this is more atomic...
- {$ELSE}
- // TODO: use LOCK CMPXCHG directly so this is more atomic...
- {$ENDIF}
- Result := Destination;
- if Destination = Comparand then begin
- Destination := Exchange;
- end;
- end;
- function Stub_InterlockedCompareExchange(var Destination: PtrInt; Exchange, Comparand: PtrInt): PtrInt; stdcall;
- function GetImpl: Pointer;
- const
- cKernel32 = 'KERNEL32'; {do not localize}
- // TODO: what is Embarcadero's 64-bit define going to be?
- cInterlockedCompareExchange = {$IFDEF CPU64}'InterlockedCompareExchange64'{$ELSE}'InterlockedCompareExchange'{$ENDIF}; {do not localize}
- begin
- Result := LoadLibFunction(GetModuleHandle(cKernel32), cInterlockedCompareExchange);
- if Result = nil then begin
- Result := @Impl_InterlockedCompareExchange;
- end;
- end;
- begin
- @InterlockedCompareExchange := GetImpl();
- Result := InterlockedCompareExchange(Destination, Exchange, Comparand);
- end;
- {$ENDIF}
- function InterlockedCompareExchangePtr(var VTarget: Pointer; const AValue, Compare: Pointer): Pointer;
- {$IFNDEF DYNAMICLOAD_InterlockedCompareExchange}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF DYNAMICLOAD_InterlockedCompareExchange}
- Result := Pointer(IdGlobal.InterlockedCompareExchange(PtrInt(VTarget), PtrInt(AValue), PtrInt(Compare)));
- {$ELSE}
- {$IFDEF HAS_TInterlocked}
- Result := TInterlocked.CompareExchange(VTarget, AValue, Compare);
- {$ELSE}
- {$IFDEF HAS_InterlockedCompareExchangePointer}
- Result := InterlockedCompareExchangePointer(VTarget, AValue, Compare);
- {$ELSE}
- {$IFDEF HAS_InterlockedCompareExchange_Pointers}
- //work around a conflicting definition for InterlockedCompareExchange
- Result := {$IFDEF FPC}system.{$ENDIF}InterlockedCompareExchange(VTarget, AValue, Compare);
- {$ELSE}
- {$IFDEF FPC}
- Result := Pointer(
- {$IFDEF CPU64}InterlockedCompareExchange64{$ELSE}InterlockedCompareExchange{$ENDIF}
- (PtrInt(VTarget), PtrInt(AValue), PtrInt(Compare))
- );
- {$ELSE}
- // Delphi 64-bit is handled by HAS_InterlockedCompareExchangePointer
- Result := Pointer(InterlockedCompareExchange(Integer(VTarget), Integer(AValue), Integer(Compare)));
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- end;
- function InterlockedCompareExchangeObj(var VTarget: TObject; const AValue, Compare: TObject): TObject;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF HAS_TInterlocked}
- // for ARC, we have to use the TObject overload of TInterlocked to ensure
- // that the reference counts of the objects are managed correctly...
- Result := TInterlocked.CompareExchange(VTarget, AValue, Compare);
- {$ELSE}
- Result := TObject(InterlockedCompareExchangePtr(Pointer(VTarget), Pointer(AValue), Pointer(Compare)));
- {$ENDIF}
- end;
- function InterlockedCompareExchangeIntf(var VTarget: IInterface; const AValue, Compare: IInterface): IInterface;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // TInterlocked does not have an overload for IInterface.
- // We have to ensure that the reference counts of the interfaces are managed correctly...
- if AValue <> nil then begin
- AValue._AddRef;
- end;
- Result := IInterface(InterlockedCompareExchangePtr(Pointer(VTarget), Pointer(AValue), Pointer(Compare)));
- if (AValue <> nil) and (Pointer(Result) <> Pointer(Compare)) then begin
- AValue._Release;
- end;
- end;
- {$ENDIF}
- {Little Endian Byte order functions from:
- From: http://community.borland.com/article/0,1410,16854,00.html
- Big-endian and little-endian formated integers - by Borland Developer Support Staff
- Note that I will NOT do big Endian functions because the stacks can handle that
- with HostToNetwork and NetworkToHost functions.
- You should use these functions for writing data that sent and received in Little
- Endian Form. Do NOT assume endianness of what's written. It can work in unpredictable
- ways on other architectures.
- }
- function HostToLittleEndian(const AValue : UInt16) : UInt16;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // TODO: FreePascal has a NtoLE() function in its System unit to
- // "Convert Native-ordered integer to a Little Endian-ordered integer"
- {.$IFDEF FPC}
- //Result := NtoLE(AValue);
- {.$ELSE}
- {$IFDEF DOTNET}
- //I think that is Little Endian but I'm not completely sure
- Result := AValue;
- {$ELSE}
- {$IFDEF ENDIAN_LITTLE}
- Result := AValue;
- {$ENDIF}
- {$IFDEF ENDIAN_BIG}
- Result := swap(AValue);
- {$ENDIF}
- {$ENDIF}
- {.$ENDIF}
- end;
- function HostToLittleEndian(const AValue : UInt32) : UInt32;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // TODO: FreePascal has a NtoLE() function in its System unit to
- // "Convert Native-ordered integer to a Little Endian-ordered integer"
- {.$IFDEF FPC}
- //Result := NtoLE(AValue);
- {.$ELSE}
- {$IFDEF DOTNET}
- //I think that is Little Endian but I'm not completely sure
- Result := AValue;
- {$ELSE}
- {$IFDEF ENDIAN_LITTLE}
- Result := AValue;
- {$ENDIF}
- {$IFDEF ENDIAN_BIG}
- Result := swap(AValue shr 16) or (UInt32(swap(AValue and $FFFF)) shl 16);
- {$ENDIF}
- {$ENDIF}
- {.$ENDIF}
- end;
- function HostToLittleEndian(const AValue : Integer) : Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // TODO: FreePascal has a NtoLE() function in its System unit to
- // "Convert Native-ordered integer to a Little Endian-ordered integer"
- {.$IFDEF FPC}
- //Result := NtoLE(AValue);
- {.$ELSE}
- {$IFDEF DOTNET}
- //I think that is Little Endian but I'm not completely sure
- Result := AValue;
- {$ELSE}
- {$IFDEF ENDIAN_LITTLE}
- Result := AValue;
- {$ENDIF}
- {$IFDEF ENDIAN_BIG}
- Result := swap(AValue);
- {$ENDIF}
- {$ENDIF}
- {.$ENDIF}
- end;
- function LittleEndianToHost(const AValue : UInt16) : UInt16;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // TODO: FreePascal has a LEtoN() function in its System unit to
- // "Convert Little Endian-ordered integer to Native-ordered integer"
- {.$IFDEF FPC}
- //Result := LEtoN(AValue);
- {.$ELSE}
- {$IFDEF DOTNET}
- //I think that is Little Endian but I'm not completely sure
- Result := AValue;
- {$ELSE}
- {$IFDEF ENDIAN_LITTLE}
- Result := AValue;
- {$ENDIF}
- {$IFDEF ENDIAN_BIG}
- Result := swap(AValue);
- {$ENDIF}
- {$ENDIF}
- {.$ENDIF}
- end;
- function LittleEndianToHost(const AValue : UInt32): UInt32;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // TODO: FreePascal has a LEtoN() function in its System unit to
- // "Convert Little Endian-ordered integer to Native-ordered integer"
- {.$IFDEF FPC}
- //Result := LEtoN(AValue);
- {.$ELSE}
- {$IFDEF DOTNET}
- //I think that is Little Endian but I'm not completely sure
- Result := AValue;
- {$ELSE}
- {$IFDEF ENDIAN_LITTLE}
- Result := AValue;
- {$ENDIF}
- {$IFDEF ENDIAN_BIG}
- Result := swap(AValue shr 16) or (UInt32(swap(AValue and $FFFF)) shl 16);
- {$ENDIF}
- {$ENDIF}
- {.$ENDIF}
- end;
- function LittleEndianToHost(const AValue : Integer): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // TODO: FreePascal has a LEtoN() function in its System unit to
- // "Convert Little Endian-ordered integer to Native-ordered integer"
- {.$IFDEF FPC}
- //Result := LEtoN(AValue);
- {.$ELSE}
- {$IFDEF DOTNET}
- //I think that is Little Endian but I'm not completely sure
- Result := AValue;
- {$ELSE}
- {$IFDEF ENDIAN_LITTLE}
- Result := AValue;
- {$ENDIF}
- {$IFDEF ENDIAN_BIG}
- Result := Swap(AValue);
- {$ENDIF}
- {$ENDIF}
- {.$ENDIF}
- end;
- // TODO: add an AIndex parameter
- procedure FillBytes(var VBytes : TIdBytes; const ACount : Integer; const AValue : Byte);
- {$IFDEF STRING_IS_ANSI}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ELSE}
- var
- I: Integer;
- {$ENDIF}
- begin
- // RLebeau: FillChar() is bad to use on Delphi/C++Builder 2009+ for filling
- // byte buffers as it is actually designed for filling character buffers
- // instead. Now that Char maps to WideChar, this causes problems for FillChar().
- {$IFDEF STRING_IS_UNICODE}
- //System.&Array.Clear(VBytes, 0, ACount);
- // TODO: optimize this
- for I := 0 to ACount-1 do begin
- VBytes[I] := AValue;
- end;
- {$ELSE}
- FillChar(VBytes[0], ACount, AValue);
- {$ENDIF}
- end;
- // RLebeau 10/22/2013: prior to Delphi 2010, fmCreate was an all-encompassing
- // bitmask, no other flags could be combined with it. The RTL was updated in
- // Delphi 2010 to allow other flags to be specified along with fmCreate. So
- // at best, we will now be able to allow read-only access to other processes
- // in Delphi 2010 and later, and at worst we will continue having exclusive
- // rights to the file in Delphi 2009 and earlier, just like we always did...
- constructor TIdFileCreateStream.Create(const AFile : String);
- begin
- inherited Create(AFile, fmCreate or fmOpenReadWrite or fmShareDenyWrite);
- end;
- constructor TIdAppendFileStream.Create(const AFile : String);
- begin
- if FileExists(AFile) then begin
- inherited Create(AFile, fmOpenReadWrite or fmShareDenyWrite);
- TIdStreamHelper.Seek(Self, 0, soEnd);
- end
- else begin
- inherited Create(AFile, fmCreate or fmOpenReadWrite or fmShareDenyWrite);
- end;
- end;
- constructor TIdReadFileNonExclusiveStream.Create(const AFile : String);
- begin
- inherited Create(AFile, fmOpenRead or fmShareDenyNone);
- end;
- constructor TIdReadFileExclusiveStream.Create(const AFile : String);
- begin
- inherited Create(AFile, fmOpenRead or fmShareDenyWrite);
- end;
- function IsASCIILDH(const AByte: Byte): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := True;
- //Verify the absence of non-LDH ASCII code points; that is, the
- //absence of 0..2C, 2E..2F, 3A..40, 5B..60, and 7B..7F.
- //Permissable chars are in this set
- //['-','0'..'9','A'..'Z','a'..'z']
- if AByte <= $2C then begin
- Result := False;
- end
- else if (AByte >= $2E) and (AByte <= $2F) then begin
- Result := False;
- end
- else if (AByte >= $3A) and (AByte <= $40) then begin
- Result := False;
- end
- else if (AByte >= $5B) and (AByte <= $60) then begin
- Result := False;
- end
- else if (AByte >= $7B) and (AByte <= $7F) then begin
- Result := False;
- end;
- end;
- function IsASCIILDH(const ABytes: TIdBytes): Boolean;
- var
- i: Integer;
- begin
- for i := 0 to Length(ABytes)-1 do begin
- if not IsASCIILDH(ABytes[i]) then
- begin
- Result := False;
- Exit;
- end;
- end;
- Result := True;
- end;
- function IsASCII(const AByte: Byte): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := AByte <= $7F;
- end;
- function IsASCII(const ABytes: TIdBytes): Boolean;
- var
- i: Integer;
- begin
- for i := 0 to Length(ABytes) -1 do begin
- if not IsASCII(ABytes[i]) then begin
- Result := False;
- Exit;
- end;
- end;
- Result := True;
- end;
- function StartsWithACE(const ABytes: TIdBytes): Boolean;
- const
- cDash = Ord('-');
- var
- LS: {$IFDEF STRING_IS_IMMUTABLE}TIdStringBuilder{$ELSE}string{$ENDIF};
- begin
- Result := False;
- if Length(ABytes) >= 4 then
- begin
- if (ABytes[2] = cDash) and (ABytes[3] = cDash) then
- begin
- // TODO: just do byte comparisons so String conversions are not needed...
- {$IFDEF STRING_IS_IMMUTABLE}
- LS := TIdStringBuilder.Create(2);
- LS.Append(Char(ABytes[0]));
- LS.Append(Char(ABytes[1]));
- {$ELSE}
- SetLength(LS, 2);
- LS[1] := Char(ABytes[0]);
- LS[2] := Char(ABytes[1]);
- {$ENDIF}
- Result := PosInStrArray(LS{$IFDEF STRING_IS_IMMUTABLE}.ToString{$ENDIF},
- ['bl','bq','dq','lq','mq','ra','wq','zq'], False) > -1;{do not localize}
- end;
- end;
- end;
- function PosInSmallIntArray(const ASearchInt: Int16; const AArray: array of Int16): Integer;
- begin
- for Result := Low(AArray) to High(AArray) do begin
- if ASearchInt = AArray[Result] then begin
- Exit;
- end;
- end;
- Result := -1;
- end;
- {This searches an array of string for an occurance of SearchStr}
- function PosInStrArray(const SearchStr: string; const Contents: array of string; const CaseSensitive: Boolean = True): Integer;
- begin
- for Result := Low(Contents) to High(Contents) do begin
- if CaseSensitive then begin
- if SearchStr = Contents[Result] then begin
- Exit;
- end;
- end else begin
- if TextIsSame(SearchStr, Contents[Result]) then begin
- Exit;
- end;
- end;
- end;
- Result := -1;
- end;
- //IPv4 address conversion
- function ByteToHex(const AByte: Byte): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$IFDEF STRING_IS_IMMUTABLE}
- var
- LSB: TIdStringBuilder;
- {$ENDIF}
- begin
- {$IFDEF STRING_IS_IMMUTABLE}
- LSB := TIdStringBuilder.Create(2);
- LSB.Append(IdHexDigits[(AByte and $F0) shr 4]);
- LSB.Append(IdHexDigits[AByte and $F]);
- Result := LSB.ToString;
- {$ELSE}
- SetLength(Result, 2);
- Result[1] := IdHexDigits[(AByte and $F0) shr 4];
- Result[2] := IdHexDigits[AByte and $F];
- {$ENDIF}
- end;
- function UInt32ToHex(const ALongWord : UInt32) : String;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := ByteToHex((ALongWord and $FF000000) shr 24)
- + ByteToHex((ALongWord and $00FF0000) shr 16)
- + ByteToHex((ALongWord and $0000FF00) shr 8)
- + ByteToHex(ALongWord and $000000FF);
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function LongWordToHex(const ALongWord : UInt32) : String;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := UInt32ToHex(ALongWord);
- end;
- function ToHex(const AValue: TIdBytes; const ACount: Integer = -1;
- const AIndex: Integer = 0): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- I, LCount: Integer;
- CH1, CH2: Char;
- {$IFDEF STRING_IS_IMMUTABLE}
- LSB: TIdStringBuilder;
- {$ELSE}
- LOffset: Integer;
- {$ENDIF}
- begin
- Result := '';
- LCount := IndyLength(AValue, ACount, AIndex);
- if LCount > 0 then begin
- {$IFDEF STRING_IS_IMMUTABLE}
- LSB := TIdStringBuilder.Create(LCount*2);
- {$ELSE}
- SetLength(Result, LCount*2);
- LOffset := 0;
- {$ENDIF}
- for I := 0 to LCount-1 do begin
- CH1 := IdHexDigits[(AValue[AIndex+I] and $F0) shr 4];
- CH2 := IdHexDigits[AValue[AIndex+I] and $F];
- {$IFDEF STRING_IS_IMMUTABLE}
- LSB.Append(CH1);
- LSB.Append(CH2);
- {$ELSE}
- Result[LOffset+1] := CH1;
- Result[LOffset+2] := CH2;
- Inc(LOffset, 2);
- {$ENDIF}
- end;
- {$IFDEF STRING_IS_IMMUTABLE}
- Result := LSB.ToString;
- {$ENDIF}
- end;
- end;
- function ToHex(const AValue: array of UInt32): string;
- var
- {$IFDEF STRING_IS_IMMUTABLE}
- LSB: TIdStringBuilder;
- {$ENDIF}
- P: {$IFDEF DOTNET}TIdBytes{$ELSE}PByteArray{$ENDIF};
- i, j: Integer;
- begin
- Result := '';
- if Length(AValue) > 0 then
- begin
- {$IFDEF STRING_IS_IMMUTABLE}
- LSB := TIdStringBuilder.Create(Length(AValue)*SizeOf(UInt32)*2);
- {$ELSE}
- SetLength(Result, Length(AValue)*SizeOf(UInt32)*2);
- {$ENDIF}
- for i := 0 to High(AValue) do begin
- {$IFDEF DOTNET}
- P := ToBytes(AValue[i]);
- {$ELSE}
- P := PByteArray(@AValue[i]);
- {$ENDIF}
- for j := 0 to SizeOf(UInt32)-1 do begin
- {$IFDEF STRING_IS_IMMUTABLE}
- LSB.Append(IdHexDigits[(P[j] and $F0) shr 4]);
- LSB.Append(IdHexDigits[P[j] and $F]);
- {$ELSE}
- Result[(i*SizeOf(UInt32))+(j*2)+1] := IdHexDigits[(P^[j] and $F0) shr 4];
- Result[(i*SizeOf(UInt32))+(j*2)+2] := IdHexDigits[P^[j] and $F];
- {$ENDIF}
- end;
- end;//for
- {$IFDEF STRING_IS_IMMUTABLE}
- Result := LSB.ToString;
- {$ENDIF}
- end;
- end;
- function IPv4ToHex(const AIPAddress: string; const ADotted: Boolean): string;
- var
- i: Integer;
- LBuf, LTmp: string;
- begin
- LBuf := Trim(AIPAddress);
- Result := IdHexPrefix;
- for i := 0 to 3 do begin
- LTmp := ByteToHex(IndyStrToInt(Fetch(LBuf, '.', True)));
- if ADotted then begin
- Result := Result + '.' + IdHexPrefix + LTmp;
- end else begin
- Result := Result + LTmp;
- end;
- end;
- end;
- {$IFNDEF DOTNET}
- function OctalToInt64(const AValue: string): Int64;
- var
- i: Integer;
- begin
- Result := 0;
- for i := 1 to Length(AValue) do begin
- Result := (Result shl 3) + IndyStrToInt(AValue[i], 0);
- end;
- end;
- {$ENDIF}
- function ByteToOctal(const AByte: Byte): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$IFDEF STRING_IS_IMMUTABLE}
- var
- LSB: TIdStringBuilder;
- C: Char;
- {$ENDIF}
- begin
- {$IFDEF STRING_IS_IMMUTABLE}
- C := IdOctalDigits[(AByte shr 6) and $7];
- if C <> '0' then begin
- LSB := TIdStringBuilder.Create(4);
- LSB.Append(Char('0')); {do not localize}
- end else begin
- LSB := TIdStringBuilder.Create(3);
- end;
- LSB.Append(C);
- LSB.Append(IdOctalDigits[(AByte shr 3) and $7]);
- LSB.Append(IdOctalDigits[AByte and $7]);
- Result := LSB.ToString;
- {$ELSE}
- SetLength(Result, 3);
- Result[1] := IdOctalDigits[(AByte shr 6) and $7];
- Result[2] := IdOctalDigits[(AByte shr 3) and $7];
- Result[3] := IdOctalDigits[AByte and $7];
- if Result[1] <> '0' then begin {do not localize}
- Result := '0' + Result; {do not localize}
- end;
- {$ENDIF}
- end;
- function IPv4ToOctal(const AIPAddress: string): string;
- var
- i: Integer;
- LBuf: string;
- begin
- LBuf := Trim(AIPAddress);
- Result := ByteToOctal(IndyStrToInt(Fetch(LBuf, '.', True), 0));
- for i := 0 to 2 do begin
- Result := Result + '.' + ByteToOctal(IndyStrToInt(Fetch(LBuf, '.', True), 0));
- end;
- end;
- procedure CopyTIdBytes(const ASource: TIdBytes; const ASourceIndex: Integer;
- var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- System.array.Copy(ASource, ASourceIndex, VDest, ADestIndex, ALength);
- {$ELSE}
- //if these asserts fail, then it indicates an attempted buffer overrun.
- Assert(ASourceIndex >= 0);
- Assert((ASourceIndex+ALength) <= Length(ASource));
- if ALength > 0 then
- Move(ASource[ASourceIndex], VDest[ADestIndex], ALength);
- {$ENDIF}
- end;
- procedure CopyTIdChar(const ASource: Char; var VDest: TIdBytes; const ADestIndex: Integer;
- ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- );
- var
- LChars: {$IFDEF DOTNET}array[0..0] of Char{$ELSE}TIdWideChars{$ENDIF};
- begin
- EnsureEncoding(ADestEncoding);
- {$IFDEF STRING_IS_UNICODE}
- {$IFNDEF DOTNET}
- SetLength(LChars, 1);
- {$ENDIF}
- LChars[0] := ASource;
- ADestEncoding.GetBytes(LChars, 0, 1, VDest, ADestIndex);
- {$ELSE}
- EnsureEncoding(ASrcEncoding, encOSDefault);
- LChars := ASrcEncoding.GetChars(RawToBytes(ASource, 1));
- ADestEncoding.GetBytes(LChars, 0, Length(LChars), VDest, ADestIndex);
- {$ENDIF}
- end;
- procedure CopyTIdInt16(const ASource: Int16; var VDest: TIdBytes; const ADestIndex: Integer);
- {$IFDEF DOTNET}
- var
- LShort : TIdBytes;
- {$ELSE}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF DOTNET}
- LShort := System.BitConverter.GetBytes(ASource);
- System.array.Copy(LShort, 0, VDest, ADestIndex, SizeOf(Int16));
- {$ELSE}
- PInt16(@VDest[ADestIndex])^ := ASource;
- {$ENDIF}
- end;
- {$I IdDeprecatedImplBugOff.inc}
- procedure CopyTIdShort(const ASource: Int16; var VDest: TIdBytes; const ADestIndex: Integer);
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- CopyTIdInt16(ASource, VDest, ADestIndex);
- end;
- procedure CopyTIdUInt16(const ASource: UInt16; var VDest: TIdBytes; const ADestIndex: Integer);
- {$IFDEF DOTNET}
- var
- LWord : TIdBytes;
- {$ELSE}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF DOTNET}
- LWord := System.BitConverter.GetBytes(ASource);
- System.array.Copy(LWord, 0, VDest, ADestIndex, SizeOf(UInt16));
- {$ELSE}
- PUInt16(@VDest[ADestIndex])^ := ASource;
- {$ENDIF}
- end;
- {$I IdDeprecatedImplBugOff.inc}
- procedure CopyTIdWord(const ASource: UInt16; var VDest: TIdBytes; const ADestIndex: Integer);
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- CopyTIdUInt16(ASource, VDest, ADestIndex);
- end;
- procedure CopyTIdUInt32(const ASource: UInt32; var VDest: TIdBytes; const ADestIndex: Integer);
- {$IFDEF DOTNET}
- var
- LWord : TIdBytes;
- {$ELSE}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF DOTNET}
- LWord := System.BitConverter.GetBytes(ASource);
- System.array.Copy(LWord, 0, VDest, ADestIndex, SizeOf(UInt32));
- {$ELSE}
- PUInt32(@VDest[ADestIndex])^ := ASource;
- {$ENDIF}
- end;
- {$I IdDeprecatedImplBugOff.inc}
- procedure CopyTIdLongWord(const ASource: UInt32; var VDest: TIdBytes; const ADestIndex: Integer);
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- CopyTIdUInt32(ASource, VDest, ADestIndex);
- end;
- procedure CopyTIdInt32(const ASource: Int32; var VDest: TIdBytes; const ADestIndex: Integer);
- {$IFDEF DOTNET}
- var
- LInt : TIdBytes;
- {$ELSE}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF DOTNET}
- LInt := System.BitConverter.GetBytes(ASource);
- System.array.Copy(LInt, 0, VDest, ADestIndex, SizeOf(Int32));
- {$ELSE}
- PInt32(@VDest[ADestIndex])^ := ASource;
- {$ENDIF}
- end;
- {$I IdDeprecatedImplBugOff.inc}
- procedure CopyTIdLongInt(const ASource: Int32; var VDest: TIdBytes; const ADestIndex: Integer);
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- CopyTIdInt32(ASource, VDest, ADestIndex);
- end;
- procedure CopyTIdInt64(const ASource: Int64; var VDest: TIdBytes; const ADestIndex: Integer);
- {$IFDEF DOTNET}
- var
- LWord : TIdBytes;
- {$ELSE}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF DOTNET}
- LWord := System.BitConverter.GetBytes(ASource);
- System.array.Copy(LWord, 0, VDest, ADestIndex, SizeOf(Int64));
- {$ELSE}
- PInt64(@VDest[ADestIndex])^ := ASource;
- {$ENDIF}
- end;
- procedure CopyTIdUInt64(const ASource: TIdUInt64;
- var VDest: TIdBytes; const ADestIndex: Integer);
- {$IFDEF DOTNET}
- var
- LWord : TIdBytes;
- {$ELSE}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF DOTNET}
- LWord := System.BitConverter.GetBytes(ASource);
- System.array.Copy(LWord, 0, VDest, ADestIndex, SizeOf(UInt64));
- {$ELSE}
- PUInt64(@VDest[ADestIndex])^ := ASource{$IFDEF TIdUInt64_HAS_QuadPart}.QuadPart{$ENDIF};
- {$ENDIF}
- end;
- {$IFDEF UInt64_IS_NATIVE}
- {$IFDEF TIdUInt64_HAS_QuadPart}
- {$DEFINE USE_TIdTicks_TIdUInt64_CONVERSION}
- {$ENDIF}
- {$ENDIF}
- procedure CopyTIdTicks(const ASource: TIdTicks; var VDest: TIdBytes; const ADestIndex: Integer);
- {$IFDEF USE_TIdTicks_TIdUInt64_CONVERSION}
- var
- LValue: TIdUInt64;
- {$ELSE}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF USE_TIdTicks_TIdUInt64_CONVERSION}
- // In C++Builder 2006/2007, TIdUInt64 is a packed record, but TIdTicks is
- // an alias for a native UInt64, so need a conversion here to get around
- // a compiler error: "E2010 Incompatible types: 'TIdUInt64' and 'UInt64'"...
- LValue.QuadPart := ASource;
- CopyTIdUInt64(LValue, VDest, ADestIndex);
- {$ELSE}
- {$IFDEF UInt64_IS_NATIVE}
- CopyTIdUInt64(ASource, VDest, ADestIndex);
- {$ELSE}
- CopyTIdInt64(ASource, VDest, ADestIndex);
- {$ENDIF}
- {$ENDIF}
- end;
- procedure CopyTIdIPV6Address(const ASource: TIdIPv6Address; var VDest: TIdBytes; const ADestIndex: Integer);
- {$IFDEF DOTNET}
- var
- i : Integer;
- {$ELSE}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF DOTNET}
- for i := 0 to 7 do begin
- CopyTIdUInt16(ASource[i], VDest, ADestIndex + (i * 2));
- end;
- {$ELSE}
- Move(ASource, VDest[ADestIndex], 16);
- {$ENDIF}
- end;
- procedure CopyTIdByteArray(const ASource: array of Byte; const ASourceIndex: Integer;
- var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer);
- begin
- {$IFDEF DOTNET}
- System.array.Copy(ASource, ASourceIndex, VDest, ADestIndex, ALength);
- {$ELSE}
- Move(ASource[ASourceIndex], VDest[ADestIndex], ALength);
- {$ENDIF}
- end;
- procedure CopyTIdString(const ASource: String; var VDest: TIdBytes;
- const ADestIndex: Integer; const ALength: Integer = -1;
- ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ); overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- CopyTIdString(ASource, 1, VDest, ADestIndex, ALength, ADestEncoding
- {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
- );
- end;
- procedure CopyTIdString(const ASource: String; const ASourceIndex: Integer;
- var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer = -1;
- ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ); overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LLength: Integer;
- {$IFDEF STRING_IS_ANSI}
- LTmp: TIdWideChars;
- {$ENDIF}
- begin
- {$IFDEF STRING_IS_ANSI}
- LTmp := nil; // keep the compiler happy
- {$ENDIF}
- LLength := IndyLength(ASource, ALength, ASourceIndex);
- if LLength > 0 then begin
- EnsureEncoding(ADestEncoding);
- {$IFDEF STRING_IS_UNICODE}
- ADestEncoding.GetBytes(ASource, ASourceIndex, LLength, VDest, ADestIndex);
- {$ELSE}
- EnsureEncoding(ASrcEncoding, encOSDefault);
- LTmp := ASrcEncoding.GetChars(RawToBytes(ASource[ASourceIndex], LLength)); // convert to Unicode
- ADestEncoding.GetBytes(LTmp, 0, Length(LTmp), VDest, ADestIndex);
- {$ENDIF}
- end;
- end;
- // TODO: define STRING_UNICODE_MISMATCH for WinCE in IdCompilerDefines.inc?
- {$IFDEF WINDOWS}
- {$IFDEF WINCE}
- {$IFNDEF STRING_IS_UNICODE}
- {$DEFINE DEBUG_STRING_MISMATCH}
- {$ENDIF}
- {$ELSE}
- {$IFDEF STRING_UNICODE_MISMATCH}
- {$DEFINE DEBUG_STRING_MISMATCH}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- procedure DebugOutput(const AText: string);
- {$IFDEF DEBUG_STRING_MISMATCH}
- var
- LTemp: {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF};
- {$ELSE}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- begin
- // TODO: support other debugging platforms
- {$IFDEF KYLIX}
- __write(stderr, AText, Length(AText));
- __write(stderr, EOL, Length(EOL));
- {$ENDIF}
- {$IFDEF WINDOWS}
- {$IFDEF DEBUG_STRING_MISMATCH}
- LTemp := {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF}(AText); // explicit convert to Ansi/Unicode
- OutputDebugString({$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF}(LTemp));
- {$ELSE}
- OutputDebugString(PChar(AText));
- {$ENDIF}
- {$ENDIF}
- {$IFDEF DOTNET}
- System.Diagnostics.Debug.WriteLine(AText);
- {$ENDIF}
- end;
- function CurrentThreadId: TIdThreadID;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- {$IFDEF DOTNET_2_OR_ABOVE}
- {
- [Warning] IdGlobal.pas(1416): W1000 Symbol 'GetCurrentThreadId'
- is deprecated: 'AppDomain.GetCurrentThreadId has been deprecated because
- it does not provide a stable Id when managed threads are running on fibers
- (aka lightweight threads). To get a stable identifier for a managed thread,
- use the ManagedThreadId property on Thread.
- http://go.microsoft.com/fwlink/?linkid=14202'
- }
- Result := System.Threading.Thread.CurrentThread.ManagedThreadId;
- // Thread.ManagedThreadId;
- {$ENDIF}
- {$IFDEF DOTNET_1_1}
- // SG: I'm not sure if this return the handle of the dotnet thread or the handle of the application domain itself (or even if there is a difference)
- Result := AppDomain.GetCurrentThreadId;
- // RLebeau
- // TODO: find if there is something like the following instead:
- // System.Diagnostics.Thread.GetCurrentThread.ID
- // System.Threading.Thread.CurrentThread.ID
- {$ENDIF}
- {$ELSE}
- // TODO: is GetCurrentThreadId() available on Linux?
- Result := GetCurrentThreadID;
- {$ENDIF}
- end;
- {$UNDEF KYLIXCOMPAT_OR_VCL_POSIX}
- {$IFDEF KYLIXCOMPAT}
- {$DEFINE KYLIXCOMPAT_OR_VCL_POSIX}
- {$ENDIF}
- {$IFDEF USE_VCL_POSIX}
- {$DEFINE KYLIXCOMPAT_OR_VCL_POSIX}
- {$ENDIF}
- function CurrentProcessId: TIdPID;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := System.Diagnostics.Process.GetCurrentProcess.ID;
- {$ELSE}
- {$IFDEF WINDOWS}
- Result := GetCurrentProcessID;
- {$ELSE}
- {$IFDEF KYLIXCOMPAT_OR_VCL_POSIX}
- Result := getpid;
- {$ELSE}
- {$IFDEF USE_BASEUNIX}
- Result := fpgetpid;
- {$ELSE}
- {$message error CurrentProcessId is not implemented on this platform!}
- Result := 0;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- end;
- function Fetch(var AInput: string; const ADelim: string = IdFetchDelimDefault;
- const ADelete: Boolean = IdFetchDeleteDefault;
- const ACaseSensitive: Boolean = IdFetchCaseSensitiveDefault): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LPos: Integer;
- begin
- if ACaseSensitive then begin
- if ADelim = #0 then begin
- // AnsiPos does not work with #0
- LPos := Pos(ADelim, AInput);
- end else begin
- LPos := IndyPos(ADelim, AInput);
- end;
- if LPos = 0 then begin
- Result := AInput;
- if ADelete then begin
- AInput := ''; {Do not Localize}
- end;
- end
- else begin
- Result := Copy(AInput, 1, LPos - 1);
- if ADelete then begin
- //slower Delete(AInput, 1, LPos + Length(ADelim) - 1); because the
- //remaining part is larger than the deleted
- AInput := Copy(AInput, LPos + Length(ADelim), MaxInt);
- end;
- end;
- end else begin
- Result := FetchCaseInsensitive(AInput, ADelim, ADelete);
- end;
- end;
- function FetchCaseInsensitive(var AInput: string; const ADelim: string;
- const ADelete: Boolean): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LPos: Integer;
- begin
- if ADelim = #0 then begin
- // AnsiPos does not work with #0
- LPos := Pos(ADelim, AInput);
- end else begin
- //? may be AnsiUpperCase?
- LPos := IndyPos(UpperCase(ADelim), UpperCase(AInput));
- end;
- if LPos = 0 then begin
- Result := AInput;
- if ADelete then begin
- AInput := ''; {Do not Localize}
- end;
- end else begin
- Result := Copy(AInput, 1, LPos - 1);
- if ADelete then begin
- //faster than Delete(AInput, 1, LPos + Length(ADelim) - 1); because the
- //remaining part is larger than the deleted
- AInput := Copy(AInput, LPos + Length(ADelim), MaxInt);
- end;
- end;
- end;
- function GetThreadHandle(AThread: TThread): TIdThreadHandle;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF UNIX}
- Result := AThread.ThreadID; // RLebeau: is it right to return an ID where a thread object handle is expected instead?
- {$ENDIF}
- {$IFDEF WINDOWS}
- Result := AThread.Handle;
- {$ENDIF}
- {$IFDEF DOTNET}
- Result := AThread.Handle;
- {$ENDIF}
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function Ticks: UInt32;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // TODO: maybe throw an exception if Ticks64() exceeds the 49.7 day limit of UInt32?
- Result := UInt32(Ticks64() mod High(UInt32));
- end;
- // RLebeau: breaking up the Ticks64() implementation into separate platform blocks,
- // instead of trying to do it all in one implementation. This way, the code is
- // cleaner, and if I miss a platform then the compiler should complain about Ticks64()
- // being unresolved...
- // TODO: move these to platform-specific units instead, maybe even to the TIdStack classes?
- {$IFDEF DOTNET}
- function Ticks64: TIdTicks;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // Must cast to a cardinal
- //
- // http://lists.ximian.com/archives/public/mono-bugs/2003-November/009293.html
- // Other references in Google.
- // Bug in .NET. It acts like Win32, not as per .NET docs but goes negative after 25 days.
- //
- // There may be a problem in the future if .NET changes this to work as docced with 25 days.
- // Will need to check our routines then and somehow counteract / detect this.
- // One possibility is that we could just wrap it ourselves in this routine.
- // TODO: use DateTime.Ticks instead?
- //Result := DateTime.Now.Ticks div 10000;
- Result := TIdTicks(Environment.TickCount);
- end;
- {$ELSE}
- {$IFDEF WINDOWS}
- type
- TGetTickCount64Func = function: UInt64; stdcall;
- var
- GetTickCount64: TGetTickCount64Func = nil;
- function Impl_GetTickCount64: UInt64; stdcall;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // TODO: implement some kind of accumulator so the Result
- // keeps growing even when GetTickCount() wraps back to 0.
- // Or maybe access the CPU's TSC via the x86 RDTSC instruction...
- Result := UInt64(Windows.GetTickCount);
- end;
- function Stub_GetTickCount64: UInt64; stdcall;
- function GetImpl: Pointer;
- begin
- Result := LoadLibFunction(GetModuleHandle('KERNEL32'), 'GetTickCount64'); {do not localize}
- if Result = nil then begin
- Result := @Impl_GetTickCount64;
- end;
- end;
- begin
- @GetTickCount64 := GetImpl();
- Result := GetTickCount64();
- end;
- function Ticks64: TIdTicks;
- {$IFDEF USE_HI_PERF_COUNTER_FOR_TICKS}
- var
- nTime, freq: {$IFDEF WINCE}LARGE_INTEGER{$ELSE}Int64{$ENDIF};
- {$ENDIF}
- begin
- // S.G. 27/11/2002: Changed to use high-performance counters as per suggested
- // S.G. 27/11/2002: by David B. Ferguson ([email protected])
- // RLebeau 11/12/2009: removed the high-performance counters again. They
- // are not reliable on multi-core systems, and are now starting to cause
- // problems with TIdIOHandler.ReadLn() timeouts under Windows XP SP3, both
- // 32-bit and 64-bit. Refer to these discussions:
- //
- // http://www.virtualdub.org/blog/pivot/entry.php?id=106
- // http://blogs.msdn.com/oldnewthing/archive/2008/09/08/8931563.aspx
- {$IFDEF USE_HI_PERF_COUNTER_FOR_TICKS}
- {$IFDEF WINCE}
- if Windows.QueryPerformanceCounter(@nTime) then begin
- if Windows.QueryPerformanceFrequency(@freq) then begin
- Result := Trunc((nTime.QuadPart / Freq.QuadPart) * 1000) and High(TIdTicks);
- Exit;
- end;
- end;
- {$ELSE}
- if Windows.QueryPerformanceCounter(nTime) then begin
- if Windows.QueryPerformanceFrequency(freq) then begin
- Result := Trunc((nTime / Freq) * 1000) and High(TIdTicks);
- Exit;
- end;
- end;
- {$ENDIF}
- {$ENDIF}
- Result := TIdTicks(GetTickCount64());
- end;
- {$ELSE}
- {$IFDEF USE_clock_gettime}
- {$IFDEF LINUX}
- // according to Linux's /usr/include/linux/time.h
- const
- CLOCK_MONOTONIC = 1;
- {$ENDIF}
- {$IFDEF FREEBSD}
- // according to FreeBSD's /usr/include/time.h
- const
- CLOCK_MONOTONIC = 4;
- {$ENDIF}
- {$IFDEF ANDROID}
- // according to Android NDK's /include/time.h
- const
- CLOCK_MONOTONIC = 1;
- {$ENDIF}
- function clock_gettime(clockid: Integer; var pts: timespec): Integer; cdecl; external 'libc';
- function Ticks64: TIdTicks;
- var
- ts: timespec;
- begin
- // TODO: use CLOCK_BOOTTIME on platforms that support it? It takes system
- // suspension into account, whereas CLOCK_MONOTONIC does not...
- clock_gettime(CLOCK_MONOTONIC, ts);
- {$I IdRangeCheckingOff.inc}
- {$I IdOverflowCheckingOff.inc}
- Result := (Int64(ts.tv_sec) * 1000) + (ts.tv_nsec div 1000000);
- {$I IdOverflowCheckingOn.inc}
- {$I IdRangeCheckingOn.inc}
- end;
- {$ELSE}
- {$IFDEF UNIX}
- {$IFDEF OSX}
- {$IFDEF FPC}
- //RLebeau: FPC does not provide mach_timebase_info() and mach_absolute_time() yet...
- function mach_timebase_info(var TimebaseInfoData: TTimebaseInfoData): Integer; cdecl; external 'libc';
- function mach_absolute_time: QWORD; cdecl; external 'libc';
- {$ENDIF}
- {$ENDIF}
- function Ticks64: TIdTicks;
- {$IFDEF OSX}
- {$IFDEF USE_INLINE} inline;{$ENDIF}
- {$ELSE}
- var
- tv: timeval;
- {$ENDIF}
- begin
- {$IFDEF OSX}
- // TODO: mach_absolute_time() does NOT count ticks while the system is
- // sleeping! We can use time() to account for that:
- //
- // "time() carries on incrementing while the device is asleep, but of
- // course can be manipulated by the operating system or user. However,
- // the Kernel boottime (a timestamp of when the system last booted)
- // also changes when the system clock is changed, therefore even though
- // both these values are not fixed, the offset between them is."
- //
- // time_t uptime()
- // {
- // struct timeval boottime;
- // int mib[2] = {CTL_KERN, KERN_BOOTTIME};
- // size_t size = sizeof(boottime);
- // time_t now;
- // time_t uptime = -1;
- // time(&now);
- // if ((sysctl(mib, 2, &boottime, &size, NULL, 0) != -1) && (boottime.tv_sec != 0))
- // {
- // uptime = now - boottime.tv_sec;
- // }
- // return uptime;
- // }
- //
- // However, KERN_BOOTTIME only has *seconds* precision (timeval.tv_usecs is always 0).
- // mach_absolute_time() returns billionth of seconds, so divide by one million to get milliseconds
- Result := (mach_absolute_time() * GMachTimeBaseInfo.numer) div (1000000 * GMachTimeBaseInfo.denom);
- {$ELSE}
- // TODO: raise an exception if gettimeofday() fails...
- {$IFDEF KYLIXCOMPAT_OR_VCL_POSIX}
- gettimeofday(tv, nil);
- {$ELSE}
- {$IFDEF USE_BASEUNIX}
- fpgettimeofday(@tv,nil);
- {$ELSE}
- {$message error gettimeofday is not called on this platform!}
- FillChar(tv, sizeof(tv), 0);
- {$ENDIF}
- {$ENDIF}
- {
- I've implemented this correctly for now. I'll argue for using
- an int64 internally, since apparently quite some functionality
- (throttle, etc etc) depends on it, and this value may wrap
- at any point in time.
- For Windows: Uptime > 72 hours isn't really that rare any more,
- For Linux: no control over when this wraps.
- IdEcho has code to circumvent the wrap, but its not very good
- to have code for that at all spots where it might be relevant.
- }
- {$I IdRangeCheckingOff.inc}
- Result := (Int64(tv.tv_sec) * 1000) + (tv.tv_usec div 1000);
- {$I IdRangeCheckingOn.inc}
- {$ENDIF}
- end;
- {$ELSE}
- function Ticks64: TIdTicks;
- begin
- {$message error Ticks64 is not implemented on this platform!}
- Result := 0;
- end;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$I IdDeprecatedImplBugOff.inc}
- function GetTickDiff(const AOldTickCount, ANewTickCount: UInt32): UInt32;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {This is just in case the TickCount rolled back to zero}
- if ANewTickCount >= AOldTickCount then begin
- Result := ANewTickCount - AOldTickCount;
- end else begin
- Result := ((High(UInt32) - AOldTickCount) + ANewTickCount) + 1;
- end;
- end;
- function GetTickDiff64(const AOldTickCount, ANewTickCount: TIdTicks): TIdTicks;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {This is just in case the TickCount rolled back to zero}
- if ANewTickCount >= AOldTickCount then begin
- Result := TIdTicks(ANewTickCount - AOldTickCount);
- end else begin
- Result := TIdTicks(((High(TIdTicks) - AOldTickCount) + ANewTickCount) + 1);
- end;
- end;
- function GetElapsedTicks(const AOldTickCount: TIdTicks): UInt32;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := UInt32(GetTickDiff64(AOldTickCount, Ticks64));
- end;
- function GetElapsedTicks64(const AOldTickCount: TIdTicks): TIdTicks;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := GetTickDiff64(AOldTickCount, Ticks64);
- end;
- {$IFNDEF DOTNET}
- // TODO: define STRING_UNICODE_MISMATCH for WinCE in IdCompilerDefines.inc?
- {$IFDEF WINDOWS}
- {$IFDEF WINCE}
- {$IFNDEF STRING_IS_UNICODE}
- {$DEFINE SERVICE_STRING_MISMATCH}
- {$ENDIF}
- {$ELSE}
- {$IFDEF STRING_UNICODE_MISMATCH}
- {$DEFINE SERVICE_STRING_MISMATCH}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- function ServicesFilePath: string;
- var
- sLocation: {$IFDEF SERVICE_STRING_MISMATCH}TIdPlatformString{$ELSE}string{$ENDIF};
- begin
- {$IFDEF UNIX}
- sLocation := '/etc/'; // assume Berkeley standard placement {do not localize}
- {$ENDIF}
- {$IFDEF WINDOWS}
- {$IFNDEF WINCE}
- SetLength(sLocation, MAX_PATH);
- SetLength(sLocation, GetWindowsDirectory(PIdPlatformChar(sLocation), MAX_PATH));
- sLocation := IndyIncludeTrailingPathDelimiter(string(sLocation));
- if IndyWindowsPlatform = VER_PLATFORM_WIN32_NT then begin
- sLocation := sLocation + 'system32\drivers\etc\'; {do not localize}
- end;
- {$ELSE}
- // GetWindowsDirectory() does not exist in WinCE, and there is no system folder, either
- sLocation := '\Windows\'; {do not localize}
- {$ENDIF}
- {$ENDIF}
- Result := sLocation + 'services'; {do not localize}
- end;
- {$ENDIF}
- {$IFNDEF DOTNET}
- // IdPorts returns a list of defined ports in /etc/services
- function IdPorts: TIdPortList;
- var
- s: string;
- idx, iPosSlash: {$IFDEF BYTE_COMPARE_SETS}Byte{$ELSE}Integer{$ENDIF};
- i: {$IFDEF HAS_GENERICS_TList}Integer{$ELSE}PtrInt{$ENDIF};
- iPrev: PtrInt;
- sl: TStringList;
- begin
- if GIdPorts = nil then
- begin
- GIdPorts := TIdPortList.Create;
- sl := TStringList.Create;
- try
- // TODO: use TStreamReader instead, on versions that support it
- sl.LoadFromFile(ServicesFilePath); {do not localize}
- iPrev := 0;
- for idx := 0 to sl.Count - 1 do
- begin
- s := sl[idx];
- iPosSlash := IndyPos('/', s); {do not localize}
- if (iPosSlash > 0) and (not (IndyPos('#', s) in [1..iPosSlash])) then {do not localize}
- begin // presumably found a port number that isn't commented {Do not Localize}
- i := iPosSlash;
- repeat
- Dec(i);
- if i = 0 then begin
- raise EIdCorruptServicesFile.CreateFmt(RSCorruptServicesFile, [ServicesFilePath]); {do not localize}
- end;
- //TODO: Make Whitespace a function to elim warning
- until Ord(s[i]) in IdWhiteSpace;
- i := IndyStrToInt(Copy(s, i+1, iPosSlash-i-1));
- if i <> iPrev then begin
- GIdPorts.Add(
- {$IFDEF HAS_GENERICS_TList}i{$ELSE}Pointer(i){$ENDIF}
- );
- end;
- iPrev := i;
- end;
- end;
- finally
- sl.Free;
- end;
- end;
- Result := GIdPorts;
- end;
- {$ENDIF}
- function iif(ATest: Boolean; const ATrue: Integer; const AFalse: Integer): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if ATest then begin
- Result := ATrue;
- end else begin
- Result := AFalse;
- end;
- end;
- function iif(ATest: Boolean; const ATrue: string; const AFalse: string): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if ATest then begin
- Result := ATrue;
- end else begin
- Result := AFalse;
- end;
- end;
- function iif(ATest: Boolean; const ATrue: Boolean; const AFalse: Boolean): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if ATest then begin
- Result := ATrue;
- end else begin
- Result := AFalse;
- end;
- end;
- function iif(const AEncoding, ADefEncoding: IIdTextEncoding; ADefEncodingType: IdTextEncodingType = encASCII): IIdTextEncoding;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := AEncoding;
- if Result = nil then
- begin
- Result := ADefEncoding;
- EnsureEncoding(Result, ADefEncodingType);
- end;
- end;
- function InMainThread: Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := System.Threading.Thread.CurrentThread = MainThread;
- {$ELSE}
- Result := GetCurrentThreadID = MainThreadID;
- {$ENDIF}
- end;
- procedure WriteMemoryStreamToStream(Src: TMemoryStream; Dest: TStream; Count: TIdStreamSize);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Dest.Write(Src.Memory, Count);
- {$ELSE}
- Dest.Write(Src.Memory^, Count);
- {$ENDIF}
- end;
- {$IFNDEF DOTNET_EXCLUDE}
- function IsCurrentThread(AThread: TThread): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := AThread.ThreadID = GetCurrentThreadID;
- end;
- {$ENDIF}
- //convert a dword into an IPv4 address in dotted form
- function MakeUInt32IntoIPv4Address(const ADWord: UInt32): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := IntToStr((ADWord shr 24) and $FF) + '.';
- Result := Result + IntToStr((ADWord shr 16) and $FF) + '.';
- Result := Result + IntToStr((ADWord shr 8) and $FF) + '.';
- Result := Result + IntToStr(ADWord and $FF);
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function MakeDWordIntoIPv4Address(const ADWord: UInt32): string;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := MakeUInt32IntoIPv4Address(ADWord);
- end;
- function IsAlpha(const AChar: Char): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // TODO: under XE3.5+, use TCharHelper.IsLetter() instead
- // TODO: under D2009+, use TCharacter.IsLetter() instead
- // Do not use IsCharAlpha or IsCharAlphaNumeric - they are Win32 routines
- Result := ((AChar >= 'a') and (AChar <= 'z')) or ((AChar >= 'A') and (AChar <= 'Z')); {Do not Localize}
- end;
- function IsAlpha(const AString: String; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- i: Integer;
- LLen: Integer;
- begin
- Result := False;
- LLen := IndyLength(AString, ALength, AIndex);
- if LLen > 0 then begin
- for i := 0 to LLen-1 do begin
- if not IsAlpha(AString[AIndex+i]) then begin
- Exit;
- end;
- end;
- Result := True;
- end;
- end;
- function IsAlphaNumeric(const AChar: Char): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // Do not use IsCharAlpha or IsCharAlphaNumeric - they are Win32 routines
- Result := IsAlpha(AChar) or IsNumeric(AChar);
- end;
- function IsAlphaNumeric(const AString: String; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- i: Integer;
- LLen: Integer;
- begin
- Result := False;
- LLen := IndyLength(AString, ALength, AIndex);
- if LLen > 0 then begin
- for i := 0 to LLen-1 do begin
- if not IsAlphaNumeric(AString[AIndex+i]) then begin
- Exit;
- end;
- end;
- Result := True;
- end;
- end;
- function IsOctal(const AChar: Char): Boolean; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := (AChar >= '0') and (AChar <= '7') {Do not Localize}
- end;
- function IsOctal(const AString: string; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- i: Integer;
- LLen: Integer;
- begin
- Result := False;
- LLen := IndyLength(AString, ALength, AIndex);
- if LLen > 0 then begin
- for i := 0 to LLen-1 do begin
- if not IsOctal(AString[AIndex+i]) then begin
- Exit;
- end;
- end;
- Result := True;
- end;
- end;
- function IsHexidecimal(const AChar: Char): Boolean; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := ((AChar >= '0') and (AChar <= '9')) {Do not Localize}
- or ((AChar >= 'A') and (AChar <= 'F')) {Do not Localize}
- or ((AChar >= 'a') and (AChar <= 'f')); {Do not Localize}
- end;
- function IsHexidecimal(const AString: string; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- i: Integer;
- LLen: Integer;
- begin
- Result := False;
- LLen := IndyLength(AString, ALength, AIndex);
- if LLen > 0 then begin
- for i := 0 to LLen-1 do begin
- if not IsHexidecimal(AString[AIndex+i]) then begin
- Exit;
- end;
- end;
- Result := True;
- end;
- end;
- {$HINTS OFF}
- function IsNumeric(const AString: string): Boolean;
- var
- LCode: Integer;
- LVoid: Int64;
- begin
- Val(AString, LVoid, LCode);
- Result := LCode = 0;
- end;
- {$HINTS ON}
- function IsNumeric(const AString: string; const ALength: Integer; const AIndex: Integer = 1): Boolean;
- var
- I: Integer;
- LLen: Integer;
- begin
- Result := False;
- LLen := IndyLength(AString, ALength, AIndex);
- if LLen > 0 then begin
- for I := 0 to LLen-1 do begin
- if not IsNumeric(AString[AIndex+i]) then begin
- Exit;
- end;
- end;
- Result := True;
- end;
- end;
- function IsNumeric(const AChar: Char): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // TODO: under XE3.5+, use TCharHelper.IsDigit() instead
- // TODO: under D2009+, use TCharacter.IsDigit() instead
- // Do not use IsCharAlpha or IsCharAlphaNumeric - they are Win32 routines
- Result := (AChar >= '0') and (AChar <= '9'); {Do not Localize}
- end;
- {
- This is an adaptation of the StrToInt64 routine in SysUtils.
- We had to adapt it to work with Int64 because the one with Integers
- can not deal with anything greater than MaxInt and IP addresses are
- always $0-$FFFFFFFF (unsigned)
- }
- {$IFNDEF HAS_StrToInt64Def}
- function StrToInt64Def(const S: string; const Default: Integer): Int64;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- E: Integer;
- begin
- Val(S, Result, E);
- if E <> 0 then begin
- Result := Default;
- end;
- end;
- {$ENDIF}
- function IPv4MakeUInt32InRange(const AInt: Int64; const A256Power: Integer): UInt32;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- //Note that this function is only for stripping off some extra bits
- //from an address that might appear in some spam E-Mails.
- begin
- case A256Power of
- 4: Result := (AInt and POWER_4);
- 3: Result := (AInt and POWER_3);
- 2: Result := (AInt and POWER_2);
- else
- Result := (AInt and POWER_1);
- end;
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function IPv4MakeLongWordInRange(const AInt: Int64; const A256Power: Integer): UInt32;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := IPv4MakeUInt32InRange(AInt, A256Power);
- end;
- function IPv4ToUInt32(const AIPAddress: string): UInt32;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LErr: Boolean;
- begin
- Result := IPv4ToUInt32(AIPAddress, LErr);
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function IPv4ToDWord(const AIPAddress: string): UInt32; overload;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := IPv4ToUInt32(AIPAddress);
- end;
- function IPv4ToUInt32(const AIPAddress: string; var VErr: Boolean): UInt32;
- var
- {$IFDEF DOTNET}
- AIPaddr: IPAddress;
- {$ELSE}
- LBuf, LBuf2: string;
- L256Power: Integer;
- LParts: Integer; //how many parts should we process at a time
- {$ENDIF}
- begin
- VErr := True;
- Result := 0;
- {$IFDEF DOTNET}
- AIPaddr := System.Net.IPAddress.Parse(AIPAddress);
- try
- try
- if AIPaddr.AddressFamily = Addressfamily.InterNetwork then begin
- {$IFDEF DOTNET_2_OR_ABOVE}
- //This looks funny but it's just to circvument a warning about
- //a depreciated property in AIPaddr. We can safely assume
- //this is an IPv4 address.
- Result := BytesToUInt32( AIPAddr.GetAddressBytes,0);
- {$ENDIF}
- {$IFDEF DOTNET_1_1}
- Result := AIPaddr.Address;
- {$ENDIF}
- VErr := False;
- end;
- except
- VErr := True;
- end;
- finally
- FreeAndNil(AIPaddr);
- end;
- {$ELSE}
- // S.G. 11/8/2003: Added overflow checking disabling and change multiplys by SHLs.
- // Locally disable overflow checking so we can safely use SHL and SHR
- {$I IdOverflowCheckingOff.inc}
- L256Power := 4;
- LBuf2 := AIPAddress;
- repeat
- LBuf := Fetch(LBuf2, '.');
- if LBuf = '' then begin
- Break;
- end;
- //We do things this way because we have to treat
- //IP address parts differently than a whole number
- //and sometimes, there can be missing periods.
- if (LBuf2 = '') and (L256Power > 1) then begin
- LParts := L256Power;
- Result := Result shl (L256Power SHL 3);
- end else begin
- LParts := 1;
- Result := Result shl 8;
- end;
- if TextStartsWith(LBuf, IdHexPrefix) then begin
- //this is a hexideciaml number
- if not IsHexidecimal(Copy(LBuf, 3, MaxInt)) then begin
- Exit;
- end;
- Result := Result + IPv4MakeUInt32InRange(StrToInt64Def(LBuf, 0), LParts);
- end else begin
- if not IsNumeric(LBuf) then begin
- //There was an error meaning an invalid IP address
- Exit;
- end;
- if TextStartsWith(LBuf, '0') and IsOctal(LBuf) then begin {do not localize}
- //this is octal
- Result := Result + IPv4MakeUInt32InRange(OctalToInt64(LBuf), LParts);
- end else begin
- //this must be a decimal
- Result := Result + IPv4MakeUInt32InRange(StrToInt64Def(LBuf, 0), LParts);
- end;
- end;
- Dec(L256Power);
- until False;
- VErr := False;
- // Restore overflow checking
- {$I IdOverflowCheckingOn.inc}
- {$ENDIF}
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function IPv4ToDWord(const AIPAddress: string; var VErr: Boolean): UInt32;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := IPv4ToUInt32(AIPAddress, VErr);
- end;
- function IPv6AddressToStr(const AValue: TIdIPv6Address): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- i: Integer;
- begin
- Result := IntToHex(AValue[0], 4);
- for i := 1 to 7 do begin
- Result := Result + ':' + IntToHex(AValue[i], 4);
- end;
- end;
- function MakeCanonicalIPv4Address(const AAddr: string): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LErr: Boolean;
- LIP: UInt32;
- begin
- LIP := IPv4ToUInt32(AAddr, LErr);
- if LErr then begin
- Result := '';
- end else begin
- Result := MakeUInt32IntoIPv4Address(LIP);
- end;
- end;
- function MakeCanonicalIPv6Address(const AAddr: string): string;
- // return an empty string if the address is invalid,
- // for easy checking if its an address or not.
- var
- p, i: Integer;
- {$IFDEF BYTE_COMPARE_SETS}
- dots, colons: Byte;
- {$ELSE}
- dots, colons: Integer;
- {$ENDIF}
- colonpos: array[1..8] of Integer;
- dotpos: array[1..3] of Integer;
- LAddr: string;
- num: Integer;
- haddoublecolon: boolean;
- fillzeros: Integer;
- begin
- Result := ''; // error
- LAddr := AAddr;
- if Length(LAddr) = 0 then begin
- Exit;
- end;
- if TextStartsWith(LAddr, ':') then begin
- LAddr := '0' + LAddr;
- end;
- if TextEndsWith(LAddr, ':') then begin
- LAddr := LAddr + '0';
- end;
- dots := 0;
- colons := 0;
- for p := 1 to Length(LAddr) do begin
- case LAddr[p] of
- '.': begin
- Inc(dots);
- if dots < 4 then begin
- dotpos[dots] := p;
- end else begin
- Exit; // error in address
- end;
- end;
- ':': begin
- Inc(colons);
- if colons < 8 then begin
- colonpos[colons] := p;
- end else begin
- Exit; // error in address
- end;
- end;
- 'a'..'f',
- 'A'..'F': if dots > 0 then Exit;
- // allow only decimal stuff within dotted portion, ignore otherwise
- '0'..'9': ; // do nothing
- else
- Exit; // error in address
- end; // case
- end; // for
- if not (dots in [0,3]) then begin
- Exit; // you have to write 0 or 3 dots...
- end;
- if dots = 3 then begin
- if not (colons in [2..6]) then begin
- Exit; // must not have 7 colons if we have dots
- end;
- if colonpos[colons] > dotpos[1] then begin
- Exit; // x:x:x.x:x:x is not valid
- end;
- end else begin
- if not (colons in [2..7]) then begin
- Exit; // must at least have two colons
- end;
- end;
- // now start :-)
- num := IndyStrToInt('$'+Copy(LAddr, 1, colonpos[1]-1), -1);
- if (num < 0) or (num > 65535) then begin
- Exit; // huh? odd number...
- end;
- Result := IntToHex(num, 1) + ':';
- haddoublecolon := False;
- for p := 2 to colons do begin
- if colonpos[p - 1] = colonpos[p]-1 then begin
- if haddoublecolon then begin
- Result := '';
- Exit; // only a single double-dot allowed!
- end;
- haddoublecolon := True;
- fillzeros := 8 - colons;
- if dots > 0 then begin
- Dec(fillzeros);
- end;
- for i := 1 to fillzeros do begin
- Result := Result + '0:'; {do not localize}
- end;
- end else begin
- num := IndyStrToInt('$' + Copy(LAddr, colonpos[p - 1] + 1, colonpos[p] - colonpos[p - 1] - 1), -1);
- if (num < 0) or (num > 65535) then begin
- Result := '';
- Exit; // huh? odd number...
- end;
- Result := Result + IntToHex(num,1) + ':';
- end;
- end; // end of colon separated part
- if dots = 0 then begin
- num := IndyStrToInt('$' + Copy(LAddr, colonpos[colons] + 1, MaxInt), -1);
- if (num < 0) or (num > 65535) then begin
- Result := '';
- Exit; // huh? odd number...
- end;
- Result := Result + IntToHex(num,1) + ':';
- end;
- if dots > 0 then begin
- num := IndyStrToInt(Copy(LAddr, colonpos[colons] + 1, dotpos[1] - colonpos[colons] -1),-1);
- if (num < 0) or (num > 255) then begin
- Result := '';
- Exit;
- end;
- Result := Result + IntToHex(num, 2);
- num := IndyStrToInt(Copy(LAddr, dotpos[1]+1, dotpos[2]-dotpos[1]-1),-1);
- if (num < 0) or (num > 255) then begin
- Result := '';
- Exit;
- end;
- Result := Result + IntToHex(num, 2) + ':';
- num := IndyStrToInt(Copy(LAddr, dotpos[2] + 1, dotpos[3] - dotpos[2] -1),-1);
- if (num < 0) or (num > 255) then begin
- Result := '';
- Exit;
- end;
- Result := Result + IntToHex(num, 2);
- num := IndyStrToInt(Copy(LAddr, dotpos[3] + 1, 3), -1);
- if (num < 0) or (num > 255) then begin
- Result := '';
- Exit;
- end;
- Result := Result + IntToHex(num, 2) + ':';
- end;
- SetLength(Result, Length(Result) - 1);
- end;
- procedure IPv6ToIdIPv6Address(const AIPAddress: String; var VAddress: TIdIPv6Address);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LErr: Boolean;
- begin
- IPv6ToIdIPv6Address(AIPAddress, VAddress, LErr);
- if LErr then begin
- raise EIdInvalidIPv6Address.CreateFmt(RSInvalidIPv6Address, [AIPAddress]);
- end;
- end;
- procedure IPv6ToIdIPv6Address(const AIPAddress: String; var VAddress: TIdIPv6Address; var VErr: Boolean);
- var
- LAddress: string;
- I: Integer;
- begin
- LAddress := MakeCanonicalIPv6Address(AIPAddress);
- VErr := (LAddress = '');
- if VErr then begin
- Exit;
- end;
- for I := 0 to 7 do begin
- VAddress[I] := IndyStrToInt('$' + Fetch(LAddress,':'), 0);
- end;
- end;
- function IndyMax(const AValueOne, AValueTwo: Int64): Int64;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if AValueOne < AValueTwo then begin
- Result := AValueTwo;
- end else begin
- Result := AValueOne;
- end;
- end;
- function IndyMax(const AValueOne, AValueTwo: Int32): Int32;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if AValueOne < AValueTwo then begin
- Result := AValueTwo;
- end else begin
- Result := AValueOne;
- end;
- end;
- function IndyMax(const AValueOne, AValueTwo: UInt16): UInt16;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if AValueOne < AValueTwo then begin
- Result := AValueTwo;
- end else begin
- Result := AValueOne;
- end;
- end;
- {$IFNDEF DOTNET}
- // TODO: validate this with Unicode data
- function MemoryPos(const ASubStr: string; MemBuff: PChar; MemorySize: Integer): Integer;
- var
- LSearchLength: Integer;
- LS1: Integer;
- LChar: Char;
- LPS, LPM: PChar;
- begin
- LSearchLength := Length(ASubStr);
- if (LSearchLength = 0) or (LSearchLength > (MemorySize * SizeOf(Char))) then begin
- Result := 0;
- Exit;
- end;
- LChar := PChar(Pointer(ASubStr))^; //first char
- LPS := PChar(Pointer(ASubStr))+1;//tail string
- LPM := MemBuff;
- LS1 := LSearchLength-1;
- LSearchLength := MemorySize-LS1;//MemorySize-LS+1
- if LS1 = 0 then begin //optimization for freq used LF
- while LSearchLength > 0 do begin
- if LPM^ = LChar then begin
- Result := LPM-MemBuff + 1;
- Exit;
- end;
- Inc(LPM);
- Dec(LSearchLength);
- end;//while
- end else begin
- while LSearchLength > 0 do begin
- if LPM^ = LChar then begin
- Inc(LPM);
- if CompareMem(LPM, LPS, LS1 * SizeOf(Char)) then begin
- Result := LPM - MemBuff;
- Exit;
- end;
- end else begin
- Inc(LPM);
- end;
- Dec(LSearchLength);
- end;
- end;
- Result := 0;
- end;
- {$ENDIF}
- function IndyMin(const AValueOne, AValueTwo: Int32): Int32;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if AValueOne > AValueTwo then begin
- Result := AValueTwo;
- end else begin
- Result := AValueOne;
- end;
- end;
- function IndyMin(const AValueOne, AValueTwo: Int64): Int64;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if AValueOne > AValueTwo then begin
- Result := AValueTwo;
- end else begin
- Result := AValueOne;
- end;
- end;
- function IndyMin(const AValueOne, AValueTwo: UInt16): UInt16;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if AValueOne > AValueTwo then begin
- Result := AValueTwo;
- end else begin
- Result := AValueOne;
- end;
- end;
- function PosIdx(const ASubStr, AStr: string; AStartPos: UInt32): UInt32;
- {$IFDEF DOTNET}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ELSE}
- // use best register allocation on Win32
- function FindStr(ALStartPos, EndPos: UInt32; StartChar: Char; const ALStr: string): UInt32;
- begin
- for Result := ALStartPos to EndPos do begin
- if ALStr[Result] = StartChar then begin
- Exit;
- end;
- end;
- Result := 0;
- end;
- // use best register allocation on Win32
- function FindNextStr(ALStartPos, EndPos: UInt32; const ALStr, ALSubStr: string): UInt32;
- begin
- for Result := ALStartPos + 1 to EndPos do begin
- if ALStr[Result] <> ALSubStr[Result - ALStartPos + 1] then begin
- Exit;
- end;
- end;
- Result := 0;
- end;
- var
- StartChar: Char;
- LenSubStr, LenStr: UInt32;
- EndPos: UInt32;
- {$ENDIF}
- begin
- if AStartPos = 0 then begin
- AStartPos := 1;
- end;
- {$IFDEF DOTNET}
- Result := AStr.IndexOf(ASubStr, AStartPos-1) + 1;
- {$ELSE}
- Result := 0;
- LenSubStr := Length(ASubStr);
- LenStr := Length(AStr);
- if (LenSubStr = 0) or (AStr = '') or (LenSubStr > (LenStr - (AStartPos - 1))) then begin
- Exit;
- end;
- StartChar := ASubStr[1];
- EndPos := LenStr - LenSubStr + 1;
- if LenSubStr = 1 then begin
- Result := FindStr(AStartPos, EndPos, StartChar, AStr)
- end else
- begin
- repeat
- Result := FindStr(AStartPos, EndPos, StartChar, AStr);
- if Result = 0 then begin
- Break;
- end;
- AStartPos := Result;
- Result := FindNextStr(Result, AStartPos + LenSubStr - 1, AStr, ASubStr);
- if Result = 0 then
- begin
- Result := AStartPos;
- Exit;
- end;
- Inc(AStartPos);
- until False;
- end;
- {$ENDIF}
- end;
- function SBPos(const Substr, S: string): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // Necessary because of "Compiler magic"
- Result := Pos(Substr, S);
- end;
- {$IFNDEF DOTNET}
- function SBStrScan(Str: PChar; Chr: Char): PChar;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := SysUtils.StrScan(Str, Chr);
- end;
- {$ENDIF}
- {$IFNDEF DOTNET}
- //Don't rename this back to AnsiPos because that conceals a symbol in Windows
- function InternalAnsiPos(const Substr, S: string): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := SysUtils.AnsiPos(Substr, S);
- end;
- function InternalAnsiStrScan(Str: PChar; Chr: Char): PChar;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := SysUtils.AnsiStrScan(Str, Chr);
- end;
- {$ENDIF}
- {$UNDEF USE_TTHREAD_PRIORITY_PROP}
- {$IFDEF DOTNET}
- {$DEFINE USE_TTHREAD_PRIORITY_PROP}
- {$ENDIF}
- {$IFDEF WINDOWS}
- {$DEFINE USE_TTHREAD_PRIORITY_PROP}
- {$ENDIF}
- {$IFDEF UNIX}
- {$IFDEF USE_VCL_POSIX}
- // TODO: does this apply?
- {.$DEFINE USE_TTHREAD_PRIORITY_PROP}
- {$ENDIF}
- {$IFDEF KYLIXCOMPAT} // TODO: use KYLIXCOMPAT_OR_VCL_POSIX instead?
- {$IFNDEF INT_THREAD_PRIORITY}
- {$DEFINE USE_TTHREAD_PRIORITY_PROP}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- procedure IndySetThreadPriority(AThread: TThread; const APriority: TIdThreadPriority;
- const APolicy: Integer = -MaxInt);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF USE_TTHREAD_PRIORITY_PROP}
- AThread.Priority := APriority;
- {$ELSE}
- {$IFDEF UNIX}
- // Linux only allows root to adjust thread priorities, so we just ignore this call in Linux?
- // actually, why not allow it if root
- // and also allow setting *down* threadpriority (anyone can do that)
- // note that priority is called "niceness" and positive is lower priority
- {$IFDEF KYLIXCOMPAT} // TODO: use KYLIXCOMPAT_OR_VCL_POSIX instead?
- if (getpriority(PRIO_PROCESS, 0) < APriority) or (geteuid = 0) then begin
- setpriority(PRIO_PROCESS, 0, APriority);
- end;
- {$ELSE}
- {$IFDEF USE_BASEUNIX}
- if (fpgetpriority(PRIO_PROCESS, 0) < cint(APriority)) or (fpgeteuid = 0) then begin
- fpsetpriority(PRIO_PROCESS, 0, cint(APriority));
- end;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- end;
- procedure IndySleep(ATime: UInt32);
- {$IFDEF USE_VCL_POSIX}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LTime: TimeVal;
- {$ELSE}
- {$IFDEF UNIX}
- var
- LTime: TTimeVal;
- {$ELSE}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF DOTNET}
- Thread.Sleep(ATime);
- {$ELSE}
- {$IFDEF WINDOWS}
- Windows.Sleep(ATime);
- {$ELSE}
- {$IFDEF UNIX}
- // *nix: Is there any reason for not using nanosleep() instead?
- // what if the user just calls sleep? without doing anything...
- // cannot use GStack.WSSelectRead(nil, ATime)
- // since no readsocketlist exists to get the fdset
- LTime.tv_sec := ATime div 1000;
- LTime.tv_usec := (ATime mod 1000) * 1000;
- {$IFDEF USE_VCL_POSIX}
- select(0, nil, nil, nil, @LTime);
- {$ELSE}
- {$IFDEF KYLIXCOMPAT}
- Libc.Select(0, nil, nil, nil, @LTime);
- {$ELSE}
- {$IFDEF USE_BASEUNIX}
- fpSelect(0, nil, nil, nil, @LTime);
- {$ELSE}
- {$message error select is not called on this platform!}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ELSE}
- {$message error IndySleep is not implemented on this platform!}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- end;
- {$I IdDeprecatedImplBugOff.inc}
- procedure SplitColumnsNoTrim(const AData: string; AStrings: TStrings; const ADelim: string = ' ');
- {$I IdDeprecatedImplBugOn.inc}
- begin
- SplitDelimitedString(AData, AStrings, False, ADelim{$IFNDEF USE_OBJECT_ARC}, True{$ENDIF});
- end;
- {$I IdDeprecatedImplBugOff.inc}
- procedure SplitColumns(const AData: string; AStrings: TStrings; const ADelim: string = ' ');
- {$I IdDeprecatedImplBugOn.inc}
- begin
- SplitDelimitedString(AData, AStrings, True, ADelim{$IFNDEF USE_OBJECT_ARC}, True{$ENDIF});
- end;
- procedure SplitDelimitedString(const AData: string; AStrings: TStrings; ATrim: Boolean;
- const ADelim: string = ' '{$IFNDEF USE_OBJECT_ARC}; AIncludePositions: Boolean = False{$ENDIF});
- var
- i: Integer;
- LData: string;
- LDelim: Integer; //delim len
- LLeft: string;
- LLastPos, LLeadingSpaceCnt: PtrInt;
- begin
- Assert(Assigned(AStrings));
- AStrings.BeginUpdate;
- try
- AStrings.Clear;
- LDelim := Length(ADelim);
- LLastPos := 1;
- if ATrim then begin
- LData := Trim(AData);
- if LData = '' then begin //if WhiteStr
- Exit;
- end;
- LLeadingSpaceCnt := 0;
- while AData[LLeadingSpaceCnt + 1] <= #32 do begin
- Inc(LLeadingSpaceCnt);
- end;
- i := Pos(ADelim, LData);
- while I > 0 do begin
- LLeft := Copy(LData, LLastPos, I - LLastPos); //'abc d' len:=i(=4)-1 {Do not Localize}
- if LLeft > '' then begin {Do not Localize}
- {$IFNDEF USE_OBJECT_ARC}
- if AIncludePositions then begin
- AStrings.AddObject(Trim(LLeft), TObject(LLastPos + LLeadingSpaceCnt));
- end else
- {$ENDIF}
- begin
- AStrings.Add(Trim(LLeft));
- end;
- end;
- LLastPos := I + LDelim; //first char after Delim
- i := PosIdx(ADelim, LData, LLastPos);
- end;//while found
- if LLastPos <= Length(LData) then begin
- {$IFNDEF USE_OBJECT_ARC}
- if AIncludePositions then begin
- AStrings.AddObject(Trim(Copy(LData, LLastPos, MaxInt)), TObject(LLastPos + LLeadingSpaceCnt));
- end else
- {$ENDIF}
- begin
- AStrings.Add(Trim(Copy(LData, LLastPos, MaxInt)));
- end;
- end;
- end else
- begin
- i := Pos(ADelim, AData);
- while I > 0 do begin
- LLeft := Copy(AData, LLastPos, I - LLastPos); //'abc d' len:=i(=4)-1 {Do not Localize}
- if LLeft <> '' then begin {Do not Localize}
- {$IFNDEF USE_OBJECT_ARC}
- if AIncludePositions then begin
- AStrings.AddObject(LLeft, TObject(LLastPos));
- end else
- {$ENDIF}
- begin
- AStrings.Add(LLeft);
- end;
- end;
- LLastPos := I + LDelim; //first char after Delim
- i := PosIdx(ADelim, AData, LLastPos);
- end;
- if LLastPos <= Length(AData) then begin
- {$IFNDEF USE_OBJECT_ARC}
- if AIncludePositions then begin
- AStrings.AddObject(Copy(AData, LLastPos, MaxInt), TObject(LLastPos));
- end else
- {$ENDIF}
- begin
- AStrings.Add(Copy(AData, LLastPos, MaxInt));
- end;
- end;
- end;
- finally
- AStrings.EndUpdate;
- end;
- end;
- {$IFDEF USE_OBJECT_ARC}
- constructor TIdStringPosition.Create(const AValue: String; const APosition: Integer);
- begin
- Value := AValue;
- Position := APosition;
- end;
- procedure SplitDelimitedString(const AData: string; AStrings: TIdStringPositionList;
- ATrim: Boolean; const ADelim: string = ' ');
- var
- i: Integer;
- LData: string;
- LDelim: Integer; //delim len
- LLeft: string;
- LLastPos, LLeadingSpaceCnt: Integer;
- begin
- Assert(Assigned(AStrings));
- AStrings.Clear;
- LDelim := Length(ADelim);
- LLastPos := 1;
- if ATrim then begin
- LData := Trim(AData);
- if LData = '' then begin //if WhiteStr
- Exit;
- end;
- LLeadingSpaceCnt := 0;
- while AData[LLeadingSpaceCnt + 1] <= #32 do begin
- Inc(LLeadingSpaceCnt);
- end;
- i := Pos(ADelim, LData);
- while I > 0 do begin
- LLeft := Copy(LData, LLastPos, I - LLastPos); //'abc d' len:=i(=4)-1 {Do not Localize}
- if LLeft > '' then begin {Do not Localize}
- AStrings.Add(TIdStringPosition.Create(Trim(LLeft), LLastPos + LLeadingSpaceCnt));
- end;
- LLastPos := I + LDelim; //first char after Delim
- i := PosIdx(ADelim, LData, LLastPos);
- end;//while found
- if LLastPos <= Length(LData) then begin
- AStrings.Add(TIdStringPosition.Create(Trim(Copy(LData, LLastPos, MaxInt)), LLastPos + LLeadingSpaceCnt));
- end;
- end else
- begin
- i := Pos(ADelim, AData);
- while I > 0 do begin
- LLeft := Copy(AData, LLastPos, I - LLastPos); //'abc d' len:=i(=4)-1 {Do not Localize}
- if LLeft <> '' then begin {Do not Localize}
- AStrings.Add(TIdStringPosition.Create(LLeft, LLastPos));
- end;
- LLastPos := I + LDelim; //first char after Delim
- i := PosIdx(ADelim, AData, LLastPos);
- end;
- if LLastPos <= Length(AData) then begin
- AStrings.Add(TIdStringPosition.Create(Copy(AData, LLastPos, MaxInt), LLastPos));
- end;
- end;
- end;
- {$ENDIF}
- {$IFDEF DOTNET}
- procedure SetThreadName(const AName: string; AThread: System.Threading.Thread = nil);
- begin
- if AThread = nil then begin
- AThread := System.Threading.Thread.CurrentThread;
- end;
- // cannot rename a previously-named thread
- if AThread.Name = nil then begin
- AThread.Name := AName;
- end;
- end;
- {$ELSE}
- procedure SetThreadName(const AName: string; AThreadID: UInt32 = $FFFFFFFF);
- {$IFDEF HAS_NAMED_THREADS}
- {$IFDEF HAS_TThread_NameThreadForDebugging}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ELSE}
- {$IFDEF WINDOWS}
- const
- MS_VC_EXCEPTION = $406D1388;
- type
- TThreadNameInfo = record
- RecType: UInt32; // Must be 0x1000
- Name: PAnsiChar; // Pointer to name (in user address space)
- ThreadID: UInt32; // Thread ID (-1 indicates caller thread)
- Flags: UInt32; // Reserved for future use. Must be zero
- end;
- var
- {$IFDEF STRING_IS_UNICODE}
- LName: AnsiString;
- {$ENDIF}
- LThreadNameInfo: TThreadNameInfo;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF HAS_NAMED_THREADS}
- {$IFDEF HAS_TThread_NameThreadForDebugging}
- TThread.NameThreadForDebugging(
- {$IFDEF HAS_AnsiString}
- AnsiString(AName) // explicit convert to Ansi
- {$ELSE}
- AName
- {$ENDIF},
- AThreadID
- );
- {$ELSE}
- {$IFDEF WINDOWS}
- {$IFDEF STRING_IS_UNICODE}
- LName := AnsiString(AName); // explicit convert to Ansi
- {$ENDIF}
- LThreadNameInfo.RecType := $1000;
- LThreadNameInfo.Name := PAnsiChar({$IFDEF STRING_IS_UNICODE}LName{$ELSE}AName{$ENDIF});
- LThreadNameInfo.ThreadID := AThreadID;
- LThreadNameInfo.Flags := 0;
- try
- // This is a wierdo Windows way to pass the info in
- RaiseException(MS_VC_EXCEPTION, 0, SizeOf(LThreadNameInfo) div SizeOf(UInt32),
- PDWord(@LThreadNameInfo));
- except
- end;
- {$ENDIF}
- {$ENDIF}
- {$ELSE}
- // Do nothing. No support in this compiler for it.
- {$ENDIF}
- end;
- {$ENDIF}
- {$IFDEF DOTNET}
- {$IFNDEF DOTNET_2_OR_ABOVE}
- { TEvent }
- constructor TEvent.Create(EventAttributes: IntPtr; ManualReset, InitialState: Boolean; const Name: string);
- begin
- inherited Create;
- // Name not used
- if ManualReset then begin
- FEvent := ManualResetEvent.Create(InitialState);
- end else begin
- FEvent := AutoResetEvent.Create(InitialState);
- end;
- end;
- constructor TEvent.Create;
- begin
- Create(nil, True, False, ''); {Do not Localize}
- end;
- destructor TEvent.Destroy;
- begin
- if Assigned(FEvent) then begin
- FEvent.Close;
- end;
- FreeAndNil(FEvent);
- inherited Destroy;
- end;
- procedure TEvent.SetEvent;
- begin
- if FEvent is ManualResetEvent then begin
- ManualResetEvent(FEvent).&Set;
- end else begin
- AutoResetEvent(FEvent).&Set;
- end;
- end;
- procedure TEvent.ResetEvent;
- begin
- if FEvent is ManualResetEvent then begin
- ManualResetEvent(FEvent).Reset;
- end else begin
- AutoResetEvent(FEvent).Reset;
- end;
- end;
- function TEvent.WaitFor(Timeout: UInt32): TWaitResult;
- var
- Passed: Boolean;
- begin
- try
- if Timeout = INFINITE then begin
- Passed := FEvent.WaitOne;
- end else begin
- Passed := FEvent.WaitOne(Timeout, True);
- end;
- if Passed then begin
- Result := wrSignaled;
- end else begin
- Result := wrTimeout;
- end;
- except
- Result := wrError;
- end;
- end;
- { TCriticalSection }
- procedure TCriticalSection.Acquire;
- begin
- Enter;
- end;
- procedure TCriticalSection.Release;
- begin
- Leave;
- end;
- function TCriticalSection.TryEnter: Boolean;
- begin
- Result := System.Threading.Monitor.TryEnter(Self);
- end;
- procedure TCriticalSection.Enter;
- begin
- System.Threading.Monitor.Enter(Self);
- end;
- procedure TCriticalSection.Leave;
- begin
- System.Threading.Monitor.Exit(Self);
- end;
- {$ENDIF}
- {$ENDIF}
- { TIdLocalEvent }
- constructor TIdLocalEvent.Create(const AInitialState: Boolean = False; const AManualReset: Boolean = False);
- begin
- inherited Create(nil, AManualReset, AInitialState, ''); {Do not Localize}
- end;
- function TIdLocalEvent.WaitForEver: TWaitResult;
- begin
- Result := WaitFor(Infinite);
- end;
- procedure ToDo(const AMsg: string);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- raise EIdException.Create(AMsg);
- end;
- // RLebeau: the following three functions are utility functions
- // that determine the usable amount of data in various buffer types.
- // There are many operations in Indy that allow the user to specify
- // data sizes, or to have Indy calculate it. So these functions
- // help reduce code duplication.
- function IndyLength(const ABuffer: String; const ALength: Integer = -1; const AIndex: Integer = 1): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LAvailable: Integer;
- begin
- Assert(AIndex >= 1);
- LAvailable := IndyMax(Length(ABuffer)-AIndex+1, 0);
- if ALength < 0 then begin
- Result := LAvailable;
- end else begin
- Result := IndyMin(LAvailable, ALength);
- end;
- end;
- function IndyLength(const ABuffer: TIdBytes; const ALength: Integer = -1; const AIndex: Integer = 0): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LAvailable: Integer;
- begin
- Assert(AIndex >= 0);
- LAvailable := IndyMax(Length(ABuffer)-AIndex, 0);
- if ALength < 0 then begin
- Result := LAvailable;
- end else begin
- Result := IndyMin(LAvailable, ALength);
- end;
- end;
- function IndyLength(const ABuffer: TStream; const ALength: TIdStreamSize = -1): TIdStreamSize; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LAvailable: TIdStreamSize;
- begin
- LAvailable := IndyMax(ABuffer.Size - ABuffer.Position, 0);
- if ALength < 0 then begin
- Result := LAvailable;
- end else begin
- Result := IndyMin(LAvailable, ALength);
- end;
- end;
- const
- wdays: array[1..7] of string = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'); {do not localize}
- monthnames: array[1..12] of string = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', {do not localize}
- 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); {do not localize}
- {$IFDEF HAS_TFormatSettings}
- //Delphi5 does not have TFormatSettings
- //this should be changed to a singleton?
- function GetEnglishSetting: TFormatSettings;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result.CurrencyFormat := $00; // 0 = '$1'
- Result.NegCurrFormat := $00; //0 = '($1)'
- Result.CurrencyString := '$'; {do not localize}
- Result.CurrencyDecimals := 2;
- Result.ThousandSeparator := ','; {do not localize}
- Result.DecimalSeparator := '.'; {do not localize}
- Result.DateSeparator := '/'; {do not localize}
- Result.ShortDateFormat := 'M/d/yyyy'; {do not localize}
- Result.LongDateFormat := 'dddd, MMMM dd, yyyy'; {do not localize}
- Result.TimeSeparator := ':'; {do not localize}
- Result.TimeAMString := 'AM'; {do not localize}
- Result.TimePMString := 'PM'; {do not localize}
- Result.LongTimeFormat := 'h:mm:ss AMPM'; {do not localize}
- Result.ShortTimeFormat := 'h:mm AMPM'; {do not localize}
- // TODO: use hard-coded names instead?
- Result.ShortMonthNames[1] := monthnames[1]; //'Jan';
- Result.ShortMonthNames[2] := monthnames[2]; //'Feb';
- Result.ShortMonthNames[3] := monthnames[3]; //'Mar';
- Result.ShortMonthNames[4] := monthnames[4]; //'Apr';
- Result.ShortMonthNames[5] := monthnames[5]; //'May';
- Result.ShortMonthNames[6] := monthnames[6]; //'Jun';
- Result.ShortMonthNames[7] := monthnames[7]; //'Jul';
- Result.ShortMonthNames[8] := monthnames[8]; //'Aug';
- Result.ShortMonthNames[9] := monthnames[9]; //'Sep';
- Result.ShortMonthNames[10] := monthnames[10];// 'Oct';
- Result.ShortMonthNames[11] := monthnames[11]; //'Nov';
- Result.ShortMonthNames[12] := monthnames[12]; //'Dec';
- Result.LongMonthNames[1] := 'January'; {do not localize}
- Result.LongMonthNames[2] := 'February'; {do not localize}
- Result.LongMonthNames[3] := 'March'; {do not localize}
- Result.LongMonthNames[4] := 'April'; {do not localize}
- Result.LongMonthNames[5] := 'May'; {do not localize}
- Result.LongMonthNames[6] := 'June'; {do not localize}
- Result.LongMonthNames[7] := 'July'; {do not localize}
- Result.LongMonthNames[8] := 'August'; {do not localize}
- Result.LongMonthNames[9] := 'September'; {do not localize}
- Result.LongMonthNames[10] := 'October'; {do not localize}
- Result.LongMonthNames[11] := 'November'; {do not localize}
- Result.LongMonthNames[12] := 'December'; {do not localize}
- // TODO: use hard-coded names instead?
- Result.ShortDayNames[1] := wdays[1]; //'Sun';
- Result.ShortDayNames[2] := wdays[2]; //'Mon';
- Result.ShortDayNames[3] := wdays[3]; //'Tue';
- Result.ShortDayNames[4] := wdays[4]; //'Wed';
- Result.ShortDayNames[5] := wdays[5]; //'Thu';
- Result.ShortDayNames[6] := wdays[6]; //'Fri';
- Result.ShortDayNames[7] := wdays[7]; //'Sat';
- Result.LongDayNames[1] := 'Sunday'; {do not localize}
- Result.LongDayNames[2] := 'Monday'; {do not localize}
- Result.LongDayNames[3] := 'Tuesday'; {do not localize}
- Result.LongDayNames[4] := 'Wednesday'; {do not localize}
- Result.LongDayNames[5] := 'Thursday'; {do not localize}
- Result.LongDayNames[6] := 'Friday'; {do not localize}
- Result.LongDayNames[7] := 'Saturday'; {do not localize}
- Result.ListSeparator := ','; {do not localize}
- end;
- {$ENDIF}
- // RLebeau 10/24/2008: In the RTM release of Delphi/C++Builder 2009, the
- // overloaded version of SysUtils.Format() that has a TFormatSettings parameter
- // has an internal bug that causes an EConvertError exception when UnicodeString
- // parameters greater than 4094 characters are passed to it. Refer to QC #67934
- // for details. The bug is fixed in 2009 Update 1. For RTM, call FormatBuf()
- // directly to work around the problem...
- function IndyFormat(const AFormat: string; const Args: array of const): string;
- {$IFNDEF DOTNET}
- {$IFDEF HAS_TFormatSettings}
- var
- EnglishFmt: TFormatSettings;
- {$IFDEF BROKEN_FmtStr}
- Len, BufLen: Integer;
- Buffer: array[0..4095] of Char;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF DOTNET}
- // RLebeau 10/29/09: temporary workaround until we figure out how to use
- // SysUtils.FormatBuf() correctly under .NET in D2009 RTM...
- Result := SysUtils.Format(AFormat, Args);
- {$ELSE}
- {$IFDEF HAS_TFormatSettings}
- EnglishFmt := GetEnglishSetting;
- {$IFDEF BROKEN_FmtStr}
- BufLen := Length(Buffer);
- if Length(AFormat) < (Length(Buffer) - (Length(Buffer) div 4)) then
- begin
- Len := SysUtils.FormatBuf(Buffer, Length(Buffer) - 1, Pointer(AFormat)^,
- Length(AFormat), Args, EnglishFmt);
- end else
- begin
- BufLen := Length(AFormat);
- Len := BufLen;
- end;
- if Len >= BufLen - 1 then
- begin
- while Len >= BufLen - 1 do
- begin
- Inc(BufLen, BufLen);
- Result := ''; // prevent copying of existing data, for speed
- SetLength(Result, BufLen);
- Len := SysUtils.FormatBuf(PChar(Result), BufLen - 1, Pointer(AFormat)^,
- Length(AFormat), Args, EnglishFmt);
- end;
- SetLength(Result, Len);
- end else
- begin
- SetString(Result, Buffer, Len);
- {$IFDEF STRING_IS_ANSI}
- // TODO: do we need to use SetCodePage() here?
- {$ENDIF}
- end;
- {$ELSE}
- Result := SysUtils.Format(AFormat, Args, EnglishFmt);
- {$ENDIF}
- {$ELSE}
- //Is there a way to get delphi5 to use locale in format? something like:
- // SetThreadLocale(TheNewLocaleId);
- // GetFormatSettings;
- // Application.UpdateFormatSettings := False; //needed?
- // format()
- // set locale back to prior
- Result := SysUtils.Format(AFormat, Args);
- {$ENDIF}
- {$ENDIF}
- end;
- function DateTimeGMTToHttpStr(const GMTValue: TDateTime) : String;
- // should adhere to RFC 2616
- var
- wDay, wMonth, wYear: Word;
- begin
- DecodeDate(GMTValue, wYear, wMonth, wDay);
- Result := IndyFormat('%s, %.2d %s %.4d %s %s', {do not localize}
- [wdays[DayOfWeek(GMTValue)], wDay, monthnames[wMonth],
- wYear, FormatDateTime('HH":"nn":"ss',GMTValue), 'GMT']); {do not localize}
- end;
- function DateTimeGMTToCookieStr(const GMTValue: TDateTime; const AUseNetscapeFmt: Boolean = True) : String;
- var
- wDay, wMonth, wYear: Word;
- LDelim: Char;
- begin
- DecodeDate(GMTValue, wYear, wMonth, wDay);
- // RLebeau: cookie draft-23 requires HTTP servers to format an Expires value as follows:
- //
- // Wdy, DD Mon YYYY HH:MM:SS GMT
- //
- // However, Netscape style formatting, which RFCs 2109 and 2965 allow
- // (but draft-23 obsoletes), are more common:
- //
- // Wdy, DD-Mon-YY HH:MM:SS GMT (original)
- // Wdy, DD-Mon-YYYY HH:MM:SS GMT (RFC 1123)
- //
- if AUseNetscapeFmt then begin
- LDelim := '-'; {do not localize}
- end else begin
- LDelim := ' '; {do not localize}
- end;
- Result := IndyFormat('%s, %.2d%s%s%s%.4d %s %s', {do not localize}
- [wdays[DayOfWeek(GMTValue)], wDay, LDelim, monthnames[wMonth], LDelim, wYear,
- FormatDateTime('HH":"nn":"ss',GMTValue), 'GMT']); {do not localize}
- end;
- function DateTimeGMTToImapStr(const GMTValue: TDateTime) : String;
- var
- wDay, wMonth, wYear: Word;
- LDay: String;
- begin
- DecodeDate(GMTValue, wYear, wMonth, wDay);
- LDay := IntToStr(wDay);
- if Length(LDay) < 2 then begin
- LDay := ' ' + LDay; // NOTE: space NOT zero!
- end;
- Result := IndyFormat('%s-%s-%d %s %s', {do not localize}
- [LDay, monthnames[wMonth], wYear, FormatDateTime('HH":"nn":"ss',GMTValue), {do not localize}
- '+0000']); {do not localize}
- end;
- function LocalDateTimeToHttpStr(const Value: TDateTime) : String;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := DateTimeGMTToHttpStr(LocalTimeToUTCTime(Value));
- end;
- function LocalDateTimeToCookieStr(const Value: TDateTime; const AUseNetscapeFmt: Boolean = True) : String;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := DateTimeGMTToCookieStr(LocalTimeToUTCTime(Value), AUseNetscapeFmt);
- end;
- function LocalDateTimeToImapStr(const Value: TDateTime) : String;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := DateTimeGMTToImapStr(LocalTimeToUTCTime(Value));
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function DateTimeToInternetStr(const Value: TDateTime; const AUseGMTStr : Boolean = False) : String;
- {$I IdDeprecatedImplBugOn.inc}
- begin
- Result := LocalDateTimeToGMT(Value, AUseGMTStr);
- end;
- {This should never be localized}
- function LocalDateTimeToGMT(const Value: TDateTime; const AUseGMTStr: Boolean = False) : String;
- var
- wDay, wMonth, wYear: Word;
- begin
- DecodeDate(Value, wYear, wMonth, wDay);
- Result := IndyFormat('%s, %d %s %d %s %s', {do not localize}
- [wdays[DayOfWeek(Value)], wDay, monthnames[wMonth],
- wYear, FormatDateTime('HH":"nn":"ss', Value), {do not localize}
- UTCOffsetToStr(OffsetFromUTC, AUseGMTStr)]);
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function DateTimeToGmtOffSetStr(ADateTime: TDateTime; const AUseGMTStr: Boolean = False): string;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := UTCOffsetToStr(ADateTime, AUseGMTStr);
- end;
- function OffsetFromUTC: TDateTime;
- {$IFDEF DOTNET}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ELSE}
- {$IFNDEF HAS_GetLocalTimeOffset}
- {$IFNDEF HAS_DateUtils_TTimeZone}
- {$IFDEF WINDOWS}
- var
- iBias: Integer;
- tmez: TTimeZoneInformation;
- {$ELSE}
- {$IFDEF UNIX}
- {$IFDEF USE_VCL_POSIX}
- var
- T : Time_t;
- TV : TimeVal;
- UT : tm;
- {$ELSE}
- {$IFDEF KYLIXCOMPAT}
- var
- T : Time_T;
- TV : TTimeVal;
- UT : TUnixTime;
- {$ELSE}
- {$IFDEF USE_BASEUNIX}
- var
- timeval: TTimeVal;
- timezone: TTimeZone;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := System.Timezone.CurrentTimezone.GetUTCOffset(DateTime.FromOADate(Now)).TotalDays;
- {$ELSE}
- {$IFDEF HAS_GetLocalTimeOffset}
- // RLebeau: Note that on Linux/Unix, this information may be inaccurate around
- // the DST time changes (for optimization). In that case, the unix.ReReadLocalTime()
- // function must be used to re-initialize the timezone information...
- Result := GetLocalTimeOffset() / 60 / 24;
- {$ELSE}
- {$IFDEF HAS_DateUtils_TTimeZone}
- Result := TTimeZone.Local.UtcOffset.TotalMinutes / 60 / 24;
- {$ELSE}
- {$IFDEF WINDOWS}
- case GetTimeZoneInformation({$IFDEF WINCE}@{$ENDIF}tmez) of
- TIME_ZONE_ID_INVALID :
- raise EIdFailedToRetreiveTimeZoneInfo.Create(RSFailedTimeZoneInfo);
- TIME_ZONE_ID_UNKNOWN :
- iBias := tmez.Bias;
- TIME_ZONE_ID_DAYLIGHT : begin
- iBias := tmez.Bias;
- if tmez.DaylightDate.wMonth <> 0 then begin
- iBias := iBias + tmez.DaylightBias;
- end;
- end;
- TIME_ZONE_ID_STANDARD : begin
- iBias := tmez.Bias;
- if tmez.StandardDate.wMonth <> 0 then begin
- iBias := iBias + tmez.StandardBias;
- end;
- end
- else
- begin
- raise EIdFailedToRetreiveTimeZoneInfo.Create(RSFailedTimeZoneInfo);
- end;
- end;
- {We use ABS because EncodeTime will only accept positive values}
- Result := EncodeTime(Abs(iBias) div 60, Abs(iBias) mod 60, 0, 0);
- {The GetTimeZone function returns values oriented towards converting
- a GMT time into a local time. We wish to do the opposite by returning
- the difference between the local time and GMT. So I just make a positive
- value negative and leave a negative value as positive}
- if iBias > 0 then begin
- Result := 0.0 - Result;
- end;
- {$ELSE}
- {$IFDEF UNIX}
- // TODO: raise EIdFailedToRetreiveTimeZoneInfo if gettimeofday() fails...
- {$IFDEF KYLIXCOMPAT_OR_VCL_POSIX}
- {from http://edn.embarcadero.com/article/27890 but without multiplying the Result by -1}
- gettimeofday(TV, nil);
- T := TV.tv_sec;
- localtime_r({$IFDEF KYLIXCOMPAT}@{$ENDIF}T, UT);
- Result := UT.{$IFDEF KYLIXCOMPAT}__tm_gmtoff{$ELSE}tm_gmtoff{$ENDIF} / 60 / 60 / 24;
- {$ELSE}
- {$IFDEF USE_BASEUNIX}
- fpGetTimeOfDay (@TimeVal, @TimeZone);
- Result := -1 * (timezone.tz_minuteswest / 60 / 24);
- {$ELSE}
- {$message error gettimeofday is not called on this platform!}
- Result := GOffsetFromUTC;
- {$ENDIF}
- {$ENDIF}
- {$ELSE}
- {$message error no platform API called to get UTC offset!}
- Result := GOffsetFromUTC;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- end;
- function UTCOffsetToStr(const AOffset: TDateTime; const AUseGMTStr: Boolean = False): string;
- var
- AHour, AMin, ASec, AMSec: Word;
- s: string;
- {$IFDEF STRING_IS_IMMUTABLE}
- LSB: TIdStringBuilder;
- {$ENDIF}
- begin
- if (AOffset = 0.0) and AUseGMTStr then
- begin
- Result := 'GMT'; {do not localize}
- end else
- begin
- DecodeTime(AOffset, AHour, AMin, ASec, AMSec);
- s := IndyFormat(' %0.2d%0.2d', [AHour, AMin]); {do not localize}
- {$IFDEF STRING_IS_IMMUTABLE}
- LSB := TIdStringBuilder.Create(5);
- LSB.Append(s);
- if AOffset < 0.0 then begin
- LSB[0] := '-'; {do not localize}
- end else begin
- LSB[0] := '+'; {do not localize}
- end;
- Result := LSB.ToString;
- {$ELSE}
- Result := s;
- if AOffset < 0.0 then begin
- Result[1] := '-'; {do not localize}
- end else begin
- Result[1] := '+'; {do not localize}
- end;
- {$ENDIF}
- end;
- end;
- function LocalTimeToUTCTime(const Value: TDateTime): TDateTime;
- begin
- {$IFDEF HAS_LocalTimeToUniversal}
- Result := LocalTimeToUniversal(Value);
- {$ELSE}
- {$IFDEF HAS_DateUtils_TTimeZone}
- Result := TTimeZone.Local.ToUniversalTime(Value);
- {$ELSE}
- Result := Value - OffsetFromUTC;
- {$ENDIF}
- {$ENDIF}
- end;
- function UTCTimeToLocalTime(const Value: TDateTime): TDateTime;
- begin
- {$IFDEF HAS_UniversalTimeToLocal}
- Result := UniversalTimeToLocal(Value);
- {$ELSE}
- {$IFDEF HAS_DateUtils_TTimeZone}
- Result := TTimeZone.Local.ToLocalTime(Value);
- {$ELSE}
- Result := Value + OffsetFromUTC;
- {$ENDIF}
- {$ENDIF}
- end;
- function IndyIncludeTrailingPathDelimiter(const S: string): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF HAS_SysUtils_IncludeExcludeTrailingPathDelimiter}
- Result := SysUtils.IncludeTrailingPathDelimiter(S);
- {$ELSE}
- Result := SysUtils.IncludeTrailingBackslash(S);
- {$ENDIF}
- end;
- function IndyExcludeTrailingPathDelimiter(const S: string): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF HAS_SysUtils_IncludeExcludeTrailingPathDelimiter}
- Result := SysUtils.ExcludeTrailingPathDelimiter(S);
- {$ELSE}
- Result := SysUtils.ExcludeTrailingBackslash(S);
- {$ENDIF}
- end;
- function StringsReplace(const S: String; const OldPattern, NewPattern: array of string): string;
- var
- i : Integer;
- begin
- // TODO: re-write this to not use ReplaceAll() in a loop anymore. If
- // OldPattern contains multiple strings, a string appearing later in the
- // list may be replaced multiple times by accident if it appears in the
- // Result of an earlier string replacement.
- Result := s;
- for i := Low(OldPattern) to High(OldPattern) do begin
- Result := ReplaceAll(Result, OldPattern[i], NewPattern[i]);
- end;
- end;
- {$IFNDEF DOTNET}
- {$IFNDEF HAS_PosEx}
- function PosEx(const SubStr, S: string; Offset: Integer): Integer;
- var
- I, LIterCnt, L, J: Integer;
- PSubStr, PS: PChar;
- begin
- Result := 0;
- if SubStr = '' then begin
- Exit;
- end;
- { Calculate the number of possible iterations. Not valid if Offset < 1. }
- LIterCnt := Length(S) - Offset - Length(SubStr) + 1;
- { Only continue if the number of iterations is positive or zero (there is space to check) }
- if (Offset > 0) and (LIterCnt >= 0) then
- begin
- L := Length(SubStr);
- PSubStr := PChar(SubStr);
- PS := PChar(S);
- Inc(PS, Offset - 1);
- for I := 0 to LIterCnt do
- begin
- J := 0;
- while (J >= 0) and (J < L) do
- begin
- if PS[I + J] = PSubStr[J] then begin
- Inc(J);
- end else begin
- J := -1;
- end;
- end;
- if J >= L then begin
- Result := I + Offset;
- Exit;
- end;
- end;
- end;
- end;
- {$ENDIF}
- {$ENDIF}
- function ReplaceAll(const S: String; const OldPattern, NewPattern: String): String;
- var
- I, PatLen: Integer;
- {$IFDEF DOTNET}
- J: Integer;
- {$ELSE}
- NumBytes: Integer;
- {$ENDIF}
- begin
- PatLen := Length(OldPattern);
- if Length(NewPattern) = PatLen then begin
- Result := S;
- I := Pos(OldPattern, Result);
- if I > 0 then begin
- UniqueString(Result);
- {$IFNDEF DOTNET}
- NumBytes := PatLen * SizeOf(Char);
- {$ENDIF}
- repeat
- {$IFDEF DOTNET}
- for J := 1 to PatLen do begin
- Result[I+J-1] := NewPattern[J];
- end;
- {$ELSE}
- Move(PChar(NewPattern)^, Result[I], NumBytes);
- {$ENDIF}
- I := PosEx(OldPattern, Result, I + PatLen);
- until I = 0;
- end;
- end else begin
- Result := SysUtils.StringReplace(S, OldPattern, NewPattern, [rfReplaceAll]);
- end;
- end;
- function ReplaceOnlyFirst(const S, OldPattern, NewPattern: string): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := SysUtils.StringReplace(s, OldPattern, NewPattern, []);
- end;
- function IndyStrToInt(const S: string): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := StrToInt(Trim(S));
- end;
- function IndyStrToInt(const S: string; ADefault: Integer): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := StrToIntDef(Trim(S), ADefault);
- end;
- function CompareDate(const D1, D2: TDateTime): Integer;
- var
- LTM1, LTM2 : TTimeStamp;
- begin
- // TODO: use DateUtils.CompareDateTime() instead...
- LTM1 := DateTimeToTimeStamp(D1);
- LTM2 := DateTimeToTimeStamp(D2);
- if LTM1.Date = LTM2.Date then begin
- if LTM1.Time < LTM2.Time then begin
- Result := -1;
- end
- else if LTM1.Time > LTM2.Time then begin
- Result := 1;
- end
- else begin
- Result := 0;
- end;
- end
- else if LTM1.Date > LTM2.Date then begin
- Result := 1;
- end
- else begin
- Result := -1;
- end;
- end;
- function AddMSecToTime(const ADateTime: TDateTime; const AMSec: Integer): TDateTime;
- {$IFDEF HAS_UNIT_DateUtils}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ELSE}
- var
- LTM : TTimeStamp;
- {$ENDIF}
- begin
- {$IFDEF HAS_UNIT_DateUtils}
- Result := DateUtils.IncMilliSecond(ADateTime, AMSec);
- {$ELSE}
- LTM := DateTimeToTimeStamp(ADateTime);
- LTM.Time := LTM.Time + AMSec;
- Result := TimeStampToDateTime(LTM);
- {$ENDIF}
- end;
- function IndyFileAge(const AFileName: string): TDateTime;
- {$IFDEF HAS_2PARAM_FileAge}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ELSE}
- var
- LAge: Integer;
- {$ENDIF}
- begin
- {$IFDEF HAS_2PARAM_FileAge}
- //single-parameter fileage is deprecated in d2006 and above
- if not FileAge(AFileName, Result) then begin
- Result := 0;
- end;
- {$ELSE}
- LAge := SysUtils.FileAge(AFileName);
- if LAge <> -1 then begin
- Result := FileDateToDateTime(LAge);
- end else begin
- Result := 0.0;
- end;
- {$ENDIF}
- end;
- function IndyDirectoryExists(const ADirectory: string): Boolean;
- {$IFDEF HAS_SysUtils_DirectoryExists}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ELSE}
- var
- Code: Integer;
- {$IFDEF STRING_UNICODE_MISMATCH}
- LStr: TIdPlatformString;
- {$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF HAS_SysUtils_DirectoryExists}
- Result := SysUtils.DirectoryExists(ADirectory);
- {$ELSE}
- // RLebeau 2/16/2006: Removed dependency on the FileCtrl unit
- {$IFDEF STRING_UNICODE_MISMATCH}
- LStr := TIdPlatformString(ADirectory); // explicit convert to Ansi/Unicode
- Code := GetFileAttributes(PIdPlatformChar(LStr));
- {$ELSE}
- Code := GetFileAttributes(PChar(ADirectory));
- {$ENDIF}
- Result := (Code <> -1) and ((Code and FILE_ATTRIBUTE_DIRECTORY) <> 0);
- {$ENDIF}
- end;
- function IndyStrToInt64(const S: string; const ADefault: Int64): Int64;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := SysUtils.StrToInt64Def(Trim(S), ADefault);
- end;
- function IndyStrToInt64(const S: string): Int64;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := SysUtils.StrToInt64(Trim(S));
- end;
- function IndyStrToStreamSize(const S: string; const ADefault: TIdStreamSize): TIdStreamSize;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF STREAM_SIZE_64}
- Result := IndyStrToInt64(S, ADefault);
- {$ELSE}
- Result := IndyStrToInt(S, ADefault);
- {$ENDIF}
- end;
- function IndyStrToStreamSize(const S: string): TIdStreamSize;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF STREAM_SIZE_64}
- Result := IndyStrToInt64(S);
- {$ELSE}
- Result := IndyStrToInt(S);
- {$ENDIF}
- end;
- function ToBytes(const AValue: string; ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ): TIdBytes; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := ToBytes(AValue, -1, 1, ADestEncoding
- {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
- );
- end;
- function ToBytes(const AValue: string; const ALength: Integer; const AIndex: Integer = 1;
- ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ): TIdBytes; overload;
- var
- LLength: Integer;
- {$IFDEF STRING_IS_ANSI}
- LBytes: TIdBytes;
- {$ENDIF}
- begin
- {$IFDEF STRING_IS_ANSI}
- LBytes := nil; // keep the compiler happy
- {$ENDIF}
- LLength := IndyLength(AValue, ALength, AIndex);
- if LLength > 0 then
- begin
- EnsureEncoding(ADestEncoding);
- {$IFDEF STRING_IS_UNICODE}
- SetLength(Result, ADestEncoding.GetByteCount(AValue, AIndex, LLength));
- if Length(Result) > 0 then begin
- ADestEncoding.GetBytes(AValue, AIndex, LLength, Result, 0);
- end;
- {$ELSE}
- EnsureEncoding(ASrcEncoding, encOSDefault);
- LBytes := RawToBytes(AValue[AIndex], LLength);
- CheckByteEncoding(LBytes, ASrcEncoding, ADestEncoding);
- Result := LBytes;
- {$ENDIF}
- end else begin
- SetLength(Result, 0);
- end;
- end;
- function ToBytes(const AValue: Char; ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ): TIdBytes; overload;
- var
- {$IFDEF STRING_IS_UNICODE}
- LChars: {$IFDEF DOTNET}array[0..0] of Char{$ELSE}TIdWideChars{$ENDIF};
- {$ELSE}
- LBytes: TIdBytes;
- {$ENDIF}
- begin
- EnsureEncoding(ADestEncoding);
- {$IFDEF STRING_IS_UNICODE}
- {$IFNDEF DOTNET}
- SetLength(LChars, 1);
- {$ENDIF}
- LChars[0] := AValue;
- Result := ADestEncoding.GetBytes(LChars);
- {$ELSE}
- EnsureEncoding(ASrcEncoding, encOSDefault);
- LBytes := RawToBytes(AValue, 1);
- CheckByteEncoding(LBytes, ASrcEncoding, ADestEncoding);
- Result := LBytes;
- {$ENDIF}
- end;
- function ToBytes(const AValue: Int64): TIdBytes; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := System.BitConverter.GetBytes(AValue);
- {$ELSE}
- SetLength(Result, SizeOf(Int64));
- PInt64(@Result[0])^ := AValue;
- {$ENDIF}
- end;
- function ToBytes(const AValue: TIdUInt64): TIdBytes; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := System.BitConverter.GetBytes(AValue);
- {$ELSE}
- SetLength(Result, SizeOf(UInt64));
- PUInt64(@Result[0])^ := AValue{$IFDEF TIdUInt64_HAS_QuadPart}.QuadPart{$ENDIF};
- {$ENDIF}
- end;
- function ToBytes(const AValue: Int32): TIdBytes; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := System.BitConverter.GetBytes(AValue);
- {$ELSE}
- SetLength(Result, SizeOf(Int32));
- PInt32(@Result[0])^ := AValue;
- {$ENDIF}
- end;
- function ToBytes(const AValue: UInt32): TIdBytes; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := System.BitConverter.GetBytes(AValue);
- {$ELSE}
- SetLength(Result, SizeOf(UInt32));
- PUInt32(@Result[0])^ := AValue;
- {$ENDIF}
- end;
- function ToBytes(const AValue: Int16): TIdBytes; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := System.BitConverter.GetBytes(AValue);
- {$ELSE}
- SetLength(Result, SizeOf(Int16));
- PInt16(@Result[0])^ := AValue;
- {$ENDIF}
- end;
- function ToBytes(const AValue: UInt16): TIdBytes; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := System.BitConverter.GetBytes(AValue);
- {$ELSE}
- SetLength(Result, SizeOf(UInt16));
- PUInt16(@Result[0])^ := AValue;
- {$ENDIF}
- end;
- function ToBytes(const AValue: Int8): TIdBytes; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- SetLength(Result, SizeOf(Int8));
- Result[0] := Byte(AValue);
- end;
- function ToBytes(const AValue: UInt8): TIdBytes; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- SetLength(Result, SizeOf(UInt8));
- Result[0] := AValue;
- end;
- function ToBytes(const AValue: TIdBytes; const ASize: Integer; const AIndex: Integer = 0): TIdBytes; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LSize: Integer;
- begin
- LSize := IndyLength(AValue, ASize, AIndex);
- SetLength(Result, LSize);
- if LSize > 0 then begin
- CopyTIdBytes(AValue, AIndex, Result, 0, LSize);
- end;
- end;
- {$IFNDEF DOTNET}
- function RawToBytes(const AValue; const ASize: Integer): TIdBytes;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- SetLength(Result, ASize);
- if ASize > 0 then begin
- Move(AValue, Result[0], ASize);
- end;
- end;
- {$ENDIF}
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: Char; ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- );
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LChars: {$IFDEF DOTNET}array[0..0] of Char{$ELSE}TIdWideChars{$ENDIF};
- begin
- EnsureEncoding(ADestEncoding);
- {$IFDEF STRING_IS_UNICODE}
- {$IFNDEF DOTNET}
- SetLength(LChars, 1);
- {$ENDIF}
- LChars[0] := AValue;
- {$ELSE}
- EnsureEncoding(ASrcEncoding, encOSDefault);
- LChars := ASrcEncoding.GetChars(RawToBytes(AValue, 1)); // convert to Unicode
- {$ENDIF}
- Assert(Length(Bytes) >= ADestEncoding.GetByteCount(LChars));
- ADestEncoding.GetBytes(LChars, 0, Length(LChars), Bytes, 0);
- end;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int32);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(Bytes) >= SizeOf(AValue));
- CopyTIdInt32(AValue, Bytes, 0);
- end;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int16);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(Bytes) >= SizeOf(AValue));
- CopyTIdInt16(AValue, Bytes, 0);
- end;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: UInt16);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(Bytes) >= SizeOf(AValue));
- CopyTIdUInt16(AValue, Bytes, 0);
- end;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int8);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(Bytes) >= SizeOf(AValue));
- Bytes[0] := Byte(AValue);
- end;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: UInt8);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(Bytes) >= SizeOf(AValue));
- Bytes[0] := AValue;
- end;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: UInt32);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(Bytes) >= SizeOf(AValue));
- CopyTIdUInt32(AValue, Bytes, 0);
- end;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int64);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(Bytes) >= SizeOf(AValue));
- CopyTIdInt64(AValue, Bytes, 0);
- end;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: TIdUInt64);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(Bytes) >= SizeOf(AValue));
- CopyTIdUInt64(AValue, Bytes, 0);
- end;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: TIdBytes; const ASize: Integer; const AIndex: Integer = 0);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(Bytes) >= ASize);
- CopyTIdBytes(AValue, AIndex, Bytes, 0, ASize);
- end;
- {$IFNDEF DOTNET}
- procedure RawToBytesF(var Bytes: TIdBytes; const AValue; const ASize: Integer);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(Bytes) >= ASize);
- if ASize > 0 then begin
- Move(AValue, Bytes[0], ASize);
- end;
- end;
- {$ENDIF}
- function BytesToChar(const AValue: TIdBytes; const AIndex: Integer = 0;
- AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): Char; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- BytesToChar(AValue, Result, AIndex, AByteEncoding{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
- end;
- function BytesToChar(const AValue: TIdBytes; var VChar: Char; const AIndex: Integer = 0;
- AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): Integer; overload;
- var
- I, J, NumChars, NumBytes: Integer;
- {$IFDEF DOTNET}
- LChars: array[0..1] of Char;
- {$ELSE}
- LChars: TIdWideChars;
- {$IFDEF STRING_IS_ANSI}
- LWTmp: WideString;
- LATmp: TIdBytes;
- {$ENDIF}
- {$ENDIF}
- begin
- Result := 0;
- EnsureEncoding(AByteEncoding);
- // 2 Chars to handle UTF-16 surrogates
- NumBytes := IndyMin(IndyLength(AValue, -1, AIndex), AByteEncoding.GetMaxByteCount(2));
- {$IFNDEF DOTNET}
- SetLength(LChars, 2);
- {$ENDIF}
- NumChars := 0;
- if NumBytes > 0 then
- begin
- for I := 1 to NumBytes do
- begin
- NumChars := AByteEncoding.GetChars(AValue, AIndex, I, LChars, 0);
- Inc(Result);
- if NumChars > 0 then begin
- // RLebeau 10/19/2012: when Indy switched to its own UTF-8 implementation
- // to avoid the MB_ERR_INVALID_CHARS flag on Windows, it accidentally broke
- // this loop! Since this is not commonly used, this was not noticed until
- // now. On Windows at least, GetChars() now returns >0 for an invalid
- // sequence, so we have to check if any of the returned characters are the
- // Unicode U+FFFD character, indicating bad data...
- for J := 0 to NumChars-1 do begin
- if LChars[J] = TIdWideChar($FFFD) then begin
- // keep reading...
- NumChars := 0;
- Break;
- end;
- end;
- if NumChars > 0 then begin
- Break;
- end;
- end;
- end;
- end;
- {$IFDEF STRING_IS_UNICODE}
- // RLebeau: if the bytes were decoded into surrogates, the second
- // surrogate is lost here, as it can't be returned unless we cache
- // it somewhere for the the next BytesToChar() call to retreive. Just
- // raise an error for now. Users will have to update their code to
- // read surrogates differently...
- Assert(NumChars = 1);
- VChar := LChars[0];
- {$ELSE}
- // RLebeau: since we can only return an AnsiChar here, let's convert
- // the decoded characters, surrogates and all, into their Ansi
- // representation. This will have the same problem as above if the
- // conversion results in a multibyte character sequence...
- EnsureEncoding(ADestEncoding, encOSDefault);
- SetString(LWTmp, PWideChar(LChars), NumChars);
- LATmp := ADestEncoding.GetBytes(LWTmp); // convert to Ansi
- Assert(Length(LATmp) = 1);
- VChar := Char(LATmp[0]);
- {$ENDIF}
- end;
- function BytesToInt32(const AValue: TIdBytes; const AIndex: Integer = 0): Int32;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(AValue) >= (AIndex+SizeOf(Int32)));
- {$IFDEF DOTNET}
- Result := System.BitConverter.ToInt32(AValue, AIndex);
- {$ELSE}
- Result := PInt32(@AValue[AIndex])^;
- {$ENDIF}
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function BytesToLongInt(const AValue: TIdBytes; const AIndex: Integer = 0): Integer;
- {$I IdDeprecatedImplBugOff.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := BytesToInt32(AValue, AIndex);
- end;
- function BytesToInt64(const AValue: TIdBytes; const AIndex: Integer = 0): Int64;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(AValue) >= (AIndex+SizeOf(Int64)));
- {$IFDEF DOTNET}
- Result := System.BitConverter.ToInt64(AValue, AIndex);
- {$ELSE}
- Result := PInt64(@AValue[AIndex])^;
- {$ENDIF}
- end;
- function BytesToUInt64(const AValue: TIdBytes; const AIndex: Integer = 0): TIdUInt64;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(AValue) >= (AIndex+SizeOf(TIdUInt64)));
- {$IFDEF DOTNET}
- Result := System.BitConverter.ToUInt64(AValue, AIndex);
- {$ELSE}
- Result{$IFDEF TIdUInt64_HAS_QuadPart}.QuadPart{$ENDIF} := PUInt64(@AValue[AIndex])^;
- {$ENDIF}
- end;
- function BytesToTicks(const AValue: TIdBytes; const AIndex: Integer = 0): TIdTicks;
- {$IFDEF USE_TIdTicks_TIdUInt64_CONVERSION}
- var
- LValue: TIdUInt64;
- {$ELSE}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF USE_TIdTicks_TIdUInt64_CONVERSION}
- // In C++Builder 2006/2007, TIdUInt64 is a packed record, but TIdTicks is
- // an alias for a native UInt64 , so need a conversion here to get around
- // a compiler error: "E2010 Incompatible types: 'UInt64' and 'TIdUInt64'"...
- LValue := BytesToUInt64(AValue, AIndex);
- Result := LValue.QuadPart;
- {$ELSE}
- {$IFDEF UInt64_IS_NATIVE}
- Result := BytesToUInt64(AValue, AIndex);
- {$ELSE}
- Result := BytesToInt64(AValue, AIndex);
- {$ENDIF}
- {$ENDIF}
- end;
- function BytesToUInt16(const AValue: TIdBytes; const AIndex: Integer = 0): UInt16;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(AValue) >= (AIndex+SizeOf(UInt16)));
- {$IFDEF DOTNET}
- Result := System.BitConverter.ToUInt16(AValue, AIndex);
- {$ELSE}
- Result := PUInt16(@AValue[AIndex])^;
- {$ENDIF}
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function BytesToWord(const AValue: TIdBytes; const AIndex: Integer = 0): UInt16;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := BytesToUInt16(AValue, AIndex);
- end;
- function BytesToInt16(const AValue: TIdBytes; const AIndex: Integer = 0): Int16;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(AValue) >= (AIndex+SizeOf(Int16)));
- {$IFDEF DOTNET}
- Result := System.BitConverter.ToInt16(AValue, AIndex);
- {$ELSE}
- Result := PInt16(@AValue[AIndex])^;
- {$ENDIF}
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function BytesToShort(const AValue: TIdBytes; const AIndex: Integer = 0): Int16;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := BytesToInt16(AValue, AIndex);
- end;
- function BytesToIPv4Str(const AValue: TIdBytes; const AIndex: Integer = 0): String;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(AValue) >= (AIndex+4));
- Result := IntToStr(Ord(AValue[AIndex])) + '.' +
- IntToStr(Ord(AValue[AIndex+1])) + '.' +
- IntToStr(Ord(AValue[AIndex+2])) + '.' +
- IntToStr(Ord(AValue[AIndex+3]));
- end;
- procedure BytesToIPv6(const AValue: TIdBytes; var VAddress: TIdIPv6Address; const AIndex: Integer = 0);
- {$IFDEF DOTNET}
- var
- I: Integer;
- {$ELSE}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- begin
- Assert(Length(AValue) >= (AIndex+16));
- {$IFDEF DOTNET}
- for i := 0 to 7 do begin
- VAddress[i] := TwoByteToUInt16(AValue[(i*2)+AIndex], AValue[(i*2)+1+AIndex]);
- end;
- {$ELSE}
- Move(AValue[AIndex], VAddress[0], 16);
- {$ENDIF}
- end;
- function BytesToUInt32(const AValue: TIdBytes; const AIndex: Integer = 0): UInt32;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(AValue) >= (AIndex+SizeOf(UInt32)));
- {$IFDEF DOTNET}
- Result := System.BitConverter.ToUInt32(AValue, AIndex);
- {$ELSE}
- Result := PUInt32(@AValue[AIndex])^;
- {$ENDIF}
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function BytesToLongWord(const AValue: TIdBytes; const AIndex: Integer = 0): UInt32;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := BytesToUInt32(AValue, AIndex);
- end;
- function BytesToString(const AValue: TIdBytes; AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): string; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := BytesToString(AValue, 0, -1, AByteEncoding
- {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
- );
- end;
- function BytesToString(const AValue: TIdBytes; const AStartIndex: Integer;
- const ALength: Integer = -1; AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): string; overload;
- var
- LLength: Integer;
- {$IFDEF STRING_IS_ANSI}
- LBytes: TIdBytes;
- {$ENDIF}
- begin
- {$IFDEF STRING_IS_ANSI}
- LBytes := nil; // keep the compiler happy
- {$ENDIF}
- LLength := IndyLength(AValue, ALength, AStartIndex);
- if LLength > 0 then begin
- EnsureEncoding(AByteEncoding);
- {$IFDEF STRING_IS_UNICODE}
- Result := AByteEncoding.GetString(AValue, AStartIndex, LLength);
- {$ELSE}
- EnsureEncoding(ADestEncoding);
- if (AStartIndex = 0) and (LLength = Length(AValue)) then begin
- LBytes := AValue;
- end else begin
- LBytes := Copy(AValue, AStartIndex, LLength);
- end;
- CheckByteEncoding(LBytes, AByteEncoding, ADestEncoding);
- SetString(Result, PAnsiChar(LBytes), Length(LBytes));
- {$IFDEF HAS_SetCodePage}
- // on compilers that support AnsiString codepages,
- // set the string's codepage to match ADestEncoding...
- SetCodePage(PRawByteString(@Result)^, GetEncodingCodePage(ADestEncoding), False);
- {$ENDIF}
- {$ENDIF}
- end else begin
- Result := '';
- end;
- end;
- function BytesToStringRaw(const AValue: TIdBytes): string; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := BytesToStringRaw(AValue, 0, -1);
- end;
- function BytesToStringRaw(const AValue: TIdBytes; const AStartIndex: Integer;
- const ALength: Integer = -1): string;
- var
- LLength: Integer;
- begin
- LLength := IndyLength(AValue, ALength, AStartIndex);
- if LLength > 0 then begin
- {$IFDEF STRING_IS_UNICODE}
- Result := IndyTextEncoding_8Bit.GetString(AValue, AStartIndex, LLength);
- {$ELSE}
- SetString(Result, PAnsiChar(@AValue[AStartIndex]), LLength);
- {$IFDEF HAS_SetCodePage}
- // on compilers that support AnsiString codepages,
- // set the string's codepage to something like ISO-8859-1...
- SetCodePage(PRawByteString(@Result)^, 28591, False);
- {$ENDIF}
- {$ENDIF}
- end else begin
- Result := '';
- end;
- end;
- {$IFNDEF DOTNET}
- procedure BytesToRaw(const AValue: TIdBytes; var VBuffer; const ASize: Integer);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(AValue) >= ASize);
- Move(AValue[0], VBuffer, ASize);
- end;
- {$ENDIF}
- function TwoByteToUInt16(AByte1, AByte2: Byte): UInt16;
- //Since Replys are returned as Strings, we need a routine to convert two
- // characters which are a 2 byte U Int into a two byte unsigned Integer
- var
- LWord: TIdBytes;
- begin
- SetLength(LWord, SizeOf(UInt16));
- LWord[0] := AByte1;
- LWord[1] := AByte2;
- Result := BytesToUInt16(LWord);
- // Result := UInt16((AByte1 shl 8) and $FF00) or UInt16(AByte2 and $00FF);
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function TwoByteToWord(AByte1, AByte2: Byte): UInt16;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := TwoByteToUInt16(AByte1, AByte2);
- end;
- function ReadStringFromStream(AStream: TStream; ASize: Integer = -1;
- AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): string;
- var
- LBytes: TIdBytes;
- begin
- ASize := TIdStreamHelper.ReadBytes(AStream, LBytes, ASize);
- Result := BytesToString(LBytes, 0, ASize, AByteEncoding
- {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
- );
- end;
- function ReadTIdBytesFromStream(const AStream: TStream; var ABytes: TIdBytes;
- const Count: TIdStreamSize; const AIndex: Integer = 0): TIdStreamSize;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := TIdStreamHelper.ReadBytes(AStream, ABytes, Count, AIndex);
- end;
- function ReadCharFromStream(AStream: TStream; var VChar: Char;
- AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): Integer;
- var
- StartPos: TIdStreamSize;
- Lb: Byte;
- I, NumChars, NumBytes: Integer;
- LBytes: TIdBytes;
- {$IFDEF DOTNET}
- LChars: array[0..1] of Char;
- {$ELSE}
- LChars: TIdWideChars;
- {$IFDEF STRING_IS_ANSI}
- LWTmp: WideString;
- LATmp: TIdBytes;
- {$ENDIF}
- {$ENDIF}
- function ReadByte: Byte;
- begin
- if AStream.Read(Result{$IFNDEF DOTNET}, 1{$ENDIF}) <> 1 then begin
- raise EIdException.Create('Unable to read byte'); {do not localize}
- end;
- end;
- begin
- Result := 0;
- {$IFDEF STRING_IS_ANSI}
- LATmp := nil; // keep the compiler happy
- {$ENDIF}
- EnsureEncoding(AByteEncoding);
- StartPos := AStream.Position;
- // don't raise an exception here, backwards compatibility for now
- if AStream.Read(Lb{$IFNDEF DOTNET}, 1{$ENDIF}) <> 1 then begin
- Exit;
- end;
- Result := 1;
- // 2 Chars to handle UTF-16 surrogates
- NumBytes := AByteEncoding.GetMaxByteCount(2);
- SetLength(LBytes, NumBytes);
- {$IFNDEF DOTNET}
- SetLength(LChars, 2);
- {$ENDIF}
- try
- repeat
- LBytes[Result-1] := Lb;
- NumChars := AByteEncoding.GetChars(LBytes, 0, Result, LChars, 0);
- if NumChars > 0 then begin
- // RLebeau 10/19/2012: when Indy switched to its own UTF-8 implementation
- // to avoid the MB_ERR_INVALID_CHARS flag on Windows, it accidentally broke
- // this loop! Since this is not commonly used, this was not noticed until
- // now. On Windows at least, GetChars() now returns >0 for an invalid
- // sequence, so we have to check if any of the returned characters are the
- // Unicode U+FFFD character, indicating bad data...
- for I := 0 to NumChars-1 do begin
- if LChars[I] = TIdWideChar($FFFD) then begin
- // keep reading...
- NumChars := 0;
- Break;
- end;
- end;
- if NumChars > 0 then begin
- Break;
- end;
- end;
- if Result = NumBytes then begin
- Break;
- end;
- Lb := ReadByte;
- Inc(Result);
- until False;
- except
- AStream.Position := StartPos;
- raise;
- end;
- {$IFDEF STRING_IS_UNICODE}
- // RLebeau: if the bytes were decoded into surrogates, the second
- // surrogate is lost here, as it can't be returned unless we cache
- // it somewhere for the the next ReadTIdBytesFromStream() call to
- // retreive. Just raise an error for now. Users will have to
- // update their code to read surrogates differently...
- Assert(NumChars = 1);
- VChar := LChars[0];
- {$ELSE}
- // RLebeau: since we can only return an AnsiChar here, let's convert
- // the decoded characters, surrogates and all, into their Ansi
- // representation. This will have the same problem as above if the
- // conversion results in a multibyte character sequence...
- EnsureEncoding(ADestEncoding, encOSDefault);
- SetString(LWTmp, PWideChar(LChars), NumChars);
- LATmp := ADestEncoding.GetBytes(LWTmp); // convert to Ansi
- Assert(Length(LATmp) = 1);
- VChar := Char(LATmp[0]);
- {$ENDIF}
- end;
- procedure WriteTIdBytesToStream(const AStream: TStream; const ABytes: TIdBytes;
- const ASize: Integer = -1; const AIndex: Integer = 0);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- TIdStreamHelper.Write(AStream, ABytes, ASize, AIndex);
- end;
- procedure WriteStringToStream(AStream: TStream; const AStr: string;
- ADestEncoding: IIdTextEncoding
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- );
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- WriteStringToStream(AStream, AStr, -1, 1, ADestEncoding
- {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
- );
- end;
- procedure WriteStringToStream(AStream: TStream; const AStr: string;
- const ALength: Integer = -1; const AIndex: Integer = 1;
- ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- );
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LLength: Integer;
- LBytes: TIdBytes;
- begin
- LBytes := nil;
- LLength := IndyLength(AStr, ALength, AIndex);
- if LLength > 0 then
- begin
- LBytes := ToBytes(AStr, LLength, AIndex, ADestEncoding
- {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
- );
- TIdStreamHelper.Write(AStream, LBytes);
- end;
- end;
- {$IFDEF DOTNET}
- function TIdBaseStream.Read(var VBuffer: array of Byte; AOffset, ACount: Longint): Longint;
- var
- LBytes: TIdBytes;
- begin
- // this is a silly work around really, but array of Byte and TIdByte aren't
- // interchangable in a var parameter, though really they *should be*
- SetLength(LBytes, ACount - AOffset);
- Result := IdRead(LBytes, 0, ACount - AOffset);
- CopyTIdByteArray(LBytes, 0, VBuffer, AOffset, Result);
- end;
- function TIdBaseStream.Write(const ABuffer: array of Byte; AOffset, ACount: Longint): Longint;
- begin
- Result := IdWrite(ABuffer, AOffset, ACount);
- end;
- function TIdBaseStream.Seek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64;
- begin
- Result := IdSeek(AOffset, AOrigin);
- end;
- procedure TIdBaseStream.SetSize(ASize: Int64);
- begin
- IdSetSize(ASize);
- end;
- {$ELSE}
- {$IFDEF STREAM_SIZE_64}
- procedure TIdBaseStream.SetSize(const NewSize: Int64);
- begin
- IdSetSize(NewSize);
- end;
- {$ELSE}
- procedure TIdBaseStream.SetSize(ASize: Integer);
- begin
- IdSetSize(ASize);
- end;
- {$ENDIF}
- function TIdBaseStream.Read(var Buffer; Count: Longint): Longint;
- var
- LBytes: TIdBytes;
- begin
- SetLength(LBytes, Count);
- Result := IdRead(LBytes, 0, Count);
- if Result > 0 then begin
- Move(LBytes[0], Buffer, Result);
- end;
- end;
- function TIdBaseStream.Write(const Buffer; Count: Longint): Longint;
- begin
- if Count > 0 then begin
- Result := IdWrite(RawToBytes(Buffer, Count), 0, Count);
- end else begin
- Result := 0;
- end;
- end;
- {$IFDEF STREAM_SIZE_64}
- function TIdBaseStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
- begin
- Result := IdSeek(Offset, Origin);
- end;
- {$ELSE}
- function TIdBaseStream.Seek(Offset: Longint; Origin: Word): Longint;
- var
- LSeek : TSeekOrigin;
- begin
- case Origin of
- soFromBeginning : LSeek := soBeginning;
- soFromCurrent : LSeek := soCurrent;
- soFromEnd : LSeek := soEnd;
- else
- Result := 0;
- Exit;
- end;
- Result := IdSeek(Offset, LSeek) and $FFFFFFFF;
- end;
- {$ENDIF}
- {$ENDIF}
- function TIdCalculateSizeStream.IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint;
- begin
- Result := 0;
- end;
- function TIdCalculateSizeStream.IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint;
- var
- I: Integer;
- begin
- I := IndyLength(ABuffer, ACount, AOffset);
- if I > 0 then begin
- Inc(FPosition, I);
- if FPosition > FSize then begin
- FSize := FPosition;
- end;
- end;
- Result := I;
- end;
- function TIdCalculateSizeStream.IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64;
- begin
- case AOrigin of
- soBeginning: begin
- FPosition := AOffset;
- end;
- soCurrent: begin
- FPosition := FPosition + AOffset;
- end;
- soEnd: begin
- FPosition := FSize + AOffset;
- end;
- end;
- if FPosition < 0 then begin
- FPosition := 0;
- end;
- Result := FPosition;
- end;
- procedure TIdCalculateSizeStream.IdSetSize(ASize: Int64);
- begin
- if ASize < 0 then begin
- ASize := 0;
- end;
- if FSize <> ASize then begin
- FSize := ASize;
- if FSize < FPosition then begin
- FPosition := FSize;
- end;
- end;
- end;
- function TIdEventStream.IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint;
- begin
- Result := 0;
- if Assigned(FOnRead) then begin
- FOnRead(VBuffer, AOffset, ACount, Result);
- end;
- end;
- function TIdEventStream.IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint;
- begin
- if Assigned(FOnWrite) then begin
- Result := 0;
- FOnWrite(ABuffer, AOffset, ACount, Result);
- end else begin
- Result := ACount;
- end;
- end;
- function TIdEventStream.IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64;
- begin
- Result := 0;
- if Assigned(FOnSeek) then begin
- FOnSeek(AOffset, AOrigin, Result);
- end;
- end;
- procedure TIdEventStream.IdSetSize(ASize: Int64);
- begin
- if Assigned(FOnSetSize) then begin
- FOnSetSize(ASize);
- end;
- end;
- {$IFNDEF DOTNET}
- constructor TIdMemoryBufferStream.Create(APtr: Pointer; ASize: TIdNativeInt);
- begin
- inherited Create;
- SetPointer(APtr, ASize);
- end;
- {$UNDEF USE_PBYTE_ARITHMETIC}
- {$IFDEF FPC}
- {$DEFINE USE_PBYTE_ARITHMETIC}
- {$ELSE}
- {$IFDEF VCL_XE2_OR_ABOVE}
- {$DEFINE USE_PBYTE_ARITHMETIC}
- {$ENDIF}
- {$ENDIF}
- function TIdMemoryBufferStream.Write(const Buffer; Count: Longint): Longint;
- var
- LAvailable: TIdStreamSize;
- LNumToCopy: Longint;
- begin
- Result := 0;
- LAvailable := Size - Position;
- if LAvailable > 0 then
- begin
- {$IFDEF STREAM_SIZE_64}
- LNumToCopy := Longint(IndyMin(LAvailable, TIdStreamSize(Count)));
- {$ELSE}
- LNumToCopy := IndyMin(LAvailable, Count);
- {$ENDIF}
- if LNumToCopy > 0 then
- begin
- System.Move(Buffer, ({$IFDEF USE_PBYTE_ARITHMETIC}PByte{$ELSE}PIdAnsiChar{$ENDIF}(Memory) + Position)^, LNumToCopy);
- TIdStreamHelper.Seek(Self, LNumToCopy, soCurrent);
- Result := LNumToCopy;
- end;
- end;
- end;
- {$ENDIF}
- function TIdReadOnlyMemoryBufferStream.Write(const Buffer; Count: Longint): Longint;
- begin
- // TODO: raise an exception instead?
- Result := 0;
- end;
- procedure AppendBytes(var VBytes: TIdBytes; const AToAdd: TIdBytes; const AIndex: Integer = 0; const ALength: Integer = -1);
- var
- LOldLen, LAddLen: Integer;
- begin
- LAddLen := IndyLength(AToAdd, ALength, AIndex);
- if LAddLen > 0 then begin
- LOldLen := Length(VBytes);
- SetLength(VBytes, LOldLen + LAddLen);
- CopyTIdBytes(AToAdd, AIndex, VBytes, LOldLen, LAddLen);
- end;
- end;
- procedure AppendByte(var VBytes: TIdBytes; const AByte: Byte);
- var
- LOldLen: Integer;
- begin
- LOldLen := Length(VBytes);
- SetLength(VBytes, LOldLen + 1);
- VBytes[LOldLen] := AByte;
- end;
- procedure AppendString(var VBytes: TIdBytes; const AStr: String; const ALength: Integer = -1;
- ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- );
- var
- LBytes: TIdBytes;
- LLength, LOldLen: Integer;
- begin
- LBytes := nil; // keep the compiler happy
- LLength := IndyLength(AStr, ALength);
- if LLength > 0 then begin
- LBytes := ToBytes(AStr, LLength, 1, ADestEncoding
- {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
- );
- LOldLen := Length(VBytes);
- LLength := Length(LBytes);
- SetLength(VBytes, LOldLen + LLength);
- CopyTIdBytes(LBytes, 0, VBytes, LOldLen, LLength);
- end;
- end;
- procedure ExpandBytes(var VBytes: TIdBytes; const AIndex: Integer; const ACount: Integer; const AFillByte: Byte = 0);
- var
- I: Integer;
- begin
- if ACount > 0 then begin
- // if AIndex is at the end of the buffer then the operation is appending bytes
- if AIndex <> Length(VBytes) then begin
- //if these asserts fail, then it indicates an attempted buffer overrun.
- Assert(AIndex >= 0);
- Assert(AIndex < Length(VBytes));
- end;
- SetLength(VBytes, Length(VBytes) + ACount);
- // move any existing bytes at the index to the end of the buffer
- for I := Length(VBytes)-1 downto AIndex+ACount do begin
- VBytes[I] := VBytes[I-ACount];
- end;
- // fill in the new space with the fill byte
- for I := AIndex to AIndex+ACount-1 do begin
- VBytes[I] := AFillByte;
- end;
- end;
- end;
- procedure InsertBytes(var VBytes: TIdBytes; const ADestIndex: Integer;
- const ASource: TIdBytes; const ASourceIndex: Integer = 0);
- var
- LAddLen: Integer;
- begin
- LAddLen := IndyLength(ASource, -1, ASourceIndex);
- if LAddLen > 0 then begin
- ExpandBytes(VBytes, ADestIndex, LAddLen);
- CopyTIdBytes(ASource, ASourceIndex, VBytes, ADestIndex, LAddLen);
- end;
- end;
- procedure InsertByte(var VBytes: TIdBytes; const AByte: Byte; const AIndex: Integer);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- ExpandBytes(VBytes, AIndex, 1, AByte);
- end;
- procedure RemoveBytes(var VBytes: TIdBytes; const ACount: Integer; const AIndex: Integer = 0);
- var
- I: Integer;
- LActual: Integer;
- begin
- //TODO: check the reference count of VBytes, if >1 then make a new copy
- Assert(AIndex >= 0);
- LActual := IndyMin(Length(VBytes)-AIndex, ACount);
- if LActual > 0 then begin
- if (AIndex + LActual) < Length(VBytes) then begin
- // RLebeau: TODO - use Move() here instead?
- for I := AIndex to Length(VBytes)-LActual-1 do begin
- VBytes[I] := VBytes[I+LActual];
- end;
- end;
- SetLength(VBytes, Length(VBytes)-LActual);
- end;
- end;
- procedure IdDelete(var s: string; AOffset, ACount: Integer);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Delete(s, AOffset, ACount);
- end;
- procedure IdInsert(const Source: string; var S: string; Index: Integer);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Insert(Source, S, Index);
- end;
- function TextIsSame(const A1, A2: string): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := System.String.Compare(A1, A2, True) = 0;
- {$ELSE}
- Result := AnsiCompareText(A1, A2) = 0;
- {$ENDIF}
- end;
- // TODO: define STRING_UNICODE_MISMATCH for WinCE in IdCompilerDefines.inc?
- {$IFDEF WINDOWS}
- {$IFDEF WINCE}
- {$IFNDEF STRING_IS_UNICODE}
- {$DEFINE COMPARE_STRING_MISMATCH}
- {$ENDIF}
- {$ELSE}
- {$IFDEF STRING_UNICODE_MISMATCH}
- {$DEFINE COMPARE_STRING_MISMATCH}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- function TextStartsWith(const S, SubS: string): Boolean;
- var
- LLen: Integer;
- {$IFDEF WINDOWS}
- {$IFDEF COMPARE_STRING_MISMATCH}
- LS, LSubS: {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF};
- P1, P2: {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF};
- {$ENDIF}
- {$ENDIF}
- begin
- LLen := Length(SubS);
- Result := LLen <= Length(S);
- if Result then
- begin
- {$IFDEF DOTNET}
- Result := System.String.Compare(S, 0, SubS, 0, LLen, True) = 0;
- {$ELSE}
- {$IFDEF WINDOWS}
- {$IFDEF COMPARE_STRING_MISMATCH}
- // explicit convert to Ansi/Unicode
- LS := {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF}(S);
- LSubS := {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF}(SubS);
- LLen := Length(LSubS);
- Result := LLen <= Length(LS);
- if Result then begin
- P1 := {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF}(LS);
- P2 := {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF}(LSubS);
- Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, P1, LLen, P2, LLen) = 2;
- end;
- {$ELSE}
- Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PChar(S), LLen, PChar(SubS), LLen) = 2;
- {$ENDIF}
- {$ELSE}
- Result := AnsiCompareText(Copy(S, 1, LLen), SubS) = 0;
- {$ENDIF}
- {$ENDIF}
- end;
- end;
- function TextEndsWith(const S, SubS: string): Boolean;
- var
- LLen: Integer;
- {$IFDEF WINDOWS}
- {$IFDEF COMPARE_STRING_MISMATCH}
- LS, LSubS: {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF};
- P1, P2: {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF};
- {$ELSE}
- P: PChar;
- {$ENDIF}
- {$ENDIF}
- begin
- LLen := Length(SubS);
- Result := LLen <= Length(S);
- if Result then
- begin
- {$IFDEF DOTNET}
- Result := System.String.Compare(S, Length(S)-LLen, SubS, 0, LLen, True) = 0;
- {$ELSE}
- {$IFDEF WINDOWS}
- {$IFDEF COMPARE_STRING_MISMATCH}
- // explicit convert to Ansi/Unicode
- LS := {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF}(S);
- LSubS := {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF}(SubS);
- LLen := Length(LSubS);
- Result := LLen <= Length(S);
- if Result then begin
- P1 := {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF}(LS);
- P2 := {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF}(LSubS);
- Inc(P1, Length(LS)-LLen);
- Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, P1, LLen, P2, LLen) = 2;
- end;
- {$ELSE}
- P := PChar(S);
- Inc(P, Length(S)-LLen);
- Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, P, LLen, PChar(SubS), LLen) = 2;
- {$ENDIF}
- {$ELSE}
- Result := AnsiCompareText(Copy(S, Length(S)-LLen+1, LLen), SubS) = 0;
- {$ENDIF}
- {$ENDIF}
- end;
- end;
- function IndyLowerCase(const A1: string): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := A1.ToLower;
- {$ELSE}
- Result := AnsiLowerCase(A1);
- {$ENDIF}
- end;
- function IndyUpperCase(const A1: string): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := A1.ToUpper;
- {$ELSE}
- Result := AnsiUpperCase(A1);
- {$ENDIF}
- end;
- function IndyCompareStr(const A1, A2: string): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := CompareStr(A1, A2);
- {$ELSE}
- Result := AnsiCompareStr(A1, A2);
- {$ENDIF}
- end;
- function CharPosInSet(const AString: string; const ACharPos: Integer; const ASet: String): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$IFNDEF DOTNET}
- var
- LChar: Char;
- I: Integer;
- {$ENDIF}
- begin
- Result := 0;
- if ACharPos < 1 then begin
- raise EIdException.Create('Invalid ACharPos');{ do not localize }
- end;
- if ACharPos <= Length(AString) then begin
- {$IFDEF DOTNET}
- Result := ASet.IndexOf(AString[ACharPos]) + 1;
- {$ELSE}
- // RLebeau 5/8/08: Calling Pos() with a Char as input creates a temporary
- // String. Normally this is fine, but profiling reveils this to be a big
- // bottleneck for code that makes a lot of calls to CharIsInSet(), so we
- // will scan through ASet looking for the character without a conversion...
- //
- // Result := IndyPos(AString[ACharPos], ASet);
- //
- LChar := AString[ACharPos];
- for I := 1 to Length(ASet) do begin
- if ASet[I] = LChar then begin
- Result := I;
- Exit;
- end;
- end;
- {$ENDIF}
- end;
- end;
- function CharIsInSet(const AString: string; const ACharPos: Integer; const ASet: String): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := CharPosInSet(AString, ACharPos, ASet) > 0;
- end;
- function CharIsInEOL(const AString: string; const ACharPos: Integer): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := CharPosInSet(AString, ACharPos, EOL) > 0;
- end;
- function CharEquals(const AString: string; const ACharPos: Integer; const AValue: Char): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if ACharPos < 1 then begin
- raise EIdException.Create('Invalid ACharPos');{ do not localize }
- end;
- Result := ACharPos <= Length(AString);
- if Result then begin
- Result := AString[ACharPos] = AValue;
- end;
- end;
- {$IFDEF STRING_IS_IMMUTABLE}
- {$IFDEF DOTNET}
- {$DEFINE HAS_String_IndexOf}
- {$ENDIF}
- {$IFDEF HAS_SysUtils_TStringHelper}
- {$DEFINE HAS_String_IndexOf}
- {$ENDIF}
- function CharPosInSet(const ASB: TIdStringBuilder; const ACharPos: Integer; const ASet: String): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$IFNDEF HAS_String_IndexOf}
- var
- LChar: Char;
- I: Integer;
- {$ENDIF}
- begin
- Result := 0;
- if ACharPos < 1 then begin
- raise EIdException.Create('Invalid ACharPos');{ do not localize }
- end;
- if ACharPos <= ASB.Length then begin
- {$IFDEF HAS_String_IndexOf}
- Result := ASet.IndexOf(ASB[ACharPos-1]) + 1;
- {$ELSE}
- // RLebeau 5/8/08: Calling Pos() with a Char as input creates a temporary
- // String. Normally this is fine, but profiling reveils this to be a big
- // bottleneck for code that makes a lot of calls to CharIsInSet(), so we
- // will scan through ASet looking for the character without a conversion...
- //
- // Result := IndyPos(ASB[ACharPos-1], ASet);
- //
- LChar := ASB[ACharPos-1];
- for I := 1 to Length(ASet) do begin
- if ASet[I] = LChar then begin
- Result := I;
- Exit;
- end;
- end;
- {$ENDIF}
- end;
- end;
- function CharIsInSet(const ASB: TIdStringBuilder; const ACharPos: Integer; const ASet: String): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := CharPosInSet(ASB, ACharPos, ASet) > 0;
- end;
- function CharIsInEOL(const ASB: TIdStringBuilder; const ACharPos: Integer): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := CharPosInSet(ASB, ACharPos, EOL) > 0;
- end;
- function CharEquals(const ASB: TIdStringBuilder; const ACharPos: Integer; const AValue: Char): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if ACharPos < 1 then begin
- raise EIdException.Create('Invalid ACharPos');{ do not localize }
- end;
- Result := ACharPos <= ASB.Length;
- if Result then begin
- Result := ASB[ACharPos-1] = AValue;
- end;
- end;
- {$ENDIF}
- function ByteIndex(const AByte: Byte; const ABytes: TIdBytes; const AStartIndex: Integer = 0): Integer;
- var
- I: Integer;
- begin
- Result := -1;
- for I := AStartIndex to Length(ABytes)-1 do begin
- if ABytes[I] = AByte then begin
- Result := I;
- Exit;
- end;
- end;
- end;
- function ByteIdxInSet(const ABytes: TIdBytes; const AIndex: Integer; const ASet: TIdBytes): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if AIndex < 0 then begin
- raise EIdException.Create('Invalid AIndex'); {do not localize}
- end;
- if AIndex < Length(ABytes) then begin
- Result := ByteIndex(ABytes[AIndex], ASet);
- end else begin
- Result := -1;
- end;
- end;
- function ByteIsInSet(const ABytes: TIdBytes; const AIndex: Integer; const ASet: TIdBytes): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := ByteIdxInSet(ABytes, AIndex, ASet) > -1;
- end;
- function ByteIsInEOL(const ABytes: TIdBytes; const AIndex: Integer): Boolean;
- var
- LSet: TIdBytes;
- begin
- SetLength(LSet, 2);
- LSet[0] := 13;
- LSet[1] := 10;
- Result := ByteIsInSet(ABytes, AIndex, LSet);
- end;
- function ReadLnFromStream(AStream: TStream; AMaxLineLength: Integer = -1;
- AExceptionIfEOF: Boolean = False; AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): string; overload;
- begin
- if (not ReadLnFromStream(AStream, Result, AMaxLineLength, AByteEncoding
- {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
- )) and AExceptionIfEOF then
- begin
- raise EIdEndOfStream.CreateFmt(RSEndOfStream, ['ReadLnFromStream', AStream.Position]);
- end;
- end;
- //TODO: Continue to optimize this function. Its performance severely impacts the coders
- function ReadLnFromStream(AStream: TStream; var VLine: String; AMaxLineLength: Integer = -1;
- AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): Boolean; overload;
- const
- LBUFMAXSIZE = 2048;
- var
- LStringLen, LResultLen, LBufSize: Integer;
- LBuf: TIdBytes;
- LLine: TIdBytes;
- // LBuf: packed array [0..LBUFMAXSIZE] of Char;
- LStrmPos, LStrmSize: TIdStreamSize; //LBytesToRead = stream size - Position
- LCrEncountered: Boolean;
- function FindEOL(const ABuf: TIdBytes; var VLineBufSize: Integer; var VCrEncountered: Boolean): Integer;
- var
- i: Integer;
- begin
- Result := VLineBufSize; //EOL not found => use all
- i := 0;
- while i < VLineBufSize do begin
- case ABuf[i] of
- Ord(LF): begin
- Result := i; {string size}
- VCrEncountered := True;
- VLineBufSize := i+1;
- Break;
- end;
- Ord(CR): begin
- Result := i; {string size}
- VCrEncountered := True;
- Inc(i); //crLF?
- if (i < VLineBufSize) and (ABuf[i] = Ord(LF)) then begin
- VLineBufSize := i+1;
- end else begin
- VLineBufSize := i;
- end;
- Break;
- end;
- end;
- Inc(i);
- end;
- end;
- begin
- Assert(AStream<>nil);
- VLine := '';
- SetLength(LLine, 0);
- if AMaxLineLength < 0 then begin
- AMaxLineLength := MaxInt;
- end;
- { we store the stream size for the whole routine to prevent
- so do not incur a performance penalty with TStream.Size. It has
- to use something such as Seek each time the size is obtained}
- {4 seek vs 3 seek}
- LStrmPos := AStream.Position;
- LStrmSize := AStream.Size;
- if LStrmPos >= LStrmSize then begin
- Result := False;
- Exit;
- end;
- SetLength(LBuf, LBUFMAXSIZE);
- LCrEncountered := False;
- repeat
- LBufSize := ReadTIdBytesFromStream(AStream, LBuf, IndyMin(LStrmSize - LStrmPos, LBUFMAXSIZE));
- if LBufSize < 1 then begin
- Break; // TODO: throw a stream read exception instead?
- end;
- LStringLen := FindEOL(LBuf, LBufSize, LCrEncountered);
- Inc(LStrmPos, LBufSize);
- LResultLen := Length(VLine);
- if (LResultLen + LStringLen) > AMaxLineLength then begin
- LStringLen := AMaxLineLength - LResultLen;
- LCrEncountered := True;
- Dec(LStrmPos, LBufSize);
- Inc(LStrmPos, LStringLen);
- end;
- if LStringLen > 0 then begin
- LBufSize := Length(LLine);
- SetLength(LLine, LBufSize+LStringLen);
- CopyTIdBytes(LBuf, 0, LLine, LBufSize, LStringLen);
- end;
- until (LStrmPos >= LStrmSize) or LCrEncountered;
- // RLebeau: why is the original Position being restored here, instead
- // of leaving the Position at the end of the line?
- AStream.Position := LStrmPos;
- VLine := BytesToString(LLine, 0, -1, AByteEncoding
- {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
- );
- Result := True;
- end;
- {$IFDEF REGISTER_EXPECTED_MEMORY_LEAK}
- function IndyRegisterExpectedMemoryLeak(AAddress: Pointer): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // use only System.RegisterExpectedMemoryLeak() on systems that support
- // it. We should use whatever the RTL's active memory manager is. The user
- // can override the RTL's version of FastMM (2006+ only) with any memory
- // manager they want, such as MadExcept.
- //
- // Fallback to specific memory managers if System.RegisterExpectedMemoryLeak()
- // is not available.
- {$IFDEF HAS_System_RegisterExpectedMemoryLeak}
- // RLebeau 4/21/08: not quite sure what the difference is between the
- // SysRegisterExpectedMemoryLeak() and RegisterExpectedMemoryLeak()
- // functions in the System unit, but calling RegisterExpectedMemoryLeak()
- // is causing stack overflows when FastMM is not active, so call
- // SysRegisterExpectedMemoryLeak() instead...
- // RLebeau 7/4/09: According to Pierre Le Riche, developer of FastMM:
- //
- // "SysRegisterExpectedMemoryLeak() is the leak registration routine for
- // the built-in memory manager. FastMM.RegisterExpectedMemoryLeak is the
- // leak registration code for FastMM. Both of these are thus hardwired to
- // a specific memory manager. In order to register a leak for the
- // *currently installed* memory manager, which is what you typically want
- // to do, you have to call System.RegisterExpectedMemoryLeak().
- // System.RegisterExpectedMemoryLeak() redirects to the leak registration
- // code of the installed memory manager."
- {$I IdSymbolPlatformOff.inc}
- //Result := System.SysRegisterExpectedMemoryLeak(AAddress);
- Result := System.RegisterExpectedMemoryLeak(AAddress);
- {$I IdSymbolPlatformOn.inc}
- {$ELSE}
- // RLebeau 10/5/2014: the user can override the RTL's version of FastMM
- // (2006+ only) with any memory manager, such as MadExcept, so check for
- // that...
- {$IFDEF USE_FASTMM4}
- Result := FastMM4.RegisterExpectedMemoryLeak(AAddress);
- {$ELSE}
- {$IFDEF USE_MADEXCEPT}
- Result := madExcept.HideLeak(AAddress);
- {$ELSE}
- {$IFDEF USE_LEAKCHECK}
- Result := LeakCheck.RegisterExpectedMemoryLeak(AAddress);
- {$ELSE}
- Result := False;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- end;
- {$ENDIF}
- function IndyAddPair(AStrings: TStrings; const AName, AValue: String): TStrings;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF HAS_TStrings_AddPair}
- Result := AStrings.AddPair(AName, AValue);
- {$ELSE}
- {$IFDEF HAS_TStrings_NameValueSeparator}
- AStrings.Add(AName + AStrings.NameValueSeparator + AValue);
- {$ELSE}
- AStrings.Add(AName + '=' + AValue); {do not localize}
- {$ENDIF}
- Result := AStrings;
- {$ENDIF}
- end;
- function IndyAddPair(AStrings: TStrings; const AName, AValue: String; AObject: TObject): TStrings;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF HAS_TStrings_AddPair}
- Result := AStrings.AddPair(AName, AValue, AObject);
- {$ELSE}
- {$IFDEF HAS_TStrings_NameValueSeparator}
- AStrings.AddObject(AName + AStrings.NameValueSeparator + AValue, AObject);
- {$ELSE}
- AStrings.AddObject(AName + '=' + AValue, AObject);
- {$ENDIF}
- Result := AStrings;
- {$ENDIF}
- end;
- function InternalIndyIndexOf(AStrings: TStrings; const AStr: string;
- const ACaseSensitive: Boolean = False): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- I: Integer;
- begin
- Result := -1;
- for I := 0 to AStrings.Count - 1 do begin
- if ACaseSensitive then begin
- if AStrings[I] = AStr then begin
- Result := I;
- Exit;
- end;
- end else begin
- if TextIsSame(AStrings[I], AStr) then begin
- Result := I;
- Exit;
- end;
- end;
- end;
- end;
- function IndyIndexOf(AStrings: TStrings; const AStr: string;
- const ACaseSensitive: Boolean = False): Integer;
- begin
- {$IFDEF HAS_TStringList_CaseSensitive}
- if AStrings is TStringList then begin
- Result := IndyIndexOf(TStringList(AStrings), AStr, ACaseSensitive);
- Exit;
- end;
- {$ENDIF}
- Result := InternalIndyIndexOf(AStrings, AStr, ACaseSensitive);
- end;
- {$IFDEF HAS_TStringList_CaseSensitive}
- function IndyIndexOf(AStrings: TStringList; const AStr: string;
- const ACaseSensitive: Boolean = False): Integer;
- begin
- if AStrings.CaseSensitive = ACaseSensitive then begin
- Result := AStrings.IndexOf(AStr);
- end else begin
- Result := InternalIndyIndexOf(AStrings, AStr, ACaseSensitive);
- end;
- end;
- {$ENDIF}
- function InternalIndyIndexOfName(AStrings: TStrings; const AName: string;
- const ACaseSensitive: Boolean = False): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- I: Integer;
- begin
- Result := -1;
- for I := 0 to AStrings.Count - 1 do begin
- if ACaseSensitive then begin
- if AStrings.Names[I] = AName then begin
- Result := I;
- Exit;
- end;
- end
- else if TextIsSame(AStrings.Names[I], AName) then begin
- Result := I;
- Exit;
- end;
- end;
- end;
- function IndyIndexOfName(AStrings: TStrings; const AName: string;
- const ACaseSensitive: Boolean = False): Integer;
- begin
- {$IFDEF HAS_TStringList_CaseSensitive}
- if AStrings is TStringList then begin
- Result := IndyIndexOfName(TStringList(AStrings), AName, ACaseSensitive);
- Exit;
- end;
- {$ENDIF}
- Result := InternalIndyIndexOfName(AStrings, AName, ACaseSensitive);
- end;
- {$IFDEF HAS_TStringList_CaseSensitive}
- function IndyIndexOfName(AStrings: TStringList; const AName: string;
- const ACaseSensitive: Boolean = False): Integer;
- begin
- if AStrings.CaseSensitive = ACaseSensitive then begin
- Result := AStrings.IndexOfName(AName);
- end else begin
- Result := InternalIndyIndexOfName(AStrings, AName, ACaseSensitive);
- end;
- end;
- {$ENDIF}
- function IndyValueFromIndex(AStrings: TStrings; const AIndex: Integer): String;
- {$IFNDEF HAS_TStrings_ValueFromIndex}
- var
- LTmp: string;
- LPos: Integer;
- {$IFDEF HAS_TStrings_NameValueSeparator}
- LChar: Char;
- {$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF HAS_TStrings_ValueFromIndex}
- Result := AStrings.ValueFromIndex[AIndex];
- {$ELSE}
- Result := '';
- if AIndex >= 0 then
- begin
- LTmp := AStrings.Strings[AIndex];
- {$IFDEF HAS_TStrings_NameValueSeparator}
- // RLebeau 11/8/16: Calling Pos() with a Char as input creates a temporary
- // String. Normally this is fine, but profiling reveils this to be a big
- // bottleneck for code that makes a lot of calls to Pos() in a loop, so we
- // will scan through the string looking for the character without a conversion...
- //
- // LPos := Pos(AStrings.NameValueSeparator, LTmp); {do not localize}
- // if LPos > 0 then begin
- //
- LChar := AStrings.NameValueSeparator;
- for LPos := 1 to Length(LTmp) do begin
- //if CharEquals(LTmp, LPos, LChar) then begin
- if LTmp[LPos] = LChar then begin
- Result := Copy(LTmp, LPos+1, MaxInt);
- Exit;
- end;
- end;
- {$ELSE}
- LPos := Pos('=', LTmp); {do not localize}
- if LPos > 0 then begin
- Result := Copy(LTmp, LPos+1, MaxInt);
- end;
- {$ENDIF}
- end;
- {$ENDIF}
- end;
- {$IFDEF WINDOWS}
- function IndyWindowsMajorVersion: Integer;
- begin
- {$IFDEF WINCE}
- Result := SysUtils.WinCEMajorVersion;
- {$ELSE}
- Result := SysUtils.Win32MajorVersion;
- {$ENDIF}
- end;
- function IndyWindowsMinorVersion: Integer;
- begin
- {$IFDEF WINCE}
- Result := SysUtils.WinCEMinorVersion;
- {$ELSE}
- Result := SysUtils.Win32MinorVersion;
- {$ENDIF}
- end;
- function IndyWindowsBuildNumber: Integer;
- begin
- // for this, you need to strip off some junk to do comparisons
- {$IFDEF WINCE}
- Result := SysUtils.WinCEBuildNumber and $FFFF;
- {$ELSE}
- Result := SysUtils.Win32BuildNumber and $FFFF;
- {$ENDIF}
- end;
- function IndyWindowsPlatform: Integer;
- begin
- {$IFDEF WINCE}
- Result := SysUtils.WinCEPlatform;
- {$ELSE}
- Result := SysUtils.Win32Platform;
- {$ENDIF}
- end;
- function IndyCheckWindowsVersion(const AMajor: Integer; const AMinor: Integer = 0): Boolean;
- var
- LMajor, LMinor: Integer;
- begin
- LMajor := IndyWindowsMajorVersion;
- LMinor := IndyWindowsMinorVersion;
- Result := (LMajor > AMajor) or ((LMajor = AMajor) and (LMinor >= AMinor));
- end;
- {$ENDIF}
- // Embarcadero changed the signature of FreeAndNil() in 10.4 Denali...
- {$UNDEF HAS_FreeAndNil_TObject_Param}
- {$IFNDEF USE_OBJECT_ARC}
- {$IFDEF DCC}
- {$IFDEF VCL_10_4_OR_ABOVE}
- {$DEFINE HAS_FreeAndNil_TObject_Param}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- procedure IdDisposeAndNil(var Obj);
- {$IFDEF USE_OBJECT_ARC}
- var
- Temp: {Pointer}TObject;
- {$ENDIF}
- begin
- {$IFDEF USE_OBJECT_ARC}
- // RLebeau: was originally calling DisposeOf() on Obj directly, but nil'ing
- // Obj first prevented the calling code from invoking __ObjRelease() on Obj.
- // Don't do that in ARC. __ObjRelease() needs to be called, even if disposed,
- // to allow the compiler/RTL to finalize Obj so any managed members it has
- // can be cleaned up properly...
- {
- Temp := Pointer(Obj);
- Pointer(Obj) := nil;
- TObject(Temp).DisposeOf;
- }
- Pointer(Temp) := Pointer(Obj);
- Pointer(Obj) := nil;
- Temp.DisposeOf;
- // __ObjRelease() is called when Temp goes out of scope
- {$ELSE}
- FreeAndNil({$IFDEF HAS_FreeAndNil_TObject_Param}TObject(Obj){$ELSE}Obj{$ENDIF});
- {$ENDIF}
- end;
- initialization
- // AnsiPos does not handle strings with #0 and is also very slow compared to Pos
- {$IFDEF DOTNET}
- IndyPos := SBPos;
- {$ELSE}
- if LeadBytes = [] then begin
- IndyPos := SBPos;
- end else begin
- IndyPos := InternalAnsiPos;
- end;
- {$ENDIF}
- {$IFDEF DYNAMICLOAD_InterlockedCompareExchange}
- InterlockedCompareExchange := Stub_InterlockedCompareExchange;
- {$ENDIF}
- {$IFDEF WINDOWS}
- GetTickCount64 := Stub_GetTickCount64;
- {$ENDIF}
- {$IFDEF UNIX}
- {$IFDEF OSX}
- mach_timebase_info(GMachTimeBaseInfo);
- {$ENDIF}
- {$ENDIF}
- {$IFNDEF DOTNET}
- finalization
- FreeAndNil(GIdPorts);
- {$ENDIF}
- end.
|