IdGlobal.pas 326 KB

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