IdGlobal.pas 315 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415441644174418441944204421442244234424442544264427442844294430443144324433443444354436443744384439444044414442444344444445444644474448444944504451445244534454445544564457445844594460446144624463446444654466446744684469447044714472447344744475447644774478447944804481448244834484448544864487448844894490449144924493449444954496449744984499450045014502450345044505450645074508450945104511451245134514451545164517451845194520452145224523452445254526452745284529453045314532453345344535453645374538453945404541454245434544454545464547454845494550455145524553455445554556455745584559456045614562456345644565456645674568456945704571457245734574457545764577457845794580458145824583458445854586458745884589459045914592459345944595459645974598459946004601460246034604460546064607460846094610461146124613461446154616461746184619462046214622462346244625462646274628462946304631463246334634463546364637463846394640464146424643464446454646464746484649465046514652465346544655465646574658465946604661466246634664466546664667466846694670467146724673467446754676467746784679468046814682468346844685468646874688468946904691469246934694469546964697469846994700470147024703470447054706470747084709471047114712471347144715471647174718471947204721472247234724472547264727472847294730473147324733473447354736473747384739474047414742474347444745474647474748474947504751475247534754475547564757475847594760476147624763476447654766476747684769477047714772477347744775477647774778477947804781478247834784478547864787478847894790479147924793479447954796479747984799480048014802480348044805480648074808480948104811481248134814481548164817481848194820482148224823482448254826482748284829483048314832483348344835483648374838483948404841484248434844484548464847484848494850485148524853485448554856485748584859486048614862486348644865486648674868486948704871487248734874487548764877487848794880488148824883488448854886488748884889489048914892489348944895489648974898489949004901490249034904490549064907490849094910491149124913491449154916491749184919492049214922492349244925492649274928492949304931493249334934493549364937493849394940494149424943494449454946494749484949495049514952495349544955495649574958495949604961496249634964496549664967496849694970497149724973497449754976497749784979498049814982498349844985498649874988498949904991499249934994499549964997499849995000500150025003500450055006500750085009501050115012501350145015501650175018501950205021502250235024502550265027502850295030503150325033503450355036503750385039504050415042504350445045504650475048504950505051505250535054505550565057505850595060506150625063506450655066506750685069507050715072507350745075507650775078507950805081508250835084508550865087508850895090509150925093509450955096509750985099510051015102510351045105510651075108510951105111511251135114511551165117511851195120512151225123512451255126512751285129513051315132513351345135513651375138513951405141514251435144514551465147514851495150515151525153515451555156515751585159516051615162516351645165516651675168516951705171517251735174517551765177517851795180518151825183518451855186518751885189519051915192519351945195519651975198519952005201520252035204520552065207520852095210521152125213521452155216521752185219522052215222522352245225522652275228522952305231523252335234523552365237523852395240524152425243524452455246524752485249525052515252525352545255525652575258525952605261526252635264526552665267526852695270527152725273527452755276527752785279528052815282528352845285528652875288528952905291529252935294529552965297529852995300530153025303530453055306530753085309531053115312531353145315531653175318531953205321532253235324532553265327532853295330533153325333533453355336533753385339534053415342534353445345534653475348534953505351535253535354535553565357535853595360536153625363536453655366536753685369537053715372537353745375537653775378537953805381538253835384538553865387538853895390539153925393539453955396539753985399540054015402540354045405540654075408540954105411541254135414541554165417541854195420542154225423542454255426542754285429543054315432543354345435543654375438543954405441544254435444544554465447544854495450545154525453545454555456545754585459546054615462546354645465546654675468546954705471547254735474547554765477547854795480548154825483548454855486548754885489549054915492549354945495549654975498549955005501550255035504550555065507550855095510551155125513551455155516551755185519552055215522552355245525552655275528552955305531553255335534553555365537553855395540554155425543554455455546554755485549555055515552555355545555555655575558555955605561556255635564556555665567556855695570557155725573557455755576557755785579558055815582558355845585558655875588558955905591559255935594559555965597559855995600560156025603560456055606560756085609561056115612561356145615561656175618561956205621562256235624562556265627562856295630563156325633563456355636563756385639564056415642564356445645564656475648564956505651565256535654565556565657565856595660566156625663566456655666566756685669567056715672567356745675567656775678567956805681568256835684568556865687568856895690569156925693569456955696569756985699570057015702570357045705570657075708570957105711571257135714571557165717571857195720572157225723572457255726572757285729573057315732573357345735573657375738573957405741574257435744574557465747574857495750575157525753575457555756575757585759576057615762576357645765576657675768576957705771577257735774577557765777577857795780578157825783578457855786578757885789579057915792579357945795579657975798579958005801580258035804580558065807580858095810581158125813581458155816581758185819582058215822582358245825582658275828582958305831583258335834583558365837583858395840584158425843584458455846584758485849585058515852585358545855585658575858585958605861586258635864586558665867586858695870587158725873587458755876587758785879588058815882588358845885588658875888588958905891589258935894589558965897589858995900590159025903590459055906590759085909591059115912591359145915591659175918591959205921592259235924592559265927592859295930593159325933593459355936593759385939594059415942594359445945594659475948594959505951595259535954595559565957595859595960596159625963596459655966596759685969597059715972597359745975597659775978597959805981598259835984598559865987598859895990599159925993599459955996599759985999600060016002600360046005600660076008600960106011601260136014601560166017601860196020602160226023602460256026602760286029603060316032603360346035603660376038603960406041604260436044604560466047604860496050605160526053605460556056605760586059606060616062606360646065606660676068606960706071607260736074607560766077607860796080608160826083608460856086608760886089609060916092609360946095609660976098609961006101610261036104610561066107610861096110611161126113611461156116611761186119612061216122612361246125612661276128612961306131613261336134613561366137613861396140614161426143614461456146614761486149615061516152615361546155615661576158615961606161616261636164616561666167616861696170617161726173617461756176617761786179618061816182618361846185618661876188618961906191619261936194619561966197619861996200620162026203620462056206620762086209621062116212621362146215621662176218621962206221622262236224622562266227622862296230623162326233623462356236623762386239624062416242624362446245624662476248624962506251625262536254625562566257625862596260626162626263626462656266626762686269627062716272627362746275627662776278627962806281628262836284628562866287628862896290629162926293629462956296629762986299630063016302630363046305630663076308630963106311631263136314631563166317631863196320632163226323632463256326632763286329633063316332633363346335633663376338633963406341634263436344634563466347634863496350635163526353635463556356635763586359636063616362636363646365636663676368636963706371637263736374637563766377637863796380638163826383638463856386638763886389639063916392639363946395639663976398639964006401640264036404640564066407640864096410641164126413641464156416641764186419642064216422642364246425642664276428642964306431643264336434643564366437643864396440644164426443644464456446644764486449645064516452645364546455645664576458645964606461646264636464646564666467646864696470647164726473647464756476647764786479648064816482648364846485648664876488648964906491649264936494649564966497649864996500650165026503650465056506650765086509651065116512651365146515651665176518651965206521652265236524652565266527652865296530653165326533653465356536653765386539654065416542654365446545654665476548654965506551655265536554655565566557655865596560656165626563656465656566656765686569657065716572657365746575657665776578657965806581658265836584658565866587658865896590659165926593659465956596659765986599660066016602660366046605660666076608660966106611661266136614661566166617661866196620662166226623662466256626662766286629663066316632663366346635663666376638663966406641664266436644664566466647664866496650665166526653665466556656665766586659666066616662666366646665666666676668666966706671667266736674667566766677667866796680668166826683668466856686668766886689669066916692669366946695669666976698669967006701670267036704670567066707670867096710671167126713671467156716671767186719672067216722672367246725672667276728672967306731673267336734673567366737673867396740674167426743674467456746674767486749675067516752675367546755675667576758675967606761676267636764676567666767676867696770677167726773677467756776677767786779678067816782678367846785678667876788678967906791679267936794679567966797679867996800680168026803680468056806680768086809681068116812681368146815681668176818681968206821682268236824682568266827682868296830683168326833683468356836683768386839684068416842684368446845684668476848684968506851685268536854685568566857685868596860686168626863686468656866686768686869687068716872687368746875687668776878687968806881688268836884688568866887688868896890689168926893689468956896689768986899690069016902690369046905690669076908690969106911691269136914691569166917691869196920692169226923692469256926692769286929693069316932693369346935693669376938693969406941694269436944694569466947694869496950695169526953695469556956695769586959696069616962696369646965696669676968696969706971697269736974697569766977697869796980698169826983698469856986698769886989699069916992699369946995699669976998699970007001700270037004700570067007700870097010701170127013701470157016701770187019702070217022702370247025702670277028702970307031703270337034703570367037703870397040704170427043704470457046704770487049705070517052705370547055705670577058705970607061706270637064706570667067706870697070707170727073707470757076707770787079708070817082708370847085708670877088708970907091709270937094709570967097709870997100710171027103710471057106710771087109711071117112711371147115711671177118711971207121712271237124712571267127712871297130713171327133713471357136713771387139714071417142714371447145714671477148714971507151715271537154715571567157715871597160716171627163716471657166716771687169717071717172717371747175717671777178717971807181718271837184718571867187718871897190719171927193719471957196719771987199720072017202720372047205720672077208720972107211721272137214721572167217721872197220722172227223722472257226722772287229723072317232723372347235723672377238723972407241724272437244724572467247724872497250725172527253725472557256725772587259726072617262726372647265726672677268726972707271727272737274727572767277727872797280728172827283728472857286728772887289729072917292729372947295729672977298729973007301730273037304730573067307730873097310731173127313731473157316731773187319732073217322732373247325732673277328732973307331733273337334733573367337733873397340734173427343734473457346734773487349735073517352735373547355735673577358735973607361736273637364736573667367736873697370737173727373737473757376737773787379738073817382738373847385738673877388738973907391739273937394739573967397739873997400740174027403740474057406740774087409741074117412741374147415741674177418741974207421742274237424742574267427742874297430743174327433743474357436743774387439744074417442744374447445744674477448744974507451745274537454745574567457745874597460746174627463746474657466746774687469747074717472747374747475747674777478747974807481748274837484748574867487748874897490749174927493749474957496749774987499750075017502750375047505750675077508750975107511751275137514751575167517751875197520752175227523752475257526752775287529753075317532753375347535753675377538753975407541754275437544754575467547754875497550755175527553755475557556755775587559756075617562756375647565756675677568756975707571757275737574757575767577757875797580758175827583758475857586758775887589759075917592759375947595759675977598759976007601760276037604760576067607760876097610761176127613761476157616761776187619762076217622762376247625762676277628762976307631763276337634763576367637763876397640764176427643764476457646764776487649765076517652765376547655765676577658765976607661766276637664766576667667766876697670767176727673767476757676767776787679768076817682768376847685768676877688768976907691769276937694769576967697769876997700770177027703770477057706770777087709771077117712771377147715771677177718771977207721772277237724772577267727772877297730773177327733773477357736773777387739774077417742774377447745774677477748774977507751775277537754775577567757775877597760776177627763776477657766776777687769777077717772777377747775777677777778777977807781778277837784778577867787778877897790779177927793779477957796779777987799780078017802780378047805780678077808780978107811781278137814781578167817781878197820782178227823782478257826782778287829783078317832783378347835783678377838783978407841784278437844784578467847784878497850785178527853785478557856785778587859786078617862786378647865786678677868786978707871787278737874787578767877787878797880788178827883788478857886788778887889789078917892789378947895789678977898789979007901790279037904790579067907790879097910791179127913791479157916791779187919792079217922792379247925792679277928792979307931793279337934793579367937793879397940794179427943794479457946794779487949795079517952795379547955795679577958795979607961796279637964796579667967796879697970797179727973797479757976797779787979798079817982798379847985798679877988798979907991799279937994799579967997799879998000800180028003800480058006800780088009801080118012801380148015801680178018801980208021802280238024802580268027802880298030803180328033803480358036803780388039804080418042804380448045804680478048804980508051805280538054805580568057805880598060806180628063806480658066806780688069807080718072807380748075807680778078807980808081808280838084808580868087808880898090809180928093809480958096809780988099810081018102810381048105810681078108810981108111811281138114811581168117811881198120812181228123812481258126812781288129813081318132813381348135813681378138813981408141814281438144814581468147814881498150815181528153815481558156815781588159816081618162816381648165816681678168816981708171817281738174817581768177817881798180818181828183818481858186818781888189819081918192819381948195819681978198819982008201820282038204820582068207820882098210821182128213821482158216821782188219822082218222822382248225822682278228822982308231823282338234823582368237823882398240824182428243824482458246824782488249825082518252825382548255825682578258825982608261826282638264826582668267826882698270827182728273827482758276827782788279828082818282828382848285828682878288828982908291829282938294829582968297829882998300830183028303830483058306830783088309831083118312831383148315831683178318831983208321832283238324832583268327832883298330833183328333833483358336833783388339834083418342834383448345834683478348834983508351835283538354835583568357835883598360836183628363836483658366836783688369837083718372837383748375837683778378837983808381838283838384838583868387838883898390839183928393839483958396839783988399840084018402840384048405840684078408840984108411841284138414841584168417841884198420842184228423842484258426842784288429843084318432843384348435843684378438843984408441844284438444844584468447844884498450845184528453845484558456845784588459846084618462846384648465846684678468846984708471847284738474847584768477847884798480848184828483848484858486848784888489849084918492849384948495849684978498849985008501850285038504850585068507850885098510851185128513851485158516851785188519852085218522852385248525852685278528852985308531853285338534853585368537853885398540854185428543854485458546854785488549855085518552855385548555855685578558855985608561856285638564856585668567856885698570857185728573857485758576857785788579858085818582858385848585858685878588858985908591859285938594859585968597859885998600860186028603860486058606860786088609861086118612861386148615861686178618861986208621862286238624862586268627862886298630863186328633863486358636863786388639864086418642864386448645864686478648864986508651865286538654865586568657865886598660866186628663866486658666866786688669867086718672867386748675867686778678867986808681868286838684868586868687868886898690869186928693869486958696869786988699870087018702870387048705870687078708870987108711871287138714871587168717871887198720872187228723872487258726872787288729873087318732873387348735873687378738873987408741874287438744874587468747874887498750875187528753875487558756875787588759876087618762876387648765876687678768876987708771877287738774877587768777877887798780878187828783878487858786878787888789879087918792879387948795879687978798879988008801880288038804880588068807880888098810881188128813881488158816881788188819882088218822882388248825882688278828882988308831883288338834883588368837883888398840884188428843884488458846884788488849885088518852885388548855885688578858885988608861886288638864886588668867886888698870887188728873887488758876887788788879888088818882888388848885888688878888888988908891889288938894889588968897889888998900890189028903890489058906890789088909891089118912891389148915891689178918891989208921892289238924892589268927892889298930893189328933893489358936893789388939894089418942894389448945894689478948894989508951895289538954895589568957895889598960896189628963896489658966896789688969897089718972897389748975897689778978897989808981898289838984898589868987898889898990899189928993899489958996899789988999900090019002900390049005900690079008900990109011901290139014901590169017901890199020902190229023902490259026902790289029903090319032903390349035903690379038903990409041904290439044904590469047904890499050905190529053905490559056905790589059906090619062906390649065906690679068906990709071907290739074907590769077907890799080908190829083908490859086908790889089909090919092909390949095909690979098909991009101910291039104910591069107910891099110911191129113911491159116911791189119912091219122912391249125912691279128912991309131913291339134913591369137913891399140914191429143914491459146914791489149915091519152915391549155915691579158915991609161916291639164916591669167916891699170917191729173917491759176917791789179918091819182918391849185918691879188918991909191919291939194919591969197919891999200920192029203920492059206920792089209921092119212921392149215921692179218921992209221922292239224922592269227922892299230923192329233923492359236923792389239924092419242924392449245924692479248924992509251925292539254925592569257925892599260926192629263926492659266926792689269927092719272927392749275927692779278927992809281928292839284928592869287928892899290929192929293929492959296929792989299930093019302930393049305930693079308930993109311931293139314931593169317931893199320932193229323932493259326932793289329933093319332933393349335933693379338933993409341934293439344934593469347934893499350935193529353935493559356935793589359936093619362936393649365936693679368936993709371937293739374937593769377937893799380938193829383938493859386938793889389939093919392939393949395939693979398939994009401940294039404940594069407940894099410941194129413941494159416941794189419942094219422942394249425942694279428942994309431943294339434943594369437943894399440944194429443944494459446944794489449945094519452945394549455945694579458945994609461946294639464946594669467946894699470947194729473947494759476947794789479948094819482948394849485948694879488948994909491949294939494949594969497949894999500950195029503950495059506950795089509951095119512951395149515951695179518951995209521952295239524952595269527952895299530953195329533953495359536953795389539954095419542954395449545954695479548954995509551955295539554955595569557955895599560956195629563956495659566956795689569957095719572957395749575957695779578957995809581958295839584958595869587958895899590959195929593959495959596959795989599960096019602960396049605960696079608960996109611961296139614961596169617961896199620962196229623962496259626962796289629963096319632963396349635963696379638963996409641964296439644964596469647964896499650965196529653965496559656965796589659966096619662966396649665966696679668966996709671967296739674967596769677967896799680968196829683968496859686968796889689969096919692969396949695969696979698969997009701970297039704970597069707970897099710971197129713971497159716971797189719972097219722972397249725972697279728972997309731973297339734973597369737973897399740974197429743974497459746974797489749975097519752975397549755975697579758975997609761976297639764976597669767976897699770977197729773977497759776977797789779978097819782978397849785978697879788978997909791979297939794979597969797979897999800980198029803980498059806980798089809981098119812981398149815981698179818981998209821
  1. {
  2. $Project$
  3. $Workfile$
  4. $Revision$
  5. $DateUTC$
  6. $Id$
  7. This file is part of the Indy (Internet Direct) project, and is offered
  8. under the dual-licensing agreement described on the Indy website.
  9. (http://www.indyproject.org/)
  10. Copyright:
  11. (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
  12. }
  13. {
  14. $Log$
  15. }
  16. {
  17. Rev 1.54 2/9/2005 8:45:38 PM JPMugaas
  18. Should work.
  19. Rev 1.53 2/8/05 6:37:38 PM RLebeau
  20. Added default value to ASize parameter of ReadStringFromStream()
  21. Rev 1.52 2/8/05 5:57:10 PM RLebeau
  22. added AppendString(), CopyTIdLongWord(), and CopyTIdString() functions
  23. Rev 1.51 1/31/05 6:01:40 PM RLebeau
  24. Renamed GetCurrentThreadHandle() to CurrentThreadId() and changed the return
  25. type from THandle to to TIdPID.
  26. Reworked conditionals for SetThreadName() and updated the implementation to
  27. support naming threads under DotNet.
  28. Rev 1.50 1/27/05 3:40:04 PM RLebeau
  29. Updated BytesToShort() to actually use the AIndex parameter that was added
  30. earlier.
  31. Rev 1.49 1/24/2005 7:35:36 PM JPMugaas
  32. Foxed ma,e om CopyTIdIPV6Address/
  33. Rev 1.48 1/17/2005 7:26:44 PM JPMugaas
  34. Made an IPv6 address byte copy function.
  35. Rev 1.47 1/15/2005 6:01:38 PM JPMugaas
  36. Removed some new procedures for extracting int values from a TIdBytes and
  37. made some other procedures have an optional index paramter.
  38. Rev 1.46 1/13/05 11:11:20 AM RLebeau
  39. Changed BytesToRaw() to pass TIdBytes by 'const' rather than by 'var'
  40. Rev 1.45 1/8/2005 3:56:58 PM JPMugaas
  41. Added routiens for copying integer values to and from TIdBytes. These are
  42. useful for some protocols.
  43. Rev 1.44 24/11/2004 16:26:24 ANeillans
  44. GetTickCount corrected, as per Paul Cooper's post in
  45. atozedsoftware.indy.general.
  46. Rev 1.43 11/13/04 10:47:28 PM RLebeau
  47. Fixed compiler errors
  48. Rev 1.42 11/12/04 1:02:42 PM RLebeau
  49. Added RawToBytesF() and BytesToRaw() functions
  50. Added asserts to BytesTo...() functions
  51. Rev 1.41 10/26/2004 8:20:02 PM JPMugaas
  52. Fixed some oversights with conversion. OOPS!!!
  53. Rev 1.40 10/26/2004 8:00:54 PM JPMugaas
  54. Now uses TIdStrings for DotNET portability.
  55. Rev 1.39 2004.10.26 7:35:16 PM czhower
  56. Moved IndyCat to CType in IdBaseComponent
  57. Rev 1.38 24/10/2004 21:29:52 ANeillans
  58. Corrected error in GetTickCount,
  59. was Result := Trunc(nTime / (Freq * 1000))
  60. should be Result := Trunc((nTime / Freq) * 1000)
  61. Rev 1.37 20/10/2004 01:08:20 CCostelloe
  62. Bug fix
  63. Rev 1.36 28.09.2004 20:36:58 Andreas Hausladen
  64. Works now with Delphi 5
  65. Rev 1.35 9/23/2004 11:36:04 PM DSiders
  66. Modified Ticks function (Win32) to correct RangeOverflow error. (Reported by
  67. Mike Potter)
  68. Rev 1.34 24.09.2004 02:16:04 Andreas Hausladen
  69. Added ReadTIdBytesFromStream and ReadCharFromStream function to supress .NET
  70. warnings.
  71. Rev 1.33 9/5/2004 2:55:00 AM JPMugaas
  72. function BytesToWord(const AValue: TIdBytes): Word; was not listed in the
  73. interface.
  74. Rev 1.32 04.09.2004 17:12:56 Andreas Hausladen
  75. New PosIdx function (without pointers)
  76. Rev 1.31 27.08.2004 22:02:20 Andreas Hausladen
  77. Speed optimization ("const" for string parameters)
  78. rewritten PosIdx function with AStartPos = 0 handling
  79. new ToArrayF() functions (faster in native code because the TIdBytes array
  80. must have the required len before the ToArrayF function is called)
  81. Rev 1.30 24.08.2004 19:48:28 Andreas Hausladen
  82. Some optimizations
  83. Removed IFDEF for IdDelete and IdInsert
  84. Rev 1.29 8/17/2004 2:54:08 PM JPMugaas
  85. Fix compiler warning about widening operends. Int64 can sometimes incur a
  86. performance penalty.
  87. Rev 1.28 8/15/04 5:57:06 PM RLebeau
  88. Tweaks to PosIdx()
  89. Rev 1.27 7/23/04 10:13:16 PM RLebeau
  90. Updated ReadStringFromStream() to resize the result using the actual number
  91. of bytes read from the stream
  92. Rev 1.26 7/18/2004 2:45:38 PM DSiders
  93. Added localization comments.
  94. Rev 1.25 7/9/04 4:25:20 PM RLebeau
  95. Renamed ToBytes(raw) to RawToBytes() to fix an ambiquity error with
  96. ToBytes(TIdBytes)
  97. Rev 1.24 7/9/04 4:07:06 PM RLebeau
  98. Compiler fix for TIdBaseStream.Write()
  99. Rev 1.23 09/07/2004 22:17:52 ANeillans
  100. Fixed IdGlobal.pas(761) Error: ';', ')' or '=' expected but ':=' found
  101. Rev 1.22 7/8/04 11:56:10 PM RLebeau
  102. Added additional parameters to BytesToString()
  103. Bug fix for ReadStringFromStream()
  104. Updated TIdBaseStream.Write() to use ToBytes()
  105. Rev 1.21 7/8/04 4:22:36 PM RLebeau
  106. Added ToBytes() overload for raw pointers under non-DotNet platfoms.
  107. Rev 1.20 2004.07.03 19:39:38 czhower
  108. UTF8
  109. Rev 1.19 6/15/2004 7:18:06 PM JPMugaas
  110. IdInsert for stuff needing to call the Insert procedure.
  111. Rev 1.18 2004.06.13 8:06:46 PM czhower
  112. .NET update
  113. Rev 1.17 6/11/2004 8:28:30 AM DSiders
  114. Added "Do not Localize" comments.
  115. Rev 1.16 2004.06.08 7:11:14 PM czhower
  116. Typo fix.
  117. Rev 1.15 2004.06.08 6:34:48 PM czhower
  118. .NET bug with Ticks workaround.
  119. Rev 1.14 07/06/2004 21:30:32 CCostelloe
  120. Kylix 3 changes
  121. Rev 1.13 5/3/04 12:17:44 PM RLebeau
  122. Updated ToBytes(string) and BytesToString() under DotNet to use
  123. System.Text.Encoding.ASCII instead of AnsiEncoding
  124. Rev 1.12 4/24/04 12:41:36 PM RLebeau
  125. Conversion support to/from TIdBytes for Char values
  126. Rev 1.11 4/18/04 2:45:14 PM RLebeau
  127. Conversion support to/from TIdBytes for Int64 values
  128. Rev 1.10 2004.04.08 4:50:06 PM czhower
  129. Comments
  130. Rev 1.9 2004.04.08 1:45:42 AM czhower
  131. tiny string optimization
  132. Rev 1.8 4/7/2004 3:20:50 PM JPMugaas
  133. PosIdx was not working in DotNET. In DotNET, it was returning a Pos value
  134. without adding the startvalue -1. It was throwing off the FTP list parsers.
  135. Two uneeded IFDEF's were removed.
  136. Rev 1.7 2004.03.13 5:51:28 PM czhower
  137. Fixed stack overflow in Sleep for .net
  138. Rev 1.6 3/6/2004 5:16:02 PM JPMugaas
  139. Bug 67 fixes. Do not write to const values.
  140. Rev 1.5 3/6/2004 4:54:12 PM JPMugaas
  141. Write to const bug fix.
  142. Rev 1.4 2/17/2004 12:02:44 AM JPMugaas
  143. A few routines that might be needed later for RFC 3490 support.
  144. Rev 1.3 2/16/2004 1:56:04 PM JPMugaas
  145. Moved some routines here to lay the groundwork for RFC 3490 support. Started
  146. work on RFC 3490 support.
  147. Rev 1.2 2/11/2004 5:12:30 AM JPMugaas
  148. Moved IPv6 address definition here.
  149. I also made a function for converting a TIdBytes to an IPv6 address.
  150. Rev 1.1 2004.02.03 3:15:52 PM czhower
  151. Updates to move to System.
  152. Rev 1.0 2004.02.03 2:28:30 PM czhower
  153. Move
  154. Rev 1.91 2/1/2004 11:16:04 PM BGooijen
  155. ToBytes
  156. Rev 1.90 2/1/2004 1:28:46 AM JPMugaas
  157. Disabled IdPort functionality in DotNET. It can't work there in it's current
  158. form and trying to get it to work will introduce more problems than it
  159. solves. It was only used by the bindings editor and we did something
  160. different in DotNET so IdPorts wouldn't used there.
  161. Rev 1.89 2004.01.31 1:51:10 AM czhower
  162. IndyCast for VB.
  163. Rev 1.88 30/1/2004 4:47:46 PM SGrobety
  164. Added "WriteMemoryStreamToStream" to take care of Win32/dotnet difference in
  165. the TMemoryStream.Memory type and the Write buffer parameter
  166. Rev 1.87 1/30/2004 11:59:24 AM BGooijen
  167. Added WriteTIdBytesToStream, because we can convert almost everything to
  168. TIdBytes, and TIdBytes couldn't be written to streams easily
  169. Rev 1.86 2004.01.27 11:44:36 PM czhower
  170. .Net Updates
  171. Rev 1.85 2004.01.27 8:15:54 PM czhower
  172. Fixed compile error + .net helper.
  173. Rev 1.84 27/1/2004 1:55:10 PM SGrobety
  174. TIdStringStream introduced to fix a bug in DOTNET TStringStream
  175. implementation.
  176. Rev 1.83 2004.01.27 1:42:00 AM czhower
  177. Added parameter check
  178. Rev 1.82 25/01/2004 21:55:40 CCostelloe
  179. Added portable IdFromBeginning/FromCurrent/FromEnd, to be used instead of
  180. soFromBeginning/soBeginning, etc.
  181. Rev 1.81 24/01/2004 20:18:46 CCostelloe
  182. Added IndyCompareStr (to be used in place of AnsiCompareStr for .NET
  183. compatibility)
  184. Rev 1.80 2004.01.23 9:56:30 PM czhower
  185. CharIsInSet now checks length and returns false if no character.
  186. Rev 1.79 2004.01.23 9:49:40 PM czhower
  187. CharInSet no longer accepts -1, was unneeded and redundant.
  188. Rev 1.78 1/22/2004 5:47:46 PM SPerry
  189. fixed CharIsInSet
  190. Rev 1.77 2004.01.22 5:33:46 PM czhower
  191. TIdCriticalSection
  192. Rev 1.76 2004.01.22 3:23:18 PM czhower
  193. IsCharInSet
  194. Rev 1.75 2004.01.22 2:00:14 PM czhower
  195. iif change
  196. Rev 1.74 14/01/2004 00:17:34 CCostelloe
  197. Added IndyLowerCase/IndyUpperCase to replace AnsiLowerCase/AnsiUpperCase for
  198. .NET code
  199. Rev 1.73 1/11/2004 9:50:54 PM BGooijen
  200. Added ToBytes function for Socks
  201. Rev 1.72 2003.12.31 7:32:40 PM czhower
  202. InMainThread now for .net too.
  203. Rev 1.71 2003.12.29 6:48:38 PM czhower
  204. TextIsSame
  205. Rev 1.70 2003.12.28 1:11:04 PM czhower
  206. Conditional typo fixed.
  207. Rev 1.69 2003.12.28 1:05:48 PM czhower
  208. .Net changes.
  209. Rev 1.68 5/12/2003 9:11:00 AM GGrieve
  210. Add WriteStringToStream
  211. Rev 1.67 5/12/2003 12:32:48 AM GGrieve
  212. fix DotNet warnings
  213. Rev 1.66 22/11/2003 12:03:02 AM GGrieve
  214. fix IdMultiPathFormData.pas implementation
  215. Rev 1.65 11/15/2003 1:15:36 PM VVassiliev
  216. Move AppendByte from IdDNSCommon to IdCoreGlobal
  217. Rev 1.64 10/28/2003 8:43:48 PM BGooijen
  218. compiles, and removed call to setstring
  219. Rev 1.63 2003.10.24 10:44:50 AM czhower
  220. IdStream implementation, bug fixes.
  221. Rev 1.62 10/18/2003 4:53:18 PM BGooijen
  222. Added ToHex
  223. Rev 1.61 2003.10.17 6:17:24 PM czhower
  224. Some parts moved to stream
  225. Rev 1.60 10/15/2003 8:28:16 PM DSiders
  226. Added localization comments.
  227. Rev 1.59 2003.10.14 9:27:12 PM czhower
  228. Fixed compile erorr with missing )
  229. Rev 1.58 10/14/2003 3:31:04 PM SPerry
  230. Modified ByteToHex() and IPv4ToHex
  231. Rev 1.57 10/13/2003 5:06:46 PM BGooijen
  232. Removed local constant IdOctalDigits in favor of the unit constant. - attempt
  233. 2
  234. Rev 1.56 10/13/2003 10:07:12 AM DSiders
  235. Reverted prior change; local constant for IdOctalDigits is restored.
  236. Rev 1.55 10/12/2003 11:55:42 AM DSiders
  237. Removed local constant IdOctalDigits in favor of the unit constant.
  238. Rev 1.54 2003.10.11 5:47:22 PM czhower
  239. -VCL fixes for servers
  240. -Chain suport for servers (Super core)
  241. -Scheduler upgrades
  242. -Full yarn support
  243. Rev 1.53 10/8/2003 10:14:34 PM GGrieve
  244. add WriteStringToStream
  245. Rev 1.52 10/8/2003 9:55:30 PM GGrieve
  246. Add IdDelete
  247. Rev 1.51 10/7/2003 11:33:30 PM GGrieve
  248. Fix ReadStringFromStream
  249. Rev 1.50 10/7/2003 10:07:30 PM GGrieve
  250. Get IdHTTP compiling for DotNet
  251. Rev 1.49 6/10/2003 5:48:48 PM SGrobety
  252. DotNet updates
  253. Rev 1.48 10/5/2003 12:26:46 PM BGooijen
  254. changed parameter names at some places
  255. Rev 1.47 10/4/2003 7:08:26 PM BGooijen
  256. added some conversion routines type->TIdBytes->type, and fixed existing ones
  257. Rev 1.46 10/4/2003 3:53:40 PM BGooijen
  258. added some ToBytes functions
  259. Rev 1.45 04/10/2003 13:38:28 HHariri
  260. Write(Integer) support
  261. Rev 1.44 10/3/2003 10:44:54 PM BGooijen
  262. Added WriteBytesToStream
  263. Rev 1.43 2003.10.02 8:29:14 PM czhower
  264. Changed names of byte conversion routines to be more readily understood and
  265. not to conflict with already in use ones.
  266. Rev 1.42 10/2/2003 5:15:16 PM BGooijen
  267. Added Grahame's functions
  268. Rev 1.41 10/1/2003 8:02:20 PM BGooijen
  269. Removed some ifdefs and improved code
  270. Rev 1.40 2003.10.01 9:10:58 PM czhower
  271. .Net
  272. Rev 1.39 2003.10.01 2:46:36 PM czhower
  273. .Net
  274. Rev 1.38 2003.10.01 2:30:36 PM czhower
  275. .Net
  276. Rev 1.37 2003.10.01 12:30:02 PM czhower
  277. .Net
  278. Rev 1.35 2003.10.01 1:12:32 AM czhower
  279. .Net
  280. Rev 1.34 2003.09.30 7:37:14 PM czhower
  281. Typo fix.
  282. Rev 1.33 30/9/2003 3:58:08 PM SGrobety
  283. More .net updates
  284. Rev 1.31 2003.09.30 3:19:30 PM czhower
  285. Updates for .net
  286. Rev 1.30 2003.09.30 1:22:54 PM czhower
  287. Stack split for DotNet
  288. Rev 1.29 2003.09.30 12:09:36 PM czhower
  289. DotNet changes.
  290. Rev 1.28 2003.09.30 10:36:02 AM czhower
  291. Moved stack creation to IdStack
  292. Added DotNet stack.
  293. Rev 1.27 9/29/2003 03:03:28 PM JPMugaas
  294. Changed CIL to DOTNET.
  295. Rev 1.26 9/28/2003 04:22:00 PM JPMugaas
  296. IFDEF'ed out MemoryPos in NET because that will not work there.
  297. Rev 1.25 9/26/03 11:20:50 AM RLebeau
  298. Updated defines used with SetThreadName() to allow it to work under BCB6.
  299. Rev 1.24 9/24/2003 11:42:42 PM JPMugaas
  300. Minor changes to help compile under NET
  301. Rev 1.23 2003.09.20 10:25:42 AM czhower
  302. Added comment and chaned for D6 compat.
  303. Rev 1.22 9/18/2003 07:43:12 PM JPMugaas
  304. Moved GetThreadHandle to IdGlobals so the ThreadComponent can be in this
  305. package.
  306. Rev 1.21 9/8/2003 11:44:38 AM JPMugaas
  307. Fix for problem that was introduced in an optimization.
  308. Rev 1.20 2003.08.19 1:54:34 PM czhower
  309. Removed warning
  310. Rev 1.19 11/8/2003 6:25:44 PM SGrobety
  311. IPv4ToDWord: Added overflow checking disabling ($Q+) and changed "* 256" by
  312. "SHL 8".
  313. Rev 1.18 2003.07.08 2:41:42 PM czhower
  314. This time I saved the file before checking in.
  315. Rev 1.16 7/1/2003 03:39:38 PM JPMugaas
  316. Started numeric IP function API calls for more efficiency.
  317. Rev 1.15 2003.07.01 3:49:56 PM czhower
  318. Added SetThreadName
  319. Rev 1.14 7/1/2003 12:03:56 AM BGooijen
  320. Added functions to switch between IPv6 addresses in string and in
  321. TIdIPv6Address form
  322. Rev 1.13 6/30/2003 06:33:58 AM JPMugaas
  323. Fix for range check error.
  324. Rev 1.12 6/27/2003 04:43:30 PM JPMugaas
  325. Made IPv4ToDWord overload that returns a flag for an error message.
  326. Moved MakeCanonicalIPv4Address code into IPv4ToDWord because most of that
  327. simply reduces IPv4 addresses into a DWord. That also should make the
  328. function more useful in reducing various alternative forms of IPv4 addresses
  329. down to DWords.
  330. Rev 1.11 6/27/2003 01:19:38 PM JPMugaas
  331. Added MakeCanonicalIPv4Address for converting various IPv4 address forms
  332. (mentioned at http://www.pc-help.org/obscure.htm) into a standard dotted IP
  333. address. Hopefully, we should soon support octal and hexidecimal addresses.
  334. Rev 1.9 6/27/2003 04:36:08 AM JPMugaas
  335. Function for converting DWord to IP adcdress.
  336. Rev 1.8 6/26/2003 07:54:38 PM JPMugaas
  337. Routines for converting standard dotted IPv4 addresses into dword,
  338. hexidecimal, and octal forms.
  339. Rev 1.7 5/11/2003 11:57:06 AM BGooijen
  340. Added RaiseLastOSError
  341. Rev 1.6 4/28/2003 03:19:00 PM JPMugaas
  342. Made a function for obtaining the services file FQN. That's in case
  343. something else besides IdPorts needs it.
  344. Rev 1.5 2003.04.16 10:06:42 PM czhower
  345. Moved DebugOutput to IdCoreGlobal
  346. Rev 1.4 12/29/2002 2:15:30 PM JPMugaas
  347. GetCurrentThreadHandle function created as per Bas's instructions. Moved
  348. THandle to IdCoreGlobal for this function.
  349. Rev 1.3 12-15-2002 17:02:58 BGooijen
  350. Added comments to TIdExtList
  351. Rev 1.2 12-15-2002 16:45:42 BGooijen
  352. Added TIdList
  353. Rev 1.1 29/11/2002 10:08:50 AM SGrobety Version: 1.1
  354. Changed GetTickCount to use high-performance timer if available under windows
  355. Rev 1.0 21/11/2002 12:36:18 PM SGrobety Version: Indy 10
  356. Rev 1.0 11/13/2002 08:41:24 AM JPMugaas
  357. }
  358. unit IdGlobal;
  359. interface
  360. {$I IdCompilerDefines.inc}
  361. uses
  362. SysUtils,
  363. {$IFDEF DOTNET}
  364. System.Collections.Specialized,
  365. System.net,
  366. System.net.Sockets,
  367. System.Diagnostics,
  368. System.Threading,
  369. System.IO,
  370. System.Text,
  371. {$ELSE}
  372. {$IFDEF HAS_UNIT_Generics_Collections}
  373. System.Generics.Collections,
  374. {$ENDIF}
  375. {$ENDIF}
  376. {$IFDEF WINDOWS}
  377. {$IFDEF FPC}
  378. windows,
  379. {$ELSE}
  380. Windows,
  381. {$ENDIF}
  382. {$ENDIF}
  383. Classes,
  384. syncobjs,
  385. {$IFDEF UNIX}
  386. {$IFDEF KYLIXCOMPAT}
  387. Libc,
  388. {$ELSE}
  389. {$IFDEF FPC}
  390. DynLibs, // better add DynLibs only for fpc
  391. {$ENDIF}
  392. {$IFDEF USE_VCL_POSIX}
  393. Posix.SysTypes, Posix.Pthread, Posix.Unistd,
  394. {$ENDIF}
  395. {$IFDEF USE_BASEUNIX}
  396. BaseUnix, Unix, Sockets, UnixType,
  397. {$ENDIF}
  398. {$IFDEF USE_ICONV_ENC}iconvenc, {$ENDIF}
  399. {$ENDIF}
  400. {$IFDEF OSX}
  401. {$IFNDEF FPC}
  402. //RLebeau: FPC does not provide mach_timebase_info() and mach_absolute_time() yet...
  403. Macapi.Mach,
  404. {$ENDIF}
  405. {$ENDIF}
  406. {$ENDIF}
  407. IdException;
  408. {$IFNDEF DOTNET}
  409. {$IFNDEF HAS_PCardinal}
  410. type
  411. PCardinal = ^Cardinal;
  412. {$ENDIF}
  413. {$ENDIF}
  414. {$IFDEF HAS_QWord}
  415. {$IFNDEF HAS_PQWord}
  416. type
  417. PQWord = ^QWord;
  418. {$ENDIF}
  419. {$ENDIF}
  420. {$IFNDEF HAS_Int8}
  421. type
  422. Int8 = {$IFDEF DOTNET}System.SByte{$ELSE}Shortint{$ENDIF};
  423. {$NODEFINE Int8}
  424. {$ENDIF}
  425. {$IFNDEF HAS_PInt8}
  426. {$IFNDEF DOTNET}
  427. type
  428. PInt8 = PShortint;
  429. {$NODEFINE PInt8}
  430. {$ENDIF}
  431. {$ENDIF}
  432. {$IFNDEF HAS_UInt8}
  433. type
  434. UInt8 = {$IFDEF DOTNET}System.Byte{$ELSE}Byte{$ENDIF};
  435. {$NODEFINE UInt8}
  436. {$ENDIF}
  437. {$IFNDEF HAS_PUInt8}
  438. {$IFNDEF DOTNET}
  439. type
  440. PUInt8 = PByte;
  441. {$NODEFINE PUInt8}
  442. {$ENDIF}
  443. {$ENDIF}
  444. {$IFNDEF HAS_Int16}
  445. type
  446. Int16 = Smallint;
  447. {$NODEFINE Int16}
  448. {$ENDIF}
  449. {$IFNDEF HAS_PInt16}
  450. {$IFNDEF DOTNET}
  451. type
  452. PInt16 = PSmallint;
  453. {$NODEFINE PInt16}
  454. {$ENDIF}
  455. {$ENDIF}
  456. {$IFNDEF HAS_UInt16}
  457. type
  458. UInt16 = Word;
  459. {$NODEFINE UInt16}
  460. {$ENDIF}
  461. {$IFNDEF HAS_PUInt16}
  462. {$IFNDEF DOTNET}
  463. type
  464. PUInt16 = PWord;
  465. {$NODEFINE PUInt16}
  466. {$ENDIF}
  467. {$ENDIF}
  468. {$IFNDEF HAS_Int32}
  469. type
  470. Int32 = Integer;
  471. {$NODEFINE Int32}
  472. {$ENDIF}
  473. {$IFNDEF HAS_PInt32}
  474. {$IFNDEF DOTNET}
  475. type
  476. PInt32 = PInteger;
  477. {$NODEFINE PInt32}
  478. {$ENDIF}
  479. {$ENDIF}
  480. {$IFNDEF HAS_UInt32}
  481. type
  482. UInt32 = Cardinal;
  483. {$NODEFINE UInt32}
  484. {$ENDIF}
  485. {$IFNDEF HAS_PUInt32}
  486. {$IFNDEF DOTNET}
  487. type
  488. PUInt32 = PCardinal;
  489. {$NODEFINE PUInt32}
  490. {$ENDIF}
  491. {$ENDIF}
  492. {$IFDEF HAS_UInt64}
  493. {$DEFINE UInt64_IS_NATIVE}
  494. // In C++Builder 2006 and 2007, UInt64 is emitted as signed __int64 in HPP
  495. // files instead of as unsigned __int64. This causes conflicts in overloaded
  496. // routines that have (U)Int64 parameters. This was fixed in C++Builder 2009...
  497. {$IFNDEF TIdUInt64_HAS_QuadPart}
  498. type
  499. TIdUInt64 = UInt64;
  500. {$ENDIF}
  501. {$ELSE}
  502. {$IFDEF HAS_QWord}
  503. {$DEFINE UInt64_IS_NATIVE}
  504. type
  505. UInt64 = QWord;
  506. {$NODEFINE UInt64}
  507. TIdUInt64 = QWord;
  508. {$ELSE}
  509. type
  510. UInt64 = Int64;
  511. {$NODEFINE UInt64}
  512. {$ENDIF}
  513. {$ENDIF}
  514. {$IFDEF HAS_UInt64}
  515. {$IFNDEF HAS_PUInt64}
  516. type
  517. PUInt64 = ^UInt64;
  518. {$ENDIF}
  519. {$ELSE}
  520. type
  521. PUInt64 = {$IFDEF HAS_QWord}PQWord{$ELSE}PInt64{$ENDIF};
  522. {$ENDIF}
  523. {$IFDEF TIdUInt64_HAS_QuadPart}
  524. // For compilers that do not have a native UInt64 type, or for C++Builder
  525. // 2006/2007 with its broken UInt64 HPP emit, let's define a record type
  526. // that can hold UInt64 values, and then use it wherever UInt64 parameters
  527. // are needed...
  528. type
  529. TIdUInt64 = packed record
  530. case Integer of
  531. 0: (
  532. {$IFDEF ENDIAN_BIG}
  533. HighPart: UInt32;
  534. LowPart: UInt32
  535. {$ELSE}
  536. LowPart: UInt32;
  537. HighPart: UInt32
  538. {$ENDIF}
  539. );
  540. 1: (
  541. QuadPart: UInt64
  542. );
  543. end;
  544. {$NODEFINE TIdUInt64}
  545. (*$HPPEMIT 'namespace Idglobal'*)
  546. (*$HPPEMIT '{'*)
  547. (*$HPPEMIT ' #pragma pack(push, 1)' *)
  548. (*$HPPEMIT ' struct TIdUInt64'*)
  549. (*$HPPEMIT ' {'*)
  550. (*$HPPEMIT ' union {'*)
  551. (*$HPPEMIT ' struct {'*)
  552. // TODO: move the endian check to the C++ side using #if...
  553. {$IFDEF ENDIAN_BIG}
  554. (*$HPPEMIT ' unsigned __int32 HighPart;'*)
  555. (*$HPPEMIT ' unsigned __int32 LowPart;'*)
  556. {$ELSE}
  557. (*$HPPEMIT ' unsigned __int32 LowPart;'*)
  558. (*$HPPEMIT ' unsigned __int32 HighPart;'*)
  559. {$ENDIF}
  560. (*$HPPEMIT ' };'*)
  561. (*$HPPEMIT ' unsigned __int64 QuadPart;'*)
  562. (*$HPPEMIT ' };'*)
  563. (*$HPPEMIT ' TIdUInt64(unsigned __int64 value) { QuadPart = value; }'*)
  564. (*$HPPEMIT ' operator unsigned __int64() const { return QuadPart; }'*)
  565. (*$HPPEMIT ' TIdUInt64& operator=(unsigned __int64 value) { QuadPart = value; return *this; }'*)
  566. (*$HPPEMIT ' };'*)
  567. (*$HPPEMIT ' #pragma pack(pop)' *)
  568. (*$HPPEMIT '}'*)
  569. {$ENDIF}
  570. const
  571. {This is the only unit with references to OS specific units and IFDEFs. NO OTHER units
  572. are permitted to do so except .pas files which are counterparts to dfm/xfm files, and only for
  573. support of that.}
  574. //We make the version things an Inc so that they can be managed independantly
  575. //by the package builder.
  576. {$I IdVers.inc}
  577. {$IFNDEF HAS_TIMEUNITS}
  578. HoursPerDay = 24;
  579. MinsPerHour = 60;
  580. SecsPerMin = 60;
  581. MSecsPerSec = 1000;
  582. MinsPerDay = HoursPerDay * MinsPerHour;
  583. SecsPerDay = MinsPerDay * SecsPerMin;
  584. MSecsPerDay = SecsPerDay * MSecsPerSec;
  585. {$ENDIF}
  586. {$IFDEF DOTNET}
  587. // Timeout.Infinite is -1 which violates Cardinal which VCL uses for parameter
  588. // so we are just setting it to this as a hard coded constant until
  589. // the synchro classes and other are all ported directly to portable classes
  590. // (SyncObjs is platform specific)
  591. //Infinite = Timeout.Infinite;
  592. INFINITE = UInt32($FFFFFFFF); { Infinite timeout }
  593. {$ENDIF}
  594. // FPC's DynLibs unit is not included in this unit's interface 'uses' clause, only
  595. // in the implementation's 'uses' clause, so map to what DynLibs.NilHandle maps to...
  596. IdNilHandle = {$IFDEF FPC}{DynLibs.NilHandle}PtrInt(0){$ELSE}THandle(0){$ENDIF};
  597. LF = #10;
  598. CR = #13;
  599. // RLebeau: EOL is NOT to be used as a platform-specific line break! Most
  600. // text-based protocols that Indy implements are defined to use CRLF line
  601. // breaks. DO NOT change this! If you need a platform-based line break,
  602. // use sLineBreak instead.
  603. EOL = CR + LF;
  604. //
  605. CHAR0 = #0;
  606. BACKSPACE = #8;
  607. TAB = #9;
  608. CHAR32 = #32;
  609. //Timeout values
  610. IdTimeoutDefault = -1;
  611. IdTimeoutInfinite = -2;
  612. //Fetch Defaults
  613. IdFetchDelimDefault = ' '; {Do not Localize}
  614. IdFetchDeleteDefault = True;
  615. IdFetchCaseSensitiveDefault = True;
  616. IdWhiteSpace = [0..12, 14..32]; {do not localize}
  617. 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}
  618. IdOctalDigits: array [0..7] of Char = ('0','1','2','3','4','5','6','7'); {do not localize}
  619. IdHexPrefix = '0x'; {Do not translate}
  620. type
  621. //thread and PID stuff
  622. {$IFDEF DOTNET}
  623. TIdPID = UInt32;
  624. TIdThreadId = UInt32;
  625. TIdThreadHandle = System.Threading.Thread;
  626. {$IFDEF DOTNETDISTRO}
  627. TIdThreadPriority = System.Threading.ThreadPriority;
  628. {$ELSE}
  629. TIdThreadPriority = TThreadPriority;
  630. {$ENDIF}
  631. {$ENDIF}
  632. {$IFDEF UNIX}
  633. {$IFDEF KYLIXCOMPAT}
  634. TIdPID = Int32;
  635. TIdThreadId = Int32;
  636. {$IFDEF FPC}
  637. TIdThreadHandle = TThreadID;
  638. {$ELSE}
  639. TIdThreadHandle = UInt32;
  640. {$ENDIF}
  641. {$IFDEF INT_THREAD_PRIORITY}
  642. TIdThreadPriority = -20..19;
  643. {$ELSE}
  644. TIdThreadPriority = TThreadPriority;
  645. {$ENDIF}
  646. {$ENDIF}
  647. {$IFDEF USE_BASEUNIX}
  648. TIdPID = TPid;
  649. TIdThreadId = TThreadId;
  650. TIdThreadHandle = TIdThreadId;
  651. TIdThreadPriority = TThreadPriority;
  652. {$ENDIF}
  653. {$IFDEF USE_VCL_POSIX}
  654. TIdPID = pid_t;
  655. TIdThreadId = NativeUInt;
  656. TIdThreadHandle = NativeUInt;
  657. {$IFDEF INT_THREAD_PRIORITY}
  658. TIdThreadPriority = -20..19;
  659. {$ELSE}
  660. TIdThreadPriority = TThreadPriority;
  661. {$ENDIF}
  662. {$ENDIF}
  663. {$ENDIF}
  664. {$IFDEF WINDOWS}
  665. TIdPID = UInt32;
  666. TIdThreadId = UInt32;
  667. TIdThreadHandle = THandle;
  668. {$I IdSymbolPlatformOff.inc}
  669. TIdThreadPriority = TThreadPriority;
  670. {$I IdSymbolPlatformOn.inc}
  671. {$ENDIF}
  672. TIdTicks = UInt64;
  673. {$IFDEF INT_THREAD_PRIORITY}
  674. const
  675. // approximate values, its finer grained on Linux
  676. tpIdle = 19;
  677. tpLowest = 12;
  678. tpLower = 6;
  679. tpNormal = 0;
  680. tpHigher = -7;
  681. tpHighest = -13;
  682. tpTimeCritical = -20;
  683. {$ENDIF}
  684. {CH tpIdLowest = tpLowest; }
  685. {CH tpIdBelowNormal = tpLower; }
  686. {CH tpIdNormal = tpNormal; }
  687. {CH tpIdAboveNormal = tpHigher; }
  688. {CH tpIdHighest = tpHighest; }
  689. //end thread stuff
  690. const
  691. //leave this as zero. It's significant in many socket calls that specify ports
  692. DEF_PORT_ANY = 0;
  693. type
  694. {$IFDEF DOTNET}
  695. TIdUnicodeString = System.String;
  696. {$ELSE}
  697. {$IFDEF HAS_UnicodeString}
  698. TIdUnicodeString = UnicodeString;
  699. {$ELSE}
  700. TIdUnicodeString = WideString;
  701. // RP 9/12/2014: Synopse just released a unit that patches the System unit
  702. // in pre-Unicode versions of Delphi to redirect WideString memory management
  703. // to the RTL's memory manager (FastMM, etc) instead of the Win32 COM API!
  704. //
  705. // http://blog.synopse.info/post/2014/09/12/Faster-WideString-process-for-good-old-non-Unicode-Delphi-6-2007
  706. // https://github.com/synopse/mORMot/blob/master/SynFastWideString.pas
  707. //
  708. // We should consider providing an optional setting to enable that patch
  709. // so we can get a performance boost for Unicode-enabled code that uses
  710. // TIdUnicodeString...
  711. {$ENDIF}
  712. {$ENDIF}
  713. // the Delphi next-gen compiler eliminates AnsiString/AnsiChar/PAnsiChar,
  714. // but we still need to deal with Ansi data. Unfortunately, the compiler
  715. // won't let us use its secret _AnsiChr types either, so we have to use
  716. // Byte instead unless we can find a better solution...
  717. {$IFDEF HAS_AnsiChar}
  718. TIdAnsiChar = AnsiChar;
  719. {$ELSE}
  720. TIdAnsiChar = Byte;
  721. {$ENDIF}
  722. {$IFDEF HAS_PAnsiChar}
  723. PIdAnsiChar = PAnsiChar;
  724. {$ELSE}
  725. {$IFDEF HAS_MarshaledAString}
  726. PIdAnsiChar = MarshaledAString;
  727. {$ELSE}
  728. PIdAnsiChar = PByte;
  729. {$ENDIF}
  730. {$ENDIF}
  731. {$IFDEF HAS_PPAnsiChar}
  732. PPIdAnsiChar = PPAnsiChar;
  733. {$ELSE}
  734. PPIdAnsiChar = ^PIdAnsiChar;
  735. {$ENDIF}
  736. {$IFDEF STRING_IS_UNICODE}
  737. TIdWideChar = Char;
  738. PIdWideChar = PChar;
  739. {$ELSE}
  740. TIdWideChar = WideChar;
  741. PIdWideChar = PWideChar;
  742. {$ENDIF}
  743. {$IFDEF WINDOWS}
  744. // .NET and Delphi 2009+ support UNICODE strings natively!
  745. //
  746. // FreePascal 2.4.0+ supports UnicodeString, but does not map its native
  747. // String type to UnicodeString except when {$MODE DelphiUnicode} or
  748. // {$MODESWITCH UnicodeStrings} is enabled. However, UNICODE is not
  749. // defined in that mode yet until FreePascal's RTL has been updated to
  750. // support UnicodeString. STRING_UNICODE_MISMATCH is defined in
  751. // IdCompilerDefines.inc when the compiler's native String/Char types do
  752. // not map to the same types that API functions are expecting based on
  753. // whether UNICODE is defined or not. So we will create special Platform
  754. // typedefs here to help with API function calls when dealing with that
  755. // mismatch...
  756. {$IFDEF UNICODE}
  757. TIdPlatformString = TIdUnicodeString;
  758. TIdPlatformChar = TIdWideChar;
  759. PIdPlatformChar = PIdWideChar;
  760. {$ELSE}
  761. TIdPlatformString = AnsiString;
  762. TIdPlatformChar = TIdAnsiChar;
  763. PIdPlatformChar = PIdAnsiChar;
  764. {$ENDIF}
  765. {$ENDIF}
  766. TIdBytes = array of Byte;
  767. TIdWideChars = array of TIdWideChar;
  768. //NOTE: The code below assumes a 32bit Linux architecture (such as target i386-linux)
  769. {$UNDEF CPU32_OR_KYLIX}
  770. {$IFNDEF DOTNET}
  771. {$IFDEF CPU32}
  772. {$DEFINE CPU32_OR_KYLIX}
  773. {$ENDIF}
  774. {$IFDEF KYLIX}
  775. {$DEFINE CPU32_OR_KYLIX}
  776. {$ENDIF}
  777. {$ENDIF}
  778. // native signed and unsigned integer sized pointer types
  779. {$IFDEF DOTNET}
  780. TIdNativeInt = IntPtr;
  781. TIdNativeUInt = UIntPtr;
  782. {$ELSE}
  783. {$IFDEF HAS_NativeInt}
  784. TIdNativeInt = NativeInt;
  785. {$ELSE}
  786. {$IFDEF CPU32}
  787. TIdNativeInt = Int32;
  788. {$ENDIF}
  789. {$IFDEF CPU64}
  790. TIdNativeInt = Int64;
  791. {$ENDIF}
  792. {$ENDIF}
  793. {$IFDEF HAS_NativeUInt}
  794. TIdNativeUInt = NativeUInt;
  795. {$ELSE}
  796. {$IFDEF CPU32}
  797. TIdNativeUInt = UInt32;
  798. {$ENDIF}
  799. {$IFDEF CPU64}
  800. TIdNativeUInt = UInt64;
  801. {$ENDIF}
  802. {$ENDIF}
  803. {$ENDIF}
  804. {$IFNDEF HAS_PtrInt}
  805. PtrInt = TIdNativeInt;
  806. {$ENDIF}
  807. {$IFNDEF HAS_PtrUInt}
  808. PtrUInt = TIdNativeUInt;
  809. {$ENDIF}
  810. {$IFDEF STREAM_SIZE_64}
  811. TIdStreamSize = Int64;
  812. {$ELSE}
  813. TIdStreamSize = Int32;
  814. {$ENDIF}
  815. {$IFNDEF HAS_SIZE_T}
  816. {$EXTERNALSYM size_t}
  817. size_t = PtrUInt;
  818. {$ENDIF}
  819. {$IFNDEF HAS_PSIZE_T}
  820. {$EXTERNALSYM Psize_t}
  821. Psize_t = ^size_t;
  822. {$ENDIF}
  823. // RLebeau 12/1/2018: FPC's System unit defines an HMODULE type as a PtrUInt. But,
  824. // the DynLibs unit defines its own HModule type that is a TLibHandle, which is a
  825. // PtrInt instead. And to make matters worse, although FPC's System.THandle is a
  826. // platform-dependant type, it is not always defined as 8 bytes on 64bit platforms,
  827. // which has been known to cause overflows when dynamic libraries are loaded at
  828. // high addresses! (FPC bug?) So, we can't rely on THandle to hold correct handles
  829. // for libraries that we load dynamically at runtime (which is probably why FPC
  830. // defines TLibHandle in the first place, but why is it signed instead of unsigned?).
  831. //
  832. // Delphi's HMODULE is a System.THandle, which is a NativeUInt, and so is defined
  833. // with a proper byte size across all 32bit and 64bit platforms.
  834. //
  835. // Since (Safe)LoadLibrary(), GetProcAddress(), etc all use TLibHandle in FPC, but
  836. // use HMODULE in Delphi. this does mean we have a small descrepency between using
  837. // signed vs unsigned library handles. I would prefer to use unsigned everywhere,
  838. // but we should use what is more natural for each compiler...
  839. // FPC's DynLibs unit is not included in this unit's interface 'uses' clause, only
  840. // in the implementation's 'uses' clause, so map to what DynLibs.TLibHandle maps to...
  841. TIdLibHandle = {$IFDEF FPC}{DynLibs.TLibHandle}PtrInt{$ELSE}THandle{$ENDIF};
  842. {$IFDEF STRING_IS_IMMUTABLE}
  843. // In .NET and Delphi next-gen, strings are immutable (and zero-indexed), so we
  844. // need to use a StringBuilder whenever we need to modify individual characters
  845. // of a string...
  846. TIdStringBuilder = {$IFDEF DOTNET}System.Text.StringBuilder{$ELSE}TStringBuilder{$ENDIF};
  847. {$ENDIF}
  848. {
  849. Delphi/C++Builder 2009+ have a TEncoding class which mirrors System.Text.Encoding
  850. in .NET, but does not have a TDecoder class which mirrors System.Text.Decoder
  851. in .NET. TEncoding's interface changes from version to version, in some ways
  852. that cause compatibility issues when trying to write portable code, so we will
  853. not rely on it. IIdTextEncoding is our own wrapper so we have control over
  854. text encodings.
  855. This way, Indy can have a unified internal interface for String<->Byte conversions
  856. without using IFDEFs everywhere.
  857. Note: Having the wrapper class use WideString in earlier versions adds extra
  858. overhead to string operations, but this is the only way to ensure that strings
  859. are encoded properly. Later on, perhaps we can optimize the operations when
  860. Ansi-compatible encodings are being used with AnsiString values.
  861. }
  862. {$IFNDEF HAS_IInterface}
  863. IInterface = IUnknown;
  864. {$ENDIF}
  865. IIdTextEncoding = interface(IInterface)
  866. ['{FA87FAE5-E3E3-4632-8FCA-2FB786848655}']
  867. function GetByteCount(const AChars: TIdWideChars): Integer; overload;
  868. function GetByteCount(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): Integer; overload;
  869. {$IFNDEF DOTNET}
  870. function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; overload;
  871. {$ENDIF}
  872. function GetByteCount(const AStr: TIdUnicodeString): Integer; overload;
  873. function GetByteCount(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): Integer; overload;
  874. function GetBytes(const AChars: TIdWideChars): TIdBytes; overload;
  875. function GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): TIdBytes; overload;
  876. function GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
  877. {$IFNDEF DOTNET}
  878. function GetBytes(const AChars: PIdWideChar; ACharCount: Integer): TIdBytes; overload;
  879. function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
  880. function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; overload;
  881. {$ENDIF}
  882. function GetBytes(const AStr: TIdUnicodeString): TIdBytes; overload;
  883. function GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): TIdBytes; overload;
  884. function GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
  885. function GetCharCount(const ABytes: TIdBytes): Integer; overload;
  886. function GetCharCount(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): Integer; overload;
  887. {$IFNDEF DOTNET}
  888. function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; overload;
  889. {$ENDIF}
  890. function GetChars(const ABytes: TIdBytes): TIdWideChars; overload;
  891. function GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdWideChars; overload;
  892. function GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer; overload;
  893. {$IFNDEF DOTNET}
  894. function GetChars(const ABytes: PByte; AByteCount: Integer): TIdWideChars; overload;
  895. function GetChars(const ABytes: PByte; AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer; overload;
  896. function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; overload;
  897. {$ENDIF}
  898. function GetIsSingleByte: Boolean;
  899. function GetMaxByteCount(ACharCount: Integer): Integer;
  900. function GetMaxCharCount(AByteCount: Integer): Integer;
  901. function GetPreamble: TIdBytes;
  902. function GetString(const ABytes: TIdBytes): TIdUnicodeString; overload;
  903. function GetString(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdUnicodeString; overload;
  904. {$IFNDEF DOTNET}
  905. function GetString(const ABytes: PByte; AByteCount: Integer): TIdUnicodeString; overload;
  906. {$ENDIF}
  907. property IsSingleByte: Boolean read GetIsSingleByte;
  908. end;
  909. IdTextEncodingType = (encIndyDefault, encOSDefault, enc8Bit, encASCII, encUTF16BE, encUTF16LE, encUTF7, encUTF8);
  910. function IndyTextEncoding(AType: IdTextEncodingType): IIdTextEncoding; overload;
  911. function IndyTextEncoding(ACodepage: UInt16): IIdTextEncoding; overload;
  912. function IndyTextEncoding(const ACharSet: String): IIdTextEncoding; overload;
  913. {$IFDEF DOTNET}
  914. function IndyTextEncoding(AEncoding: System.Text.Encoding): IIdTextEncoding; overload;
  915. {$ENDIF}
  916. {$IFDEF HAS_TEncoding}
  917. function IndyTextEncoding(AEncoding: TEncoding; AFreeEncoding: Boolean = False): IIdTextEncoding; overload;
  918. {$ENDIF}
  919. function IndyTextEncoding_Default: IIdTextEncoding;
  920. function IndyTextEncoding_OSDefault: IIdTextEncoding;
  921. function IndyTextEncoding_8Bit: IIdTextEncoding;
  922. function IndyTextEncoding_ASCII: IIdTextEncoding;
  923. function IndyTextEncoding_UTF16BE: IIdTextEncoding;
  924. function IndyTextEncoding_UTF16LE: IIdTextEncoding;
  925. function IndyTextEncoding_UTF7: IIdTextEncoding;
  926. function IndyTextEncoding_UTF8: IIdTextEncoding;
  927. // These are for backwards compatibility with past Indy 10 releases
  928. function enDefault: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_Default() or a nil IIdTextEncoding pointer'{$ENDIF};{$ENDIF}
  929. {$NODEFINE enDefault}
  930. function en7Bit: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_ASCII()'{$ENDIF};{$ENDIF}
  931. {$NODEFINE en7Bit}
  932. function en8Bit: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_8Bit()'{$ENDIF};{$ENDIF}
  933. {$NODEFINE en8Bit}
  934. function enUTF8: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_UTF8()'{$ENDIF};{$ENDIF}
  935. {$NODEFINE enUTF8}
  936. function Indy8BitEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_8Bit()'{$ENDIF};{$ENDIF}
  937. function IndyASCIIEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_ASCII()'{$ENDIF};{$ENDIF}
  938. function IndyUTF16BigEndianEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_UTF16BE()'{$ENDIF};{$ENDIF}
  939. function IndyUTF16LittleEndianEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_UTF16LE()'{$ENDIF};{$ENDIF}
  940. function IndyOSDefaultEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_OSDefault()'{$ENDIF};{$ENDIF}
  941. function IndyUTF7Encoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_UTF7()'{$ENDIF};{$ENDIF}
  942. function IndyUTF8Encoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_UTF8()'{$ENDIF};{$ENDIF}
  943. (*$HPPEMIT '// These are helper macros to handle differences between C++Builder versions'*)
  944. (*$HPPEMIT '#define TIdTextEncoding_ASCII IndyTextEncoding_ASCII()'*)
  945. (*$HPPEMIT '#define TIdTextEncoding_BigEndianUnicode IndyTextEncoding_UTF16BE()'*)
  946. (*$HPPEMIT '#define TIdTextEncoding_Default IndyTextEncoding_OSDefault()'*)
  947. (*$HPPEMIT '#define TIdTextEncoding_Unicode IndyTextEncoding_UTF16LE()'*)
  948. (*$HPPEMIT '#define TIdTextEncoding_UTF7 IndyTextEncoding_UTF7()'*)
  949. (*$HPPEMIT '#define TIdTextEncoding_UTF8 IndyTextEncoding_UTF8()'*)
  950. (*$HPPEMIT ''*)
  951. (*$HPPEMIT '// These are for backwards compatibility with earlier Indy 10 releases'*)
  952. (*$HPPEMIT '#define enDefault ( ( IIdTextEncoding* )NULL )'*)
  953. (*$HPPEMIT '#define en8Bit IndyTextEncoding_8Bit()'*)
  954. (*$HPPEMIT '#define en7Bit IndyTextEncoding_ASCII()'*)
  955. (*$HPPEMIT '#define enUTF8 IndyTextEncoding_UTF8()'*)
  956. (*$HPPEMIT ''*)
  957. var
  958. {RLebeau: using ASCII by default because most Internet protocols that Indy
  959. implements are based on ASCII specifically, not Ansi. Non-ASCII data has
  960. to be explicitally allowed by RFCs, in which case the caller should not be
  961. using nil IIdTextEncoding objects to begin with...}
  962. GIdDefaultTextEncoding: IdTextEncodingType = encASCII;
  963. {$IFDEF USE_ICONV}
  964. // This indicates whether encOSDefault should map to an OS dependant Ansi
  965. // locale or to ASCII. Defaulting to ASCII for now to maintain compatibility
  966. // with earlier Indy 10 releases...
  967. GIdIconvUseLocaleDependantAnsiEncoding: Boolean = False;
  968. // This indicates whether Iconv should ignore characters that cannot be
  969. // converted. Defaulting to false for now to maintain compatibility with
  970. // earlier Indy 10 releases...
  971. GIdIconvIgnoreIllegalChars: Boolean = False;
  972. // This indicates whether Iconv should transliterate characters that cannot
  973. // be converted. Defaulting to false for now to maintain compatibility with
  974. // earlier Indy 10 releases...
  975. GIdIconvUseTransliteration: Boolean = False;
  976. {$ENDIF}
  977. procedure EnsureEncoding(var VEncoding : IIdTextEncoding; ADefEncoding: IdTextEncodingType = encIndyDefault);
  978. procedure CheckByteEncoding(var VBytes: TIdBytes; ASrcEncoding, ADestEncoding: IIdTextEncoding);
  979. {$IFNDEF DOTNET}
  980. function GetEncodingCodePage(AEncoding: IIdTextEncoding): UInt16;
  981. {$ENDIF}
  982. type
  983. TIdAppendFileStream = class(TFileStream)
  984. public
  985. constructor Create(const AFile : String);
  986. end;
  987. TIdReadFileExclusiveStream = class(TFileStream)
  988. public
  989. constructor Create(const AFile : String);
  990. end;
  991. TIdReadFileNonExclusiveStream = class(TFileStream)
  992. public
  993. constructor Create(const AFile : String);
  994. end;
  995. TIdFileCreateStream = class(TFileStream)
  996. public
  997. constructor Create(const AFile : String);
  998. end;
  999. {$IFDEF DOTNET}
  1000. {$IFNDEF DOTNET_2_OR_ABOVE}
  1001. // dotNET implementation
  1002. TWaitResult = (wrSignaled, wrTimeout, wrAbandoned, wrError);
  1003. TEvent = class(TObject)
  1004. protected
  1005. FEvent: WaitHandle;
  1006. public
  1007. constructor Create(EventAttributes: IntPtr; ManualReset,
  1008. InitialState: Boolean; const Name: string = ''); overload;
  1009. constructor Create; overload;
  1010. destructor Destroy; override;
  1011. procedure SetEvent;
  1012. procedure ResetEvent;
  1013. function WaitFor(Timeout: UInt32): TWaitResult; virtual;
  1014. end;
  1015. TCriticalSection = class(TObject)
  1016. public
  1017. procedure Acquire; virtual;
  1018. procedure Release; virtual;
  1019. function TryEnter: Boolean;
  1020. procedure Enter;
  1021. procedure Leave;
  1022. end;
  1023. {$ENDIF}
  1024. {$ELSE}
  1025. {$IFNDEF NO_REDECLARE}
  1026. // TCriticalSection = SyncObjs.TCriticalSection;
  1027. {$ENDIF}
  1028. {$ENDIF}
  1029. TIdLocalEvent = class(TEvent)
  1030. public
  1031. constructor Create(const AInitialState: Boolean = False;
  1032. const AManualReset: Boolean = False); reintroduce;
  1033. function WaitForEver: TWaitResult; overload;
  1034. end;
  1035. // This is here to reduce all the warnings about imports. We may also ifdef
  1036. // it to provide a non warning implementatino on this unit too later.
  1037. TIdCriticalSection = class(TCriticalSection)
  1038. end;
  1039. //Only needed for ToBytes(Short) and BytesToShort
  1040. {$IFDEF DOTNET}
  1041. Short = System.Int16 {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use Int16'{$ENDIF}{$ENDIF};
  1042. {$ENDIF}
  1043. {$IFDEF UNIX}
  1044. Short = Int16 {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use Int16'{$ENDIF}{$ENDIF};
  1045. {$ENDIF}
  1046. {$IFNDEF DOTNET}
  1047. {$IFNDEF NO_REDECLARE}
  1048. PShort = ^Short;
  1049. {$ENDIF}
  1050. {$ENDIF}
  1051. //This usually is a property editor exception
  1052. EIdCorruptServicesFile = class(EIdException);
  1053. EIdEndOfStream = class(EIdException);
  1054. EIdInvalidIPv6Address = class(EIdException);
  1055. EIdNoEncodingSpecified = class(EIdException);
  1056. //This is called whenever there is a failure to retreive the time zone information
  1057. EIdFailedToRetreiveTimeZoneInfo = class(EIdException);
  1058. TIdPort = UInt16;
  1059. //We don't have a native type that can hold an IPv6 address.
  1060. {$NODEFINE TIdIPv6Address}
  1061. TIdIPv6Address = array [0..7] of UInt16;
  1062. // C++ does not allow an array to be returned by a function,
  1063. // so wrapping the array in a struct as a workaround...
  1064. //
  1065. // This is one place where Word is being used instead of UInt16.
  1066. // On OSX/iOS, UInt16 is defined in mactypes.h, not in System.hpp!
  1067. // don't want to use a bunch of IFDEF's trying to figure out where
  1068. // UInt16 is coming from...
  1069. //
  1070. (*$HPPEMIT 'namespace Idglobal'*)
  1071. (*$HPPEMIT '{'*)
  1072. (*$HPPEMIT ' struct TIdIPv6Address'*)
  1073. (*$HPPEMIT ' {'*)
  1074. (*$HPPEMIT ' ::System::Word data[8];'*)
  1075. (*$HPPEMIT ' ::System::Word& operator[](int index) { return data[index]; }'*)
  1076. (*$HPPEMIT ' const ::System::Word& operator[](int index) const { return data[index]; }'*)
  1077. (*$HPPEMIT ' operator const ::System::Word*() const { return data; }'*)
  1078. (*$HPPEMIT ' operator ::System::Word*() { return data; }'*)
  1079. (*$HPPEMIT ' };'*)
  1080. (*$HPPEMIT '}'*)
  1081. {This way instead of a boolean for future expansion of other actions}
  1082. TIdMaxLineAction = (maException, maSplit);
  1083. TIdOSType = (otUnknown, otUnix, otWindows, otDotNet);
  1084. //This is for IPv6 support when merged into the core
  1085. TIdIPVersion = (Id_IPv4, Id_IPv6);
  1086. {$IFNDEF NO_REDECLARE}
  1087. {$IFDEF LINUX}
  1088. {$IFNDEF VCL_6_OR_ABOVE}
  1089. THandle = UInt32; //D6.System
  1090. {$ENDIF}
  1091. {$ENDIF}
  1092. {$ENDIF}
  1093. {$IFDEF DOTNET}
  1094. THandle = Int32;
  1095. {$ELSE}
  1096. {$IFDEF WINDOWS}
  1097. // THandle = Windows.THandle;
  1098. {$ENDIF}
  1099. {$ENDIF}
  1100. TPosProc = function(const substr, str: String): Integer;
  1101. {$IFNDEF DOTNET}
  1102. TStrScanProc = function(Str: PChar; Chr: Char): PChar;
  1103. {$ENDIF}
  1104. TIdReuseSocket = (rsOSDependent, rsTrue, rsFalse);
  1105. {$IFNDEF STREAM_SIZE_64}
  1106. type
  1107. TSeekOrigin = (soBeginning, soCurrent, soEnd);
  1108. {$ENDIF}
  1109. // TIdBaseStream is defined here to allow TIdMultiPartFormData to be defined
  1110. // without any $IFDEFs in the unit IdMultiPartFormData - in accordance with Indy Coding rules
  1111. TIdBaseStream = class(TStream)
  1112. protected
  1113. function IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint; virtual; abstract;
  1114. function IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint; virtual; abstract;
  1115. function IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; virtual; abstract;
  1116. procedure IdSetSize(ASize: Int64); virtual; abstract;
  1117. {$IFDEF DOTNET}
  1118. procedure SetSize(ASize: Int64); override;
  1119. {$ELSE}
  1120. {$IFDEF STREAM_SIZE_64}
  1121. procedure SetSize(const NewSize: Int64); override;
  1122. {$ELSE}
  1123. procedure SetSize(ASize: Integer); override;
  1124. {$ENDIF}
  1125. {$ENDIF}
  1126. public
  1127. {$IFDEF DOTNET}
  1128. function Read(var VBuffer: array of Byte; AOffset, ACount: Longint): Longint; override;
  1129. function Write(const ABuffer: array of Byte; AOffset, ACount: Longint): Longint; override;
  1130. function Seek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; override;
  1131. {$ELSE}
  1132. function Read(var Buffer; Count: Longint): Longint; override;
  1133. function Write(const Buffer; Count: Longint): Longint; override;
  1134. {$IFDEF STREAM_SIZE_64}
  1135. function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
  1136. {$ELSE}
  1137. function Seek(Offset: Longint; Origin: Word): Longint; override;
  1138. {$ENDIF}
  1139. {$ENDIF}
  1140. end;
  1141. TIdCalculateSizeStream = class(TIdBaseStream)
  1142. protected
  1143. FPosition: Int64;
  1144. FSize: Int64;
  1145. function IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint; override;
  1146. function IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint; override;
  1147. function IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; override;
  1148. procedure IdSetSize(ASize: Int64); override;
  1149. end;
  1150. TIdStreamReadEvent = procedure(var VBuffer: TIdBytes; AOffset, ACount: Longint; var VResult: Longint) of object;
  1151. TIdStreamWriteEvent = procedure(const ABuffer: TIdBytes; AOffset, ACount: Longint; var VResult: Longint) of object;
  1152. TIdStreamSeekEvent = procedure(const AOffset: Int64; AOrigin: TSeekOrigin; var VPosition: Int64) of object;
  1153. TIdStreamSetSizeEvent = procedure(const ANewSize: Int64) of object;
  1154. TIdEventStream = class(TIdBaseStream)
  1155. protected
  1156. FOnRead: TIdStreamReadEvent;
  1157. FOnWrite: TIdStreamWriteEvent;
  1158. FOnSeek: TIdStreamSeekEvent;
  1159. FOnSetSize: TIdStreamSetSizeEvent;
  1160. function IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint; override;
  1161. function IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint; override;
  1162. function IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; override;
  1163. procedure IdSetSize(ASize: Int64); override;
  1164. public
  1165. property OnRead: TIdStreamReadEvent read FOnRead write FOnRead;
  1166. property OnWrite: TIdStreamWriteEvent read FOnWrite write FOnWrite;
  1167. property OnSeek: TIdStreamSeekEvent read FOnSeek write FOnSeek;
  1168. property OnSetSize: TIdStreamSetSizeEvent read FOnSetSize write FOnSetSize;
  1169. end;
  1170. {$IFNDEF DOTNET} // what is the .NET equivilent?
  1171. TIdMemoryBufferStream = class(TCustomMemoryStream)
  1172. public
  1173. constructor Create(APtr: Pointer; ASize: TIdNativeInt);
  1174. function Write(const Buffer; Count: Longint): Longint; override;
  1175. end;
  1176. TIdReadOnlyMemoryBufferStream = class(TIdMemoryBufferStream)
  1177. public
  1178. function Write(const Buffer; Count: Longint): Longint; override;
  1179. end;
  1180. {$ENDIF}
  1181. const
  1182. {$IFDEF UNIX}
  1183. GOSType = otUnix;
  1184. GPathDelim = '/'; {do not localize}
  1185. INFINITE = UInt32($FFFFFFFF); { Infinite timeout }
  1186. {$ENDIF}
  1187. {$IFDEF WINDOWS}
  1188. GOSType = otWindows;
  1189. GPathDelim = '\'; {do not localize}
  1190. Infinite = Windows.INFINITE; { redeclare here for use elsewhere without using Windows.pas } // cls modified 1/23/2002
  1191. {$ENDIF}
  1192. {$IFDEF DOTNET}
  1193. GOSType = otDotNet;
  1194. GPathDelim = '\'; {do not localize}
  1195. // Infinite = ?; { redeclare here for use elsewhere without using Windows.pas } // cls modified 1/23/2002
  1196. {$ENDIF}
  1197. // S.G. 4/9/2002: IP version general switch for defaults
  1198. {$IFDEF IdIPv6}
  1199. ID_DEFAULT_IP_VERSION = Id_IPv6;
  1200. {$ELSE}
  1201. ID_DEFAULT_IP_VERSION = Id_IPv4;
  1202. {$ENDIF}
  1203. {$IFNDEF HAS_sLineBreak}
  1204. {$IFDEF WINDOWS}
  1205. sLineBreak = CR + LF;
  1206. {$ELSE}
  1207. sLineBreak = LF;
  1208. {$ENDIF}
  1209. {$ENDIF}
  1210. //The power constants are for processing IP addresses
  1211. //They are powers of 255.
  1212. const
  1213. POWER_1 = $000000FF;
  1214. POWER_2 = $0000FFFF;
  1215. POWER_3 = $00FFFFFF;
  1216. POWER_4 = $FFFFFFFF;
  1217. // utility functions to calculate the usable length of a given buffer.
  1218. // If ALength is <0 then the actual Buffer length is returned,
  1219. // otherwise the minimum of the two lengths is returned instead.
  1220. function IndyLength(const ABuffer: String; const ALength: Integer = -1; const AIndex: Integer = 1): Integer; overload;
  1221. function IndyLength(const ABuffer: TIdBytes; const ALength: Integer = -1; const AIndex: Integer = 0): Integer; overload;
  1222. function IndyLength(const ABuffer: TStream; const ALength: TIdStreamSize = -1): TIdStreamSize; overload;
  1223. function IndyFormat(const AFormat: string; const Args: array of const): string;
  1224. function IndyIncludeTrailingPathDelimiter(const S: string): string;
  1225. function IndyExcludeTrailingPathDelimiter(const S: string): string;
  1226. procedure IndyRaiseLastError;
  1227. // This can only be called inside of an 'except' block! This is so that
  1228. // Exception.RaiseOuterException() (when available) can capture the current
  1229. // exception into the InnerException property of a new Exception that is
  1230. // being raised...
  1231. procedure IndyRaiseOuterException(AOuterException: Exception);
  1232. //You could possibly use the standard StrInt and StrIntDef but these
  1233. //also remove spaces from the string using the trim functions.
  1234. function IndyStrToInt(const S: string): Integer; overload;
  1235. function IndyStrToInt(const S: string; ADefault: Integer): Integer; overload;
  1236. function IndyFileAge(const AFileName: string): TDateTime;
  1237. function IndyDirectoryExists(const ADirectory: string): Boolean;
  1238. //You could possibly use the standard StrToInt and StrToInt64Def
  1239. //functions but these also remove spaces using the trim function
  1240. function IndyStrToInt64(const S: string; const ADefault: Int64): Int64; overload;
  1241. function IndyStrToInt64(const S: string): Int64; overload;
  1242. //This converts the string to an Integer or Int64 depending on the bit size TStream uses
  1243. function IndyStrToStreamSize(const S: string; const ADefault: TIdStreamSize): TIdStreamSize; overload;
  1244. function IndyStrToStreamSize(const S: string): TIdStreamSize; overload;
  1245. function AddMSecToTime(const ADateTime: TDateTime; const AMSec: Integer): TDateTime;
  1246. // To and From Bytes conversion routines
  1247. function ToBytes(const AValue: string; ADestEncoding: IIdTextEncoding = nil
  1248. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  1249. ): TIdBytes; overload;
  1250. function ToBytes(const AValue: string; const ALength: Integer; const AIndex: Integer = 1;
  1251. ADestEncoding: IIdTextEncoding = nil
  1252. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  1253. ): TIdBytes; overload;
  1254. function ToBytes(const AValue: Char; ADestEncoding: IIdTextEncoding = nil
  1255. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  1256. ): TIdBytes; overload;
  1257. function ToBytes(const AValue: Int8): TIdBytes; overload;
  1258. function ToBytes(const AValue: UInt8): TIdBytes; overload;
  1259. function ToBytes(const AValue: Int16): TIdBytes; overload;
  1260. function ToBytes(const AValue: UInt16): TIdBytes; overload;
  1261. function ToBytes(const AValue: Int32): TIdBytes; overload;
  1262. function ToBytes(const AValue: UInt32): TIdBytes; overload;
  1263. function ToBytes(const AValue: Int64): TIdBytes; overload;
  1264. function ToBytes(const AValue: TIdUInt64): TIdBytes; overload;
  1265. function ToBytes(const AValue: TIdBytes; const ASize: Integer; const AIndex: Integer = 0): TIdBytes; overload;
  1266. {$IFNDEF DOTNET}
  1267. // RLebeau - not using the same "ToBytes" naming convention for RawToBytes()
  1268. // in order to prevent ambiquious errors with ToBytes(TIdBytes) above
  1269. function RawToBytes(const AValue; const ASize: Integer): TIdBytes;
  1270. {$ENDIF}
  1271. // The following functions are faster but except that Bytes[] must have enough
  1272. // space for at least SizeOf(AValue) bytes.
  1273. procedure ToBytesF(var Bytes: TIdBytes; const AValue: Char; ADestEncoding: IIdTextEncoding = nil
  1274. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  1275. ); overload;
  1276. procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int8); overload;
  1277. procedure ToBytesF(var Bytes: TIdBytes; const AValue: UInt8); overload;
  1278. procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int16); overload;
  1279. procedure ToBytesF(var Bytes: TIdBytes; const AValue: UInt16); overload;
  1280. procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int32); overload;
  1281. procedure ToBytesF(var Bytes: TIdBytes; const AValue: UInt32); overload;
  1282. procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int64); overload;
  1283. procedure ToBytesF(var Bytes: TIdBytes; const AValue: TIdUInt64); overload;
  1284. procedure ToBytesF(var Bytes: TIdBytes; const AValue: TIdBytes; const ASize: Integer; const AIndex: Integer = 0); overload;
  1285. {$IFNDEF DOTNET}
  1286. // RLebeau - not using the same "ToBytesF" naming convention for RawToBytesF()
  1287. // in order to prevent ambiquious errors with ToBytesF(TIdBytes) above
  1288. procedure RawToBytesF(var Bytes: TIdBytes; const AValue; const ASize: Integer);
  1289. {$ENDIF}
  1290. function ToHex(const AValue: TIdBytes; const ACount: Integer = -1; const AIndex: Integer = 0): string; overload;
  1291. function ToHex(const AValue: array of UInt32): string; overload; // for IdHash
  1292. function BytesToString(const AValue: TIdBytes; AByteEncoding: IIdTextEncoding = nil
  1293. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1294. ): string; overload;
  1295. function BytesToString(const AValue: TIdBytes; const AStartIndex: Integer;
  1296. const ALength: Integer = -1; AByteEncoding: IIdTextEncoding = nil
  1297. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1298. ): string; overload;
  1299. // BytesToStringRaw() differs from BytesToString() in that it stores the
  1300. // byte octets as-is, whereas BytesToString() may decode character encodings
  1301. function BytesToStringRaw(const AValue: TIdBytes): string; overload;
  1302. function BytesToStringRaw(const AValue: TIdBytes; const AStartIndex: Integer;
  1303. const ALength: Integer = -1): string; overload;
  1304. function BytesToChar(const AValue: TIdBytes; const AIndex: Integer = 0;
  1305. AByteEncoding: IIdTextEncoding = nil
  1306. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1307. ): Char; overload;
  1308. function BytesToChar(const AValue: TIdBytes; var VChar: Char; const AIndex: Integer = 0;
  1309. AByteEncoding: IIdTextEncoding = nil
  1310. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1311. ): Integer; overload;
  1312. function BytesToInt16(const AValue: TIdBytes; const AIndex: Integer = 0): Int16;
  1313. function BytesToUInt16(const AValue: TIdBytes; const AIndex : Integer = 0): UInt16;
  1314. function BytesToInt32(const AValue: TIdBytes; const AIndex: Integer = 0): Int32;
  1315. function BytesToUInt32(const AValue: TIdBytes; const AIndex : Integer = 0): UInt32;
  1316. function BytesToInt64(const AValue: TIdBytes; const AIndex: Integer = 0): Int64;
  1317. function BytesToUInt64(const AValue: TIdBytes; const AIndex: Integer = 0): TIdUInt64;
  1318. function BytesToShort(const AValue: TIdBytes; const AIndex: Integer = 0): Int16; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use BytesToInt16()'{$ENDIF};{$ENDIF}
  1319. function BytesToWord(const AValue: TIdBytes; const AIndex : Integer = 0): UInt16; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use BytesToUInt16()'{$ENDIF};{$ENDIF}
  1320. function BytesToLongInt(const AValue: TIdBytes; const AIndex: Integer = 0): Int32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use BytesToInt32()'{$ENDIF};{$ENDIF}
  1321. function BytesToLongWord(const AValue: TIdBytes; const AIndex : Integer = 0): UInt32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use BytesToUInt32()'{$ENDIF};{$ENDIF}
  1322. function BytesToIPv4Str(const AValue: TIdBytes; const AIndex: Integer = 0): String;
  1323. procedure BytesToIPv6(const AValue: TIdBytes; var VAddress: TIdIPv6Address; const AIndex: Integer = 0);
  1324. function BytesToTicks(const AValue: TIdBytes; const AIndex: Integer = 0): TIdTicks;
  1325. {$IFNDEF DOTNET}
  1326. procedure BytesToRaw(const AValue: TIdBytes; var VBuffer; const ASize: Integer);
  1327. {$ENDIF}
  1328. // TIdBytes utilities
  1329. procedure AppendBytes(var VBytes: TIdBytes; const AToAdd: TIdBytes; const AIndex: Integer = 0; const ALength: Integer = -1);
  1330. procedure AppendByte(var VBytes: TIdBytes; const AByte: Byte);
  1331. procedure AppendString(var VBytes: TIdBytes; const AStr: String; const ALength: Integer = -1;
  1332. ADestEncoding: IIdTextEncoding = nil
  1333. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  1334. );
  1335. procedure ExpandBytes(var VBytes: TIdBytes; const AIndex: Integer; const ACount: Integer; const AFillByte: Byte = 0);
  1336. procedure InsertBytes(var VBytes: TIdBytes; const ADestIndex: Integer; const ASource: TIdBytes; const ASourceIndex: Integer = 0);
  1337. procedure InsertByte(var VBytes: TIdBytes; const AByte: Byte; const AIndex: Integer);
  1338. procedure RemoveBytes(var VBytes: TIdBytes; const ACount: Integer; const AIndex: Integer = 0);
  1339. // Common Streaming routines
  1340. function ReadLnFromStream(AStream: TStream; var VLine: String; AMaxLineLength: Integer = -1;
  1341. AByteEncoding: IIdTextEncoding = nil
  1342. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1343. ): Boolean; overload;
  1344. function ReadLnFromStream(AStream: TStream; AMaxLineLength: Integer = -1;
  1345. AExceptionIfEOF: Boolean = False; AByteEncoding: IIdTextEncoding = nil
  1346. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1347. ): string; overload;
  1348. function ReadStringFromStream(AStream: TStream; ASize: Integer = -1; AByteEncoding: IIdTextEncoding = nil
  1349. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1350. ): string; overload;
  1351. procedure WriteStringToStream(AStream: TStream; const AStr: string; ADestEncoding: IIdTextEncoding
  1352. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  1353. ); overload;
  1354. procedure WriteStringToStream(AStream: TStream; const AStr: string; const ALength: Integer = -1;
  1355. const AIndex: Integer = 1; ADestEncoding: IIdTextEncoding = nil
  1356. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  1357. ); overload;
  1358. function ReadCharFromStream(AStream: TStream; var VChar: Char; AByteEncoding: IIdTextEncoding = nil
  1359. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1360. ): Integer;
  1361. function ReadTIdBytesFromStream(const AStream: TStream; var ABytes: TIdBytes;
  1362. const Count: TIdStreamSize; const AIndex: Integer = 0): TIdStreamSize;
  1363. procedure WriteTIdBytesToStream(const AStream: TStream; const ABytes: TIdBytes;
  1364. const ASize: Integer = -1; const AIndex: Integer = 0);
  1365. function ByteToHex(const AByte: Byte): string;
  1366. function ByteToOctal(const AByte: Byte): string;
  1367. function UInt32ToHex(const ALongWord : UInt32) : String;
  1368. function LongWordToHex(const ALongWord : UInt32) : String; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use UInt32ToHex()'{$ENDIF};{$ENDIF}
  1369. procedure CopyTIdBytes(const ASource: TIdBytes; const ASourceIndex: Integer;
  1370. var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer);
  1371. procedure CopyTIdByteArray(const ASource: array of Byte; const ASourceIndex: Integer;
  1372. var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer);
  1373. procedure CopyTIdChar(const ASource: Char; var VDest: TIdBytes; const ADestIndex: Integer;
  1374. ADestEncoding: IIdTextEncoding = nil
  1375. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  1376. );
  1377. procedure CopyTIdInt16(const ASource: Int16; var VDest: TIdBytes; const ADestIndex: Integer);
  1378. procedure CopyTIdUInt16(const ASource: UInt16; var VDest: TIdBytes; const ADestIndex: Integer);
  1379. procedure CopyTIdInt32(const ASource: Int32; var VDest: TIdBytes; const ADestIndex: Integer);
  1380. procedure CopyTIdUInt32(const ASource: UInt32; var VDest: TIdBytes; const ADestIndex: Integer);
  1381. procedure CopyTIdInt64(const ASource: Int64; var VDest: TIdBytes; const ADestIndex: Integer);
  1382. procedure CopyTIdUInt64(const ASource: TIdUInt64; var VDest: TIdBytes; const ADestIndex: Integer);
  1383. procedure CopyTIdShort(const ASource: Int16; var VDest: TIdBytes; const ADestIndex: Integer); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use CopyTIdInt16()'{$ENDIF};{$ENDIF}
  1384. procedure CopyTIdWord(const ASource: UInt16; var VDest: TIdBytes; const ADestIndex: Integer); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use CopyTIdUInt16()'{$ENDIF};{$ENDIF}
  1385. procedure CopyTIdLongInt(const ASource: Int32; var VDest: TIdBytes; const ADestIndex: Integer); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use CopyTIdInt32()'{$ENDIF};{$ENDIF}
  1386. procedure CopyTIdLongWord(const ASource: UInt32; var VDest: TIdBytes; const ADestIndex: Integer); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use CopyTIdUInt32()'{$ENDIF};{$ENDIF}
  1387. procedure CopyTIdIPV6Address(const ASource: TIdIPv6Address; var VDest: TIdBytes; const ADestIndex: Integer);
  1388. procedure CopyTIdTicks(const ASource: TIdTicks; var VDest: TIdBytes; const ADestIndex: Integer);
  1389. procedure CopyTIdString(const ASource: String; var VDest: TIdBytes; const ADestIndex: Integer;
  1390. const ALength: Integer = -1; ADestEncoding: IIdTextEncoding = nil
  1391. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  1392. ); overload;
  1393. procedure CopyTIdString(const ASource: String; const ASourceIndex: Integer;
  1394. var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer = -1;
  1395. ADestEncoding: IIdTextEncoding = nil
  1396. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  1397. ); overload;
  1398. // Need to change prob not to use this set
  1399. function CharPosInSet(const AString: string; const ACharPos: Integer; const ASet: String): Integer; {$IFDEF STRING_IS_IMMUTABLE}overload;{$ENDIF}
  1400. function CharIsInSet(const AString: string; const ACharPos: Integer; const ASet: String): Boolean; {$IFDEF STRING_IS_IMMUTABLE}overload;{$ENDIF}
  1401. function CharIsInEOL(const AString: string; const ACharPos: Integer): Boolean; {$IFDEF STRING_IS_IMMUTABLE}overload;{$ENDIF}
  1402. function CharEquals(const AString: string; const ACharPos: Integer; const AValue: Char): Boolean; {$IFDEF STRING_IS_IMMUTABLE}overload;{$ENDIF}
  1403. {$IFDEF STRING_IS_IMMUTABLE}
  1404. function CharPosInSet(const ASB: TIdStringBuilder; const ACharPos: Integer; const ASet: String): Integer; overload;
  1405. function CharIsInSet(const ASB: TIdStringBuilder; const ACharPos: Integer; const ASet: String): Boolean; overload;
  1406. function CharIsInEOL(const ASB: TIdStringBuilder; const ACharPos: Integer): Boolean; overload;
  1407. function CharEquals(const ASB: TIdStringBuilder; const ACharPos: Integer; const AValue: Char): Boolean; overload;
  1408. {$ENDIF}
  1409. function ByteIndex(const AByte: Byte; const ABytes: TIdBytes; const AStartIndex: Integer = 0): Integer;
  1410. function ByteIdxInSet(const ABytes: TIdBytes; const AIndex: Integer; const ASet: TIdBytes): Integer;
  1411. function ByteIsInSet(const ABytes: TIdBytes; const AIndex: Integer; const ASet: TIdBytes): Boolean;
  1412. function ByteIsInEOL(const ABytes: TIdBytes; const AIndex: Integer): Boolean;
  1413. function CompareDate(const D1, D2: TDateTime): Integer;
  1414. function CurrentProcessId: TIdPID;
  1415. // RLebeau: the input of these functions must be in GMT
  1416. function DateTimeGMTToHttpStr(const GMTValue: TDateTime) : String;
  1417. function DateTimeGMTToCookieStr(const GMTValue: TDateTime; const AUseNetscapeFmt: Boolean = True) : String;
  1418. function DateTimeGMTToImapStr(const GMTValue: TDateTime) : String;
  1419. // RLebeau: the input of these functions must be in local time
  1420. function DateTimeToInternetStr(const Value: TDateTime; const AUseGMTStr: Boolean = False) : String; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use LocalDateTimeToGMT()'{$ENDIF};{$ENDIF}
  1421. function DateTimeToGmtOffSetStr(ADateTime: TDateTime; const AUseGMTStr: Boolean = False): string; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use UTCOffsetToStr()'{$ENDIF};{$ENDIF}
  1422. function LocalDateTimeToHttpStr(const Value: TDateTime) : String;
  1423. function LocalDateTimeToCookieStr(const Value: TDateTime; const AUseNetscapeFmt: Boolean = True) : String;
  1424. function LocalDateTimeToImapStr(const Value: TDateTime) : String;
  1425. function LocalDateTimeToGMT(const Value: TDateTime; const AUseGMTStr: Boolean = False) : String;
  1426. procedure DebugOutput(const AText: string);
  1427. function Fetch(var AInput: string; const ADelim: string = IdFetchDelimDefault;
  1428. const ADelete: Boolean = IdFetchDeleteDefault;
  1429. const ACaseSensitive: Boolean = IdFetchCaseSensitiveDefault): string;
  1430. function FetchCaseInsensitive(var AInput: string; const ADelim: string = IdFetchDelimDefault;
  1431. const ADelete: Boolean = IdFetchDeleteDefault): string;
  1432. // TODO: add an index parameter
  1433. procedure FillBytes(var VBytes : TIdBytes; const ACount : Integer; const AValue : Byte);
  1434. function CurrentThreadId: TIdThreadID;
  1435. function GetThreadHandle(AThread: TThread): TIdThreadHandle;
  1436. //GetTickDiff required because GetTickCount will wrap (IdICMP uses this)
  1437. function GetTickDiff(const AOldTickCount, ANewTickCount: UInt32): UInt32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use GetTickDiff64()'{$ENDIF};{$ENDIF}
  1438. function GetTickDiff64(const AOldTickCount, ANewTickCount: TIdTicks): TIdTicks;
  1439. // Most operations that use tick counters will never run anywhere near the
  1440. // 49.7 day limit that UInt32 imposes. If an operation really were to
  1441. // run that long, use GetElapsedTicks64()...
  1442. function GetElapsedTicks(const AOldTickCount: TIdTicks): UInt32;
  1443. function GetElapsedTicks64(const AOldTickCount: TIdTicks): TIdTicks;
  1444. procedure IdDelete(var s: string; AOffset, ACount: Integer);
  1445. procedure IdInsert(const Source: string; var S: string; Index: Integer);
  1446. {$IFNDEF DOTNET}
  1447. type
  1448. // TODO: use "array of Integer" instead?
  1449. {$IFDEF HAS_GENERICS_TList}
  1450. TIdPortList = TList<Integer>; // TODO: use TIdPort instead?
  1451. {$ELSE}
  1452. // TODO: flesh out to match TList<Integer> for non-Generics compilers
  1453. TIdPortList = TList;
  1454. {$ENDIF}
  1455. function IdPorts: TIdPortList;
  1456. {$ENDIF}
  1457. function iif(ATest: Boolean; const ATrue: Integer; const AFalse: Integer): Integer; overload;
  1458. function iif(ATest: Boolean; const ATrue: string; const AFalse: string = ''): string; overload; { do not localize }
  1459. function iif(ATest: Boolean; const ATrue: Boolean; const AFalse: Boolean): Boolean; overload;
  1460. function iif(const AEncoding, ADefEncoding: IIdTextEncoding; ADefEncodingType: IdTextEncodingType = encASCII): IIdTextEncoding; overload;
  1461. function InMainThread: Boolean;
  1462. function IPv6AddressToStr(const AValue: TIdIPv6Address): string;
  1463. //Note that there is NO need for Big Endian byte order functions because
  1464. //that's done through HostToNetwork byte order functions.
  1465. function HostToLittleEndian(const AValue : UInt16) : UInt16; overload;
  1466. function HostToLittleEndian(const AValue : UInt32): UInt32; overload;
  1467. function HostToLittleEndian(const AValue : Int32): Int32; overload;
  1468. function LittleEndianToHost(const AValue : UInt16) : UInt16; overload;
  1469. function LittleEndianToHost(const AValue : UInt32): UInt32; overload;
  1470. function LittleEndianToHost(const AValue : Int32): Int32; overload;
  1471. procedure WriteMemoryStreamToStream(Src: TMemoryStream; Dest: TStream; Count: TIdStreamSize);
  1472. {$IFNDEF DOTNET_EXCLUDE}
  1473. function IsCurrentThread(AThread: TThread): boolean;
  1474. {$ENDIF}
  1475. function IPv4ToUInt32(const AIPAddress: string): UInt32; overload;
  1476. function IPv4ToUInt32(const AIPAddress: string; var VErr: Boolean): UInt32; overload;
  1477. function IPv4ToDWord(const AIPAddress: string): UInt32; overload; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IPv4ToUInt32()'{$ENDIF};{$ENDIF}
  1478. function IPv4ToDWord(const AIPAddress: string; var VErr: Boolean): UInt32; overload; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IPv4ToUInt32()'{$ENDIF};{$ENDIF}
  1479. function IPv4ToHex(const AIPAddress: string; const ADotted: Boolean = False): string;
  1480. function IPv4ToOctal(const AIPAddress: string): string;
  1481. procedure IPv6ToIdIPv6Address(const AIPAddress: String; var VAddress: TIdIPv6Address); overload;
  1482. procedure IPv6ToIdIPv6Address(const AIPAddress: String; var VAddress: TIdIPv6Address; var VErr : Boolean); overload;
  1483. function IsAlpha(const AChar: Char): Boolean; overload;
  1484. function IsAlpha(const AString: String; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean; overload;
  1485. function IsAlphaNumeric(const AChar: Char): Boolean; overload;
  1486. function IsAlphaNumeric(const AString: String; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean; overload;
  1487. function IsASCII(const AByte: Byte): Boolean; overload;
  1488. function IsASCII(const ABytes: TIdBytes): Boolean; overload;
  1489. function IsASCIILDH(const AByte: Byte): Boolean; overload;
  1490. function IsASCIILDH(const ABytes: TIdBytes): Boolean; overload;
  1491. function IsHexidecimal(const AChar: Char): Boolean; overload;
  1492. function IsHexidecimal(const AString: string; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean; overload;
  1493. function IsNumeric(const AChar: Char): Boolean; overload;
  1494. function IsNumeric(const AString: string): Boolean; overload;
  1495. function IsNumeric(const AString: string; const ALength: Integer; const AIndex: Integer = 1): Boolean; overload;
  1496. function IsOctal(const AChar: Char): Boolean; overload;
  1497. function IsOctal(const AString: string; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean; overload;
  1498. {$IFNDEF DOTNET}
  1499. function InterlockedExchangeTHandle(var VTarget: THandle; const AValue: THandle): THandle;
  1500. function InterlockedExchangeTLibHandle(var VTarget: TIdLibHandle; const AValue: TIdLibHandle): TIdLibHandle;
  1501. function InterlockedCompareExchangePtr(var VTarget: Pointer; const AValue, Compare: Pointer): Pointer;
  1502. function InterlockedCompareExchangeObj(var VTarget: TObject; const AValue, Compare: TObject): TObject;
  1503. function InterlockedCompareExchangeIntf(var VTarget: IInterface; const AValue, Compare: IInterface): IInterface;
  1504. {$ENDIF}
  1505. function MakeCanonicalIPv4Address(const AAddr: string): string;
  1506. function MakeCanonicalIPv6Address(const AAddr: string): string;
  1507. function MakeUInt32IntoIPv4Address(const ADWord: UInt32): string;
  1508. function MakeDWordIntoIPv4Address(const ADWord: UInt32): string; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use MakeUInt32IntoIPv4Address()'{$ENDIF};{$ENDIF}
  1509. function IndyMin(const AValueOne, AValueTwo: Int64): Int64; overload;
  1510. function IndyMin(const AValueOne, AValueTwo: Int32): Int32; overload;
  1511. function IndyMin(const AValueOne, AValueTwo: UInt16): UInt16; overload;
  1512. function IndyMax(const AValueOne, AValueTwo: Int64): Int64; overload;
  1513. function IndyMax(const AValueOne, AValueTwo: Int32): Int32; overload;
  1514. function IndyMax(const AValueOne, AValueTwo: UInt16): UInt16; overload;
  1515. function IPv4MakeUInt32InRange(const AInt: Int64; const A256Power: Integer): UInt32;
  1516. function IPv4MakeLongWordInRange(const AInt: Int64; const A256Power: Integer): UInt32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IPv4MakeUInt32InRange()'{$ENDIF};{$ENDIF}
  1517. {$IFNDEF DOTNET}
  1518. {$IFDEF REGISTER_EXPECTED_MEMORY_LEAK}
  1519. function IndyRegisterExpectedMemoryLeak(AAddress: Pointer): Boolean;
  1520. {$ENDIF}
  1521. {$ENDIF}
  1522. {$IFDEF UNIX}
  1523. function HackLoad(const ALibName : String; const ALibVersions : array of String) : TIdLibHandle;
  1524. {$ENDIF}
  1525. {$IFNDEF DOTNET}
  1526. function MemoryPos(const ASubStr: string; MemBuff: PChar; MemorySize: Integer): Integer;
  1527. {$ENDIF}
  1528. // TODO: have OffsetFromUTC() return minutes as an integer instead, and
  1529. // then use DateUtils.IncMinutes() when adding the offset to a TDateTime...
  1530. function OffsetFromUTC: TDateTime;
  1531. function UTCOffsetToStr(const AOffset: TDateTime; const AUseGMTStr: Boolean = False): string;
  1532. function PosIdx(const ASubStr, AStr: string; AStartPos: UInt32 = 0): UInt32; //For "ignoreCase" use AnsiUpperCase
  1533. function PosInSmallIntArray(const ASearchInt: Int16; const AArray: array of Int16): Integer;
  1534. function PosInStrArray(const SearchStr: string; const Contents: array of string; const CaseSensitive: Boolean = True): Integer;
  1535. {$IFNDEF DOTNET}
  1536. function ServicesFilePath: string;
  1537. {$ENDIF}
  1538. procedure IndySetThreadPriority(AThread: TThread; const APriority: TIdThreadPriority; const APolicy: Integer = -MaxInt);
  1539. procedure SetThreadName(const AName: string; {$IFDEF DOTNET}AThread: System.Threading.Thread = nil{$ELSE}AThreadID: UInt32 = $FFFFFFFF{$ENDIF});
  1540. procedure IndySleep(ATime: UInt32);
  1541. // TODO: create TIdStringPositionList for non-Nextgen compilers...
  1542. {$IFDEF USE_OBJECT_ARC}
  1543. type
  1544. TIdStringPosition = record
  1545. Value: String;
  1546. Position: Integer;
  1547. constructor Create(const AValue: String; const APosition: Integer);
  1548. end;
  1549. TIdStringPositionList = TList<TIdStringPosition>;
  1550. {$ENDIF}
  1551. //For non-Nextgen compilers: Integer(TStrings.Objects[i]) = column position in AData
  1552. //For Nextgen compilers: use SplitDelimitedString() if column positions are needed
  1553. 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}
  1554. 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}
  1555. 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}
  1556. {$IFDEF USE_OBJECT_ARC}
  1557. procedure SplitDelimitedString(const AData: string; AStrings: TIdStringPositionList; ATrim: Boolean; const ADelim: string = ' '); overload; {Do not Localize}
  1558. {$ENDIF}
  1559. function StartsWithACE(const ABytes: TIdBytes): Boolean;
  1560. function StringsReplace(const S: String; const OldPattern, NewPattern: array of string): string;
  1561. function ReplaceAll(const S, OldPattern, NewPattern: string): string;
  1562. function ReplaceOnlyFirst(const S, OldPattern, NewPattern: string): string;
  1563. function TextIsSame(const A1, A2: string): Boolean;
  1564. function TextStartsWith(const S, SubS: string): Boolean;
  1565. function TextEndsWith(const S, SubS: string): Boolean;
  1566. function IndyUpperCase(const A1: string): string;
  1567. function IndyLowerCase(const A1: string): string;
  1568. function IndyCompareStr(const A1: string; const A2: string): Integer;
  1569. function Ticks: UInt32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use Ticks64()'{$ENDIF};{$ENDIF}
  1570. function Ticks64: TIdTicks;
  1571. procedure ToDo(const AMsg: string);
  1572. function TwoByteToUInt16(AByte1, AByte2: Byte): UInt16;
  1573. function TwoByteToWord(AByte1, AByte2: Byte): UInt16; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use TwoByteToUInt16()'{$ENDIF};{$ENDIF}
  1574. function IndyAddPair(AStrings: TStrings; const AName, AValue: String): TStrings; overload;
  1575. function IndyAddPair(AStrings: TStrings; const AName, AValue: String; AObject: TObject): TStrings; overload;
  1576. function IndyIndexOf(AStrings: TStrings; const AStr: string; const ACaseSensitive: Boolean = False): Integer;{$IFDEF HAS_TStringList_CaseSensitive} overload;{$ENDIF}
  1577. {$IFDEF HAS_TStringList_CaseSensitive}
  1578. function IndyIndexOf(AStrings: TStringList; const AStr: string; const ACaseSensitive: Boolean = False): Integer; overload;
  1579. {$ENDIF}
  1580. function IndyIndexOfName(AStrings: TStrings; const AName: string; const ACaseSensitive: Boolean = False): Integer;{$IFDEF HAS_TStringList_CaseSensitive} overload;{$ENDIF}
  1581. {$IFDEF HAS_TStringList_CaseSensitive}
  1582. function IndyIndexOfName(AStrings: TStringList; const AName: string; const ACaseSensitive: Boolean = False): Integer; overload;
  1583. {$ENDIF}
  1584. function IndyValueFromIndex(AStrings: TStrings; const AIndex: Integer): String;
  1585. {$IFDEF WINDOWS}
  1586. function IndyWindowsMajorVersion: Integer;
  1587. function IndyWindowsMinorVersion: Integer;
  1588. function IndyWindowsBuildNumber: Integer;
  1589. function IndyWindowsPlatform: Integer;
  1590. function IndyCheckWindowsVersion(const AMajor: Integer; const AMinor: Integer = 0): Boolean;
  1591. {$ENDIF}
  1592. // For non-Nextgen compilers: IdDisposeAndNil is the same as FreeAndNil()
  1593. // For Nextgen compilers: IdDisposeAndNil calls TObject.DisposeOf() to ensure
  1594. // the object is freed immediately even if it has active references to it,
  1595. // for instance when freeing an Owned component
  1596. procedure IdDisposeAndNil(var Obj); {$IFDEF USE_INLINE}inline;{$ENDIF}
  1597. //RLebeau: FPC does not provide mach_timebase_info() and mach_absolute_time() yet...
  1598. {$IFDEF UNIX}
  1599. {$IFDEF OSX}
  1600. {$IFDEF FPC}
  1601. type
  1602. TTimebaseInfoData = record
  1603. numer: UInt32;
  1604. denom: UInt32;
  1605. end;
  1606. {$ENDIF}
  1607. {$ENDIF}
  1608. {$ENDIF}
  1609. var
  1610. {$IFDEF UNIX}
  1611. // For linux the user needs to set this variable to be accurate where used (mail, etc)
  1612. GOffsetFromUTC: TDateTime = 0{$IFDEF HAS_DEPRECATED}{$IFDEF USE_SEMICOLON_BEFORE_DEPRECATED};{$ENDIF} deprecated{$ENDIF};
  1613. {$IFDEF OSX}
  1614. GMachTimeBaseInfo: TTimebaseInfoData;
  1615. {$ENDIF}
  1616. {$ENDIF}
  1617. IndyPos: TPosProc = nil;
  1618. {$IFDEF UNIX}
  1619. {$UNDEF OSX_OR_IOS}
  1620. {$IFDEF OSX}
  1621. {$DEFINE OSX_OR_IOS}
  1622. {$ENDIF}
  1623. {$IFDEF IOS}
  1624. {$DEFINE OSX_OR_IOS}
  1625. {$ENDIF}
  1626. {$ENDIF}
  1627. {$IFDEF UNIX}
  1628. const
  1629. {$IFDEF HAS_SharedSuffix}
  1630. LIBEXT = '.' + SharedSuffix; {do not localize}
  1631. {$ELSE}
  1632. {$IFDEF OSX_OR_IOS}
  1633. LIBEXT = '.dylib'; {do not localize}
  1634. {$ELSE}
  1635. LIBEXT = '.so'; {do not localize}
  1636. {$ENDIF}
  1637. {$ENDIF}
  1638. {$ENDIF}
  1639. implementation
  1640. {$IFDEF UNIX}
  1641. {$IFDEF LINUX}
  1642. {$DEFINE USE_clock_gettime}
  1643. {$IFDEF FPC}
  1644. {$linklib rt}
  1645. {$ENDIF}
  1646. {$ENDIF}
  1647. {$IFDEF FREEBSD}
  1648. {$DEFINE USE_clock_gettime}
  1649. {$ENDIF}
  1650. {$ENDIF}
  1651. {$IFDEF ANDROID}
  1652. {$DEFINE USE_clock_gettime}
  1653. {$ENDIF}
  1654. uses
  1655. {$IFDEF USE_VCL_POSIX}
  1656. Posix.SysSelect,
  1657. Posix.SysSocket,
  1658. Posix.Time,
  1659. Posix.SysTime,
  1660. {$ENDIF}
  1661. {$IFDEF USE_VCL_POSIX}
  1662. {$IFDEF OSX}
  1663. Macapi.CoreServices,
  1664. {$ENDIF}
  1665. {$ENDIF}
  1666. {$IFDEF REGISTER_EXPECTED_MEMORY_LEAK}
  1667. {$IFNDEF HAS_System_RegisterExpectedMemoryLeak}
  1668. {$IFDEF USE_FASTMM4}FastMM4,{$ENDIF}
  1669. {$IFDEF USE_MADEXCEPT}madExcept,{$ENDIF}
  1670. {$IFDEF USE_LEAKCHECK}LeakCheck,{$ENDIF}
  1671. {$ENDIF}
  1672. {$ENDIF}
  1673. {$IFDEF USE_LIBC}Libc,{$ENDIF}
  1674. {$IFDEF HAS_UNIT_DateUtils}DateUtils,{$ENDIF}
  1675. //do not bring in our IdIconv unit if we are using the libc unit directly.
  1676. {$IFDEF USE_ICONV_UNIT}IdIconv, {$ENDIF}
  1677. IdResourceStrings,
  1678. IdStream,
  1679. {$IFDEF DOTNET}
  1680. IdStreamNET
  1681. {$ELSE}
  1682. IdStreamVCL
  1683. {$ENDIF}
  1684. {$IFDEF HAS_PosEx}
  1685. {$IFDEF HAS_UNIT_StrUtils}
  1686. ,StrUtils
  1687. {$ENDIF}
  1688. {$ENDIF}
  1689. ;
  1690. {$IFDEF FPC}
  1691. {$IFDEF WINCE}
  1692. //FreePascal for WindowsCE may not define these.
  1693. const
  1694. CP_UTF7 = 65000;
  1695. CP_UTF8 = 65001;
  1696. {$ENDIF}
  1697. {$ENDIF}
  1698. {$IFDEF REGISTER_EXPECTED_MEMORY_LEAK}
  1699. {$IFNDEF HAS_System_RegisterExpectedMemoryLeak}
  1700. {$IFDEF USE_FASTMM4}
  1701. // RLebeau 7/5/2018: Prior to Delphi 2009+, FastMM manually defines several of
  1702. // Delphi's native types. Most importantly, it defines PByte, which then causes
  1703. // problems for IIdTextEncoding implementations below. So, lets make sure that
  1704. // our definitions below are using the same RTL types that their declarations
  1705. // above were using, and not use FastMM's types by mistake, otherwise we get
  1706. // compiler errors!
  1707. type
  1708. PByte = System.PByte;
  1709. //NativeInt = System.NativeInt;
  1710. //NativeUInt = System.NativeUInt;
  1711. //PNativeUInt = System.PNativeUInt;
  1712. {$IFDEF DOTNET}
  1713. IntPtr = System.IntPtr;
  1714. {$ENDIF}
  1715. //UIntPtr = System.UIntPtr;
  1716. {$ENDIF}
  1717. {$ENDIF}
  1718. {$ENDIF}
  1719. procedure EnsureEncoding(var VEncoding : IIdTextEncoding; ADefEncoding: IdTextEncodingType = encIndyDefault);
  1720. {$IFDEF USE_INLINE}inline;{$ENDIF}
  1721. begin
  1722. if VEncoding = nil then begin
  1723. VEncoding := IndyTextEncoding(ADefEncoding);
  1724. end;
  1725. end;
  1726. procedure CheckByteEncoding(var VBytes: TIdBytes; ASrcEncoding, ADestEncoding: IIdTextEncoding);
  1727. begin
  1728. if ASrcEncoding <> ADestEncoding then begin
  1729. VBytes := ADestEncoding.GetBytes(ASrcEncoding.GetChars(VBytes));
  1730. end;
  1731. end;
  1732. {$IFNDEF WINDOWS}
  1733. //FreePascal may not define this for non-Windows systems.
  1734. //#define MAKEWORD(a, b) ((WORD)(((BYTE)(a)) | ((WORD)((BYTE)(b))) << 8))
  1735. function MakeWord(const a, b : Byte) : Word;
  1736. {$IFDEF USE_INLINE}inline;{$ENDIF}
  1737. begin
  1738. Result := Word(a) or (Word(b) shl 8);
  1739. end;
  1740. {$ENDIF}
  1741. {$IFNDEF DOTNET}
  1742. var
  1743. // TODO: use "array of Integer" instead?
  1744. GIdPorts: TIdPortList = nil;
  1745. GIdOSDefaultEncoding: IIdTextEncoding = nil;
  1746. GId8BitEncoding: IIdTextEncoding = nil;
  1747. GIdASCIIEncoding: IIdTextEncoding = nil;
  1748. GIdUTF16BigEndianEncoding: IIdTextEncoding = nil;
  1749. GIdUTF16LittleEndianEncoding: IIdTextEncoding = nil;
  1750. GIdUTF7Encoding: IIdTextEncoding = nil;
  1751. GIdUTF8Encoding: IIdTextEncoding = nil;
  1752. {$ENDIF}
  1753. { IIdTextEncoding implementations }
  1754. {$IFDEF DOTNET}
  1755. type
  1756. TIdDotNetEncoding = class(TInterfacedObject, IIdTextEncoding)
  1757. protected
  1758. FEncoding: System.Text.Encoding;
  1759. public
  1760. constructor Create(AEncoding: System.Text.Encoding); overload;
  1761. constructor Create(const ACharset: String); overload;
  1762. constructor Create(const ACodepage: UInt16); overload;
  1763. function GetByteCount(const AChars: TIdWideChars): Integer; overload;
  1764. function GetByteCount(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): Integer; overload;
  1765. function GetByteCount(const AStr: TIdUnicodeString): Integer; overload;
  1766. function GetByteCount(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): Integer; overload;
  1767. function GetBytes(const AChars: TIdWideChars): TIdBytes; overload;
  1768. function GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): TIdBytes; overload;
  1769. function GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
  1770. function GetBytes(const AStr: TIdUnicodeString): TIdBytes; overload;
  1771. function GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): TIdBytes; overload;
  1772. function GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
  1773. function GetCharCount(const ABytes: TIdBytes): Integer; overload;
  1774. function GetCharCount(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): Integer; overload;
  1775. function GetChars(const ABytes: TIdBytes): TIdWideChars; overload;
  1776. function GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdWideChars; overload;
  1777. function GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer; overload;
  1778. function GetIsSingleByte: Boolean;
  1779. function GetMaxByteCount(ACharCount: Integer): Integer;
  1780. function GetMaxCharCount(AByteCount: Integer): Integer;
  1781. function GetPreamble: TIdBytes;
  1782. function GetString(const ABytes: TIdBytes): TIdUnicodeString; overload;
  1783. function GetString(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdUnicodeString; overload;
  1784. end;
  1785. constructor TIdDotNetEncoding.Create(AEncoding: System.Text.Encoding);
  1786. begin
  1787. inherited Create;
  1788. FEncoding := AEncoding;
  1789. end;
  1790. constructor TIdDotNetEncoding.Create(const ACharset: String);
  1791. begin
  1792. inherited Create;
  1793. // RLebeau 5/2/2017: have seen some malformed emails that use 'utf8'
  1794. // instead of 'utf-8', so let's check for that...
  1795. // RLebeau 9/27/2017: updating to handle a few more UTFs without hyphens...
  1796. case PosInStrArray(ACharset, ['UTF7', 'UTF8', 'UTF16', 'UTF16LE', 'UTF16BE', 'UTF32', 'UTF32LE', 'UTF32BE'], False) of {Do not Localize}
  1797. 0: FEncoding := System.Text.Encoding.UTF7;
  1798. 1: FEncoding := System.Text.Encoding.UTF8;
  1799. 2,3: FEncoding := System.Text.Encoding.Unicode;
  1800. 4: FEncoding := System.Text.Encoding.BigEndianUnicode;
  1801. 5,6: FEncoding := System.Text.Encoding.UTF32;
  1802. 7: FEncoding := System.Text.Encoding.GetEncoding(12001);
  1803. else
  1804. FEncoding := System.Text.Encoding.GetEncoding(ACharset);
  1805. end;
  1806. end;
  1807. constructor TIdDotNetEncoding.Create(const ACodepage: UInt16);
  1808. begin
  1809. inherited Create;
  1810. FEncoding := System.Text.Encoding.GetEncoding(ACodepage);
  1811. end;
  1812. function TIdDotNetEncoding.GetByteCount(const AChars: TIdWideChars): Integer;
  1813. begin
  1814. Result := FEncoding.GetByteCount(AChars);
  1815. end;
  1816. function TIdDotNetEncoding.GetByteCount(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): Integer;
  1817. begin
  1818. Result := FEncoding.GetByteCount(AChars, ACharIndex, ACharCount);
  1819. end;
  1820. function TIdDotNetEncoding.GetByteCount(const AStr: TIdUnicodeString): Integer;
  1821. begin
  1822. Result := FEncoding.GetByteCount(AStr);
  1823. end;
  1824. function TIdDotNetEncoding.GetByteCount(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): Integer;
  1825. begin
  1826. Result := FEncoding.GetByteCount(AStr.Substring(ACharIndex-1, ACharCount));
  1827. end;
  1828. function TIdDotNetEncoding.GetBytes(const AChars: TIdWideChars): TIdBytes;
  1829. begin
  1830. Result := FEncoding.GetBytes(AChars);
  1831. end;
  1832. function TIdDotNetEncoding.GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): TIdBytes;
  1833. begin
  1834. Result := FEncoding.GetBytes(AChars, ACharIndex, ACharCount);
  1835. end;
  1836. function TIdDotNetEncoding.GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer;
  1837. begin
  1838. Result := FEncoding.GetBytes(AChars, ACharIndex, ACharCount, VBytes, AByteIndex);
  1839. end;
  1840. function TIdDotNetEncoding.GetBytes(const AStr: TIdUnicodeString): TIdBytes;
  1841. begin
  1842. Result := FEncoding.GetBytes(AStr);
  1843. end;
  1844. function TIdDotNetEncoding.GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): TIdBytes;
  1845. begin
  1846. Result := FEncoding.GetByteCount(AStr.Substring(ACharIndex-1, ACharCount));
  1847. end;
  1848. function TIdDotNetEncoding.GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer;
  1849. begin
  1850. Result := FEncoding.GetBytes(AStr, ACharIndex-1, ACharCount, VBytes, AByteIndex);
  1851. end;
  1852. function TIdDotNetEncoding.GetCharCount(const ABytes: TIdBytes): Integer;
  1853. begin
  1854. Result := FEncoding.GetCharCount(ABytes);
  1855. end;
  1856. function TIdDotNetEncoding.GetCharCount(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): Integer;
  1857. begin
  1858. Result := FEncoding.GetCharCount(ABytes, AByteIndex, AByteCount);
  1859. end;
  1860. function TIdDotNetEncoding.GetChars(const ABytes: TIdBytes): TIdWideChars;
  1861. begin
  1862. Result := FEncoding.GetChars(ABytes);
  1863. end;
  1864. function TIdDotNetEncoding.GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdWideChars;
  1865. begin
  1866. Result := FEncoding.GetChars(ABytes, AByteIndex, AByteCount);
  1867. end;
  1868. function TIdDotNetEncoding.GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer;
  1869. begin
  1870. Result := FEncoding.GetChars(ABytes, AByteIndex, AByteCount, VChars, ACharIndex);
  1871. end;
  1872. function TIdDotNetEncoding.GetIsSingleByte: Boolean;
  1873. begin
  1874. Result := FEncoding.IsSingleByte;
  1875. end;
  1876. function TIdDotNetEncoding.GetMaxByteCount(ACharCount: Integer): Integer;
  1877. begin
  1878. Result := FEncoding.GetMaxByteCount(ACharCount);
  1879. end;
  1880. function TIdDotNetEncoding.GetMaxCharCount(AByteCount: Integer): Integer;
  1881. begin
  1882. Result := FEncoding.GetMaxCharCount(AByteCount);
  1883. end;
  1884. function TIdDotNetEncoding.GetPreamble: TIdBytes;
  1885. begin
  1886. Result := fEncoding.GetPreamble;
  1887. end;
  1888. function TIdDotNetEncoding.GetString(const ABytes: TIdBytes): TIdUnicodeString;
  1889. begin
  1890. Result := FEncoding.GetString(ABytes);
  1891. end;
  1892. function TIdDotNetEncoding.GetString(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdUnicodeString;
  1893. begin
  1894. Result := FEncoding.GetString(ABytes, AByteIndex, AByteCount);
  1895. end;
  1896. {$ELSE}
  1897. type
  1898. TIdTextEncodingBase = class(TInterfacedObject, IIdTextEncoding)
  1899. protected
  1900. FIsSingleByte: Boolean;
  1901. FMaxCharSize: Integer;
  1902. public
  1903. function GetByteCount(const AChars: TIdWideChars): Integer; overload;
  1904. function GetByteCount(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): Integer; overload;
  1905. function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; overload; virtual; abstract;
  1906. function GetByteCount(const AStr: TIdUnicodeString): Integer; overload;
  1907. function GetByteCount(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): Integer; overload;
  1908. function GetBytes(const AChars: TIdWideChars): TIdBytes; overload;
  1909. function GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): TIdBytes; overload;
  1910. function GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
  1911. function GetBytes(const AChars: PIdWideChar; ACharCount: Integer): TIdBytes; overload;
  1912. function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
  1913. function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; overload; virtual; abstract;
  1914. function GetBytes(const AStr: TIdUnicodeString): TIdBytes; overload;
  1915. function GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): TIdBytes; overload;
  1916. function GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
  1917. function GetCharCount(const ABytes: TIdBytes): Integer; overload;
  1918. function GetCharCount(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): Integer; overload;
  1919. function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; overload; virtual; abstract;
  1920. function GetChars(const ABytes: TIdBytes): TIdWideChars; overload;
  1921. function GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdWideChars; overload;
  1922. function GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer; overload;
  1923. function GetChars(const ABytes: PByte; AByteCount: Integer): TIdWideChars; overload;
  1924. function GetChars(const ABytes: PByte; AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer; overload;
  1925. function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; overload; virtual; abstract;
  1926. function GetIsSingleByte: Boolean;
  1927. function GetMaxByteCount(ACharCount: Integer): Integer; virtual; abstract;
  1928. function GetMaxCharCount(AByteCount: Integer): Integer; virtual; abstract;
  1929. function GetPreamble: TIdBytes; virtual;
  1930. function GetString(const ABytes: TIdBytes): TIdUnicodeString; overload;
  1931. function GetString(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdUnicodeString; overload;
  1932. function GetString(const ABytes: PByte; AByteCount: Integer): TIdUnicodeString; overload;
  1933. end;
  1934. {$UNDEF SUPPORTS_CODEPAGE_ENCODING}
  1935. {$IFNDEF USE_ICONV}
  1936. {$IFDEF WINDOWS}
  1937. {$DEFINE SUPPORTS_CODEPAGE_ENCODING}
  1938. {$ENDIF}
  1939. {$IFDEF HAS_LocaleCharsFromUnicode}
  1940. {$DEFINE SUPPORTS_CODEPAGE_ENCODING}
  1941. {$ENDIF}
  1942. {$ENDIF}
  1943. TIdMBCSEncoding = class(TIdTextEncodingBase)
  1944. private
  1945. {$IFDEF USE_ICONV}
  1946. FCharSet: String;
  1947. {$ELSE}
  1948. {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
  1949. FCodePage: UInt32;
  1950. FMBToWCharFlags: UInt32;
  1951. FWCharToMBFlags: UInt32;
  1952. {$ENDIF}
  1953. {$ENDIF}
  1954. public
  1955. constructor Create; overload; virtual;
  1956. {$IFDEF USE_ICONV}
  1957. constructor Create(const CharSet: String); overload; virtual;
  1958. {$ELSE}
  1959. {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
  1960. constructor Create(CodePage: Integer); overload; virtual;
  1961. constructor Create(CodePage, MBToWCharFlags, WCharToMBFlags: Integer); overload; virtual;
  1962. {$ENDIF}
  1963. {$ENDIF}
  1964. function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; overload; override;
  1965. function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; overload; override;
  1966. function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; overload; override;
  1967. function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; overload; override;
  1968. function GetMaxByteCount(CharCount: Integer): Integer; override;
  1969. function GetMaxCharCount(ByteCount: Integer): Integer; override;
  1970. function GetPreamble: TIdBytes; override;
  1971. end;
  1972. TIdUTF7Encoding = class(TIdMBCSEncoding)
  1973. public
  1974. constructor Create; override;
  1975. function GetMaxByteCount(CharCount: Integer): Integer; override;
  1976. function GetMaxCharCount(ByteCount: Integer): Integer; override;
  1977. end;
  1978. TIdUTF8Encoding = class(TIdMBCSEncoding)
  1979. public
  1980. constructor Create; override;
  1981. function GetMaxByteCount(CharCount: Integer): Integer; override;
  1982. function GetMaxCharCount(ByteCount: Integer): Integer; override;
  1983. function GetPreamble: TIdBytes; override;
  1984. end;
  1985. TIdUTF16LittleEndianEncoding = class(TIdTextEncodingBase)
  1986. public
  1987. constructor Create; virtual;
  1988. function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; overload; override;
  1989. function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; overload; override;
  1990. function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; overload; override;
  1991. function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; overload; override;
  1992. function GetMaxByteCount(CharCount: Integer): Integer; override;
  1993. function GetMaxCharCount(ByteCount: Integer): Integer; override;
  1994. function GetPreamble: TIdBytes; override;
  1995. end;
  1996. TIdUTF16BigEndianEncoding = class(TIdUTF16LittleEndianEncoding)
  1997. public
  1998. function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; overload; override;
  1999. function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; overload; override;
  2000. function GetPreamble: TIdBytes; override;
  2001. end;
  2002. TIdASCIIEncoding = class(TIdTextEncodingBase)
  2003. public
  2004. constructor Create; virtual;
  2005. function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; override;
  2006. function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; override;
  2007. function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; override;
  2008. function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; override;
  2009. function GetMaxByteCount(ACharCount: Integer): Integer; override;
  2010. function GetMaxCharCount(AByteCount: Integer): Integer; override;
  2011. end;
  2012. TId8BitEncoding = class(TIdTextEncodingBase)
  2013. public
  2014. constructor Create; virtual;
  2015. function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; override;
  2016. function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; override;
  2017. function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; override;
  2018. function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; override;
  2019. function GetMaxByteCount(ACharCount: Integer): Integer; override;
  2020. function GetMaxCharCount(AByteCount: Integer): Integer; override;
  2021. end;
  2022. {$IFDEF HAS_TEncoding}
  2023. TIdVCLEncoding = class(TIdTextEncodingBase)
  2024. protected
  2025. FEncoding: TEncoding;
  2026. FFreeEncoding: Boolean;
  2027. public
  2028. constructor Create(AEncoding: TEncoding; AFreeEncoding: Boolean); overload;
  2029. {$IFDEF HAS_TEncoding_GetEncoding_ByEncodingName}
  2030. constructor Create(const ACharset: String); overload;
  2031. {$ENDIF}
  2032. constructor Create(const ACodepage: UInt16); overload;
  2033. destructor Destroy; override;
  2034. function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; override;
  2035. function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; override;
  2036. function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; override;
  2037. function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; override;
  2038. function GetMaxByteCount(ACharCount: Integer): Integer; override;
  2039. function GetMaxCharCount(AByteCount: Integer): Integer; override;
  2040. end;
  2041. {$ENDIF}
  2042. { TIdTextEncodingBase }
  2043. function ValidateChars(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): PIdWideChar;
  2044. var
  2045. Len: Integer;
  2046. begin
  2047. Len := Length(AChars);
  2048. if (ACharIndex < 0) or (ACharIndex >= Len) then begin
  2049. raise Exception.CreateResFmt(PResStringRec(@RSCharIndexOutOfBounds), [ACharIndex]);
  2050. end;
  2051. if ACharCount < 0 then begin
  2052. raise Exception.CreateResFmt(PResStringRec(@RSInvalidCharCount), [ACharCount]);
  2053. end;
  2054. if (Len - ACharIndex) < ACharCount then begin
  2055. raise Exception.CreateResFmt(PResStringRec(@RSInvalidCharCount), [ACharCount]);
  2056. end;
  2057. if ACharCount > 0 then begin
  2058. Result := @AChars[ACharIndex];
  2059. end else begin
  2060. Result := nil;
  2061. end;
  2062. end;
  2063. function ValidateBytes(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): PByte; overload;
  2064. var
  2065. Len: Integer;
  2066. begin
  2067. Len := Length(ABytes);
  2068. if (AByteIndex < 0) or (AByteIndex >= Len) then begin
  2069. raise Exception.CreateResFmt(PResStringRec(@RSInvalidDestinationIndex), [AByteIndex]);
  2070. end;
  2071. if (Len - AByteIndex) < AByteCount then begin
  2072. raise Exception.CreateRes(PResStringRec(@RSInvalidDestinationArray));
  2073. end;
  2074. if AByteCount > 0 then begin
  2075. Result := @ABytes[AByteIndex];
  2076. end else begin
  2077. Result := nil;
  2078. end;
  2079. end;
  2080. function ValidateBytes(const ABytes: TIdBytes; AByteIndex, AByteCount, ANeeded: Integer): PByte; overload;
  2081. var
  2082. Len: Integer;
  2083. begin
  2084. Len := Length(ABytes);
  2085. if (AByteIndex < 0) or (AByteIndex >= Len) then begin
  2086. raise Exception.CreateResFmt(PResStringRec(@RSInvalidDestinationIndex), [AByteIndex]);
  2087. end;
  2088. if (Len - AByteIndex) < ANeeded then begin
  2089. raise Exception.CreateRes(PResStringRec(@RSInvalidDestinationArray));
  2090. end;
  2091. if AByteCount > 0 then begin
  2092. Result := @ABytes[AByteIndex];
  2093. end else begin
  2094. Result := nil;
  2095. end;
  2096. end;
  2097. function ValidateStr(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): PIdWideChar;
  2098. begin
  2099. if ACharIndex < 1 then begin
  2100. raise Exception.CreateResFmt(PResStringRec(@RSCharIndexOutOfBounds), [ACharIndex]);
  2101. end;
  2102. if ACharCount < 0 then begin
  2103. raise Exception.CreateResFmt(PResStringRec(@RSInvalidCharCount), [ACharCount]);
  2104. end;
  2105. if (Length(AStr) - ACharIndex + 1) < ACharCount then begin
  2106. raise Exception.CreateResFmt(PResStringRec(@RSInvalidCharCount), [ACharCount]);
  2107. end;
  2108. if ACharCount > 0 then begin
  2109. Result := @AStr[ACharIndex];
  2110. end else begin
  2111. Result := nil;
  2112. end;
  2113. end;
  2114. function TIdTextEncodingBase.GetByteCount(const AChars: TIdWideChars): Integer;
  2115. begin
  2116. if AChars <> nil then begin
  2117. Result := GetByteCount(PIdWideChar(AChars), Length(AChars));
  2118. end else begin
  2119. Result := 0;
  2120. end;
  2121. end;
  2122. function TIdTextEncodingBase.GetByteCount(const AChars: TIdWideChars;
  2123. ACharIndex, ACharCount: Integer): Integer;
  2124. var
  2125. LChars: PIdWideChar;
  2126. begin
  2127. LChars := ValidateChars(AChars, ACharIndex, ACharCount);
  2128. if LChars <> nil then begin
  2129. Result := GetByteCount(LChars, ACharCount);
  2130. end else begin
  2131. Result := 0;
  2132. end;
  2133. end;
  2134. function TIdTextEncodingBase.GetByteCount(const AStr: TIdUnicodeString): Integer;
  2135. begin
  2136. if AStr <> '' then begin
  2137. Result := GetByteCount(PIdWideChar(AStr), Length(AStr));
  2138. end else begin
  2139. Result := 0;
  2140. end;
  2141. end;
  2142. function TIdTextEncodingBase.GetByteCount(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): Integer;
  2143. var
  2144. LChars: PIdWideChar;
  2145. begin
  2146. LChars := ValidateStr(AStr, ACharIndex, ACharCount);
  2147. if LChars <> nil then begin
  2148. Result := GetByteCount(LChars, ACharCount);
  2149. end else begin
  2150. Result := 0;
  2151. end;
  2152. end;
  2153. function TIdTextEncodingBase.GetBytes(const AChars: TIdWideChars): TIdBytes;
  2154. begin
  2155. if AChars <> nil then begin
  2156. Result := GetBytes(PIdWideChar(AChars), Length(AChars));
  2157. end else begin
  2158. Result := nil;
  2159. end;
  2160. end;
  2161. function TIdTextEncodingBase.GetBytes(const AChars: TIdWideChars;
  2162. ACharIndex, ACharCount: Integer): TIdBytes;
  2163. var
  2164. Len: Integer;
  2165. begin
  2166. Result := nil;
  2167. Len := GetByteCount(AChars, ACharIndex, ACharCount);
  2168. if Len > 0 then begin
  2169. SetLength(Result, Len);
  2170. GetBytes(@AChars[ACharIndex], ACharCount, PByte(Result), Len);
  2171. end;
  2172. end;
  2173. function TIdTextEncodingBase.GetBytes(const AChars: TIdWideChars;
  2174. ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer;
  2175. begin
  2176. Result := GetBytes(
  2177. ValidateChars(AChars, ACharIndex, ACharCount),
  2178. ACharCount, VBytes, AByteIndex);
  2179. end;
  2180. function TIdTextEncodingBase.GetBytes(const AChars: PIdWideChar; ACharCount: Integer): TIdBytes;
  2181. var
  2182. Len: Integer;
  2183. begin
  2184. Result := nil;
  2185. Len := GetByteCount(AChars, ACharCount);
  2186. if Len > 0 then begin
  2187. SetLength(Result, Len);
  2188. GetBytes(AChars, ACharCount, PByte(Result), Len);
  2189. end;
  2190. end;
  2191. function TIdTextEncodingBase.GetBytes(const AChars: PIdWideChar; ACharCount: Integer;
  2192. var VBytes: TIdBytes; AByteIndex: Integer): Integer;
  2193. var
  2194. Len, LByteCount: Integer;
  2195. LBytes: PByte;
  2196. begin
  2197. if (AChars = nil) and (ACharCount <> 0) then begin
  2198. raise Exception.CreateRes(PResStringRec(@RSInvalidSourceArray));
  2199. end;
  2200. if (VBytes = nil) and (ACharCount <> 0) then begin
  2201. raise Exception.CreateRes(PResStringRec(@RSInvalidDestinationArray));
  2202. end;
  2203. if ACharCount < 0 then begin
  2204. raise Exception.CreateResFmt(PResStringRec(@RSInvalidCharCount), [ACharCount]);
  2205. end;
  2206. Len := Length(VBytes);
  2207. LByteCount := GetByteCount(AChars, ACharCount);
  2208. LBytes := ValidateBytes(VBytes, AByteIndex, Len, LByteCount);
  2209. Dec(Len, AByteIndex);
  2210. if (ACharCount > 0) and (Len > 0) then begin
  2211. Result := GetBytes(AChars, ACharCount, LBytes, LByteCount);
  2212. end else begin
  2213. Result := 0;
  2214. end;
  2215. end;
  2216. function TIdTextEncodingBase.GetBytes(const AStr: TIdUnicodeString): TIdBytes;
  2217. var
  2218. Len: Integer;
  2219. begin
  2220. Result := nil;
  2221. Len := GetByteCount(AStr);
  2222. if Len > 0 then begin
  2223. SetLength(Result, Len);
  2224. GetBytes(PIdWideChar(AStr), Length(AStr), PByte(Result), Len);
  2225. end;
  2226. end;
  2227. function TIdTextEncodingBase.GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): TIdBytes;
  2228. var
  2229. Len: Integer;
  2230. LChars: PIdWideChar;
  2231. begin
  2232. Result := nil;
  2233. LChars := ValidateStr(AStr, ACharIndex, ACharCount);
  2234. if LChars <> nil then begin
  2235. Len := GetByteCount(LChars, ACharCount);
  2236. if Len > 0 then begin
  2237. SetLength(Result, Len);
  2238. GetBytes(LChars, ACharCount, PByte(Result), Len);
  2239. end;
  2240. end;
  2241. end;
  2242. function TIdTextEncodingBase.GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer;
  2243. var VBytes: TIdBytes; AByteIndex: Integer): Integer;
  2244. var
  2245. LChars: PIdWideChar;
  2246. begin
  2247. LChars := ValidateStr(AStr, ACharIndex, ACharCount);
  2248. if LChars <> nil then begin
  2249. Result := GetBytes(LChars, ACharCount, VBytes, AByteIndex);
  2250. end else begin
  2251. Result := 0;
  2252. end;
  2253. end;
  2254. function TIdTextEncodingBase.GetCharCount(const ABytes: TIdBytes): Integer;
  2255. begin
  2256. if ABytes <> nil then begin
  2257. Result := GetCharCount(PByte(ABytes), Length(ABytes));
  2258. end else begin
  2259. Result := 0;
  2260. end;
  2261. end;
  2262. function TIdTextEncodingBase.GetCharCount(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): Integer;
  2263. var
  2264. LBytes: PByte;
  2265. begin
  2266. LBytes := ValidateBytes(ABytes, AByteIndex, AByteCount);
  2267. if LBytes <> nil then begin
  2268. Result := GetCharCount(LBytes, AByteCount);
  2269. end else begin
  2270. Result := 0;
  2271. end;
  2272. end;
  2273. function TIdTextEncodingBase.GetChars(const ABytes: TIdBytes): TIdWideChars;
  2274. begin
  2275. if ABytes <> nil then begin
  2276. Result := GetChars(PByte(ABytes), Length(ABytes));
  2277. end else begin
  2278. Result := nil;
  2279. end;
  2280. end;
  2281. function TIdTextEncodingBase.GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdWideChars;
  2282. var
  2283. Len: Integer;
  2284. begin
  2285. Result := nil;
  2286. Len := GetCharCount(ABytes, AByteIndex, AByteCount);
  2287. if Len > 0 then begin
  2288. SetLength(Result, Len);
  2289. GetChars(@ABytes[AByteIndex], AByteCount, PIdWideChar(Result), Len);
  2290. end;
  2291. end;
  2292. function TIdTextEncodingBase.GetChars(const ABytes: TIdBytes;
  2293. AByteIndex, AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer;
  2294. var
  2295. LBytes: PByte;
  2296. begin
  2297. LBytes := ValidateBytes(ABytes, AByteIndex, AByteCount);
  2298. if LBytes <> nil then begin
  2299. Result := GetChars(LBytes, AByteCount, VChars, ACharIndex);
  2300. end else begin
  2301. Result := 0;
  2302. end;
  2303. end;
  2304. function TIdTextEncodingBase.GetChars(const ABytes: PByte; AByteCount: Integer): TIdWideChars;
  2305. var
  2306. Len: Integer;
  2307. begin
  2308. Len := GetCharCount(ABytes, AByteCount);
  2309. if Len > 0 then begin
  2310. SetLength(Result, Len);
  2311. GetChars(ABytes, AByteCount, PIdWideChar(Result), Len);
  2312. end;
  2313. end;
  2314. function TIdTextEncodingBase.GetChars(const ABytes: PByte; AByteCount: Integer;
  2315. var VChars: TIdWideChars; ACharIndex: Integer): Integer;
  2316. var
  2317. LCharCount: Integer;
  2318. begin
  2319. if (ABytes = nil) and (AByteCount <> 0) then begin
  2320. raise Exception.CreateRes(PResStringRec(@RSInvalidSourceArray));
  2321. end;
  2322. if AByteCount < 0 then begin
  2323. raise Exception.CreateResFmt(PResStringRec(@RSInvalidCharCount), [AByteCount]);
  2324. end;
  2325. if (ACharIndex < 0) or (ACharIndex > Length(VChars)) then begin
  2326. raise Exception.CreateResFmt(PResStringRec(@RSInvalidDestinationIndex), [ACharIndex]);
  2327. end;
  2328. LCharCount := GetCharCount(ABytes, AByteCount);
  2329. if LCharCount > 0 then begin
  2330. if (ACharIndex + LCharCount) > Length(VChars) then begin
  2331. raise Exception.CreateRes(PResStringRec(@RSInvalidDestinationArray));
  2332. end;
  2333. Result := GetChars(ABytes, AByteCount, @VChars[ACharIndex], LCharCount);
  2334. end else begin
  2335. Result := 0;
  2336. end;
  2337. end;
  2338. function TIdTextEncodingBase.GetIsSingleByte: Boolean;
  2339. begin
  2340. Result := FIsSingleByte;
  2341. end;
  2342. function TIdTextEncodingBase.GetPreamble: TIdBytes;
  2343. begin
  2344. SetLength(Result, 0);
  2345. end;
  2346. function TIdTextEncodingBase.GetString(const ABytes: TIdBytes): TIdUnicodeString;
  2347. begin
  2348. if ABytes <> nil then begin
  2349. Result := GetString(PByte(ABytes), Length(ABytes));
  2350. end else begin
  2351. Result := '';
  2352. end;
  2353. end;
  2354. function TIdTextEncodingBase.GetString(const ABytes: TIdBytes;
  2355. AByteIndex, AByteCount: Integer): TIdUnicodeString;
  2356. var
  2357. Len: Integer;
  2358. begin
  2359. Result := '';
  2360. Len := GetCharCount(ABytes, AByteIndex, AByteCount);
  2361. if Len > 0 then begin
  2362. SetLength(Result, Len);
  2363. GetChars(@ABytes[AByteIndex], AByteCount, PIdWideChar(Result), Len);
  2364. end;
  2365. end;
  2366. function TIdTextEncodingBase.GetString(const ABytes: PByte; AByteCount: Integer): TIdUnicodeString;
  2367. var
  2368. Len: Integer;
  2369. begin
  2370. Result := '';
  2371. Len := GetCharCount(ABytes, AByteCount);
  2372. if Len > 0 then begin
  2373. SetLength(Result, Len);
  2374. GetChars(ABytes, AByteCount, PIdWideChar(Result), Len);
  2375. end;
  2376. end;
  2377. { TIdMBCSEncoding }
  2378. function IsCharsetASCII(const ACharSet: string): Boolean;
  2379. {$IFDEF USE_INLINE}inline;{$ENDIF}
  2380. begin
  2381. // TODO: when the IdCharsets unit is moved to the System
  2382. // package, use CharsetToCodePage() here...
  2383. Result := PosInStrArray(ACharSet,
  2384. [
  2385. 'US-ASCII', {do not localize}
  2386. 'ANSI_X3.4-1968', {do not localize}
  2387. 'iso-ir-6', {do not localize}
  2388. 'ANSI_X3.4-1986', {do not localize}
  2389. 'ISO_646.irv:1991', {do not localize}
  2390. 'ASCII', {do not localize}
  2391. 'ISO646-US', {do not localize}
  2392. 'us', {do not localize}
  2393. 'IBM367', {do not localize}
  2394. 'cp367', {do not localize}
  2395. 'csASCII' {do not localize}
  2396. ], False) <> -1;
  2397. end;
  2398. {$IFNDEF USE_ICONV}
  2399. {$IFNDEF HAS_LocaleCharsFromUnicode}
  2400. {$IFDEF WINDOWS}
  2401. {$IFNDEF HAS_PLongBool}
  2402. type
  2403. PLongBool = ^LongBool;
  2404. {$ENDIF}
  2405. function LocaleCharsFromUnicode(CodePage, Flags: Cardinal;
  2406. UnicodeStr: PWideChar; UnicodeStrLen: Integer; LocaleStr: PAnsiChar;
  2407. LocaleStrLen: Integer; DefaultChar: PAnsiChar; UsedDefaultChar: PLongBool): Integer; overload;
  2408. {$IFDEF USE_INLINE}inline;{$ENDIF}
  2409. begin
  2410. Result := WideCharToMultiByte(CodePage, Flags, UnicodeStr, UnicodeStrLen, LocaleStr, LocaleStrLen, DefaultChar, PBOOL(UsedDefaultChar));
  2411. end;
  2412. {$DEFINE HAS_LocaleCharsFromUnicode}
  2413. {$ENDIF}
  2414. {$ENDIF}
  2415. {$ENDIF}
  2416. {$IFNDEF USE_ICONV}
  2417. {$IFNDEF HAS_UnicodeFromLocaleChars}
  2418. {$IFDEF WINDOWS}
  2419. function UnicodeFromLocaleChars(CodePage, Flags: Cardinal; LocaleStr: PAnsiChar;
  2420. LocaleStrLen: Integer; UnicodeStr: PWideChar; UnicodeStrLen: Integer): Integer; overload;
  2421. {$IFDEF USE_INLINE}inline;{$ENDIF}
  2422. begin
  2423. Result := MultiByteToWideChar(CodePage, Flags, LocaleStr, LocaleStrLen, UnicodeStr, UnicodeStrLen);
  2424. end;
  2425. {$DEFINE HAS_UnicodeFromLocaleChars}
  2426. {$ENDIF}
  2427. {$ENDIF}
  2428. {$ENDIF}
  2429. constructor TIdMBCSEncoding.Create;
  2430. begin
  2431. {$IFDEF USE_ICONV}
  2432. Create(iif(GIdIconvUseLocaleDependantAnsiEncoding, 'char', 'ASCII')); {do not localize}
  2433. {$ELSE}
  2434. {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
  2435. Create(CP_ACP, 0, 0);
  2436. {$ELSE}
  2437. ToDo('Constructor of TIdMBCSEncoding class is not implemented for this platform yet'); {do not localize}
  2438. {$ENDIF}
  2439. {$ENDIF}
  2440. end;
  2441. {$IFDEF USE_ICONV}
  2442. constructor TIdMBCSEncoding.Create(const CharSet: String);
  2443. const
  2444. // RLebeau: iconv() does not provide a maximum character byte size like
  2445. // Microsoft does, so have to determine the max bytes by manually encoding
  2446. // an actual Unicode codepoint. We'll encode the largest codepoint that
  2447. // UTF-16 supports, U+10FFFF, for now...
  2448. //
  2449. cValue: array[0..3] of Byte = ({$IFDEF ENDIAN_BIG}$DB, $FF, $DF, $FF{$ELSE}$FF, $DB, $FF, $DF{$ENDIF});
  2450. //cValue: array[0..1] of UInt16 = ($DBFF, $DFFF);
  2451. begin
  2452. inherited Create;
  2453. // RLebeau 5/2/2017: have seen some malformed emails that use 'utf8'
  2454. // instead of 'utf-8', so let's check for that...
  2455. // RLebeau 9/27/2017: updating to handle a few more UTFs without hyphens...
  2456. // RLebeau 7/6/2018: iconv does not have a way to query the highest Unicode
  2457. // codepoint a charset supports, let alone the max bytes needed to encode such
  2458. // a codepoint, so use known values for select charsets, and calculate
  2459. // MaxCharSize dynamically for the rest...
  2460. 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}
  2461. 0, 1: begin
  2462. FCharSet := 'UTF-7'; {Do not Localize}
  2463. FMaxCharSize := 5;
  2464. end;
  2465. 2, 3: begin
  2466. FCharSet := 'UTF-8'; {Do not Localize}
  2467. FMaxCharSize := 4;
  2468. end;
  2469. 4..7: begin
  2470. FCharSet := 'UTF-16LE'; {Do not Localize}
  2471. FMaxCharSize := 4;
  2472. end;
  2473. 8, 9: begin
  2474. FCharSet := 'UTF-16BE'; {Do not Localize}
  2475. FMaxCharSize := 4;
  2476. end;
  2477. 10..13: begin
  2478. FCharSet := 'UTF-32LE'; {Do not Localize}
  2479. FMaxCharSize := 4;
  2480. end;
  2481. 14, 15: begin
  2482. FCharSet := 'UTF-32BE'; {Do not Localize}
  2483. FMaxCharSize := 4;
  2484. end;
  2485. else
  2486. FCharSet := CharSet;
  2487. if TextStartsWith(CharSet, 'ISO-8859') or {Do not Localize}
  2488. TextStartsWith(CharSet, 'Windows') or {Do not Localize}
  2489. TextStartsWith(CharSet, 'KOI8') or {Do not Localize}
  2490. IsCharsetASCII(CharSet) then
  2491. begin
  2492. FMaxCharSize := 1;
  2493. end
  2494. else begin
  2495. FMaxCharSize := GetByteCount(PWideChar(@cValue[0]), 2);
  2496. // Not all charsets support all codepoints. For example, ISO-8859-1 does
  2497. // not support U+10FFFF. If GetByteCount() fails above, FMaxCharSize gets
  2498. // set to 0, preventing any character conversions. So force FMaxCharSize
  2499. // to 1 if GetByteCount() fails, until a better solution can be found.
  2500. // Maybe loop through the codepoints until we find the largest one that is
  2501. // supported by this charset..
  2502. if FMaxCharSize = 0 then begin
  2503. FMaxCharSize := 1;
  2504. end;
  2505. end;
  2506. end;
  2507. FIsSingleByte := (FMaxCharSize = 1);
  2508. end;
  2509. {$ELSE}
  2510. {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
  2511. constructor TIdMBCSEncoding.Create(CodePage: Integer);
  2512. begin
  2513. Create(CodePage, 0, 0);
  2514. end;
  2515. {$IFDEF WINDOWS}
  2516. // TODO: move this into IdCompilerDefines.inc?
  2517. {$IFDEF DCC}
  2518. {$IFDEF VCL_2009_OR_ABOVE}
  2519. {$DEFINE HAS_GetCPInfoEx}
  2520. {$ELSE}
  2521. {$UNDEF HAS_GetCPInfoEx}
  2522. {$ENDIF}
  2523. {$ELSE}
  2524. // TODO: when was GetCPInfoEx() added to FreePascal?
  2525. {$DEFINE HAS_GetCPInfoEx}
  2526. {$ENDIF}
  2527. {$IFNDEF HAS_GetCPInfoEx}
  2528. type
  2529. TCPInfoEx = record
  2530. MaxCharSize: UINT; { max length (bytes) of a char }
  2531. DefaultChar: array[0..MAX_DEFAULTCHAR - 1] of Byte; { default character }
  2532. LeadByte: array[0..MAX_LEADBYTES - 1] of Byte; { lead byte ranges }
  2533. UnicodeDefaultChar: WideChar;
  2534. Codepage: UINT;
  2535. CodePageName: array[0..MAX_PATH -1] of {$IFDEF UNICODE}WideChar{$ELSE}AnsiChar{$ENDIF};
  2536. end;
  2537. function GetCPInfoEx(CodePage: UINT; dwFlags: DWORD; var lpCPInfoEx: TCPInfoEx): BOOL; stdcall; external 'KERNEL32' name {$IFDEF UNICODE}'GetCPInfoExW'{$ELSE}'GetCPInfoExA'{$ENDIF};
  2538. {$ENDIF}
  2539. {$ENDIF}
  2540. constructor TIdMBCSEncoding.Create(CodePage, MBToWCharFlags, WCharToMBFlags: Integer);
  2541. {$IFNDEF WINDOWS}
  2542. const
  2543. // RLebeau: have to determine the max bytes by manually encoding an actual
  2544. // Unicode codepoint. We'll encode the largest codepoint that UTF-16 supports,
  2545. // U+10FFFF, for now...
  2546. //
  2547. cValue: array[0..1] of UInt16 = ($DBFF, $DFFF);
  2548. {$ELSE}
  2549. var
  2550. LCPInfo: TCPInfoEx;
  2551. LError: Boolean;
  2552. {$ENDIF}
  2553. begin
  2554. inherited Create;
  2555. FCodePage := CodePage;
  2556. FMBToWCharFlags := MBToWCharFlags;
  2557. FWCharToMBFlags := WCharToMBFlags;
  2558. {$IFDEF FPC}
  2559. if FCodePage = CP_ACP then begin
  2560. FCodePage := DefaultSystemCodePage;
  2561. end;
  2562. {$ENDIF}
  2563. {$IFDEF WINDOWS}
  2564. LError := not GetCPInfoEx(FCodePage, 0, LCPInfo);
  2565. if LError and (FCodePage = 20127) then begin
  2566. // RLebeau: 20127 is the official codepage for ASCII, but not
  2567. // all OS versions support that codepage, so fallback to 1252
  2568. // or even 437...
  2569. LError := not GetCPInfoEx(1252, 0, LCPInfo);
  2570. // just in case...
  2571. if LError then begin
  2572. LError := not GetCPInfoEx(437, 0, LCPInfo);
  2573. end;
  2574. end;
  2575. if LError then begin
  2576. raise EIdException.CreateResFmt(PResStringRec(@RSInvalidCodePage), [FCodePage]);
  2577. end;
  2578. FCodePage := LCPInfo.CodePage;
  2579. FMaxCharSize := LCPInfo.MaxCharSize;
  2580. {$ELSE}
  2581. case FCodePage of
  2582. 65000: begin
  2583. FMaxCharSize := 5;
  2584. end;
  2585. 65001: begin
  2586. FMaxCharSize := 4;
  2587. end;
  2588. 1200: begin
  2589. FMaxCharSize := 4;
  2590. end;
  2591. 1201: begin
  2592. FMaxCharSize := 4;
  2593. end;
  2594. // TODO: add support for UTF-32...
  2595. // TODO: add cases for 'ISO-8859-X', 'Windows-X', 'KOI8-X', and ASCII charsets...
  2596. else
  2597. FMaxCharSize := LocaleCharsFromUnicode(FCodePage, FWCharToMBFlags, @cValue[0], 2, nil, 0, nil, nil);
  2598. if FMaxCharSize < 1 then begin
  2599. raise EIdException.CreateResFmt(@RSInvalidCodePage, [FCodePage]);
  2600. end;
  2601. // Not all charsets support all codepoints. For example, ISO-8859-1 does
  2602. // not support U+10FFFF. If LocaleCharsFromUnicode() fails above,
  2603. // FMaxCharSize gets set to 0, preventing any character conversions. So
  2604. // force FMaxCharSize to 1 if GetByteCount() fails, until a better solution
  2605. // can be found. Maybe loop through the codepoints until we find the largest
  2606. // one that is supported by this codepage (though that will take time)...
  2607. if FMaxCharSize = 0 then begin
  2608. FMaxCharSize := 1;
  2609. end;
  2610. end;
  2611. {$ENDIF}
  2612. FIsSingleByte := (FMaxCharSize = 1);
  2613. end;
  2614. {$ENDIF}
  2615. {$ENDIF}
  2616. {$IFDEF USE_ICONV}
  2617. function CreateIconvHandle(const ACharSet: String; AToUTF16: Boolean): iconv_t;
  2618. const
  2619. // RLebeau: iconv() outputs a UTF-16 BOM if data is converted to the generic
  2620. // "UTF-16" charset. We do not want that, so we will use the "UTF-16LE/BE"
  2621. // charset explicitally instead so no BOM is outputted. This also saves us
  2622. // from having to manually detect the presense of a BOM and strip it out.
  2623. //
  2624. // TODO: should we be using UTF-16LE or UTF-16BE on big-endian systems?
  2625. // Delphi uses UTF-16LE, but what does FreePascal use? Let's err on the
  2626. // side of caution until we know otherwise...
  2627. //
  2628. cUTF16CharSet = {$IFDEF ENDIAN_BIG}'UTF-16BE'{$ELSE}'UTF-16LE'{$ENDIF}; {do not localize}
  2629. var
  2630. LToCharSet, LFromCharSet, LFlags: String;
  2631. {$IFDEF USE_MARSHALLED_PTRS}
  2632. M: TMarshaller;
  2633. {$ENDIF}
  2634. begin
  2635. // on some systems, //IGNORE must be specified before //TRANSLIT if they
  2636. // are used together, otherwise //IGNORE gets ignored!
  2637. LFlags := '';
  2638. if GIdIconvIgnoreIllegalChars then begin
  2639. LFlags := LFlags + '//IGNORE'; {do not localize}
  2640. end;
  2641. if GIdIconvUseTransliteration then begin
  2642. LFlags := LFlags + '//TRANSLIT'; {do not localize}
  2643. end;
  2644. if AToUTF16 then begin
  2645. LToCharSet := cUTF16CharSet + LFlags;
  2646. LFromCharSet := ACharSet;
  2647. end else begin
  2648. LToCharSet := ACharSet + LFlags;
  2649. LFromCharSet := cUTF16CharSet;
  2650. end;
  2651. Result := iconv_open(
  2652. {$IFDEF USE_MARSHALLED_PTRS}
  2653. M.AsAnsi(LToCharSet).ToPointer,
  2654. M.AsAnsi(LFromCharSet).ToPointer
  2655. {$ELSE}
  2656. PAnsiChar(
  2657. {$IFDEF STRING_IS_ANSI}
  2658. LToCharSet
  2659. {$ELSE}
  2660. AnsiString(LToCharSet) // explicit convert to Ansi
  2661. {$ENDIF}
  2662. ),
  2663. PAnsiChar(
  2664. {$IFDEF STRING_IS_ANSI}
  2665. LFromCharSet
  2666. {$ELSE}
  2667. AnsiString(LFromCharSet) // explicit convert to Ansi
  2668. {$ENDIF}
  2669. )
  2670. {$ENDIF}
  2671. );
  2672. if Result = iconv_t(-1) then begin
  2673. if LFlags <> '' then begin
  2674. raise EIdException.CreateResFmt(@RSInvalidCharSetConvWithFlags, [ACharSet, cUTF16CharSet, LFlags]);
  2675. end else begin
  2676. raise EIdException.CreateResFmt(@RSInvalidCharSetConv, [ACharSet, cUTF16CharSet]);
  2677. end;
  2678. end;
  2679. end;
  2680. function CalcUTF16ByteSize(AChars: PWideChar; ACharCount: Integer): Integer;
  2681. var
  2682. C: WideChar;
  2683. LCount: Integer;
  2684. begin
  2685. C := AChars^;
  2686. if (C >= #$D800) and (C <= #$DFFF) then
  2687. begin
  2688. Result := 0;
  2689. if C > #$DBFF then begin
  2690. // invalid high surrogate
  2691. Exit;
  2692. end;
  2693. if ACharCount = 1 then begin
  2694. // missing low surrogate
  2695. Exit;
  2696. end;
  2697. Inc(AChars);
  2698. C := AChars^;
  2699. if (C < #$DC00) or (C > #$DFFF) then begin
  2700. // invalid low surrogate
  2701. Exit;
  2702. end;
  2703. LCount := 2;
  2704. end else begin
  2705. LCount := 1;
  2706. end;
  2707. Result := LCount * SizeOf(WideChar);
  2708. end;
  2709. {$ENDIF}
  2710. {$IFDEF USE_ICONV}
  2711. function DoIconvCharsToBytes(const ACharset: string; AChars: PIdWideChar; ACharCount: Integer;
  2712. ABytes: PByte; AByteCount: Integer; ABytesIsTemp: Boolean): Integer;
  2713. var
  2714. LSrcCharsPtr: PIdWideChar;
  2715. LCharsPtr, LBytesPtr: PAnsiChar;
  2716. LSrcCharSize, LCharSize, LByteSize: size_t;
  2717. LCharsRead, LBytesWritten: Integer;
  2718. LIconv: iconv_t;
  2719. begin
  2720. Result := 0;
  2721. if (AChars = nil) or (ACharCount = 0) then begin
  2722. Exit;
  2723. end;
  2724. LIconv := CreateIconvHandle(ACharSet, False);
  2725. try
  2726. // RLebeau: iconv() does not allow for querying a pre-calculated byte size
  2727. // for the input like Microsoft does, so have to determine the max bytes
  2728. // by actually encoding the Unicode data to a real buffer. When ABytesIsTemp
  2729. // is True, we are encoding to a small local buffer so we don't have to use
  2730. // a lot of memory. We also have to encode the input 1 Unicode codepoint at
  2731. // a time to avoid iconv() returning an E2BIG error if multiple UTF-16
  2732. // sequences were decoded to a length that would exceed the size of the
  2733. // local buffer.
  2734. //Kylix has an odd definition in iconv. In Kylix, __outbytesleft is defined as a var
  2735. //while in FreePascal's libc and our IdIconv units define it as a pSize_t
  2736. // reset to initial state
  2737. LByteSize := 0;
  2738. if iconv(LIconv, nil, nil, nil, {$IFNDEF KYLIX}@{$ENDIF}LByteSize) = size_t(-1) then begin
  2739. Exit;
  2740. end;
  2741. // do the conversion
  2742. LSrcCharsPtr := AChars;
  2743. repeat
  2744. if LSrcCharsPtr <> nil then begin
  2745. LSrcCharSize := CalcUTF16ByteSize(LSrcCharsPtr, ACharCount);
  2746. if LSrcCharSize = 0 then begin
  2747. Result := 0;
  2748. Exit;
  2749. end;
  2750. end else begin
  2751. LSrcCharSize := 0;
  2752. end;
  2753. LCharsPtr := PAnsiChar(LSrcCharsPtr);
  2754. LCharSize := LSrcCharSize;
  2755. LBytesPtr := PAnsiChar(ABytes);
  2756. LByteSize := AByteCount;
  2757. if iconv(LIconv, @LCharsPtr, @LCharSize, @LBytesPtr, {$IFNDEF KYLIX}@{$ENDIF}LByteSize) = size_t(-1) then
  2758. begin
  2759. Exit;
  2760. end;
  2761. // LByteSize was decremented by the number of bytes stored in the output buffer
  2762. LBytesWritten := AByteCount - LByteSize;
  2763. Inc(Result, LBytesWritten);
  2764. if LSrcCharsPtr = nil then begin
  2765. Exit;
  2766. end;
  2767. if not ABytesIsTemp then begin
  2768. Inc(ABytes, LBytesWritten);
  2769. Dec(AByteCount, LBytesWritten);
  2770. end;
  2771. // LCharSize was decremented by the number of bytes read from the input buffer
  2772. LCharsRead := (LSrcCharSize-LCharSize) div SizeOf(WideChar);
  2773. Inc(LSrcCharsPtr, LCharsRead);
  2774. Dec(ACharCount, LCharsRead);
  2775. if ACharCount < 1 then
  2776. begin
  2777. // After all characters are handled, the output buffer has to be flushed
  2778. // This is done by running one more iteration, without an input buffer
  2779. LSrcCharsPtr := nil;
  2780. end;
  2781. until False;
  2782. finally
  2783. iconv_close(LIconv);
  2784. end;
  2785. end;
  2786. {$ENDIF}
  2787. function TIdMBCSEncoding.GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer;
  2788. {$IFDEF USE_ICONV}
  2789. var
  2790. // TODO: size this dynamically to accomodate FMaxCharSize, plus some extra padding for safety...
  2791. LBytes: array[0..7] of Byte;
  2792. {$ENDIF}
  2793. begin
  2794. {$IFDEF USE_ICONV}
  2795. Result := DoIconvCharsToBytes(FCharset, AChars, ACharCount, @LBytes[0], Length(LBytes), True);
  2796. {$ELSE}
  2797. {$IFDEF HAS_LocaleCharsFromUnicode}
  2798. Result := LocaleCharsFromUnicode(FCodePage, FWCharToMBFlags, AChars, ACharCount, nil, 0, nil, nil);
  2799. {$ELSE}
  2800. Result := 0;
  2801. ToDo('GetByteCount() method of TIdMBCSEncoding class is not implemented for this platform yet'); {do not localize}
  2802. {$ENDIF}
  2803. {$ENDIF}
  2804. end;
  2805. function TIdMBCSEncoding.GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte;
  2806. AByteCount: Integer): Integer;
  2807. begin
  2808. {$IFDEF USE_ICONV}
  2809. Assert (ABytes <> nil, 'TIdMBCSEncoding.GetBytes Bytes can not be nil');
  2810. Result := DoIconvCharsToBytes(FCharset, AChars, ACharCount, ABytes, AByteCount, False);
  2811. {$ELSE}
  2812. {$IFDEF HAS_LocaleCharsFromUnicode}
  2813. Result := LocaleCharsFromUnicode(FCodePage, FWCharToMBFlags, AChars, ACharCount, {$IFNDEF HAS_PAnsiChar}Pointer{$ELSE}PAnsiChar{$ENDIF}(ABytes), AByteCount, nil, nil);
  2814. {$ELSE}
  2815. Result := 0;
  2816. ToDo('GetBytes() method of TIdMBCSEncoding class is not implemented for this platform yet'); {do not localize}
  2817. {$ENDIF}
  2818. {$ENDIF}
  2819. end;
  2820. {$IFDEF USE_ICONV}
  2821. function DoIconvBytesToChars(const ACharset: string; const ABytes: PByte; AByteCount: Integer;
  2822. AChars: PWideChar; ACharCount: Integer; AMaxCharSize: Integer; ACharsIsTemp: Boolean): Integer;
  2823. var
  2824. LSrcBytesPtr: PByte;
  2825. LBytesPtr, LCharsPtr: PAnsiChar;
  2826. LByteSize, LCharsSize: size_t;
  2827. I, LDestCharSize, LMaxBytesSize, LBytesRead, LCharsWritten: Integer;
  2828. LConverted: Boolean;
  2829. LIconv: iconv_t;
  2830. begin
  2831. Result := 0;
  2832. if (ABytes = nil) or (AByteCount = 0) then begin
  2833. Exit;
  2834. end;
  2835. LIconv := CreateIconvHandle(ACharset, True);
  2836. try
  2837. // RLebeau: iconv() does not allow for querying a pre-calculated character count
  2838. // for the input like Microsoft does, so have to determine the max characters
  2839. // by actually encoding the Ansi data to a real buffer. If ACharsIsTemp is True
  2840. // then we are encoding to a small local buffer so we don't have to use a lot of
  2841. // memory. We also have to encode the input 1 Unicode codepoint at a time to
  2842. // avoid iconv() returning an E2BIG error if multiple MBCS sequences were decoded
  2843. // to a length that would exceed the size of the local buffer.
  2844. //Kylix has an odd definition in iconv. In Kylix, __outbytesleft is defined as a var
  2845. //while in FreePascal's libc and our IdIconv units define it as a pSize_t
  2846. // reset to initial state
  2847. LCharsSize := 0;
  2848. if iconv(LIconv, nil, nil, nil, {$IFNDEF KYLIX}@{$ENDIF}LCharsSize) = size_t(-1) then
  2849. begin
  2850. Exit;
  2851. end;
  2852. // do the conversion
  2853. LSrcBytesPtr := ABytes;
  2854. repeat
  2855. LMaxBytesSize := IndyMin(AByteCount, AMaxCharSize);
  2856. LDestCharSize := ACharCount * SizeOf(WideChar);
  2857. if LSrcBytesPtr = nil then
  2858. begin
  2859. LBytesPtr := nil;
  2860. LByteSize := 0;
  2861. LCharsPtr := PAnsiChar(AChars);
  2862. LCharsSize := LDestCharSize;
  2863. if iconv(LIconv, @LBytesPtr, @LByteSize, @LCharsPtr, {$IFNDEF KYLIX}@{$ENDIF}LCharsSize) = size_t(-1) then
  2864. begin
  2865. Result := 0;
  2866. end else
  2867. begin
  2868. // LCharsSize was decremented by the number of bytes stored in the output buffer
  2869. Inc(Result, (LDestCharSize-LCharsSize) div SizeOf(WideChar));
  2870. end;
  2871. Exit;
  2872. end;
  2873. // TODO: figure out a better way to calculate the number of input bytes
  2874. // needed to generate a single UTF-16 output sequence...
  2875. LMaxBytesSize := IndyMin(AByteCount, AMaxCharSize);
  2876. LConverted := False;
  2877. for I := 1 to LMaxBytesSize do
  2878. begin
  2879. LBytesPtr := PAnsiChar(LSrcBytesPtr);
  2880. LByteSize := I;
  2881. LCharsPtr := PAnsiChar(AChars);
  2882. LCharsSize := LDestCharSize;
  2883. if iconv(LIconv, @LBytesPtr, @LByteSize, @LCharsPtr, {$IFNDEF KYLIX}@{$ENDIF}LCharsSize) <> size_t(-1) then
  2884. begin
  2885. LConverted := True;
  2886. // LCharsSize was decremented by the number of bytes stored in the output buffer
  2887. LCharsWritten := (LDestCharSize-LCharsSize) div SizeOf(WideChar);
  2888. Inc(Result, LCharsWritten);
  2889. if LSrcBytesPtr = nil then begin
  2890. Exit;
  2891. end;
  2892. if not ACharsIsTemp then begin
  2893. Inc(AChars, LCharsWritten);
  2894. Dec(ACharCount, LCharsWritten);
  2895. end;
  2896. // LByteSize was decremented by the number of bytes read from the input buffer
  2897. LBytesRead := I - LByteSize;
  2898. Inc(LSrcBytesPtr, LBytesRead);
  2899. Dec(AByteCount, LBytesRead);
  2900. if AByteCount < 1 then begin
  2901. // After all bytes are handled, the output buffer has to be flushed
  2902. // This is done by running one more iteration, without an input buffer
  2903. LSrcBytesPtr := nil;
  2904. end;
  2905. Break;
  2906. end;
  2907. end;
  2908. if not LConverted then begin
  2909. Result := 0;
  2910. Exit;
  2911. end;
  2912. until False;
  2913. finally
  2914. iconv_close(LIconv);
  2915. end;
  2916. end;
  2917. {$ENDIF}
  2918. function TIdMBCSEncoding.GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer;
  2919. {$IFDEF USE_ICONV}
  2920. var
  2921. LChars: array[0..3] of WideChar;
  2922. {$ENDIF}
  2923. begin
  2924. {$IFDEF USE_ICONV}
  2925. Result := DoIconvBytesToChars(FCharSet, ABytes, AByteCount, @LChars[0], Length(LChars), FMaxCharSize, True);
  2926. {$ELSE}
  2927. {$IFDEF HAS_UnicodeFromLocaleChars}
  2928. Result := UnicodeFromLocaleChars(FCodePage, FMBToWCharFlags, {$IFNDEF HAS_PAnsiChar}Pointer{$ELSE}PAnsiChar{$ENDIF}(ABytes), AByteCount, nil, 0);
  2929. {$ELSE}
  2930. Result := 0;
  2931. ToDo('GetCharCount() method of TIdMBCSEncoding class is not implemented for this platform yet'); {do not localize}
  2932. {$ENDIF}
  2933. {$ENDIF}
  2934. end;
  2935. function TIdMBCSEncoding.GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PWideChar;
  2936. ACharCount: Integer): Integer;
  2937. begin
  2938. {$IFDEF USE_ICONV}
  2939. Result := DoIconvBytesToChars(FCharSet, ABytes, AByteCount, AChars, ACharCount, FMaxCharSize, False);
  2940. {$ELSE}
  2941. {$IFDEF HAS_UnicodeFromLocaleChars}
  2942. Result := UnicodeFromLocaleChars(FCodePage, FMBToWCharFlags, {$IFNDEF HAS_PAnsiChar}Pointer{$ELSE}PAnsiChar{$ENDIF}(ABytes), AByteCount, AChars, ACharCount);
  2943. {$ELSE}
  2944. Result := 0;
  2945. ToDo('GetChars() method of TIdMBCSEncoding class is not implemented for this platform yet'); {do not localize}
  2946. {$ENDIF}
  2947. {$ENDIF}
  2948. end;
  2949. function TIdMBCSEncoding.GetMaxByteCount(CharCount: Integer): Integer;
  2950. begin
  2951. Result := (CharCount + 1) * FMaxCharSize;
  2952. end;
  2953. function TIdMBCSEncoding.GetMaxCharCount(ByteCount: Integer): Integer;
  2954. begin
  2955. Result := ByteCount;
  2956. end;
  2957. function TIdMBCSEncoding.GetPreamble: TIdBytes;
  2958. begin
  2959. {$IFDEF USE_ICONV}
  2960. // RLebeau 5/2/2017: have seen some malformed emails that use 'utf8'
  2961. // instead of 'utf-8', so let's check for that...
  2962. // RLebeau 9/27/2017: updating to handle a few more UTFs without hyphens...
  2963. 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}
  2964. 0, 1: begin
  2965. SetLength(Result, 3);
  2966. Result[0] := $EF;
  2967. Result[1] := $BB;
  2968. Result[2] := $BF;
  2969. end;
  2970. 2..5: begin
  2971. SetLength(Result, 2);
  2972. Result[0] := $FF;
  2973. Result[1] := $FE;
  2974. end;
  2975. 6, 7: begin
  2976. SetLength(Result, 2);
  2977. Result[0] := $FE;
  2978. Result[1] := $FF;
  2979. end;
  2980. 8..11: begin
  2981. SetLength(Result, 4);
  2982. Result[0] := $FF;
  2983. Result[1] := $FE;
  2984. Result[2] := $00;
  2985. Result[3] := $00;
  2986. end;
  2987. 12, 13: begin
  2988. SetLength(Result, 4);
  2989. Result[0] := $00;
  2990. Result[1] := $00;
  2991. Result[2] := $FE;
  2992. Result[3] := $FF;
  2993. end;
  2994. else
  2995. SetLength(Result, 0);
  2996. end;
  2997. {$ELSE}
  2998. {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
  2999. case FCodePage of
  3000. CP_UTF8: begin
  3001. SetLength(Result, 3);
  3002. Result[0] := $EF;
  3003. Result[1] := $BB;
  3004. Result[2] := $BF;
  3005. end;
  3006. 1200: begin
  3007. SetLength(Result, 2);
  3008. Result[0] := $FF;
  3009. Result[1] := $FE;
  3010. end;
  3011. 1201: begin
  3012. SetLength(Result, 2);
  3013. Result[0] := $FE;
  3014. Result[1] := $FF;
  3015. end;
  3016. 12000: begin
  3017. SetLength(Result, 4);
  3018. Result[0] := $FF;
  3019. Result[1] := $FE;
  3020. Result[2] := $00;
  3021. Result[3] := $00;
  3022. end;
  3023. 12001: begin
  3024. SetLength(Result, 4);
  3025. Result[0] := $00;
  3026. Result[1] := $00;
  3027. Result[2] := $FE;
  3028. Result[3] := $FF;
  3029. end;
  3030. else
  3031. SetLength(Result, 0);
  3032. end;
  3033. {$ELSE}
  3034. SetLength(Result, 0);
  3035. ToDo('GetPreamble() method of TIdMBCSEncoding class is not implemented for this platform yet'); {do not localize}
  3036. {$ENDIF}
  3037. {$ENDIF}
  3038. end;
  3039. { TIdUTF7Encoding }
  3040. constructor TIdUTF7Encoding.Create;
  3041. begin
  3042. {$IFDEF USE_ICONV}
  3043. // RLebeau 7/6/2018: iconv does not have a way to query the highest Unicode codepoint
  3044. // a charset supports, let alone the max bytes needed to encode such a codepoint, so
  3045. // the inherited constructor tries to calculate MaxCharSize dynamically, which doesn't
  3046. // work very well for most charsets. Since we already know the exact value to use for
  3047. // this charset, let's just skip the inherited constructor and hard-code the value here...
  3048. //
  3049. //inherited Create('UTF-7'); {do not localize}
  3050. FCharSet := 'UTF-7'; {do not localize};
  3051. FIsSingleByte := False;
  3052. FMaxCharSize := 5;
  3053. {$ELSE}
  3054. {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
  3055. inherited Create(CP_UTF7);
  3056. {$ELSE}
  3057. ToDo('Constructor of TIdUTF7Encoding class is not implemented for this platform yet'); {do not localize}
  3058. {$ENDIF}
  3059. {$ENDIF}
  3060. end;
  3061. function TIdUTF7Encoding.GetMaxByteCount(CharCount: Integer): Integer;
  3062. begin
  3063. Result := (CharCount * 3) + 2;
  3064. end;
  3065. function TIdUTF7Encoding.GetMaxCharCount(ByteCount: Integer): Integer;
  3066. begin
  3067. Result := ByteCount;
  3068. end;
  3069. { TIdUTF8Encoding }
  3070. // TODO: implement UTF-8 manually so we don't have to deal with codepage issues...
  3071. constructor TIdUTF8Encoding.Create;
  3072. begin
  3073. {$IFDEF USE_ICONV}
  3074. // RLebeau 7/6/2018: iconv does not have a way to query the highest Unicode codepoint
  3075. // a charset supports, let alone the max bytes needed to encode such a codepoint, so
  3076. // the inherited constructor tries to calculate MaxCharSize dynamically, which doesn't
  3077. // work very well for most charsets. Since we already know the exact value to use for
  3078. // this charset, let's just skip the inherited constructor and hard-code the value here...
  3079. //
  3080. //inherited Create('UTF-8'); {do not localize}
  3081. FCharSet := 'UTF-8'; {do not localize};
  3082. FIsSingleByte := False;
  3083. FMaxCharSize := 4;
  3084. {$ELSE}
  3085. {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
  3086. inherited Create(CP_UTF8);
  3087. {$ELSE}
  3088. ToDo('Constructor of TIdUTF8Encoding class is not implemented for this platform yet'); {do not localize}
  3089. {$ENDIF}
  3090. {$ENDIF}
  3091. end;
  3092. function TIdUTF8Encoding.GetMaxByteCount(CharCount: Integer): Integer;
  3093. begin
  3094. Result := (CharCount + 1) * 3;
  3095. end;
  3096. function TIdUTF8Encoding.GetMaxCharCount(ByteCount: Integer): Integer;
  3097. begin
  3098. Result := ByteCount + 1;
  3099. end;
  3100. function TIdUTF8Encoding.GetPreamble: TIdBytes;
  3101. begin
  3102. SetLength(Result, 3);
  3103. Result[0] := $EF;
  3104. Result[1] := $BB;
  3105. Result[2] := $BF;
  3106. end;
  3107. { TIdUTF16LittleEndianEncoding }
  3108. constructor TIdUTF16LittleEndianEncoding.Create;
  3109. begin
  3110. inherited Create;
  3111. FIsSingleByte := False;
  3112. FMaxCharSize := 4;
  3113. end;
  3114. function TIdUTF16LittleEndianEncoding.GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer;
  3115. begin
  3116. // TODO: verify UTF-16 sequences
  3117. Result := ACharCount * SizeOf(WideChar);
  3118. end;
  3119. function TIdUTF16LittleEndianEncoding.GetBytes(const AChars: PIdWideChar; ACharCount: Integer;
  3120. ABytes: PByte; AByteCount: Integer): Integer;
  3121. {$IFDEF ENDIAN_BIG}
  3122. var
  3123. I: Integer;
  3124. LChars: PIdWideChar;
  3125. {$ENDIF}
  3126. begin
  3127. // TODO: verify UTF-16 sequences
  3128. {$IFDEF ENDIAN_BIG}
  3129. LChars := AChars;
  3130. for I := ACharCount - 1 downto 0 do
  3131. begin
  3132. ABytes^ := Hi(UInt16(LChars^));
  3133. Inc(ABytes);
  3134. ABytes^ := Lo(UInt16(LChars^));
  3135. Inc(ABytes);
  3136. Inc(LChars);
  3137. end;
  3138. Result := ACharCount * SizeOf(WideChar);
  3139. {$ELSE}
  3140. Result := ACharCount * SizeOf(WideChar);
  3141. Move(AChars^, ABytes^, Result);
  3142. {$ENDIF}
  3143. end;
  3144. function TIdUTF16LittleEndianEncoding.GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer;
  3145. begin
  3146. // TODO: verify UTF-16 sequences
  3147. Result := AByteCount div SizeOf(WideChar);
  3148. end;
  3149. function TIdUTF16LittleEndianEncoding.GetChars(const ABytes: PByte; AByteCount: Integer;
  3150. AChars: PIdWideChar; ACharCount: Integer): Integer;
  3151. {$IFDEF ENDIAN_BIG}
  3152. var
  3153. LBytes1, LBytes2: PByte;
  3154. I: Integer;
  3155. {$ENDIF}
  3156. begin
  3157. // TODO: verify UTF-16 sequences
  3158. {$IFDEF ENDIAN_BIG}
  3159. LBytes1 := ABytes;
  3160. LBytes2 := ABytes;
  3161. Inc(LBytes2);
  3162. for I := 0 to ACharCount - 1 do
  3163. begin
  3164. AChars^ := WideChar(MakeWord(LBytes2^, LBytes1^));
  3165. Inc(LBytes1, 2);
  3166. Inc(LBytes2, 2);
  3167. Inc(AChars);
  3168. end;
  3169. Result := ACharCount;
  3170. {$ELSE}
  3171. Result := AByteCount div SizeOf(WideChar);
  3172. Move(ABytes^, AChars^, Result * SizeOf(WideChar));
  3173. {$ENDIF}
  3174. end;
  3175. function TIdUTF16LittleEndianEncoding.GetMaxByteCount(CharCount: Integer): Integer;
  3176. begin
  3177. Result := (CharCount + 1) * 2;
  3178. end;
  3179. function TIdUTF16LittleEndianEncoding.GetMaxCharCount(ByteCount: Integer): Integer;
  3180. begin
  3181. Result := (ByteCount div SizeOf(WideChar)) + (ByteCount and 1) + 1;
  3182. end;
  3183. function TIdUTF16LittleEndianEncoding.GetPreamble: TIdBytes;
  3184. begin
  3185. SetLength(Result, 2);
  3186. Result[0] := $FF;
  3187. Result[1] := $FE;
  3188. end;
  3189. { TIdUTF16BigEndianEncoding }
  3190. function TIdUTF16BigEndianEncoding.GetBytes(const AChars: PIdWideChar; ACharCount: Integer;
  3191. ABytes: PByte; AByteCount: Integer): Integer;
  3192. {$IFDEF ENDIAN_LITTLE}
  3193. var
  3194. I: Integer;
  3195. P: PIdWideChar;
  3196. {$ENDIF}
  3197. begin
  3198. {$IFDEF ENDIAN_LITTLE}
  3199. P := AChars;
  3200. for I := ACharCount - 1 downto 0 do
  3201. begin
  3202. ABytes^ := Hi(UInt16(P^));
  3203. Inc(ABytes);
  3204. ABytes^ := Lo(UInt16(P^));
  3205. Inc(ABytes);
  3206. Inc(P);
  3207. end;
  3208. Result := ACharCount * SizeOf(WideChar);
  3209. {$ELSE}
  3210. Result := ACharCount * SizeOf(WideChar);
  3211. Move(AChars^, ABytes^, Result);
  3212. {$ENDIF}
  3213. end;
  3214. function TIdUTF16BigEndianEncoding.GetChars(const ABytes: PByte; AByteCount: Integer;
  3215. AChars: PIdWideChar; ACharCount: Integer): Integer;
  3216. {$IFDEF ENDIAN_LITTLE}
  3217. var
  3218. P1, P2: PByte;
  3219. I: Integer;
  3220. {$ENDIF}
  3221. begin
  3222. {$IFDEF ENDIAN_LITTLE}
  3223. P1 := ABytes;
  3224. P2 := P1;
  3225. Inc(P1);
  3226. for I := 0 to ACharCount - 1 do
  3227. begin
  3228. AChars^ := WideChar(MakeWord(P1^, P2^));
  3229. Inc(P2, 2);
  3230. Inc(P1, 2);
  3231. Inc(AChars);
  3232. end;
  3233. Result := ACharCount;
  3234. {$ELSE}
  3235. Result := AByteCount div SizeOf(WideChar);
  3236. Move(ABytes^, AChars^, Result * SizeOf(WideChar));
  3237. {$ENDIF}
  3238. end;
  3239. function TIdUTF16BigEndianEncoding.GetPreamble: TIdBytes;
  3240. begin
  3241. SetLength(Result, 2);
  3242. Result[0] := $FE;
  3243. Result[1] := $FF;
  3244. end;
  3245. { TIdASCIIEncoding }
  3246. constructor TIdASCIIEncoding.Create;
  3247. begin
  3248. inherited Create;
  3249. FIsSingleByte := True;
  3250. FMaxCharSize := 1;
  3251. end;
  3252. function TIdASCIIEncoding.GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer;
  3253. begin
  3254. // TODO: decode UTF-16 surrogates...
  3255. Result := ACharCount;
  3256. end;
  3257. function TIdASCIIEncoding.GetBytes(const AChars: PIdWideChar; ACharCount: Integer;
  3258. ABytes: PByte; AByteCount: Integer): Integer;
  3259. var
  3260. P: PIdWideChar;
  3261. i : Integer;
  3262. begin
  3263. // TODO: decode UTF-16 surrogates...
  3264. P := AChars;
  3265. Result := IndyMin(ACharCount, AByteCount);
  3266. for i := 1 to Result do begin
  3267. // replace illegal characters > $7F
  3268. if UInt16(P^) > $007F then begin
  3269. ABytes^ := Byte(Ord('?'));
  3270. end else begin
  3271. ABytes^ := Byte(P^);
  3272. end;
  3273. //advance to next char
  3274. Inc(P);
  3275. Inc(ABytes);
  3276. end;
  3277. end;
  3278. function TIdASCIIEncoding.GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer;
  3279. begin
  3280. Result := AByteCount;
  3281. end;
  3282. function TIdASCIIEncoding.GetChars(const ABytes: PByte; AByteCount: Integer;
  3283. AChars: PIdWideChar; ACharCount: Integer): Integer;
  3284. var
  3285. P: PByte;
  3286. i : Integer;
  3287. begin
  3288. P := ABytes;
  3289. Result := IndyMin(ACharCount, AByteCount);
  3290. for i := 1 to Result do begin
  3291. // This is an invalid byte in the ASCII encoding.
  3292. if P^ > $7F then begin
  3293. UInt16(AChars^) := $FFFD;
  3294. end else begin
  3295. UInt16(AChars^) := P^;
  3296. end;
  3297. //advance to next byte
  3298. Inc(AChars);
  3299. Inc(P);
  3300. end;
  3301. end;
  3302. function TIdASCIIEncoding.GetMaxByteCount(ACharCount: Integer): Integer;
  3303. begin
  3304. Result := ACharCount;
  3305. end;
  3306. function TIdASCIIEncoding.GetMaxCharCount(AByteCount: Integer): Integer;
  3307. begin
  3308. Result := AByteCount;
  3309. end;
  3310. { TId8BitEncoding }
  3311. constructor TId8BitEncoding.Create;
  3312. begin
  3313. inherited Create;
  3314. FIsSingleByte := True;
  3315. FMaxCharSize := 1;
  3316. end;
  3317. function TId8BitEncoding.GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer;
  3318. begin
  3319. // TODO: decode UTF-16 surrogates...
  3320. Result := ACharCount;
  3321. end;
  3322. function TId8BitEncoding.GetBytes(const AChars: PIdWideChar; ACharCount: Integer;
  3323. ABytes: PByte; AByteCount: Integer): Integer;
  3324. var
  3325. P: PIdWideChar;
  3326. i : Integer;
  3327. begin
  3328. // TODO: decode UTF-16 surrogates...
  3329. P := AChars;
  3330. Result := IndyMin(ACharCount, AByteCount);
  3331. for i := 1 to Result do begin
  3332. // replace illegal characters > $FF
  3333. if UInt16(P^) > $00FF then begin
  3334. ABytes^ := Byte(Ord('?'));
  3335. end else begin
  3336. ABytes^ := Byte(P^);
  3337. end;
  3338. //advance to next char
  3339. Inc(P);
  3340. Inc(ABytes);
  3341. end;
  3342. end;
  3343. function TId8BitEncoding.GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer;
  3344. begin
  3345. Result := AByteCount;
  3346. end;
  3347. function TId8BitEncoding.GetChars(const ABytes: PByte; AByteCount: Integer;
  3348. AChars: PIdWideChar; ACharCount: Integer): Integer;
  3349. var
  3350. P: PByte;
  3351. i : Integer;
  3352. begin
  3353. P := ABytes;
  3354. Result := IndyMin(ACharCount, AByteCount);
  3355. for i := 1 to Result do begin
  3356. UInt16(AChars^) := P^;
  3357. //advance to next char
  3358. Inc(AChars);
  3359. Inc(P);
  3360. end;
  3361. end;
  3362. function TId8BitEncoding.GetMaxByteCount(ACharCount: Integer): Integer;
  3363. begin
  3364. Result := ACharCount;
  3365. end;
  3366. function TId8BitEncoding.GetMaxCharCount(AByteCount: Integer): Integer;
  3367. begin
  3368. Result := AByteCount;
  3369. end;
  3370. { TIdVCLEncoding }
  3371. {$IFDEF HAS_TEncoding}
  3372. // RLebeau: this is a hack. The protected members of SysUtils.TEncoding are
  3373. // declared as 'STRICT protected', so a regular accessor will not work here.
  3374. // Only descendants can call them, so we have to expose our own methods that
  3375. // this unit can call, and have them call the inherited methods internally.
  3376. type
  3377. TEncodingAccess = class(TEncoding)
  3378. public
  3379. function IndyGetByteCount(Chars: PChar; CharCount: Integer): Integer;
  3380. function IndyGetBytes(Chars: PChar; CharCount: Integer; Bytes: PByte; ByteCount: Integer): Integer;
  3381. function IndyGetCharCount(Bytes: PByte; ByteCount: Integer): Integer;
  3382. function IndyGetChars(Bytes: PByte; ByteCount: Integer; Chars: PChar; CharCount: Integer): Integer;
  3383. end;
  3384. function TEncodingAccess.IndyGetByteCount(Chars: PChar; CharCount: Integer): Integer;
  3385. begin
  3386. Result := GetByteCount(Chars, CharCount);
  3387. end;
  3388. function TEncodingAccess.IndyGetBytes(Chars: PChar; CharCount: Integer; Bytes: PByte; ByteCount: Integer): Integer;
  3389. begin
  3390. Result := GetBytes(Chars, CharCount, Bytes, ByteCount);
  3391. end;
  3392. function TEncodingAccess.IndyGetCharCount(Bytes: PByte; ByteCount: Integer): Integer;
  3393. begin
  3394. Result := GetCharCount(Bytes, ByteCount);
  3395. end;
  3396. function TEncodingAccess.IndyGetChars(Bytes: PByte; ByteCount: Integer;
  3397. Chars: PChar; CharCount: Integer): Integer;
  3398. begin
  3399. Result := GetChars(Bytes, ByteCount, Chars, CharCount);
  3400. end;
  3401. constructor TIdVCLEncoding.Create(AEncoding: TEncoding; AFreeEncoding: Boolean);
  3402. begin
  3403. inherited Create;
  3404. FEncoding := AEncoding;
  3405. FFreeEncoding := AFreeEncoding and not TEncoding.IsStandardEncoding(AEncoding);
  3406. FIsSingleByte := FEncoding.IsSingleByte;
  3407. end;
  3408. {$IFDEF HAS_TEncoding_GetEncoding_ByEncodingName}
  3409. constructor TIdVCLEncoding.Create(const ACharset: String);
  3410. var
  3411. LCharset: string;
  3412. begin
  3413. // RLebeau 5/2/2017: have seen some malformed emails that use 'utf8'
  3414. // instead of 'utf-8', so let's check for that...
  3415. // RLebeau 9/27/2017: updating to handle a few more UTFs without hyphens...
  3416. case PosInStrArray(ACharset, ['UTF7', 'UTF8', 'UTF16', 'UTF16LE', 'UTF16BE', 'UTF32', 'UTF32LE', 'UTF32BE'], False) of {Do not Localize}
  3417. 0: LCharset := 'UTF-7'; {Do not Localize}
  3418. 1: LCharset := 'UTF-8'; {Do not Localize}
  3419. 2,3: LCharset := 'UTF-16LE'; {Do not Localize}
  3420. 4: LCharset := 'UTF-16BE'; {Do not Localize}
  3421. 5,6: LCharset := 'UTF-32LE'; {Do not Localize}
  3422. 7: LCharset := 'UTF-32BE'; {Do not Localize}
  3423. else
  3424. LCharset := ACharset;
  3425. end;
  3426. Create(TEncoding.GetEncoding(LCharset), True);
  3427. end;
  3428. {$ENDIF}
  3429. constructor TIdVCLEncoding.Create(const ACodepage: UInt16);
  3430. begin
  3431. Create(TEncoding.GetEncoding(ACodepage), True);
  3432. end;
  3433. destructor TIdVCLEncoding.Destroy;
  3434. begin
  3435. if FFreeEncoding then begin
  3436. FEncoding.Free;
  3437. end;
  3438. inherited Destroy;
  3439. end;
  3440. function TIdVCLEncoding.GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer;
  3441. begin
  3442. Result := TEncodingAccess(FEncoding).IndyGetByteCount(AChars, ACharCount);
  3443. end;
  3444. function TIdVCLEncoding.GetBytes(const AChars: PIdWideChar; ACharCount: Integer;
  3445. ABytes: PByte; AByteCount: Integer): Integer;
  3446. begin
  3447. Result := TEncodingAccess(FEncoding).IndyGetBytes(AChars, ACharCount, ABytes, AByteCount);
  3448. end;
  3449. function TIdVCLEncoding.GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer;
  3450. begin
  3451. Result := TEncodingAccess(FEncoding).IndyGetCharCount(ABytes, AByteCount);
  3452. end;
  3453. function TIdVCLEncoding.GetChars(const ABytes: PByte; AByteCount: Integer;
  3454. AChars: PIdWideChar; ACharCount: Integer): Integer;
  3455. begin
  3456. Result := TEncodingAccess(FEncoding).IndyGetChars(ABytes, AByteCount, AChars, ACharCount);
  3457. end;
  3458. function TIdVCLEncoding.GetMaxByteCount(ACharCount: Integer): Integer;
  3459. begin
  3460. Result := FEncoding.GetMaxByteCount(ACharCount);
  3461. end;
  3462. function TIdVCLEncoding.GetMaxCharCount(AByteCount: Integer): Integer;
  3463. begin
  3464. Result := FEncoding.GetMaxCharCount(AByteCount);
  3465. end;
  3466. {$ENDIF}
  3467. {$ENDIF}
  3468. function IndyTextEncoding(AType: IdTextEncodingType): IIdTextEncoding;
  3469. begin
  3470. case AType of
  3471. encIndyDefault: Result := IndyTextEncoding_Default;
  3472. // encOSDefault handled further below
  3473. enc8Bit: Result := IndyTextEncoding_8Bit;
  3474. encASCII: Result := IndyTextEncoding_ASCII;
  3475. encUTF16BE: Result := IndyTextEncoding_UTF16BE;
  3476. encUTF16LE: Result := IndyTextEncoding_UTF16LE;
  3477. encUTF7: Result := IndyTextEncoding_UTF7;
  3478. encUTF8: Result := IndyTextEncoding_UTF8;
  3479. else
  3480. // encOSDefault
  3481. Result := IndyTextEncoding_OSDefault;
  3482. end;
  3483. end;
  3484. function IndyTextEncoding(ACodepage: UInt16): IIdTextEncoding;
  3485. begin
  3486. {$IFDEF DOTNET}
  3487. Result := TIdDotNetEncoding.Create(ACodepage);
  3488. {$ELSE}
  3489. case ACodepage of
  3490. 20127:
  3491. Result := IndyTextEncoding_ASCII;
  3492. 1200:
  3493. Result := IndyTextEncoding_UTF16LE;
  3494. 1201:
  3495. Result := IndyTextEncoding_UTF16BE;
  3496. 65000:
  3497. Result := IndyTextEncoding_UTF7;
  3498. 65001:
  3499. Result := IndyTextEncoding_UTF8;
  3500. // TODO: add support for UTF-32...
  3501. else
  3502. {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
  3503. Result := TIdMBCSEncoding.Create(ACodepage);
  3504. {$ELSE}
  3505. {$IFDEF HAS_TEncoding}
  3506. Result := TIdVCLEncoding.Create(ACodepage);
  3507. {$ELSE}
  3508. Result := nil;
  3509. raise EIdException.CreateResFmt(@RSUnsupportedCodePage, [ACodepage]);
  3510. {$ENDIF}
  3511. {$ENDIF}
  3512. end;
  3513. {$ENDIF}
  3514. end;
  3515. function IndyTextEncoding(const ACharSet: String): IIdTextEncoding;
  3516. begin
  3517. {$IFDEF DOTNET}
  3518. Result := TIdDotNetEncoding.Create(ACharSet);
  3519. {$ELSE}
  3520. // TODO: move IdCharsets unit into the System package so the
  3521. // IdGlobalProtocols.CharsetToEncoding() function can be moved
  3522. // into this unit...
  3523. if IsCharsetASCII(ACharSet) then begin
  3524. Result := IndyTextEncoding_ASCII;
  3525. end else begin
  3526. // RLebeau 5/2/2017: have seen some malformed emails that use 'utf8'
  3527. // instead of 'utf-8', so let's check for that...
  3528. // RLebeau 9/27/2017: updating to handle a few more UTFs without hyphens...
  3529. case PosInStrArray(ACharset, ['UTF-7', 'UTF7', 'UTF-8', 'UTF8', 'UTF-16', 'UTF16', 'UTF-16LE', 'UTF16LE', 'UTF-16BE', 'UTF16BE'], False) of {Do not Localize}
  3530. 0, 1: Result := IndyTextEncoding_UTF7;
  3531. 2, 3: Result := IndyTextEncoding_UTF8;
  3532. 4..7: Result := IndyTextEncoding_UTF16LE;
  3533. 8, 9: Result := IndyTextEncoding_UTF16BE;
  3534. // TODO: add support for UTF-32...
  3535. else
  3536. {$IFDEF USE_ICONV}
  3537. Result := TIdMBCSEncoding.Create(ACharSet);
  3538. {$ELSE}
  3539. {$IFDEF HAS_TEncoding_GetEncoding_ByEncodingName}
  3540. Result := TIdVCLEncoding.Create(ACharSet);
  3541. {$ELSE}
  3542. // TODO: provide a hook that IdGlobalProtocols can assign to so we can call
  3543. // CharsetToCodePage() here, at least until CharsetToEncoding() can be moved
  3544. // to this unit once IdCharsets has been moved to the System package...
  3545. Result := nil;
  3546. raise EIdException.CreateFmt(RSUnsupportedCharSet, [ACharSet]);
  3547. {$ENDIF}
  3548. {$ENDIF}
  3549. end;
  3550. end;
  3551. {$ENDIF}
  3552. end;
  3553. {$IFDEF DOTNET}
  3554. function IndyTextEncoding(AEncoding: System.Text.Encoding): IIdTextEncoding;
  3555. begin
  3556. Result := TIdDotNetEncoding.Create(AEncoding);
  3557. end;
  3558. {$ENDIF}
  3559. {$IFDEF HAS_TEncoding}
  3560. function IndyTextEncoding(AEncoding: TEncoding; AFreeEncoding: Boolean = False): IIdTextEncoding;
  3561. begin
  3562. Result := TIdVCLEncoding.Create(AEncoding, AFreeEncoding);
  3563. end;
  3564. {$ENDIF}
  3565. function IndyTextEncoding_Default: IIdTextEncoding;
  3566. var
  3567. LType: IdTextEncodingType;
  3568. begin
  3569. LType := GIdDefaultTextEncoding;
  3570. if LType = encIndyDefault then begin
  3571. LType := encASCII;
  3572. end;
  3573. Result := IndyTextEncoding(LType);
  3574. end;
  3575. function IndyTextEncoding_OSDefault: IIdTextEncoding;
  3576. {$IFNDEF DOTNET}
  3577. var
  3578. LEncoding: IIdTextEncoding;
  3579. {$ENDIF}
  3580. begin
  3581. if GIdOSDefaultEncoding = nil then begin
  3582. {$IFDEF DOTNET}
  3583. // TODO: use thread-safe assignment
  3584. GIdOSDefaultEncoding := TIdDotNetEncoding.Create(System.Text.Encoding.Default);
  3585. {$ELSE}
  3586. // TODO: SysUtils.TEncoding.Default uses ANSI on Windows
  3587. // but uses UTF-8 on POSIX, so we should do the same...
  3588. //LEncoding := {$IFDEF WINDOWS}TIdMBCSEncoding{$ELSE}TIdUTF8Encoding{$ENDIF}.Create;
  3589. LEncoding := TIdMBCSEncoding.Create;
  3590. if InterlockedCompareExchangeIntf(IInterface(GIdOSDefaultEncoding), LEncoding, nil) <> nil then begin
  3591. LEncoding := nil;
  3592. end;
  3593. {$ENDIF}
  3594. end;
  3595. Result := GIdOSDefaultEncoding;
  3596. end;
  3597. function IndyTextEncoding_8Bit: IIdTextEncoding;
  3598. {$IFNDEF DOTNET}
  3599. var
  3600. LEncoding: IIdTextEncoding;
  3601. {$ENDIF}
  3602. begin
  3603. if GId8BitEncoding = nil then begin
  3604. {$IFDEF DOTNET}
  3605. // We need a charset that converts UTF-16 codeunits in the $00-$FF range
  3606. // to/from their numeric values as-is. Was previously using "Windows-1252"
  3607. // which does so for most codeunits, however codeunits $80-$9F in
  3608. // Windows-1252 map to different codepoints in Unicode, which we don't want.
  3609. // "ISO-8859-1" aka "ISO_8859-1:1987" (not to be confused with the older
  3610. // "ISO 8859-1" charset), on the other hand, treats codeunits $00-$FF as-is,
  3611. // and seems to be just as widely supported as Windows-1252 on most systems,
  3612. // so we'll use that for now...
  3613. // TODO: use thread-safe assignment
  3614. GId8BitEncoding := TIdDotNetEncoding.Create('ISO-8859-1');
  3615. {$ELSE}
  3616. LEncoding := TId8BitEncoding.Create;
  3617. if InterlockedCompareExchangeIntf(IInterface(GId8BitEncoding), LEncoding, nil) <> nil then begin
  3618. LEncoding := nil;
  3619. end;
  3620. {$ENDIF}
  3621. end;
  3622. Result := GId8BitEncoding;
  3623. end;
  3624. function IndyTextEncoding_ASCII: IIdTextEncoding;
  3625. {$IFNDEF DOTNET}
  3626. var
  3627. LEncoding: IIdTextEncoding;
  3628. {$ENDIF}
  3629. begin
  3630. if GIdASCIIEncoding = nil then begin
  3631. {$IFDEF DOTNET}
  3632. // TODO: use thread-safe assignment
  3633. GIdASCIIEncoding := TIdDotNetEncoding.Creeate(System.Text.Encoding.ASCII);
  3634. {$ELSE}
  3635. LEncoding := TIdASCIIEncoding.Create;
  3636. if InterlockedCompareExchangeIntf(IInterface(GIdASCIIEncoding), LEncoding, nil) <> nil then begin
  3637. LEncoding := nil;
  3638. end;
  3639. {$ENDIF}
  3640. end;
  3641. Result := GIdASCIIEncoding;
  3642. end;
  3643. function IndyTextEncoding_UTF16BE: IIdTextEncoding;
  3644. {$IFNDEF DOTNET}
  3645. var
  3646. LEncoding: IIdTextEncoding;
  3647. {$ENDIF}
  3648. begin
  3649. if GIdUTF16BigEndianEncoding = nil then begin
  3650. {$IFDEF DOTNET}
  3651. // TODO: use thread-safe assignment
  3652. GIdUTF16BigEndianEncoding := TIdDotNetEncoding.Create(System.Text.Encoding.BigEndianUnicode);
  3653. {$ELSE}
  3654. LEncoding := TIdUTF16BigEndianEncoding.Create;
  3655. if InterlockedCompareExchangeIntf(IInterface(GIdUTF16BigEndianEncoding), LEncoding, nil) <> nil then begin
  3656. LEncoding := nil;
  3657. end;
  3658. {$ENDIF}
  3659. end;
  3660. Result := GIdUTF16BigEndianEncoding;
  3661. end;
  3662. function IndyTextEncoding_UTF16LE: IIdTextEncoding;
  3663. {$IFNDEF DOTNET}
  3664. var
  3665. LEncoding: IIdTextEncoding;
  3666. {$ENDIF}
  3667. begin
  3668. if GIdUTF16LittleEndianEncoding = nil then begin
  3669. {$IFDEF DOTNET}
  3670. // TODO: use thread-safe assignment
  3671. GIdUTF16LittleEndianEncoding := TIdDotNetEncoding.Create(System.Text.Encoding.Unicode);
  3672. {$ELSE}
  3673. LEncoding := TIdUTF16LittleEndianEncoding.Create;
  3674. if InterlockedCompareExchangeIntf(IInterface(GIdUTF16LittleEndianEncoding), LEncoding, nil) <> nil then begin
  3675. LEncoding := nil;
  3676. end;
  3677. {$ENDIF}
  3678. end;
  3679. Result := GIdUTF16LittleEndianEncoding;
  3680. end;
  3681. function IndyTextEncoding_UTF7: IIdTextEncoding;
  3682. {$IFNDEF DOTNET}
  3683. var
  3684. LEncoding: IIdTextEncoding;
  3685. {$ENDIF}
  3686. begin
  3687. if GIdUTF7Encoding = nil then begin
  3688. {$IFDEF DOTNET}
  3689. // TODO: use thread-safe assignment
  3690. GIdUTF7Encoding := TIdDotNetEncoding.Create(System.Text.Encoding.UTF7);
  3691. {$ELSE}
  3692. LEncoding := TIdUTF7Encoding.Create;
  3693. if InterlockedCompareExchangeIntf(IInterface(GIdUTF7Encoding), LEncoding, nil) <> nil then begin
  3694. LEncoding := nil;
  3695. end;
  3696. {$ENDIF}
  3697. end;
  3698. Result := GIdUTF7Encoding;
  3699. end;
  3700. function IndyTextEncoding_UTF8: IIdTextEncoding;
  3701. {$IFNDEF DOTNET}
  3702. var
  3703. LEncoding: IIdTextEncoding;
  3704. {$ENDIF}
  3705. begin
  3706. if GIdUTF8Encoding = nil then begin
  3707. {$IFDEF DOTNET}
  3708. // TODO: use thread-safe assignment
  3709. GIdUTF8Encoding := TIdDotNetEncoding.Create(System.Text.Encoding.UTF8);
  3710. {$ELSE}
  3711. LEncoding := TIdUTF8Encoding.Create;
  3712. if InterlockedCompareExchangeIntf(IInterface(GIdUTF8Encoding), LEncoding, nil) <> nil then begin
  3713. LEncoding := nil;
  3714. end;
  3715. {$ENDIF}
  3716. end;
  3717. Result := GIdUTF8Encoding;
  3718. end;
  3719. {$I IdDeprecatedImplBugOff.inc}
  3720. function enDefault: IIdTextEncoding;
  3721. {$I IdDeprecatedImplBugOn.inc}
  3722. {$IFDEF USE_INLINE}inline;{$ENDIF}
  3723. begin
  3724. Result := nil;
  3725. end;
  3726. {$I IdDeprecatedImplBugOff.inc}
  3727. function en7Bit: IIdTextEncoding;
  3728. {$I IdDeprecatedImplBugOn.inc}
  3729. {$IFDEF USE_INLINE}inline;{$ENDIF}
  3730. begin
  3731. Result := IndyTextEncoding_ASCII;
  3732. end;
  3733. {$I IdDeprecatedImplBugOff.inc}
  3734. function en8Bit: IIdTextEncoding;
  3735. {$I IdDeprecatedImplBugOn.inc}
  3736. {$IFDEF USE_INLINE}inline;{$ENDIF}
  3737. begin
  3738. Result := IndyTextEncoding_8Bit;
  3739. end;
  3740. {$I IdDeprecatedImplBugOff.inc}
  3741. function enUTF8: IIdTextEncoding;
  3742. {$I IdDeprecatedImplBugOn.inc}
  3743. {$IFDEF USE_INLINE}inline;{$ENDIF}
  3744. begin
  3745. Result := IndyTextEncoding_UTF8;
  3746. end;
  3747. {$I IdDeprecatedImplBugOff.inc}
  3748. function Indy8BitEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
  3749. {$I IdDeprecatedImplBugOn.inc}
  3750. begin
  3751. {$IFNDEF DOTNET}
  3752. if not AOwnedByIndy then begin
  3753. Result := TId8BitEncoding.Create;
  3754. Exit;
  3755. end;
  3756. {$ENDIF}
  3757. Result := IndyTextEncoding_8Bit;
  3758. end;
  3759. {$I IdDeprecatedImplBugOff.inc}
  3760. function IndyASCIIEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
  3761. {$I IdDeprecatedImplBugOn.inc}
  3762. begin
  3763. {$IFNDEF DOTNET}
  3764. if not AOwnedByIndy then begin
  3765. Result := TIdASCIIEncoding.Create;
  3766. Exit;
  3767. end;
  3768. {$ENDIF}
  3769. Result := IndyTextEncoding_ASCII;
  3770. end;
  3771. {$I IdDeprecatedImplBugOff.inc}
  3772. function IndyUTF16BigEndianEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
  3773. {$I IdDeprecatedImplBugOn.inc}
  3774. begin
  3775. {$IFNDEF DOTNET}
  3776. if not AOwnedByIndy then begin
  3777. Result := TIdUTF16BigEndianEncoding.Create;
  3778. Exit;
  3779. end;
  3780. {$ENDIF}
  3781. Result := IndyTextEncoding_UTF16BE;
  3782. end;
  3783. {$I IdDeprecatedImplBugOff.inc}
  3784. function IndyUTF16LittleEndianEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
  3785. {$I IdDeprecatedImplBugOn.inc}
  3786. begin
  3787. {$IFNDEF DOTNET}
  3788. if not AOwnedByIndy then begin
  3789. Result := TIdUTF16LittleEndianEncoding.Create;
  3790. Exit;
  3791. end;
  3792. {$ENDIF}
  3793. Result := IndyTextEncoding_UTF16LE;
  3794. end;
  3795. {$I IdDeprecatedImplBugOff.inc}
  3796. function IndyOSDefaultEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
  3797. {$I IdDeprecatedImplBugOn.inc}
  3798. begin
  3799. {$IFNDEF DOTNET}
  3800. if not AOwnedByIndy then begin
  3801. // TODO: SysUtils.TEncoding.Default uses ANSI on Windows
  3802. // but uses UTF-8 on POSIX, so we should do the same...
  3803. //Result := {$IFDEF WINDOWS}TIdMBCSEncoding{$ELSE}TIdUTF8Encoding{$ENDIF}.Create;
  3804. Result := TIdMBCSEncoding.Create;
  3805. Exit;
  3806. end;
  3807. {$ENDIF}
  3808. Result := IndyTextEncoding_OSDefault;
  3809. end;
  3810. {$I IdDeprecatedImplBugOff.inc}
  3811. function IndyUTF7Encoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
  3812. {$I IdDeprecatedImplBugOn.inc}
  3813. begin
  3814. {$IFNDEF DOTNET}
  3815. if not AOwnedByIndy then begin
  3816. Result := TIdUTF7Encoding.Create;
  3817. Exit;
  3818. end;
  3819. {$ENDIF}
  3820. Result := IndyTextEncoding_UTF7;
  3821. end;
  3822. {$I IdDeprecatedImplBugOff.inc}
  3823. function IndyUTF8Encoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
  3824. {$I IdDeprecatedImplBugOn.inc}
  3825. begin
  3826. {$IFNDEF DOTNET}
  3827. if not AOwnedByIndy then begin
  3828. Result := TIdUTF8Encoding.Create;
  3829. Exit;
  3830. end;
  3831. {$ENDIF}
  3832. Result := IndyTextEncoding_UTF8;
  3833. end;
  3834. {$IFNDEF DOTNET}
  3835. function GetEncodingCodePage(AEncoding: IIdTextEncoding): UInt16;
  3836. begin
  3837. Result := 0;
  3838. if AEncoding = nil then begin
  3839. Exit;
  3840. end;
  3841. // RLebeau 2/15/2019: AEncoding is checked this way until IIdTextEncoding is updated to expose its assigned CodePage...
  3842. {$IFDEF USE_ICONV}
  3843. {
  3844. if AEncoding is TIdMBCSEncoding then begin
  3845. 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
  3846. 0, 1: Result := 65000;
  3847. 2, 3: Result := 65001;
  3848. 4..7: Result := 1200;
  3849. 8, 9: Result := 1201;
  3850. 10: Result := ($IFDEF HAS_SetCodePage)DefaultSystemCodePage($ELSE)0($ENDIF);
  3851. 11: Result := 28591;
  3852. // TODO: add support for UTF-32...
  3853. else
  3854. if IsCharsetASCII(TIdMBCSEncoding(AEncoding).FCharSet) then begin
  3855. Result := 20127;
  3856. end;
  3857. end;
  3858. end
  3859. else
  3860. }
  3861. {$ELSE}
  3862. {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
  3863. {
  3864. if AEncoding is TIdMBCSEncoding then begin
  3865. Result := TIdMBCSEncoding(AEncoding).FCodePage;
  3866. end
  3867. else
  3868. }
  3869. {$ENDIF}
  3870. {$ENDIF}
  3871. if (AEncoding = GIdOSDefaultEncoding) then
  3872. begin
  3873. {$IFDEF HAS_SetCodePage}
  3874. Result := DefaultSystemCodePage;
  3875. {$ELSE}
  3876. {$IFDEF WINDOWS}
  3877. Result := GetACP();
  3878. {$ENDIF}
  3879. {$ENDIF}
  3880. end
  3881. else if (AEncoding = GId8BitEncoding) {or (AEncoding is TId8BitEncoding)} then
  3882. begin
  3883. Result := 28591;
  3884. end
  3885. else if (AEncoding = GIdASCIIEncoding) {or (AEncoding is TIdASCIIEncoding)} then
  3886. begin
  3887. Result := 20127;
  3888. end
  3889. else if (AEncoding = GIdUTF16BigEndianEncoding) {or (AEncoding is TIdUTF16BigEndianEncoding)} then
  3890. begin
  3891. Result := 1201;
  3892. end
  3893. else if (AEncoding = GIdUTF16LittleEndianEncoding) {or (AEncoding is TIdUTF16LittleEndianEncoding)} then
  3894. begin
  3895. Result := 1200;
  3896. end
  3897. else if (AEncoding = GIdUTF7Encoding) {or (AEncoding is TIdUTF7Encoding)} then
  3898. begin
  3899. Result := 65000;
  3900. end
  3901. else if (AEncoding = GIdUTF8Encoding) {or (AEncoding is TIdUTF8Encoding)} then
  3902. begin
  3903. Result := 65001;
  3904. end;
  3905. end;
  3906. {$ENDIF}
  3907. {$IFDEF UNIX}
  3908. function HackLoadFileName(const ALibName, ALibVer : String) : string;
  3909. {$IFDEF USE_INLINE}inline;{$ENDIF}
  3910. begin
  3911. {$IFDEF OSX_OR_IOS}
  3912. Result := ALibName + ALibVer + LIBEXT;
  3913. {$ELSE}
  3914. Result := ALibName + LIBEXT + ALibVer;
  3915. {$ENDIF}
  3916. end;
  3917. function HackLoad(const ALibName : String; const ALibVersions : array of String) : TIdLibHandle;
  3918. var
  3919. i : Integer;
  3920. function LoadLibVer(const ALibVer: string): TIdLibHandle;
  3921. var
  3922. FileName: string;
  3923. begin
  3924. FileName := HackLoadFileName(ALibName, ALibVer);
  3925. {$IFDEF USE_SAFELOADLIBRARY}
  3926. Result := SafeLoadLibrary(FileName);
  3927. {$ELSE}
  3928. {$IFDEF KYLIXCOMPAT}
  3929. // Workaround that is required under Linux (changed RTLD_GLOBAL with RTLD_LAZY Note: also work with LoadLibrary())
  3930. // TODO: use ToSingleByteFileSystemEncodedFileName() to encode the filename:
  3931. // Result := TIdLibHandle(dlopen(PAnsiChar(ToSingleByteFileSystemEncodedFileName(FileName)), RTLD_LAZY));
  3932. // TODO: use dynlibs.SysLoadLibraryU() instead:
  3933. // Result := SysLoadLibraryU(FileName);
  3934. Result := TIdLibHandle(dlopen(PAnsiChar(FileName), RTLD_LAZY));
  3935. {$ELSE}
  3936. Result := LoadLibrary(FileName);
  3937. {$ENDIF}
  3938. {$ENDIF}
  3939. {$IFDEF USE_INVALIDATE_MOD_CACHE}
  3940. InvalidateModuleCache;
  3941. {$ENDIF}
  3942. end;
  3943. begin
  3944. if High(ALibVersions) > -1 then begin
  3945. Result := IdNilHandle;
  3946. for i := Low(ALibVersions) to High(ALibVersions) do
  3947. begin
  3948. Result := LoadLibVer(ALibVersions[i]);
  3949. if Result <> IdNilHandle then begin
  3950. Break;
  3951. end;
  3952. end;
  3953. end else begin
  3954. Result := LoadLibVer('');
  3955. end;
  3956. end;
  3957. {$ENDIF}
  3958. procedure IndyRaiseLastError;
  3959. {$IFDEF USE_INLINE}inline;{$ENDIF}
  3960. begin
  3961. {$IFNDEF HAS_RaiseLastOSError}
  3962. RaiseLastWin32Error;
  3963. {$ELSE}
  3964. RaiseLastOSError;
  3965. {$ENDIF}
  3966. end;
  3967. {$IFDEF HAS_Exception_RaiseOuterException}
  3968. procedure IndyRaiseOuterException(AOuterException: Exception);
  3969. {$IFDEF USE_INLINE}inline;{$ENDIF}
  3970. begin
  3971. Exception.RaiseOuterException(AOuterException);
  3972. end;
  3973. {$ELSE}
  3974. {$IFDEF DCC}
  3975. // RLebeau: There is no Exception.InnerException property to capture the inner
  3976. // exception into, but we can still raise the outer exception using Delphi's
  3977. // 'raise ... at [address]' syntax, at least. This way, the debugger (and
  3978. // exception loggers) can show the outer exception occuring in the caller
  3979. // rather than inside this function...
  3980. {$IFDEF HAS_System_ReturnAddress}
  3981. procedure IndyRaiseOuterException(AOuterException: Exception);
  3982. begin
  3983. raise AOuterException at ReturnAddress;
  3984. end;
  3985. {$ELSE}
  3986. // RLebeau: Delphi RTL functions like SysUtils.Abort(), Classes.TList.Error(),
  3987. // and Classes.TStrings.Error() raise their respective exceptions at the
  3988. // caller's return address using Delphi's 'raise ... at [address]' syntax,
  3989. // however they do so in different ways depending on Delphi version!
  3990. //
  3991. // ----------------
  3992. // SysUtils.Abort()
  3993. // ----------------
  3994. // Delphi 5-2007: Abort() calls an internal helper function that returns the
  3995. // caller's return address from the call stack - [EBP-4] in Delphi 5, [EBP+4]
  3996. // in Delphi 6+ - and then passes that value to 'raise'. Not sure why [EBP-4]
  3997. // was being used in Delphi 5. Maybe a typo?
  3998. //
  3999. // Delphi 2009-XE: Abort() JMP's into an internal helper procedure that takes
  4000. // a Pointer parameter as input (passed in EAX) and passes it to 'raise'.
  4001. // Delphi 2009-2010 POP's the caller's return address from the call stack
  4002. // into EAX. Delphi XE simply MOV's [ESP] into EAX instead.
  4003. // ----------------
  4004. // TList.Error()
  4005. // TStrings.Error()
  4006. // ----------------
  4007. // Delphi 5-2010: Error() calls an internal helper function that returns the
  4008. // caller's return address from the call stack - always [EBP+4] - and then passes
  4009. // that value to 'raise'.
  4010. //
  4011. // Delphi XE: no helper is used. Error() is wrapped with {$O-} to force a stack
  4012. // frame, and then reads the caller's return address directly from the call stack
  4013. // (using pointer math to find it) and passes it to 'raise'.
  4014. // ----------------
  4015. //
  4016. // To be safe, we will use the MOV [ESP] approach here, as it is the simplest.
  4017. // We only have to worry about this in Delphi's Windows 32bit compiler, as the
  4018. // 64bit and mobile compilers have System.ReturnAddress available...
  4019. // disable stack frames to reduce instructions
  4020. {$I IdStackFramesOff.inc}
  4021. procedure IndyRaiseOuterException(AOuterException: Exception);
  4022. procedure RaiseE(E: Exception; ReturnAddr: Pointer);
  4023. begin
  4024. raise E at ReturnAddr;
  4025. end;
  4026. asm
  4027. // AOuterException is already in EAX...
  4028. // MOV EAX, AOuterException
  4029. MOV EDX, [ESP]
  4030. JMP RaiseE
  4031. end;
  4032. {$I IdStackFramesOn.inc}
  4033. {$ENDIF}
  4034. {$ELSE}
  4035. // Not Delphi, so just raise the exception as-is until we know what else to do with it...
  4036. procedure IndyRaiseOuterException(AOuterException: Exception);
  4037. begin
  4038. raise AOuterException;
  4039. end;
  4040. {$ENDIF}
  4041. {$ENDIF}
  4042. {$IFNDEF DOTNET}
  4043. function InterlockedExchangeTHandle(var VTarget: THandle; const AValue: THandle): THandle;
  4044. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4045. begin
  4046. {$IFDEF HAS_TInterlocked}
  4047. {$IFDEF THANDLE_32}
  4048. Result := THandle(TInterlocked.Exchange(Integer(VTarget), Integer(AValue)));
  4049. {$ENDIF}
  4050. //Temporary workaround. TInterlocked for Emb really should accept 64 bit unsigned values as set of parameters
  4051. //for TInterlocked.Exchange since 64-bit wide integers are common on 64 bit platforms.
  4052. {$IFDEF THANDLE_64}
  4053. Result := THandle(TInterlocked.Exchange(Int64(VTarget), Int64(AValue)));
  4054. {$ENDIF}
  4055. {$ELSE}
  4056. {$IFDEF THANDLE_32}
  4057. Result := THandle(InterlockedExchange(Integer(VTarget), Integer(AValue)));
  4058. {$ENDIF}
  4059. {$IFDEF THANDLE_64}
  4060. Result := THandle(InterlockedExchange64(Int64(VTarget), Int64(AValue)));
  4061. {$ENDIF}
  4062. {$ENDIF}
  4063. end;
  4064. function InterlockedExchangeTLibHandle(var VTarget: TIdLibHandle; const AValue: TIdLibHandle): TIdLibHandle;
  4065. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4066. begin
  4067. Result := TIdLibHandle(
  4068. {$IFDEF HAS_TInterlocked}
  4069. TInterlocked.Exchange(
  4070. {$IFDEF CPU64}
  4071. Int64(VTarget), Int64(AValue)
  4072. {$ELSE}
  4073. Integer(VTarget), Integer(AValue)
  4074. {$ENDIF}
  4075. )
  4076. {$ELSE}
  4077. {$IFDEF CPU64}
  4078. InterlockedExchange64(Int64(VTarget), Int64(AValue))
  4079. {$ELSE}
  4080. InterlockedExchange(Integer(VTarget), Integer(AValue))
  4081. {$ENDIF}
  4082. {$ENDIF}
  4083. );
  4084. end;
  4085. {$UNDEF DYNAMICLOAD_InterlockedCompareExchange}
  4086. {$IFNDEF HAS_TInterlocked}
  4087. {$IFNDEF FPC}
  4088. // RLebeau: InterlockedCompareExchange() is not available prior to Win2K,
  4089. // so need to fallback to some other logic on older systems. Not too many
  4090. // people still support those systems anymore, so we will make this optional.
  4091. //
  4092. // InterlockedCompareExchange64(), on the other hand, is not available until
  4093. // Windows Vista (and not defined in any version of Windows.pas up to Delphi
  4094. // XE), so always dynamically load it in order to support WinXP 64-bit...
  4095. {$IFDEF CPU64}
  4096. {$DEFINE DYNAMICLOAD_InterlockedCompareExchange}
  4097. {$ELSE}
  4098. {.$DEFINE STATICLOAD_InterlockedCompareExchange}
  4099. {$ENDIF}
  4100. {$ENDIF}
  4101. {$ENDIF}
  4102. {$IFDEF DYNAMICLOAD_InterlockedCompareExchange}
  4103. // See http://code.google.com/p/delphi-toolbox/source/browse/trunk/RTLEx/RTLEx.BasicOp.Atomic.pas
  4104. // for how to perform interlocked operations in assembler...
  4105. type
  4106. TInterlockedCompareExchangeFunc = function(var Destination: PtrInt; Exchange, Comparand: PtrInt): PtrInt; stdcall;
  4107. var
  4108. InterlockedCompareExchange: TInterlockedCompareExchangeFunc = nil;
  4109. function Impl_InterlockedCompareExchange(var Destination: PtrInt; Exchange, Comparand: PtrInt): PtrInt; stdcall;
  4110. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4111. begin
  4112. {$IFDEF CPU64}
  4113. // TODO: use LOCK CMPXCHG8B directly so this is more atomic...
  4114. {$ELSE}
  4115. // TODO: use LOCK CMPXCHG directly so this is more atomic...
  4116. {$ENDIF}
  4117. Result := Destination;
  4118. if Destination = Comparand then begin
  4119. Destination := Exchange;
  4120. end;
  4121. end;
  4122. function Stub_InterlockedCompareExchange(var Destination: PtrInt; Exchange, Comparand: PtrInt): PtrInt; stdcall;
  4123. function GetImpl: Pointer;
  4124. const
  4125. cKernel32 = 'KERNEL32'; {do not localize}
  4126. // TODO: what is Embarcadero's 64-bit define going to be?
  4127. cInterlockedCompareExchange = {$IFDEF CPU64}'InterlockedCompareExchange64'{$ELSE}'InterlockedCompareExchange'{$ENDIF}; {do not localize}
  4128. begin
  4129. Result := GetProcAddress(GetModuleHandle(cKernel32), cInterlockedCompareExchange);
  4130. if Result = nil then begin
  4131. Result := @Impl_InterlockedCompareExchange;
  4132. end;
  4133. end;
  4134. begin
  4135. @InterlockedCompareExchange := GetImpl();
  4136. Result := InterlockedCompareExchange(Destination, Exchange, Comparand);
  4137. end;
  4138. {$ENDIF}
  4139. function InterlockedCompareExchangePtr(var VTarget: Pointer; const AValue, Compare: Pointer): Pointer;
  4140. {$IFNDEF DYNAMICLOAD_InterlockedCompareExchange}
  4141. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4142. {$ENDIF}
  4143. begin
  4144. {$IFDEF DYNAMICLOAD_InterlockedCompareExchange}
  4145. Result := Pointer(IdGlobal.InterlockedCompareExchange(PtrInt(VTarget), PtrInt(AValue), PtrInt(Compare)));
  4146. {$ELSE}
  4147. {$IFDEF HAS_TInterlocked}
  4148. Result := TInterlocked.CompareExchange(VTarget, AValue, Compare);
  4149. {$ELSE}
  4150. {$IFDEF HAS_InterlockedCompareExchangePointer}
  4151. Result := InterlockedCompareExchangePointer(VTarget, AValue, Compare);
  4152. {$ELSE}
  4153. {$IFDEF HAS_InterlockedCompareExchange_Pointers}
  4154. //work around a conflicting definition for InterlockedCompareExchange
  4155. Result := {$IFDEF FPC}system.{$ENDIF}InterlockedCompareExchange(VTarget, AValue, Compare);
  4156. {$ELSE}
  4157. {$IFDEF FPC}
  4158. Result := Pointer(
  4159. {$IFDEF CPU64}InterlockedCompareExchange64{$ELSE}InterlockedCompareExchange{$ENDIF}
  4160. (PtrInt(VTarget), PtrInt(AValue), PtrInt(Compare))
  4161. );
  4162. {$ELSE}
  4163. // Delphi 64-bit is handled by HAS_InterlockedCompareExchangePointer
  4164. Result := Pointer(InterlockedCompareExchange(Integer(VTarget), Integer(AValue), Integer(Compare)));
  4165. {$ENDIF}
  4166. {$ENDIF}
  4167. {$ENDIF}
  4168. {$ENDIF}
  4169. {$ENDIF}
  4170. end;
  4171. function InterlockedCompareExchangeObj(var VTarget: TObject; const AValue, Compare: TObject): TObject;
  4172. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4173. begin
  4174. {$IFDEF HAS_TInterlocked}
  4175. // for ARC, we have to use the TObject overload of TInterlocked to ensure
  4176. // that the reference counts of the objects are managed correctly...
  4177. Result := TInterlocked.CompareExchange(VTarget, AValue, Compare);
  4178. {$ELSE}
  4179. Result := TObject(InterlockedCompareExchangePtr(Pointer(VTarget), Pointer(AValue), Pointer(Compare)));
  4180. {$ENDIF}
  4181. end;
  4182. function InterlockedCompareExchangeIntf(var VTarget: IInterface; const AValue, Compare: IInterface): IInterface;
  4183. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4184. begin
  4185. // TInterlocked does not have an overload for IInterface.
  4186. // We have to ensure that the reference counts of the interfaces are managed correctly...
  4187. if AValue <> nil then begin
  4188. AValue._AddRef;
  4189. end;
  4190. Result := IInterface(InterlockedCompareExchangePtr(Pointer(VTarget), Pointer(AValue), Pointer(Compare)));
  4191. if (AValue <> nil) and (Pointer(Result) <> Pointer(Compare)) then begin
  4192. AValue._Release;
  4193. end;
  4194. end;
  4195. {$ENDIF}
  4196. {Little Endian Byte order functions from:
  4197. From: http://community.borland.com/article/0,1410,16854,00.html
  4198. Big-endian and little-endian formated integers - by Borland Developer Support Staff
  4199. Note that I will NOT do big Endian functions because the stacks can handle that
  4200. with HostToNetwork and NetworkToHost functions.
  4201. You should use these functions for writing data that sent and received in Little
  4202. Endian Form. Do NOT assume endianness of what's written. It can work in unpredictable
  4203. ways on other architectures.
  4204. }
  4205. function HostToLittleEndian(const AValue : UInt16) : UInt16;
  4206. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4207. begin
  4208. // TODO: FreePascal has a NtoLE() function in its System unit to
  4209. // "Convert Native-ordered integer to a Little Endian-ordered integer"
  4210. {.$IFDEF FPC}
  4211. //Result := NtoLE(AValue);
  4212. {.$ELSE}
  4213. {$IFDEF DOTNET}
  4214. //I think that is Little Endian but I'm not completely sure
  4215. Result := AValue;
  4216. {$ELSE}
  4217. {$IFDEF ENDIAN_LITTLE}
  4218. Result := AValue;
  4219. {$ENDIF}
  4220. {$IFDEF ENDIAN_BIG}
  4221. Result := swap(AValue);
  4222. {$ENDIF}
  4223. {$ENDIF}
  4224. {.$ENDIF}
  4225. end;
  4226. function HostToLittleEndian(const AValue : UInt32) : UInt32;
  4227. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4228. begin
  4229. // TODO: FreePascal has a NtoLE() function in its System unit to
  4230. // "Convert Native-ordered integer to a Little Endian-ordered integer"
  4231. {.$IFDEF FPC}
  4232. //Result := NtoLE(AValue);
  4233. {.$ELSE}
  4234. {$IFDEF DOTNET}
  4235. //I think that is Little Endian but I'm not completely sure
  4236. Result := AValue;
  4237. {$ELSE}
  4238. {$IFDEF ENDIAN_LITTLE}
  4239. Result := AValue;
  4240. {$ENDIF}
  4241. {$IFDEF ENDIAN_BIG}
  4242. Result := swap(AValue shr 16) or (UInt32(swap(AValue and $FFFF)) shl 16);
  4243. {$ENDIF}
  4244. {$ENDIF}
  4245. {.$ENDIF}
  4246. end;
  4247. function HostToLittleEndian(const AValue : Integer) : Integer;
  4248. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4249. begin
  4250. // TODO: FreePascal has a NtoLE() function in its System unit to
  4251. // "Convert Native-ordered integer to a Little Endian-ordered integer"
  4252. {.$IFDEF FPC}
  4253. //Result := NtoLE(AValue);
  4254. {.$ELSE}
  4255. {$IFDEF DOTNET}
  4256. //I think that is Little Endian but I'm not completely sure
  4257. Result := AValue;
  4258. {$ELSE}
  4259. {$IFDEF ENDIAN_LITTLE}
  4260. Result := AValue;
  4261. {$ENDIF}
  4262. {$IFDEF ENDIAN_BIG}
  4263. Result := swap(AValue);
  4264. {$ENDIF}
  4265. {$ENDIF}
  4266. {.$ENDIF}
  4267. end;
  4268. function LittleEndianToHost(const AValue : UInt16) : UInt16;
  4269. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4270. begin
  4271. // TODO: FreePascal has a LEtoN() function in its System unit to
  4272. // "Convert Little Endian-ordered integer to Native-ordered integer"
  4273. {.$IFDEF FPC}
  4274. //Result := LEtoN(AValue);
  4275. {.$ELSE}
  4276. {$IFDEF DOTNET}
  4277. //I think that is Little Endian but I'm not completely sure
  4278. Result := AValue;
  4279. {$ELSE}
  4280. {$IFDEF ENDIAN_LITTLE}
  4281. Result := AValue;
  4282. {$ENDIF}
  4283. {$IFDEF ENDIAN_BIG}
  4284. Result := swap(AValue);
  4285. {$ENDIF}
  4286. {$ENDIF}
  4287. {.$ENDIF}
  4288. end;
  4289. function LittleEndianToHost(const AValue : UInt32): UInt32;
  4290. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4291. begin
  4292. // TODO: FreePascal has a LEtoN() function in its System unit to
  4293. // "Convert Little Endian-ordered integer to Native-ordered integer"
  4294. {.$IFDEF FPC}
  4295. //Result := LEtoN(AValue);
  4296. {.$ELSE}
  4297. {$IFDEF DOTNET}
  4298. //I think that is Little Endian but I'm not completely sure
  4299. Result := AValue;
  4300. {$ELSE}
  4301. {$IFDEF ENDIAN_LITTLE}
  4302. Result := AValue;
  4303. {$ENDIF}
  4304. {$IFDEF ENDIAN_BIG}
  4305. Result := swap(AValue shr 16) or (UInt32(swap(AValue and $FFFF)) shl 16);
  4306. {$ENDIF}
  4307. {$ENDIF}
  4308. {.$ENDIF}
  4309. end;
  4310. function LittleEndianToHost(const AValue : Integer): Integer;
  4311. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4312. begin
  4313. // TODO: FreePascal has a LEtoN() function in its System unit to
  4314. // "Convert Little Endian-ordered integer to Native-ordered integer"
  4315. {.$IFDEF FPC}
  4316. //Result := LEtoN(AValue);
  4317. {.$ELSE}
  4318. {$IFDEF DOTNET}
  4319. //I think that is Little Endian but I'm not completely sure
  4320. Result := AValue;
  4321. {$ELSE}
  4322. {$IFDEF ENDIAN_LITTLE}
  4323. Result := AValue;
  4324. {$ENDIF}
  4325. {$IFDEF ENDIAN_BIG}
  4326. Result := Swap(AValue);
  4327. {$ENDIF}
  4328. {$ENDIF}
  4329. {.$ENDIF}
  4330. end;
  4331. // TODO: add an AIndex parameter
  4332. procedure FillBytes(var VBytes : TIdBytes; const ACount : Integer; const AValue : Byte);
  4333. {$IFDEF STRING_IS_ANSI}
  4334. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4335. {$ELSE}
  4336. var
  4337. I: Integer;
  4338. {$ENDIF}
  4339. begin
  4340. // RLebeau: FillChar() is bad to use on Delphi/C++Builder 2009+ for filling
  4341. // byte buffers as it is actually designed for filling character buffers
  4342. // instead. Now that Char maps to WideChar, this causes problems for FillChar().
  4343. {$IFDEF STRING_IS_UNICODE}
  4344. //System.&Array.Clear(VBytes, 0, ACount);
  4345. // TODO: optimize this
  4346. for I := 0 to ACount-1 do begin
  4347. VBytes[I] := AValue;
  4348. end;
  4349. {$ELSE}
  4350. FillChar(VBytes[0], ACount, AValue);
  4351. {$ENDIF}
  4352. end;
  4353. // RLebeau 10/22/2013: prior to Delphi 2010, fmCreate was an all-encompassing
  4354. // bitmask, no other flags could be combined with it. The RTL was updated in
  4355. // Delphi 2010 to allow other flags to be specified along with fmCreate. So
  4356. // at best, we will now be able to allow read-only access to other processes
  4357. // in Delphi 2010 and later, and at worst we will continue having exclusive
  4358. // rights to the file in Delphi 2009 and earlier, just like we always did...
  4359. constructor TIdFileCreateStream.Create(const AFile : String);
  4360. begin
  4361. inherited Create(AFile, fmCreate or fmOpenReadWrite or fmShareDenyWrite);
  4362. end;
  4363. constructor TIdAppendFileStream.Create(const AFile : String);
  4364. var
  4365. LFlags: Word;
  4366. begin
  4367. LFlags := fmOpenReadWrite or fmShareDenyWrite;
  4368. if not FileExists(AFile) then begin
  4369. LFlags := LFLags or fmCreate;
  4370. end;
  4371. inherited Create(AFile, LFlags);
  4372. if (LFlags and fmCreate) = 0 then begin
  4373. TIdStreamHelper.Seek(Self, 0, soEnd);
  4374. end;
  4375. end;
  4376. constructor TIdReadFileNonExclusiveStream.Create(const AFile : String);
  4377. begin
  4378. inherited Create(AFile, fmOpenRead or fmShareDenyNone);
  4379. end;
  4380. constructor TIdReadFileExclusiveStream.Create(const AFile : String);
  4381. begin
  4382. inherited Create(AFile, fmOpenRead or fmShareDenyWrite);
  4383. end;
  4384. function IsASCIILDH(const AByte: Byte): Boolean;
  4385. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4386. begin
  4387. Result := True;
  4388. //Verify the absence of non-LDH ASCII code points; that is, the
  4389. //absence of 0..2C, 2E..2F, 3A..40, 5B..60, and 7B..7F.
  4390. //Permissable chars are in this set
  4391. //['-','0'..'9','A'..'Z','a'..'z']
  4392. if AByte <= $2C then begin
  4393. Result := False;
  4394. end
  4395. else if (AByte >= $2E) and (AByte <= $2F) then begin
  4396. Result := False;
  4397. end
  4398. else if (AByte >= $3A) and (AByte <= $40) then begin
  4399. Result := False;
  4400. end
  4401. else if (AByte >= $5B) and (AByte <= $60) then begin
  4402. Result := False;
  4403. end
  4404. else if (AByte >= $7B) and (AByte <= $7F) then begin
  4405. Result := False;
  4406. end;
  4407. end;
  4408. function IsASCIILDH(const ABytes: TIdBytes): Boolean;
  4409. var
  4410. i: Integer;
  4411. begin
  4412. for i := 0 to Length(ABytes)-1 do begin
  4413. if not IsASCIILDH(ABytes[i]) then
  4414. begin
  4415. Result := False;
  4416. Exit;
  4417. end;
  4418. end;
  4419. Result := True;
  4420. end;
  4421. function IsASCII(const AByte: Byte): Boolean;
  4422. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4423. begin
  4424. Result := AByte <= $7F;
  4425. end;
  4426. function IsASCII(const ABytes: TIdBytes): Boolean;
  4427. var
  4428. i: Integer;
  4429. begin
  4430. for i := 0 to Length(ABytes) -1 do begin
  4431. if not IsASCII(ABytes[i]) then begin
  4432. Result := False;
  4433. Exit;
  4434. end;
  4435. end;
  4436. Result := True;
  4437. end;
  4438. function StartsWithACE(const ABytes: TIdBytes): Boolean;
  4439. const
  4440. cDash = Ord('-');
  4441. var
  4442. LS: {$IFDEF STRING_IS_IMMUTABLE}TIdStringBuilder{$ELSE}string{$ENDIF};
  4443. begin
  4444. Result := False;
  4445. if Length(ABytes) >= 4 then
  4446. begin
  4447. if (ABytes[2] = cDash) and (ABytes[3] = cDash) then
  4448. begin
  4449. // TODO: just do byte comparisons so String conversions are not needed...
  4450. {$IFDEF STRING_IS_IMMUTABLE}
  4451. LS := TIdStringBuilder.Create(2);
  4452. LS.Append(Char(ABytes[0]));
  4453. LS.Append(Char(ABytes[1]));
  4454. {$ELSE}
  4455. SetLength(LS, 2);
  4456. LS[1] := Char(ABytes[0]);
  4457. LS[2] := Char(ABytes[1]);
  4458. {$ENDIF}
  4459. Result := PosInStrArray(LS{$IFDEF STRING_IS_IMMUTABLE}.ToString{$ENDIF},
  4460. ['bl','bq','dq','lq','mq','ra','wq','zq'], False) > -1;{do not localize}
  4461. end;
  4462. end;
  4463. end;
  4464. function PosInSmallIntArray(const ASearchInt: Int16; const AArray: array of Int16): Integer;
  4465. begin
  4466. for Result := Low(AArray) to High(AArray) do begin
  4467. if ASearchInt = AArray[Result] then begin
  4468. Exit;
  4469. end;
  4470. end;
  4471. Result := -1;
  4472. end;
  4473. {This searches an array of string for an occurance of SearchStr}
  4474. function PosInStrArray(const SearchStr: string; const Contents: array of string; const CaseSensitive: Boolean = True): Integer;
  4475. begin
  4476. for Result := Low(Contents) to High(Contents) do begin
  4477. if CaseSensitive then begin
  4478. if SearchStr = Contents[Result] then begin
  4479. Exit;
  4480. end;
  4481. end else begin
  4482. if TextIsSame(SearchStr, Contents[Result]) then begin
  4483. Exit;
  4484. end;
  4485. end;
  4486. end;
  4487. Result := -1;
  4488. end;
  4489. //IPv4 address conversion
  4490. function ByteToHex(const AByte: Byte): string;
  4491. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4492. {$IFDEF STRING_IS_IMMUTABLE}
  4493. var
  4494. LSB: TIdStringBuilder;
  4495. {$ENDIF}
  4496. begin
  4497. {$IFDEF STRING_IS_IMMUTABLE}
  4498. LSB := TIdStringBuilder.Create(2);
  4499. LSB.Append(IdHexDigits[(AByte and $F0) shr 4]);
  4500. LSB.Append(IdHexDigits[AByte and $F]);
  4501. Result := LSB.ToString;
  4502. {$ELSE}
  4503. SetLength(Result, 2);
  4504. Result[1] := IdHexDigits[(AByte and $F0) shr 4];
  4505. Result[2] := IdHexDigits[AByte and $F];
  4506. {$ENDIF}
  4507. end;
  4508. function UInt32ToHex(const ALongWord : UInt32) : String;
  4509. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4510. begin
  4511. Result := ByteToHex((ALongWord and $FF000000) shr 24)
  4512. + ByteToHex((ALongWord and $00FF0000) shr 16)
  4513. + ByteToHex((ALongWord and $0000FF00) shr 8)
  4514. + ByteToHex(ALongWord and $000000FF);
  4515. end;
  4516. {$I IdDeprecatedImplBugOff.inc}
  4517. function LongWordToHex(const ALongWord : UInt32) : String;
  4518. {$I IdDeprecatedImplBugOn.inc}
  4519. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4520. begin
  4521. Result := UInt32ToHex(ALongWord);
  4522. end;
  4523. function ToHex(const AValue: TIdBytes; const ACount: Integer = -1;
  4524. const AIndex: Integer = 0): string;
  4525. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4526. var
  4527. I, LCount: Integer;
  4528. {$IFDEF STRING_IS_IMMUTABLE}
  4529. LSB: TIdStringBuilder;
  4530. {$ENDIF}
  4531. begin
  4532. LCount := IndyLength(AValue, ACount, AIndex);
  4533. if LCount > 0 then begin
  4534. {$IFDEF STRING_IS_IMMUTABLE}
  4535. LSB := TIdStringBuilder.Create(LCount*2);
  4536. {$ELSE}
  4537. SetLength(Result, LCount*2);
  4538. {$ENDIF}
  4539. for I := 0 to LCount-1 do begin
  4540. {$IFDEF STRING_IS_IMMUTABLE}
  4541. LSB.Append(IdHexDigits[(AValue[AIndex+I] and $F0) shr 4]);
  4542. LSB.Append(IdHexDigits[AValue[AIndex+I] and $F]);
  4543. {$ELSE}
  4544. Result[I*2+1] := IdHexDigits[(AValue[AIndex+I] and $F0) shr 4];
  4545. Result[I*2+2] := IdHexDigits[AValue[AIndex+I] and $F];
  4546. {$ENDIF}
  4547. end;
  4548. {$IFDEF STRING_IS_IMMUTABLE}
  4549. Result := LSB.ToString;
  4550. {$ENDIF}
  4551. end else begin
  4552. Result := '';
  4553. end;
  4554. end;
  4555. function ToHex(const AValue: array of UInt32): string;
  4556. var
  4557. {$IFDEF STRING_IS_IMMUTABLE}
  4558. LSB: TIdStringBuilder;
  4559. {$ENDIF}
  4560. P: {$IFDEF DOTNET}TIdBytes{$ELSE}PByteArray{$ENDIF};
  4561. i, j: Integer;
  4562. begin
  4563. Result := '';
  4564. if Length(AValue) > 0 then
  4565. begin
  4566. {$IFDEF STRING_IS_IMMUTABLE}
  4567. LSB := TIdStringBuilder.Create(Length(AValue)*SizeOf(UInt32)*2);
  4568. {$ELSE}
  4569. SetLength(Result, Length(AValue)*SizeOf(UInt32)*2);
  4570. {$ENDIF}
  4571. for i := 0 to High(AValue) do begin
  4572. {$IFDEF DOTNET}
  4573. P := ToBytes(AValue[i]);
  4574. {$ELSE}
  4575. P := PByteArray(@AValue[i]);
  4576. {$ENDIF}
  4577. for j := 0 to SizeOf(UInt32)-1 do begin
  4578. {$IFDEF STRING_IS_IMMUTABLE}
  4579. LSB.Append(IdHexDigits[(P[j] and $F0) shr 4]);
  4580. LSB.Append(IdHexDigits[P[j] and $F]);
  4581. {$ELSE}
  4582. Result[(i*SizeOf(UInt32))+(j*2)+1] := IdHexDigits[(P^[j] and $F0) shr 4];
  4583. Result[(i*SizeOf(UInt32))+(j*2)+2] := IdHexDigits[P^[j] and $F];
  4584. {$ENDIF}
  4585. end;
  4586. end;//for
  4587. {$IFDEF STRING_IS_IMMUTABLE}
  4588. Result := LSB.ToString;
  4589. {$ENDIF}
  4590. end;
  4591. end;
  4592. function IPv4ToHex(const AIPAddress: string; const ADotted: Boolean): string;
  4593. var
  4594. i: Integer;
  4595. LBuf, LTmp: string;
  4596. begin
  4597. LBuf := Trim(AIPAddress);
  4598. Result := IdHexPrefix;
  4599. for i := 0 to 3 do begin
  4600. LTmp := ByteToHex(IndyStrToInt(Fetch(LBuf, '.', True)));
  4601. if ADotted then begin
  4602. Result := Result + '.' + IdHexPrefix + LTmp;
  4603. end else begin
  4604. Result := Result + LTmp;
  4605. end;
  4606. end;
  4607. end;
  4608. {$IFNDEF DOTNET}
  4609. function OctalToInt64(const AValue: string): Int64;
  4610. var
  4611. i: Integer;
  4612. begin
  4613. Result := 0;
  4614. for i := 1 to Length(AValue) do begin
  4615. Result := (Result shl 3) + IndyStrToInt(AValue[i], 0);
  4616. end;
  4617. end;
  4618. {$ENDIF}
  4619. function ByteToOctal(const AByte: Byte): string;
  4620. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4621. {$IFDEF STRING_IS_IMMUTABLE}
  4622. var
  4623. LSB: TIdStringBuilder;
  4624. C: Char;
  4625. {$ENDIF}
  4626. begin
  4627. {$IFDEF STRING_IS_IMMUTABLE}
  4628. C := IdOctalDigits[(AByte shr 6) and $7];
  4629. if C <> '0' then begin
  4630. LSB := TIdStringBuilder.Create(4);
  4631. LSB.Append(Char('0')); {do not localize}
  4632. end else begin
  4633. LSB := TIdStringBuilder.Create(3);
  4634. end;
  4635. LSB.Append(C);
  4636. LSB.Append(IdOctalDigits[(AByte shr 3) and $7]);
  4637. LSB.Append(IdOctalDigits[AByte and $7]);
  4638. Result := LSB.ToString;
  4639. {$ELSE}
  4640. SetLength(Result, 3);
  4641. Result[1] := IdOctalDigits[(AByte shr 6) and $7];
  4642. Result[2] := IdOctalDigits[(AByte shr 3) and $7];
  4643. Result[3] := IdOctalDigits[AByte and $7];
  4644. if Result[1] <> '0' then begin {do not localize}
  4645. Result := '0' + Result; {do not localize}
  4646. end;
  4647. {$ENDIF}
  4648. end;
  4649. function IPv4ToOctal(const AIPAddress: string): string;
  4650. var
  4651. i: Integer;
  4652. LBuf: string;
  4653. begin
  4654. LBuf := Trim(AIPAddress);
  4655. Result := ByteToOctal(IndyStrToInt(Fetch(LBuf, '.', True), 0));
  4656. for i := 0 to 2 do begin
  4657. Result := Result + '.' + ByteToOctal(IndyStrToInt(Fetch(LBuf, '.', True), 0));
  4658. end;
  4659. end;
  4660. procedure CopyTIdBytes(const ASource: TIdBytes; const ASourceIndex: Integer;
  4661. var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer);
  4662. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4663. begin
  4664. {$IFDEF DOTNET}
  4665. System.array.Copy(ASource, ASourceIndex, VDest, ADestIndex, ALength);
  4666. {$ELSE}
  4667. //if these asserts fail, then it indicates an attempted buffer overrun.
  4668. Assert(ASourceIndex >= 0);
  4669. Assert((ASourceIndex+ALength) <= Length(ASource));
  4670. Move(ASource[ASourceIndex], VDest[ADestIndex], ALength);
  4671. {$ENDIF}
  4672. end;
  4673. procedure CopyTIdChar(const ASource: Char; var VDest: TIdBytes; const ADestIndex: Integer;
  4674. ADestEncoding: IIdTextEncoding = nil
  4675. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  4676. );
  4677. var
  4678. LChars: {$IFDEF DOTNET}array[0..0] of Char{$ELSE}TIdWideChars{$ENDIF};
  4679. begin
  4680. EnsureEncoding(ADestEncoding);
  4681. {$IFDEF STRING_IS_UNICODE}
  4682. {$IFNDEF DOTNET}
  4683. SetLength(LChars, 1);
  4684. {$ENDIF}
  4685. LChars[0] := ASource;
  4686. ADestEncoding.GetBytes(LChars, 0, 1, VDest, ADestIndex);
  4687. {$ELSE}
  4688. EnsureEncoding(ASrcEncoding, encOSDefault);
  4689. LChars := ASrcEncoding.GetChars(RawToBytes(ASource, 1));
  4690. ADestEncoding.GetBytes(LChars, 0, Length(LChars), VDest, ADestIndex);
  4691. {$ENDIF}
  4692. end;
  4693. procedure CopyTIdInt16(const ASource: Int16; var VDest: TIdBytes; const ADestIndex: Integer);
  4694. {$IFDEF DOTNET}
  4695. var
  4696. LShort : TIdBytes;
  4697. {$ELSE}
  4698. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4699. {$ENDIF}
  4700. begin
  4701. {$IFDEF DOTNET}
  4702. LShort := System.BitConverter.GetBytes(ASource);
  4703. System.array.Copy(LShort, 0, VDest, ADestIndex, SizeOf(Int16));
  4704. {$ELSE}
  4705. PInt16(@VDest[ADestIndex])^ := ASource;
  4706. {$ENDIF}
  4707. end;
  4708. {$I IdDeprecatedImplBugOff.inc}
  4709. procedure CopyTIdShort(const ASource: Int16; var VDest: TIdBytes; const ADestIndex: Integer);
  4710. {$I IdDeprecatedImplBugOn.inc}
  4711. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4712. begin
  4713. CopyTIdInt16(ASource, VDest, ADestIndex);
  4714. end;
  4715. procedure CopyTIdUInt16(const ASource: UInt16; var VDest: TIdBytes; const ADestIndex: Integer);
  4716. {$IFDEF DOTNET}
  4717. var
  4718. LWord : TIdBytes;
  4719. {$ELSE}
  4720. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4721. {$ENDIF}
  4722. begin
  4723. {$IFDEF DOTNET}
  4724. LWord := System.BitConverter.GetBytes(ASource);
  4725. System.array.Copy(LWord, 0, VDest, ADestIndex, SizeOf(UInt16));
  4726. {$ELSE}
  4727. PUInt16(@VDest[ADestIndex])^ := ASource;
  4728. {$ENDIF}
  4729. end;
  4730. {$I IdDeprecatedImplBugOff.inc}
  4731. procedure CopyTIdWord(const ASource: UInt16; var VDest: TIdBytes; const ADestIndex: Integer);
  4732. {$I IdDeprecatedImplBugOn.inc}
  4733. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4734. begin
  4735. CopyTIdUInt16(ASource, VDest, ADestIndex);
  4736. end;
  4737. procedure CopyTIdUInt32(const ASource: UInt32; var VDest: TIdBytes; const ADestIndex: Integer);
  4738. {$IFDEF DOTNET}
  4739. var
  4740. LWord : TIdBytes;
  4741. {$ELSE}
  4742. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4743. {$ENDIF}
  4744. begin
  4745. {$IFDEF DOTNET}
  4746. LWord := System.BitConverter.GetBytes(ASource);
  4747. System.array.Copy(LWord, 0, VDest, ADestIndex, SizeOf(UInt32));
  4748. {$ELSE}
  4749. PUInt32(@VDest[ADestIndex])^ := ASource;
  4750. {$ENDIF}
  4751. end;
  4752. {$I IdDeprecatedImplBugOff.inc}
  4753. procedure CopyTIdLongWord(const ASource: UInt32; var VDest: TIdBytes; const ADestIndex: Integer);
  4754. {$I IdDeprecatedImplBugOn.inc}
  4755. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4756. begin
  4757. CopyTIdUInt32(ASource, VDest, ADestIndex);
  4758. end;
  4759. procedure CopyTIdInt32(const ASource: Int32; var VDest: TIdBytes; const ADestIndex: Integer);
  4760. {$IFDEF DOTNET}
  4761. var
  4762. LInt : TIdBytes;
  4763. {$ELSE}
  4764. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4765. {$ENDIF}
  4766. begin
  4767. {$IFDEF DOTNET}
  4768. LInt := System.BitConverter.GetBytes(ASource);
  4769. System.array.Copy(LInt, 0, VDest, ADestIndex, SizeOf(Int32));
  4770. {$ELSE}
  4771. PInt32(@VDest[ADestIndex])^ := ASource;
  4772. {$ENDIF}
  4773. end;
  4774. {$I IdDeprecatedImplBugOff.inc}
  4775. procedure CopyTIdLongInt(const ASource: Int32; var VDest: TIdBytes; const ADestIndex: Integer);
  4776. {$I IdDeprecatedImplBugOn.inc}
  4777. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4778. begin
  4779. CopyTIdInt32(ASource, VDest, ADestIndex);
  4780. end;
  4781. procedure CopyTIdInt64(const ASource: Int64; var VDest: TIdBytes; const ADestIndex: Integer);
  4782. {$IFDEF DOTNET}
  4783. var
  4784. LWord : TIdBytes;
  4785. {$ELSE}
  4786. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4787. {$ENDIF}
  4788. begin
  4789. {$IFDEF DOTNET}
  4790. LWord := System.BitConverter.GetBytes(ASource);
  4791. System.array.Copy(LWord, 0, VDest, ADestIndex, SizeOf(Int64));
  4792. {$ELSE}
  4793. PInt64(@VDest[ADestIndex])^ := ASource;
  4794. {$ENDIF}
  4795. end;
  4796. procedure CopyTIdUInt64(const ASource: TIdUInt64;
  4797. var VDest: TIdBytes; const ADestIndex: Integer);
  4798. {$IFDEF DOTNET}
  4799. var
  4800. LWord : TIdBytes;
  4801. {$ELSE}
  4802. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4803. {$ENDIF}
  4804. begin
  4805. {$IFDEF DOTNET}
  4806. LWord := System.BitConverter.GetBytes(ASource);
  4807. System.array.Copy(LWord, 0, VDest, ADestIndex, SizeOf(UInt64));
  4808. {$ELSE}
  4809. PUInt64(@VDest[ADestIndex])^ := ASource{$IFDEF TIdUInt64_HAS_QuadPart}.QuadPart{$ENDIF};
  4810. {$ENDIF}
  4811. end;
  4812. {$IFDEF UInt64_IS_NATIVE}
  4813. {$IFDEF TIdUInt64_HAS_QuadPart}
  4814. {$DEFINE USE_TIdTicks_TIdUInt64_CONVERSION}
  4815. {$ENDIF}
  4816. {$ENDIF}
  4817. procedure CopyTIdTicks(const ASource: TIdTicks; var VDest: TIdBytes; const ADestIndex: Integer);
  4818. {$IFDEF USE_TIdTicks_TIdUInt64_CONVERSION}
  4819. var
  4820. LValue: TIdUInt64;
  4821. {$ELSE}
  4822. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4823. {$ENDIF}
  4824. begin
  4825. {$IFDEF USE_TIdTicks_TIdUInt64_CONVERSION}
  4826. // In C++Builder 2006/2007, TIdUInt64 is a packed record, but TIdTicks is
  4827. // an alias for a native UInt64, so need a conversion here to get around
  4828. // a compiler error: "E2010 Incompatible types: 'TIdUInt64' and 'UInt64'"...
  4829. LValue.QuadPart := ASource;
  4830. CopyTIdUInt64(LValue, VDest, ADestIndex);
  4831. {$ELSE}
  4832. {$IFDEF UInt64_IS_NATIVE}
  4833. CopyTIdUInt64(ASource, VDest, ADestIndex);
  4834. {$ELSE}
  4835. CopyTIdInt64(ASource, VDest, ADestIndex);
  4836. {$ENDIF}
  4837. {$ENDIF}
  4838. end;
  4839. procedure CopyTIdIPV6Address(const ASource: TIdIPv6Address; var VDest: TIdBytes; const ADestIndex: Integer);
  4840. {$IFDEF DOTNET}
  4841. var
  4842. i : Integer;
  4843. {$ELSE}
  4844. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4845. {$ENDIF}
  4846. begin
  4847. {$IFDEF DOTNET}
  4848. for i := 0 to 7 do begin
  4849. CopyTIdUInt16(ASource[i], VDest, ADestIndex + (i * 2));
  4850. end;
  4851. {$ELSE}
  4852. Move(ASource, VDest[ADestIndex], 16);
  4853. {$ENDIF}
  4854. end;
  4855. procedure CopyTIdByteArray(const ASource: array of Byte; const ASourceIndex: Integer;
  4856. var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer);
  4857. begin
  4858. {$IFDEF DOTNET}
  4859. System.array.Copy(ASource, ASourceIndex, VDest, ADestIndex, ALength);
  4860. {$ELSE}
  4861. Move(ASource[ASourceIndex], VDest[ADestIndex], ALength);
  4862. {$ENDIF}
  4863. end;
  4864. procedure CopyTIdString(const ASource: String; var VDest: TIdBytes;
  4865. const ADestIndex: Integer; const ALength: Integer = -1;
  4866. ADestEncoding: IIdTextEncoding = nil
  4867. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  4868. ); overload;
  4869. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4870. begin
  4871. CopyTIdString(ASource, 1, VDest, ADestIndex, ALength, ADestEncoding
  4872. {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
  4873. );
  4874. end;
  4875. procedure CopyTIdString(const ASource: String; const ASourceIndex: Integer;
  4876. var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer = -1;
  4877. ADestEncoding: IIdTextEncoding = nil
  4878. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  4879. ); overload;
  4880. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4881. var
  4882. LLength: Integer;
  4883. {$IFDEF STRING_IS_ANSI}
  4884. LTmp: TIdWideChars;
  4885. {$ENDIF}
  4886. begin
  4887. {$IFDEF STRING_IS_ANSI}
  4888. LTmp := nil; // keep the compiler happy
  4889. {$ENDIF}
  4890. LLength := IndyLength(ASource, ALength, ASourceIndex);
  4891. if LLength > 0 then begin
  4892. EnsureEncoding(ADestEncoding);
  4893. {$IFDEF STRING_IS_UNICODE}
  4894. ADestEncoding.GetBytes(ASource, ASourceIndex, LLength, VDest, ADestIndex);
  4895. {$ELSE}
  4896. EnsureEncoding(ASrcEncoding, encOSDefault);
  4897. LTmp := ASrcEncoding.GetChars(RawToBytes(ASource[ASourceIndex], LLength)); // convert to Unicode
  4898. ADestEncoding.GetBytes(LTmp, 0, Length(LTmp), VDest, ADestIndex);
  4899. {$ENDIF}
  4900. end;
  4901. end;
  4902. // TODO: define STRING_UNICODE_MISMATCH for WinCE in IdCompilerDefines.inc?
  4903. {$IFDEF WINDOWS}
  4904. {$IFDEF WINCE}
  4905. {$IFNDEF STRING_IS_UNICODE}
  4906. {$DEFINE DEBUG_STRING_MISMATCH}
  4907. {$ENDIF}
  4908. {$ELSE}
  4909. {$IFDEF STRING_UNICODE_MISMATCH}
  4910. {$DEFINE DEBUG_STRING_MISMATCH}
  4911. {$ENDIF}
  4912. {$ENDIF}
  4913. {$ENDIF}
  4914. procedure DebugOutput(const AText: string);
  4915. {$IFDEF DEBUG_STRING_MISMATCH}
  4916. var
  4917. LTemp: {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF};
  4918. {$ELSE}
  4919. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4920. {$ENDIF}
  4921. begin
  4922. // TODO: support other debugging platforms
  4923. {$IFDEF KYLIX}
  4924. __write(stderr, AText, Length(AText));
  4925. __write(stderr, EOL, Length(EOL));
  4926. {$ENDIF}
  4927. {$IFDEF WINDOWS}
  4928. {$IFDEF DEBUG_STRING_MISMATCH}
  4929. LTemp := {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF}(AText); // explicit convert to Ansi/Unicode
  4930. OutputDebugString({$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF}(LTemp));
  4931. {$ELSE}
  4932. OutputDebugString(PChar(AText));
  4933. {$ENDIF}
  4934. {$ENDIF}
  4935. {$IFDEF DOTNET}
  4936. System.Diagnostics.Debug.WriteLine(AText);
  4937. {$ENDIF}
  4938. end;
  4939. function CurrentThreadId: TIdThreadID;
  4940. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4941. begin
  4942. {$IFDEF DOTNET}
  4943. {$IFDEF DOTNET_2_OR_ABOVE}
  4944. {
  4945. [Warning] IdGlobal.pas(1416): W1000 Symbol 'GetCurrentThreadId'
  4946. is deprecated: 'AppDomain.GetCurrentThreadId has been deprecated because
  4947. it does not provide a stable Id when managed threads are running on fibers
  4948. (aka lightweight threads). To get a stable identifier for a managed thread,
  4949. use the ManagedThreadId property on Thread.
  4950. http://go.microsoft.com/fwlink/?linkid=14202'
  4951. }
  4952. Result := System.Threading.Thread.CurrentThread.ManagedThreadId;
  4953. // Thread.ManagedThreadId;
  4954. {$ENDIF}
  4955. {$IFDEF DOTNET_1_1}
  4956. // 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)
  4957. Result := AppDomain.GetCurrentThreadId;
  4958. // RLebeau
  4959. // TODO: find if there is something like the following instead:
  4960. // System.Diagnostics.Thread.GetCurrentThread.ID
  4961. // System.Threading.Thread.CurrentThread.ID
  4962. {$ENDIF}
  4963. {$ELSE}
  4964. // TODO: is GetCurrentThreadId() available on Linux?
  4965. Result := GetCurrentThreadID;
  4966. {$ENDIF}
  4967. end;
  4968. {$UNDEF KYLIXCOMPAT_OR_VCL_POSIX}
  4969. {$IFDEF KYLIXCOMPAT}
  4970. {$DEFINE KYLIXCOMPAT_OR_VCL_POSIX}
  4971. {$ENDIF}
  4972. {$IFDEF USE_VCL_POSIX}
  4973. {$DEFINE KYLIXCOMPAT_OR_VCL_POSIX}
  4974. {$ENDIF}
  4975. function CurrentProcessId: TIdPID;
  4976. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4977. begin
  4978. {$IFDEF DOTNET}
  4979. Result := System.Diagnostics.Process.GetCurrentProcess.ID;
  4980. {$ELSE}
  4981. {$IFDEF WINDOWS}
  4982. Result := GetCurrentProcessID;
  4983. {$ELSE}
  4984. {$IFDEF KYLIXCOMPAT_OR_VCL_POSIX}
  4985. Result := getpid;
  4986. {$ELSE}
  4987. {$IFDEF USE_BASEUNIX}
  4988. Result := fpgetpid;
  4989. {$ELSE}
  4990. {$message error CurrentProcessId is not implemented on this platform!}
  4991. Result := 0;
  4992. {$ENDIF}
  4993. {$ENDIF}
  4994. {$ENDIF}
  4995. {$ENDIF}
  4996. end;
  4997. function Fetch(var AInput: string; const ADelim: string = IdFetchDelimDefault;
  4998. const ADelete: Boolean = IdFetchDeleteDefault;
  4999. const ACaseSensitive: Boolean = IdFetchCaseSensitiveDefault): string;
  5000. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5001. var
  5002. LPos: Integer;
  5003. begin
  5004. if ACaseSensitive then begin
  5005. if ADelim = #0 then begin
  5006. // AnsiPos does not work with #0
  5007. LPos := Pos(ADelim, AInput);
  5008. end else begin
  5009. LPos := IndyPos(ADelim, AInput);
  5010. end;
  5011. if LPos = 0 then begin
  5012. Result := AInput;
  5013. if ADelete then begin
  5014. AInput := ''; {Do not Localize}
  5015. end;
  5016. end
  5017. else begin
  5018. Result := Copy(AInput, 1, LPos - 1);
  5019. if ADelete then begin
  5020. //slower Delete(AInput, 1, LPos + Length(ADelim) - 1); because the
  5021. //remaining part is larger than the deleted
  5022. AInput := Copy(AInput, LPos + Length(ADelim), MaxInt);
  5023. end;
  5024. end;
  5025. end else begin
  5026. Result := FetchCaseInsensitive(AInput, ADelim, ADelete);
  5027. end;
  5028. end;
  5029. function FetchCaseInsensitive(var AInput: string; const ADelim: string;
  5030. const ADelete: Boolean): string;
  5031. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5032. var
  5033. LPos: Integer;
  5034. begin
  5035. if ADelim = #0 then begin
  5036. // AnsiPos does not work with #0
  5037. LPos := Pos(ADelim, AInput);
  5038. end else begin
  5039. //? may be AnsiUpperCase?
  5040. LPos := IndyPos(UpperCase(ADelim), UpperCase(AInput));
  5041. end;
  5042. if LPos = 0 then begin
  5043. Result := AInput;
  5044. if ADelete then begin
  5045. AInput := ''; {Do not Localize}
  5046. end;
  5047. end else begin
  5048. Result := Copy(AInput, 1, LPos - 1);
  5049. if ADelete then begin
  5050. //faster than Delete(AInput, 1, LPos + Length(ADelim) - 1); because the
  5051. //remaining part is larger than the deleted
  5052. AInput := Copy(AInput, LPos + Length(ADelim), MaxInt);
  5053. end;
  5054. end;
  5055. end;
  5056. function GetThreadHandle(AThread: TThread): TIdThreadHandle;
  5057. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5058. begin
  5059. {$IFDEF UNIX}
  5060. Result := AThread.ThreadID; // RLebeau: is it right to return an ID where a thread object handle is expected instead?
  5061. {$ENDIF}
  5062. {$IFDEF WINDOWS}
  5063. Result := AThread.Handle;
  5064. {$ENDIF}
  5065. {$IFDEF DOTNET}
  5066. Result := AThread.Handle;
  5067. {$ENDIF}
  5068. end;
  5069. {$I IdDeprecatedImplBugOff.inc}
  5070. function Ticks: UInt32;
  5071. {$I IdDeprecatedImplBugOn.inc}
  5072. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5073. begin
  5074. // TODO: maybe throw an exception if Ticks64() exceeds the 49.7 day limit of UInt32?
  5075. Result := UInt32(Ticks64() mod High(UInt32));
  5076. end;
  5077. // RLebeau: breaking up the Ticks64() implementation into separate platform blocks,
  5078. // instead of trying to do it all in one implementation. This way, the code is
  5079. // cleaner, and if I miss a platform then the compiler should complain about Ticks64()
  5080. // being unresolved...
  5081. // TODO: move these to platform-specific units instead, maybe even to the TIdStack classes?
  5082. {$IFDEF DOTNET}
  5083. function Ticks64: TIdTicks;
  5084. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5085. begin
  5086. // Must cast to a cardinal
  5087. //
  5088. // http://lists.ximian.com/archives/public/mono-bugs/2003-November/009293.html
  5089. // Other references in Google.
  5090. // Bug in .NET. It acts like Win32, not as per .NET docs but goes negative after 25 days.
  5091. //
  5092. // There may be a problem in the future if .NET changes this to work as docced with 25 days.
  5093. // Will need to check our routines then and somehow counteract / detect this.
  5094. // One possibility is that we could just wrap it ourselves in this routine.
  5095. // TODO: use DateTime.Ticks instead?
  5096. //Result := DateTime.Now.Ticks div 10000;
  5097. Result := TIdTicks(Environment.TickCount);
  5098. end;
  5099. {$ELSE}
  5100. {$IFDEF WINDOWS}
  5101. type
  5102. TGetTickCount64Func = function: UInt64; stdcall;
  5103. var
  5104. GetTickCount64: TGetTickCount64Func = nil;
  5105. function Impl_GetTickCount64: UInt64; stdcall;
  5106. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5107. begin
  5108. // TODO: implement some kind of accumulator so the Result
  5109. // keeps growing even when GetTickCount() wraps back to 0.
  5110. // Or maybe access the CPU's TSC via the x86 RDTSC instruction...
  5111. Result := UInt64(Windows.GetTickCount);
  5112. end;
  5113. function Stub_GetTickCount64: UInt64; stdcall;
  5114. function GetImpl: Pointer;
  5115. begin
  5116. Result := GetProcAddress(GetModuleHandle('KERNEL32'), 'GetTickCount64'); {do not localize}
  5117. if Result = nil then begin
  5118. Result := @Impl_GetTickCount64;
  5119. end;
  5120. end;
  5121. begin
  5122. @GetTickCount64 := GetImpl();
  5123. Result := GetTickCount64();
  5124. end;
  5125. function Ticks64: TIdTicks;
  5126. {$IFDEF USE_HI_PERF_COUNTER_FOR_TICKS}
  5127. var
  5128. nTime, freq: {$IFDEF WINCE}LARGE_INTEGER{$ELSE}Int64{$ENDIF};
  5129. {$ENDIF}
  5130. begin
  5131. // S.G. 27/11/2002: Changed to use high-performance counters as per suggested
  5132. // S.G. 27/11/2002: by David B. Ferguson ([email protected])
  5133. // RLebeau 11/12/2009: removed the high-performance counters again. They
  5134. // are not reliable on multi-core systems, and are now starting to cause
  5135. // problems with TIdIOHandler.ReadLn() timeouts under Windows XP SP3, both
  5136. // 32-bit and 64-bit. Refer to these discussions:
  5137. //
  5138. // http://www.virtualdub.org/blog/pivot/entry.php?id=106
  5139. // http://blogs.msdn.com/oldnewthing/archive/2008/09/08/8931563.aspx
  5140. {$IFDEF USE_HI_PERF_COUNTER_FOR_TICKS}
  5141. {$IFDEF WINCE}
  5142. if Windows.QueryPerformanceCounter(@nTime) then begin
  5143. if Windows.QueryPerformanceFrequency(@freq) then begin
  5144. Result := Trunc((nTime.QuadPart / Freq.QuadPart) * 1000) and High(TIdTicks);
  5145. Exit;
  5146. end;
  5147. end;
  5148. {$ELSE}
  5149. if Windows.QueryPerformanceCounter(nTime) then begin
  5150. if Windows.QueryPerformanceFrequency(freq) then begin
  5151. Result := Trunc((nTime / Freq) * 1000) and High(TIdTicks);
  5152. Exit;
  5153. end;
  5154. end;
  5155. {$ENDIF}
  5156. {$ENDIF}
  5157. Result := TIdTicks(GetTickCount64());
  5158. end;
  5159. {$ELSE}
  5160. {$IFDEF USE_clock_gettime}
  5161. {$IFDEF LINUX}
  5162. // according to Linux's /usr/include/linux/time.h
  5163. const
  5164. CLOCK_MONOTONIC = 1;
  5165. {$ENDIF}
  5166. {$IFDEF FREEBSD}
  5167. // according to FreeBSD's /usr/include/time.h
  5168. const
  5169. CLOCK_MONOTONIC = 4;
  5170. {$ENDIF}
  5171. {$IFDEF ANDROID}
  5172. // according to Android NDK's /include/time.h
  5173. const
  5174. CLOCK_MONOTONIC = 1;
  5175. {$ENDIF}
  5176. function clock_gettime(clockid: Integer; var pts: timespec): Integer; cdecl; external 'libc';
  5177. function Ticks64: TIdTicks;
  5178. var
  5179. ts: timespec;
  5180. begin
  5181. // TODO: use CLOCK_BOOTTIME on platforms that support it? It takes system
  5182. // suspension into account, whereas CLOCK_MONOTONIC does not...
  5183. clock_gettime(CLOCK_MONOTONIC, ts);
  5184. {$I IdRangeCheckingOff.inc}
  5185. {$I IdOverflowCheckingOff.inc}
  5186. Result := (Int64(ts.tv_sec) * 1000) + (ts.tv_nsec div 1000000);
  5187. {$I IdOverflowCheckingOn.inc}
  5188. {$I IdRangeCheckingOn.inc}
  5189. end;
  5190. {$ELSE}
  5191. {$IFDEF UNIX}
  5192. {$IFDEF OSX}
  5193. {$IFDEF FPC}
  5194. //RLebeau: FPC does not provide mach_timebase_info() and mach_absolute_time() yet...
  5195. function mach_timebase_info(var TimebaseInfoData: TTimebaseInfoData): Integer; cdecl; external 'libc';
  5196. function mach_absolute_time: QWORD; cdecl; external 'libc';
  5197. {$ENDIF}
  5198. {$ENDIF}
  5199. function Ticks64: TIdTicks;
  5200. {$IFDEF OSX}
  5201. {$IFDEF USE_INLINE} inline;{$ENDIF}
  5202. {$ELSE}
  5203. var
  5204. tv: timeval;
  5205. {$ENDIF}
  5206. begin
  5207. {$IFDEF OSX}
  5208. // TODO: mach_absolute_time() does NOT count ticks while the system is
  5209. // sleeping! We can use time() to account for that:
  5210. //
  5211. // "time() carries on incrementing while the device is asleep, but of
  5212. // course can be manipulated by the operating system or user. However,
  5213. // the Kernel boottime (a timestamp of when the system last booted)
  5214. // also changes when the system clock is changed, therefore even though
  5215. // both these values are not fixed, the offset between them is."
  5216. //
  5217. // time_t uptime()
  5218. // {
  5219. // struct timeval boottime;
  5220. // int mib[2] = {CTL_KERN, KERN_BOOTTIME};
  5221. // size_t size = sizeof(boottime);
  5222. // time_t now;
  5223. // time_t uptime = -1;
  5224. // time(&now);
  5225. // if ((sysctl(mib, 2, &boottime, &size, NULL, 0) != -1) && (boottime.tv_sec != 0))
  5226. // {
  5227. // uptime = now - boottime.tv_sec;
  5228. // }
  5229. // return uptime;
  5230. // }
  5231. //
  5232. // However, KERN_BOOTTIME only has *seconds* precision (timeval.tv_usecs is always 0).
  5233. // mach_absolute_time() returns billionth of seconds, so divide by one million to get milliseconds
  5234. Result := (mach_absolute_time() * GMachTimeBaseInfo.numer) div (1000000 * GMachTimeBaseInfo.denom);
  5235. {$ELSE}
  5236. // TODO: raise an exception if gettimeofday() fails...
  5237. {$IFDEF KYLIXCOMPAT_OR_VCL_POSIX}
  5238. gettimeofday(tv, nil);
  5239. {$ELSE}
  5240. {$IFDEF USE_BASEUNIX}
  5241. fpgettimeofday(@tv,nil);
  5242. {$ELSE}
  5243. {$message error gettimeofday is not called on this platform!}
  5244. FillChar(tv, sizeof(tv), 0);
  5245. {$ENDIF}
  5246. {$ENDIF}
  5247. {
  5248. I've implemented this correctly for now. I'll argue for using
  5249. an int64 internally, since apparently quite some functionality
  5250. (throttle, etc etc) depends on it, and this value may wrap
  5251. at any point in time.
  5252. For Windows: Uptime > 72 hours isn't really that rare any more,
  5253. For Linux: no control over when this wraps.
  5254. IdEcho has code to circumvent the wrap, but its not very good
  5255. to have code for that at all spots where it might be relevant.
  5256. }
  5257. {$I IdRangeCheckingOff.inc}
  5258. Result := (Int64(tv.tv_sec) * 1000) + (tv.tv_usec div 1000);
  5259. {$I IdRangeCheckingOn.inc}
  5260. {$ENDIF}
  5261. end;
  5262. {$ELSE}
  5263. function Ticks64: TIdTicks;
  5264. begin
  5265. {$message error Ticks64 is not implemented on this platform!}
  5266. Result := 0;
  5267. end;
  5268. {$ENDIF}
  5269. {$ENDIF}
  5270. {$ENDIF}
  5271. {$ENDIF}
  5272. {$I IdDeprecatedImplBugOff.inc}
  5273. function GetTickDiff(const AOldTickCount, ANewTickCount: UInt32): UInt32;
  5274. {$I IdDeprecatedImplBugOn.inc}
  5275. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5276. begin
  5277. {This is just in case the TickCount rolled back to zero}
  5278. if ANewTickCount >= AOldTickCount then begin
  5279. Result := ANewTickCount - AOldTickCount;
  5280. end else begin
  5281. Result := ((High(UInt32) - AOldTickCount) + ANewTickCount) + 1;
  5282. end;
  5283. end;
  5284. function GetTickDiff64(const AOldTickCount, ANewTickCount: TIdTicks): TIdTicks;
  5285. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5286. begin
  5287. {This is just in case the TickCount rolled back to zero}
  5288. if ANewTickCount >= AOldTickCount then begin
  5289. Result := TIdTicks(ANewTickCount - AOldTickCount);
  5290. end else begin
  5291. Result := TIdTicks(((High(TIdTicks) - AOldTickCount) + ANewTickCount) + 1);
  5292. end;
  5293. end;
  5294. function GetElapsedTicks(const AOldTickCount: TIdTicks): UInt32;
  5295. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5296. begin
  5297. Result := UInt32(GetTickDiff64(AOldTickCount, Ticks64));
  5298. end;
  5299. function GetElapsedTicks64(const AOldTickCount: TIdTicks): TIdTicks;
  5300. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5301. begin
  5302. Result := GetTickDiff64(AOldTickCount, Ticks64);
  5303. end;
  5304. {$IFNDEF DOTNET}
  5305. // TODO: define STRING_UNICODE_MISMATCH for WinCE in IdCompilerDefines.inc?
  5306. {$IFDEF WINDOWS}
  5307. {$IFDEF WINCE}
  5308. {$IFNDEF STRING_IS_UNICODE}
  5309. {$DEFINE SERVICE_STRING_MISMATCH}
  5310. {$ENDIF}
  5311. {$ELSE}
  5312. {$IFDEF STRING_UNICODE_MISMATCH}
  5313. {$DEFINE SERVICE_STRING_MISMATCH}
  5314. {$ENDIF}
  5315. {$ENDIF}
  5316. {$ENDIF}
  5317. function ServicesFilePath: string;
  5318. var
  5319. sLocation: {$IFDEF SERVICE_STRING_MISMATCH}TIdPlatformString{$ELSE}string{$ENDIF};
  5320. begin
  5321. {$IFDEF UNIX}
  5322. sLocation := '/etc/'; // assume Berkeley standard placement {do not localize}
  5323. {$ENDIF}
  5324. {$IFDEF WINDOWS}
  5325. {$IFNDEF WINCE}
  5326. SetLength(sLocation, MAX_PATH);
  5327. SetLength(sLocation, GetWindowsDirectory(PIdPlatformChar(sLocation), MAX_PATH));
  5328. sLocation := IndyIncludeTrailingPathDelimiter(string(sLocation));
  5329. if IndyWindowsPlatform = VER_PLATFORM_WIN32_NT then begin
  5330. sLocation := sLocation + 'system32\drivers\etc\'; {do not localize}
  5331. end;
  5332. {$ELSE}
  5333. // GetWindowsDirectory() does not exist in WinCE, and there is no system folder, either
  5334. sLocation := '\Windows\'; {do not localize}
  5335. {$ENDIF}
  5336. {$ENDIF}
  5337. Result := sLocation + 'services'; {do not localize}
  5338. end;
  5339. {$ENDIF}
  5340. {$IFNDEF DOTNET}
  5341. // IdPorts returns a list of defined ports in /etc/services
  5342. function IdPorts: TIdPortList;
  5343. var
  5344. s: string;
  5345. idx, iPosSlash: {$IFDEF BYTE_COMPARE_SETS}Byte{$ELSE}Integer{$ENDIF};
  5346. i: {$IFDEF HAS_GENERICS_TList}Integer{$ELSE}PtrInt{$ENDIF};
  5347. iPrev: PtrInt;
  5348. sl: TStringList;
  5349. begin
  5350. if GIdPorts = nil then
  5351. begin
  5352. GIdPorts := TIdPortList.Create;
  5353. sl := TStringList.Create;
  5354. try
  5355. // TODO: use TStreamReader instead, on versions that support it
  5356. sl.LoadFromFile(ServicesFilePath); {do not localize}
  5357. iPrev := 0;
  5358. for idx := 0 to sl.Count - 1 do
  5359. begin
  5360. s := sl[idx];
  5361. iPosSlash := IndyPos('/', s); {do not localize}
  5362. if (iPosSlash > 0) and (not (IndyPos('#', s) in [1..iPosSlash])) then {do not localize}
  5363. begin // presumably found a port number that isn't commented {Do not Localize}
  5364. i := iPosSlash;
  5365. repeat
  5366. Dec(i);
  5367. if i = 0 then begin
  5368. raise EIdCorruptServicesFile.CreateFmt(RSCorruptServicesFile, [ServicesFilePath]); {do not localize}
  5369. end;
  5370. //TODO: Make Whitespace a function to elim warning
  5371. until Ord(s[i]) in IdWhiteSpace;
  5372. i := IndyStrToInt(Copy(s, i+1, iPosSlash-i-1));
  5373. if i <> iPrev then begin
  5374. GIdPorts.Add(
  5375. {$IFDEF HAS_GENERICS_TList}i{$ELSE}Pointer(i){$ENDIF}
  5376. );
  5377. end;
  5378. iPrev := i;
  5379. end;
  5380. end;
  5381. finally
  5382. sl.Free;
  5383. end;
  5384. end;
  5385. Result := GIdPorts;
  5386. end;
  5387. {$ENDIF}
  5388. function iif(ATest: Boolean; const ATrue: Integer; const AFalse: Integer): Integer;
  5389. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5390. begin
  5391. if ATest then begin
  5392. Result := ATrue;
  5393. end else begin
  5394. Result := AFalse;
  5395. end;
  5396. end;
  5397. function iif(ATest: Boolean; const ATrue: string; const AFalse: string): string;
  5398. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5399. begin
  5400. if ATest then begin
  5401. Result := ATrue;
  5402. end else begin
  5403. Result := AFalse;
  5404. end;
  5405. end;
  5406. function iif(ATest: Boolean; const ATrue: Boolean; const AFalse: Boolean): Boolean;
  5407. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5408. begin
  5409. if ATest then begin
  5410. Result := ATrue;
  5411. end else begin
  5412. Result := AFalse;
  5413. end;
  5414. end;
  5415. function iif(const AEncoding, ADefEncoding: IIdTextEncoding; ADefEncodingType: IdTextEncodingType = encASCII): IIdTextEncoding;
  5416. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5417. begin
  5418. Result := AEncoding;
  5419. if Result = nil then
  5420. begin
  5421. Result := ADefEncoding;
  5422. EnsureEncoding(Result, ADefEncodingType);
  5423. end;
  5424. end;
  5425. function InMainThread: Boolean;
  5426. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5427. begin
  5428. {$IFDEF DOTNET}
  5429. Result := System.Threading.Thread.CurrentThread = MainThread;
  5430. {$ELSE}
  5431. Result := GetCurrentThreadID = MainThreadID;
  5432. {$ENDIF}
  5433. end;
  5434. procedure WriteMemoryStreamToStream(Src: TMemoryStream; Dest: TStream; Count: TIdStreamSize);
  5435. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5436. begin
  5437. {$IFDEF DOTNET}
  5438. Dest.Write(Src.Memory, Count);
  5439. {$ELSE}
  5440. Dest.Write(Src.Memory^, Count);
  5441. {$ENDIF}
  5442. end;
  5443. {$IFNDEF DOTNET_EXCLUDE}
  5444. function IsCurrentThread(AThread: TThread): Boolean;
  5445. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5446. begin
  5447. Result := AThread.ThreadID = GetCurrentThreadID;
  5448. end;
  5449. {$ENDIF}
  5450. //convert a dword into an IPv4 address in dotted form
  5451. function MakeUInt32IntoIPv4Address(const ADWord: UInt32): string;
  5452. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5453. begin
  5454. Result := IntToStr((ADWord shr 24) and $FF) + '.';
  5455. Result := Result + IntToStr((ADWord shr 16) and $FF) + '.';
  5456. Result := Result + IntToStr((ADWord shr 8) and $FF) + '.';
  5457. Result := Result + IntToStr(ADWord and $FF);
  5458. end;
  5459. {$I IdDeprecatedImplBugOff.inc}
  5460. function MakeDWordIntoIPv4Address(const ADWord: UInt32): string;
  5461. {$I IdDeprecatedImplBugOn.inc}
  5462. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5463. begin
  5464. Result := MakeUInt32IntoIPv4Address(ADWord);
  5465. end;
  5466. function IsAlpha(const AChar: Char): Boolean;
  5467. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5468. begin
  5469. // TODO: under XE3.5+, use TCharHelper.IsLetter() instead
  5470. // TODO: under D2009+, use TCharacter.IsLetter() instead
  5471. // Do not use IsCharAlpha or IsCharAlphaNumeric - they are Win32 routines
  5472. Result := ((AChar >= 'a') and (AChar <= 'z')) or ((AChar >= 'A') and (AChar <= 'Z')); {Do not Localize}
  5473. end;
  5474. function IsAlpha(const AString: String; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean;
  5475. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5476. var
  5477. i: Integer;
  5478. LLen: Integer;
  5479. begin
  5480. Result := False;
  5481. LLen := IndyLength(AString, ALength, AIndex);
  5482. if LLen > 0 then begin
  5483. for i := 0 to LLen-1 do begin
  5484. if not IsAlpha(AString[AIndex+i]) then begin
  5485. Exit;
  5486. end;
  5487. end;
  5488. Result := True;
  5489. end;
  5490. end;
  5491. function IsAlphaNumeric(const AChar: Char): Boolean;
  5492. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5493. begin
  5494. // Do not use IsCharAlpha or IsCharAlphaNumeric - they are Win32 routines
  5495. Result := IsAlpha(AChar) or IsNumeric(AChar);
  5496. end;
  5497. function IsAlphaNumeric(const AString: String; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean;
  5498. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5499. var
  5500. i: Integer;
  5501. LLen: Integer;
  5502. begin
  5503. Result := False;
  5504. LLen := IndyLength(AString, ALength, AIndex);
  5505. if LLen > 0 then begin
  5506. for i := 0 to LLen-1 do begin
  5507. if not IsAlphaNumeric(AString[AIndex+i]) then begin
  5508. Exit;
  5509. end;
  5510. end;
  5511. Result := True;
  5512. end;
  5513. end;
  5514. function IsOctal(const AChar: Char): Boolean; overload;
  5515. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5516. begin
  5517. Result := (AChar >= '0') and (AChar <= '7') {Do not Localize}
  5518. end;
  5519. function IsOctal(const AString: string; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean; overload;
  5520. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5521. var
  5522. i: Integer;
  5523. LLen: Integer;
  5524. begin
  5525. Result := False;
  5526. LLen := IndyLength(AString, ALength, AIndex);
  5527. if LLen > 0 then begin
  5528. for i := 0 to LLen-1 do begin
  5529. if not IsOctal(AString[AIndex+i]) then begin
  5530. Exit;
  5531. end;
  5532. end;
  5533. Result := True;
  5534. end;
  5535. end;
  5536. function IsHexidecimal(const AChar: Char): Boolean; overload;
  5537. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5538. begin
  5539. Result := IsNumeric(AChar)
  5540. or ((AChar >= 'A') and (AChar <= 'F')) {Do not Localize}
  5541. or ((AChar >= 'a') and (AChar <= 'f')); {Do not Localize}
  5542. end;
  5543. function IsHexidecimal(const AString: string; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean; overload;
  5544. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5545. var
  5546. i: Integer;
  5547. LLen: Integer;
  5548. begin
  5549. Result := False;
  5550. LLen := IndyLength(AString, ALength, AIndex);
  5551. if LLen > 0 then begin
  5552. for i := 0 to LLen-1 do begin
  5553. if not IsHexidecimal(AString[AIndex+i]) then begin
  5554. Exit;
  5555. end;
  5556. end;
  5557. Result := True;
  5558. end;
  5559. end;
  5560. {$HINTS OFF}
  5561. function IsNumeric(const AString: string): Boolean;
  5562. var
  5563. LCode: Integer;
  5564. LVoid: Int64;
  5565. begin
  5566. Val(AString, LVoid, LCode);
  5567. Result := LCode = 0;
  5568. end;
  5569. {$HINTS ON}
  5570. function IsNumeric(const AString: string; const ALength: Integer; const AIndex: Integer = 1): Boolean;
  5571. var
  5572. I: Integer;
  5573. LLen: Integer;
  5574. begin
  5575. Result := False;
  5576. LLen := IndyLength(AString, ALength, AIndex);
  5577. if LLen > 0 then begin
  5578. for I := 0 to LLen-1 do begin
  5579. if not IsNumeric(AString[AIndex+i]) then begin
  5580. Exit;
  5581. end;
  5582. end;
  5583. Result := True;
  5584. end;
  5585. end;
  5586. function IsNumeric(const AChar: Char): Boolean;
  5587. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5588. begin
  5589. // TODO: under XE3.5+, use TCharHelper.IsDigit() instead
  5590. // TODO: under D2009+, use TCharacter.IsDigit() instead
  5591. // Do not use IsCharAlpha or IsCharAlphaNumeric - they are Win32 routines
  5592. Result := (AChar >= '0') and (AChar <= '9'); {Do not Localize}
  5593. end;
  5594. {
  5595. This is an adaptation of the StrToInt64 routine in SysUtils.
  5596. We had to adapt it to work with Int64 because the one with Integers
  5597. can not deal with anything greater than MaxInt and IP addresses are
  5598. always $0-$FFFFFFFF (unsigned)
  5599. }
  5600. {$IFNDEF HAS_StrToInt64Def}
  5601. function StrToInt64Def(const S: string; const Default: Integer): Int64;
  5602. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5603. var
  5604. E: Integer;
  5605. begin
  5606. Val(S, Result, E);
  5607. if E <> 0 then begin
  5608. Result := Default;
  5609. end;
  5610. end;
  5611. {$ENDIF}
  5612. function IPv4MakeUInt32InRange(const AInt: Int64; const A256Power: Integer): UInt32;
  5613. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5614. //Note that this function is only for stripping off some extra bits
  5615. //from an address that might appear in some spam E-Mails.
  5616. begin
  5617. case A256Power of
  5618. 4: Result := (AInt and POWER_4);
  5619. 3: Result := (AInt and POWER_3);
  5620. 2: Result := (AInt and POWER_2);
  5621. else
  5622. Result := (AInt and POWER_1);
  5623. end;
  5624. end;
  5625. {$I IdDeprecatedImplBugOff.inc}
  5626. function IPv4MakeLongWordInRange(const AInt: Int64; const A256Power: Integer): UInt32;
  5627. {$I IdDeprecatedImplBugOn.inc}
  5628. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5629. begin
  5630. Result := IPv4MakeUInt32InRange(AInt, A256Power);
  5631. end;
  5632. function IPv4ToUInt32(const AIPAddress: string): UInt32;
  5633. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5634. var
  5635. LErr: Boolean;
  5636. begin
  5637. Result := IPv4ToUInt32(AIPAddress, LErr);
  5638. end;
  5639. {$I IdDeprecatedImplBugOff.inc}
  5640. function IPv4ToDWord(const AIPAddress: string): UInt32; overload;
  5641. {$I IdDeprecatedImplBugOn.inc}
  5642. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5643. begin
  5644. Result := IPv4ToUInt32(AIPAddress);
  5645. end;
  5646. function IPv4ToUInt32(const AIPAddress: string; var VErr: Boolean): UInt32;
  5647. var
  5648. {$IFDEF DOTNET}
  5649. AIPaddr: IPAddress;
  5650. {$ELSE}
  5651. LBuf, LBuf2: string;
  5652. L256Power: Integer;
  5653. LParts: Integer; //how many parts should we process at a time
  5654. {$ENDIF}
  5655. begin
  5656. VErr := True;
  5657. Result := 0;
  5658. {$IFDEF DOTNET}
  5659. AIPaddr := System.Net.IPAddress.Parse(AIPAddress);
  5660. try
  5661. try
  5662. if AIPaddr.AddressFamily = Addressfamily.InterNetwork then begin
  5663. {$IFDEF DOTNET_2_OR_ABOVE}
  5664. //This looks funny but it's just to circvument a warning about
  5665. //a depreciated property in AIPaddr. We can safely assume
  5666. //this is an IPv4 address.
  5667. Result := BytesToUInt32( AIPAddr.GetAddressBytes,0);
  5668. {$ENDIF}
  5669. {$IFDEF DOTNET_1_1}
  5670. Result := AIPaddr.Address;
  5671. {$ENDIF}
  5672. VErr := False;
  5673. end;
  5674. except
  5675. VErr := True;
  5676. end;
  5677. finally
  5678. FreeAndNil(AIPaddr);
  5679. end;
  5680. {$ELSE}
  5681. // S.G. 11/8/2003: Added overflow checking disabling and change multiplys by SHLs.
  5682. // Locally disable overflow checking so we can safely use SHL and SHR
  5683. {$I IdOverflowCheckingOff.inc}
  5684. L256Power := 4;
  5685. LBuf2 := AIPAddress;
  5686. repeat
  5687. LBuf := Fetch(LBuf2, '.');
  5688. if LBuf = '' then begin
  5689. Break;
  5690. end;
  5691. //We do things this way because we have to treat
  5692. //IP address parts differently than a whole number
  5693. //and sometimes, there can be missing periods.
  5694. if (LBuf2 = '') and (L256Power > 1) then begin
  5695. LParts := L256Power;
  5696. Result := Result shl (L256Power SHL 3);
  5697. end else begin
  5698. LParts := 1;
  5699. Result := Result shl 8;
  5700. end;
  5701. if TextStartsWith(LBuf, IdHexPrefix) then begin
  5702. //this is a hexideciaml number
  5703. if not IsHexidecimal(Copy(LBuf, 3, MaxInt)) then begin
  5704. Exit;
  5705. end;
  5706. Result := Result + IPv4MakeUInt32InRange(StrToInt64Def(LBuf, 0), LParts);
  5707. end else begin
  5708. if not IsNumeric(LBuf) then begin
  5709. //There was an error meaning an invalid IP address
  5710. Exit;
  5711. end;
  5712. if TextStartsWith(LBuf, '0') and IsOctal(LBuf) then begin {do not localize}
  5713. //this is octal
  5714. Result := Result + IPv4MakeUInt32InRange(OctalToInt64(LBuf), LParts);
  5715. end else begin
  5716. //this must be a decimal
  5717. Result := Result + IPv4MakeUInt32InRange(StrToInt64Def(LBuf, 0), LParts);
  5718. end;
  5719. end;
  5720. Dec(L256Power);
  5721. until False;
  5722. VErr := False;
  5723. // Restore overflow checking
  5724. {$I IdOverflowCheckingOn.inc}
  5725. {$ENDIF}
  5726. end;
  5727. {$I IdDeprecatedImplBugOff.inc}
  5728. function IPv4ToDWord(const AIPAddress: string; var VErr: Boolean): UInt32;
  5729. {$I IdDeprecatedImplBugOn.inc}
  5730. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5731. begin
  5732. Result := IPv4ToUInt32(AIPAddress, VErr);
  5733. end;
  5734. function IPv6AddressToStr(const AValue: TIdIPv6Address): string;
  5735. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5736. var
  5737. i: Integer;
  5738. begin
  5739. Result := IntToHex(AValue[0], 4);
  5740. for i := 1 to 7 do begin
  5741. Result := Result + ':' + IntToHex(AValue[i], 4);
  5742. end;
  5743. end;
  5744. function MakeCanonicalIPv4Address(const AAddr: string): string;
  5745. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5746. var
  5747. LErr: Boolean;
  5748. LIP: UInt32;
  5749. begin
  5750. LIP := IPv4ToUInt32(AAddr, LErr);
  5751. if LErr then begin
  5752. Result := '';
  5753. end else begin
  5754. Result := MakeUInt32IntoIPv4Address(LIP);
  5755. end;
  5756. end;
  5757. function MakeCanonicalIPv6Address(const AAddr: string): string;
  5758. // return an empty string if the address is invalid,
  5759. // for easy checking if its an address or not.
  5760. var
  5761. p, i: Integer;
  5762. {$IFDEF BYTE_COMPARE_SETS}
  5763. dots, colons: Byte;
  5764. {$ELSE}
  5765. dots, colons: Integer;
  5766. {$ENDIF}
  5767. colonpos: array[1..8] of Integer;
  5768. dotpos: array[1..3] of Integer;
  5769. LAddr: string;
  5770. num: Integer;
  5771. haddoublecolon: boolean;
  5772. fillzeros: Integer;
  5773. begin
  5774. Result := ''; // error
  5775. LAddr := AAddr;
  5776. if Length(LAddr) = 0 then begin
  5777. Exit;
  5778. end;
  5779. if TextStartsWith(LAddr, ':') then begin
  5780. LAddr := '0' + LAddr;
  5781. end;
  5782. if TextEndsWith(LAddr, ':') then begin
  5783. LAddr := LAddr + '0';
  5784. end;
  5785. dots := 0;
  5786. colons := 0;
  5787. for p := 1 to Length(LAddr) do begin
  5788. case LAddr[p] of
  5789. '.': begin
  5790. Inc(dots);
  5791. if dots < 4 then begin
  5792. dotpos[dots] := p;
  5793. end else begin
  5794. Exit; // error in address
  5795. end;
  5796. end;
  5797. ':': begin
  5798. Inc(colons);
  5799. if colons < 8 then begin
  5800. colonpos[colons] := p;
  5801. end else begin
  5802. Exit; // error in address
  5803. end;
  5804. end;
  5805. 'a'..'f',
  5806. 'A'..'F': if dots > 0 then Exit;
  5807. // allow only decimal stuff within dotted portion, ignore otherwise
  5808. '0'..'9': ; // do nothing
  5809. else
  5810. Exit; // error in address
  5811. end; // case
  5812. end; // for
  5813. if not (dots in [0,3]) then begin
  5814. Exit; // you have to write 0 or 3 dots...
  5815. end;
  5816. if dots = 3 then begin
  5817. if not (colons in [2..6]) then begin
  5818. Exit; // must not have 7 colons if we have dots
  5819. end;
  5820. if colonpos[colons] > dotpos[1] then begin
  5821. Exit; // x:x:x.x:x:x is not valid
  5822. end;
  5823. end else begin
  5824. if not (colons in [2..7]) then begin
  5825. Exit; // must at least have two colons
  5826. end;
  5827. end;
  5828. // now start :-)
  5829. num := IndyStrToInt('$'+Copy(LAddr, 1, colonpos[1]-1), -1);
  5830. if (num < 0) or (num > 65535) then begin
  5831. Exit; // huh? odd number...
  5832. end;
  5833. Result := IntToHex(num, 1) + ':';
  5834. haddoublecolon := False;
  5835. for p := 2 to colons do begin
  5836. if colonpos[p - 1] = colonpos[p]-1 then begin
  5837. if haddoublecolon then begin
  5838. Result := '';
  5839. Exit; // only a single double-dot allowed!
  5840. end;
  5841. haddoublecolon := True;
  5842. fillzeros := 8 - colons;
  5843. if dots > 0 then begin
  5844. Dec(fillzeros);
  5845. end;
  5846. for i := 1 to fillzeros do begin
  5847. Result := Result + '0:'; {do not localize}
  5848. end;
  5849. end else begin
  5850. num := IndyStrToInt('$' + Copy(LAddr, colonpos[p - 1] + 1, colonpos[p] - colonpos[p - 1] - 1), -1);
  5851. if (num < 0) or (num > 65535) then begin
  5852. Result := '';
  5853. Exit; // huh? odd number...
  5854. end;
  5855. Result := Result + IntToHex(num,1) + ':';
  5856. end;
  5857. end; // end of colon separated part
  5858. if dots = 0 then begin
  5859. num := IndyStrToInt('$' + Copy(LAddr, colonpos[colons] + 1, MaxInt), -1);
  5860. if (num < 0) or (num > 65535) then begin
  5861. Result := '';
  5862. Exit; // huh? odd number...
  5863. end;
  5864. Result := Result + IntToHex(num,1) + ':';
  5865. end;
  5866. if dots > 0 then begin
  5867. num := IndyStrToInt(Copy(LAddr, colonpos[colons] + 1, dotpos[1] - colonpos[colons] -1),-1);
  5868. if (num < 0) or (num > 255) then begin
  5869. Result := '';
  5870. Exit;
  5871. end;
  5872. Result := Result + IntToHex(num, 2);
  5873. num := IndyStrToInt(Copy(LAddr, dotpos[1]+1, dotpos[2]-dotpos[1]-1),-1);
  5874. if (num < 0) or (num > 255) then begin
  5875. Result := '';
  5876. Exit;
  5877. end;
  5878. Result := Result + IntToHex(num, 2) + ':';
  5879. num := IndyStrToInt(Copy(LAddr, dotpos[2] + 1, dotpos[3] - dotpos[2] -1),-1);
  5880. if (num < 0) or (num > 255) then begin
  5881. Result := '';
  5882. Exit;
  5883. end;
  5884. Result := Result + IntToHex(num, 2);
  5885. num := IndyStrToInt(Copy(LAddr, dotpos[3] + 1, 3), -1);
  5886. if (num < 0) or (num > 255) then begin
  5887. Result := '';
  5888. Exit;
  5889. end;
  5890. Result := Result + IntToHex(num, 2) + ':';
  5891. end;
  5892. SetLength(Result, Length(Result) - 1);
  5893. end;
  5894. procedure IPv6ToIdIPv6Address(const AIPAddress: String; var VAddress: TIdIPv6Address);
  5895. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5896. var
  5897. LErr: Boolean;
  5898. begin
  5899. IPv6ToIdIPv6Address(AIPAddress, VAddress, LErr);
  5900. if LErr then begin
  5901. raise EIdInvalidIPv6Address.CreateFmt(RSInvalidIPv6Address, [AIPAddress]);
  5902. end;
  5903. end;
  5904. procedure IPv6ToIdIPv6Address(const AIPAddress: String; var VAddress: TIdIPv6Address; var VErr: Boolean);
  5905. var
  5906. LAddress: string;
  5907. I: Integer;
  5908. begin
  5909. LAddress := MakeCanonicalIPv6Address(AIPAddress);
  5910. VErr := (LAddress = '');
  5911. if VErr then begin
  5912. Exit;
  5913. end;
  5914. for I := 0 to 7 do begin
  5915. VAddress[I] := IndyStrToInt('$' + Fetch(LAddress,':'), 0);
  5916. end;
  5917. end;
  5918. function IndyMax(const AValueOne, AValueTwo: Int64): Int64;
  5919. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5920. begin
  5921. if AValueOne < AValueTwo then begin
  5922. Result := AValueTwo;
  5923. end else begin
  5924. Result := AValueOne;
  5925. end;
  5926. end;
  5927. function IndyMax(const AValueOne, AValueTwo: Int32): Int32;
  5928. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5929. begin
  5930. if AValueOne < AValueTwo then begin
  5931. Result := AValueTwo;
  5932. end else begin
  5933. Result := AValueOne;
  5934. end;
  5935. end;
  5936. function IndyMax(const AValueOne, AValueTwo: UInt16): UInt16;
  5937. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5938. begin
  5939. if AValueOne < AValueTwo then begin
  5940. Result := AValueTwo;
  5941. end else begin
  5942. Result := AValueOne;
  5943. end;
  5944. end;
  5945. {$IFNDEF DOTNET}
  5946. // TODO: validate this with Unicode data
  5947. function MemoryPos(const ASubStr: string; MemBuff: PChar; MemorySize: Integer): Integer;
  5948. var
  5949. LSearchLength: Integer;
  5950. LS1: Integer;
  5951. LChar: Char;
  5952. LPS, LPM: PChar;
  5953. begin
  5954. LSearchLength := Length(ASubStr);
  5955. if (LSearchLength = 0) or (LSearchLength > (MemorySize * SizeOf(Char))) then begin
  5956. Result := 0;
  5957. Exit;
  5958. end;
  5959. LChar := PChar(Pointer(ASubStr))^; //first char
  5960. LPS := PChar(Pointer(ASubStr))+1;//tail string
  5961. LPM := MemBuff;
  5962. LS1 := LSearchLength-1;
  5963. LSearchLength := MemorySize-LS1;//MemorySize-LS+1
  5964. if LS1 = 0 then begin //optimization for freq used LF
  5965. while LSearchLength > 0 do begin
  5966. if LPM^ = LChar then begin
  5967. Result := LPM-MemBuff + 1;
  5968. Exit;
  5969. end;
  5970. Inc(LPM);
  5971. Dec(LSearchLength);
  5972. end;//while
  5973. end else begin
  5974. while LSearchLength > 0 do begin
  5975. if LPM^ = LChar then begin
  5976. Inc(LPM);
  5977. if CompareMem(LPM, LPS, LS1 * SizeOf(Char)) then begin
  5978. Result := LPM - MemBuff;
  5979. Exit;
  5980. end;
  5981. end else begin
  5982. Inc(LPM);
  5983. end;
  5984. Dec(LSearchLength);
  5985. end;
  5986. end;
  5987. Result := 0;
  5988. end;
  5989. {$ENDIF}
  5990. function IndyMin(const AValueOne, AValueTwo: Int32): Int32;
  5991. {$IFDEF USE_INLINE}inline;{$ENDIF}
  5992. begin
  5993. if AValueOne > AValueTwo then begin
  5994. Result := AValueTwo;
  5995. end else begin
  5996. Result := AValueOne;
  5997. end;
  5998. end;
  5999. function IndyMin(const AValueOne, AValueTwo: Int64): Int64;
  6000. {$IFDEF USE_INLINE}inline;{$ENDIF}
  6001. begin
  6002. if AValueOne > AValueTwo then begin
  6003. Result := AValueTwo;
  6004. end else begin
  6005. Result := AValueOne;
  6006. end;
  6007. end;
  6008. function IndyMin(const AValueOne, AValueTwo: UInt16): UInt16;
  6009. {$IFDEF USE_INLINE}inline;{$ENDIF}
  6010. begin
  6011. if AValueOne > AValueTwo then begin
  6012. Result := AValueTwo;
  6013. end else begin
  6014. Result := AValueOne;
  6015. end;
  6016. end;
  6017. function PosIdx(const ASubStr, AStr: string; AStartPos: UInt32): UInt32;
  6018. {$IFDEF DOTNET}
  6019. {$IFDEF USE_INLINE}inline;{$ENDIF}
  6020. {$ELSE}
  6021. // use best register allocation on Win32
  6022. function FindStr(ALStartPos, EndPos: UInt32; StartChar: Char; const ALStr: string): UInt32;
  6023. begin
  6024. for Result := ALStartPos to EndPos do begin
  6025. if ALStr[Result] = StartChar then begin
  6026. Exit;
  6027. end;
  6028. end;
  6029. Result := 0;
  6030. end;
  6031. // use best register allocation on Win32
  6032. function FindNextStr(ALStartPos, EndPos: UInt32; const ALStr, ALSubStr: string): UInt32;
  6033. begin
  6034. for Result := ALStartPos + 1 to EndPos do begin
  6035. if ALStr[Result] <> ALSubStr[Result - ALStartPos + 1] then begin
  6036. Exit;
  6037. end;
  6038. end;
  6039. Result := 0;
  6040. end;
  6041. var
  6042. StartChar: Char;
  6043. LenSubStr, LenStr: UInt32;
  6044. EndPos: UInt32;
  6045. {$ENDIF}
  6046. begin
  6047. if AStartPos = 0 then begin
  6048. AStartPos := 1;
  6049. end;
  6050. {$IFDEF DOTNET}
  6051. Result := AStr.IndexOf(ASubStr, AStartPos-1) + 1;
  6052. {$ELSE}
  6053. Result := 0;
  6054. LenSubStr := Length(ASubStr);
  6055. LenStr := Length(AStr);
  6056. if (LenSubStr = 0) or (AStr = '') or (LenSubStr > (LenStr - (AStartPos - 1))) then begin
  6057. Exit;
  6058. end;
  6059. StartChar := ASubStr[1];
  6060. EndPos := LenStr - LenSubStr + 1;
  6061. if LenSubStr = 1 then begin
  6062. Result := FindStr(AStartPos, EndPos, StartChar, AStr)
  6063. end else
  6064. begin
  6065. repeat
  6066. Result := FindStr(AStartPos, EndPos, StartChar, AStr);
  6067. if Result = 0 then begin
  6068. Break;
  6069. end;
  6070. AStartPos := Result;
  6071. Result := FindNextStr(Result, AStartPos + LenSubStr - 1, AStr, ASubStr);
  6072. if Result = 0 then
  6073. begin
  6074. Result := AStartPos;
  6075. Exit;
  6076. end;
  6077. Inc(AStartPos);
  6078. until False;
  6079. end;
  6080. {$ENDIF}
  6081. end;
  6082. function SBPos(const Substr, S: string): Integer;
  6083. {$IFDEF USE_INLINE}inline;{$ENDIF}
  6084. begin
  6085. // Necessary because of "Compiler magic"
  6086. Result := Pos(Substr, S);
  6087. end;
  6088. {$IFNDEF DOTNET}
  6089. function SBStrScan(Str: PChar; Chr: Char): PChar;
  6090. {$IFDEF USE_INLINE}inline;{$ENDIF}
  6091. begin
  6092. Result := SysUtils.StrScan(Str, Chr);
  6093. end;
  6094. {$ENDIF}
  6095. {$IFNDEF DOTNET}
  6096. //Don't rename this back to AnsiPos because that conceals a symbol in Windows
  6097. function InternalAnsiPos(const Substr, S: string): Integer;
  6098. {$IFDEF USE_INLINE}inline;{$ENDIF}
  6099. begin
  6100. Result := SysUtils.AnsiPos(Substr, S);
  6101. end;
  6102. function InternalAnsiStrScan(Str: PChar; Chr: Char): PChar;
  6103. {$IFDEF USE_INLINE}inline;{$ENDIF}
  6104. begin
  6105. Result := SysUtils.AnsiStrScan(Str, Chr);
  6106. end;
  6107. {$ENDIF}
  6108. {$UNDEF USE_TTHREAD_PRIORITY_PROP}
  6109. {$IFDEF DOTNET}
  6110. {$DEFINE USE_TTHREAD_PRIORITY_PROP}
  6111. {$ENDIF}
  6112. {$IFDEF WINDOWS}
  6113. {$DEFINE USE_TTHREAD_PRIORITY_PROP}
  6114. {$ENDIF}
  6115. {$IFDEF UNIX}
  6116. {$IFDEF USE_VCL_POSIX}
  6117. // TODO: does this apply?
  6118. {.$DEFINE USE_TTHREAD_PRIORITY_PROP}
  6119. {$ENDIF}
  6120. {$IFDEF KYLIXCOMPAT} // TODO: use KYLIXCOMPAT_OR_VCL_POSIX instead?
  6121. {$IFNDEF INT_THREAD_PRIORITY}
  6122. {$DEFINE USE_TTHREAD_PRIORITY_PROP}
  6123. {$ENDIF}
  6124. {$ENDIF}
  6125. {$ENDIF}
  6126. procedure IndySetThreadPriority(AThread: TThread; const APriority: TIdThreadPriority;
  6127. const APolicy: Integer = -MaxInt);
  6128. {$IFDEF USE_INLINE}inline;{$ENDIF}
  6129. begin
  6130. {$IFDEF USE_TTHREAD_PRIORITY_PROP}
  6131. AThread.Priority := APriority;
  6132. {$ELSE}
  6133. {$IFDEF UNIX}
  6134. // Linux only allows root to adjust thread priorities, so we just ignore this call in Linux?
  6135. // actually, why not allow it if root
  6136. // and also allow setting *down* threadpriority (anyone can do that)
  6137. // note that priority is called "niceness" and positive is lower priority
  6138. {$IFDEF KYLIXCOMPAT} // TODO: use KYLIXCOMPAT_OR_VCL_POSIX instead?
  6139. if (getpriority(PRIO_PROCESS, 0) < APriority) or (geteuid = 0) then begin
  6140. setpriority(PRIO_PROCESS, 0, APriority);
  6141. end;
  6142. {$ELSE}
  6143. {$IFDEF USE_BASEUNIX}
  6144. if (fpgetpriority(PRIO_PROCESS, 0) < cint(APriority)) or (fpgeteuid = 0) then begin
  6145. fpsetpriority(PRIO_PROCESS, 0, cint(APriority));
  6146. end;
  6147. {$ENDIF}
  6148. {$ENDIF}
  6149. {$ENDIF}
  6150. {$ENDIF}
  6151. end;
  6152. procedure IndySleep(ATime: UInt32);
  6153. {$IFDEF USE_VCL_POSIX}
  6154. {$IFDEF USE_INLINE}inline;{$ENDIF}
  6155. var
  6156. LTime: TimeVal;
  6157. {$ELSE}
  6158. {$IFDEF UNIX}
  6159. var
  6160. LTime: TTimeVal;
  6161. {$ELSE}
  6162. {$IFDEF USE_INLINE}inline;{$ENDIF}
  6163. {$ENDIF}
  6164. {$ENDIF}
  6165. begin
  6166. {$IFDEF DOTNET}
  6167. Thread.Sleep(ATime);
  6168. {$ELSE}
  6169. {$IFDEF WINDOWS}
  6170. Windows.Sleep(ATime);
  6171. {$ELSE}
  6172. {$IFDEF UNIX}
  6173. // *nix: Is there any reason for not using nanosleep() instead?
  6174. // what if the user just calls sleep? without doing anything...
  6175. // cannot use GStack.WSSelectRead(nil, ATime)
  6176. // since no readsocketlist exists to get the fdset
  6177. LTime.tv_sec := ATime div 1000;
  6178. LTime.tv_usec := (ATime mod 1000) * 1000;
  6179. {$IFDEF USE_VCL_POSIX}
  6180. select(0, nil, nil, nil, @LTime);
  6181. {$ELSE}
  6182. {$IFDEF KYLIXCOMPAT}
  6183. Libc.Select(0, nil, nil, nil, @LTime);
  6184. {$ELSE}
  6185. {$IFDEF USE_BASEUNIX}
  6186. fpSelect(0, nil, nil, nil, @LTime);
  6187. {$ELSE}
  6188. {$message error select is not called on this platform!}
  6189. {$ENDIF}
  6190. {$ENDIF}
  6191. {$ENDIF}
  6192. {$ELSE}
  6193. {$message error IndySleep is not implemented on this platform!}
  6194. {$ENDIF}
  6195. {$ENDIF}
  6196. {$ENDIF}
  6197. end;
  6198. {$I IdDeprecatedImplBugOff.inc}
  6199. procedure SplitColumnsNoTrim(const AData: string; AStrings: TStrings; const ADelim: string = ' ');
  6200. {$I IdDeprecatedImplBugOn.inc}
  6201. begin
  6202. SplitDelimitedString(AData, AStrings, False, ADelim{$IFNDEF USE_OBJECT_ARC}, True{$ENDIF});
  6203. end;
  6204. {$I IdDeprecatedImplBugOff.inc}
  6205. procedure SplitColumns(const AData: string; AStrings: TStrings; const ADelim: string = ' ');
  6206. {$I IdDeprecatedImplBugOn.inc}
  6207. begin
  6208. SplitDelimitedString(AData, AStrings, True, ADelim{$IFNDEF USE_OBJECT_ARC}, True{$ENDIF});
  6209. end;
  6210. procedure SplitDelimitedString(const AData: string; AStrings: TStrings; ATrim: Boolean;
  6211. const ADelim: string = ' '{$IFNDEF USE_OBJECT_ARC}; AIncludePositions: Boolean = False{$ENDIF});
  6212. var
  6213. i: Integer;
  6214. LData: string;
  6215. LDelim: Integer; //delim len
  6216. LLeft: string;
  6217. LLastPos, LLeadingSpaceCnt: PtrInt;
  6218. begin
  6219. Assert(Assigned(AStrings));
  6220. AStrings.BeginUpdate;
  6221. try
  6222. AStrings.Clear;
  6223. LDelim := Length(ADelim);
  6224. LLastPos := 1;
  6225. if ATrim then begin
  6226. LData := Trim(AData);
  6227. if LData = '' then begin //if WhiteStr
  6228. Exit;
  6229. end;
  6230. LLeadingSpaceCnt := 0;
  6231. while AData[LLeadingSpaceCnt + 1] <= #32 do begin
  6232. Inc(LLeadingSpaceCnt);
  6233. end;
  6234. i := Pos(ADelim, LData);
  6235. while I > 0 do begin
  6236. LLeft := Copy(LData, LLastPos, I - LLastPos); //'abc d' len:=i(=4)-1 {Do not Localize}
  6237. if LLeft > '' then begin {Do not Localize}
  6238. {$IFNDEF USE_OBJECT_ARC}
  6239. if AIncludePositions then begin
  6240. AStrings.AddObject(Trim(LLeft), TObject(LLastPos + LLeadingSpaceCnt));
  6241. end else
  6242. {$ENDIF}
  6243. begin
  6244. AStrings.Add(Trim(LLeft));
  6245. end;
  6246. end;
  6247. LLastPos := I + LDelim; //first char after Delim
  6248. i := PosIdx(ADelim, LData, LLastPos);
  6249. end;//while found
  6250. if LLastPos <= Length(LData) then begin
  6251. {$IFNDEF USE_OBJECT_ARC}
  6252. if AIncludePositions then begin
  6253. AStrings.AddObject(Trim(Copy(LData, LLastPos, MaxInt)), TObject(LLastPos + LLeadingSpaceCnt));
  6254. end else
  6255. {$ENDIF}
  6256. begin
  6257. AStrings.Add(Trim(Copy(LData, LLastPos, MaxInt)));
  6258. end;
  6259. end;
  6260. end else
  6261. begin
  6262. i := Pos(ADelim, AData);
  6263. while I > 0 do begin
  6264. LLeft := Copy(AData, LLastPos, I - LLastPos); //'abc d' len:=i(=4)-1 {Do not Localize}
  6265. if LLeft <> '' then begin {Do not Localize}
  6266. {$IFNDEF USE_OBJECT_ARC}
  6267. if AIncludePositions then begin
  6268. AStrings.AddObject(LLeft, TObject(LLastPos));
  6269. end else
  6270. {$ENDIF}
  6271. begin
  6272. AStrings.Add(LLeft);
  6273. end;
  6274. end;
  6275. LLastPos := I + LDelim; //first char after Delim
  6276. i := PosIdx(ADelim, AData, LLastPos);
  6277. end;
  6278. if LLastPos <= Length(AData) then begin
  6279. {$IFNDEF USE_OBJECT_ARC}
  6280. if AIncludePositions then begin
  6281. AStrings.AddObject(Copy(AData, LLastPos, MaxInt), TObject(LLastPos));
  6282. end else
  6283. {$ENDIF}
  6284. begin
  6285. AStrings.Add(Copy(AData, LLastPos, MaxInt));
  6286. end;
  6287. end;
  6288. end;
  6289. finally
  6290. AStrings.EndUpdate;
  6291. end;
  6292. end;
  6293. {$IFDEF USE_OBJECT_ARC}
  6294. constructor TIdStringPosition.Create(const AValue: String; const APosition: Integer);
  6295. begin
  6296. Value := AValue;
  6297. Position := APosition;
  6298. end;
  6299. procedure SplitDelimitedString(const AData: string; AStrings: TIdStringPositionList;
  6300. ATrim: Boolean; const ADelim: string = ' ');
  6301. var
  6302. i: Integer;
  6303. LData: string;
  6304. LDelim: Integer; //delim len
  6305. LLeft: string;
  6306. LLastPos, LLeadingSpaceCnt: Integer;
  6307. begin
  6308. Assert(Assigned(AStrings));
  6309. AStrings.Clear;
  6310. LDelim := Length(ADelim);
  6311. LLastPos := 1;
  6312. if ATrim then begin
  6313. LData := Trim(AData);
  6314. if LData = '' then begin //if WhiteStr
  6315. Exit;
  6316. end;
  6317. LLeadingSpaceCnt := 0;
  6318. while AData[LLeadingSpaceCnt + 1] <= #32 do begin
  6319. Inc(LLeadingSpaceCnt);
  6320. end;
  6321. i := Pos(ADelim, LData);
  6322. while I > 0 do begin
  6323. LLeft := Copy(LData, LLastPos, I - LLastPos); //'abc d' len:=i(=4)-1 {Do not Localize}
  6324. if LLeft > '' then begin {Do not Localize}
  6325. AStrings.Add(TIdStringPosition.Create(Trim(LLeft), LLastPos + LLeadingSpaceCnt));
  6326. end;
  6327. LLastPos := I + LDelim; //first char after Delim
  6328. i := PosIdx(ADelim, LData, LLastPos);
  6329. end;//while found
  6330. if LLastPos <= Length(LData) then begin
  6331. AStrings.Add(TIdStringPosition.Create(Trim(Copy(LData, LLastPos, MaxInt)), LLastPos + LLeadingSpaceCnt));
  6332. end;
  6333. end else
  6334. begin
  6335. i := Pos(ADelim, AData);
  6336. while I > 0 do begin
  6337. LLeft := Copy(AData, LLastPos, I - LLastPos); //'abc d' len:=i(=4)-1 {Do not Localize}
  6338. if LLeft <> '' then begin {Do not Localize}
  6339. AStrings.Add(TIdStringPosition.Create(LLeft, LLastPos));
  6340. end;
  6341. LLastPos := I + LDelim; //first char after Delim
  6342. i := PosIdx(ADelim, AData, LLastPos);
  6343. end;
  6344. if LLastPos <= Length(AData) then begin
  6345. AStrings.Add(TIdStringPosition.Create(Copy(AData, LLastPos, MaxInt), LLastPos));
  6346. end;
  6347. end;
  6348. end;
  6349. {$ENDIF}
  6350. {$IFDEF DOTNET}
  6351. procedure SetThreadName(const AName: string; AThread: System.Threading.Thread = nil);
  6352. begin
  6353. if AThread = nil then begin
  6354. AThread := System.Threading.Thread.CurrentThread;
  6355. end;
  6356. // cannot rename a previously-named thread
  6357. if AThread.Name = nil then begin
  6358. AThread.Name := AName;
  6359. end;
  6360. end;
  6361. {$ELSE}
  6362. procedure SetThreadName(const AName: string; AThreadID: UInt32 = $FFFFFFFF);
  6363. {$IFDEF HAS_NAMED_THREADS}
  6364. {$IFDEF HAS_TThread_NameThreadForDebugging}
  6365. {$IFDEF USE_INLINE}inline;{$ENDIF}
  6366. {$ELSE}
  6367. {$IFDEF WINDOWS}
  6368. const
  6369. MS_VC_EXCEPTION = $406D1388;
  6370. type
  6371. TThreadNameInfo = record
  6372. RecType: UInt32; // Must be 0x1000
  6373. Name: PAnsiChar; // Pointer to name (in user address space)
  6374. ThreadID: UInt32; // Thread ID (-1 indicates caller thread)
  6375. Flags: UInt32; // Reserved for future use. Must be zero
  6376. end;
  6377. var
  6378. {$IFDEF STRING_IS_UNICODE}
  6379. LName: AnsiString;
  6380. {$ENDIF}
  6381. LThreadNameInfo: TThreadNameInfo;
  6382. {$ENDIF}
  6383. {$ENDIF}
  6384. {$ENDIF}
  6385. begin
  6386. {$IFDEF HAS_NAMED_THREADS}
  6387. {$IFDEF HAS_TThread_NameThreadForDebugging}
  6388. TThread.NameThreadForDebugging(
  6389. {$IFDEF HAS_AnsiString}
  6390. AnsiString(AName) // explicit convert to Ansi
  6391. {$ELSE}
  6392. AName
  6393. {$ENDIF},
  6394. AThreadID
  6395. );
  6396. {$ELSE}
  6397. {$IFDEF WINDOWS}
  6398. {$IFDEF STRING_IS_UNICODE}
  6399. LName := AnsiString(AName); // explicit convert to Ansi
  6400. {$ENDIF}
  6401. LThreadNameInfo.RecType := $1000;
  6402. LThreadNameInfo.Name := PAnsiChar({$IFDEF STRING_IS_UNICODE}LName{$ELSE}AName{$ENDIF});
  6403. LThreadNameInfo.ThreadID := AThreadID;
  6404. LThreadNameInfo.Flags := 0;
  6405. try
  6406. // This is a wierdo Windows way to pass the info in
  6407. RaiseException(MS_VC_EXCEPTION, 0, SizeOf(LThreadNameInfo) div SizeOf(UInt32),
  6408. PDWord(@LThreadNameInfo));
  6409. except
  6410. end;
  6411. {$ENDIF}
  6412. {$ENDIF}
  6413. {$ELSE}
  6414. // Do nothing. No support in this compiler for it.
  6415. {$ENDIF}
  6416. end;
  6417. {$ENDIF}
  6418. {$IFDEF DOTNET}
  6419. {$IFNDEF DOTNET_2_OR_ABOVE}
  6420. { TEvent }
  6421. constructor TEvent.Create(EventAttributes: IntPtr; ManualReset, InitialState: Boolean; const Name: string);
  6422. begin
  6423. inherited Create;
  6424. // Name not used
  6425. if ManualReset then begin
  6426. FEvent := ManualResetEvent.Create(InitialState);
  6427. end else begin
  6428. FEvent := AutoResetEvent.Create(InitialState);
  6429. end;
  6430. end;
  6431. constructor TEvent.Create;
  6432. begin
  6433. Create(nil, True, False, ''); {Do not Localize}
  6434. end;
  6435. destructor TEvent.Destroy;
  6436. begin
  6437. if Assigned(FEvent) then begin
  6438. FEvent.Close;
  6439. end;
  6440. FreeAndNil(FEvent);
  6441. inherited Destroy;
  6442. end;
  6443. procedure TEvent.SetEvent;
  6444. begin
  6445. if FEvent is ManualResetEvent then begin
  6446. ManualResetEvent(FEvent).&Set;
  6447. end else begin
  6448. AutoResetEvent(FEvent).&Set;
  6449. end;
  6450. end;
  6451. procedure TEvent.ResetEvent;
  6452. begin
  6453. if FEvent is ManualResetEvent then begin
  6454. ManualResetEvent(FEvent).Reset;
  6455. end else begin
  6456. AutoResetEvent(FEvent).Reset;
  6457. end;
  6458. end;
  6459. function TEvent.WaitFor(Timeout: UInt32): TWaitResult;
  6460. var
  6461. Passed: Boolean;
  6462. begin
  6463. try
  6464. if Timeout = INFINITE then begin
  6465. Passed := FEvent.WaitOne;
  6466. end else begin
  6467. Passed := FEvent.WaitOne(Timeout, True);
  6468. end;
  6469. if Passed then begin
  6470. Result := wrSignaled;
  6471. end else begin
  6472. Result := wrTimeout;
  6473. end;
  6474. except
  6475. Result := wrError;
  6476. end;
  6477. end;
  6478. { TCriticalSection }
  6479. procedure TCriticalSection.Acquire;
  6480. begin
  6481. Enter;
  6482. end;
  6483. procedure TCriticalSection.Release;
  6484. begin
  6485. Leave;
  6486. end;
  6487. function TCriticalSection.TryEnter: Boolean;
  6488. begin
  6489. Result := System.Threading.Monitor.TryEnter(Self);
  6490. end;
  6491. procedure TCriticalSection.Enter;
  6492. begin
  6493. System.Threading.Monitor.Enter(Self);
  6494. end;
  6495. procedure TCriticalSection.Leave;
  6496. begin
  6497. System.Threading.Monitor.Exit(Self);
  6498. end;
  6499. {$ENDIF}
  6500. {$ENDIF}
  6501. { TIdLocalEvent }
  6502. constructor TIdLocalEvent.Create(const AInitialState: Boolean = False; const AManualReset: Boolean = False);
  6503. begin
  6504. inherited Create(nil, AManualReset, AInitialState, ''); {Do not Localize}
  6505. end;
  6506. function TIdLocalEvent.WaitForEver: TWaitResult;
  6507. begin
  6508. Result := WaitFor(Infinite);
  6509. end;
  6510. procedure ToDo(const AMsg: string);
  6511. {$IFDEF USE_INLINE}inline;{$ENDIF}
  6512. begin
  6513. raise EIdException.Create(AMsg);
  6514. end;
  6515. // RLebeau: the following three functions are utility functions
  6516. // that determine the usable amount of data in various buffer types.
  6517. // There are many operations in Indy that allow the user to specify
  6518. // data sizes, or to have Indy calculate it. So these functions
  6519. // help reduce code duplication.
  6520. function IndyLength(const ABuffer: String; const ALength: Integer = -1; const AIndex: Integer = 1): Integer;
  6521. {$IFDEF USE_INLINE}inline;{$ENDIF}
  6522. var
  6523. LAvailable: Integer;
  6524. begin
  6525. Assert(AIndex >= 1);
  6526. LAvailable := IndyMax(Length(ABuffer)-AIndex+1, 0);
  6527. if ALength < 0 then begin
  6528. Result := LAvailable;
  6529. end else begin
  6530. Result := IndyMin(LAvailable, ALength);
  6531. end;
  6532. end;
  6533. function IndyLength(const ABuffer: TIdBytes; const ALength: Integer = -1; const AIndex: Integer = 0): Integer;
  6534. {$IFDEF USE_INLINE}inline;{$ENDIF}
  6535. var
  6536. LAvailable: Integer;
  6537. begin
  6538. Assert(AIndex >= 0);
  6539. LAvailable := IndyMax(Length(ABuffer)-AIndex, 0);
  6540. if ALength < 0 then begin
  6541. Result := LAvailable;
  6542. end else begin
  6543. Result := IndyMin(LAvailable, ALength);
  6544. end;
  6545. end;
  6546. function IndyLength(const ABuffer: TStream; const ALength: TIdStreamSize = -1): TIdStreamSize; overload;
  6547. {$IFDEF USE_INLINE}inline;{$ENDIF}
  6548. var
  6549. LAvailable: TIdStreamSize;
  6550. begin
  6551. LAvailable := IndyMax(ABuffer.Size - ABuffer.Position, 0);
  6552. if ALength < 0 then begin
  6553. Result := LAvailable;
  6554. end else begin
  6555. Result := IndyMin(LAvailable, ALength);
  6556. end;
  6557. end;
  6558. const
  6559. wdays: array[1..7] of string = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'); {do not localize}
  6560. monthnames: array[1..12] of string = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', {do not localize}
  6561. 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); {do not localize}
  6562. {$IFDEF HAS_TFormatSettings}
  6563. //Delphi5 does not have TFormatSettings
  6564. //this should be changed to a singleton?
  6565. function GetEnglishSetting: TFormatSettings;
  6566. {$IFDEF USE_INLINE}inline;{$ENDIF}
  6567. begin
  6568. Result.CurrencyFormat := $00; // 0 = '$1'
  6569. Result.NegCurrFormat := $00; //0 = '($1)'
  6570. Result.CurrencyString := '$'; {do not localize}
  6571. Result.CurrencyDecimals := 2;
  6572. Result.ThousandSeparator := ','; {do not localize}
  6573. Result.DecimalSeparator := '.'; {do not localize}
  6574. Result.DateSeparator := '/'; {do not localize}
  6575. Result.ShortDateFormat := 'M/d/yyyy'; {do not localize}
  6576. Result.LongDateFormat := 'dddd, MMMM dd, yyyy'; {do not localize}
  6577. Result.TimeSeparator := ':'; {do not localize}
  6578. Result.TimeAMString := 'AM'; {do not localize}
  6579. Result.TimePMString := 'PM'; {do not localize}
  6580. Result.LongTimeFormat := 'h:mm:ss AMPM'; {do not localize}
  6581. Result.ShortTimeFormat := 'h:mm AMPM'; {do not localize}
  6582. // TODO: use hard-coded names instead?
  6583. Result.ShortMonthNames[1] := monthnames[1]; //'Jan';
  6584. Result.ShortMonthNames[2] := monthnames[2]; //'Feb';
  6585. Result.ShortMonthNames[3] := monthnames[3]; //'Mar';
  6586. Result.ShortMonthNames[4] := monthnames[4]; //'Apr';
  6587. Result.ShortMonthNames[5] := monthnames[5]; //'May';
  6588. Result.ShortMonthNames[6] := monthnames[6]; //'Jun';
  6589. Result.ShortMonthNames[7] := monthnames[7]; //'Jul';
  6590. Result.ShortMonthNames[8] := monthnames[8]; //'Aug';
  6591. Result.ShortMonthNames[9] := monthnames[9]; //'Sep';
  6592. Result.ShortMonthNames[10] := monthnames[10];// 'Oct';
  6593. Result.ShortMonthNames[11] := monthnames[11]; //'Nov';
  6594. Result.ShortMonthNames[12] := monthnames[12]; //'Dec';
  6595. Result.LongMonthNames[1] := 'January'; {do not localize}
  6596. Result.LongMonthNames[2] := 'February'; {do not localize}
  6597. Result.LongMonthNames[3] := 'March'; {do not localize}
  6598. Result.LongMonthNames[4] := 'April'; {do not localize}
  6599. Result.LongMonthNames[5] := 'May'; {do not localize}
  6600. Result.LongMonthNames[6] := 'June'; {do not localize}
  6601. Result.LongMonthNames[7] := 'July'; {do not localize}
  6602. Result.LongMonthNames[8] := 'August'; {do not localize}
  6603. Result.LongMonthNames[9] := 'September'; {do not localize}
  6604. Result.LongMonthNames[10] := 'October'; {do not localize}
  6605. Result.LongMonthNames[11] := 'November'; {do not localize}
  6606. Result.LongMonthNames[12] := 'December'; {do not localize}
  6607. // TODO: use hard-coded names instead?
  6608. Result.ShortDayNames[1] := wdays[1]; //'Sun';
  6609. Result.ShortDayNames[2] := wdays[2]; //'Mon';
  6610. Result.ShortDayNames[3] := wdays[3]; //'Tue';
  6611. Result.ShortDayNames[4] := wdays[4]; //'Wed';
  6612. Result.ShortDayNames[5] := wdays[5]; //'Thu';
  6613. Result.ShortDayNames[6] := wdays[6]; //'Fri';
  6614. Result.ShortDayNames[7] := wdays[7]; //'Sat';
  6615. Result.LongDayNames[1] := 'Sunday'; {do not localize}
  6616. Result.LongDayNames[2] := 'Monday'; {do not localize}
  6617. Result.LongDayNames[3] := 'Tuesday'; {do not localize}
  6618. Result.LongDayNames[4] := 'Wednesday'; {do not localize}
  6619. Result.LongDayNames[5] := 'Thursday'; {do not localize}
  6620. Result.LongDayNames[6] := 'Friday'; {do not localize}
  6621. Result.LongDayNames[7] := 'Saturday'; {do not localize}
  6622. Result.ListSeparator := ','; {do not localize}
  6623. end;
  6624. {$ENDIF}
  6625. // RLebeau 10/24/2008: In the RTM release of Delphi/C++Builder 2009, the
  6626. // overloaded version of SysUtils.Format() that has a TFormatSettings parameter
  6627. // has an internal bug that causes an EConvertError exception when UnicodeString
  6628. // parameters greater than 4094 characters are passed to it. Refer to QC #67934
  6629. // for details. The bug is fixed in 2009 Update 1. For RTM, call FormatBuf()
  6630. // directly to work around the problem...
  6631. function IndyFormat(const AFormat: string; const Args: array of const): string;
  6632. {$IFNDEF DOTNET}
  6633. {$IFDEF HAS_TFormatSettings}
  6634. var
  6635. EnglishFmt: TFormatSettings;
  6636. {$IFDEF BROKEN_FmtStr}
  6637. Len, BufLen: Integer;
  6638. Buffer: array[0..4095] of Char;
  6639. {$ENDIF}
  6640. {$ENDIF}
  6641. {$ENDIF}
  6642. begin
  6643. {$IFDEF DOTNET}
  6644. // RLebeau 10/29/09: temporary workaround until we figure out how to use
  6645. // SysUtils.FormatBuf() correctly under .NET in D2009 RTM...
  6646. Result := SysUtils.Format(AFormat, Args);
  6647. {$ELSE}
  6648. {$IFDEF HAS_TFormatSettings}
  6649. EnglishFmt := GetEnglishSetting;
  6650. {$IFDEF BROKEN_FmtStr}
  6651. BufLen := Length(Buffer);
  6652. if Length(AFormat) < (Length(Buffer) - (Length(Buffer) div 4)) then
  6653. begin
  6654. Len := SysUtils.FormatBuf(Buffer, Length(Buffer) - 1, Pointer(AFormat)^,
  6655. Length(AFormat), Args, EnglishFmt);
  6656. end else
  6657. begin
  6658. BufLen := Length(AFormat);
  6659. Len := BufLen;
  6660. end;
  6661. if Len >= BufLen - 1 then
  6662. begin
  6663. while Len >= BufLen - 1 do
  6664. begin
  6665. Inc(BufLen, BufLen);
  6666. Result := ''; // prevent copying of existing data, for speed
  6667. SetLength(Result, BufLen);
  6668. Len := SysUtils.FormatBuf(PChar(Result), BufLen - 1, Pointer(AFormat)^,
  6669. Length(AFormat), Args, EnglishFmt);
  6670. end;
  6671. SetLength(Result, Len);
  6672. end else
  6673. begin
  6674. SetString(Result, Buffer, Len);
  6675. end;
  6676. {$ELSE}
  6677. Result := SysUtils.Format(AFormat, Args, EnglishFmt);
  6678. {$ENDIF}
  6679. {$ELSE}
  6680. //Is there a way to get delphi5 to use locale in format? something like:
  6681. // SetThreadLocale(TheNewLocaleId);
  6682. // GetFormatSettings;
  6683. // Application.UpdateFormatSettings := False; //needed?
  6684. // format()
  6685. // set locale back to prior
  6686. Result := SysUtils.Format(AFormat, Args);
  6687. {$ENDIF}
  6688. {$ENDIF}
  6689. end;
  6690. function DateTimeGMTToHttpStr(const GMTValue: TDateTime) : String;
  6691. // should adhere to RFC 2616
  6692. var
  6693. wDay, wMonth, wYear: Word;
  6694. begin
  6695. DecodeDate(GMTValue, wYear, wMonth, wDay);
  6696. Result := IndyFormat('%s, %.2d %s %.4d %s %s', {do not localize}
  6697. [wdays[DayOfWeek(GMTValue)], wDay, monthnames[wMonth],
  6698. wYear, FormatDateTime('HH":"nn":"ss',GMTValue), 'GMT']); {do not localize}
  6699. end;
  6700. function DateTimeGMTToCookieStr(const GMTValue: TDateTime; const AUseNetscapeFmt: Boolean = True) : String;
  6701. var
  6702. wDay, wMonth, wYear: Word;
  6703. LDelim: Char;
  6704. begin
  6705. DecodeDate(GMTValue, wYear, wMonth, wDay);
  6706. // RLebeau: cookie draft-23 requires HTTP servers to format an Expires value as follows:
  6707. //
  6708. // Wdy, DD Mon YYYY HH:MM:SS GMT
  6709. //
  6710. // However, Netscape style formatting, which RFCs 2109 and 2965 allow
  6711. // (but draft-23 obsoletes), are more common:
  6712. //
  6713. // Wdy, DD-Mon-YY HH:MM:SS GMT (original)
  6714. // Wdy, DD-Mon-YYYY HH:MM:SS GMT (RFC 1123)
  6715. //
  6716. if AUseNetscapeFmt then begin
  6717. LDelim := '-'; {do not localize}
  6718. end else begin
  6719. LDelim := ' '; {do not localize}
  6720. end;
  6721. Result := IndyFormat('%s, %.2d%s%s%s%.4d %s %s', {do not localize}
  6722. [wdays[DayOfWeek(GMTValue)], wDay, LDelim, monthnames[wMonth], LDelim, wYear,
  6723. FormatDateTime('HH":"nn":"ss',GMTValue), 'GMT']); {do not localize}
  6724. end;
  6725. function DateTimeGMTToImapStr(const GMTValue: TDateTime) : String;
  6726. var
  6727. wDay, wMonth, wYear: Word;
  6728. LDay: String;
  6729. begin
  6730. DecodeDate(GMTValue, wYear, wMonth, wDay);
  6731. LDay := IntToStr(wDay);
  6732. if Length(LDay) < 2 then begin
  6733. LDay := ' ' + LDay; // NOTE: space NOT zero!
  6734. end;
  6735. Result := IndyFormat('%s-%s-%d %s %s', {do not localize}
  6736. [LDay, monthnames[wMonth], wYear, FormatDateTime('HH":"nn":"ss',GMTValue), {do not localize}
  6737. '+0000']); {do not localize}
  6738. end;
  6739. function LocalDateTimeToHttpStr(const Value: TDateTime) : String;
  6740. {$IFDEF USE_INLINE}inline;{$ENDIF}
  6741. begin
  6742. Result := DateTimeGMTToHttpStr(
  6743. {$IFDEF HAS_LocalTimeToUniversal}
  6744. LocalTimeToUniversal(Value)
  6745. {$ELSE}
  6746. Value - OffsetFromUTC
  6747. {$ENDIF}
  6748. );
  6749. end;
  6750. function LocalDateTimeToCookieStr(const Value: TDateTime; const AUseNetscapeFmt: Boolean = True) : String;
  6751. {$IFDEF USE_INLINE}inline;{$ENDIF}
  6752. begin
  6753. Result := DateTimeGMTToCookieStr(
  6754. {$IFDEF HAS_LocalTimeToUniversal}
  6755. LocalTimeToUniversal(Value)
  6756. {$ELSE}
  6757. Value - OffsetFromUTC
  6758. {$ENDIF}
  6759. , AUseNetscapeFmt);
  6760. end;
  6761. function LocalDateTimeToImapStr(const Value: TDateTime) : String;
  6762. {$IFDEF USE_INLINE}inline;{$ENDIF}
  6763. begin
  6764. Result := DateTimeGMTToImapStr(
  6765. {$IFDEF HAS_LocalTimeToUniversal}
  6766. LocalTimeToUniversal(Value)
  6767. {$ELSE}
  6768. Value - OffsetFromUTC
  6769. {$ENDIF}
  6770. );
  6771. end;
  6772. {$I IdDeprecatedImplBugOff.inc}
  6773. function DateTimeToInternetStr(const Value: TDateTime; const AUseGMTStr : Boolean = False) : String;
  6774. {$I IdDeprecatedImplBugOn.inc}
  6775. begin
  6776. Result := LocalDateTimeToGMT(Value, AUseGMTStr);
  6777. end;
  6778. {This should never be localized}
  6779. function LocalDateTimeToGMT(const Value: TDateTime; const AUseGMTStr: Boolean = False) : String;
  6780. var
  6781. wDay, wMonth, wYear: Word;
  6782. begin
  6783. DecodeDate(Value, wYear, wMonth, wDay);
  6784. Result := IndyFormat('%s, %d %s %d %s %s', {do not localize}
  6785. [wdays[DayOfWeek(Value)], wDay, monthnames[wMonth],
  6786. wYear, FormatDateTime('HH":"nn":"ss', Value), {do not localize}
  6787. UTCOffsetToStr(OffsetFromUTC, AUseGMTStr)]);
  6788. end;
  6789. {$I IdDeprecatedImplBugOff.inc}
  6790. function DateTimeToGmtOffSetStr(ADateTime: TDateTime; const AUseGMTStr: Boolean = False): string;
  6791. {$I IdDeprecatedImplBugOn.inc}
  6792. {$IFDEF USE_INLINE}inline;{$ENDIF}
  6793. begin
  6794. Result := UTCOffsetToStr(ADateTime, AUseGMTStr);
  6795. end;
  6796. function OffsetFromUTC: TDateTime;
  6797. {$IFDEF DOTNET}
  6798. {$IFDEF USE_INLINE}inline;{$ENDIF}
  6799. {$ELSE}
  6800. {$IFDEF WINDOWS}
  6801. var
  6802. iBias: Integer;
  6803. tmez: TTimeZoneInformation;
  6804. {$ELSE}
  6805. {$IFNDEF HAS_GetLocalTimeOffset}
  6806. {$IFDEF UNIX}
  6807. {$IFDEF USE_VCL_POSIX}
  6808. var
  6809. T : Time_t;
  6810. TV : TimeVal;
  6811. UT : tm;
  6812. {$ELSE}
  6813. {$IFDEF KYLIXCOMPAT}
  6814. var
  6815. T : Time_T;
  6816. TV : TTimeVal;
  6817. UT : TUnixTime;
  6818. {$ELSE}
  6819. {$IFDEF USE_BASEUNIX}
  6820. var
  6821. timeval: TTimeVal;
  6822. timezone: TTimeZone;
  6823. {$ENDIF}
  6824. {$ENDIF}
  6825. {$ENDIF}
  6826. {$ENDIF}
  6827. {$ENDIF}
  6828. {$ENDIF}
  6829. {$ENDIF}
  6830. begin
  6831. {$IFDEF DOTNET}
  6832. Result := System.Timezone.CurrentTimezone.GetUTCOffset(DateTime.FromOADate(Now)).TotalDays;
  6833. {$ELSE}
  6834. {$IFDEF WINDOWS}
  6835. case GetTimeZoneInformation({$IFDEF WINCE}@{$ENDIF}tmez) of
  6836. TIME_ZONE_ID_INVALID :
  6837. raise EIdFailedToRetreiveTimeZoneInfo.Create(RSFailedTimeZoneInfo);
  6838. TIME_ZONE_ID_UNKNOWN :
  6839. iBias := tmez.Bias;
  6840. TIME_ZONE_ID_DAYLIGHT : begin
  6841. iBias := tmez.Bias;
  6842. if tmez.DaylightDate.wMonth <> 0 then begin
  6843. iBias := iBias + tmez.DaylightBias;
  6844. end;
  6845. end;
  6846. TIME_ZONE_ID_STANDARD : begin
  6847. iBias := tmez.Bias;
  6848. if tmez.StandardDate.wMonth <> 0 then begin
  6849. iBias := iBias + tmez.StandardBias;
  6850. end;
  6851. end
  6852. else
  6853. begin
  6854. raise EIdFailedToRetreiveTimeZoneInfo.Create(RSFailedTimeZoneInfo);
  6855. end;
  6856. end;
  6857. {We use ABS because EncodeTime will only accept positive values}
  6858. Result := EncodeTime(Abs(iBias) div 60, Abs(iBias) mod 60, 0, 0);
  6859. {The GetTimeZone function returns values oriented towards converting
  6860. a GMT time into a local time. We wish to do the opposite by returning
  6861. the difference between the local time and GMT. So I just make a positive
  6862. value negative and leave a negative value as positive}
  6863. if iBias > 0 then begin
  6864. Result := 0.0 - Result;
  6865. end;
  6866. {$ELSE}
  6867. {$IFDEF HAS_GetLocalTimeOffset}
  6868. // RLebeau: Note that on Linux/Unix, this information may be inaccurate around
  6869. // the DST time changes (for optimization). In that case, the unix.ReReadLocalTime()
  6870. // function must be used to re-initialize the timezone information...
  6871. Result := -1 * (GetLocalTimeOffset() / 60 / 24);
  6872. {$ELSE}
  6873. {$IFDEF UNIX}
  6874. // TODO: raise EIdFailedToRetreiveTimeZoneInfo if gettimeofday() fails...
  6875. {$IFDEF KYLIXCOMPAT_OR_VCL_POSIX}
  6876. {from http://edn.embarcadero.com/article/27890 but without multiplying the Result by -1}
  6877. gettimeofday(TV, nil);
  6878. T := TV.tv_sec;
  6879. localtime_r({$IFDEF KYLIXCOMPAT}@{$ENDIF}T, UT);
  6880. Result := UT.{$IFDEF KYLIXCOMPAT}__tm_gmtoff{$ELSE}tm_gmtoff{$ENDIF} / 60 / 60 / 24;
  6881. {$ELSE}
  6882. {$IFDEF USE_BASEUNIX}
  6883. fpGetTimeOfDay (@TimeVal, @TimeZone);
  6884. Result := -1 * (timezone.tz_minuteswest / 60 / 24);
  6885. {$ELSE}
  6886. {$message error gettimeofday is not called on this platform!}
  6887. Result := GOffsetFromUTC;
  6888. {$ENDIF}
  6889. {$ENDIF}
  6890. {$ELSE}
  6891. {$message error no platform API called to get UTC offset!}
  6892. Result := GOffsetFromUTC;
  6893. {$ENDIF}
  6894. {$ENDIF}
  6895. {$ENDIF}
  6896. {$ENDIF}
  6897. end;
  6898. function UTCOffsetToStr(const AOffset: TDateTime; const AUseGMTStr: Boolean = False): string;
  6899. var
  6900. AHour, AMin, ASec, AMSec: Word;
  6901. s: string;
  6902. {$IFDEF STRING_IS_IMMUTABLE}
  6903. LSB: TIdStringBuilder;
  6904. {$ENDIF}
  6905. begin
  6906. if (AOffset = 0.0) and AUseGMTStr then
  6907. begin
  6908. Result := 'GMT'; {do not localize}
  6909. end else
  6910. begin
  6911. DecodeTime(AOffset, AHour, AMin, ASec, AMSec);
  6912. s := IndyFormat(' %0.2d%0.2d', [AHour, AMin]); {do not localize}
  6913. {$IFDEF STRING_IS_IMMUTABLE}
  6914. LSB := TIdStringBuilder.Create(5);
  6915. LSB.Append(s);
  6916. if AOffset < 0.0 then begin
  6917. LSB[0] := '-'; {do not localize}
  6918. end else begin
  6919. LSB[0] := '+'; {do not localize}
  6920. end;
  6921. Result := LSB.ToString;
  6922. {$ELSE}
  6923. Result := s;
  6924. if AOffset < 0.0 then begin
  6925. Result[1] := '-'; {do not localize}
  6926. end else begin
  6927. Result[1] := '+'; {do not localize}
  6928. end;
  6929. {$ENDIF}
  6930. end;
  6931. end;
  6932. function IndyIncludeTrailingPathDelimiter(const S: string): string;
  6933. {$IFDEF USE_INLINE}inline;{$ENDIF}
  6934. begin
  6935. {$IFDEF HAS_SysUtils_IncludeExcludeTrailingPathDelimiter}
  6936. Result := SysUtils.IncludeTrailingPathDelimiter(S);
  6937. {$ELSE}
  6938. Result := SysUtils.IncludeTrailingBackslash(S);
  6939. {$ENDIF}
  6940. end;
  6941. function IndyExcludeTrailingPathDelimiter(const S: string): string;
  6942. {$IFDEF USE_INLINE}inline;{$ENDIF}
  6943. begin
  6944. {$IFDEF HAS_SysUtils_IncludeExcludeTrailingPathDelimiter}
  6945. Result := SysUtils.ExcludeTrailingPathDelimiter(S);
  6946. {$ELSE}
  6947. Result := SysUtils.ExcludeTrailingBackslash(S);
  6948. {$ENDIF}
  6949. end;
  6950. function StringsReplace(const S: String; const OldPattern, NewPattern: array of string): string;
  6951. var
  6952. i : Integer;
  6953. begin
  6954. // TODO: re-write this to not use ReplaceAll() in a loop anymore. If
  6955. // OldPattern contains multiple strings, a string appearing later in the
  6956. // list may be replaced multiple times by accident if it appears in the
  6957. // Result of an earlier string replacement.
  6958. Result := s;
  6959. for i := Low(OldPattern) to High(OldPattern) do begin
  6960. Result := ReplaceAll(Result, OldPattern[i], NewPattern[i]);
  6961. end;
  6962. end;
  6963. {$IFNDEF DOTNET}
  6964. {$IFNDEF HAS_PosEx}
  6965. function PosEx(const SubStr, S: string; Offset: Integer): Integer;
  6966. var
  6967. I, LIterCnt, L, J: Integer;
  6968. PSubStr, PS: PChar;
  6969. begin
  6970. Result := 0;
  6971. if SubStr = '' then begin
  6972. Exit;
  6973. end;
  6974. { Calculate the number of possible iterations. Not valid if Offset < 1. }
  6975. LIterCnt := Length(S) - Offset - Length(SubStr) + 1;
  6976. { Only continue if the number of iterations is positive or zero (there is space to check) }
  6977. if (Offset > 0) and (LIterCnt >= 0) then
  6978. begin
  6979. L := Length(SubStr);
  6980. PSubStr := PChar(SubStr);
  6981. PS := PChar(S);
  6982. Inc(PS, Offset - 1);
  6983. for I := 0 to LIterCnt do
  6984. begin
  6985. J := 0;
  6986. while (J >= 0) and (J < L) do
  6987. begin
  6988. if PS[I + J] = PSubStr[J] then begin
  6989. Inc(J);
  6990. end else begin
  6991. J := -1;
  6992. end;
  6993. end;
  6994. if J >= L then begin
  6995. Result := I + Offset;
  6996. Exit;
  6997. end;
  6998. end;
  6999. end;
  7000. end;
  7001. {$ENDIF}
  7002. {$ENDIF}
  7003. function ReplaceAll(const S: String; const OldPattern, NewPattern: String): String;
  7004. var
  7005. I, PatLen: Integer;
  7006. {$IFDEF DOTNET}
  7007. J: Integer;
  7008. {$ELSE}
  7009. NumBytes: Integer;
  7010. {$ENDIF}
  7011. begin
  7012. PatLen := Length(OldPattern);
  7013. if Length(NewPattern) = PatLen then begin
  7014. Result := S;
  7015. I := Pos(OldPattern, Result);
  7016. if I > 0 then begin
  7017. UniqueString(Result);
  7018. {$IFNDEF DOTNET}
  7019. NumBytes := PatLen * SizeOf(Char);
  7020. {$ENDIF}
  7021. repeat
  7022. {$IFDEF DOTNET}
  7023. for J := 1 to PatLen do begin
  7024. Result[I+J-1] := NewPattern[J];
  7025. end;
  7026. {$ELSE}
  7027. Move(PChar(NewPattern)^, Result[I], NumBytes);
  7028. {$ENDIF}
  7029. I := PosEx(OldPattern, Result, I + PatLen);
  7030. until I = 0;
  7031. end;
  7032. end else begin
  7033. Result := SysUtils.StringReplace(S, OldPattern, NewPattern, [rfReplaceAll]);
  7034. end;
  7035. end;
  7036. function ReplaceOnlyFirst(const S, OldPattern, NewPattern: string): string;
  7037. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7038. begin
  7039. Result := SysUtils.StringReplace(s, OldPattern, NewPattern, []);
  7040. end;
  7041. function IndyStrToInt(const S: string): Integer;
  7042. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7043. begin
  7044. Result := StrToInt(Trim(S));
  7045. end;
  7046. function IndyStrToInt(const S: string; ADefault: Integer): Integer;
  7047. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7048. begin
  7049. Result := StrToIntDef(Trim(S), ADefault);
  7050. end;
  7051. function CompareDate(const D1, D2: TDateTime): Integer;
  7052. var
  7053. LTM1, LTM2 : TTimeStamp;
  7054. begin
  7055. // TODO: use DateUtils.CompareDateTime() instead...
  7056. LTM1 := DateTimeToTimeStamp(D1);
  7057. LTM2 := DateTimeToTimeStamp(D2);
  7058. if LTM1.Date = LTM2.Date then begin
  7059. if LTM1.Time < LTM2.Time then begin
  7060. Result := -1;
  7061. end
  7062. else if LTM1.Time > LTM2.Time then begin
  7063. Result := 1;
  7064. end
  7065. else begin
  7066. Result := 0;
  7067. end;
  7068. end
  7069. else if LTM1.Date > LTM2.Date then begin
  7070. Result := 1;
  7071. end
  7072. else begin
  7073. Result := -1;
  7074. end;
  7075. end;
  7076. function AddMSecToTime(const ADateTime: TDateTime; const AMSec: Integer): TDateTime;
  7077. {$IFDEF HAS_UNIT_DateUtils}
  7078. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7079. {$ELSE}
  7080. var
  7081. LTM : TTimeStamp;
  7082. {$ENDIF}
  7083. begin
  7084. {$IFDEF HAS_UNIT_DateUtils}
  7085. Result := DateUtils.IncMilliSecond(ADateTime, AMSec);
  7086. {$ELSE}
  7087. LTM := DateTimeToTimeStamp(ADateTime);
  7088. LTM.Time := LTM.Time + AMSec;
  7089. Result := TimeStampToDateTime(LTM);
  7090. {$ENDIF}
  7091. end;
  7092. function IndyFileAge(const AFileName: string): TDateTime;
  7093. {$IFDEF HAS_2PARAM_FileAge}
  7094. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7095. {$ELSE}
  7096. var
  7097. LAge: Integer;
  7098. {$ENDIF}
  7099. begin
  7100. {$IFDEF HAS_2PARAM_FileAge}
  7101. //single-parameter fileage is deprecated in d2006 and above
  7102. if not FileAge(AFileName, Result) then begin
  7103. Result := 0;
  7104. end;
  7105. {$ELSE}
  7106. LAge := SysUtils.FileAge(AFileName);
  7107. if LAge <> -1 then begin
  7108. Result := FileDateToDateTime(LAge);
  7109. end else begin
  7110. Result := 0.0;
  7111. end;
  7112. {$ENDIF}
  7113. end;
  7114. function IndyDirectoryExists(const ADirectory: string): Boolean;
  7115. {$IFDEF HAS_SysUtils_DirectoryExists}
  7116. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7117. {$ELSE}
  7118. var
  7119. Code: Integer;
  7120. {$IFDEF STRING_UNICODE_MISMATCH}
  7121. LStr: TIdPlatformString;
  7122. {$ENDIF}
  7123. {$ENDIF}
  7124. begin
  7125. {$IFDEF HAS_SysUtils_DirectoryExists}
  7126. Result := SysUtils.DirectoryExists(ADirectory);
  7127. {$ELSE}
  7128. // RLebeau 2/16/2006: Removed dependency on the FileCtrl unit
  7129. {$IFDEF STRING_UNICODE_MISMATCH}
  7130. LStr := TIdPlatformString(ADirectory); // explicit convert to Ansi/Unicode
  7131. Code := GetFileAttributes(PIdPlatformChar(LStr));
  7132. {$ELSE}
  7133. Code := GetFileAttributes(PChar(ADirectory));
  7134. {$ENDIF}
  7135. Result := (Code <> -1) and ((Code and FILE_ATTRIBUTE_DIRECTORY) <> 0);
  7136. {$ENDIF}
  7137. end;
  7138. function IndyStrToInt64(const S: string; const ADefault: Int64): Int64;
  7139. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7140. begin
  7141. Result := SysUtils.StrToInt64Def(Trim(S), ADefault);
  7142. end;
  7143. function IndyStrToInt64(const S: string): Int64;
  7144. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7145. begin
  7146. Result := SysUtils.StrToInt64(Trim(S));
  7147. end;
  7148. function IndyStrToStreamSize(const S: string; const ADefault: TIdStreamSize): TIdStreamSize;
  7149. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7150. begin
  7151. {$IFDEF STREAM_SIZE_64}
  7152. Result := IndyStrToInt64(S, ADefault);
  7153. {$ELSE}
  7154. Result := IndyStrToInt(S, ADefault);
  7155. {$ENDIF}
  7156. end;
  7157. function IndyStrToStreamSize(const S: string): TIdStreamSize;
  7158. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7159. begin
  7160. {$IFDEF STREAM_SIZE_64}
  7161. Result := IndyStrToInt64(S);
  7162. {$ELSE}
  7163. Result := IndyStrToInt(S);
  7164. {$ENDIF}
  7165. end;
  7166. function ToBytes(const AValue: string; ADestEncoding: IIdTextEncoding = nil
  7167. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  7168. ): TIdBytes; overload;
  7169. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7170. begin
  7171. Result := ToBytes(AValue, -1, 1, ADestEncoding
  7172. {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
  7173. );
  7174. end;
  7175. function ToBytes(const AValue: string; const ALength: Integer; const AIndex: Integer = 1;
  7176. ADestEncoding: IIdTextEncoding = nil
  7177. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  7178. ): TIdBytes; overload;
  7179. var
  7180. LLength: Integer;
  7181. {$IFDEF STRING_IS_ANSI}
  7182. LBytes: TIdBytes;
  7183. {$ENDIF}
  7184. begin
  7185. {$IFDEF STRING_IS_ANSI}
  7186. LBytes := nil; // keep the compiler happy
  7187. {$ENDIF}
  7188. LLength := IndyLength(AValue, ALength, AIndex);
  7189. if LLength > 0 then
  7190. begin
  7191. EnsureEncoding(ADestEncoding);
  7192. {$IFDEF STRING_IS_UNICODE}
  7193. SetLength(Result, ADestEncoding.GetByteCount(AValue, AIndex, LLength));
  7194. if Length(Result) > 0 then begin
  7195. ADestEncoding.GetBytes(AValue, AIndex, LLength, Result, 0);
  7196. end;
  7197. {$ELSE}
  7198. EnsureEncoding(ASrcEncoding, encOSDefault);
  7199. LBytes := RawToBytes(AValue[AIndex], LLength);
  7200. CheckByteEncoding(LBytes, ASrcEncoding, ADestEncoding);
  7201. Result := LBytes;
  7202. {$ENDIF}
  7203. end else begin
  7204. SetLength(Result, 0);
  7205. end;
  7206. end;
  7207. function ToBytes(const AValue: Char; ADestEncoding: IIdTextEncoding = nil
  7208. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  7209. ): TIdBytes; overload;
  7210. var
  7211. {$IFDEF STRING_IS_UNICODE}
  7212. LChars: {$IFDEF DOTNET}array[0..0] of Char{$ELSE}TIdWideChars{$ENDIF};
  7213. {$ELSE}
  7214. LBytes: TIdBytes;
  7215. {$ENDIF}
  7216. begin
  7217. EnsureEncoding(ADestEncoding);
  7218. {$IFDEF STRING_IS_UNICODE}
  7219. {$IFNDEF DOTNET}
  7220. SetLength(LChars, 1);
  7221. {$ENDIF}
  7222. LChars[0] := AValue;
  7223. Result := ADestEncoding.GetBytes(LChars);
  7224. {$ELSE}
  7225. EnsureEncoding(ASrcEncoding, encOSDefault);
  7226. LBytes := RawToBytes(AValue, 1);
  7227. CheckByteEncoding(LBytes, ASrcEncoding, ADestEncoding);
  7228. Result := LBytes;
  7229. {$ENDIF}
  7230. end;
  7231. function ToBytes(const AValue: Int64): TIdBytes; overload;
  7232. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7233. begin
  7234. {$IFDEF DOTNET}
  7235. Result := System.BitConverter.GetBytes(AValue);
  7236. {$ELSE}
  7237. SetLength(Result, SizeOf(Int64));
  7238. PInt64(@Result[0])^ := AValue;
  7239. {$ENDIF}
  7240. end;
  7241. function ToBytes(const AValue: TIdUInt64): TIdBytes; overload;
  7242. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7243. begin
  7244. {$IFDEF DOTNET}
  7245. Result := System.BitConverter.GetBytes(AValue);
  7246. {$ELSE}
  7247. SetLength(Result, SizeOf(UInt64));
  7248. PUInt64(@Result[0])^ := AValue{$IFDEF TIdUInt64_HAS_QuadPart}.QuadPart{$ENDIF};
  7249. {$ENDIF}
  7250. end;
  7251. function ToBytes(const AValue: Int32): TIdBytes; overload;
  7252. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7253. begin
  7254. {$IFDEF DOTNET}
  7255. Result := System.BitConverter.GetBytes(AValue);
  7256. {$ELSE}
  7257. SetLength(Result, SizeOf(Int32));
  7258. PInt32(@Result[0])^ := AValue;
  7259. {$ENDIF}
  7260. end;
  7261. function ToBytes(const AValue: UInt32): TIdBytes; overload;
  7262. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7263. begin
  7264. {$IFDEF DOTNET}
  7265. Result := System.BitConverter.GetBytes(AValue);
  7266. {$ELSE}
  7267. SetLength(Result, SizeOf(UInt32));
  7268. PUInt32(@Result[0])^ := AValue;
  7269. {$ENDIF}
  7270. end;
  7271. function ToBytes(const AValue: Int16): TIdBytes; overload;
  7272. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7273. begin
  7274. {$IFDEF DOTNET}
  7275. Result := System.BitConverter.GetBytes(AValue);
  7276. {$ELSE}
  7277. SetLength(Result, SizeOf(Int16));
  7278. PInt16(@Result[0])^ := AValue;
  7279. {$ENDIF}
  7280. end;
  7281. function ToBytes(const AValue: UInt16): TIdBytes; overload;
  7282. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7283. begin
  7284. {$IFDEF DOTNET}
  7285. Result := System.BitConverter.GetBytes(AValue);
  7286. {$ELSE}
  7287. SetLength(Result, SizeOf(UInt16));
  7288. PUInt16(@Result[0])^ := AValue;
  7289. {$ENDIF}
  7290. end;
  7291. function ToBytes(const AValue: Int8): TIdBytes; overload;
  7292. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7293. begin
  7294. SetLength(Result, SizeOf(Int8));
  7295. Result[0] := Byte(AValue);
  7296. end;
  7297. function ToBytes(const AValue: UInt8): TIdBytes; overload;
  7298. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7299. begin
  7300. SetLength(Result, SizeOf(UInt8));
  7301. Result[0] := AValue;
  7302. end;
  7303. function ToBytes(const AValue: TIdBytes; const ASize: Integer; const AIndex: Integer = 0): TIdBytes; overload;
  7304. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7305. var
  7306. LSize: Integer;
  7307. begin
  7308. LSize := IndyLength(AValue, ASize, AIndex);
  7309. SetLength(Result, LSize);
  7310. if LSize > 0 then begin
  7311. CopyTIdBytes(AValue, AIndex, Result, 0, LSize);
  7312. end;
  7313. end;
  7314. {$IFNDEF DOTNET}
  7315. function RawToBytes(const AValue; const ASize: Integer): TIdBytes;
  7316. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7317. begin
  7318. SetLength(Result, ASize);
  7319. if ASize > 0 then begin
  7320. Move(AValue, Result[0], ASize);
  7321. end;
  7322. end;
  7323. {$ENDIF}
  7324. procedure ToBytesF(var Bytes: TIdBytes; const AValue: Char; ADestEncoding: IIdTextEncoding = nil
  7325. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  7326. );
  7327. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7328. var
  7329. LChars: {$IFDEF DOTNET}array[0..0] of Char{$ELSE}TIdWideChars{$ENDIF};
  7330. begin
  7331. EnsureEncoding(ADestEncoding);
  7332. {$IFDEF STRING_IS_UNICODE}
  7333. {$IFNDEF DOTNET}
  7334. SetLength(LChars, 1);
  7335. {$ENDIF}
  7336. LChars[0] := AValue;
  7337. {$ELSE}
  7338. EnsureEncoding(ASrcEncoding, encOSDefault);
  7339. LChars := ASrcEncoding.GetChars(RawToBytes(AValue, 1)); // convert to Unicode
  7340. {$ENDIF}
  7341. Assert(Length(Bytes) >= ADestEncoding.GetByteCount(LChars));
  7342. ADestEncoding.GetBytes(LChars, 0, Length(LChars), Bytes, 0);
  7343. end;
  7344. procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int32);
  7345. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7346. begin
  7347. Assert(Length(Bytes) >= SizeOf(AValue));
  7348. CopyTIdInt32(AValue, Bytes, 0);
  7349. end;
  7350. procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int16);
  7351. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7352. begin
  7353. Assert(Length(Bytes) >= SizeOf(AValue));
  7354. CopyTIdInt16(AValue, Bytes, 0);
  7355. end;
  7356. procedure ToBytesF(var Bytes: TIdBytes; const AValue: UInt16);
  7357. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7358. begin
  7359. Assert(Length(Bytes) >= SizeOf(AValue));
  7360. CopyTIdUInt16(AValue, Bytes, 0);
  7361. end;
  7362. procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int8);
  7363. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7364. begin
  7365. Assert(Length(Bytes) >= SizeOf(AValue));
  7366. Bytes[0] := Byte(AValue);
  7367. end;
  7368. procedure ToBytesF(var Bytes: TIdBytes; const AValue: UInt8);
  7369. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7370. begin
  7371. Assert(Length(Bytes) >= SizeOf(AValue));
  7372. Bytes[0] := AValue;
  7373. end;
  7374. procedure ToBytesF(var Bytes: TIdBytes; const AValue: UInt32);
  7375. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7376. begin
  7377. Assert(Length(Bytes) >= SizeOf(AValue));
  7378. CopyTIdUInt32(AValue, Bytes, 0);
  7379. end;
  7380. procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int64);
  7381. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7382. begin
  7383. Assert(Length(Bytes) >= SizeOf(AValue));
  7384. CopyTIdInt64(AValue, Bytes, 0);
  7385. end;
  7386. procedure ToBytesF(var Bytes: TIdBytes; const AValue: TIdUInt64);
  7387. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7388. begin
  7389. Assert(Length(Bytes) >= SizeOf(AValue));
  7390. CopyTIdUInt64(AValue, Bytes, 0);
  7391. end;
  7392. procedure ToBytesF(var Bytes: TIdBytes; const AValue: TIdBytes; const ASize: Integer; const AIndex: Integer = 0);
  7393. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7394. begin
  7395. Assert(Length(Bytes) >= ASize);
  7396. CopyTIdBytes(AValue, AIndex, Bytes, 0, ASize);
  7397. end;
  7398. {$IFNDEF DOTNET}
  7399. procedure RawToBytesF(var Bytes: TIdBytes; const AValue; const ASize: Integer);
  7400. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7401. begin
  7402. Assert(Length(Bytes) >= ASize);
  7403. if ASize > 0 then begin
  7404. Move(AValue, Bytes[0], ASize);
  7405. end;
  7406. end;
  7407. {$ENDIF}
  7408. function BytesToChar(const AValue: TIdBytes; const AIndex: Integer = 0;
  7409. AByteEncoding: IIdTextEncoding = nil
  7410. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  7411. ): Char; overload;
  7412. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7413. begin
  7414. BytesToChar(AValue, Result, AIndex, AByteEncoding{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
  7415. end;
  7416. function BytesToChar(const AValue: TIdBytes; var VChar: Char; const AIndex: Integer = 0;
  7417. AByteEncoding: IIdTextEncoding = nil
  7418. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  7419. ): Integer; overload;
  7420. var
  7421. I, J, NumChars, NumBytes: Integer;
  7422. {$IFDEF DOTNET}
  7423. LChars: array[0..1] of Char;
  7424. {$ELSE}
  7425. LChars: TIdWideChars;
  7426. {$IFDEF STRING_IS_ANSI}
  7427. LWTmp: WideString;
  7428. LATmp: TIdBytes;
  7429. {$ENDIF}
  7430. {$ENDIF}
  7431. begin
  7432. Result := 0;
  7433. EnsureEncoding(AByteEncoding);
  7434. // 2 Chars to handle UTF-16 surrogates
  7435. NumBytes := IndyMin(IndyLength(AValue, -1, AIndex), AByteEncoding.GetMaxByteCount(2));
  7436. {$IFNDEF DOTNET}
  7437. SetLength(LChars, 2);
  7438. {$ENDIF}
  7439. NumChars := 0;
  7440. if NumBytes > 0 then
  7441. begin
  7442. for I := 1 to NumBytes do
  7443. begin
  7444. NumChars := AByteEncoding.GetChars(AValue, AIndex, I, LChars, 0);
  7445. Inc(Result);
  7446. if NumChars > 0 then begin
  7447. // RLebeau 10/19/2012: when Indy switched to its own UTF-8 implementation
  7448. // to avoid the MB_ERR_INVALID_CHARS flag on Windows, it accidentally broke
  7449. // this loop! Since this is not commonly used, this was not noticed until
  7450. // now. On Windows at least, GetChars() now returns >0 for an invalid
  7451. // sequence, so we have to check if any of the returned characters are the
  7452. // Unicode U+FFFD character, indicating bad data...
  7453. for J := 0 to NumChars-1 do begin
  7454. if LChars[J] = TIdWideChar($FFFD) then begin
  7455. // keep reading...
  7456. NumChars := 0;
  7457. Break;
  7458. end;
  7459. end;
  7460. if NumChars > 0 then begin
  7461. Break;
  7462. end;
  7463. end;
  7464. end;
  7465. end;
  7466. {$IFDEF STRING_IS_UNICODE}
  7467. // RLebeau: if the bytes were decoded into surrogates, the second
  7468. // surrogate is lost here, as it can't be returned unless we cache
  7469. // it somewhere for the the next BytesToChar() call to retreive. Just
  7470. // raise an error for now. Users will have to update their code to
  7471. // read surrogates differently...
  7472. Assert(NumChars = 1);
  7473. VChar := LChars[0];
  7474. {$ELSE}
  7475. // RLebeau: since we can only return an AnsiChar here, let's convert
  7476. // the decoded characters, surrogates and all, into their Ansi
  7477. // representation. This will have the same problem as above if the
  7478. // conversion results in a multibyte character sequence...
  7479. EnsureEncoding(ADestEncoding, encOSDefault);
  7480. SetString(LWTmp, PWideChar(LChars), NumChars);
  7481. LATmp := ADestEncoding.GetBytes(LWTmp); // convert to Ansi
  7482. Assert(Length(LATmp) = 1);
  7483. VChar := Char(LATmp[0]);
  7484. {$ENDIF}
  7485. end;
  7486. function BytesToInt32(const AValue: TIdBytes; const AIndex: Integer = 0): Int32;
  7487. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7488. begin
  7489. Assert(Length(AValue) >= (AIndex+SizeOf(Int32)));
  7490. {$IFDEF DOTNET}
  7491. Result := System.BitConverter.ToInt32(AValue, AIndex);
  7492. {$ELSE}
  7493. Result := PInt32(@AValue[AIndex])^;
  7494. {$ENDIF}
  7495. end;
  7496. {$I IdDeprecatedImplBugOff.inc}
  7497. function BytesToLongInt(const AValue: TIdBytes; const AIndex: Integer = 0): Integer;
  7498. {$I IdDeprecatedImplBugOff.inc}
  7499. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7500. begin
  7501. Result := BytesToInt32(AValue, AIndex);
  7502. end;
  7503. function BytesToInt64(const AValue: TIdBytes; const AIndex: Integer = 0): Int64;
  7504. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7505. begin
  7506. Assert(Length(AValue) >= (AIndex+SizeOf(Int64)));
  7507. {$IFDEF DOTNET}
  7508. Result := System.BitConverter.ToInt64(AValue, AIndex);
  7509. {$ELSE}
  7510. Result := PInt64(@AValue[AIndex])^;
  7511. {$ENDIF}
  7512. end;
  7513. function BytesToUInt64(const AValue: TIdBytes; const AIndex: Integer = 0): TIdUInt64;
  7514. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7515. begin
  7516. Assert(Length(AValue) >= (AIndex+SizeOf(TIdUInt64)));
  7517. {$IFDEF DOTNET}
  7518. Result := System.BitConverter.ToUInt64(AValue, AIndex);
  7519. {$ELSE}
  7520. Result{$IFDEF TIdUInt64_HAS_QuadPart}.QuadPart{$ENDIF} := PUInt64(@AValue[AIndex])^;
  7521. {$ENDIF}
  7522. end;
  7523. function BytesToTicks(const AValue: TIdBytes; const AIndex: Integer = 0): TIdTicks;
  7524. {$IFDEF USE_TIdTicks_TIdUInt64_CONVERSION}
  7525. var
  7526. LValue: TIdUInt64;
  7527. {$ELSE}
  7528. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7529. {$ENDIF}
  7530. begin
  7531. {$IFDEF USE_TIdTicks_TIdUInt64_CONVERSION}
  7532. // In C++Builder 2006/2007, TIdUInt64 is a packed record, but TIdTicks is
  7533. // an alias for a native UInt64 , so need a conversion here to get around
  7534. // a compiler error: "E2010 Incompatible types: 'UInt64' and 'TIdUInt64'"...
  7535. LValue := BytesToUInt64(AValue, AIndex);
  7536. Result := LValue.QuadPart;
  7537. {$ELSE}
  7538. {$IFDEF UInt64_IS_NATIVE}
  7539. Result := BytesToUInt64(AValue, AIndex);
  7540. {$ELSE}
  7541. Result := BytesToInt64(AValue, AIndex);
  7542. {$ENDIF}
  7543. {$ENDIF}
  7544. end;
  7545. function BytesToUInt16(const AValue: TIdBytes; const AIndex: Integer = 0): UInt16;
  7546. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7547. begin
  7548. Assert(Length(AValue) >= (AIndex+SizeOf(UInt16)));
  7549. {$IFDEF DOTNET}
  7550. Result := System.BitConverter.ToUInt16(AValue, AIndex);
  7551. {$ELSE}
  7552. Result := PUInt16(@AValue[AIndex])^;
  7553. {$ENDIF}
  7554. end;
  7555. {$I IdDeprecatedImplBugOff.inc}
  7556. function BytesToWord(const AValue: TIdBytes; const AIndex: Integer = 0): UInt16;
  7557. {$I IdDeprecatedImplBugOn.inc}
  7558. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7559. begin
  7560. Result := BytesToUInt16(AValue, AIndex);
  7561. end;
  7562. function BytesToInt16(const AValue: TIdBytes; const AIndex: Integer = 0): Int16;
  7563. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7564. begin
  7565. Assert(Length(AValue) >= (AIndex+SizeOf(Int16)));
  7566. {$IFDEF DOTNET}
  7567. Result := System.BitConverter.ToInt16(AValue, AIndex);
  7568. {$ELSE}
  7569. Result := PInt16(@AValue[AIndex])^;
  7570. {$ENDIF}
  7571. end;
  7572. {$I IdDeprecatedImplBugOff.inc}
  7573. function BytesToShort(const AValue: TIdBytes; const AIndex: Integer = 0): Int16;
  7574. {$I IdDeprecatedImplBugOn.inc}
  7575. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7576. begin
  7577. Result := BytesToInt16(AValue, AIndex);
  7578. end;
  7579. function BytesToIPv4Str(const AValue: TIdBytes; const AIndex: Integer = 0): String;
  7580. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7581. begin
  7582. Assert(Length(AValue) >= (AIndex+4));
  7583. Result := IntToStr(Ord(AValue[AIndex])) + '.' +
  7584. IntToStr(Ord(AValue[AIndex+1])) + '.' +
  7585. IntToStr(Ord(AValue[AIndex+2])) + '.' +
  7586. IntToStr(Ord(AValue[AIndex+3]));
  7587. end;
  7588. procedure BytesToIPv6(const AValue: TIdBytes; var VAddress: TIdIPv6Address; const AIndex: Integer = 0);
  7589. {$IFDEF DOTNET}
  7590. var
  7591. I: Integer;
  7592. {$ELSE}
  7593. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7594. {$ENDIF}
  7595. begin
  7596. Assert(Length(AValue) >= (AIndex+16));
  7597. {$IFDEF DOTNET}
  7598. for i := 0 to 7 do begin
  7599. VAddress[i] := TwoByteToUInt16(AValue[(i*2)+AIndex], AValue[(i*2)+1+AIndex]);
  7600. end;
  7601. {$ELSE}
  7602. Move(AValue[AIndex], VAddress[0], 16);
  7603. {$ENDIF}
  7604. end;
  7605. function BytesToUInt32(const AValue: TIdBytes; const AIndex: Integer = 0): UInt32;
  7606. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7607. begin
  7608. Assert(Length(AValue) >= (AIndex+SizeOf(UInt32)));
  7609. {$IFDEF DOTNET}
  7610. Result := System.BitConverter.ToUInt32(AValue, AIndex);
  7611. {$ELSE}
  7612. Result := PUInt32(@AValue[AIndex])^;
  7613. {$ENDIF}
  7614. end;
  7615. {$I IdDeprecatedImplBugOff.inc}
  7616. function BytesToLongWord(const AValue: TIdBytes; const AIndex: Integer = 0): UInt32;
  7617. {$I IdDeprecatedImplBugOn.inc}
  7618. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7619. begin
  7620. Result := BytesToUInt32(AValue, AIndex);
  7621. end;
  7622. function BytesToString(const AValue: TIdBytes; AByteEncoding: IIdTextEncoding = nil
  7623. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  7624. ): string; overload;
  7625. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7626. begin
  7627. Result := BytesToString(AValue, 0, -1, AByteEncoding
  7628. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  7629. );
  7630. end;
  7631. function BytesToString(const AValue: TIdBytes; const AStartIndex: Integer;
  7632. const ALength: Integer = -1; AByteEncoding: IIdTextEncoding = nil
  7633. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  7634. ): string; overload;
  7635. var
  7636. LLength: Integer;
  7637. {$IFDEF STRING_IS_ANSI}
  7638. LBytes: TIdBytes;
  7639. {$ENDIF}
  7640. begin
  7641. {$IFDEF STRING_IS_ANSI}
  7642. LBytes := nil; // keep the compiler happy
  7643. {$ENDIF}
  7644. LLength := IndyLength(AValue, ALength, AStartIndex);
  7645. if LLength > 0 then begin
  7646. EnsureEncoding(AByteEncoding);
  7647. {$IFDEF STRING_IS_UNICODE}
  7648. Result := AByteEncoding.GetString(AValue, AStartIndex, LLength);
  7649. {$ELSE}
  7650. EnsureEncoding(ADestEncoding);
  7651. if (AStartIndex = 0) and (LLength = Length(AValue)) then begin
  7652. LBytes := AValue;
  7653. end else begin
  7654. LBytes := Copy(AValue, AStartIndex, LLength);
  7655. end;
  7656. CheckByteEncoding(LBytes, AByteEncoding, ADestEncoding);
  7657. SetString(Result, PAnsiChar(LBytes), Length(LBytes));
  7658. {$IFDEF HAS_SetCodePage}
  7659. // on compilers that support AnsiString codepages,
  7660. // set the string's codepage to match ADestEncoding...
  7661. SetCodePage(PRawByteString(@Result)^, GetEncodingCodePage(ADestEncoding), False);
  7662. {$ENDIF}
  7663. {$ENDIF}
  7664. end else begin
  7665. Result := '';
  7666. end;
  7667. end;
  7668. function BytesToStringRaw(const AValue: TIdBytes): string; overload;
  7669. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7670. begin
  7671. Result := BytesToStringRaw(AValue, 0, -1);
  7672. end;
  7673. function BytesToStringRaw(const AValue: TIdBytes; const AStartIndex: Integer;
  7674. const ALength: Integer = -1): string;
  7675. var
  7676. LLength: Integer;
  7677. begin
  7678. LLength := IndyLength(AValue, ALength, AStartIndex);
  7679. if LLength > 0 then begin
  7680. {$IFDEF STRING_IS_UNICODE}
  7681. Result := IndyTextEncoding_8Bit.GetString(AValue, AStartIndex, LLength);
  7682. {$ELSE}
  7683. SetString(Result, PAnsiChar(@AValue[AStartIndex]), LLength);
  7684. {$IFDEF HAS_SetCodePage}
  7685. // on compilers that support AnsiString codepages,
  7686. // set the string's codepage to something like ISO-8859-1...
  7687. SetCodePage(PRawByteString(@Result)^, 28591, False);
  7688. {$ENDIF}
  7689. {$ENDIF}
  7690. end else begin
  7691. Result := '';
  7692. end;
  7693. end;
  7694. {$IFNDEF DOTNET}
  7695. procedure BytesToRaw(const AValue: TIdBytes; var VBuffer; const ASize: Integer);
  7696. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7697. begin
  7698. Assert(Length(AValue) >= ASize);
  7699. Move(AValue[0], VBuffer, ASize);
  7700. end;
  7701. {$ENDIF}
  7702. function TwoByteToUInt16(AByte1, AByte2: Byte): UInt16;
  7703. //Since Replys are returned as Strings, we need a routine to convert two
  7704. // characters which are a 2 byte U Int into a two byte unsigned Integer
  7705. var
  7706. LWord: TIdBytes;
  7707. begin
  7708. SetLength(LWord, SizeOf(UInt16));
  7709. LWord[0] := AByte1;
  7710. LWord[1] := AByte2;
  7711. Result := BytesToUInt16(LWord);
  7712. // Result := UInt16((AByte1 shl 8) and $FF00) or UInt16(AByte2 and $00FF);
  7713. end;
  7714. {$I IdDeprecatedImplBugOff.inc}
  7715. function TwoByteToWord(AByte1, AByte2: Byte): UInt16;
  7716. {$I IdDeprecatedImplBugOn.inc}
  7717. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7718. begin
  7719. Result := TwoByteToUInt16(AByte1, AByte2);
  7720. end;
  7721. function ReadStringFromStream(AStream: TStream; ASize: Integer = -1;
  7722. AByteEncoding: IIdTextEncoding = nil
  7723. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  7724. ): string;
  7725. var
  7726. LBytes: TIdBytes;
  7727. begin
  7728. ASize := TIdStreamHelper.ReadBytes(AStream, LBytes, ASize);
  7729. Result := BytesToString(LBytes, 0, ASize, AByteEncoding
  7730. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  7731. );
  7732. end;
  7733. function ReadTIdBytesFromStream(const AStream: TStream; var ABytes: TIdBytes;
  7734. const Count: TIdStreamSize; const AIndex: Integer = 0): TIdStreamSize;
  7735. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7736. begin
  7737. Result := TIdStreamHelper.ReadBytes(AStream, ABytes, Count, AIndex);
  7738. end;
  7739. function ReadCharFromStream(AStream: TStream; var VChar: Char;
  7740. AByteEncoding: IIdTextEncoding = nil
  7741. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  7742. ): Integer;
  7743. var
  7744. StartPos: TIdStreamSize;
  7745. Lb: Byte;
  7746. I, NumChars, NumBytes: Integer;
  7747. LBytes: TIdBytes;
  7748. {$IFDEF DOTNET}
  7749. LChars: array[0..1] of Char;
  7750. {$ELSE}
  7751. LChars: TIdWideChars;
  7752. {$IFDEF STRING_IS_ANSI}
  7753. LWTmp: WideString;
  7754. LATmp: TIdBytes;
  7755. {$ENDIF}
  7756. {$ENDIF}
  7757. function ReadByte: Byte;
  7758. begin
  7759. if AStream.Read(Result{$IFNDEF DOTNET}, 1{$ENDIF}) <> 1 then begin
  7760. raise EIdException.Create('Unable to read byte'); {do not localize}
  7761. end;
  7762. end;
  7763. begin
  7764. Result := 0;
  7765. {$IFDEF STRING_IS_ANSI}
  7766. LATmp := nil; // keep the compiler happy
  7767. {$ENDIF}
  7768. EnsureEncoding(AByteEncoding);
  7769. StartPos := AStream.Position;
  7770. // don't raise an exception here, backwards compatibility for now
  7771. if AStream.Read(Lb{$IFNDEF DOTNET}, 1{$ENDIF}) <> 1 then begin
  7772. Exit;
  7773. end;
  7774. Result := 1;
  7775. // 2 Chars to handle UTF-16 surrogates
  7776. NumBytes := AByteEncoding.GetMaxByteCount(2);
  7777. SetLength(LBytes, NumBytes);
  7778. {$IFNDEF DOTNET}
  7779. SetLength(LChars, 2);
  7780. {$ENDIF}
  7781. try
  7782. repeat
  7783. LBytes[Result-1] := Lb;
  7784. NumChars := AByteEncoding.GetChars(LBytes, 0, Result, LChars, 0);
  7785. if NumChars > 0 then begin
  7786. // RLebeau 10/19/2012: when Indy switched to its own UTF-8 implementation
  7787. // to avoid the MB_ERR_INVALID_CHARS flag on Windows, it accidentally broke
  7788. // this loop! Since this is not commonly used, this was not noticed until
  7789. // now. On Windows at least, GetChars() now returns >0 for an invalid
  7790. // sequence, so we have to check if any of the returned characters are the
  7791. // Unicode U+FFFD character, indicating bad data...
  7792. for I := 0 to NumChars-1 do begin
  7793. if LChars[I] = TIdWideChar($FFFD) then begin
  7794. // keep reading...
  7795. NumChars := 0;
  7796. Break;
  7797. end;
  7798. end;
  7799. if NumChars > 0 then begin
  7800. Break;
  7801. end;
  7802. end;
  7803. if Result = NumBytes then begin
  7804. Break;
  7805. end;
  7806. Lb := ReadByte;
  7807. Inc(Result);
  7808. until False;
  7809. except
  7810. AStream.Position := StartPos;
  7811. raise;
  7812. end;
  7813. {$IFDEF STRING_IS_UNICODE}
  7814. // RLebeau: if the bytes were decoded into surrogates, the second
  7815. // surrogate is lost here, as it can't be returned unless we cache
  7816. // it somewhere for the the next ReadTIdBytesFromStream() call to
  7817. // retreive. Just raise an error for now. Users will have to
  7818. // update their code to read surrogates differently...
  7819. Assert(NumChars = 1);
  7820. VChar := LChars[0];
  7821. {$ELSE}
  7822. // RLebeau: since we can only return an AnsiChar here, let's convert
  7823. // the decoded characters, surrogates and all, into their Ansi
  7824. // representation. This will have the same problem as above if the
  7825. // conversion results in a multibyte character sequence...
  7826. EnsureEncoding(ADestEncoding, encOSDefault);
  7827. SetString(LWTmp, PWideChar(LChars), NumChars);
  7828. LATmp := ADestEncoding.GetBytes(LWTmp); // convert to Ansi
  7829. Assert(Length(LATmp) = 1);
  7830. VChar := Char(LATmp[0]);
  7831. {$ENDIF}
  7832. end;
  7833. procedure WriteTIdBytesToStream(const AStream: TStream; const ABytes: TIdBytes;
  7834. const ASize: Integer = -1; const AIndex: Integer = 0);
  7835. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7836. begin
  7837. TIdStreamHelper.Write(AStream, ABytes, ASize, AIndex);
  7838. end;
  7839. procedure WriteStringToStream(AStream: TStream; const AStr: string;
  7840. ADestEncoding: IIdTextEncoding
  7841. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  7842. );
  7843. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7844. begin
  7845. WriteStringToStream(AStream, AStr, -1, 1, ADestEncoding
  7846. {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
  7847. );
  7848. end;
  7849. procedure WriteStringToStream(AStream: TStream; const AStr: string;
  7850. const ALength: Integer = -1; const AIndex: Integer = 1;
  7851. ADestEncoding: IIdTextEncoding = nil
  7852. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  7853. );
  7854. {$IFDEF USE_INLINE}inline;{$ENDIF}
  7855. var
  7856. LLength: Integer;
  7857. LBytes: TIdBytes;
  7858. begin
  7859. LBytes := nil;
  7860. LLength := IndyLength(AStr, ALength, AIndex);
  7861. if LLength > 0 then
  7862. begin
  7863. LBytes := ToBytes(AStr, LLength, AIndex, ADestEncoding
  7864. {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
  7865. );
  7866. TIdStreamHelper.Write(AStream, LBytes);
  7867. end;
  7868. end;
  7869. {$IFDEF DOTNET}
  7870. function TIdBaseStream.Read(var VBuffer: array of Byte; AOffset, ACount: Longint): Longint;
  7871. var
  7872. LBytes: TIdBytes;
  7873. begin
  7874. // this is a silly work around really, but array of Byte and TIdByte aren't
  7875. // interchangable in a var parameter, though really they *should be*
  7876. SetLength(LBytes, ACount - AOffset);
  7877. Result := IdRead(LBytes, 0, ACount - AOffset);
  7878. CopyTIdByteArray(LBytes, 0, VBuffer, AOffset, Result);
  7879. end;
  7880. function TIdBaseStream.Write(const ABuffer: array of Byte; AOffset, ACount: Longint): Longint;
  7881. begin
  7882. Result := IdWrite(ABuffer, AOffset, ACount);
  7883. end;
  7884. function TIdBaseStream.Seek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64;
  7885. begin
  7886. Result := IdSeek(AOffset, AOrigin);
  7887. end;
  7888. procedure TIdBaseStream.SetSize(ASize: Int64);
  7889. begin
  7890. IdSetSize(ASize);
  7891. end;
  7892. {$ELSE}
  7893. {$IFDEF STREAM_SIZE_64}
  7894. procedure TIdBaseStream.SetSize(const NewSize: Int64);
  7895. begin
  7896. IdSetSize(NewSize);
  7897. end;
  7898. {$ELSE}
  7899. procedure TIdBaseStream.SetSize(ASize: Integer);
  7900. begin
  7901. IdSetSize(ASize);
  7902. end;
  7903. {$ENDIF}
  7904. function TIdBaseStream.Read(var Buffer; Count: Longint): Longint;
  7905. var
  7906. LBytes: TIdBytes;
  7907. begin
  7908. SetLength(LBytes, Count);
  7909. Result := IdRead(LBytes, 0, Count);
  7910. if Result > 0 then begin
  7911. Move(LBytes[0], Buffer, Result);
  7912. end;
  7913. end;
  7914. function TIdBaseStream.Write(const Buffer; Count: Longint): Longint;
  7915. begin
  7916. if Count > 0 then begin
  7917. Result := IdWrite(RawToBytes(Buffer, Count), 0, Count);
  7918. end else begin
  7919. Result := 0;
  7920. end;
  7921. end;
  7922. {$IFDEF STREAM_SIZE_64}
  7923. function TIdBaseStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
  7924. begin
  7925. Result := IdSeek(Offset, Origin);
  7926. end;
  7927. {$ELSE}
  7928. function TIdBaseStream.Seek(Offset: Longint; Origin: Word): Longint;
  7929. var
  7930. LSeek : TSeekOrigin;
  7931. begin
  7932. case Origin of
  7933. soFromBeginning : LSeek := soBeginning;
  7934. soFromCurrent : LSeek := soCurrent;
  7935. soFromEnd : LSeek := soEnd;
  7936. else
  7937. Result := 0;
  7938. Exit;
  7939. end;
  7940. Result := IdSeek(Offset, LSeek) and $FFFFFFFF;
  7941. end;
  7942. {$ENDIF}
  7943. {$ENDIF}
  7944. function TIdCalculateSizeStream.IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint;
  7945. begin
  7946. Result := 0;
  7947. end;
  7948. function TIdCalculateSizeStream.IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint;
  7949. var
  7950. I: Integer;
  7951. begin
  7952. I := IndyLength(ABuffer, ACount, AOffset);
  7953. if I > 0 then begin
  7954. Inc(FPosition, I);
  7955. if FPosition > FSize then begin
  7956. FSize := FPosition;
  7957. end;
  7958. end;
  7959. Result := I;
  7960. end;
  7961. function TIdCalculateSizeStream.IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64;
  7962. begin
  7963. case AOrigin of
  7964. soBeginning: begin
  7965. FPosition := AOffset;
  7966. end;
  7967. soCurrent: begin
  7968. FPosition := FPosition + AOffset;
  7969. end;
  7970. soEnd: begin
  7971. FPosition := FSize + AOffset;
  7972. end;
  7973. end;
  7974. if FPosition < 0 then begin
  7975. FPosition := 0;
  7976. end;
  7977. Result := FPosition;
  7978. end;
  7979. procedure TIdCalculateSizeStream.IdSetSize(ASize: Int64);
  7980. begin
  7981. if ASize < 0 then begin
  7982. ASize := 0;
  7983. end;
  7984. if FSize <> ASize then begin
  7985. FSize := ASize;
  7986. if FSize < FPosition then begin
  7987. FPosition := FSize;
  7988. end;
  7989. end;
  7990. end;
  7991. function TIdEventStream.IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint;
  7992. begin
  7993. Result := 0;
  7994. if Assigned(FOnRead) then begin
  7995. FOnRead(VBuffer, AOffset, ACount, Result);
  7996. end;
  7997. end;
  7998. function TIdEventStream.IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint;
  7999. begin
  8000. if Assigned(FOnWrite) then begin
  8001. Result := 0;
  8002. FOnWrite(ABuffer, AOffset, ACount, Result);
  8003. end else begin
  8004. Result := ACount;
  8005. end;
  8006. end;
  8007. function TIdEventStream.IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64;
  8008. begin
  8009. Result := 0;
  8010. if Assigned(FOnSeek) then begin
  8011. FOnSeek(AOffset, AOrigin, Result);
  8012. end;
  8013. end;
  8014. procedure TIdEventStream.IdSetSize(ASize: Int64);
  8015. begin
  8016. if Assigned(FOnSetSize) then begin
  8017. FOnSetSize(ASize);
  8018. end;
  8019. end;
  8020. {$IFNDEF DOTNET}
  8021. constructor TIdMemoryBufferStream.Create(APtr: Pointer; ASize: TIdNativeInt);
  8022. begin
  8023. inherited Create;
  8024. SetPointer(APtr, ASize);
  8025. end;
  8026. {$UNDEF USE_PBYTE_ARITHMETIC}
  8027. {$IFDEF FPC}
  8028. {$DEFINE USE_PBYTE_ARITHMETIC}
  8029. {$ELSE}
  8030. {$IFDEF VCL_XE2_OR_ABOVE}
  8031. {$DEFINE USE_PBYTE_ARITHMETIC}
  8032. {$ENDIF}
  8033. {$ENDIF}
  8034. function TIdMemoryBufferStream.Write(const Buffer; Count: Longint): Longint;
  8035. var
  8036. LAvailable: TIdStreamSize;
  8037. LNumToCopy: Longint;
  8038. begin
  8039. Result := 0;
  8040. LAvailable := Size - Position;
  8041. if LAvailable > 0 then
  8042. begin
  8043. {$IFDEF STREAM_SIZE_64}
  8044. LNumToCopy := Longint(IndyMin(LAvailable, TIdStreamSize(Count)));
  8045. {$ELSE}
  8046. LNumToCopy := IndyMin(LAvailable, Count);
  8047. {$ENDIF}
  8048. if LNumToCopy > 0 then
  8049. begin
  8050. System.Move(Buffer, ({$IFDEF USE_PBYTE_ARITHMETIC}PByte{$ELSE}PIdAnsiChar{$ENDIF}(Memory) + Position)^, LNumToCopy);
  8051. TIdStreamHelper.Seek(Self, LNumToCopy, soCurrent);
  8052. Result := LNumToCopy;
  8053. end;
  8054. end;
  8055. end;
  8056. {$ENDIF}
  8057. function TIdReadOnlyMemoryBufferStream.Write(const Buffer; Count: Longint): Longint;
  8058. begin
  8059. // TODO: raise an exception instead?
  8060. Result := 0;
  8061. end;
  8062. procedure AppendBytes(var VBytes: TIdBytes; const AToAdd: TIdBytes; const AIndex: Integer = 0; const ALength: Integer = -1);
  8063. var
  8064. LOldLen, LAddLen: Integer;
  8065. begin
  8066. LAddLen := IndyLength(AToAdd, ALength, AIndex);
  8067. if LAddLen > 0 then begin
  8068. LOldLen := Length(VBytes);
  8069. SetLength(VBytes, LOldLen + LAddLen);
  8070. CopyTIdBytes(AToAdd, AIndex, VBytes, LOldLen, LAddLen);
  8071. end;
  8072. end;
  8073. procedure AppendByte(var VBytes: TIdBytes; const AByte: Byte);
  8074. var
  8075. LOldLen: Integer;
  8076. begin
  8077. LOldLen := Length(VBytes);
  8078. SetLength(VBytes, LOldLen + 1);
  8079. VBytes[LOldLen] := AByte;
  8080. end;
  8081. procedure AppendString(var VBytes: TIdBytes; const AStr: String; const ALength: Integer = -1;
  8082. ADestEncoding: IIdTextEncoding = nil
  8083. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  8084. );
  8085. var
  8086. LBytes: TIdBytes;
  8087. LLength, LOldLen: Integer;
  8088. begin
  8089. LBytes := nil; // keep the compiler happy
  8090. LLength := IndyLength(AStr, ALength);
  8091. if LLength > 0 then begin
  8092. LBytes := ToBytes(AStr, LLength, 1, ADestEncoding
  8093. {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
  8094. );
  8095. LOldLen := Length(VBytes);
  8096. LLength := Length(LBytes);
  8097. SetLength(VBytes, LOldLen + LLength);
  8098. CopyTIdBytes(LBytes, 0, VBytes, LOldLen, LLength);
  8099. end;
  8100. end;
  8101. procedure ExpandBytes(var VBytes: TIdBytes; const AIndex: Integer; const ACount: Integer; const AFillByte: Byte = 0);
  8102. var
  8103. I: Integer;
  8104. begin
  8105. if ACount > 0 then begin
  8106. // if AIndex is at the end of the buffer then the operation is appending bytes
  8107. if AIndex <> Length(VBytes) then begin
  8108. //if these asserts fail, then it indicates an attempted buffer overrun.
  8109. Assert(AIndex >= 0);
  8110. Assert(AIndex < Length(VBytes));
  8111. end;
  8112. SetLength(VBytes, Length(VBytes) + ACount);
  8113. // move any existing bytes at the index to the end of the buffer
  8114. for I := Length(VBytes)-1 downto AIndex+ACount do begin
  8115. VBytes[I] := VBytes[I-ACount];
  8116. end;
  8117. // fill in the new space with the fill byte
  8118. for I := AIndex to AIndex+ACount-1 do begin
  8119. VBytes[I] := AFillByte;
  8120. end;
  8121. end;
  8122. end;
  8123. procedure InsertBytes(var VBytes: TIdBytes; const ADestIndex: Integer;
  8124. const ASource: TIdBytes; const ASourceIndex: Integer = 0);
  8125. var
  8126. LAddLen: Integer;
  8127. begin
  8128. LAddLen := IndyLength(ASource, -1, ASourceIndex);
  8129. if LAddLen > 0 then begin
  8130. ExpandBytes(VBytes, ADestIndex, LAddLen);
  8131. CopyTIdBytes(ASource, ASourceIndex, VBytes, ADestIndex, LAddLen);
  8132. end;
  8133. end;
  8134. procedure InsertByte(var VBytes: TIdBytes; const AByte: Byte; const AIndex: Integer);
  8135. {$IFDEF USE_INLINE}inline;{$ENDIF}
  8136. begin
  8137. ExpandBytes(VBytes, AIndex, 1, AByte);
  8138. end;
  8139. procedure RemoveBytes(var VBytes: TIdBytes; const ACount: Integer; const AIndex: Integer = 0);
  8140. var
  8141. I: Integer;
  8142. LActual: Integer;
  8143. begin
  8144. //TODO: check the reference count of VBytes, if >1 then make a new copy
  8145. Assert(AIndex >= 0);
  8146. LActual := IndyMin(Length(VBytes)-AIndex, ACount);
  8147. if LActual > 0 then begin
  8148. if (AIndex + LActual) < Length(VBytes) then begin
  8149. // RLebeau: TODO - use Move() here instead?
  8150. for I := AIndex to Length(VBytes)-LActual-1 do begin
  8151. VBytes[I] := VBytes[I+LActual];
  8152. end;
  8153. end;
  8154. SetLength(VBytes, Length(VBytes)-LActual);
  8155. end;
  8156. end;
  8157. procedure IdDelete(var s: string; AOffset, ACount: Integer);
  8158. {$IFDEF USE_INLINE}inline;{$ENDIF}
  8159. begin
  8160. Delete(s, AOffset, ACount);
  8161. end;
  8162. procedure IdInsert(const Source: string; var S: string; Index: Integer);
  8163. {$IFDEF USE_INLINE}inline;{$ENDIF}
  8164. begin
  8165. Insert(Source, S, Index);
  8166. end;
  8167. function TextIsSame(const A1, A2: string): Boolean;
  8168. {$IFDEF USE_INLINE}inline;{$ENDIF}
  8169. begin
  8170. {$IFDEF DOTNET}
  8171. Result := System.String.Compare(A1, A2, True) = 0;
  8172. {$ELSE}
  8173. Result := AnsiCompareText(A1, A2) = 0;
  8174. {$ENDIF}
  8175. end;
  8176. // TODO: define STRING_UNICODE_MISMATCH for WinCE in IdCompilerDefines.inc?
  8177. {$IFDEF WINDOWS}
  8178. {$IFDEF WINCE}
  8179. {$IFNDEF STRING_IS_UNICODE}
  8180. {$DEFINE COMPARE_STRING_MISMATCH}
  8181. {$ENDIF}
  8182. {$ELSE}
  8183. {$IFDEF STRING_UNICODE_MISMATCH}
  8184. {$DEFINE COMPARE_STRING_MISMATCH}
  8185. {$ENDIF}
  8186. {$ENDIF}
  8187. {$ENDIF}
  8188. function TextStartsWith(const S, SubS: string): Boolean;
  8189. var
  8190. LLen: Integer;
  8191. {$IFDEF WINDOWS}
  8192. {$IFDEF COMPARE_STRING_MISMATCH}
  8193. LS, LSubS: {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF};
  8194. P1, P2: {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF};
  8195. {$ENDIF}
  8196. {$ENDIF}
  8197. begin
  8198. LLen := Length(SubS);
  8199. Result := LLen <= Length(S);
  8200. if Result then
  8201. begin
  8202. {$IFDEF DOTNET}
  8203. Result := System.String.Compare(S, 0, SubS, 0, LLen, True) = 0;
  8204. {$ELSE}
  8205. {$IFDEF WINDOWS}
  8206. {$IFDEF COMPARE_STRING_MISMATCH}
  8207. // explicit convert to Ansi/Unicode
  8208. LS := {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF}(S);
  8209. LSubS := {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF}(SubS);
  8210. LLen := Length(LSubS);
  8211. Result := LLen <= Length(LS);
  8212. if Result then begin
  8213. P1 := {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF}(LS);
  8214. P2 := {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF}(LSubS);
  8215. Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, P1, LLen, P2, LLen) = 2;
  8216. end;
  8217. {$ELSE}
  8218. Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PChar(S), LLen, PChar(SubS), LLen) = 2;
  8219. {$ENDIF}
  8220. {$ELSE}
  8221. Result := AnsiCompareText(Copy(S, 1, LLen), SubS) = 0;
  8222. {$ENDIF}
  8223. {$ENDIF}
  8224. end;
  8225. end;
  8226. function TextEndsWith(const S, SubS: string): Boolean;
  8227. var
  8228. LLen: Integer;
  8229. {$IFDEF WINDOWS}
  8230. {$IFDEF COMPARE_STRING_MISMATCH}
  8231. LS, LSubS: {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF};
  8232. P1, P2: {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF};
  8233. {$ELSE}
  8234. P: PChar;
  8235. {$ENDIF}
  8236. {$ENDIF}
  8237. begin
  8238. LLen := Length(SubS);
  8239. Result := LLen <= Length(S);
  8240. if Result then
  8241. begin
  8242. {$IFDEF DOTNET}
  8243. Result := System.String.Compare(S, Length(S)-LLen, SubS, 0, LLen, True) = 0;
  8244. {$ELSE}
  8245. {$IFDEF WINDOWS}
  8246. {$IFDEF COMPARE_STRING_MISMATCH}
  8247. // explicit convert to Ansi/Unicode
  8248. LS := {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF}(S);
  8249. LSubS := {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF}(SubS);
  8250. LLen := Length(LSubS);
  8251. Result := LLen <= Length(S);
  8252. if Result then begin
  8253. P1 := {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF}(LS);
  8254. P2 := {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF}(LSubS);
  8255. Inc(P1, Length(LS)-LLen);
  8256. Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, P1, LLen, P2, LLen) = 2;
  8257. end;
  8258. {$ELSE}
  8259. P := PChar(S);
  8260. Inc(P, Length(S)-LLen);
  8261. Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, P, LLen, PChar(SubS), LLen) = 2;
  8262. {$ENDIF}
  8263. {$ELSE}
  8264. Result := AnsiCompareText(Copy(S, Length(S)-LLen+1, LLen), SubS) = 0;
  8265. {$ENDIF}
  8266. {$ENDIF}
  8267. end;
  8268. end;
  8269. function IndyLowerCase(const A1: string): string;
  8270. {$IFDEF USE_INLINE}inline;{$ENDIF}
  8271. begin
  8272. {$IFDEF DOTNET}
  8273. Result := A1.ToLower;
  8274. {$ELSE}
  8275. Result := AnsiLowerCase(A1);
  8276. {$ENDIF}
  8277. end;
  8278. function IndyUpperCase(const A1: string): string;
  8279. {$IFDEF USE_INLINE}inline;{$ENDIF}
  8280. begin
  8281. {$IFDEF DOTNET}
  8282. Result := A1.ToUpper;
  8283. {$ELSE}
  8284. Result := AnsiUpperCase(A1);
  8285. {$ENDIF}
  8286. end;
  8287. function IndyCompareStr(const A1, A2: string): Integer;
  8288. {$IFDEF USE_INLINE}inline;{$ENDIF}
  8289. begin
  8290. {$IFDEF DOTNET}
  8291. Result := CompareStr(A1, A2);
  8292. {$ELSE}
  8293. Result := AnsiCompareStr(A1, A2);
  8294. {$ENDIF}
  8295. end;
  8296. function CharPosInSet(const AString: string; const ACharPos: Integer; const ASet: String): Integer;
  8297. {$IFDEF USE_INLINE}inline;{$ENDIF}
  8298. {$IFNDEF DOTNET}
  8299. var
  8300. LChar: Char;
  8301. I: Integer;
  8302. {$ENDIF}
  8303. begin
  8304. Result := 0;
  8305. if ACharPos < 1 then begin
  8306. raise EIdException.Create('Invalid ACharPos');{ do not localize }
  8307. end;
  8308. if ACharPos <= Length(AString) then begin
  8309. {$IFDEF DOTNET}
  8310. Result := ASet.IndexOf(AString[ACharPos]) + 1;
  8311. {$ELSE}
  8312. // RLebeau 5/8/08: Calling Pos() with a Char as input creates a temporary
  8313. // String. Normally this is fine, but profiling reveils this to be a big
  8314. // bottleneck for code that makes a lot of calls to CharIsInSet(), so we
  8315. // will scan through ASet looking for the character without a conversion...
  8316. //
  8317. // Result := IndyPos(AString[ACharPos], ASet);
  8318. //
  8319. LChar := AString[ACharPos];
  8320. for I := 1 to Length(ASet) do begin
  8321. if ASet[I] = LChar then begin
  8322. Result := I;
  8323. Exit;
  8324. end;
  8325. end;
  8326. {$ENDIF}
  8327. end;
  8328. end;
  8329. function CharIsInSet(const AString: string; const ACharPos: Integer; const ASet: String): Boolean;
  8330. {$IFDEF USE_INLINE}inline;{$ENDIF}
  8331. begin
  8332. Result := CharPosInSet(AString, ACharPos, ASet) > 0;
  8333. end;
  8334. function CharIsInEOL(const AString: string; const ACharPos: Integer): Boolean;
  8335. {$IFDEF USE_INLINE}inline;{$ENDIF}
  8336. begin
  8337. Result := CharPosInSet(AString, ACharPos, EOL) > 0;
  8338. end;
  8339. function CharEquals(const AString: string; const ACharPos: Integer; const AValue: Char): Boolean;
  8340. {$IFDEF USE_INLINE}inline;{$ENDIF}
  8341. begin
  8342. if ACharPos < 1 then begin
  8343. raise EIdException.Create('Invalid ACharPos');{ do not localize }
  8344. end;
  8345. Result := ACharPos <= Length(AString);
  8346. if Result then begin
  8347. Result := AString[ACharPos] = AValue;
  8348. end;
  8349. end;
  8350. {$IFDEF STRING_IS_IMMUTABLE}
  8351. {$IFDEF DOTNET}
  8352. {$DEFINE HAS_String_IndexOf}
  8353. {$ENDIF}
  8354. {$IFDEF HAS_SysUtils_TStringHelper}
  8355. {$DEFINE HAS_String_IndexOf}
  8356. {$ENDIF}
  8357. function CharPosInSet(const ASB: TIdStringBuilder; const ACharPos: Integer; const ASet: String): Integer;
  8358. {$IFDEF USE_INLINE}inline;{$ENDIF}
  8359. {$IFNDEF HAS_String_IndexOf}
  8360. var
  8361. LChar: Char;
  8362. I: Integer;
  8363. {$ENDIF}
  8364. begin
  8365. Result := 0;
  8366. if ACharPos < 1 then begin
  8367. raise EIdException.Create('Invalid ACharPos');{ do not localize }
  8368. end;
  8369. if ACharPos <= ASB.Length then begin
  8370. {$IFDEF HAS_String_IndexOf}
  8371. Result := ASet.IndexOf(ASB[ACharPos-1]) + 1;
  8372. {$ELSE}
  8373. // RLebeau 5/8/08: Calling Pos() with a Char as input creates a temporary
  8374. // String. Normally this is fine, but profiling reveils this to be a big
  8375. // bottleneck for code that makes a lot of calls to CharIsInSet(), so we
  8376. // will scan through ASet looking for the character without a conversion...
  8377. //
  8378. // Result := IndyPos(ASB[ACharPos-1], ASet);
  8379. //
  8380. LChar := ASB[ACharPos-1];
  8381. for I := 1 to Length(ASet) do begin
  8382. if ASet[I] = LChar then begin
  8383. Result := I;
  8384. Exit;
  8385. end;
  8386. end;
  8387. {$ENDIF}
  8388. end;
  8389. end;
  8390. function CharIsInSet(const ASB: TIdStringBuilder; const ACharPos: Integer; const ASet: String): Boolean;
  8391. {$IFDEF USE_INLINE}inline;{$ENDIF}
  8392. begin
  8393. Result := CharPosInSet(ASB, ACharPos, ASet) > 0;
  8394. end;
  8395. function CharIsInEOL(const ASB: TIdStringBuilder; const ACharPos: Integer): Boolean;
  8396. {$IFDEF USE_INLINE}inline;{$ENDIF}
  8397. begin
  8398. Result := CharPosInSet(ASB, ACharPos, EOL) > 0;
  8399. end;
  8400. function CharEquals(const ASB: TIdStringBuilder; const ACharPos: Integer; const AValue: Char): Boolean;
  8401. {$IFDEF USE_INLINE}inline;{$ENDIF}
  8402. begin
  8403. if ACharPos < 1 then begin
  8404. raise EIdException.Create('Invalid ACharPos');{ do not localize }
  8405. end;
  8406. Result := ACharPos <= ASB.Length;
  8407. if Result then begin
  8408. Result := ASB[ACharPos-1] = AValue;
  8409. end;
  8410. end;
  8411. {$ENDIF}
  8412. function ByteIndex(const AByte: Byte; const ABytes: TIdBytes; const AStartIndex: Integer = 0): Integer;
  8413. var
  8414. I: Integer;
  8415. begin
  8416. Result := -1;
  8417. for I := AStartIndex to Length(ABytes)-1 do begin
  8418. if ABytes[I] = AByte then begin
  8419. Result := I;
  8420. Exit;
  8421. end;
  8422. end;
  8423. end;
  8424. function ByteIdxInSet(const ABytes: TIdBytes; const AIndex: Integer; const ASet: TIdBytes): Integer;
  8425. {$IFDEF USE_INLINE}inline;{$ENDIF}
  8426. begin
  8427. if AIndex < 0 then begin
  8428. raise EIdException.Create('Invalid AIndex'); {do not localize}
  8429. end;
  8430. if AIndex < Length(ABytes) then begin
  8431. Result := ByteIndex(ABytes[AIndex], ASet);
  8432. end else begin
  8433. Result := -1;
  8434. end;
  8435. end;
  8436. function ByteIsInSet(const ABytes: TIdBytes; const AIndex: Integer; const ASet: TIdBytes): Boolean;
  8437. {$IFDEF USE_INLINE}inline;{$ENDIF}
  8438. begin
  8439. Result := ByteIdxInSet(ABytes, AIndex, ASet) > -1;
  8440. end;
  8441. function ByteIsInEOL(const ABytes: TIdBytes; const AIndex: Integer): Boolean;
  8442. var
  8443. LSet: TIdBytes;
  8444. begin
  8445. SetLength(LSet, 2);
  8446. LSet[0] := 13;
  8447. LSet[1] := 10;
  8448. Result := ByteIsInSet(ABytes, AIndex, LSet);
  8449. end;
  8450. function ReadLnFromStream(AStream: TStream; AMaxLineLength: Integer = -1;
  8451. AExceptionIfEOF: Boolean = False; AByteEncoding: IIdTextEncoding = nil
  8452. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  8453. ): string; overload;
  8454. begin
  8455. if (not ReadLnFromStream(AStream, Result, AMaxLineLength, AByteEncoding
  8456. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  8457. )) and AExceptionIfEOF then
  8458. begin
  8459. raise EIdEndOfStream.CreateFmt(RSEndOfStream, ['ReadLnFromStream', AStream.Position]);
  8460. end;
  8461. end;
  8462. //TODO: Continue to optimize this function. Its performance severely impacts the coders
  8463. function ReadLnFromStream(AStream: TStream; var VLine: String; AMaxLineLength: Integer = -1;
  8464. AByteEncoding: IIdTextEncoding = nil
  8465. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  8466. ): Boolean; overload;
  8467. const
  8468. LBUFMAXSIZE = 2048;
  8469. var
  8470. LStringLen, LResultLen, LBufSize: Integer;
  8471. LBuf: TIdBytes;
  8472. LLine: TIdBytes;
  8473. // LBuf: packed array [0..LBUFMAXSIZE] of Char;
  8474. LStrmPos, LStrmSize: TIdStreamSize; //LBytesToRead = stream size - Position
  8475. LCrEncountered: Boolean;
  8476. function FindEOL(const ABuf: TIdBytes; var VLineBufSize: Integer; var VCrEncountered: Boolean): Integer;
  8477. var
  8478. i: Integer;
  8479. begin
  8480. Result := VLineBufSize; //EOL not found => use all
  8481. i := 0;
  8482. while i < VLineBufSize do begin
  8483. case ABuf[i] of
  8484. Ord(LF): begin
  8485. Result := i; {string size}
  8486. VCrEncountered := True;
  8487. VLineBufSize := i+1;
  8488. Break;
  8489. end;
  8490. Ord(CR): begin
  8491. Result := i; {string size}
  8492. VCrEncountered := True;
  8493. Inc(i); //crLF?
  8494. if (i < VLineBufSize) and (ABuf[i] = Ord(LF)) then begin
  8495. VLineBufSize := i+1;
  8496. end else begin
  8497. VLineBufSize := i;
  8498. end;
  8499. Break;
  8500. end;
  8501. end;
  8502. Inc(i);
  8503. end;
  8504. end;
  8505. begin
  8506. Assert(AStream<>nil);
  8507. VLine := '';
  8508. SetLength(LLine, 0);
  8509. if AMaxLineLength < 0 then begin
  8510. AMaxLineLength := MaxInt;
  8511. end;
  8512. { we store the stream size for the whole routine to prevent
  8513. so do not incur a performance penalty with TStream.Size. It has
  8514. to use something such as Seek each time the size is obtained}
  8515. {4 seek vs 3 seek}
  8516. LStrmPos := AStream.Position;
  8517. LStrmSize := AStream.Size;
  8518. if LStrmPos >= LStrmSize then begin
  8519. Result := False;
  8520. Exit;
  8521. end;
  8522. SetLength(LBuf, LBUFMAXSIZE);
  8523. LCrEncountered := False;
  8524. repeat
  8525. LBufSize := ReadTIdBytesFromStream(AStream, LBuf, IndyMin(LStrmSize - LStrmPos, LBUFMAXSIZE));
  8526. if LBufSize < 1 then begin
  8527. Break; // TODO: throw a stream read exception instead?
  8528. end;
  8529. LStringLen := FindEOL(LBuf, LBufSize, LCrEncountered);
  8530. Inc(LStrmPos, LBufSize);
  8531. LResultLen := Length(VLine);
  8532. if (LResultLen + LStringLen) > AMaxLineLength then begin
  8533. LStringLen := AMaxLineLength - LResultLen;
  8534. LCrEncountered := True;
  8535. Dec(LStrmPos, LBufSize);
  8536. Inc(LStrmPos, LStringLen);
  8537. end;
  8538. if LStringLen > 0 then begin
  8539. LBufSize := Length(LLine);
  8540. SetLength(LLine, LBufSize+LStringLen);
  8541. CopyTIdBytes(LBuf, 0, LLine, LBufSize, LStringLen);
  8542. end;
  8543. until (LStrmPos >= LStrmSize) or LCrEncountered;
  8544. // RLebeau: why is the original Position being restored here, instead
  8545. // of leaving the Position at the end of the line?
  8546. AStream.Position := LStrmPos;
  8547. VLine := BytesToString(LLine, 0, -1, AByteEncoding
  8548. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  8549. );
  8550. Result := True;
  8551. end;
  8552. {$IFNDEF DOTNET}
  8553. {$IFDEF REGISTER_EXPECTED_MEMORY_LEAK}
  8554. function IndyRegisterExpectedMemoryLeak(AAddress: Pointer): Boolean;
  8555. {$IFDEF USE_INLINE}inline;{$ENDIF}
  8556. begin
  8557. // use only System.RegisterExpectedMemoryLeak() on systems that support
  8558. // it. We should use whatever the RTL's active memory manager is. The user
  8559. // can override the RTL's version of FastMM (2006+ only) with any memory
  8560. // manager they want, such as MadExcept.
  8561. //
  8562. // Fallback to specific memory managers if System.RegisterExpectedMemoryLeak()
  8563. // is not available.
  8564. {$IFDEF HAS_System_RegisterExpectedMemoryLeak}
  8565. // RLebeau 4/21/08: not quite sure what the difference is between the
  8566. // SysRegisterExpectedMemoryLeak() and RegisterExpectedMemoryLeak()
  8567. // functions in the System unit, but calling RegisterExpectedMemoryLeak()
  8568. // is causing stack overflows when FastMM is not active, so call
  8569. // SysRegisterExpectedMemoryLeak() instead...
  8570. // RLebeau 7/4/09: According to Pierre Le Riche, developer of FastMM:
  8571. //
  8572. // "SysRegisterExpectedMemoryLeak() is the leak registration routine for
  8573. // the built-in memory manager. FastMM.RegisterExpectedMemoryLeak is the
  8574. // leak registration code for FastMM. Both of these are thus hardwired to
  8575. // a specific memory manager. In order to register a leak for the
  8576. // *currently installed* memory manager, which is what you typically want
  8577. // to do, you have to call System.RegisterExpectedMemoryLeak().
  8578. // System.RegisterExpectedMemoryLeak() redirects to the leak registration
  8579. // code of the installed memory manager."
  8580. //Result := System.SysRegisterExpectedMemoryLeak(AAddress);
  8581. Result := System.RegisterExpectedMemoryLeak(AAddress);
  8582. {$ELSE}
  8583. // RLebeau 10/5/2014: the user can override the RTL's version of FastMM
  8584. // (2006+ only) with any memory manager, such as MadExcept, so check for
  8585. // that...
  8586. {$IFDEF USE_FASTMM4}
  8587. Result := FastMM4.RegisterExpectedMemoryLeak(AAddress);
  8588. {$ELSE}
  8589. {$IFDEF USE_MADEXCEPT}
  8590. Result := madExcept.HideLeak(AAddress);
  8591. {$ELSE}
  8592. {$IFDEF USE_LEAKCHECK}
  8593. Result := LeakCheck.RegisterExpectedMemoryLeak(AAddress);
  8594. {$ELSE}
  8595. Result := False;
  8596. {$ENDIF}
  8597. {$ENDIF}
  8598. {$ENDIF}
  8599. {$ENDIF}
  8600. end;
  8601. {$ENDIF}
  8602. {$ENDIF}
  8603. function IndyAddPair(AStrings: TStrings; const AName, AValue: String): TStrings;
  8604. {$IFDEF USE_INLINE}inline;{$ENDIF}
  8605. begin
  8606. {$IFDEF HAS_TStrings_AddPair}
  8607. Result := AStrings.AddPair(AName, AValue);
  8608. {$ELSE}
  8609. {$IFDEF HAS_TStrings_NameValueSeparator}
  8610. AStrings.Add(AName + AStrings.NameValueSeparator + AValue);
  8611. {$ELSE}
  8612. AStrings.Add(AName + '=' + AValue); {do not localize}
  8613. {$ENDIF}
  8614. Result := AStrings;
  8615. {$ENDIF}
  8616. end;
  8617. function IndyAddPair(AStrings: TStrings; const AName, AValue: String; AObject: TObject): TStrings;
  8618. {$IFDEF USE_INLINE}inline;{$ENDIF}
  8619. begin
  8620. {$IFDEF HAS_TStrings_AddPair}
  8621. Result := AStrings.AddPair(AName, AValue, AObject);
  8622. {$ELSE}
  8623. {$IFDEF HAS_TStrings_NameValueSeparator}
  8624. AStrings.AddObject(AName + AStrings.NameValueSeparator + AValue, AObject);
  8625. {$ELSE}
  8626. AStrings.AddObject(AName + '=' + AValue, AObject);
  8627. {$ENDIF}
  8628. Result := AStrings;
  8629. {$ENDIF}
  8630. end;
  8631. function InternalIndyIndexOf(AStrings: TStrings; const AStr: string;
  8632. const ACaseSensitive: Boolean = False): Integer;
  8633. {$IFDEF USE_INLINE}inline;{$ENDIF}
  8634. var
  8635. I: Integer;
  8636. begin
  8637. Result := -1;
  8638. for I := 0 to AStrings.Count - 1 do begin
  8639. if ACaseSensitive then begin
  8640. if AStrings[I] = AStr then begin
  8641. Result := I;
  8642. Exit;
  8643. end;
  8644. end else begin
  8645. if TextIsSame(AStrings[I], AStr) then begin
  8646. Result := I;
  8647. Exit;
  8648. end;
  8649. end;
  8650. end;
  8651. end;
  8652. function IndyIndexOf(AStrings: TStrings; const AStr: string;
  8653. const ACaseSensitive: Boolean = False): Integer;
  8654. begin
  8655. {$IFDEF HAS_TStringList_CaseSensitive}
  8656. if AStrings is TStringList then begin
  8657. Result := IndyIndexOf(TStringList(AStrings), AStr, ACaseSensitive);
  8658. Exit;
  8659. end;
  8660. {$ENDIF}
  8661. Result := InternalIndyIndexOf(AStrings, AStr, ACaseSensitive);
  8662. end;
  8663. {$IFDEF HAS_TStringList_CaseSensitive}
  8664. function IndyIndexOf(AStrings: TStringList; const AStr: string;
  8665. const ACaseSensitive: Boolean = False): Integer;
  8666. begin
  8667. if AStrings.CaseSensitive = ACaseSensitive then begin
  8668. Result := AStrings.IndexOf(AStr);
  8669. end else begin
  8670. Result := InternalIndyIndexOf(AStrings, AStr, ACaseSensitive);
  8671. end;
  8672. end;
  8673. {$ENDIF}
  8674. function InternalIndyIndexOfName(AStrings: TStrings; const AName: string;
  8675. const ACaseSensitive: Boolean = False): Integer;
  8676. {$IFDEF USE_INLINE}inline;{$ENDIF}
  8677. var
  8678. I: Integer;
  8679. begin
  8680. Result := -1;
  8681. for I := 0 to AStrings.Count - 1 do begin
  8682. if ACaseSensitive then begin
  8683. if AStrings.Names[I] = AName then begin
  8684. Result := I;
  8685. Exit;
  8686. end;
  8687. end
  8688. else if TextIsSame(AStrings.Names[I], AName) then begin
  8689. Result := I;
  8690. Exit;
  8691. end;
  8692. end;
  8693. end;
  8694. function IndyIndexOfName(AStrings: TStrings; const AName: string;
  8695. const ACaseSensitive: Boolean = False): Integer;
  8696. begin
  8697. {$IFDEF HAS_TStringList_CaseSensitive}
  8698. if AStrings is TStringList then begin
  8699. Result := IndyIndexOfName(TStringList(AStrings), AName, ACaseSensitive);
  8700. Exit;
  8701. end;
  8702. {$ENDIF}
  8703. Result := InternalIndyIndexOfName(AStrings, AName, ACaseSensitive);
  8704. end;
  8705. {$IFDEF HAS_TStringList_CaseSensitive}
  8706. function IndyIndexOfName(AStrings: TStringList; const AName: string;
  8707. const ACaseSensitive: Boolean = False): Integer;
  8708. begin
  8709. if AStrings.CaseSensitive = ACaseSensitive then begin
  8710. Result := AStrings.IndexOfName(AName);
  8711. end else begin
  8712. Result := InternalIndyIndexOfName(AStrings, AName, ACaseSensitive);
  8713. end;
  8714. end;
  8715. {$ENDIF}
  8716. function IndyValueFromIndex(AStrings: TStrings; const AIndex: Integer): String;
  8717. {$IFNDEF HAS_TStrings_ValueFromIndex}
  8718. var
  8719. LTmp: string;
  8720. LPos: Integer;
  8721. {$IFDEF HAS_TStrings_NameValueSeparator}
  8722. LChar: Char;
  8723. {$ENDIF}
  8724. {$ENDIF}
  8725. begin
  8726. {$IFDEF HAS_TStrings_ValueFromIndex}
  8727. Result := AStrings.ValueFromIndex[AIndex];
  8728. {$ELSE}
  8729. Result := '';
  8730. if AIndex >= 0 then
  8731. begin
  8732. LTmp := AStrings.Strings[AIndex];
  8733. {$IFDEF HAS_TStrings_NameValueSeparator}
  8734. // RLebeau 11/8/16: Calling Pos() with a Char as input creates a temporary
  8735. // String. Normally this is fine, but profiling reveils this to be a big
  8736. // bottleneck for code that makes a lot of calls to Pos() in a loop, so we
  8737. // will scan through the string looking for the character without a conversion...
  8738. //
  8739. // LPos := Pos(AStrings.NameValueSeparator, LTmp); {do not localize}
  8740. // if LPos > 0 then begin
  8741. //
  8742. LChar := AStrings.NameValueSeparator;
  8743. for LPos := 1 to Length(LTmp) do begin
  8744. //if CharEquals(LTmp, LPos, LChar) then begin
  8745. if LTmp[LPos] = LChar then begin
  8746. Result := Copy(LTmp, LPos+1, MaxInt);
  8747. Exit;
  8748. end;
  8749. end;
  8750. {$ELSE}
  8751. LPos := Pos('=', LTmp); {do not localize}
  8752. if LPos > 0 then begin
  8753. Result := Copy(LTmp, LPos+1, MaxInt);
  8754. end;
  8755. {$ENDIF}
  8756. end;
  8757. {$ENDIF}
  8758. end;
  8759. {$IFDEF WINDOWS}
  8760. function IndyWindowsMajorVersion: Integer;
  8761. begin
  8762. {$IFDEF WINCE}
  8763. Result := SysUtils.WinCEMajorVersion;
  8764. {$ELSE}
  8765. Result := SysUtils.Win32MajorVersion;
  8766. {$ENDIF}
  8767. end;
  8768. function IndyWindowsMinorVersion: Integer;
  8769. begin
  8770. {$IFDEF WINCE}
  8771. Result := SysUtils.WinCEMinorVersion;
  8772. {$ELSE}
  8773. Result := SysUtils.Win32MinorVersion;
  8774. {$ENDIF}
  8775. end;
  8776. function IndyWindowsBuildNumber: Integer;
  8777. begin
  8778. // for this, you need to strip off some junk to do comparisons
  8779. {$IFDEF WINCE}
  8780. Result := SysUtils.WinCEBuildNumber and $FFFF;
  8781. {$ELSE}
  8782. Result := SysUtils.Win32BuildNumber and $FFFF;
  8783. {$ENDIF}
  8784. end;
  8785. function IndyWindowsPlatform: Integer;
  8786. begin
  8787. {$IFDEF WINCE}
  8788. Result := SysUtils.WinCEPlatform;
  8789. {$ELSE}
  8790. Result := SysUtils.Win32Platform;
  8791. {$ENDIF}
  8792. end;
  8793. function IndyCheckWindowsVersion(const AMajor: Integer; const AMinor: Integer = 0): Boolean;
  8794. var
  8795. LMajor, LMinor: Integer;
  8796. begin
  8797. LMajor := IndyWindowsMajorVersion;
  8798. LMinor := IndyWindowsMinorVersion;
  8799. Result := (LMajor > AMajor) or ((LMajor = AMajor) and (LMinor >= AMinor));
  8800. end;
  8801. {$ENDIF}
  8802. procedure IdDisposeAndNil(var Obj);
  8803. {$IFDEF USE_OBJECT_ARC}
  8804. var
  8805. Temp: {Pointer}TObject;
  8806. {$ENDIF}
  8807. begin
  8808. {$IFDEF USE_OBJECT_ARC}
  8809. // RLebeau: was originally calling DisposeOf() on Obj directly, but nil'ing
  8810. // Obj first prevented the calling code from invoking __ObjRelease() on Obj.
  8811. // Don't do that in ARC. __ObjRelease() needs to be called, even if disposed,
  8812. // to allow the compiler/RTL to finalize Obj so any managed members it has
  8813. // can be cleaned up properly...
  8814. {
  8815. Temp := Pointer(Obj);
  8816. Pointer(Obj) := nil;
  8817. TObject(Temp).DisposeOf;
  8818. }
  8819. Pointer(Temp) := Pointer(Obj);
  8820. Pointer(Obj) := nil;
  8821. Temp.DisposeOf;
  8822. // __ObjRelease() is called when Temp goes out of scope
  8823. {$ELSE}
  8824. FreeAndNil(Obj);
  8825. {$ENDIF}
  8826. end;
  8827. initialization
  8828. // AnsiPos does not handle strings with #0 and is also very slow compared to Pos
  8829. {$IFDEF DOTNET}
  8830. IndyPos := SBPos;
  8831. {$ELSE}
  8832. if LeadBytes = [] then begin
  8833. IndyPos := SBPos;
  8834. end else begin
  8835. IndyPos := InternalAnsiPos;
  8836. end;
  8837. {$ENDIF}
  8838. {$IFDEF DYNAMICLOAD_InterlockedCompareExchange}
  8839. InterlockedCompareExchange := Stub_InterlockedCompareExchange;
  8840. {$ENDIF}
  8841. {$IFDEF WINDOWS}
  8842. GetTickCount64 := Stub_GetTickCount64;
  8843. {$ENDIF}
  8844. {$IFDEF UNIX}
  8845. {$IFDEF OSX}
  8846. mach_timebase_info(GMachTimeBaseInfo);
  8847. {$ENDIF}
  8848. {$ENDIF}
  8849. {$IFNDEF DOTNET}
  8850. finalization
  8851. FreeAndNil(GIdPorts);
  8852. {$ENDIF}
  8853. end.