IdGlobal.pas 326 KB

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