IdGlobal.pas 329 KB

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