IdGlobal.pas 325 KB

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