| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424542554265427542854295430543154325433543454355436543754385439544054415442544354445445544654475448544954505451545254535454545554565457545854595460546154625463546454655466546754685469547054715472547354745475547654775478547954805481548254835484548554865487548854895490549154925493549454955496549754985499550055015502550355045505550655075508550955105511551255135514551555165517551855195520552155225523552455255526552755285529553055315532553355345535553655375538553955405541554255435544554555465547554855495550555155525553555455555556555755585559556055615562556355645565556655675568556955705571557255735574557555765577557855795580558155825583558455855586558755885589559055915592559355945595559655975598559956005601560256035604560556065607560856095610561156125613561456155616561756185619562056215622562356245625562656275628562956305631563256335634563556365637563856395640564156425643564456455646564756485649565056515652565356545655565656575658565956605661566256635664566556665667566856695670567156725673567456755676567756785679568056815682568356845685568656875688568956905691569256935694569556965697569856995700570157025703570457055706570757085709571057115712571357145715571657175718571957205721572257235724572557265727572857295730573157325733573457355736573757385739574057415742574357445745574657475748574957505751575257535754575557565757575857595760576157625763576457655766576757685769577057715772577357745775577657775778577957805781578257835784578557865787578857895790579157925793579457955796579757985799580058015802580358045805580658075808580958105811581258135814581558165817581858195820582158225823582458255826582758285829583058315832583358345835583658375838583958405841584258435844584558465847584858495850585158525853585458555856585758585859586058615862586358645865586658675868586958705871587258735874587558765877587858795880588158825883588458855886588758885889589058915892589358945895589658975898589959005901590259035904590559065907590859095910591159125913591459155916591759185919592059215922592359245925592659275928592959305931593259335934593559365937593859395940594159425943594459455946594759485949595059515952595359545955595659575958595959605961596259635964596559665967596859695970597159725973597459755976597759785979598059815982598359845985598659875988598959905991599259935994599559965997599859996000600160026003600460056006600760086009601060116012601360146015601660176018601960206021602260236024602560266027602860296030603160326033603460356036603760386039604060416042604360446045604660476048604960506051605260536054605560566057605860596060606160626063606460656066606760686069607060716072607360746075607660776078607960806081608260836084608560866087608860896090609160926093609460956096609760986099610061016102610361046105610661076108610961106111611261136114611561166117611861196120612161226123612461256126612761286129613061316132613361346135613661376138613961406141614261436144614561466147614861496150615161526153615461556156615761586159616061616162616361646165616661676168616961706171617261736174617561766177617861796180618161826183618461856186618761886189619061916192619361946195619661976198619962006201620262036204620562066207620862096210621162126213621462156216621762186219622062216222622362246225622662276228622962306231623262336234623562366237623862396240624162426243624462456246624762486249625062516252625362546255625662576258625962606261626262636264626562666267626862696270627162726273627462756276627762786279628062816282628362846285628662876288628962906291629262936294629562966297629862996300630163026303630463056306630763086309631063116312631363146315631663176318631963206321632263236324632563266327632863296330633163326333633463356336633763386339634063416342634363446345634663476348634963506351635263536354635563566357635863596360636163626363636463656366636763686369637063716372637363746375637663776378637963806381638263836384638563866387638863896390639163926393639463956396639763986399640064016402640364046405640664076408640964106411641264136414641564166417641864196420642164226423642464256426642764286429643064316432643364346435643664376438643964406441644264436444644564466447644864496450645164526453645464556456645764586459646064616462646364646465646664676468646964706471647264736474647564766477647864796480648164826483648464856486648764886489649064916492649364946495649664976498649965006501650265036504650565066507650865096510651165126513651465156516651765186519652065216522652365246525652665276528652965306531653265336534653565366537653865396540654165426543654465456546654765486549655065516552655365546555655665576558655965606561656265636564656565666567656865696570657165726573657465756576657765786579658065816582658365846585658665876588658965906591659265936594659565966597659865996600660166026603660466056606660766086609661066116612661366146615661666176618661966206621662266236624662566266627662866296630663166326633663466356636663766386639664066416642664366446645664666476648664966506651665266536654665566566657665866596660666166626663666466656666666766686669667066716672667366746675667666776678667966806681668266836684668566866687668866896690669166926693669466956696669766986699670067016702670367046705670667076708670967106711671267136714671567166717671867196720672167226723672467256726672767286729673067316732673367346735673667376738673967406741674267436744674567466747674867496750675167526753675467556756675767586759676067616762676367646765676667676768676967706771677267736774677567766777677867796780678167826783678467856786678767886789679067916792679367946795679667976798679968006801680268036804680568066807680868096810681168126813681468156816681768186819682068216822682368246825682668276828682968306831683268336834683568366837683868396840684168426843684468456846684768486849685068516852685368546855685668576858685968606861686268636864686568666867686868696870687168726873687468756876687768786879688068816882688368846885688668876888688968906891689268936894689568966897689868996900690169026903690469056906690769086909691069116912691369146915691669176918691969206921692269236924692569266927692869296930693169326933693469356936693769386939694069416942694369446945694669476948694969506951695269536954695569566957695869596960696169626963696469656966696769686969697069716972697369746975697669776978697969806981698269836984698569866987698869896990699169926993699469956996699769986999700070017002700370047005700670077008700970107011701270137014701570167017701870197020702170227023702470257026702770287029703070317032703370347035703670377038703970407041704270437044704570467047704870497050705170527053705470557056705770587059706070617062706370647065706670677068706970707071707270737074707570767077707870797080708170827083708470857086708770887089709070917092709370947095709670977098709971007101710271037104710571067107710871097110711171127113711471157116711771187119712071217122712371247125712671277128712971307131713271337134713571367137713871397140714171427143714471457146714771487149715071517152715371547155715671577158715971607161716271637164716571667167716871697170717171727173717471757176717771787179718071817182718371847185718671877188718971907191719271937194719571967197719871997200720172027203720472057206720772087209721072117212721372147215721672177218721972207221722272237224722572267227722872297230723172327233723472357236723772387239724072417242724372447245724672477248724972507251725272537254725572567257725872597260726172627263726472657266726772687269727072717272727372747275727672777278727972807281728272837284728572867287728872897290729172927293729472957296729772987299730073017302730373047305730673077308730973107311731273137314731573167317731873197320732173227323732473257326732773287329733073317332733373347335733673377338733973407341734273437344734573467347734873497350735173527353735473557356735773587359736073617362736373647365736673677368736973707371737273737374737573767377737873797380738173827383738473857386738773887389739073917392739373947395739673977398739974007401740274037404740574067407740874097410741174127413741474157416741774187419742074217422742374247425742674277428742974307431743274337434743574367437743874397440744174427443744474457446744774487449745074517452745374547455745674577458745974607461746274637464746574667467746874697470747174727473747474757476747774787479748074817482748374847485748674877488748974907491749274937494749574967497749874997500750175027503750475057506750775087509751075117512751375147515751675177518751975207521752275237524752575267527752875297530753175327533753475357536753775387539754075417542754375447545754675477548754975507551755275537554755575567557755875597560756175627563756475657566756775687569757075717572757375747575757675777578757975807581758275837584758575867587758875897590759175927593759475957596759775987599760076017602760376047605760676077608760976107611761276137614761576167617761876197620762176227623762476257626762776287629763076317632763376347635763676377638763976407641764276437644764576467647764876497650765176527653765476557656765776587659766076617662766376647665766676677668766976707671767276737674767576767677767876797680768176827683768476857686768776887689769076917692769376947695769676977698769977007701770277037704770577067707770877097710771177127713771477157716771777187719772077217722772377247725772677277728772977307731773277337734773577367737773877397740774177427743774477457746774777487749775077517752775377547755775677577758775977607761776277637764776577667767776877697770777177727773777477757776777777787779778077817782778377847785778677877788778977907791779277937794779577967797779877997800780178027803780478057806780778087809781078117812781378147815781678177818781978207821782278237824782578267827782878297830783178327833783478357836783778387839784078417842784378447845784678477848784978507851785278537854785578567857785878597860786178627863786478657866786778687869787078717872787378747875787678777878787978807881788278837884788578867887788878897890789178927893789478957896789778987899790079017902790379047905790679077908790979107911791279137914791579167917791879197920792179227923792479257926792779287929793079317932793379347935793679377938793979407941794279437944794579467947794879497950795179527953795479557956795779587959796079617962796379647965796679677968796979707971797279737974797579767977797879797980798179827983798479857986798779887989799079917992799379947995799679977998799980008001800280038004800580068007800880098010801180128013801480158016801780188019802080218022802380248025802680278028802980308031803280338034803580368037803880398040804180428043804480458046804780488049805080518052805380548055805680578058805980608061806280638064806580668067806880698070807180728073807480758076807780788079808080818082808380848085808680878088808980908091809280938094809580968097809880998100810181028103810481058106810781088109811081118112811381148115811681178118811981208121812281238124812581268127812881298130813181328133813481358136813781388139814081418142814381448145814681478148814981508151815281538154815581568157815881598160816181628163816481658166816781688169817081718172817381748175817681778178817981808181818281838184818581868187818881898190819181928193819481958196819781988199820082018202820382048205820682078208820982108211821282138214821582168217821882198220822182228223822482258226822782288229823082318232823382348235823682378238823982408241824282438244824582468247824882498250825182528253825482558256825782588259826082618262826382648265826682678268826982708271827282738274827582768277827882798280828182828283828482858286828782888289829082918292829382948295829682978298829983008301830283038304830583068307830883098310831183128313831483158316831783188319832083218322832383248325832683278328832983308331833283338334833583368337833883398340834183428343834483458346834783488349835083518352835383548355835683578358835983608361836283638364836583668367836883698370837183728373837483758376837783788379838083818382838383848385838683878388838983908391839283938394839583968397839883998400840184028403840484058406840784088409841084118412841384148415841684178418841984208421842284238424842584268427842884298430843184328433843484358436843784388439844084418442844384448445844684478448844984508451845284538454845584568457845884598460846184628463846484658466846784688469847084718472847384748475847684778478847984808481848284838484848584868487848884898490849184928493849484958496849784988499850085018502850385048505850685078508850985108511851285138514851585168517851885198520852185228523852485258526852785288529853085318532853385348535853685378538853985408541854285438544854585468547854885498550855185528553855485558556855785588559856085618562856385648565856685678568856985708571857285738574857585768577857885798580858185828583858485858586858785888589859085918592859385948595859685978598859986008601860286038604860586068607860886098610861186128613861486158616861786188619862086218622862386248625862686278628862986308631863286338634863586368637863886398640864186428643864486458646864786488649865086518652865386548655865686578658865986608661866286638664866586668667866886698670867186728673867486758676867786788679868086818682868386848685868686878688868986908691869286938694869586968697869886998700870187028703870487058706870787088709871087118712871387148715871687178718871987208721872287238724872587268727872887298730873187328733873487358736873787388739874087418742874387448745874687478748874987508751875287538754875587568757875887598760876187628763876487658766876787688769877087718772877387748775877687778778877987808781878287838784878587868787878887898790879187928793879487958796879787988799880088018802880388048805880688078808880988108811881288138814881588168817881888198820882188228823882488258826882788288829883088318832883388348835883688378838883988408841884288438844884588468847884888498850885188528853885488558856885788588859886088618862886388648865886688678868886988708871887288738874887588768877887888798880888188828883888488858886888788888889889088918892889388948895889688978898889989008901890289038904890589068907890889098910891189128913891489158916891789188919892089218922892389248925892689278928892989308931893289338934893589368937893889398940894189428943894489458946894789488949895089518952895389548955895689578958895989608961896289638964896589668967896889698970897189728973897489758976897789788979898089818982898389848985898689878988898989908991899289938994899589968997899889999000900190029003900490059006900790089009901090119012901390149015901690179018901990209021902290239024902590269027902890299030903190329033903490359036903790389039904090419042904390449045904690479048904990509051905290539054905590569057905890599060906190629063906490659066906790689069907090719072907390749075907690779078907990809081908290839084908590869087908890899090909190929093909490959096909790989099910091019102910391049105910691079108910991109111911291139114911591169117911891199120912191229123912491259126912791289129913091319132913391349135913691379138913991409141914291439144914591469147914891499150915191529153915491559156915791589159916091619162916391649165916691679168916991709171917291739174917591769177917891799180918191829183918491859186918791889189919091919192919391949195919691979198919992009201920292039204920592069207920892099210921192129213921492159216921792189219922092219222922392249225922692279228922992309231923292339234923592369237923892399240924192429243924492459246924792489249925092519252925392549255925692579258925992609261926292639264926592669267926892699270927192729273927492759276927792789279928092819282928392849285928692879288928992909291929292939294929592969297929892999300930193029303930493059306930793089309931093119312931393149315931693179318931993209321932293239324932593269327932893299330933193329333933493359336933793389339934093419342934393449345934693479348934993509351935293539354935593569357935893599360936193629363936493659366936793689369937093719372937393749375937693779378937993809381938293839384938593869387938893899390939193929393939493959396939793989399940094019402940394049405940694079408940994109411941294139414941594169417941894199420942194229423942494259426942794289429943094319432943394349435943694379438943994409441944294439444944594469447944894499450945194529453945494559456945794589459946094619462946394649465946694679468946994709471947294739474947594769477947894799480948194829483948494859486948794889489949094919492949394949495949694979498949995009501950295039504950595069507950895099510951195129513951495159516951795189519952095219522952395249525952695279528952995309531953295339534953595369537953895399540954195429543954495459546954795489549955095519552955395549555955695579558955995609561956295639564956595669567956895699570957195729573957495759576957795789579958095819582958395849585958695879588958995909591959295939594959595969597959895999600960196029603960496059606960796089609961096119612961396149615961696179618961996209621962296239624962596269627962896299630963196329633963496359636963796389639964096419642964396449645964696479648964996509651965296539654965596569657965896599660966196629663966496659666966796689669967096719672967396749675967696779678967996809681968296839684968596869687968896899690969196929693969496959696969796989699970097019702970397049705970697079708970997109711971297139714971597169717971897199720972197229723972497259726972797289729973097319732973397349735973697379738973997409741974297439744974597469747974897499750975197529753975497559756975797589759976097619762976397649765976697679768976997709771977297739774977597769777977897799780978197829783978497859786978797889789979097919792979397949795979697979798979998009801980298039804980598069807980898099810981198129813981498159816981798189819982098219822982398249825982698279828982998309831983298339834983598369837983898399840984198429843984498459846984798489849985098519852985398549855985698579858985998609861986298639864986598669867986898699870987198729873987498759876987798789879988098819882988398849885988698879888988998909891989298939894989598969897989898999900990199029903990499059906990799089909991099119912991399149915991699179918991999209921992299239924992599269927992899299930993199329933993499359936993799389939994099419942994399449945994699479948994999509951995299539954995599569957995899599960996199629963996499659966996799689969997099719972997399749975997699779978997999809981998299839984998599869987998899899990999199929993999499959996999799989999100001000110002100031000410005100061000710008100091001010011100121001310014100151001610017100181001910020100211002210023100241002510026100271002810029100301003110032100331003410035100361003710038100391004010041100421004310044100451004610047100481004910050100511005210053100541005510056100571005810059100601006110062100631006410065100661006710068100691007010071100721007310074100751007610077100781007910080100811008210083100841008510086100871008810089100901009110092100931009410095100961009710098100991010010101101021010310104 |
- {
- $Project$
- $Workfile$
- $Revision$
- $DateUTC$
- $Id$
- This file is part of the Indy (Internet Direct) project, and is offered
- under the dual-licensing agreement described on the Indy website.
- (http://www.indyproject.org/)
- Copyright:
- (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
- }
- {
- $Log$
- }
- {
- Rev 1.54 2/9/2005 8:45:38 PM JPMugaas
- Should work.
- Rev 1.53 2/8/05 6:37:38 PM RLebeau
- Added default value to ASize parameter of ReadStringFromStream()
- Rev 1.52 2/8/05 5:57:10 PM RLebeau
- added AppendString(), CopyTIdLongWord(), and CopyTIdString() functions
- Rev 1.51 1/31/05 6:01:40 PM RLebeau
- Renamed GetCurrentThreadHandle() to CurrentThreadId() and changed the return
- type from THandle to to TIdPID.
- Reworked conditionals for SetThreadName() and updated the implementation to
- support naming threads under DotNet.
- Rev 1.50 1/27/05 3:40:04 PM RLebeau
- Updated BytesToShort() to actually use the AIndex parameter that was added
- earlier.
- Rev 1.49 1/24/2005 7:35:36 PM JPMugaas
- Foxed ma,e om CopyTIdIPV6Address/
- Rev 1.48 1/17/2005 7:26:44 PM JPMugaas
- Made an IPv6 address byte copy function.
- Rev 1.47 1/15/2005 6:01:38 PM JPMugaas
- Removed some new procedures for extracting int values from a TIdBytes and
- made some other procedures have an optional index paramter.
- Rev 1.46 1/13/05 11:11:20 AM RLebeau
- Changed BytesToRaw() to pass TIdBytes by 'const' rather than by 'var'
- Rev 1.45 1/8/2005 3:56:58 PM JPMugaas
- Added routiens for copying integer values to and from TIdBytes. These are
- useful for some protocols.
- Rev 1.44 24/11/2004 16:26:24 ANeillans
- GetTickCount corrected, as per Paul Cooper's post in
- atozedsoftware.indy.general.
- Rev 1.43 11/13/04 10:47:28 PM RLebeau
- Fixed compiler errors
- Rev 1.42 11/12/04 1:02:42 PM RLebeau
- Added RawToBytesF() and BytesToRaw() functions
- Added asserts to BytesTo...() functions
- Rev 1.41 10/26/2004 8:20:02 PM JPMugaas
- Fixed some oversights with conversion. OOPS!!!
- Rev 1.40 10/26/2004 8:00:54 PM JPMugaas
- Now uses TIdStrings for DotNET portability.
- Rev 1.39 2004.10.26 7:35:16 PM czhower
- Moved IndyCat to CType in IdBaseComponent
- Rev 1.38 24/10/2004 21:29:52 ANeillans
- Corrected error in GetTickCount,
- was Result := Trunc(nTime / (Freq * 1000))
- should be Result := Trunc((nTime / Freq) * 1000)
- Rev 1.37 20/10/2004 01:08:20 CCostelloe
- Bug fix
- Rev 1.36 28.09.2004 20:36:58 Andreas Hausladen
- Works now with Delphi 5
- Rev 1.35 9/23/2004 11:36:04 PM DSiders
- Modified Ticks function (Win32) to correct RangeOverflow error. (Reported by
- Mike Potter)
- Rev 1.34 24.09.2004 02:16:04 Andreas Hausladen
- Added ReadTIdBytesFromStream and ReadCharFromStream function to supress .NET
- warnings.
- Rev 1.33 9/5/2004 2:55:00 AM JPMugaas
- function BytesToWord(const AValue: TIdBytes): Word; was not listed in the
- interface.
- Rev 1.32 04.09.2004 17:12:56 Andreas Hausladen
- New PosIdx function (without pointers)
- Rev 1.31 27.08.2004 22:02:20 Andreas Hausladen
- Speed optimization ("const" for string parameters)
- rewritten PosIdx function with AStartPos = 0 handling
- new ToArrayF() functions (faster in native code because the TIdBytes array
- must have the required len before the ToArrayF function is called)
- Rev 1.30 24.08.2004 19:48:28 Andreas Hausladen
- Some optimizations
- Removed IFDEF for IdDelete and IdInsert
- Rev 1.29 8/17/2004 2:54:08 PM JPMugaas
- Fix compiler warning about widening operends. Int64 can sometimes incur a
- performance penalty.
- Rev 1.28 8/15/04 5:57:06 PM RLebeau
- Tweaks to PosIdx()
- Rev 1.27 7/23/04 10:13:16 PM RLebeau
- Updated ReadStringFromStream() to resize the result using the actual number
- of bytes read from the stream
- Rev 1.26 7/18/2004 2:45:38 PM DSiders
- Added localization comments.
- Rev 1.25 7/9/04 4:25:20 PM RLebeau
- Renamed ToBytes(raw) to RawToBytes() to fix an ambiquity error with
- ToBytes(TIdBytes)
- Rev 1.24 7/9/04 4:07:06 PM RLebeau
- Compiler fix for TIdBaseStream.Write()
- Rev 1.23 09/07/2004 22:17:52 ANeillans
- Fixed IdGlobal.pas(761) Error: ';', ')' or '=' expected but ':=' found
- Rev 1.22 7/8/04 11:56:10 PM RLebeau
- Added additional parameters to BytesToString()
- Bug fix for ReadStringFromStream()
- Updated TIdBaseStream.Write() to use ToBytes()
- Rev 1.21 7/8/04 4:22:36 PM RLebeau
- Added ToBytes() overload for raw pointers under non-DotNet platfoms.
- Rev 1.20 2004.07.03 19:39:38 czhower
- UTF8
- Rev 1.19 6/15/2004 7:18:06 PM JPMugaas
- IdInsert for stuff needing to call the Insert procedure.
- Rev 1.18 2004.06.13 8:06:46 PM czhower
- .NET update
- Rev 1.17 6/11/2004 8:28:30 AM DSiders
- Added "Do not Localize" comments.
- Rev 1.16 2004.06.08 7:11:14 PM czhower
- Typo fix.
- Rev 1.15 2004.06.08 6:34:48 PM czhower
- .NET bug with Ticks workaround.
- Rev 1.14 07/06/2004 21:30:32 CCostelloe
- Kylix 3 changes
- Rev 1.13 5/3/04 12:17:44 PM RLebeau
- Updated ToBytes(string) and BytesToString() under DotNet to use
- System.Text.Encoding.ASCII instead of AnsiEncoding
- Rev 1.12 4/24/04 12:41:36 PM RLebeau
- Conversion support to/from TIdBytes for Char values
- Rev 1.11 4/18/04 2:45:14 PM RLebeau
- Conversion support to/from TIdBytes for Int64 values
- Rev 1.10 2004.04.08 4:50:06 PM czhower
- Comments
- Rev 1.9 2004.04.08 1:45:42 AM czhower
- tiny string optimization
- Rev 1.8 4/7/2004 3:20:50 PM JPMugaas
- PosIdx was not working in DotNET. In DotNET, it was returning a Pos value
- without adding the startvalue -1. It was throwing off the FTP list parsers.
- Two uneeded IFDEF's were removed.
- Rev 1.7 2004.03.13 5:51:28 PM czhower
- Fixed stack overflow in Sleep for .net
- Rev 1.6 3/6/2004 5:16:02 PM JPMugaas
- Bug 67 fixes. Do not write to const values.
- Rev 1.5 3/6/2004 4:54:12 PM JPMugaas
- Write to const bug fix.
- Rev 1.4 2/17/2004 12:02:44 AM JPMugaas
- A few routines that might be needed later for RFC 3490 support.
- Rev 1.3 2/16/2004 1:56:04 PM JPMugaas
- Moved some routines here to lay the groundwork for RFC 3490 support. Started
- work on RFC 3490 support.
- Rev 1.2 2/11/2004 5:12:30 AM JPMugaas
- Moved IPv6 address definition here.
- I also made a function for converting a TIdBytes to an IPv6 address.
- Rev 1.1 2004.02.03 3:15:52 PM czhower
- Updates to move to System.
- Rev 1.0 2004.02.03 2:28:30 PM czhower
- Move
- Rev 1.91 2/1/2004 11:16:04 PM BGooijen
- ToBytes
- Rev 1.90 2/1/2004 1:28:46 AM JPMugaas
- Disabled IdPort functionality in DotNET. It can't work there in it's current
- form and trying to get it to work will introduce more problems than it
- solves. It was only used by the bindings editor and we did something
- different in DotNET so IdPorts wouldn't used there.
- Rev 1.89 2004.01.31 1:51:10 AM czhower
- IndyCast for VB.
- Rev 1.88 30/1/2004 4:47:46 PM SGrobety
- Added "WriteMemoryStreamToStream" to take care of Win32/dotnet difference in
- the TMemoryStream.Memory type and the Write buffer parameter
- Rev 1.87 1/30/2004 11:59:24 AM BGooijen
- Added WriteTIdBytesToStream, because we can convert almost everything to
- TIdBytes, and TIdBytes couldn't be written to streams easily
- Rev 1.86 2004.01.27 11:44:36 PM czhower
- .Net Updates
- Rev 1.85 2004.01.27 8:15:54 PM czhower
- Fixed compile error + .net helper.
- Rev 1.84 27/1/2004 1:55:10 PM SGrobety
- TIdStringStream introduced to fix a bug in DOTNET TStringStream
- implementation.
- Rev 1.83 2004.01.27 1:42:00 AM czhower
- Added parameter check
- Rev 1.82 25/01/2004 21:55:40 CCostelloe
- Added portable IdFromBeginning/FromCurrent/FromEnd, to be used instead of
- soFromBeginning/soBeginning, etc.
- Rev 1.81 24/01/2004 20:18:46 CCostelloe
- Added IndyCompareStr (to be used in place of AnsiCompareStr for .NET
- compatibility)
- Rev 1.80 2004.01.23 9:56:30 PM czhower
- CharIsInSet now checks length and returns false if no character.
- Rev 1.79 2004.01.23 9:49:40 PM czhower
- CharInSet no longer accepts -1, was unneeded and redundant.
- Rev 1.78 1/22/2004 5:47:46 PM SPerry
- fixed CharIsInSet
- Rev 1.77 2004.01.22 5:33:46 PM czhower
- TIdCriticalSection
- Rev 1.76 2004.01.22 3:23:18 PM czhower
- IsCharInSet
- Rev 1.75 2004.01.22 2:00:14 PM czhower
- iif change
- Rev 1.74 14/01/2004 00:17:34 CCostelloe
- Added IndyLowerCase/IndyUpperCase to replace AnsiLowerCase/AnsiUpperCase for
- .NET code
- Rev 1.73 1/11/2004 9:50:54 PM BGooijen
- Added ToBytes function for Socks
- Rev 1.72 2003.12.31 7:32:40 PM czhower
- InMainThread now for .net too.
- Rev 1.71 2003.12.29 6:48:38 PM czhower
- TextIsSame
- Rev 1.70 2003.12.28 1:11:04 PM czhower
- Conditional typo fixed.
- Rev 1.69 2003.12.28 1:05:48 PM czhower
- .Net changes.
- Rev 1.68 5/12/2003 9:11:00 AM GGrieve
- Add WriteStringToStream
- Rev 1.67 5/12/2003 12:32:48 AM GGrieve
- fix DotNet warnings
- Rev 1.66 22/11/2003 12:03:02 AM GGrieve
- fix IdMultiPathFormData.pas implementation
- Rev 1.65 11/15/2003 1:15:36 PM VVassiliev
- Move AppendByte from IdDNSCommon to IdCoreGlobal
- Rev 1.64 10/28/2003 8:43:48 PM BGooijen
- compiles, and removed call to setstring
- Rev 1.63 2003.10.24 10:44:50 AM czhower
- IdStream implementation, bug fixes.
- Rev 1.62 10/18/2003 4:53:18 PM BGooijen
- Added ToHex
- Rev 1.61 2003.10.17 6:17:24 PM czhower
- Some parts moved to stream
- Rev 1.60 10/15/2003 8:28:16 PM DSiders
- Added localization comments.
- Rev 1.59 2003.10.14 9:27:12 PM czhower
- Fixed compile erorr with missing )
- Rev 1.58 10/14/2003 3:31:04 PM SPerry
- Modified ByteToHex() and IPv4ToHex
- Rev 1.57 10/13/2003 5:06:46 PM BGooijen
- Removed local constant IdOctalDigits in favor of the unit constant. - attempt
- 2
- Rev 1.56 10/13/2003 10:07:12 AM DSiders
- Reverted prior change; local constant for IdOctalDigits is restored.
- Rev 1.55 10/12/2003 11:55:42 AM DSiders
- Removed local constant IdOctalDigits in favor of the unit constant.
- Rev 1.54 2003.10.11 5:47:22 PM czhower
- -VCL fixes for servers
- -Chain suport for servers (Super core)
- -Scheduler upgrades
- -Full yarn support
- Rev 1.53 10/8/2003 10:14:34 PM GGrieve
- add WriteStringToStream
- Rev 1.52 10/8/2003 9:55:30 PM GGrieve
- Add IdDelete
- Rev 1.51 10/7/2003 11:33:30 PM GGrieve
- Fix ReadStringFromStream
- Rev 1.50 10/7/2003 10:07:30 PM GGrieve
- Get IdHTTP compiling for DotNet
- Rev 1.49 6/10/2003 5:48:48 PM SGrobety
- DotNet updates
- Rev 1.48 10/5/2003 12:26:46 PM BGooijen
- changed parameter names at some places
- Rev 1.47 10/4/2003 7:08:26 PM BGooijen
- added some conversion routines type->TIdBytes->type, and fixed existing ones
- Rev 1.46 10/4/2003 3:53:40 PM BGooijen
- added some ToBytes functions
- Rev 1.45 04/10/2003 13:38:28 HHariri
- Write(Integer) support
- Rev 1.44 10/3/2003 10:44:54 PM BGooijen
- Added WriteBytesToStream
- Rev 1.43 2003.10.02 8:29:14 PM czhower
- Changed names of byte conversion routines to be more readily understood and
- not to conflict with already in use ones.
- Rev 1.42 10/2/2003 5:15:16 PM BGooijen
- Added Grahame's functions
- Rev 1.41 10/1/2003 8:02:20 PM BGooijen
- Removed some ifdefs and improved code
- Rev 1.40 2003.10.01 9:10:58 PM czhower
- .Net
- Rev 1.39 2003.10.01 2:46:36 PM czhower
- .Net
- Rev 1.38 2003.10.01 2:30:36 PM czhower
- .Net
- Rev 1.37 2003.10.01 12:30:02 PM czhower
- .Net
- Rev 1.35 2003.10.01 1:12:32 AM czhower
- .Net
- Rev 1.34 2003.09.30 7:37:14 PM czhower
- Typo fix.
- Rev 1.33 30/9/2003 3:58:08 PM SGrobety
- More .net updates
- Rev 1.31 2003.09.30 3:19:30 PM czhower
- Updates for .net
- Rev 1.30 2003.09.30 1:22:54 PM czhower
- Stack split for DotNet
- Rev 1.29 2003.09.30 12:09:36 PM czhower
- DotNet changes.
- Rev 1.28 2003.09.30 10:36:02 AM czhower
- Moved stack creation to IdStack
- Added DotNet stack.
- Rev 1.27 9/29/2003 03:03:28 PM JPMugaas
- Changed CIL to DOTNET.
- Rev 1.26 9/28/2003 04:22:00 PM JPMugaas
- IFDEF'ed out MemoryPos in NET because that will not work there.
- Rev 1.25 9/26/03 11:20:50 AM RLebeau
- Updated defines used with SetThreadName() to allow it to work under BCB6.
- Rev 1.24 9/24/2003 11:42:42 PM JPMugaas
- Minor changes to help compile under NET
- Rev 1.23 2003.09.20 10:25:42 AM czhower
- Added comment and chaned for D6 compat.
- Rev 1.22 9/18/2003 07:43:12 PM JPMugaas
- Moved GetThreadHandle to IdGlobals so the ThreadComponent can be in this
- package.
- Rev 1.21 9/8/2003 11:44:38 AM JPMugaas
- Fix for problem that was introduced in an optimization.
- Rev 1.20 2003.08.19 1:54:34 PM czhower
- Removed warning
- Rev 1.19 11/8/2003 6:25:44 PM SGrobety
- IPv4ToDWord: Added overflow checking disabling ($Q+) and changed "* 256" by
- "SHL 8".
- Rev 1.18 2003.07.08 2:41:42 PM czhower
- This time I saved the file before checking in.
- Rev 1.16 7/1/2003 03:39:38 PM JPMugaas
- Started numeric IP function API calls for more efficiency.
- Rev 1.15 2003.07.01 3:49:56 PM czhower
- Added SetThreadName
- Rev 1.14 7/1/2003 12:03:56 AM BGooijen
- Added functions to switch between IPv6 addresses in string and in
- TIdIPv6Address form
- Rev 1.13 6/30/2003 06:33:58 AM JPMugaas
- Fix for range check error.
- Rev 1.12 6/27/2003 04:43:30 PM JPMugaas
- Made IPv4ToDWord overload that returns a flag for an error message.
- Moved MakeCanonicalIPv4Address code into IPv4ToDWord because most of that
- simply reduces IPv4 addresses into a DWord. That also should make the
- function more useful in reducing various alternative forms of IPv4 addresses
- down to DWords.
- Rev 1.11 6/27/2003 01:19:38 PM JPMugaas
- Added MakeCanonicalIPv4Address for converting various IPv4 address forms
- (mentioned at http://www.pc-help.org/obscure.htm) into a standard dotted IP
- address. Hopefully, we should soon support octal and hexidecimal addresses.
- Rev 1.9 6/27/2003 04:36:08 AM JPMugaas
- Function for converting DWord to IP adcdress.
- Rev 1.8 6/26/2003 07:54:38 PM JPMugaas
- Routines for converting standard dotted IPv4 addresses into dword,
- hexidecimal, and octal forms.
- Rev 1.7 5/11/2003 11:57:06 AM BGooijen
- Added RaiseLastOSError
- Rev 1.6 4/28/2003 03:19:00 PM JPMugaas
- Made a function for obtaining the services file FQN. That's in case
- something else besides IdPorts needs it.
- Rev 1.5 2003.04.16 10:06:42 PM czhower
- Moved DebugOutput to IdCoreGlobal
- Rev 1.4 12/29/2002 2:15:30 PM JPMugaas
- GetCurrentThreadHandle function created as per Bas's instructions. Moved
- THandle to IdCoreGlobal for this function.
- Rev 1.3 12-15-2002 17:02:58 BGooijen
- Added comments to TIdExtList
- Rev 1.2 12-15-2002 16:45:42 BGooijen
- Added TIdList
- Rev 1.1 29/11/2002 10:08:50 AM SGrobety Version: 1.1
- Changed GetTickCount to use high-performance timer if available under windows
- Rev 1.0 21/11/2002 12:36:18 PM SGrobety Version: Indy 10
- Rev 1.0 11/13/2002 08:41:24 AM JPMugaas
- }
- unit IdGlobal;
- interface
- {$I IdCompilerDefines.inc}
- uses
- SysUtils,
- {$IFDEF DOTNET}
- System.Collections.Specialized,
- System.net,
- System.net.Sockets,
- System.Diagnostics,
- System.Threading,
- System.IO,
- System.Text,
- {$ELSE}
- {$IFDEF HAS_UNIT_Generics_Collections}
- System.Generics.Collections,
- {$ENDIF}
- {$ENDIF}
- {$IFDEF WINDOWS}
- {$IFDEF FPC}
- windows,
- {$ELSE}
- Windows,
- {$ENDIF}
- {$ENDIF}
- Classes,
- syncobjs,
- {$IFDEF UNIX}
- {$IFDEF KYLIXCOMPAT}
- Libc,
- {$ELSE}
- {$IFDEF FPC}
- DynLibs, // better add DynLibs only for fpc
- {$ENDIF}
- {$IFDEF USE_VCL_POSIX}
- Posix.SysTypes, Posix.Pthread, Posix.Unistd,
- {$ENDIF}
- {$IFDEF USE_BASEUNIX}
- BaseUnix, Unix, Sockets, UnixType,
- {$ENDIF}
- {$IFDEF USE_ICONV_ENC}iconvenc, {$ENDIF}
- {$IFDEF USE_LCONVENC}LConvEncoding, {$ENDIF}
- {$ENDIF}
- {$IFDEF OSX}
- {$IFNDEF FPC}
- //RLebeau: FPC does not provide mach_timebase_info() and mach_absolute_time() yet...
- Macapi.Mach,
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- IdException;
- {$IFNDEF DOTNET}
- {$IFNDEF HAS_PCardinal}
- type
- PCardinal = ^Cardinal;
- {$ENDIF}
- {$ENDIF}
- {$IFDEF HAS_QWord}
- {$IFNDEF HAS_PQWord}
- type
- PQWord = ^QWord;
- {$ENDIF}
- {$ENDIF}
- {$IFNDEF HAS_Int8}
- type
- Int8 = {$IFDEF DOTNET}System.SByte{$ELSE}Shortint{$ENDIF};
- {$NODEFINE Int8}
- {$ENDIF}
- {$IFNDEF HAS_PInt8}
- {$IFNDEF DOTNET}
- type
- PInt8 = PShortint;
- {$NODEFINE PInt8}
- {$ENDIF}
- {$ENDIF}
- {$IFNDEF HAS_UInt8}
- type
- UInt8 = {$IFDEF DOTNET}System.Byte{$ELSE}Byte{$ENDIF};
- {$NODEFINE UInt8}
- {$ENDIF}
- {$IFNDEF HAS_PUInt8}
- {$IFNDEF DOTNET}
- type
- PUInt8 = PByte;
- {$NODEFINE PUInt8}
- {$ENDIF}
- {$ENDIF}
- {$IFNDEF HAS_Int16}
- type
- Int16 = Smallint;
- {$NODEFINE Int16}
- {$ENDIF}
- {$IFNDEF HAS_PInt16}
- {$IFNDEF DOTNET}
- type
- PInt16 = PSmallint;
- {$NODEFINE PInt16}
- {$ENDIF}
- {$ENDIF}
- {$IFNDEF HAS_UInt16}
- type
- UInt16 = Word;
- {$NODEFINE UInt16}
- {$ENDIF}
- {$IFNDEF HAS_PUInt16}
- {$IFNDEF DOTNET}
- type
- PUInt16 = PWord;
- {$NODEFINE PUInt16}
- {$ENDIF}
- {$ENDIF}
- {$IFNDEF HAS_Int32}
- type
- Int32 = Integer;
- {$NODEFINE Int32}
- {$ENDIF}
- {$IFNDEF HAS_PInt32}
- {$IFNDEF DOTNET}
- type
- PInt32 = PInteger;
- {$NODEFINE PInt32}
- {$ENDIF}
- {$ENDIF}
- {$IFNDEF HAS_UInt32}
- type
- UInt32 = Cardinal;
- {$NODEFINE UInt32}
- {$ENDIF}
- {$IFNDEF HAS_PUInt32}
- {$IFNDEF DOTNET}
- type
- PUInt32 = PCardinal;
- {$NODEFINE PUInt32}
- {$ENDIF}
- {$ENDIF}
- {$IFDEF HAS_UInt64}
- {$DEFINE UInt64_IS_NATIVE}
- // In C++Builder 2006 and 2007, UInt64 is emitted as signed __int64 in HPP
- // files instead of as unsigned __int64. This causes conflicts in overloaded
- // routines that have (U)Int64 parameters. This was fixed in C++Builder 2009...
- {$IFNDEF TIdUInt64_HAS_QuadPart}
- type
- TIdUInt64 = UInt64;
- {$ENDIF}
- {$ELSE}
- {$IFDEF HAS_QWord}
- {$DEFINE UInt64_IS_NATIVE}
- type
- UInt64 = QWord;
- {$NODEFINE UInt64}
- TIdUInt64 = QWord;
- {$ELSE}
- type
- UInt64 = Int64;
- {$NODEFINE UInt64}
- {$ENDIF}
- {$ENDIF}
- {$IFDEF HAS_UInt64}
- {$IFNDEF HAS_PUInt64}
- type
- PUInt64 = ^UInt64;
- {$ENDIF}
- {$ELSE}
- type
- PUInt64 = {$IFDEF HAS_QWord}PQWord{$ELSE}PInt64{$ENDIF};
- {$ENDIF}
- {$IFDEF TIdUInt64_HAS_QuadPart}
- // For compilers that do not have a native UInt64 type, or for C++Builder
- // 2006/2007 with its broken UInt64 HPP emit, let's define a record type
- // that can hold UInt64 values, and then use it wherever UInt64 parameters
- // are needed...
- type
- TIdUInt64 = packed record
- case Integer of
- 0: (
- {$IFDEF ENDIAN_BIG}
- HighPart: UInt32;
- LowPart: UInt32
- {$ELSE}
- LowPart: UInt32;
- HighPart: UInt32
- {$ENDIF}
- );
- 1: (
- QuadPart: UInt64
- );
- end;
- {$NODEFINE TIdUInt64}
- {$IFDEF HAS_DIRECTIVE_HPPEMIT_NAMESPACE}
- {$HPPEMIT OPENNAMESPACE}
- {$ELSE}
- (*$HPPEMIT 'namespace Idglobal'*)
- (*$HPPEMIT '{'*)
- {$ENDIF}
- (*$HPPEMIT ' #pragma pack(push, 1)' *)
- (*$HPPEMIT ' struct TIdUInt64'*)
- (*$HPPEMIT ' {'*)
- (*$HPPEMIT ' union {'*)
- (*$HPPEMIT ' struct {'*)
- // TODO: move the endian check to the C++ side using #if...
- {$IFDEF ENDIAN_BIG}
- (*$HPPEMIT ' unsigned __int32 HighPart;'*)
- (*$HPPEMIT ' unsigned __int32 LowPart;'*)
- {$ELSE}
- (*$HPPEMIT ' unsigned __int32 LowPart;'*)
- (*$HPPEMIT ' unsigned __int32 HighPart;'*)
- {$ENDIF}
- (*$HPPEMIT ' };'*)
- (*$HPPEMIT ' unsigned __int64 QuadPart;'*)
- (*$HPPEMIT ' };'*)
- (*$HPPEMIT ' TIdUInt64(unsigned __int64 value) { QuadPart = value; }'*)
- (*$HPPEMIT ' operator unsigned __int64() const { return QuadPart; }'*)
- (*$HPPEMIT ' TIdUInt64& operator=(unsigned __int64 value) { QuadPart = value; return *this; }'*)
- (*$HPPEMIT ' };'*)
- (*$HPPEMIT ' #pragma pack(pop)' *)
- {$IFDEF HAS_DIRECTIVE_HPPEMIT_NAMESPACE}
- {$HPPEMIT CLOSENAMESPACE}
- {$ELSE}
- (*$HPPEMIT '}'*)
- {$ENDIF}
- {$ENDIF}
- const
- {This is the only unit with references to OS specific units and IFDEFs. NO OTHER units
- are permitted to do so except .pas files which are counterparts to dfm/xfm files, and only for
- support of that.}
- //We make the version things an Inc so that they can be managed independantly
- //by the package builder.
- {$I IdVers.inc}
- {$IFNDEF HAS_TIMEUNITS}
- HoursPerDay = 24;
- MinsPerHour = 60;
- SecsPerMin = 60;
- MSecsPerSec = 1000;
- MinsPerDay = HoursPerDay * MinsPerHour;
- SecsPerDay = MinsPerDay * SecsPerMin;
- MSecsPerDay = SecsPerDay * MSecsPerSec;
- {$ENDIF}
- {$IFDEF DOTNET}
- // Timeout.Infinite is -1 which violates Cardinal which VCL uses for parameter
- // so we are just setting it to this as a hard coded constant until
- // the synchro classes and other are all ported directly to portable classes
- // (SyncObjs is platform specific)
- //Infinite = Timeout.Infinite;
- INFINITE = UInt32($FFFFFFFF); { Infinite timeout }
- {$ENDIF}
- // FPC's DynLibs unit is not included in this unit's interface 'uses' clause on
- // all platforms, so map to what DynLibs.NilHandle maps to...
- {$IFDEF FPC}
- IdNilHandle = {DynLibs.NilHandle}{$IFDEF WINDOWS}PtrUInt(0){$ELSE}PtrInt(0){$ENDIF};
- {$ELSE}
- IdNilHandle = THandle(0);
- {$ENDIF}
- LF = #10;
- CR = #13;
- // RLebeau: EOL is NOT to be used as a platform-specific line break! Most
- // text-based protocols that Indy implements are defined to use CRLF line
- // breaks. DO NOT change this! If you need a platform-based line break,
- // use sLineBreak instead.
- EOL = CR + LF;
- //
- CHAR0 = #0;
- BACKSPACE = #8;
- TAB = #9;
- CHAR32 = #32;
- //Timeout values
- IdTimeoutDefault = -1;
- IdTimeoutInfinite = -2;
- //Fetch Defaults
- IdFetchDelimDefault = ' '; {Do not Localize}
- IdFetchDeleteDefault = True;
- IdFetchCaseSensitiveDefault = True;
- IdWhiteSpace = [0..12, 14..32]; {do not localize}
- 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}
- IdOctalDigits: array [0..7] of Char = ('0','1','2','3','4','5','6','7'); {do not localize}
- IdHexPrefix = '0x'; {Do not translate}
- type
- //thread and PID stuff
- {$IFDEF DOTNET}
- TIdPID = UInt32;
- TIdThreadId = UInt32;
- TIdThreadHandle = System.Threading.Thread;
- {$IFDEF DOTNETDISTRO}
- TIdThreadPriority = System.Threading.ThreadPriority;
- {$ELSE}
- TIdThreadPriority = TThreadPriority;
- {$ENDIF}
- {$ENDIF}
- {$IFDEF UNIX}
- {$IFDEF KYLIXCOMPAT}
- TIdPID = Int32;
- TIdThreadId = Int32;
- {$IFDEF FPC}
- TIdThreadHandle = TThreadID;
- {$ELSE}
- TIdThreadHandle = UInt32;
- {$ENDIF}
- {$IFDEF INT_THREAD_PRIORITY}
- TIdThreadPriority = -20..19;
- {$ELSE}
- TIdThreadPriority = TThreadPriority;
- {$ENDIF}
- {$ENDIF}
- {$IFDEF USE_BASEUNIX}
- TIdPID = TPid;
- TIdThreadId = TThreadId;
- TIdThreadHandle = TIdThreadId;
- TIdThreadPriority = TThreadPriority;
- {$ENDIF}
- {$IFDEF USE_VCL_POSIX}
- TIdPID = pid_t;
- TIdThreadId = NativeUInt;
- TIdThreadHandle = NativeUInt;
- {$IFDEF INT_THREAD_PRIORITY}
- TIdThreadPriority = -20..19;
- {$ELSE}
- TIdThreadPriority = TThreadPriority;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$IFDEF WINDOWS}
- TIdPID = UInt32;
- TIdThreadId = UInt32;
- TIdThreadHandle = THandle;
- {$I IdSymbolPlatformOff.inc}
- TIdThreadPriority = TThreadPriority;
- {$I IdSymbolPlatformOn.inc}
- {$ENDIF}
- TIdTicks = UInt64;
- {$IFDEF INT_THREAD_PRIORITY}
- const
- // approximate values, its finer grained on Linux
- tpIdle = 19;
- tpLowest = 12;
- tpLower = 6;
- tpNormal = 0;
- tpHigher = -7;
- tpHighest = -13;
- tpTimeCritical = -20;
- {$ENDIF}
- {CH tpIdLowest = tpLowest; }
- {CH tpIdBelowNormal = tpLower; }
- {CH tpIdNormal = tpNormal; }
- {CH tpIdAboveNormal = tpHigher; }
- {CH tpIdHighest = tpHighest; }
- //end thread stuff
- const
- //leave this as zero. It's significant in many socket calls that specify ports
- DEF_PORT_ANY = 0;
- type
- {$IFDEF DOTNET}
- TIdUnicodeString = System.String;
- {$ELSE}
- {$IFDEF HAS_UnicodeString}
- TIdUnicodeString = UnicodeString;
- {$ELSE}
- TIdUnicodeString = WideString;
- // RP 9/12/2014: Synopse just released a unit that patches the System unit
- // in pre-Unicode versions of Delphi to redirect WideString memory management
- // to the RTL's memory manager (FastMM, etc) instead of the Win32 COM API!
- //
- // http://blog.synopse.info/post/2014/09/12/Faster-WideString-process-for-good-old-non-Unicode-Delphi-6-2007
- // https://github.com/synopse/mORMot/blob/master/SynFastWideString.pas
- //
- // We should consider providing an optional setting to enable that patch
- // so we can get a performance boost for Unicode-enabled code that uses
- // TIdUnicodeString...
- {$ENDIF}
- {$ENDIF}
- // the Delphi next-gen compiler eliminates AnsiString/AnsiChar/PAnsiChar,
- // but we still need to deal with Ansi data. Unfortunately, the compiler
- // won't let us use its secret _AnsiChr types either, so we have to use
- // Byte instead unless we can find a better solution...
- {$IFDEF HAS_AnsiChar}
- TIdAnsiChar = AnsiChar;
- {$ELSE}
- TIdAnsiChar = Byte;
- {$ENDIF}
- {$IFDEF HAS_PAnsiChar}
- PIdAnsiChar = PAnsiChar;
- {$ELSE}
- {$IFDEF HAS_MarshaledAString}
- PIdAnsiChar = MarshaledAString;
- {$ELSE}
- PIdAnsiChar = PByte;
- {$ENDIF}
- {$ENDIF}
- {$IFDEF HAS_PPAnsiChar}
- PPIdAnsiChar = PPAnsiChar;
- {$ELSE}
- PPIdAnsiChar = ^PIdAnsiChar;
- {$ENDIF}
- {$IFDEF HAS_SetCodePage}
- {$IFNDEF HAS_PRawByteString}
- {$EXTERNALSYM PRawByteString}
- PRawByteString = ^RawByteString;
- {$ENDIF}
- {$ENDIF}
- {$IFDEF STRING_IS_UNICODE}
- TIdWideChar = Char;
- PIdWideChar = PChar;
- {$ELSE}
- TIdWideChar = WideChar;
- PIdWideChar = PWideChar;
- {$ENDIF}
- {$IFDEF WINDOWS}
- // .NET and Delphi 2009+ support UNICODE strings natively!
- //
- // FreePascal 2.4.0+ supports UnicodeString, but does not map its native
- // String type to UnicodeString except when {$MODE DelphiUnicode} or
- // {$MODESWITCH UnicodeStrings} is enabled. However, UNICODE is not
- // defined in that mode yet until FreePascal's RTL has been updated to
- // support UnicodeString. STRING_UNICODE_MISMATCH is defined in
- // IdCompilerDefines.inc when the compiler's native String/Char types do
- // not map to the same types that API functions are expecting based on
- // whether UNICODE is defined or not. So we will create special Platform
- // typedefs here to help with API function calls when dealing with that
- // mismatch...
- {$IFDEF UNICODE}
- TIdPlatformString = TIdUnicodeString;
- TIdPlatformChar = TIdWideChar;
- PIdPlatformChar = PIdWideChar;
- {$ELSE}
- TIdPlatformString = AnsiString;
- TIdPlatformChar = TIdAnsiChar;
- PIdPlatformChar = PIdAnsiChar;
- {$ENDIF}
- {$ENDIF}
- TIdBytes = array of Byte;
- TIdWideChars = array of TIdWideChar;
- //NOTE: The code below assumes a 32bit Linux architecture (such as target i386-linux)
- {$UNDEF CPU32_OR_KYLIX}
- {$IFNDEF DOTNET}
- {$IFDEF CPU32}
- {$DEFINE CPU32_OR_KYLIX}
- {$ENDIF}
- {$IFDEF KYLIX}
- {$DEFINE CPU32_OR_KYLIX}
- {$ENDIF}
- {$ENDIF}
- // native signed and unsigned integer sized pointer types
- {$IFDEF DOTNET}
- TIdNativeInt = IntPtr;
- TIdNativeUInt = UIntPtr;
- {$ELSE}
- {$IFDEF HAS_NativeInt}
- TIdNativeInt = NativeInt;
- {$ELSE}
- {$IFDEF CPU32}
- TIdNativeInt = Int32;
- {$ENDIF}
- {$IFDEF CPU64}
- TIdNativeInt = Int64;
- {$ENDIF}
- {$ENDIF}
- {$IFDEF HAS_NativeUInt}
- TIdNativeUInt = NativeUInt;
- {$ELSE}
- {$IFDEF CPU32}
- TIdNativeUInt = UInt32;
- {$ENDIF}
- {$IFDEF CPU64}
- TIdNativeUInt = UInt64;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$IFNDEF HAS_PtrInt}
- PtrInt = TIdNativeInt;
- {$ENDIF}
- {$IFNDEF HAS_PtrUInt}
- PtrUInt = TIdNativeUInt;
- {$ENDIF}
- {$IFDEF STREAM_SIZE_64}
- TIdStreamSize = Int64;
- {$ELSE}
- TIdStreamSize = Int32;
- {$ENDIF}
- {$IFNDEF HAS_SIZE_T}
- {$EXTERNALSYM size_t}
- size_t = PtrUInt;
- {$ENDIF}
- {$IFNDEF HAS_PSIZE_T}
- {$EXTERNALSYM Psize_t}
- Psize_t = ^size_t;
- {$ENDIF}
- // RLebeau 12/1/2018: FPC's System unit defines an HMODULE type as a PtrUInt. But,
- // the DynLibs unit defines its own HModule type that is a TLibHandle, which is a
- // PtrInt instead. And to make matters worse, although FPC's System.THandle is a
- // platform-dependant type, it is not always defined as 8 bytes on 64bit platforms
- // (https://bugs.freepascal.org/view.php?id=21669), which has been known to cause
- // overflows when dynamic libraries are loaded at high addresses! (FPC bug?) So,
- // we can't rely on THandle to hold correct handles for libraries that we load
- // dynamically at runtime (which is probably why FPC defines TLibHandle in the first
- // place, but why is it signed instead of unsigned?).
- //
- // Delphi's HMODULE is a System.THandle, which is a NativeUInt, and so is defined
- // with a proper byte size across all 32bit and 64bit platforms.
- //
- // Since (Safe)LoadLibrary(), GetProcAddress(), etc all use TLibHandle in FPC, but
- // use HMODULE in Delphi. this does mean we have a small descrepency between using
- // signed vs unsigned library handles. I would prefer to use unsigned everywhere,
- // but we should use what is more natural for each compiler...
- // FPC's DynLibs unit is not included in this unit's interface 'uses' clause on all
- // platforms, so map to what DynLibs.TLibHandle maps to...
- // RLebeau 4/29/2020: to make metters worse, FPC defines TLibHandle as System.THandle
- // on Windows, not as PtrInt as previously observed! And FPC's Windows.GetProcAddress()
- // uses HINST, which is also defined as System.THandle. But, as we know from above,
- // FPC's System.THandle has problems on some 64bit systems! But does that apply on
- // Windows? I THINK the latest FPC uses QWord/DWord (aka PtrUInt) for all Windows
- // platforms, which is good...
- {$IFDEF FPC}
- // TODO: use the THANDLE_(32|64|CPUBITS) defines in IdCompilerDefines.inc to decide
- // how to define TIdLibHandle when not using the DynLibs unit?
- TIdLibHandle = {DynLibs.TLibHandle}{$IFDEF WINDOWS}PtrUInt{$ELSE}PtrInt{$ENDIF};
- {$ELSE}
- TIdLibHandle = THandle;
- {$ENDIF}
- { IMPORTANT!!!
- WindowsCE only has a Unicode (WideChar) version of GetProcAddress. We could use
- a version of GetProcAddress in the FreePascal dynlibs unit but that does a
- conversion from ASCII to Unicode which might not be necessary since most calls
- pass a constant anyway.
- }
- {$IFDEF WINCE}
- TIdLibFuncName = TIdUnicodeString;
- PIdLibFuncNameChar = PWideChar;
- {$ELSE}
- TIdLibFuncName = String;
- PIdLibFuncNameChar = PChar;
- {$ENDIF}
- {$IFDEF STRING_IS_IMMUTABLE}
- // In .NET and Delphi next-gen, strings are immutable (and zero-indexed), so we
- // need to use a StringBuilder whenever we need to modify individual characters
- // of a string...
- TIdStringBuilder = {$IFDEF DOTNET}System.Text.StringBuilder{$ELSE}TStringBuilder{$ENDIF};
- {$ENDIF}
- {
- Delphi/C++Builder 2009+ have a TEncoding class which mirrors System.Text.Encoding
- in .NET, but does not have a TDecoder class which mirrors System.Text.Decoder
- in .NET. TEncoding's interface changes from version to version, in some ways
- that cause compatibility issues when trying to write portable code, so we will
- not rely on it. IIdTextEncoding is our own wrapper so we have control over
- text encodings.
- This way, Indy can have a unified internal interface for String<->Byte conversions
- without using IFDEFs everywhere.
- Note: Having the wrapper class use WideString in earlier versions adds extra
- overhead to string operations, but this is the only way to ensure that strings
- are encoded properly. Later on, perhaps we can optimize the operations when
- Ansi-compatible encodings are being used with AnsiString values.
- }
- {$IFNDEF HAS_IInterface}
- IInterface = IUnknown;
- {$ENDIF}
- IIdTextEncoding = interface(IInterface)
- ['{FA87FAE5-E3E3-4632-8FCA-2FB786848655}']
- function GetByteCount(const AChars: TIdWideChars): Integer; overload;
- function GetByteCount(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): Integer; overload;
- {$IFNDEF DOTNET}
- function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; overload;
- {$ENDIF}
- function GetByteCount(const AStr: TIdUnicodeString): Integer; overload;
- function GetByteCount(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): Integer; overload;
- function GetBytes(const AChars: TIdWideChars): TIdBytes; overload;
- function GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): TIdBytes; overload;
- function GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
- {$IFNDEF DOTNET}
- function GetBytes(const AChars: PIdWideChar; ACharCount: Integer): TIdBytes; overload;
- function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
- function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; overload;
- {$ENDIF}
- function GetBytes(const AStr: TIdUnicodeString): TIdBytes; overload;
- function GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): TIdBytes; overload;
- function GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
- function GetCharCount(const ABytes: TIdBytes): Integer; overload;
- function GetCharCount(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): Integer; overload;
- {$IFNDEF DOTNET}
- function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; overload;
- {$ENDIF}
- function GetChars(const ABytes: TIdBytes): TIdWideChars; overload;
- function GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdWideChars; overload;
- function GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer; overload;
- {$IFNDEF DOTNET}
- function GetChars(const ABytes: PByte; AByteCount: Integer): TIdWideChars; overload;
- function GetChars(const ABytes: PByte; AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer; overload;
- function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; overload;
- {$ENDIF}
- function GetIsSingleByte: Boolean;
- function GetMaxByteCount(ACharCount: Integer): Integer;
- function GetMaxCharCount(AByteCount: Integer): Integer;
- function GetPreamble: TIdBytes;
- function GetString(const ABytes: TIdBytes): TIdUnicodeString; overload;
- function GetString(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdUnicodeString; overload;
- {$IFNDEF DOTNET}
- function GetString(const ABytes: PByte; AByteCount: Integer): TIdUnicodeString; overload;
- {$ENDIF}
- property IsSingleByte: Boolean read GetIsSingleByte;
- end;
- IdTextEncodingType = (encIndyDefault, encOSDefault, enc8Bit, encASCII, encUTF16BE, encUTF16LE, encUTF7, encUTF8);
- function IndyTextEncoding(AType: IdTextEncodingType): IIdTextEncoding; overload;
- function IndyTextEncoding(ACodepage: UInt16): IIdTextEncoding; overload;
- function IndyTextEncoding(const ACharSet: String): IIdTextEncoding; overload;
- {$IFDEF DOTNET}
- function IndyTextEncoding(AEncoding: System.Text.Encoding): IIdTextEncoding; overload;
- {$ENDIF}
- {$IFDEF HAS_TEncoding}
- function IndyTextEncoding(AEncoding: TEncoding; AFreeEncoding: Boolean = False): IIdTextEncoding; overload;
- {$ENDIF}
- function IndyTextEncoding_Default: IIdTextEncoding;
- function IndyTextEncoding_OSDefault: IIdTextEncoding;
- function IndyTextEncoding_8Bit: IIdTextEncoding;
- function IndyTextEncoding_ASCII: IIdTextEncoding;
- function IndyTextEncoding_UTF16BE: IIdTextEncoding;
- function IndyTextEncoding_UTF16LE: IIdTextEncoding;
- function IndyTextEncoding_UTF7: IIdTextEncoding;
- function IndyTextEncoding_UTF8: IIdTextEncoding;
- // These are for backwards compatibility with past Indy 10 releases
- function enDefault: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_Default() or a nil IIdTextEncoding pointer'{$ENDIF};{$ENDIF}
- {$NODEFINE enDefault}
- function en7Bit: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_ASCII()'{$ENDIF};{$ENDIF}
- {$NODEFINE en7Bit}
- function en8Bit: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_8Bit()'{$ENDIF};{$ENDIF}
- {$NODEFINE en8Bit}
- function enUTF8: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_UTF8()'{$ENDIF};{$ENDIF}
- {$NODEFINE enUTF8}
- function Indy8BitEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_8Bit()'{$ENDIF};{$ENDIF}
- function IndyASCIIEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_ASCII()'{$ENDIF};{$ENDIF}
- function IndyUTF16BigEndianEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_UTF16BE()'{$ENDIF};{$ENDIF}
- function IndyUTF16LittleEndianEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_UTF16LE()'{$ENDIF};{$ENDIF}
- function IndyOSDefaultEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_OSDefault()'{$ENDIF};{$ENDIF}
- function IndyUTF7Encoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_UTF7()'{$ENDIF};{$ENDIF}
- function IndyUTF8Encoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IndyTextEncoding_UTF8()'{$ENDIF};{$ENDIF}
- (*$HPPEMIT '// These are helper macros to handle differences between C++Builder versions'*)
- (*$HPPEMIT '#define TIdTextEncoding_ASCII IndyTextEncoding_ASCII()'*)
- (*$HPPEMIT '#define TIdTextEncoding_BigEndianUnicode IndyTextEncoding_UTF16BE()'*)
- (*$HPPEMIT '#define TIdTextEncoding_Default IndyTextEncoding_OSDefault()'*)
- (*$HPPEMIT '#define TIdTextEncoding_Unicode IndyTextEncoding_UTF16LE()'*)
- (*$HPPEMIT '#define TIdTextEncoding_UTF7 IndyTextEncoding_UTF7()'*)
- (*$HPPEMIT '#define TIdTextEncoding_UTF8 IndyTextEncoding_UTF8()'*)
- (*$HPPEMIT ''*)
- (*$HPPEMIT '// These are for backwards compatibility with earlier Indy 10 releases'*)
- (*$HPPEMIT '#define enDefault ( ( IIdTextEncoding* )NULL )'*)
- (*$HPPEMIT '#define en8Bit IndyTextEncoding_8Bit()'*)
- (*$HPPEMIT '#define en7Bit IndyTextEncoding_ASCII()'*)
- (*$HPPEMIT '#define enUTF8 IndyTextEncoding_UTF8()'*)
- (*$HPPEMIT ''*)
- var
- {RLebeau: using ASCII by default because most Internet protocols that Indy
- implements are based on ASCII specifically, not Ansi. Non-ASCII data has
- to be explicitally allowed by RFCs, in which case the caller should not be
- using nil IIdTextEncoding objects to begin with...}
- GIdDefaultTextEncoding: IdTextEncodingType = encASCII;
- {$IFDEF USE_ICONV}
- // This indicates whether encOSDefault should map to an OS dependant Ansi
- // locale or to ASCII. Defaulting to ASCII for now to maintain compatibility
- // with earlier Indy 10 releases...
- GIdIconvUseLocaleDependantAnsiEncoding: Boolean = False;
- // This indicates whether Iconv should ignore characters that cannot be
- // converted. Defaulting to false for now to maintain compatibility with
- // earlier Indy 10 releases...
- GIdIconvIgnoreIllegalChars: Boolean = False;
- // This indicates whether Iconv should transliterate characters that cannot
- // be converted. Defaulting to false for now to maintain compatibility with
- // earlier Indy 10 releases...
- GIdIconvUseTransliteration: Boolean = False;
- {$ENDIF}
- procedure EnsureEncoding(var VEncoding : IIdTextEncoding; ADefEncoding: IdTextEncodingType = encIndyDefault);
- procedure CheckByteEncoding(var VBytes: TIdBytes; ASrcEncoding, ADestEncoding: IIdTextEncoding);
- {$IFNDEF DOTNET}
- function GetEncodingCodePage(AEncoding: IIdTextEncoding): UInt16;
- {$ENDIF}
- type
- TIdAppendFileStream = class(TFileStream)
- public
- constructor Create(const AFile : String);
- end;
- TIdReadFileExclusiveStream = class(TFileStream)
- public
- constructor Create(const AFile : String);
- end;
- TIdReadFileNonExclusiveStream = class(TFileStream)
- public
- constructor Create(const AFile : String);
- end;
- TIdFileCreateStream = class(TFileStream)
- public
- constructor Create(const AFile : String);
- end;
- {$IFDEF DOTNET}
- {$IFNDEF DOTNET_2_OR_ABOVE}
- // dotNET implementation
- TWaitResult = (wrSignaled, wrTimeout, wrAbandoned, wrError);
- TEvent = class(TObject)
- protected
- FEvent: WaitHandle;
- public
- constructor Create(EventAttributes: IntPtr; ManualReset,
- InitialState: Boolean; const Name: string = ''); overload;
- constructor Create; overload;
- destructor Destroy; override;
- procedure SetEvent;
- procedure ResetEvent;
- function WaitFor(Timeout: UInt32): TWaitResult; virtual;
- end;
- TCriticalSection = class(TObject)
- public
- procedure Acquire; virtual;
- procedure Release; virtual;
- function TryEnter: Boolean;
- procedure Enter;
- procedure Leave;
- end;
- {$ENDIF}
- {$ELSE}
- {$IFNDEF NO_REDECLARE}
- // TCriticalSection = SyncObjs.TCriticalSection;
- {$ENDIF}
- {$ENDIF}
- TIdLocalEvent = class(TEvent)
- public
- constructor Create(const AInitialState: Boolean = False;
- const AManualReset: Boolean = False); reintroduce;
- function WaitForEver: TWaitResult; overload;
- end;
- // This is here to reduce all the warnings about imports. We may also ifdef
- // it to provide a non warning implementatino on this unit too later.
- TIdCriticalSection = class(TCriticalSection)
- end;
- //Only needed for ToBytes(Short) and BytesToShort
- {$IFDEF DOTNET}
- Short = System.Int16 {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use Int16'{$ENDIF}{$ENDIF};
- {$ENDIF}
- {$IFDEF UNIX}
- Short = Int16 {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use Int16'{$ENDIF}{$ENDIF};
- {$ENDIF}
- {$IFNDEF DOTNET}
- {$IFNDEF NO_REDECLARE}
- PShort = ^Short;
- {$ENDIF}
- {$ENDIF}
- //This usually is a property editor exception
- EIdCorruptServicesFile = class(EIdException);
- EIdEndOfStream = class(EIdException);
- EIdInvalidIPv6Address = class(EIdException);
- EIdNoEncodingSpecified = class(EIdException);
- //This is called whenever there is a failure to retreive the time zone information
- EIdFailedToRetreiveTimeZoneInfo = class(EIdException);
- TIdPort = UInt16;
- //We don't have a native type that can hold an IPv6 address.
- {$NODEFINE TIdIPv6Address}
- TIdIPv6Address = array [0..7] of UInt16;
- // C++ does not allow an array to be returned by a function,
- // so wrapping the array in a struct as a workaround...
- //
- // This is one place where Word is being used instead of UInt16.
- // On OSX/iOS, UInt16 is defined in mactypes.h, not in System.hpp!
- // don't want to use a bunch of IFDEF's trying to figure out where
- // UInt16 is coming from...
- //
- {$IFDEF HAS_DIRECTIVE_HPPEMIT_NAMESPACE}
- {$HPPEMIT OPENNAMESPACE}
- {$ELSE}
- (*$HPPEMIT 'namespace Idglobal'*)
- (*$HPPEMIT '{'*)
- {$ENDIF}
- (*$HPPEMIT ' struct TIdIPv6Address'*)
- (*$HPPEMIT ' {'*)
- (*$HPPEMIT ' ::System::Word data[8];'*)
- (*$HPPEMIT ' ::System::Word& operator[](int index) { return data[index]; }'*)
- (*$HPPEMIT ' const ::System::Word& operator[](int index) const { return data[index]; }'*)
- (*$HPPEMIT ' operator const ::System::Word*() const { return data; }'*)
- (*$HPPEMIT ' operator ::System::Word*() { return data; }'*)
- (*$HPPEMIT ' };'*)
- {$IFDEF HAS_DIRECTIVE_HPPEMIT_NAMESPACE}
- {$HPPEMIT CLOSENAMESPACE}
- {$ELSE}
- (*$HPPEMIT '}'*)
- {$ENDIF}
- {This way instead of a boolean for future expansion of other actions}
- TIdMaxLineAction = (maException, maSplit);
- TIdOSType = (otUnknown, otUnix, otWindows, otDotNet);
- //This is for IPv6 support when merged into the core
- TIdIPVersion = (Id_IPv4, Id_IPv6);
- {$IFNDEF NO_REDECLARE}
- {$IFDEF LINUX}
- {$IFNDEF VCL_6_OR_ABOVE}
- THandle = UInt32; //D6.System
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$IFDEF DOTNET}
- THandle = Int32;
- {$ELSE}
- {$IFDEF WINDOWS}
- // THandle = Windows.THandle;
- {$ENDIF}
- {$ENDIF}
- TPosProc = function(const substr, str: String): Integer;
- {$IFNDEF DOTNET}
- TStrScanProc = function(Str: PChar; Chr: Char): PChar;
- {$ENDIF}
- TIdReuseSocket = (rsOSDependent, rsTrue, rsFalse);
- {$IFNDEF STREAM_SIZE_64}
- type
- TSeekOrigin = (soBeginning, soCurrent, soEnd);
- {$ENDIF}
- // TIdBaseStream is defined here to allow TIdMultiPartFormData to be defined
- // without any $IFDEFs in the unit IdMultiPartFormData - in accordance with Indy Coding rules
- TIdBaseStream = class(TStream)
- protected
- function IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint; virtual; abstract;
- function IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint; virtual; abstract;
- function IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; virtual; abstract;
- procedure IdSetSize(ASize: Int64); virtual; abstract;
- {$IFDEF DOTNET}
- procedure SetSize(ASize: Int64); override;
- {$ELSE}
- {$IFDEF STREAM_SIZE_64}
- procedure SetSize(const NewSize: Int64); override;
- {$ELSE}
- procedure SetSize(ASize: Integer); override;
- {$ENDIF}
- {$ENDIF}
- public
- {$IFDEF DOTNET}
- function Read(var VBuffer: array of Byte; AOffset, ACount: Longint): Longint; override;
- function Write(const ABuffer: array of Byte; AOffset, ACount: Longint): Longint; override;
- function Seek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; override;
- {$ELSE}
- function Read(var Buffer; Count: Longint): Longint; override;
- function Write(const Buffer; Count: Longint): Longint; override;
- {$IFDEF STREAM_SIZE_64}
- function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
- {$ELSE}
- function Seek(Offset: Longint; Origin: Word): Longint; override;
- {$ENDIF}
- {$ENDIF}
- end;
- TIdCalculateSizeStream = class(TIdBaseStream)
- protected
- FPosition: Int64;
- FSize: Int64;
- function IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint; override;
- function IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint; override;
- function IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; override;
- procedure IdSetSize(ASize: Int64); override;
- end;
- TIdStreamReadEvent = procedure(var VBuffer: TIdBytes; AOffset, ACount: Longint; var VResult: Longint) of object;
- TIdStreamWriteEvent = procedure(const ABuffer: TIdBytes; AOffset, ACount: Longint; var VResult: Longint) of object;
- TIdStreamSeekEvent = procedure(const AOffset: Int64; AOrigin: TSeekOrigin; var VPosition: Int64) of object;
- TIdStreamSetSizeEvent = procedure(const ANewSize: Int64) of object;
- TIdEventStream = class(TIdBaseStream)
- protected
- FOnRead: TIdStreamReadEvent;
- FOnWrite: TIdStreamWriteEvent;
- FOnSeek: TIdStreamSeekEvent;
- FOnSetSize: TIdStreamSetSizeEvent;
- function IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint; override;
- function IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint; override;
- function IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; override;
- procedure IdSetSize(ASize: Int64); override;
- public
- property OnRead: TIdStreamReadEvent read FOnRead write FOnRead;
- property OnWrite: TIdStreamWriteEvent read FOnWrite write FOnWrite;
- property OnSeek: TIdStreamSeekEvent read FOnSeek write FOnSeek;
- property OnSetSize: TIdStreamSetSizeEvent read FOnSetSize write FOnSetSize;
- end;
- {$IFNDEF DOTNET} // what is the .NET equivilent?
- TIdMemoryBufferStream = class(TCustomMemoryStream)
- public
- constructor Create(APtr: Pointer; ASize: TIdNativeInt);
- function Write(const Buffer; Count: Longint): Longint; override;
- end;
- TIdReadOnlyMemoryBufferStream = class(TIdMemoryBufferStream)
- public
- function Write(const Buffer; Count: Longint): Longint; override;
- end;
- {$ENDIF}
- const
- {$IFDEF UNIX}
- GOSType = otUnix;
- GPathDelim = '/'; {do not localize}
- INFINITE = UInt32($FFFFFFFF); { Infinite timeout }
- {$ENDIF}
- {$IFDEF WINDOWS}
- GOSType = otWindows;
- GPathDelim = '\'; {do not localize}
- Infinite = Windows.INFINITE; { redeclare here for use elsewhere without using Windows.pas } // cls modified 1/23/2002
- {$ENDIF}
- {$IFDEF DOTNET}
- GOSType = otDotNet;
- GPathDelim = '\'; {do not localize}
- // Infinite = ?; { redeclare here for use elsewhere without using Windows.pas } // cls modified 1/23/2002
- {$ENDIF}
- // S.G. 4/9/2002: IP version general switch for defaults
- {$IFDEF IdIPv6}
- ID_DEFAULT_IP_VERSION = Id_IPv6;
- {$ELSE}
- ID_DEFAULT_IP_VERSION = Id_IPv4;
- {$ENDIF}
- {$IFNDEF HAS_sLineBreak}
- {$IFDEF WINDOWS}
- sLineBreak = CR + LF;
- {$ELSE}
- sLineBreak = LF;
- {$ENDIF}
- {$ENDIF}
- //The power constants are for processing IP addresses
- //They are powers of 255.
- const
- POWER_1 = $000000FF;
- POWER_2 = $0000FFFF;
- POWER_3 = $00FFFFFF;
- POWER_4 = $FFFFFFFF;
- // utility functions to calculate the usable length of a given buffer.
- // If ALength is <0 then the actual Buffer length is returned,
- // otherwise the minimum of the two lengths is returned instead.
- function IndyLength(const ABuffer: String; const ALength: Integer = -1; const AIndex: Integer = 1): Integer; overload;
- function IndyLength(const ABuffer: TIdBytes; const ALength: Integer = -1; const AIndex: Integer = 0): Integer; overload;
- function IndyLength(const ABuffer: TStream; const ALength: TIdStreamSize = -1): TIdStreamSize; overload;
- function IndyFormat(const AFormat: string; const Args: array of const): string;
- function IndyIncludeTrailingPathDelimiter(const S: string): string;
- function IndyExcludeTrailingPathDelimiter(const S: string): string;
- procedure IndyRaiseLastError;
- // This can only be called inside of an 'except' block! This is so that
- // Exception.RaiseOuterException() (when available) can capture the current
- // exception into the InnerException property of a new Exception that is
- // being raised...
- procedure IndyRaiseOuterException(AOuterException: Exception);
- //You could possibly use the standard StrInt and StrIntDef but these
- //also remove spaces from the string using the trim functions.
- function IndyStrToInt(const S: string): Integer; overload;
- function IndyStrToInt(const S: string; ADefault: Integer): Integer; overload;
- function IndyFileAge(const AFileName: string): TDateTime;
- function IndyDirectoryExists(const ADirectory: string): Boolean;
- //You could possibly use the standard StrToInt and StrToInt64Def
- //functions but these also remove spaces using the trim function
- function IndyStrToInt64(const S: string; const ADefault: Int64): Int64; overload;
- function IndyStrToInt64(const S: string): Int64; overload;
- //This converts the string to an Integer or Int64 depending on the bit size TStream uses
- function IndyStrToStreamSize(const S: string; const ADefault: TIdStreamSize): TIdStreamSize; overload;
- function IndyStrToStreamSize(const S: string): TIdStreamSize; overload;
- function AddMSecToTime(const ADateTime: TDateTime; const AMSec: Integer): TDateTime;
- // To and From Bytes conversion routines
- function ToBytes(const AValue: string; ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ): TIdBytes; overload;
- function ToBytes(const AValue: string; const ALength: Integer; const AIndex: Integer = 1;
- ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ): TIdBytes; overload;
- function ToBytes(const AValue: Char; ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ): TIdBytes; overload;
- function ToBytes(const AValue: Int8): TIdBytes; overload;
- function ToBytes(const AValue: UInt8): TIdBytes; overload;
- function ToBytes(const AValue: Int16): TIdBytes; overload;
- function ToBytes(const AValue: UInt16): TIdBytes; overload;
- function ToBytes(const AValue: Int32): TIdBytes; overload;
- function ToBytes(const AValue: UInt32): TIdBytes; overload;
- function ToBytes(const AValue: Int64): TIdBytes; overload;
- function ToBytes(const AValue: TIdUInt64): TIdBytes; overload;
- function ToBytes(const AValue: TIdBytes; const ASize: Integer; const AIndex: Integer = 0): TIdBytes; overload;
- {$IFNDEF DOTNET}
- // RLebeau - not using the same "ToBytes" naming convention for RawToBytes()
- // in order to prevent ambiquious errors with ToBytes(TIdBytes) above
- function RawToBytes(const AValue; const ASize: Integer): TIdBytes;
- {$ENDIF}
- // The following functions are faster but except that Bytes[] must have enough
- // space for at least SizeOf(AValue) bytes.
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: Char; ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ); overload;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int8); overload;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: UInt8); overload;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int16); overload;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: UInt16); overload;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int32); overload;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: UInt32); overload;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int64); overload;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: TIdUInt64); overload;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: TIdBytes; const ASize: Integer; const AIndex: Integer = 0); overload;
- {$IFNDEF DOTNET}
- // RLebeau - not using the same "ToBytesF" naming convention for RawToBytesF()
- // in order to prevent ambiquious errors with ToBytesF(TIdBytes) above
- procedure RawToBytesF(var Bytes: TIdBytes; const AValue; const ASize: Integer);
- {$ENDIF}
- function ToHex(const AValue: TIdBytes; const ACount: Integer = -1; const AIndex: Integer = 0): string; overload;
- function ToHex(const AValue: array of UInt32): string; overload; // for IdHash
- function BytesToString(const AValue: TIdBytes; AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): string; overload;
- function BytesToString(const AValue: TIdBytes; const AStartIndex: Integer;
- const ALength: Integer = -1; AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): string; overload;
- // BytesToStringRaw() differs from BytesToString() in that it stores the
- // byte octets as-is, whereas BytesToString() may decode character encodings
- function BytesToStringRaw(const AValue: TIdBytes): string; overload;
- function BytesToStringRaw(const AValue: TIdBytes; const AStartIndex: Integer;
- const ALength: Integer = -1): string; overload;
- function BytesToChar(const AValue: TIdBytes; const AIndex: Integer = 0;
- AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): Char; overload;
- function BytesToChar(const AValue: TIdBytes; var VChar: Char; const AIndex: Integer = 0;
- AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): Integer; overload;
- function BytesToInt16(const AValue: TIdBytes; const AIndex: Integer = 0): Int16;
- function BytesToUInt16(const AValue: TIdBytes; const AIndex : Integer = 0): UInt16;
- function BytesToInt32(const AValue: TIdBytes; const AIndex: Integer = 0): Int32;
- function BytesToUInt32(const AValue: TIdBytes; const AIndex : Integer = 0): UInt32;
- function BytesToInt64(const AValue: TIdBytes; const AIndex: Integer = 0): Int64;
- function BytesToUInt64(const AValue: TIdBytes; const AIndex: Integer = 0): TIdUInt64;
- function BytesToShort(const AValue: TIdBytes; const AIndex: Integer = 0): Int16; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use BytesToInt16()'{$ENDIF};{$ENDIF}
- function BytesToWord(const AValue: TIdBytes; const AIndex : Integer = 0): UInt16; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use BytesToUInt16()'{$ENDIF};{$ENDIF}
- function BytesToLongInt(const AValue: TIdBytes; const AIndex: Integer = 0): Int32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use BytesToInt32()'{$ENDIF};{$ENDIF}
- function BytesToLongWord(const AValue: TIdBytes; const AIndex : Integer = 0): UInt32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use BytesToUInt32()'{$ENDIF};{$ENDIF}
- function BytesToIPv4Str(const AValue: TIdBytes; const AIndex: Integer = 0): String;
- procedure BytesToIPv6(const AValue: TIdBytes; var VAddress: TIdIPv6Address; const AIndex: Integer = 0);
- function BytesToTicks(const AValue: TIdBytes; const AIndex: Integer = 0): TIdTicks;
- {$IFNDEF DOTNET}
- procedure BytesToRaw(const AValue: TIdBytes; var VBuffer; const ASize: Integer);
- {$ENDIF}
- // TIdBytes utilities
- procedure AppendBytes(var VBytes: TIdBytes; const AToAdd: TIdBytes; const AIndex: Integer = 0; const ALength: Integer = -1);
- procedure AppendByte(var VBytes: TIdBytes; const AByte: Byte);
- procedure AppendString(var VBytes: TIdBytes; const AStr: String; const ALength: Integer = -1;
- ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- );
- procedure ExpandBytes(var VBytes: TIdBytes; const AIndex: Integer; const ACount: Integer; const AFillByte: Byte = 0);
- procedure InsertBytes(var VBytes: TIdBytes; const ADestIndex: Integer; const ASource: TIdBytes; const ASourceIndex: Integer = 0);
- procedure InsertByte(var VBytes: TIdBytes; const AByte: Byte; const AIndex: Integer);
- procedure RemoveBytes(var VBytes: TIdBytes; const ACount: Integer; const AIndex: Integer = 0);
- // Common Streaming routines
- function ReadLnFromStream(AStream: TStream; var VLine: String; AMaxLineLength: Integer = -1;
- AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): Boolean; overload;
- function ReadLnFromStream(AStream: TStream; AMaxLineLength: Integer = -1;
- AExceptionIfEOF: Boolean = False; AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): string; overload;
- function ReadStringFromStream(AStream: TStream; ASize: Integer = -1; AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): string; overload;
- procedure WriteStringToStream(AStream: TStream; const AStr: string; ADestEncoding: IIdTextEncoding
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ); overload;
- procedure WriteStringToStream(AStream: TStream; const AStr: string; const ALength: Integer = -1;
- const AIndex: Integer = 1; ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ); overload;
- function ReadCharFromStream(AStream: TStream; var VChar: Char; AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): Integer;
- function ReadTIdBytesFromStream(const AStream: TStream; var ABytes: TIdBytes;
- const Count: TIdStreamSize; const AIndex: Integer = 0): TIdStreamSize;
- procedure WriteTIdBytesToStream(const AStream: TStream; const ABytes: TIdBytes;
- const ASize: Integer = -1; const AIndex: Integer = 0);
- function ByteToHex(const AByte: Byte): string;
- function ByteToOctal(const AByte: Byte): string;
- function UInt32ToHex(const ALongWord : UInt32) : String;
- function LongWordToHex(const ALongWord : UInt32) : String; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use UInt32ToHex()'{$ENDIF};{$ENDIF}
- procedure CopyTIdBytes(const ASource: TIdBytes; const ASourceIndex: Integer;
- var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer);
- procedure CopyTIdByteArray(const ASource: array of Byte; const ASourceIndex: Integer;
- var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer);
- procedure CopyTIdChar(const ASource: Char; var VDest: TIdBytes; const ADestIndex: Integer;
- ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- );
- procedure CopyTIdInt16(const ASource: Int16; var VDest: TIdBytes; const ADestIndex: Integer);
- procedure CopyTIdUInt16(const ASource: UInt16; var VDest: TIdBytes; const ADestIndex: Integer);
- procedure CopyTIdInt32(const ASource: Int32; var VDest: TIdBytes; const ADestIndex: Integer);
- procedure CopyTIdUInt32(const ASource: UInt32; var VDest: TIdBytes; const ADestIndex: Integer);
- procedure CopyTIdInt64(const ASource: Int64; var VDest: TIdBytes; const ADestIndex: Integer);
- procedure CopyTIdUInt64(const ASource: TIdUInt64; var VDest: TIdBytes; const ADestIndex: Integer);
- procedure CopyTIdShort(const ASource: Int16; var VDest: TIdBytes; const ADestIndex: Integer); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use CopyTIdInt16()'{$ENDIF};{$ENDIF}
- procedure CopyTIdWord(const ASource: UInt16; var VDest: TIdBytes; const ADestIndex: Integer); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use CopyTIdUInt16()'{$ENDIF};{$ENDIF}
- procedure CopyTIdLongInt(const ASource: Int32; var VDest: TIdBytes; const ADestIndex: Integer); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use CopyTIdInt32()'{$ENDIF};{$ENDIF}
- procedure CopyTIdLongWord(const ASource: UInt32; var VDest: TIdBytes; const ADestIndex: Integer); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use CopyTIdUInt32()'{$ENDIF};{$ENDIF}
- procedure CopyTIdIPV6Address(const ASource: TIdIPv6Address; var VDest: TIdBytes; const ADestIndex: Integer);
- procedure CopyTIdTicks(const ASource: TIdTicks; var VDest: TIdBytes; const ADestIndex: Integer);
- procedure CopyTIdString(const ASource: String; var VDest: TIdBytes; const ADestIndex: Integer;
- const ALength: Integer = -1; ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ); overload;
- procedure CopyTIdString(const ASource: String; const ASourceIndex: Integer;
- var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer = -1;
- ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ); overload;
- // Need to change prob not to use this set
- function CharPosInSet(const AString: string; const ACharPos: Integer; const ASet: String): Integer; {$IFDEF STRING_IS_IMMUTABLE}overload;{$ENDIF}
- function CharIsInSet(const AString: string; const ACharPos: Integer; const ASet: String): Boolean; {$IFDEF STRING_IS_IMMUTABLE}overload;{$ENDIF}
- function CharIsInEOL(const AString: string; const ACharPos: Integer): Boolean; {$IFDEF STRING_IS_IMMUTABLE}overload;{$ENDIF}
- function CharEquals(const AString: string; const ACharPos: Integer; const AValue: Char): Boolean; {$IFDEF STRING_IS_IMMUTABLE}overload;{$ENDIF}
- {$IFDEF STRING_IS_IMMUTABLE}
- function CharPosInSet(const ASB: TIdStringBuilder; const ACharPos: Integer; const ASet: String): Integer; overload;
- function CharIsInSet(const ASB: TIdStringBuilder; const ACharPos: Integer; const ASet: String): Boolean; overload;
- function CharIsInEOL(const ASB: TIdStringBuilder; const ACharPos: Integer): Boolean; overload;
- function CharEquals(const ASB: TIdStringBuilder; const ACharPos: Integer; const AValue: Char): Boolean; overload;
- {$ENDIF}
- function ByteIndex(const AByte: Byte; const ABytes: TIdBytes; const AStartIndex: Integer = 0): Integer;
- function ByteIdxInSet(const ABytes: TIdBytes; const AIndex: Integer; const ASet: TIdBytes): Integer;
- function ByteIsInSet(const ABytes: TIdBytes; const AIndex: Integer; const ASet: TIdBytes): Boolean;
- function ByteIsInEOL(const ABytes: TIdBytes; const AIndex: Integer): Boolean;
- function CompareDate(const D1, D2: TDateTime): Integer;
- function CurrentProcessId: TIdPID;
- // RLebeau: the input of these functions must be in GMT
- function DateTimeGMTToHttpStr(const GMTValue: TDateTime) : String;
- function DateTimeGMTToCookieStr(const GMTValue: TDateTime; const AUseNetscapeFmt: Boolean = True) : String;
- function DateTimeGMTToImapStr(const GMTValue: TDateTime) : String;
- // RLebeau: the input of these functions must be in local time
- function DateTimeToInternetStr(const Value: TDateTime; const AUseGMTStr: Boolean = False) : String; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use LocalDateTimeToGMT()'{$ENDIF};{$ENDIF}
- function DateTimeToGmtOffSetStr(ADateTime: TDateTime; const AUseGMTStr: Boolean = False): string; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use UTCOffsetToStr()'{$ENDIF};{$ENDIF}
- function LocalDateTimeToHttpStr(const Value: TDateTime) : String;
- function LocalDateTimeToCookieStr(const Value: TDateTime; const AUseNetscapeFmt: Boolean = True) : String;
- function LocalDateTimeToImapStr(const Value: TDateTime) : String;
- function LocalDateTimeToGMT(const Value: TDateTime; const AUseGMTStr: Boolean = False) : String;
- procedure DebugOutput(const AText: string);
- function Fetch(var AInput: string; const ADelim: string = IdFetchDelimDefault;
- const ADelete: Boolean = IdFetchDeleteDefault;
- const ACaseSensitive: Boolean = IdFetchCaseSensitiveDefault): string;
- function FetchCaseInsensitive(var AInput: string; const ADelim: string = IdFetchDelimDefault;
- const ADelete: Boolean = IdFetchDeleteDefault): string;
- // TODO: add an index parameter
- procedure FillBytes(var VBytes : TIdBytes; const ACount : Integer; const AValue : Byte);
- function CurrentThreadId: TIdThreadID;
- function GetThreadHandle(AThread: TThread): TIdThreadHandle;
- //GetTickDiff required because GetTickCount will wrap (IdICMP uses this)
- function GetTickDiff(const AOldTickCount, ANewTickCount: UInt32): UInt32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use GetTickDiff64()'{$ENDIF};{$ENDIF}
- function GetTickDiff64(const AOldTickCount, ANewTickCount: TIdTicks): TIdTicks;
- // Most operations that use tick counters will never run anywhere near the
- // 49.7 day limit that UInt32 imposes. If an operation really were to
- // run that long, use GetElapsedTicks64()...
- function GetElapsedTicks(const AOldTickCount: TIdTicks): UInt32;
- function GetElapsedTicks64(const AOldTickCount: TIdTicks): TIdTicks;
- procedure IdDelete(var s: string; AOffset, ACount: Integer);
- procedure IdInsert(const Source: string; var S: string; Index: Integer);
- {$IFNDEF DOTNET}
- type
- // TODO: use "array of Integer" instead?
- {$IFDEF HAS_GENERICS_TList}
- TIdPortList = TList<Integer>; // TODO: use TIdPort instead?
- {$ELSE}
- // TODO: flesh out to match TList<Integer> for non-Generics compilers
- TIdPortList = TList;
- {$ENDIF}
- function IdPorts: TIdPortList;
- {$ENDIF}
- function iif(ATest: Boolean; const ATrue: Integer; const AFalse: Integer): Integer; overload;
- function iif(ATest: Boolean; const ATrue: string; const AFalse: string = ''): string; overload; { do not localize }
- function iif(ATest: Boolean; const ATrue: Boolean; const AFalse: Boolean): Boolean; overload;
- function iif(const AEncoding, ADefEncoding: IIdTextEncoding; ADefEncodingType: IdTextEncodingType = encASCII): IIdTextEncoding; overload;
- function InMainThread: Boolean;
- function IPv6AddressToStr(const AValue: TIdIPv6Address): string;
- //Note that there is NO need for Big Endian byte order functions because
- //that's done through HostToNetwork byte order functions.
- function HostToLittleEndian(const AValue : UInt16) : UInt16; overload;
- function HostToLittleEndian(const AValue : UInt32): UInt32; overload;
- function HostToLittleEndian(const AValue : Int32): Int32; overload;
- function LittleEndianToHost(const AValue : UInt16) : UInt16; overload;
- function LittleEndianToHost(const AValue : UInt32): UInt32; overload;
- function LittleEndianToHost(const AValue : Int32): Int32; overload;
- procedure WriteMemoryStreamToStream(Src: TMemoryStream; Dest: TStream; Count: TIdStreamSize);
- {$IFNDEF DOTNET_EXCLUDE}
- function IsCurrentThread(AThread: TThread): boolean;
- {$ENDIF}
- function IPv4ToUInt32(const AIPAddress: string): UInt32; overload;
- function IPv4ToUInt32(const AIPAddress: string; var VErr: Boolean): UInt32; overload;
- function IPv4ToDWord(const AIPAddress: string): UInt32; overload; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IPv4ToUInt32()'{$ENDIF};{$ENDIF}
- function IPv4ToDWord(const AIPAddress: string; var VErr: Boolean): UInt32; overload; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IPv4ToUInt32()'{$ENDIF};{$ENDIF}
- function IPv4ToHex(const AIPAddress: string; const ADotted: Boolean = False): string;
- function IPv4ToOctal(const AIPAddress: string): string;
- procedure IPv6ToIdIPv6Address(const AIPAddress: String; var VAddress: TIdIPv6Address); overload;
- procedure IPv6ToIdIPv6Address(const AIPAddress: String; var VAddress: TIdIPv6Address; var VErr : Boolean); overload;
- function IsAlpha(const AChar: Char): Boolean; overload;
- function IsAlpha(const AString: String; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean; overload;
- function IsAlphaNumeric(const AChar: Char): Boolean; overload;
- function IsAlphaNumeric(const AString: String; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean; overload;
- function IsASCII(const AByte: Byte): Boolean; overload;
- function IsASCII(const ABytes: TIdBytes): Boolean; overload;
- function IsASCIILDH(const AByte: Byte): Boolean; overload;
- function IsASCIILDH(const ABytes: TIdBytes): Boolean; overload;
- function IsHexidecimal(const AChar: Char): Boolean; overload;
- function IsHexidecimal(const AString: string; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean; overload;
- function IsNumeric(const AChar: Char): Boolean; overload;
- function IsNumeric(const AString: string): Boolean; overload;
- function IsNumeric(const AString: string; const ALength: Integer; const AIndex: Integer = 1): Boolean; overload;
- function IsOctal(const AChar: Char): Boolean; overload;
- function IsOctal(const AString: string; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean; overload;
- {$IFNDEF DOTNET}
- function InterlockedExchangeTHandle(var VTarget: THandle; const AValue: THandle): THandle;
- function InterlockedExchangeTLibHandle(var VTarget: TIdLibHandle; const AValue: TIdLibHandle): TIdLibHandle;
- function InterlockedCompareExchangePtr(var VTarget: Pointer; const AValue, Compare: Pointer): Pointer;
- function InterlockedCompareExchangeObj(var VTarget: TObject; const AValue, Compare: TObject): TObject;
- function InterlockedCompareExchangeIntf(var VTarget: IInterface; const AValue, Compare: IInterface): IInterface;
- {$ENDIF}
- function MakeCanonicalIPv4Address(const AAddr: string): string;
- function MakeCanonicalIPv6Address(const AAddr: string): string;
- function MakeUInt32IntoIPv4Address(const ADWord: UInt32): string;
- function MakeDWordIntoIPv4Address(const ADWord: UInt32): string; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use MakeUInt32IntoIPv4Address()'{$ENDIF};{$ENDIF}
- function IndyMin(const AValueOne, AValueTwo: Int64): Int64; overload;
- function IndyMin(const AValueOne, AValueTwo: Int32): Int32; overload;
- function IndyMin(const AValueOne, AValueTwo: UInt16): UInt16; overload;
- function IndyMax(const AValueOne, AValueTwo: Int64): Int64; overload;
- function IndyMax(const AValueOne, AValueTwo: Int32): Int32; overload;
- function IndyMax(const AValueOne, AValueTwo: UInt16): UInt16; overload;
- function IPv4MakeUInt32InRange(const AInt: Int64; const A256Power: Integer): UInt32;
- function IPv4MakeLongWordInRange(const AInt: Int64; const A256Power: Integer): UInt32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IPv4MakeUInt32InRange()'{$ENDIF};{$ENDIF}
- {$IFDEF REGISTER_EXPECTED_MEMORY_LEAK}
- function IndyRegisterExpectedMemoryLeak(AAddress: Pointer): Boolean;
- {$ENDIF}
- function LoadLibFunction(const ALibHandle: TIdLibHandle; const AProcName: TIdLibFuncName): Pointer;
- {$IFDEF UNIX}
- function HackLoad(const ALibName : String; const ALibVersions : array of String) : TIdLibHandle;
- {$ENDIF}
- {$IFNDEF DOTNET}
- function MemoryPos(const ASubStr: string; MemBuff: PChar; MemorySize: Integer): Integer;
- {$ENDIF}
- // TODO: have OffsetFromUTC() return minutes as an integer instead, and
- // then use DateUtils.IncMinutes() when adding the offset to a TDateTime...
- function OffsetFromUTC: TDateTime;
- function UTCOffsetToStr(const AOffset: TDateTime; const AUseGMTStr: Boolean = False): string;
- function LocalTimeToUTCTime(const Value: TDateTime): TDateTime;
- function UTCTimeToLocalTime(const Value: TDateTime): TDateTime;
- function PosIdx(const ASubStr, AStr: string; AStartPos: UInt32 = 0): UInt32; //For "ignoreCase" use AnsiUpperCase
- function PosInSmallIntArray(const ASearchInt: Int16; const AArray: array of Int16): Integer;
- function PosInStrArray(const SearchStr: string; const Contents: array of string; const CaseSensitive: Boolean = True): Integer;
- {$IFNDEF DOTNET}
- function ServicesFilePath: string;
- {$ENDIF}
- procedure IndySetThreadPriority(AThread: TThread; const APriority: TIdThreadPriority; const APolicy: Integer = -MaxInt);
- procedure SetThreadName(const AName: string; {$IFDEF DOTNET}AThread: System.Threading.Thread = nil{$ELSE}AThreadID: UInt32 = $FFFFFFFF{$ENDIF});
- procedure IndySleep(ATime: UInt32);
- // TODO: create TIdStringPositionList for non-Nextgen compilers...
- {$IFDEF USE_OBJECT_ARC}
- type
- TIdStringPosition = record
- Value: String;
- Position: Integer;
- constructor Create(const AValue: String; const APosition: Integer);
- end;
- TIdStringPositionList = TList<TIdStringPosition>;
- {$ENDIF}
- //For non-Nextgen compilers: Integer(TStrings.Objects[i]) = column position in AData
- //For Nextgen compilers: use SplitDelimitedString() if column positions are needed
- 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}
- 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}
- 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}
- {$IFDEF USE_OBJECT_ARC}
- procedure SplitDelimitedString(const AData: string; AStrings: TIdStringPositionList; ATrim: Boolean; const ADelim: string = ' '); overload; {Do not Localize}
- {$ENDIF}
- function StartsWithACE(const ABytes: TIdBytes): Boolean;
- function StringsReplace(const S: String; const OldPattern, NewPattern: array of string): string;
- function ReplaceAll(const S, OldPattern, NewPattern: string): string;
- function ReplaceOnlyFirst(const S, OldPattern, NewPattern: string): string;
- function TextIsSame(const A1, A2: string): Boolean;
- function TextStartsWith(const S, SubS: string): Boolean;
- function TextEndsWith(const S, SubS: string): Boolean;
- function IndyUpperCase(const A1: string): string;
- function IndyLowerCase(const A1: string): string;
- function IndyCompareStr(const A1: string; const A2: string): Integer;
- function Ticks: UInt32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use Ticks64()'{$ENDIF};{$ENDIF}
- function Ticks64: TIdTicks;
- procedure ToDo(const AMsg: string);
- function TwoByteToUInt16(AByte1, AByte2: Byte): UInt16;
- function TwoByteToWord(AByte1, AByte2: Byte): UInt16; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use TwoByteToUInt16()'{$ENDIF};{$ENDIF}
- function IndyAddPair(AStrings: TStrings; const AName, AValue: String): TStrings; overload;
- function IndyAddPair(AStrings: TStrings; const AName, AValue: String; AObject: TObject): TStrings; overload;
- function IndyIndexOf(AStrings: TStrings; const AStr: string; const ACaseSensitive: Boolean = False): Integer;{$IFDEF HAS_TStringList_CaseSensitive} overload;{$ENDIF}
- {$IFDEF HAS_TStringList_CaseSensitive}
- function IndyIndexOf(AStrings: TStringList; const AStr: string; const ACaseSensitive: Boolean = False): Integer; overload;
- {$ENDIF}
- function IndyIndexOfName(AStrings: TStrings; const AName: string; const ACaseSensitive: Boolean = False): Integer;{$IFDEF HAS_TStringList_CaseSensitive} overload;{$ENDIF}
- {$IFDEF HAS_TStringList_CaseSensitive}
- function IndyIndexOfName(AStrings: TStringList; const AName: string; const ACaseSensitive: Boolean = False): Integer; overload;
- {$ENDIF}
- function IndyValueFromIndex(AStrings: TStrings; const AIndex: Integer): String;
- {$IFDEF WINDOWS}
- function IndyWindowsMajorVersion: Integer;
- function IndyWindowsMinorVersion: Integer;
- function IndyWindowsBuildNumber: Integer;
- function IndyWindowsPlatform: Integer;
- function IndyCheckWindowsVersion(const AMajor: Integer; const AMinor: Integer = 0): Boolean;
- {$ENDIF}
- // For non-Nextgen compilers: IdDisposeAndNil is the same as FreeAndNil()
- // For Nextgen compilers: IdDisposeAndNil calls TObject.DisposeOf() to ensure
- // the object is freed immediately even if it has active references to it,
- // for instance when freeing an Owned component
- // Embarcadero changed the signature of FreeAndNil() in 10.4 Denali:
- // procedure FreeAndNil(const [ref] Obj: TObject); inline;
- // TODO: Change the signature of IdDisposeAndNil() to match FreeAndNil() in 10.4+...
- procedure IdDisposeAndNil(var Obj); {$IFDEF USE_INLINE}inline;{$ENDIF}
- //RLebeau: FPC does not provide mach_timebase_info() and mach_absolute_time() yet...
- {$IFDEF UNIX}
- {$IFDEF OSX}
- {$IFDEF FPC}
- type
- TTimebaseInfoData = record
- numer: UInt32;
- denom: UInt32;
- end;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- var
- {$IFDEF UNIX}
- // For linux the user needs to set this variable to be accurate where used (mail, etc)
- GOffsetFromUTC: TDateTime = 0{$IFDEF HAS_DEPRECATED}{$IFDEF USE_SEMICOLON_BEFORE_DEPRECATED};{$ENDIF} deprecated{$ENDIF};
- {$IFDEF OSX}
- GMachTimeBaseInfo: TTimebaseInfoData;
- {$ENDIF}
- {$ENDIF}
- IndyPos: TPosProc = nil;
- {$IFDEF UNIX}
- {$UNDEF OSX_OR_IOS}
- {$IFDEF OSX}
- {$DEFINE OSX_OR_IOS}
- {$ENDIF}
- {$IFDEF IOS}
- {$DEFINE OSX_OR_IOS}
- {$ENDIF}
- {$ENDIF}
- {$IFDEF UNIX}
- const
- {$IFDEF HAS_SharedSuffix}
- LIBEXT = '.' + SharedSuffix; {do not localize}
- {$ELSE}
- {$IFDEF OSX_OR_IOS}
- LIBEXT = '.dylib'; {do not localize}
- {$ELSE}
- LIBEXT = '.so'; {do not localize}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- implementation
- {$IFDEF UNIX}
- {$IFDEF LINUX}
- {$DEFINE USE_clock_gettime}
- {$IFDEF FPC}
- {$linklib rt}
- {$ENDIF}
- {$ENDIF}
- {$IFDEF FREEBSD}
- {$DEFINE USE_clock_gettime}
- {$ENDIF}
- {$ENDIF}
- {$IFDEF ANDROID}
- {$DEFINE USE_clock_gettime}
- {$ENDIF}
- uses
- {$IFDEF USE_VCL_POSIX}
- Posix.SysSelect,
- Posix.SysSocket,
- Posix.Time,
- Posix.SysTime,
- {$ENDIF}
- {$IFDEF USE_VCL_POSIX}
- {$IFDEF OSX}
- Macapi.CoreServices,
- {$ENDIF}
- {$ENDIF}
- {$IFDEF REGISTER_EXPECTED_MEMORY_LEAK}
- {$IFNDEF HAS_System_RegisterExpectedMemoryLeak}
- {$IFDEF USE_FASTMM4}FastMM4,{$ENDIF}
- {$IFDEF USE_MADEXCEPT}madExcept,{$ENDIF}
- {$IFDEF USE_LEAKCHECK}LeakCheck,{$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$IFDEF USE_LIBC}Libc,{$ENDIF}
- {$IFDEF HAS_UNIT_DateUtils}
- // to facilitate inlining
- {$IFNDEF DOTNET}
- {$IFNDEF HAS_GetLocalTimeOffset}
- {$IFDEF HAS_DateUtils_TTimeZone}
- {$IFDEF VCL_XE2_OR_ABOVE}System.TimeSpan{$ELSE}TimeSpan{$ENDIF},
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- DateUtils,
- {$ENDIF}
- //do not bring in our IdIconv unit if we are using the libc unit directly.
- {$IFDEF USE_ICONV_UNIT}IdIconv, {$ENDIF}
- IdResourceStrings,
- IdStream,
- {$IFDEF DOTNET}
- IdStreamNET
- {$ELSE}
- IdStreamVCL
- {$ENDIF}
- {$IFDEF HAS_PosEx}
- {$IFDEF HAS_UNIT_StrUtils}
- ,StrUtils
- {$ENDIF}
- {$ENDIF}
- ;
- {$IFDEF FPC}
- {$IFDEF WINCE}
- //FreePascal for WindowsCE may not define these.
- const
- CP_UTF7 = 65000;
- CP_UTF8 = 65001;
- {$ENDIF}
- {$ENDIF}
- {$IFDEF REGISTER_EXPECTED_MEMORY_LEAK}
- {$IFNDEF HAS_System_RegisterExpectedMemoryLeak}
- {$IFDEF USE_FASTMM4}
- // RLebeau 7/5/2018: Prior to Delphi 2009+, FastMM manually defines several of
- // Delphi's native types. Most importantly, it defines PByte, which then causes
- // problems for IIdTextEncoding implementations below. So, lets make sure that
- // our definitions below are using the same RTL types that their declarations
- // above were using, and not use FastMM's types by mistake, otherwise we get
- // compiler errors!
- type
- PByte = System.PByte;
- //NativeInt = System.NativeInt;
- //NativeUInt = System.NativeUInt;
- //PNativeUInt = System.PNativeUInt;
- {$IFDEF DOTNET}
- IntPtr = System.IntPtr;
- {$ENDIF}
- //UIntPtr = System.UIntPtr;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- procedure EnsureEncoding(var VEncoding : IIdTextEncoding; ADefEncoding: IdTextEncodingType = encIndyDefault);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if VEncoding = nil then begin
- VEncoding := IndyTextEncoding(ADefEncoding);
- end;
- end;
- procedure CheckByteEncoding(var VBytes: TIdBytes; ASrcEncoding, ADestEncoding: IIdTextEncoding);
- begin
- if ASrcEncoding <> ADestEncoding then begin
- VBytes := ADestEncoding.GetBytes(ASrcEncoding.GetChars(VBytes));
- end;
- end;
- {$IFNDEF WINDOWS}
- //FreePascal may not define this for non-Windows systems.
- //#define MAKEWORD(a, b) ((WORD)(((BYTE)(a)) | ((WORD)((BYTE)(b))) << 8))
- function MakeWord(const a, b : Byte) : Word;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := Word(a) or (Word(b) shl 8);
- end;
- {$ENDIF}
- {$IFNDEF DOTNET}
- var
- // TODO: use "array of Integer" instead?
- GIdPorts: TIdPortList = nil;
- GIdOSDefaultEncoding: IIdTextEncoding = nil;
- GId8BitEncoding: IIdTextEncoding = nil;
- GIdASCIIEncoding: IIdTextEncoding = nil;
- GIdUTF16BigEndianEncoding: IIdTextEncoding = nil;
- GIdUTF16LittleEndianEncoding: IIdTextEncoding = nil;
- GIdUTF7Encoding: IIdTextEncoding = nil;
- GIdUTF8Encoding: IIdTextEncoding = nil;
- {$ENDIF}
- { IIdTextEncoding implementations }
- {$IFDEF DOTNET}
- type
- TIdDotNetEncoding = class(TInterfacedObject, IIdTextEncoding)
- protected
- FEncoding: System.Text.Encoding;
- public
- constructor Create(AEncoding: System.Text.Encoding); overload;
- constructor Create(const ACharset: String); overload;
- constructor Create(const ACodepage: UInt16); overload;
- function GetByteCount(const AChars: TIdWideChars): Integer; overload;
- function GetByteCount(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): Integer; overload;
- function GetByteCount(const AStr: TIdUnicodeString): Integer; overload;
- function GetByteCount(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): Integer; overload;
- function GetBytes(const AChars: TIdWideChars): TIdBytes; overload;
- function GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): TIdBytes; overload;
- function GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
- function GetBytes(const AStr: TIdUnicodeString): TIdBytes; overload;
- function GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): TIdBytes; overload;
- function GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
- function GetCharCount(const ABytes: TIdBytes): Integer; overload;
- function GetCharCount(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): Integer; overload;
- function GetChars(const ABytes: TIdBytes): TIdWideChars; overload;
- function GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdWideChars; overload;
- function GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer; overload;
- function GetIsSingleByte: Boolean;
- function GetMaxByteCount(ACharCount: Integer): Integer;
- function GetMaxCharCount(AByteCount: Integer): Integer;
- function GetPreamble: TIdBytes;
- function GetString(const ABytes: TIdBytes): TIdUnicodeString; overload;
- function GetString(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdUnicodeString; overload;
- end;
- constructor TIdDotNetEncoding.Create(AEncoding: System.Text.Encoding);
- begin
- inherited Create;
- FEncoding := AEncoding;
- end;
- constructor TIdDotNetEncoding.Create(const ACharset: String);
- begin
- inherited Create;
- // RLebeau 5/2/2017: have seen some malformed emails that use 'utf8'
- // instead of 'utf-8', so let's check for that...
- // RLebeau 9/27/2017: updating to handle a few more UTFs without hyphens...
- case PosInStrArray(ACharset, ['UTF7', 'UTF8', 'UTF16', 'UTF16LE', 'UTF16BE', 'UTF32', 'UTF32LE', 'UTF32BE'], False) of {Do not Localize}
- 0: FEncoding := System.Text.Encoding.UTF7;
- 1: FEncoding := System.Text.Encoding.UTF8;
- 2,3: FEncoding := System.Text.Encoding.Unicode;
- 4: FEncoding := System.Text.Encoding.BigEndianUnicode;
- 5,6: FEncoding := System.Text.Encoding.UTF32;
- 7: FEncoding := System.Text.Encoding.GetEncoding(12001);
- else
- FEncoding := System.Text.Encoding.GetEncoding(ACharset);
- end;
- end;
- constructor TIdDotNetEncoding.Create(const ACodepage: UInt16);
- begin
- inherited Create;
- FEncoding := System.Text.Encoding.GetEncoding(ACodepage);
- end;
- function TIdDotNetEncoding.GetByteCount(const AChars: TIdWideChars): Integer;
- begin
- Result := FEncoding.GetByteCount(AChars);
- end;
- function TIdDotNetEncoding.GetByteCount(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): Integer;
- begin
- Result := FEncoding.GetByteCount(AChars, ACharIndex, ACharCount);
- end;
- function TIdDotNetEncoding.GetByteCount(const AStr: TIdUnicodeString): Integer;
- begin
- Result := FEncoding.GetByteCount(AStr);
- end;
- function TIdDotNetEncoding.GetByteCount(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): Integer;
- begin
- Result := FEncoding.GetByteCount(AStr.Substring(ACharIndex-1, ACharCount));
- end;
- function TIdDotNetEncoding.GetBytes(const AChars: TIdWideChars): TIdBytes;
- begin
- Result := FEncoding.GetBytes(AChars);
- end;
- function TIdDotNetEncoding.GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): TIdBytes;
- begin
- Result := FEncoding.GetBytes(AChars, ACharIndex, ACharCount);
- end;
- function TIdDotNetEncoding.GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer;
- begin
- Result := FEncoding.GetBytes(AChars, ACharIndex, ACharCount, VBytes, AByteIndex);
- end;
- function TIdDotNetEncoding.GetBytes(const AStr: TIdUnicodeString): TIdBytes;
- begin
- Result := FEncoding.GetBytes(AStr);
- end;
- function TIdDotNetEncoding.GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): TIdBytes;
- begin
- Result := FEncoding.GetByteCount(AStr.Substring(ACharIndex-1, ACharCount));
- end;
- function TIdDotNetEncoding.GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer;
- begin
- Result := FEncoding.GetBytes(AStr, ACharIndex-1, ACharCount, VBytes, AByteIndex);
- end;
- function TIdDotNetEncoding.GetCharCount(const ABytes: TIdBytes): Integer;
- begin
- Result := FEncoding.GetCharCount(ABytes);
- end;
- function TIdDotNetEncoding.GetCharCount(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): Integer;
- begin
- Result := FEncoding.GetCharCount(ABytes, AByteIndex, AByteCount);
- end;
- function TIdDotNetEncoding.GetChars(const ABytes: TIdBytes): TIdWideChars;
- begin
- Result := FEncoding.GetChars(ABytes);
- end;
- function TIdDotNetEncoding.GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdWideChars;
- begin
- Result := FEncoding.GetChars(ABytes, AByteIndex, AByteCount);
- end;
- function TIdDotNetEncoding.GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer;
- begin
- Result := FEncoding.GetChars(ABytes, AByteIndex, AByteCount, VChars, ACharIndex);
- end;
- function TIdDotNetEncoding.GetIsSingleByte: Boolean;
- begin
- Result := FEncoding.IsSingleByte;
- end;
- function TIdDotNetEncoding.GetMaxByteCount(ACharCount: Integer): Integer;
- begin
- Result := FEncoding.GetMaxByteCount(ACharCount);
- end;
- function TIdDotNetEncoding.GetMaxCharCount(AByteCount: Integer): Integer;
- begin
- Result := FEncoding.GetMaxCharCount(AByteCount);
- end;
- function TIdDotNetEncoding.GetPreamble: TIdBytes;
- begin
- Result := fEncoding.GetPreamble;
- end;
- function TIdDotNetEncoding.GetString(const ABytes: TIdBytes): TIdUnicodeString;
- begin
- Result := FEncoding.GetString(ABytes);
- end;
- function TIdDotNetEncoding.GetString(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdUnicodeString;
- begin
- Result := FEncoding.GetString(ABytes, AByteIndex, AByteCount);
- end;
- {$ELSE}
- type
- TIdTextEncodingBase = class(TInterfacedObject, IIdTextEncoding)
- protected
- FIsSingleByte: Boolean;
- FMaxCharSize: Integer;
- public
- function GetByteCount(const AChars: TIdWideChars): Integer; overload;
- function GetByteCount(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): Integer; overload;
- function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; overload; virtual; abstract;
- function GetByteCount(const AStr: TIdUnicodeString): Integer; overload;
- function GetByteCount(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): Integer; overload;
- function GetBytes(const AChars: TIdWideChars): TIdBytes; overload;
- function GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): TIdBytes; overload;
- function GetBytes(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
- function GetBytes(const AChars: PIdWideChar; ACharCount: Integer): TIdBytes; overload;
- function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
- function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; overload; virtual; abstract;
- function GetBytes(const AStr: TIdUnicodeString): TIdBytes; overload;
- function GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): TIdBytes; overload;
- function GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer; overload;
- function GetCharCount(const ABytes: TIdBytes): Integer; overload;
- function GetCharCount(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): Integer; overload;
- function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; overload; virtual; abstract;
- function GetChars(const ABytes: TIdBytes): TIdWideChars; overload;
- function GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdWideChars; overload;
- function GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer; overload;
- function GetChars(const ABytes: PByte; AByteCount: Integer): TIdWideChars; overload;
- function GetChars(const ABytes: PByte; AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer; overload;
- function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; overload; virtual; abstract;
- function GetIsSingleByte: Boolean;
- function GetMaxByteCount(ACharCount: Integer): Integer; virtual; abstract;
- function GetMaxCharCount(AByteCount: Integer): Integer; virtual; abstract;
- function GetPreamble: TIdBytes; virtual;
- function GetString(const ABytes: TIdBytes): TIdUnicodeString; overload;
- function GetString(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdUnicodeString; overload;
- function GetString(const ABytes: PByte; AByteCount: Integer): TIdUnicodeString; overload;
- end;
- {$UNDEF SUPPORTS_CHARSET_ENCODING}
- {$IFDEF USE_ICONV}
- {$DEFINE SUPPORTS_CHARSET_ENCODING}
- {$ENDIF}
- {$IFDEF USE_LCONVENC}
- {$DEFINE SUPPORTS_CHARSET_ENCODING}
- {$ENDIF}
- {$UNDEF SUPPORTS_CODEPAGE_ENCODING}
- {$IFNDEF SUPPORTS_CHARSET_ENCODING}
- {$IFDEF WINDOWS}
- {$DEFINE SUPPORTS_CODEPAGE_ENCODING}
- {$ENDIF}
- {$IFDEF HAS_LocaleCharsFromUnicode}
- {$DEFINE SUPPORTS_CODEPAGE_ENCODING}
- {$ENDIF}
- {$ENDIF}
- TIdMBCSEncoding = class(TIdTextEncodingBase)
- private
- {$IFDEF SUPPORTS_CHARSET_ENCODING}
- FCharSet: String;
- {$ELSE}
- {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
- FCodePage: UInt32;
- FMBToWCharFlags: UInt32;
- FWCharToMBFlags: UInt32;
- {$ENDIF}
- {$ENDIF}
- public
- constructor Create; overload; virtual;
- {$IFDEF SUPPORTS_CHARSET_ENCODING}
- constructor Create(const CharSet: String); overload; virtual;
- {$ELSE}
- {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
- constructor Create(CodePage: Integer); overload; virtual;
- constructor Create(CodePage, MBToWCharFlags, WCharToMBFlags: Integer); overload; virtual;
- {$ENDIF}
- {$ENDIF}
- function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; overload; override;
- function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; overload; override;
- function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; overload; override;
- function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; overload; override;
- function GetMaxByteCount(CharCount: Integer): Integer; override;
- function GetMaxCharCount(ByteCount: Integer): Integer; override;
- function GetPreamble: TIdBytes; override;
- end;
- TIdUTF7Encoding = class(TIdMBCSEncoding)
- public
- constructor Create; override;
- function GetMaxByteCount(CharCount: Integer): Integer; override;
- function GetMaxCharCount(ByteCount: Integer): Integer; override;
- end;
- TIdUTF8Encoding = class(TIdMBCSEncoding)
- public
- constructor Create; override;
- function GetMaxByteCount(CharCount: Integer): Integer; override;
- function GetMaxCharCount(ByteCount: Integer): Integer; override;
- function GetPreamble: TIdBytes; override;
- end;
- TIdUTF16LittleEndianEncoding = class(TIdTextEncodingBase)
- public
- constructor Create; virtual;
- function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; overload; override;
- function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; overload; override;
- function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; overload; override;
- function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; overload; override;
- function GetMaxByteCount(CharCount: Integer): Integer; override;
- function GetMaxCharCount(ByteCount: Integer): Integer; override;
- function GetPreamble: TIdBytes; override;
- end;
- TIdUTF16BigEndianEncoding = class(TIdUTF16LittleEndianEncoding)
- public
- function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; overload; override;
- function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; overload; override;
- function GetPreamble: TIdBytes; override;
- end;
- TIdASCIIEncoding = class(TIdTextEncodingBase)
- public
- constructor Create; virtual;
- function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; override;
- function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; override;
- function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; override;
- function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; override;
- function GetMaxByteCount(ACharCount: Integer): Integer; override;
- function GetMaxCharCount(AByteCount: Integer): Integer; override;
- end;
- TId8BitEncoding = class(TIdTextEncodingBase)
- public
- constructor Create; virtual;
- function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; override;
- function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; override;
- function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; override;
- function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; override;
- function GetMaxByteCount(ACharCount: Integer): Integer; override;
- function GetMaxCharCount(AByteCount: Integer): Integer; override;
- end;
- {$IFDEF HAS_TEncoding}
- TIdVCLEncoding = class(TIdTextEncodingBase)
- protected
- FEncoding: TEncoding;
- FFreeEncoding: Boolean;
- public
- constructor Create(AEncoding: TEncoding; AFreeEncoding: Boolean); overload;
- {$IFDEF HAS_TEncoding_GetEncoding_ByEncodingName}
- constructor Create(const ACharset: String); overload;
- {$ENDIF}
- constructor Create(const ACodepage: UInt16); overload;
- destructor Destroy; override;
- function GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer; override;
- function GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte; AByteCount: Integer): Integer; override;
- function GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer; override;
- function GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PIdWideChar; ACharCount: Integer): Integer; override;
- function GetMaxByteCount(ACharCount: Integer): Integer; override;
- function GetMaxCharCount(AByteCount: Integer): Integer; override;
- end;
- {$ENDIF}
- { TIdTextEncodingBase }
- function ValidateChars(const AChars: TIdWideChars; ACharIndex, ACharCount: Integer): PIdWideChar;
- var
- Len: Integer;
- begin
- Len := Length(AChars);
- if (ACharIndex < 0) or (ACharIndex >= Len) then begin
- raise Exception.CreateResFmt(PResStringRec(@RSCharIndexOutOfBounds), [ACharIndex]);
- end;
- if ACharCount < 0 then begin
- raise Exception.CreateResFmt(PResStringRec(@RSInvalidCharCount), [ACharCount]);
- end;
- if (Len - ACharIndex) < ACharCount then begin
- raise Exception.CreateResFmt(PResStringRec(@RSInvalidCharCount), [ACharCount]);
- end;
- if ACharCount > 0 then begin
- Result := @AChars[ACharIndex];
- end else begin
- Result := nil;
- end;
- end;
- function ValidateBytes(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): PByte; overload;
- var
- Len: Integer;
- begin
- Len := Length(ABytes);
- if (AByteIndex < 0) or (AByteIndex >= Len) then begin
- raise Exception.CreateResFmt(PResStringRec(@RSInvalidDestinationIndex), [AByteIndex]);
- end;
- if (Len - AByteIndex) < AByteCount then begin
- raise Exception.CreateRes(PResStringRec(@RSInvalidDestinationArray));
- end;
- if AByteCount > 0 then begin
- Result := @ABytes[AByteIndex];
- end else begin
- Result := nil;
- end;
- end;
- function ValidateBytes(const ABytes: TIdBytes; AByteIndex, AByteCount, ANeeded: Integer): PByte; overload;
- var
- Len: Integer;
- begin
- Len := Length(ABytes);
- if (AByteIndex < 0) or (AByteIndex >= Len) then begin
- raise Exception.CreateResFmt(PResStringRec(@RSInvalidDestinationIndex), [AByteIndex]);
- end;
- if (Len - AByteIndex) < ANeeded then begin
- raise Exception.CreateRes(PResStringRec(@RSInvalidDestinationArray));
- end;
- if AByteCount > 0 then begin
- Result := @ABytes[AByteIndex];
- end else begin
- Result := nil;
- end;
- end;
- function ValidateStr(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): PIdWideChar;
- begin
- if ACharIndex < 1 then begin
- raise Exception.CreateResFmt(PResStringRec(@RSCharIndexOutOfBounds), [ACharIndex]);
- end;
- if ACharCount < 0 then begin
- raise Exception.CreateResFmt(PResStringRec(@RSInvalidCharCount), [ACharCount]);
- end;
- if (Length(AStr) - ACharIndex + 1) < ACharCount then begin
- raise Exception.CreateResFmt(PResStringRec(@RSInvalidCharCount), [ACharCount]);
- end;
- if ACharCount > 0 then begin
- Result := @AStr[ACharIndex];
- end else begin
- Result := nil;
- end;
- end;
- function TIdTextEncodingBase.GetByteCount(const AChars: TIdWideChars): Integer;
- begin
- if AChars <> nil then begin
- Result := GetByteCount(PIdWideChar(AChars), Length(AChars));
- end else begin
- Result := 0;
- end;
- end;
- function TIdTextEncodingBase.GetByteCount(const AChars: TIdWideChars;
- ACharIndex, ACharCount: Integer): Integer;
- var
- LChars: PIdWideChar;
- begin
- LChars := ValidateChars(AChars, ACharIndex, ACharCount);
- if LChars <> nil then begin
- Result := GetByteCount(LChars, ACharCount);
- end else begin
- Result := 0;
- end;
- end;
- function TIdTextEncodingBase.GetByteCount(const AStr: TIdUnicodeString): Integer;
- begin
- if AStr <> '' then begin
- Result := GetByteCount(PIdWideChar(AStr), Length(AStr));
- end else begin
- Result := 0;
- end;
- end;
- function TIdTextEncodingBase.GetByteCount(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): Integer;
- var
- LChars: PIdWideChar;
- begin
- LChars := ValidateStr(AStr, ACharIndex, ACharCount);
- if LChars <> nil then begin
- Result := GetByteCount(LChars, ACharCount);
- end else begin
- Result := 0;
- end;
- end;
- function TIdTextEncodingBase.GetBytes(const AChars: TIdWideChars): TIdBytes;
- begin
- if AChars <> nil then begin
- Result := GetBytes(PIdWideChar(AChars), Length(AChars));
- end else begin
- Result := nil;
- end;
- end;
- function TIdTextEncodingBase.GetBytes(const AChars: TIdWideChars;
- ACharIndex, ACharCount: Integer): TIdBytes;
- var
- Len: Integer;
- begin
- Result := nil;
- Len := GetByteCount(AChars, ACharIndex, ACharCount);
- if Len > 0 then begin
- SetLength(Result, Len);
- GetBytes(@AChars[ACharIndex], ACharCount, PByte(Result), Len);
- end;
- end;
- function TIdTextEncodingBase.GetBytes(const AChars: TIdWideChars;
- ACharIndex, ACharCount: Integer; var VBytes: TIdBytes; AByteIndex: Integer): Integer;
- begin
- Result := GetBytes(
- ValidateChars(AChars, ACharIndex, ACharCount),
- ACharCount, VBytes, AByteIndex);
- end;
- function TIdTextEncodingBase.GetBytes(const AChars: PIdWideChar; ACharCount: Integer): TIdBytes;
- var
- Len: Integer;
- begin
- Result := nil;
- Len := GetByteCount(AChars, ACharCount);
- if Len > 0 then begin
- SetLength(Result, Len);
- GetBytes(AChars, ACharCount, PByte(Result), Len);
- end;
- end;
- function TIdTextEncodingBase.GetBytes(const AChars: PIdWideChar; ACharCount: Integer;
- var VBytes: TIdBytes; AByteIndex: Integer): Integer;
- var
- Len, LByteCount: Integer;
- LBytes: PByte;
- begin
- if (AChars = nil) and (ACharCount <> 0) then begin
- raise Exception.CreateRes(PResStringRec(@RSInvalidSourceArray));
- end;
- if (VBytes = nil) and (ACharCount <> 0) then begin
- raise Exception.CreateRes(PResStringRec(@RSInvalidDestinationArray));
- end;
- if ACharCount < 0 then begin
- raise Exception.CreateResFmt(PResStringRec(@RSInvalidCharCount), [ACharCount]);
- end;
- Len := Length(VBytes);
- LByteCount := GetByteCount(AChars, ACharCount);
- LBytes := ValidateBytes(VBytes, AByteIndex, Len, LByteCount);
- Dec(Len, AByteIndex);
- if (ACharCount > 0) and (Len > 0) then begin
- Result := GetBytes(AChars, ACharCount, LBytes, LByteCount);
- end else begin
- Result := 0;
- end;
- end;
- function TIdTextEncodingBase.GetBytes(const AStr: TIdUnicodeString): TIdBytes;
- var
- Len: Integer;
- begin
- Result := nil;
- Len := GetByteCount(AStr);
- if Len > 0 then begin
- SetLength(Result, Len);
- GetBytes(PIdWideChar(AStr), Length(AStr), PByte(Result), Len);
- end;
- end;
- function TIdTextEncodingBase.GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer): TIdBytes;
- var
- Len: Integer;
- LChars: PIdWideChar;
- begin
- Result := nil;
- LChars := ValidateStr(AStr, ACharIndex, ACharCount);
- if LChars <> nil then begin
- Len := GetByteCount(LChars, ACharCount);
- if Len > 0 then begin
- SetLength(Result, Len);
- GetBytes(LChars, ACharCount, PByte(Result), Len);
- end;
- end;
- end;
- function TIdTextEncodingBase.GetBytes(const AStr: TIdUnicodeString; ACharIndex, ACharCount: Integer;
- var VBytes: TIdBytes; AByteIndex: Integer): Integer;
- var
- LChars: PIdWideChar;
- begin
- LChars := ValidateStr(AStr, ACharIndex, ACharCount);
- if LChars <> nil then begin
- Result := GetBytes(LChars, ACharCount, VBytes, AByteIndex);
- end else begin
- Result := 0;
- end;
- end;
- function TIdTextEncodingBase.GetCharCount(const ABytes: TIdBytes): Integer;
- begin
- if ABytes <> nil then begin
- Result := GetCharCount(PByte(ABytes), Length(ABytes));
- end else begin
- Result := 0;
- end;
- end;
- function TIdTextEncodingBase.GetCharCount(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): Integer;
- var
- LBytes: PByte;
- begin
- LBytes := ValidateBytes(ABytes, AByteIndex, AByteCount);
- if LBytes <> nil then begin
- Result := GetCharCount(LBytes, AByteCount);
- end else begin
- Result := 0;
- end;
- end;
- function TIdTextEncodingBase.GetChars(const ABytes: TIdBytes): TIdWideChars;
- begin
- if ABytes <> nil then begin
- Result := GetChars(PByte(ABytes), Length(ABytes));
- end else begin
- Result := nil;
- end;
- end;
- function TIdTextEncodingBase.GetChars(const ABytes: TIdBytes; AByteIndex, AByteCount: Integer): TIdWideChars;
- var
- Len: Integer;
- begin
- Result := nil;
- Len := GetCharCount(ABytes, AByteIndex, AByteCount);
- if Len > 0 then begin
- SetLength(Result, Len);
- GetChars(@ABytes[AByteIndex], AByteCount, PIdWideChar(Result), Len);
- end;
- end;
- function TIdTextEncodingBase.GetChars(const ABytes: TIdBytes;
- AByteIndex, AByteCount: Integer; var VChars: TIdWideChars; ACharIndex: Integer): Integer;
- var
- LBytes: PByte;
- begin
- LBytes := ValidateBytes(ABytes, AByteIndex, AByteCount);
- if LBytes <> nil then begin
- Result := GetChars(LBytes, AByteCount, VChars, ACharIndex);
- end else begin
- Result := 0;
- end;
- end;
- function TIdTextEncodingBase.GetChars(const ABytes: PByte; AByteCount: Integer): TIdWideChars;
- var
- Len: Integer;
- begin
- Len := GetCharCount(ABytes, AByteCount);
- if Len > 0 then begin
- SetLength(Result, Len);
- GetChars(ABytes, AByteCount, PIdWideChar(Result), Len);
- end;
- end;
- function TIdTextEncodingBase.GetChars(const ABytes: PByte; AByteCount: Integer;
- var VChars: TIdWideChars; ACharIndex: Integer): Integer;
- var
- LCharCount: Integer;
- begin
- if (ABytes = nil) and (AByteCount <> 0) then begin
- raise Exception.CreateRes(PResStringRec(@RSInvalidSourceArray));
- end;
- if AByteCount < 0 then begin
- raise Exception.CreateResFmt(PResStringRec(@RSInvalidCharCount), [AByteCount]);
- end;
- if (ACharIndex < 0) or (ACharIndex > Length(VChars)) then begin
- raise Exception.CreateResFmt(PResStringRec(@RSInvalidDestinationIndex), [ACharIndex]);
- end;
- LCharCount := GetCharCount(ABytes, AByteCount);
- if LCharCount > 0 then begin
- if (ACharIndex + LCharCount) > Length(VChars) then begin
- raise Exception.CreateRes(PResStringRec(@RSInvalidDestinationArray));
- end;
- Result := GetChars(ABytes, AByteCount, @VChars[ACharIndex], LCharCount);
- end else begin
- Result := 0;
- end;
- end;
- function TIdTextEncodingBase.GetIsSingleByte: Boolean;
- begin
- Result := FIsSingleByte;
- end;
- function TIdTextEncodingBase.GetPreamble: TIdBytes;
- begin
- SetLength(Result, 0);
- end;
- function TIdTextEncodingBase.GetString(const ABytes: TIdBytes): TIdUnicodeString;
- begin
- if ABytes <> nil then begin
- Result := GetString(PByte(ABytes), Length(ABytes));
- end else begin
- Result := '';
- end;
- end;
- function TIdTextEncodingBase.GetString(const ABytes: TIdBytes;
- AByteIndex, AByteCount: Integer): TIdUnicodeString;
- var
- Len: Integer;
- begin
- Result := '';
- Len := GetCharCount(ABytes, AByteIndex, AByteCount);
- if Len > 0 then begin
- SetLength(Result, Len);
- GetChars(@ABytes[AByteIndex], AByteCount, PIdWideChar(Result), Len);
- end;
- end;
- function TIdTextEncodingBase.GetString(const ABytes: PByte; AByteCount: Integer): TIdUnicodeString;
- var
- Len: Integer;
- begin
- Result := '';
- Len := GetCharCount(ABytes, AByteCount);
- if Len > 0 then begin
- SetLength(Result, Len);
- GetChars(ABytes, AByteCount, PIdWideChar(Result), Len);
- end;
- end;
- { TIdMBCSEncoding }
- function IsCharsetASCII(const ACharSet: string): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // TODO: when the IdCharsets unit is moved to the System
- // package, use CharsetToCodePage() here...
- Result := PosInStrArray(ACharSet,
- [
- 'US-ASCII', {do not localize}
- 'ANSI_X3.4-1968', {do not localize}
- 'iso-ir-6', {do not localize}
- 'ANSI_X3.4-1986', {do not localize}
- 'ISO_646.irv:1991', {do not localize}
- 'ASCII', {do not localize}
- 'ISO646-US', {do not localize}
- 'us', {do not localize}
- 'IBM367', {do not localize}
- 'cp367', {do not localize}
- 'csASCII' {do not localize}
- ], False) <> -1;
- end;
- {$IFNDEF SUPPORTS_CHARSET_ENCODING}
- {$IFNDEF HAS_LocaleCharsFromUnicode}
- {$IFDEF WINDOWS}
- {$IFNDEF HAS_PLongBool}
- type
- PLongBool = ^LongBool;
- {$ENDIF}
- function LocaleCharsFromUnicode(CodePage, Flags: Cardinal;
- UnicodeStr: PWideChar; UnicodeStrLen: Integer; LocaleStr: PAnsiChar;
- LocaleStrLen: Integer; DefaultChar: PAnsiChar; UsedDefaultChar: PLongBool): Integer; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := WideCharToMultiByte(CodePage, Flags, UnicodeStr, UnicodeStrLen, LocaleStr, LocaleStrLen, DefaultChar, PBOOL(UsedDefaultChar));
- end;
- {$DEFINE HAS_LocaleCharsFromUnicode}
- {$ENDIF}
- {$ENDIF}
- {$IFNDEF HAS_UnicodeFromLocaleChars}
- {$IFDEF WINDOWS}
- function UnicodeFromLocaleChars(CodePage, Flags: Cardinal; LocaleStr: PAnsiChar;
- LocaleStrLen: Integer; UnicodeStr: PWideChar; UnicodeStrLen: Integer): Integer; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := MultiByteToWideChar(CodePage, Flags, LocaleStr, LocaleStrLen, UnicodeStr, UnicodeStrLen);
- end;
- {$DEFINE HAS_UnicodeFromLocaleChars}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- constructor TIdMBCSEncoding.Create;
- begin
- {$IFDEF USE_ICONV}
- Create(iif(GIdIconvUseLocaleDependantAnsiEncoding, 'char', 'ASCII')); {do not localize}
- {$ELSE}
- {$IFDEF USE_LCONVENC}
- Create(GetDefaultTextEncoding());
- {$ELSE}
- {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
- Create(CP_ACP, 0, 0);
- {$ELSE}
- ToDo('Constructor of TIdMBCSEncoding class is not implemented for this platform yet'); {do not localize}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- end;
- {$IFDEF SUPPORTS_CHARSET_ENCODING}
- constructor TIdMBCSEncoding.Create(const CharSet: String);
- const
- // RLebeau: iconv() does not provide a maximum character byte size like
- // Microsoft does, so have to determine the max bytes by manually encoding
- // an actual Unicode codepoint. We'll encode the largest codepoint that
- // UTF-16 supports, U+10FFFF, for now...
- //
- cValue: array[0..3] of Byte = ({$IFDEF ENDIAN_BIG}$DB, $FF, $DF, $FF{$ELSE}$FF, $DB, $FF, $DF{$ENDIF});
- //cValue: array[0..1] of UInt16 = ($DBFF, $DFFF);
- begin
- inherited Create;
- // RLebeau 5/2/2017: have seen some malformed emails that use 'utf8'
- // instead of 'utf-8', so let's check for that...
- // RLebeau 9/27/2017: updating to handle a few more UTFs without hyphens...
- // RLebeau 7/6/2018: iconv does not have a way to query the highest Unicode
- // codepoint a charset supports, let alone the max bytes needed to encode such
- // a codepoint, so use known values for select charsets, and calculate
- // MaxCharSize dynamically for the rest...
- // TODO: normalize the FCharSet to make comparisons easier...
- 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}
- 0, 1: begin
- FCharSet := 'UTF-7'; {Do not Localize}
- FMaxCharSize := 5;
- end;
- 2, 3: begin
- FCharSet := 'UTF-8'; {Do not Localize}
- FMaxCharSize := 4;
- end;
- 4..7: begin
- FCharSet := 'UTF-16LE'; {Do not Localize}
- FMaxCharSize := 4;
- end;
- 8, 9: begin
- FCharSet := 'UTF-16BE'; {Do not Localize}
- FMaxCharSize := 4;
- end;
- 10..13: begin
- FCharSet := 'UTF-32LE'; {Do not Localize}
- FMaxCharSize := 4;
- end;
- 14, 15: begin
- FCharSet := 'UTF-32BE'; {Do not Localize}
- FMaxCharSize := 4;
- end;
- else
- FCharSet := CharSet;
- if TextStartsWith(CharSet, 'ISO-8859') or {Do not Localize}
- TextStartsWith(CharSet, 'Windows') or {Do not Localize}
- TextStartsWith(CharSet, 'KOI8') or {Do not Localize}
- IsCharsetASCII(CharSet) then
- begin
- FMaxCharSize := 1;
- end
- else begin
- FMaxCharSize := GetByteCount(PWideChar(@cValue[0]), 2);
- // Not all charsets support all codepoints. For example, ISO-8859-1 does
- // not support U+10FFFF. If GetByteCount() fails above, FMaxCharSize gets
- // set to 0, preventing any character conversions. So force FMaxCharSize
- // to 1 if GetByteCount() fails, until a better solution can be found.
- // Maybe loop through the codepoints until we find the largest one that is
- // supported by this charset..
- if FMaxCharSize = 0 then begin
- FMaxCharSize := 1;
- end;
- end;
- end;
- FIsSingleByte := (FMaxCharSize = 1);
- end;
- {$ELSE}
- {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
- constructor TIdMBCSEncoding.Create(CodePage: Integer);
- begin
- Create(CodePage, 0, 0);
- end;
- {$IFDEF WINDOWS}
- // TODO: move this into IdCompilerDefines.inc?
- {$IFNDEF WINCE}
- {$IFDEF DCC}
- {$IFDEF VCL_2009_OR_ABOVE}
- {$DEFINE HAS_GetCPInfoEx}
- {$ELSE}
- {$UNDEF HAS_GetCPInfoEx}
- {$ENDIF}
- {$ELSE}
- // TODO: when was GetCPInfoEx() added to FreePascal?
- {$DEFINE HAS_GetCPInfoEx}
- {$ENDIF}
- {$IFNDEF HAS_GetCPInfoEx}
- // TODO: implement GetCPInfoEx() as a stub that falls back to GetCPInfo() if needed
- type
- TCPInfoEx = record
- MaxCharSize: UINT; { max length (bytes) of a char }
- DefaultChar: array[0..MAX_DEFAULTCHAR - 1] of Byte; { default character }
- LeadByte: array[0..MAX_LEADBYTES - 1] of Byte; { lead byte ranges }
- UnicodeDefaultChar: WideChar;
- Codepage: UINT;
- CodePageName: array[0..MAX_PATH -1] of {$IFDEF UNICODE}WideChar{$ELSE}AnsiChar{$ENDIF};
- end;
- function GetCPInfoEx(CodePage: UINT; dwFlags: DWORD; var lpCPInfoEx: TCPInfoEx): BOOL; stdcall; external 'KERNEL32' name {$IFDEF UNICODE}'GetCPInfoExW'{$ELSE}'GetCPInfoExA'{$ENDIF};
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- constructor TIdMBCSEncoding.Create(CodePage, MBToWCharFlags, WCharToMBFlags: Integer);
- {$IFNDEF WINDOWS}
- const
- // RLebeau: have to determine the max bytes by manually encoding an actual
- // Unicode codepoint. We'll encode the largest codepoint that UTF-16 supports,
- // U+10FFFF, for now...
- //
- cValue: array[0..1] of UInt16 = ($DBFF, $DFFF);
- {$ELSE}
- var
- LCPInfo: {$IFDEF WINCE}TCPInfo{$ELSE}TCPInfoEx{$ENDIF};
- LError: Boolean;
- {$ENDIF}
- begin
- inherited Create;
- FCodePage := CodePage;
- FMBToWCharFlags := MBToWCharFlags;
- FWCharToMBFlags := WCharToMBFlags;
- {$IFDEF FPC} // TODO: do this for Delphi 2009+, too...
- if FCodePage = CP_ACP then begin
- FCodePage := DefaultSystemCodePage;
- end;
- {$ENDIF}
- {$IFDEF WINDOWS}
- LError := not {$IFDEF WINCE}GetCPInfo(FCodePage, LCPInfo){$ELSE}GetCPInfoEx(FCodePage, 0, LCPInfo){$ENDIF};
- if LError and (FCodePage = 20127) then begin
- // RLebeau: 20127 is the official codepage for ASCII, but not
- // all OS versions support that codepage, so fallback to 1252
- // or even 437...
- LError := not {$IFDEF WINCE}GetCPInfo(1252, LCPInfo){$ELSE}GetCPInfoEx(1252, 0, LCPInfo){$ENDIF};
- // just in case...
- if LError then begin
- LError := not {$IFDEF WINCE}GetCPInfo(437, LCPInfo){$ELSE}GetCPInfoEx(437, 0, LCPInfo){$ENDIF};
- end;
- end;
- if LError then begin
- raise EIdException.CreateResFmt(PResStringRec(@RSInvalidCodePage), [FCodePage]); // TODO: create a new Exception class for this
- end;
- {$IFNDEF WINCE}
- FCodePage := LCPInfo.CodePage;
- {$ENDIF}
- FMaxCharSize := LCPInfo.MaxCharSize;
- {$ELSE}
- case FCodePage of
- 65000: begin
- FMaxCharSize := 5;
- end;
- 65001: begin
- FMaxCharSize := 4;
- end;
- 1200: begin
- FMaxCharSize := 4;
- end;
- 1201: begin
- FMaxCharSize := 4;
- end;
- // TODO: add support for UTF-32...
- // TODO: add cases for 'ISO-8859-X', 'Windows-X', 'KOI8-X', and ASCII charsets...
- else
- FMaxCharSize := LocaleCharsFromUnicode(FCodePage, FWCharToMBFlags, @cValue[0], 2, nil, 0, nil, nil);
- if FMaxCharSize < 1 then begin
- raise EIdException.CreateResFmt(@RSInvalidCodePage, [FCodePage]); // TODO: create a new Exception class for this
- end;
- // Not all charsets support all codepoints. For example, ISO-8859-1 does
- // not support U+10FFFF. If LocaleCharsFromUnicode() fails above,
- // FMaxCharSize gets set to 0, preventing any character conversions. So
- // force FMaxCharSize to 1 if GetByteCount() fails, until a better solution
- // can be found. Maybe loop through the codepoints until we find the largest
- // one that is supported by this codepage (though that will take time). Or
- // at least implement a lookup table for the more commonly used charsets...
- if FMaxCharSize = 0 then begin
- FMaxCharSize := 1;
- end;
- end;
- {$ENDIF}
- FIsSingleByte := (FMaxCharSize = 1);
- end;
- {$ENDIF}
- {$ENDIF}
- {$IFDEF USE_ICONV}
- function CreateIconvHandle(const ACharSet: String; AToUTF16: Boolean): iconv_t;
- const
- // RLebeau: iconv() outputs a UTF-16 BOM if data is converted to the generic
- // "UTF-16" charset. We do not want that, so we will use the "UTF-16LE/BE"
- // charset explicitally instead so no BOM is outputted. This also saves us
- // from having to manually detect the presense of a BOM and strip it out.
- //
- // TODO: should we be using UTF-16LE or UTF-16BE on big-endian systems?
- // Delphi uses UTF-16LE, but what does FreePascal use? Let's err on the
- // side of caution until we know otherwise...
- //
- cUTF16CharSet = {$IFDEF ENDIAN_BIG}'UTF-16BE'{$ELSE}'UTF-16LE'{$ENDIF}; {do not localize}
- var
- LToCharSet, LFromCharSet, LFlags: String;
- {$IFDEF USE_MARSHALLED_PTRS}
- M: TMarshaller;
- {$ENDIF}
- begin
- // on some systems, //IGNORE must be specified before //TRANSLIT if they
- // are used together, otherwise //IGNORE gets ignored!
- LFlags := '';
- if GIdIconvIgnoreIllegalChars then begin
- LFlags := LFlags + '//IGNORE'; {do not localize}
- end;
- if GIdIconvUseTransliteration then begin
- LFlags := LFlags + '//TRANSLIT'; {do not localize}
- end;
- if AToUTF16 then begin
- LToCharSet := cUTF16CharSet + LFlags;
- LFromCharSet := ACharSet;
- end else begin
- LToCharSet := ACharSet + LFlags;
- LFromCharSet := cUTF16CharSet;
- end;
- Result := iconv_open(
- {$IFDEF USE_MARSHALLED_PTRS}
- M.AsAnsi(LToCharSet).ToPointer,
- M.AsAnsi(LFromCharSet).ToPointer
- {$ELSE}
- PAnsiChar(
- {$IFDEF STRING_IS_ANSI}
- LToCharSet
- {$ELSE}
- AnsiString(LToCharSet) // explicit convert to Ansi
- {$ENDIF}
- ),
- PAnsiChar(
- {$IFDEF STRING_IS_ANSI}
- LFromCharSet
- {$ELSE}
- AnsiString(LFromCharSet) // explicit convert to Ansi
- {$ENDIF}
- )
- {$ENDIF}
- );
- if Result = iconv_t(-1) then begin
- if LFlags <> '' then begin
- raise EIdException.CreateResFmt(@RSInvalidCharSetConvWithFlags, [ACharSet, cUTF16CharSet, LFlags]); // TODO: create a new Exception class for this
- end else begin
- raise EIdException.CreateResFmt(@RSInvalidCharSetConv, [ACharSet, cUTF16CharSet]); // TODO: create a new Exception class for this
- end;
- end;
- end;
- function CalcUTF16ByteSize(AChars: PWideChar; ACharCount: Integer): Integer;
- var
- C: WideChar;
- LCount: Integer;
- begin
- C := AChars^;
- if (C >= #$D800) and (C <= #$DFFF) then
- begin
- Result := 0;
- if C > #$DBFF then begin
- // invalid high surrogate
- Exit;
- end;
- if ACharCount = 1 then begin
- // missing low surrogate
- Exit;
- end;
- Inc(AChars);
- C := AChars^;
- if (C < #$DC00) or (C > #$DFFF) then begin
- // invalid low surrogate
- Exit;
- end;
- LCount := 2;
- end else begin
- LCount := 1;
- end;
- Result := LCount * SizeOf(WideChar);
- end;
- {$ENDIF}
- {$IFDEF USE_ICONV}
- function DoIconvCharsToBytes(const ACharset: string; AChars: PIdWideChar; ACharCount: Integer;
- ABytes: PByte; AByteCount: Integer; ABytesIsTemp: Boolean): Integer;
- var
- LSrcCharsPtr: PIdWideChar;
- LCharsPtr, LBytesPtr: PAnsiChar;
- LSrcCharSize, LCharSize, LByteSize: size_t;
- LCharsRead, LBytesWritten: Integer;
- LIconv: iconv_t;
- begin
- Result := 0;
- if (AChars = nil) or (ACharCount < 1) or ((ABytes <> nil) and (AByteCount < 1)) then begin
- Exit;
- end;
- LIconv := CreateIconvHandle(ACharSet, False);
- try
- // RLebeau: iconv() does not allow for querying a pre-calculated byte size
- // for the input like Microsoft does, so have to determine the max bytes
- // by actually encoding the Unicode data to a real buffer. When ABytesIsTemp
- // is True, we are encoding to a small local buffer so we don't have to use
- // a lot of memory. We also have to encode the input 1 Unicode codepoint at
- // a time to avoid iconv() returning an E2BIG error if multiple UTF-16
- // sequences were decoded to a length that would exceed the size of the
- // local buffer.
- //Kylix has an odd definition in iconv. In Kylix, __outbytesleft is defined as a var
- //while in FreePascal's libc and our IdIconv units define it as a pSize_t
- // reset to initial state
- LByteSize := 0;
- if iconv(LIconv, nil, nil, nil, {$IFNDEF KYLIX}@{$ENDIF}LByteSize) = size_t(-1) then begin
- Exit;
- end;
- // do the conversion
- LSrcCharsPtr := AChars;
- repeat
- if LSrcCharsPtr <> nil then begin
- LSrcCharSize := CalcUTF16ByteSize(LSrcCharsPtr, ACharCount);
- if LSrcCharSize = 0 then begin
- Result := 0;
- Exit;
- end;
- end else begin
- LSrcCharSize := 0;
- end;
- LCharsPtr := PAnsiChar(LSrcCharsPtr);
- LCharSize := LSrcCharSize;
- LBytesPtr := PAnsiChar(ABytes);
- LByteSize := AByteCount;
- if iconv(LIconv, @LCharsPtr, @LCharSize, @LBytesPtr, {$IFNDEF KYLIX}@{$ENDIF}LByteSize) = size_t(-1) then
- begin
- Exit;
- end;
- // LByteSize was decremented by the number of bytes stored in the output buffer
- LBytesWritten := AByteCount - LByteSize;
- Inc(Result, LBytesWritten);
- if LSrcCharsPtr = nil then begin
- Exit;
- end;
- if not ABytesIsTemp then begin
- Inc(ABytes, LBytesWritten);
- Dec(AByteCount, LBytesWritten);
- end;
- // LCharSize was decremented by the number of bytes read from the input buffer
- LCharsRead := (LSrcCharSize-LCharSize) div SizeOf(WideChar);
- Inc(LSrcCharsPtr, LCharsRead);
- Dec(ACharCount, LCharsRead);
- if ACharCount < 1 then
- begin
- // After all characters are handled, the output buffer has to be flushed
- // This is done by running one more iteration, without an input buffer
- LSrcCharsPtr := nil;
- end;
- until False;
- finally
- iconv_close(LIconv);
- end;
- end;
- {$ENDIF}
- {$IFDEF USE_LCONVENC}
- function DoLconvCharsToBytes(const ACharset: string; AChars: PIdWideChar; ACharCount: Integer;
- ABytes: PByte; AByteCount: Integer): Integer;
- var
- LTmpStr : TIdUnicodeString;
- LUTF8, LConverted : RawByteString;
- LEncoded : Boolean;
- begin
- Result := 0;
- if (AChars = nil) or (ACharCount < 1) or ((ABytes <> nil) and (AByteCount < 1)) then begin
- Exit;
- end;
-
- // TODO: encode the input chars directly to UTF-8 without
- // having to create a temp UnicodeString first...
- SetString(LTmpStr, PIdWideChar(AChars), ACharCount);
- LUTF8 := UTF8Encode(LTmpStr);
- case PosInStrArray(ACharSet, ['UTF-8', 'UTF8', EncodingAnsi], False) of {do not localize}
- 0, 1: begin
- // For UTF-8 to UTF-8, ConvertEncodingFromUTF8() does nothing and returns False (FPC bug?).
- // The input has already been converted above, so let's just use the existing bytes as-is...
- LConverted := LUTF8;
- end;
- 2: begin
- // For UTF-8 to ANSI (system enc), ConvertEncodingFromUTF8() does nothing and returns False
- // if ConvertUTF8ToAnsi is not assigned, so let's just assume UTF-8 for now...
- LConverted := ConvertEncodingFromUTF8(LUTF8, ACharSet, LEncoded);
- if not LEncoded then begin
- LConverted := LUTF8;
- end;
- end;
- else
- LConverted := ConvertEncodingFromUTF8(LUTF8, ACharSet, LEncoded);
- if not LEncoded then begin
- // TODO: uncomment this?
- //raise EIdException.CreateResFmt(@RSInvalidCharSetConv, [ACharSet, cUTF16CharSet]); // TODO: create a new Exception class for this
- Exit;
- end;
- end;
- Result := Length(LConverted);
- if (ABytes <> nil) and (Result > 0) then begin
- Result := IndyMin(Result, AByteCount);
- // TODO: don't output partial character sequences...
- Move(PIdAnsiChar(LConverted)^, ABytes^, Result * SizeOf(TIdAnsiChar));
- end;
- end;
- {$ENDIF}
- function TIdMBCSEncoding.GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer;
- {$IFDEF USE_ICONV}
- var
- // TODO: size this dynamically to accomodate FMaxCharSize, plus some extra padding for safety...
- LBytes: array[0..7] of Byte;
- {$ENDIF}
- begin
- {$IFDEF USE_ICONV}
- Result := DoIconvCharsToBytes(FCharset, AChars, ACharCount, @LBytes[0], Length(LBytes), True);
- {$ELSE}
- {$IFDEF USE_LCONVENC}
- Result := DoLconvCharsToBytes(FCharset, AChars, ACharCount, nil, 0);
- {$ELSE}
- {$IFDEF HAS_LocaleCharsFromUnicode}
- Result := LocaleCharsFromUnicode(FCodePage, FWCharToMBFlags, AChars, ACharCount, nil, 0, nil, nil);
- {$ELSE}
- Result := 0;
- ToDo('GetByteCount() method of TIdMBCSEncoding class is not implemented for this platform yet'); {do not localize}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- end;
- function TIdMBCSEncoding.GetBytes(const AChars: PIdWideChar; ACharCount: Integer; ABytes: PByte;
- AByteCount: Integer): Integer;
- begin
- {$IFDEF USE_ICONV}
- Assert (ABytes <> nil, 'TIdMBCSEncoding.GetBytes Bytes can not be nil');
- Result := DoIconvCharsToBytes(FCharset, AChars, ACharCount, ABytes, AByteCount, False);
- {$ELSE}
- {$IFDEF USE_LCONVENC}
- Result := DoLconvCharsToBytes(FCharset, AChars, ACharCount, ABytes, AByteCount);
- {$ELSE}
- {$IFDEF HAS_LocaleCharsFromUnicode}
- Result := LocaleCharsFromUnicode(FCodePage, FWCharToMBFlags, AChars, ACharCount, {$IFNDEF HAS_PAnsiChar}Pointer{$ELSE}PAnsiChar{$ENDIF}(ABytes), AByteCount, nil, nil);
- {$ELSE}
- Result := 0;
- ToDo('GetBytes() method of TIdMBCSEncoding class is not implemented for this platform yet'); {do not localize}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- end;
- {$IFDEF USE_ICONV}
- function DoIconvBytesToChars(const ACharset: string; const ABytes: PByte; AByteCount: Integer;
- AChars: PWideChar; ACharCount: Integer; AMaxCharSize: Integer; ACharsIsTemp: Boolean): Integer;
- var
- LSrcBytesPtr: PByte;
- LBytesPtr, LCharsPtr: PAnsiChar;
- LByteSize, LCharsSize: size_t;
- I, LDestCharSize, LMaxBytesSize, LBytesRead, LCharsWritten: Integer;
- LConverted: Boolean;
- LIconv: iconv_t;
- begin
- Result := 0;
- if (ABytes = nil) or (AByteCount = 0) or ((AChars <> nil) and (ACharCount < 1)) then begin
- Exit;
- end;
- LIconv := CreateIconvHandle(ACharset, True);
- try
- // RLebeau: iconv() does not allow for querying a pre-calculated character count
- // for the input like Microsoft does, so have to determine the max characters
- // by actually encoding the Ansi data to a real buffer. If ACharsIsTemp is True
- // then we are encoding to a small local buffer so we don't have to use a lot of
- // memory. We also have to encode the input 1 Unicode codepoint at a time to
- // avoid iconv() returning an E2BIG error if multiple MBCS sequences were decoded
- // to a length that would exceed the size of the local buffer.
- //Kylix has an odd definition in iconv. In Kylix, __outbytesleft is defined as a var
- //while in FreePascal's libc and our IdIconv units define it as a pSize_t
- // reset to initial state
- LCharsSize := 0;
- if iconv(LIconv, nil, nil, nil, {$IFNDEF KYLIX}@{$ENDIF}LCharsSize) = size_t(-1) then
- begin
- Exit;
- end;
- // do the conversion
- LSrcBytesPtr := ABytes;
- repeat
- LMaxBytesSize := IndyMin(AByteCount, AMaxCharSize);
- LDestCharSize := ACharCount * SizeOf(WideChar);
- if LSrcBytesPtr = nil then
- begin
- LBytesPtr := nil;
- LByteSize := 0;
- LCharsPtr := PAnsiChar(AChars);
- LCharsSize := LDestCharSize;
- if iconv(LIconv, @LBytesPtr, @LByteSize, @LCharsPtr, {$IFNDEF KYLIX}@{$ENDIF}LCharsSize) = size_t(-1) then
- begin
- Result := 0;
- end else
- begin
- // LCharsSize was decremented by the number of bytes stored in the output buffer
- Inc(Result, (LDestCharSize-LCharsSize) div SizeOf(WideChar));
- end;
- Exit;
- end;
- // TODO: figure out a better way to calculate the number of input bytes
- // needed to generate a single UTF-16 output sequence...
- LMaxBytesSize := IndyMin(AByteCount, AMaxCharSize);
- LConverted := False;
- for I := 1 to LMaxBytesSize do
- begin
- LBytesPtr := PAnsiChar(LSrcBytesPtr);
- LByteSize := I;
- LCharsPtr := PAnsiChar(AChars);
- LCharsSize := LDestCharSize;
- if iconv(LIconv, @LBytesPtr, @LByteSize, @LCharsPtr, {$IFNDEF KYLIX}@{$ENDIF}LCharsSize) <> size_t(-1) then
- begin
- LConverted := True;
- // LCharsSize was decremented by the number of bytes stored in the output buffer
- LCharsWritten := (LDestCharSize-LCharsSize) div SizeOf(WideChar);
- Inc(Result, LCharsWritten);
- if LSrcBytesPtr = nil then begin
- Exit;
- end;
- if not ACharsIsTemp then begin
- Inc(AChars, LCharsWritten);
- Dec(ACharCount, LCharsWritten);
- end;
- // LByteSize was decremented by the number of bytes read from the input buffer
- LBytesRead := I - LByteSize;
- Inc(LSrcBytesPtr, LBytesRead);
- Dec(AByteCount, LBytesRead);
- if AByteCount < 1 then begin
- // After all bytes are handled, the output buffer has to be flushed
- // This is done by running one more iteration, without an input buffer
- LSrcBytesPtr := nil;
- end;
- Break;
- end;
- end;
- if not LConverted then begin
- Result := 0;
- Exit;
- end;
- until False;
- finally
- iconv_close(LIconv);
- end;
- end;
- {$ENDIF}
- {$IFDEF USE_LCONVENC}
- function DoLconvBytesToChars(const ACharset: string; const ABytes: PByte; AByteCount: Integer;
- AChars: PWideChar; ACharCount: Integer): Integer;
- var
- LBytes, LConverted: RawByteString;
- LDecoded : TIdUnicodeString;
- LEncoded : Boolean;
- C: TIdWideChar;
- begin
- Result := 0;
- if (ABytes = nil) or (AByteCount < 1) or ((AChars <> nil) and (ACharCount < 1)) then begin
- Exit;
- end;
- SetString(LBytes, PIdAnsiChar(ABytes), AByteCount);
- case PosInStrArray(ACharSet, ['UTF-8', 'UTF8', EncodingAnsi], False) of {do not localize}
- 0, 1: begin
- // For UTF-8 to UTF-8, ConvertEncodingToUTF8() does nothing and returns False (FPC bug?).
- // The input is already in UTF-8, so let's just use the existing bytes as-is...
- LConverted := LBytes;
- end;
- 2: begin
- // For ANSI (system enc) to UTF-8, ConvertEncodingToUTF8() does nothing and returns False
- // if ConvertAnsiToUTF8 is not assigned, so let's just assume UTF-8 for now...
- LConverted := ConvertEncodingToUTF8(LBytes, ACharSet, LEncoded);
- if not LEncoded then begin
- LConverted := LBytes;
- end;
- end;
- else
- LConverted := ConvertEncodingToUTF8(LBytes, ACharSet, LEncoded);
- if not LEncoded then begin
- // TODO: uncomment this?
- //raise EIdException.CreateResFmt(@RSInvalidCharSetConv, [ACharSet, cUTF16CharSet]); // TODO: create a new Exception class for this
- Exit;
- end;
- end;
- // TODO: decode the UTF-8 directly to the output chars without
- // having to create a temp UnicodeString first...
- LDecoded := UTF8Decode(LConverted);
- Result := Length(LDecoded);
- if (AChars <> nil) and (Result > 0) then begin
- Result := IndyMin(Result, ACharCount);
- // RLebeau: if the last encoded character is a UTF-16 high surrogate, don't output it...
- if Result > 0 then begin
- C := LDecoded[Result];
- if (C >= #$D800) and (C <= #$DBFF) then begin
- Dec(Result);
- end;
- end;
- Move(PIdWideChar(LDecoded)^, AChars^, Result * SizeOf(TIdWideChar));
- end;
- end;
- {$ENDIF}
- function TIdMBCSEncoding.GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer;
- {$IFDEF USE_ICONV}
- var
- LChars: array[0..3] of WideChar;
- {$ENDIF}
- begin
- {$IFDEF USE_ICONV}
- Result := DoIconvBytesToChars(FCharSet, ABytes, AByteCount, @LChars[0], Length(LChars), FMaxCharSize, True);
- {$ELSE}
- {$IFDEF USE_LCONVENC}
- Result := DoLconvBytesToChars(FCharSet, ABytes, AByteCount, nil, 0);
- {$ELSE}
- {$IFDEF HAS_UnicodeFromLocaleChars}
- Result := UnicodeFromLocaleChars(FCodePage, FMBToWCharFlags, {$IFNDEF HAS_PAnsiChar}Pointer{$ELSE}PAnsiChar{$ENDIF}(ABytes), AByteCount, nil, 0);
- {$ELSE}
- Result := 0;
- ToDo('GetCharCount() method of TIdMBCSEncoding class is not implemented for this platform yet'); {do not localize}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- end;
- function TIdMBCSEncoding.GetChars(const ABytes: PByte; AByteCount: Integer; AChars: PWideChar;
- ACharCount: Integer): Integer;
- begin
- {$IFDEF USE_ICONV}
- Result := DoIconvBytesToChars(FCharSet, ABytes, AByteCount, AChars, ACharCount, FMaxCharSize, False);
- {$ELSE}
- {$IFDEF USE_LCONVENC}
- Result := DoLconvBytesToChars(FCharSet, ABytes, AByteCount, AChars, ACharCount);
- {$ELSE}
- {$IFDEF HAS_UnicodeFromLocaleChars}
- Result := UnicodeFromLocaleChars(FCodePage, FMBToWCharFlags, {$IFNDEF HAS_PAnsiChar}Pointer{$ELSE}PAnsiChar{$ENDIF}(ABytes), AByteCount, AChars, ACharCount);
- {$ELSE}
- Result := 0;
- ToDo('GetChars() method of TIdMBCSEncoding class is not implemented for this platform yet'); {do not localize}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- end;
- function TIdMBCSEncoding.GetMaxByteCount(CharCount: Integer): Integer;
- begin
- Result := (CharCount + 1) * FMaxCharSize;
- end;
- function TIdMBCSEncoding.GetMaxCharCount(ByteCount: Integer): Integer;
- begin
- Result := ByteCount;
- end;
- function TIdMBCSEncoding.GetPreamble: TIdBytes;
- begin
- {$IFDEF SUPPORTS_CHARSET_ENCODING}
- // RLebeau 5/2/2017: have seen some malformed emails that use 'utf8'
- // instead of 'utf-8', so let's check for that...
- // RLebeau 9/27/2017: updating to handle a few more UTFs without hyphens...
- // TODO: normalize the FCharSet to make comparisons easier...
- 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}
- 0, 1: begin
- SetLength(Result, 3);
- Result[0] := $EF;
- Result[1] := $BB;
- Result[2] := $BF;
- end;
- 2..5: begin
- SetLength(Result, 2);
- Result[0] := $FF;
- Result[1] := $FE;
- end;
- 6, 7: begin
- SetLength(Result, 2);
- Result[0] := $FE;
- Result[1] := $FF;
- end;
- 8..11: begin
- SetLength(Result, 4);
- Result[0] := $FF;
- Result[1] := $FE;
- Result[2] := $00;
- Result[3] := $00;
- end;
- 12, 13: begin
- SetLength(Result, 4);
- Result[0] := $00;
- Result[1] := $00;
- Result[2] := $FE;
- Result[3] := $FF;
- end;
- else
- SetLength(Result, 0);
- end;
- {$ELSE}
- {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
- case FCodePage of
- CP_UTF8: begin
- SetLength(Result, 3);
- Result[0] := $EF;
- Result[1] := $BB;
- Result[2] := $BF;
- end;
- 1200: begin
- SetLength(Result, 2);
- Result[0] := $FF;
- Result[1] := $FE;
- end;
- 1201: begin
- SetLength(Result, 2);
- Result[0] := $FE;
- Result[1] := $FF;
- end;
- 12000: begin
- SetLength(Result, 4);
- Result[0] := $FF;
- Result[1] := $FE;
- Result[2] := $00;
- Result[3] := $00;
- end;
- 12001: begin
- SetLength(Result, 4);
- Result[0] := $00;
- Result[1] := $00;
- Result[2] := $FE;
- Result[3] := $FF;
- end;
- else
- SetLength(Result, 0);
- end;
- {$ELSE}
- SetLength(Result, 0);
- ToDo('GetPreamble() method of TIdMBCSEncoding class is not implemented for this platform yet'); {do not localize}
- {$ENDIF}
- {$ENDIF}
- end;
- { TIdUTF7Encoding }
- constructor TIdUTF7Encoding.Create;
- begin
- {$IFDEF SUPPORTS_CHARSET_ENCODING}
- // RLebeau 7/6/2018: iconv does not have a way to query the highest Unicode codepoint
- // a charset supports, let alone the max bytes needed to encode such a codepoint, so
- // the inherited constructor tries to calculate MaxCharSize dynamically, which doesn't
- // work very well for most charsets. Since we already know the exact value to use for
- // this charset, let's just skip the inherited constructor and hard-code the value here...
- //
- //inherited Create('UTF-7'); {do not localize}
- FCharSet := 'UTF-7'; {do not localize};
- FIsSingleByte := False;
- FMaxCharSize := 5;
- {$ELSE}
- {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
- inherited Create(CP_UTF7);
- {$ELSE}
- ToDo('Constructor of TIdUTF7Encoding class is not implemented for this platform yet'); {do not localize}
- {$ENDIF}
- {$ENDIF}
- end;
- function TIdUTF7Encoding.GetMaxByteCount(CharCount: Integer): Integer;
- begin
- Result := (CharCount * 3) + 2;
- end;
- function TIdUTF7Encoding.GetMaxCharCount(ByteCount: Integer): Integer;
- begin
- Result := ByteCount;
- end;
- { TIdUTF8Encoding }
- // TODO: implement UTF-8 manually so we don't have to deal with codepage issues...
- constructor TIdUTF8Encoding.Create;
- begin
- {$IFDEF SUPPORTS_CHARSET_ENCODING}
- // RLebeau 7/6/2018: iconv does not have a way to query the highest Unicode codepoint
- // a charset supports, let alone the max bytes needed to encode such a codepoint, so
- // the inherited constructor tries to calculate MaxCharSize dynamically, which doesn't
- // work very well for most charsets. Since we already know the exact value to use for
- // this charset, let's just skip the inherited constructor and hard-code the value here...
- //
- //inherited Create('UTF-8'); {do not localize}
- FCharSet := 'UTF-8'; {do not localize};
- FIsSingleByte := False;
- FMaxCharSize := 4;
- {$ELSE}
- {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
- inherited Create(CP_UTF8);
- {$ELSE}
- ToDo('Constructor of TIdUTF8Encoding class is not implemented for this platform yet'); {do not localize}
- {$ENDIF}
- {$ENDIF}
- end;
- function TIdUTF8Encoding.GetMaxByteCount(CharCount: Integer): Integer;
- begin
- Result := (CharCount + 1) * 3;
- end;
- function TIdUTF8Encoding.GetMaxCharCount(ByteCount: Integer): Integer;
- begin
- Result := ByteCount + 1;
- end;
- function TIdUTF8Encoding.GetPreamble: TIdBytes;
- begin
- SetLength(Result, 3);
- Result[0] := $EF;
- Result[1] := $BB;
- Result[2] := $BF;
- end;
- { TIdUTF16LittleEndianEncoding }
- constructor TIdUTF16LittleEndianEncoding.Create;
- begin
- inherited Create;
- FIsSingleByte := False;
- FMaxCharSize := 4;
- end;
- function TIdUTF16LittleEndianEncoding.GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer;
- begin
- // TODO: verify UTF-16 sequences
- Result := ACharCount * SizeOf(WideChar);
- end;
- function TIdUTF16LittleEndianEncoding.GetBytes(const AChars: PIdWideChar; ACharCount: Integer;
- ABytes: PByte; AByteCount: Integer): Integer;
- {$IFDEF ENDIAN_BIG}
- var
- I: Integer;
- LChars: PIdWideChar;
- C: UInt16;
- {$ENDIF}
- begin
- // TODO: verify UTF-16 sequences
- {$IFDEF ENDIAN_BIG}
- LChars := AChars;
- for I := ACharCount - 1 downto 0 do
- begin
- C := UInt16(LChars^);
- ABytes^ := Hi(C);
- Inc(ABytes);
- ABytes^ := Lo(C);
- Inc(ABytes);
- Inc(LChars);
- end;
- Result := ACharCount * SizeOf(WideChar);
- {$ELSE}
- Result := ACharCount * SizeOf(WideChar);
- Move(AChars^, ABytes^, Result);
- {$ENDIF}
- end;
- function TIdUTF16LittleEndianEncoding.GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer;
- begin
- // TODO: verify UTF-16 sequences
- Result := AByteCount div SizeOf(WideChar);
- end;
- function TIdUTF16LittleEndianEncoding.GetChars(const ABytes: PByte; AByteCount: Integer;
- AChars: PIdWideChar; ACharCount: Integer): Integer;
- {$IFDEF ENDIAN_BIG}
- var
- LBytes1, LBytes2: PByte;
- I: Integer;
- {$ENDIF}
- begin
- // TODO: verify UTF-16 sequences
- {$IFDEF ENDIAN_BIG}
- LBytes1 := ABytes;
- LBytes2 := ABytes;
- Inc(LBytes2);
- for I := 0 to ACharCount - 1 do
- begin
- AChars^ := WideChar(MakeWord(LBytes2^, LBytes1^));
- Inc(LBytes1, 2);
- Inc(LBytes2, 2);
- Inc(AChars);
- end;
- Result := ACharCount;
- {$ELSE}
- Result := AByteCount div SizeOf(WideChar);
- Move(ABytes^, AChars^, Result * SizeOf(WideChar));
- {$ENDIF}
- end;
- function TIdUTF16LittleEndianEncoding.GetMaxByteCount(CharCount: Integer): Integer;
- begin
- Result := (CharCount + 1) * 2;
- end;
- function TIdUTF16LittleEndianEncoding.GetMaxCharCount(ByteCount: Integer): Integer;
- begin
- Result := (ByteCount div SizeOf(WideChar)) + (ByteCount and 1) + 1;
- end;
- function TIdUTF16LittleEndianEncoding.GetPreamble: TIdBytes;
- begin
- SetLength(Result, 2);
- Result[0] := $FF;
- Result[1] := $FE;
- end;
- { TIdUTF16BigEndianEncoding }
- function TIdUTF16BigEndianEncoding.GetBytes(const AChars: PIdWideChar; ACharCount: Integer;
- ABytes: PByte; AByteCount: Integer): Integer;
- {$IFDEF ENDIAN_LITTLE}
- var
- I: Integer;
- P: PIdWideChar;
- C: UInt16;
- {$ENDIF}
- begin
- {$IFDEF ENDIAN_LITTLE}
- P := AChars;
- for I := ACharCount - 1 downto 0 do
- begin
- C := UInt16(P^);
- ABytes^ := Hi(C);
- Inc(ABytes);
- ABytes^ := Lo(C);
- Inc(ABytes);
- Inc(P);
- end;
- Result := ACharCount * SizeOf(WideChar);
- {$ELSE}
- Result := ACharCount * SizeOf(WideChar);
- Move(AChars^, ABytes^, Result);
- {$ENDIF}
- end;
- function TIdUTF16BigEndianEncoding.GetChars(const ABytes: PByte; AByteCount: Integer;
- AChars: PIdWideChar; ACharCount: Integer): Integer;
- {$IFDEF ENDIAN_LITTLE}
- var
- P1, P2: PByte;
- I: Integer;
- {$ENDIF}
- begin
- {$IFDEF ENDIAN_LITTLE}
- P1 := ABytes;
- P2 := P1;
- Inc(P1);
- for I := 0 to ACharCount - 1 do
- begin
- AChars^ := WideChar(MakeWord(P1^, P2^));
- Inc(P2, 2);
- Inc(P1, 2);
- Inc(AChars);
- end;
- Result := ACharCount;
- {$ELSE}
- Result := AByteCount div SizeOf(WideChar);
- Move(ABytes^, AChars^, Result * SizeOf(WideChar));
- {$ENDIF}
- end;
- function TIdUTF16BigEndianEncoding.GetPreamble: TIdBytes;
- begin
- SetLength(Result, 2);
- Result[0] := $FE;
- Result[1] := $FF;
- end;
- { TIdASCIIEncoding }
- constructor TIdASCIIEncoding.Create;
- begin
- inherited Create;
- FIsSingleByte := True;
- FMaxCharSize := 1;
- end;
- function TIdASCIIEncoding.GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer;
- begin
- // TODO: decode UTF-16 surrogates...
- Result := ACharCount;
- end;
- function TIdASCIIEncoding.GetBytes(const AChars: PIdWideChar; ACharCount: Integer;
- ABytes: PByte; AByteCount: Integer): Integer;
- var
- P: PIdWideChar;
- i : Integer;
- begin
- // TODO: decode UTF-16 surrogates...
- P := AChars;
- Result := IndyMin(ACharCount, AByteCount);
- for i := 1 to Result do begin
- // replace illegal characters > $7F
- if UInt16(P^) > $007F then begin
- ABytes^ := Byte(Ord('?'));
- end else begin
- ABytes^ := Byte(P^);
- end;
- //advance to next char
- Inc(P);
- Inc(ABytes);
- end;
- end;
- function TIdASCIIEncoding.GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer;
- begin
- Result := AByteCount;
- end;
- function TIdASCIIEncoding.GetChars(const ABytes: PByte; AByteCount: Integer;
- AChars: PIdWideChar; ACharCount: Integer): Integer;
- var
- P: PByte;
- i : Integer;
- begin
- P := ABytes;
- Result := IndyMin(ACharCount, AByteCount);
- for i := 1 to Result do begin
- // This is an invalid byte in the ASCII encoding.
- if P^ > $7F then begin
- UInt16(AChars^) := $FFFD;
- end else begin
- UInt16(AChars^) := P^;
- end;
- //advance to next byte
- Inc(AChars);
- Inc(P);
- end;
- end;
- function TIdASCIIEncoding.GetMaxByteCount(ACharCount: Integer): Integer;
- begin
- Result := ACharCount;
- end;
- function TIdASCIIEncoding.GetMaxCharCount(AByteCount: Integer): Integer;
- begin
- Result := AByteCount;
- end;
- { TId8BitEncoding }
- constructor TId8BitEncoding.Create;
- begin
- inherited Create;
- FIsSingleByte := True;
- FMaxCharSize := 1;
- end;
- function TId8BitEncoding.GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer;
- begin
- // TODO: decode UTF-16 surrogates...
- Result := ACharCount;
- end;
- function TId8BitEncoding.GetBytes(const AChars: PIdWideChar; ACharCount: Integer;
- ABytes: PByte; AByteCount: Integer): Integer;
- var
- P: PIdWideChar;
- i : Integer;
- begin
- // TODO: decode UTF-16 surrogates...
- P := AChars;
- Result := IndyMin(ACharCount, AByteCount);
- for i := 1 to Result do begin
- // replace illegal characters > $FF
- if UInt16(P^) > $00FF then begin
- ABytes^ := Byte(Ord('?'));
- end else begin
- ABytes^ := Byte(P^);
- end;
- //advance to next char
- Inc(P);
- Inc(ABytes);
- end;
- end;
- function TId8BitEncoding.GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer;
- begin
- Result := AByteCount;
- end;
- function TId8BitEncoding.GetChars(const ABytes: PByte; AByteCount: Integer;
- AChars: PIdWideChar; ACharCount: Integer): Integer;
- var
- P: PByte;
- i : Integer;
- begin
- P := ABytes;
- Result := IndyMin(ACharCount, AByteCount);
- for i := 1 to Result do begin
- UInt16(AChars^) := P^;
- //advance to next char
- Inc(AChars);
- Inc(P);
- end;
- end;
- function TId8BitEncoding.GetMaxByteCount(ACharCount: Integer): Integer;
- begin
- Result := ACharCount;
- end;
- function TId8BitEncoding.GetMaxCharCount(AByteCount: Integer): Integer;
- begin
- Result := AByteCount;
- end;
- { TIdVCLEncoding }
- {$IFDEF HAS_TEncoding}
- // RLebeau: this is a hack. The protected members of SysUtils.TEncoding are
- // declared as 'STRICT protected', so a regular accessor will not work here.
- // Only descendants can call them, so we have to expose our own methods that
- // this unit can call, and have them call the inherited methods internally.
- type
- TEncodingAccess = class(TEncoding)
- public
- function IndyGetByteCount(Chars: PChar; CharCount: Integer): Integer;
- function IndyGetBytes(Chars: PChar; CharCount: Integer; Bytes: PByte; ByteCount: Integer): Integer;
- function IndyGetCharCount(Bytes: PByte; ByteCount: Integer): Integer;
- function IndyGetChars(Bytes: PByte; ByteCount: Integer; Chars: PChar; CharCount: Integer): Integer;
- end;
- function TEncodingAccess.IndyGetByteCount(Chars: PChar; CharCount: Integer): Integer;
- begin
- Result := GetByteCount(Chars, CharCount);
- end;
- function TEncodingAccess.IndyGetBytes(Chars: PChar; CharCount: Integer; Bytes: PByte; ByteCount: Integer): Integer;
- begin
- Result := GetBytes(Chars, CharCount, Bytes, ByteCount);
- end;
- function TEncodingAccess.IndyGetCharCount(Bytes: PByte; ByteCount: Integer): Integer;
- begin
- Result := GetCharCount(Bytes, ByteCount);
- end;
- function TEncodingAccess.IndyGetChars(Bytes: PByte; ByteCount: Integer;
- Chars: PChar; CharCount: Integer): Integer;
- begin
- Result := GetChars(Bytes, ByteCount, Chars, CharCount);
- end;
- constructor TIdVCLEncoding.Create(AEncoding: TEncoding; AFreeEncoding: Boolean);
- begin
- inherited Create;
- FEncoding := AEncoding;
- FFreeEncoding := AFreeEncoding and not TEncoding.IsStandardEncoding(AEncoding);
- FIsSingleByte := FEncoding.IsSingleByte;
- end;
- {$IFDEF HAS_TEncoding_GetEncoding_ByEncodingName}
- constructor TIdVCLEncoding.Create(const ACharset: String);
- var
- LCharset: string;
- begin
- // RLebeau 5/2/2017: have seen some malformed emails that use 'utf8'
- // instead of 'utf-8', so let's check for that...
- // RLebeau 9/27/2017: updating to handle a few more UTFs without hyphens...
- // normalize ACharset for easier comparisons...
- case PosInStrArray(ACharset, ['UTF7', 'UTF8', 'UTF16', 'UTF16LE', 'UTF16BE', 'UTF32', 'UTF32LE', 'UTF32BE'], False) of {Do not Localize}
- 0: LCharset := 'UTF-7'; {Do not Localize}
- 1: LCharset := 'UTF-8'; {Do not Localize}
- 2,3: LCharset := 'UTF-16LE'; {Do not Localize}
- 4: LCharset := 'UTF-16BE'; {Do not Localize}
- 5,6: LCharset := 'UTF-32LE'; {Do not Localize}
- 7: LCharset := 'UTF-32BE'; {Do not Localize}
- else
- LCharset := ACharset;
- end;
- Create(TEncoding.GetEncoding(LCharset), True);
- end;
- {$ENDIF}
- constructor TIdVCLEncoding.Create(const ACodepage: UInt16);
- begin
- Create(TEncoding.GetEncoding(ACodepage), True);
- end;
- destructor TIdVCLEncoding.Destroy;
- begin
- if FFreeEncoding then begin
- FEncoding.Free;
- end;
- inherited Destroy;
- end;
- function TIdVCLEncoding.GetByteCount(const AChars: PIdWideChar; ACharCount: Integer): Integer;
- begin
- Result := TEncodingAccess(FEncoding).IndyGetByteCount(AChars, ACharCount);
- end;
- function TIdVCLEncoding.GetBytes(const AChars: PIdWideChar; ACharCount: Integer;
- ABytes: PByte; AByteCount: Integer): Integer;
- begin
- Result := TEncodingAccess(FEncoding).IndyGetBytes(AChars, ACharCount, ABytes, AByteCount);
- end;
- function TIdVCLEncoding.GetCharCount(const ABytes: PByte; AByteCount: Integer): Integer;
- begin
- Result := TEncodingAccess(FEncoding).IndyGetCharCount(ABytes, AByteCount);
- end;
- function TIdVCLEncoding.GetChars(const ABytes: PByte; AByteCount: Integer;
- AChars: PIdWideChar; ACharCount: Integer): Integer;
- begin
- Result := TEncodingAccess(FEncoding).IndyGetChars(ABytes, AByteCount, AChars, ACharCount);
- end;
- function TIdVCLEncoding.GetMaxByteCount(ACharCount: Integer): Integer;
- begin
- Result := FEncoding.GetMaxByteCount(ACharCount);
- end;
- function TIdVCLEncoding.GetMaxCharCount(AByteCount: Integer): Integer;
- begin
- Result := FEncoding.GetMaxCharCount(AByteCount);
- end;
- {$ENDIF}
- {$ENDIF}
- function IndyTextEncoding(AType: IdTextEncodingType): IIdTextEncoding;
- begin
- case AType of
- encIndyDefault: Result := IndyTextEncoding_Default;
- // encOSDefault handled further below
- enc8Bit: Result := IndyTextEncoding_8Bit;
- encASCII: Result := IndyTextEncoding_ASCII;
- encUTF16BE: Result := IndyTextEncoding_UTF16BE;
- encUTF16LE: Result := IndyTextEncoding_UTF16LE;
- encUTF7: Result := IndyTextEncoding_UTF7;
- encUTF8: Result := IndyTextEncoding_UTF8;
- else
- // encOSDefault
- Result := IndyTextEncoding_OSDefault;
- end;
- end;
- function IndyTextEncoding(ACodepage: UInt16): IIdTextEncoding;
- begin
- {$IFDEF DOTNET}
- Result := TIdDotNetEncoding.Create(ACodepage);
- {$ELSE}
- case ACodepage of
- 20127:
- Result := IndyTextEncoding_ASCII;
- 1200:
- Result := IndyTextEncoding_UTF16LE;
- 1201:
- Result := IndyTextEncoding_UTF16BE;
- 65000:
- Result := IndyTextEncoding_UTF7;
- 65001:
- Result := IndyTextEncoding_UTF8;
- // TODO: add support for UTF-32...
- else
- {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
- Result := TIdMBCSEncoding.Create(ACodepage);
- {$ELSE}
- {$IFDEF HAS_TEncoding}
- Result := TIdVCLEncoding.Create(ACodepage);
- {$ELSE}
- Result := nil;
- raise EIdException.CreateResFmt(@RSUnsupportedCodePage, [ACodepage]); // TODO: create a new Exception class for this
- {$ENDIF}
- {$ENDIF}
- end;
- {$ENDIF}
- end;
- function IndyTextEncoding(const ACharSet: String): IIdTextEncoding;
- begin
- {$IFDEF DOTNET}
- Result := TIdDotNetEncoding.Create(ACharSet);
- {$ELSE}
- // TODO: move IdCharsets unit into the System package so the
- // IdGlobalProtocols.CharsetToEncoding() function can be moved
- // into this unit...
- if IsCharsetASCII(ACharSet) then begin
- Result := IndyTextEncoding_ASCII;
- end else begin
- // RLebeau 5/2/2017: have seen some malformed emails that use 'utf8'
- // instead of 'utf-8', so let's check for that...
- // RLebeau 9/27/2017: updating to handle a few more UTFs without hyphens...
- // TODO: normalize ACharSet for easier comparisons...
- case PosInStrArray(ACharSet, ['UTF-7', 'UTF7', 'UTF-8', 'UTF8', 'UTF-16', 'UTF16', 'UTF-16LE', 'UTF16LE', 'UTF-16BE', 'UTF16BE'], False) of {Do not Localize}
- 0, 1: Result := IndyTextEncoding_UTF7;
- 2, 3: Result := IndyTextEncoding_UTF8;
- 4..7: Result := IndyTextEncoding_UTF16LE;
- 8, 9: Result := IndyTextEncoding_UTF16BE;
- // TODO: add support for UTF-32...
- else
- {$IFDEF SUPPORTS_CHARSET_ENCODING}
- Result := TIdMBCSEncoding.Create(ACharSet);
- {$ELSE}
- {$IFDEF HAS_TEncoding_GetEncoding_ByEncodingName}
- Result := TIdVCLEncoding.Create(ACharSet);
- {$ELSE}
- // TODO: provide a hook that IdGlobalProtocols can assign to so we can call
- // CharsetToCodePage() here, at least until CharsetToEncoding() can be moved
- // to this unit once IdCharsets has been moved to the System package...
- Result := nil;
- raise EIdException.CreateFmt(RSUnsupportedCharSet, [ACharSet]); // TODO: create a new Exception class for this
- {$ENDIF}
- {$ENDIF}
- end;
- end;
- {$ENDIF}
- end;
- {$IFDEF DOTNET}
- function IndyTextEncoding(AEncoding: System.Text.Encoding): IIdTextEncoding;
- begin
- Result := TIdDotNetEncoding.Create(AEncoding);
- end;
- {$ENDIF}
- {$IFDEF HAS_TEncoding}
- function IndyTextEncoding(AEncoding: TEncoding; AFreeEncoding: Boolean = False): IIdTextEncoding;
- begin
- Result := TIdVCLEncoding.Create(AEncoding, AFreeEncoding);
- end;
- {$ENDIF}
- function IndyTextEncoding_Default: IIdTextEncoding;
- var
- LType: IdTextEncodingType;
- begin
- LType := GIdDefaultTextEncoding;
- if LType = encIndyDefault then begin
- LType := encASCII;
- end;
- Result := IndyTextEncoding(LType);
- end;
- function IndyTextEncoding_OSDefault: IIdTextEncoding;
- {$IFNDEF DOTNET}
- var
- LEncoding: IIdTextEncoding;
- {$ENDIF}
- begin
- if GIdOSDefaultEncoding = nil then begin
- {$IFDEF DOTNET}
- // TODO: use thread-safe assignment
- GIdOSDefaultEncoding := TIdDotNetEncoding.Create(System.Text.Encoding.Default);
- {$ELSE}
- // TODO: SysUtils.TEncoding.Default uses ANSI on Windows
- // but uses UTF-8 on POSIX, so we should do the same...
- //LEncoding := {$IFDEF WINDOWS}TIdMBCSEncoding{$ELSE}TIdUTF8Encoding{$ENDIF}.Create;
- LEncoding := TIdMBCSEncoding.Create;
- if InterlockedCompareExchangeIntf(IInterface(GIdOSDefaultEncoding), LEncoding, nil) <> nil then begin
- LEncoding := nil;
- end;
- {$ENDIF}
- end;
- Result := GIdOSDefaultEncoding;
- end;
- function IndyTextEncoding_8Bit: IIdTextEncoding;
- {$IFNDEF DOTNET}
- var
- LEncoding: IIdTextEncoding;
- {$ENDIF}
- begin
- if GId8BitEncoding = nil then begin
- {$IFDEF DOTNET}
- // We need a charset that converts UTF-16 codeunits in the $00-$FF range
- // to/from their numeric values as-is. Was previously using "Windows-1252"
- // which does so for most codeunits, however codeunits $80-$9F in
- // Windows-1252 map to different codepoints in Unicode, which we don't want.
- // "ISO-8859-1" aka "ISO_8859-1:1987" (not to be confused with the older
- // "ISO 8859-1" charset), on the other hand, treats codeunits $00-$FF as-is,
- // and seems to be just as widely supported as Windows-1252 on most systems,
- // so we'll use that for now...
- // TODO: use thread-safe assignment
- GId8BitEncoding := TIdDotNetEncoding.Create('ISO-8859-1');
- {$ELSE}
- LEncoding := TId8BitEncoding.Create;
- if InterlockedCompareExchangeIntf(IInterface(GId8BitEncoding), LEncoding, nil) <> nil then begin
- LEncoding := nil;
- end;
- {$ENDIF}
- end;
- Result := GId8BitEncoding;
- end;
- function IndyTextEncoding_ASCII: IIdTextEncoding;
- {$IFNDEF DOTNET}
- var
- LEncoding: IIdTextEncoding;
- {$ENDIF}
- begin
- if GIdASCIIEncoding = nil then begin
- {$IFDEF DOTNET}
- // TODO: use thread-safe assignment
- GIdASCIIEncoding := TIdDotNetEncoding.Creeate(System.Text.Encoding.ASCII);
- {$ELSE}
- LEncoding := TIdASCIIEncoding.Create;
- if InterlockedCompareExchangeIntf(IInterface(GIdASCIIEncoding), LEncoding, nil) <> nil then begin
- LEncoding := nil;
- end;
- {$ENDIF}
- end;
- Result := GIdASCIIEncoding;
- end;
- function IndyTextEncoding_UTF16BE: IIdTextEncoding;
- {$IFNDEF DOTNET}
- var
- LEncoding: IIdTextEncoding;
- {$ENDIF}
- begin
- if GIdUTF16BigEndianEncoding = nil then begin
- {$IFDEF DOTNET}
- // TODO: use thread-safe assignment
- GIdUTF16BigEndianEncoding := TIdDotNetEncoding.Create(System.Text.Encoding.BigEndianUnicode);
- {$ELSE}
- LEncoding := TIdUTF16BigEndianEncoding.Create;
- if InterlockedCompareExchangeIntf(IInterface(GIdUTF16BigEndianEncoding), LEncoding, nil) <> nil then begin
- LEncoding := nil;
- end;
- {$ENDIF}
- end;
- Result := GIdUTF16BigEndianEncoding;
- end;
- function IndyTextEncoding_UTF16LE: IIdTextEncoding;
- {$IFNDEF DOTNET}
- var
- LEncoding: IIdTextEncoding;
- {$ENDIF}
- begin
- if GIdUTF16LittleEndianEncoding = nil then begin
- {$IFDEF DOTNET}
- // TODO: use thread-safe assignment
- GIdUTF16LittleEndianEncoding := TIdDotNetEncoding.Create(System.Text.Encoding.Unicode);
- {$ELSE}
- LEncoding := TIdUTF16LittleEndianEncoding.Create;
- if InterlockedCompareExchangeIntf(IInterface(GIdUTF16LittleEndianEncoding), LEncoding, nil) <> nil then begin
- LEncoding := nil;
- end;
- {$ENDIF}
- end;
- Result := GIdUTF16LittleEndianEncoding;
- end;
- function IndyTextEncoding_UTF7: IIdTextEncoding;
- {$IFNDEF DOTNET}
- var
- LEncoding: IIdTextEncoding;
- {$ENDIF}
- begin
- if GIdUTF7Encoding = nil then begin
- {$IFDEF DOTNET}
- // TODO: use thread-safe assignment
- GIdUTF7Encoding := TIdDotNetEncoding.Create(System.Text.Encoding.UTF7);
- {$ELSE}
- LEncoding := TIdUTF7Encoding.Create;
- if InterlockedCompareExchangeIntf(IInterface(GIdUTF7Encoding), LEncoding, nil) <> nil then begin
- LEncoding := nil;
- end;
- {$ENDIF}
- end;
- Result := GIdUTF7Encoding;
- end;
- function IndyTextEncoding_UTF8: IIdTextEncoding;
- {$IFNDEF DOTNET}
- var
- LEncoding: IIdTextEncoding;
- {$ENDIF}
- begin
- if GIdUTF8Encoding = nil then begin
- {$IFDEF DOTNET}
- // TODO: use thread-safe assignment
- GIdUTF8Encoding := TIdDotNetEncoding.Create(System.Text.Encoding.UTF8);
- {$ELSE}
- LEncoding := TIdUTF8Encoding.Create;
- if InterlockedCompareExchangeIntf(IInterface(GIdUTF8Encoding), LEncoding, nil) <> nil then begin
- LEncoding := nil;
- end;
- {$ENDIF}
- end;
- Result := GIdUTF8Encoding;
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function enDefault: IIdTextEncoding;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := nil;
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function en7Bit: IIdTextEncoding;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := IndyTextEncoding_ASCII;
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function en8Bit: IIdTextEncoding;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := IndyTextEncoding_8Bit;
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function enUTF8: IIdTextEncoding;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := IndyTextEncoding_UTF8;
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function Indy8BitEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
- {$I IdDeprecatedImplBugOn.inc}
- begin
- {$IFNDEF DOTNET}
- if not AOwnedByIndy then begin
- Result := TId8BitEncoding.Create;
- Exit;
- end;
- {$ENDIF}
- Result := IndyTextEncoding_8Bit;
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function IndyASCIIEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
- {$I IdDeprecatedImplBugOn.inc}
- begin
- {$IFNDEF DOTNET}
- if not AOwnedByIndy then begin
- Result := TIdASCIIEncoding.Create;
- Exit;
- end;
- {$ENDIF}
- Result := IndyTextEncoding_ASCII;
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function IndyUTF16BigEndianEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
- {$I IdDeprecatedImplBugOn.inc}
- begin
- {$IFNDEF DOTNET}
- if not AOwnedByIndy then begin
- Result := TIdUTF16BigEndianEncoding.Create;
- Exit;
- end;
- {$ENDIF}
- Result := IndyTextEncoding_UTF16BE;
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function IndyUTF16LittleEndianEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
- {$I IdDeprecatedImplBugOn.inc}
- begin
- {$IFNDEF DOTNET}
- if not AOwnedByIndy then begin
- Result := TIdUTF16LittleEndianEncoding.Create;
- Exit;
- end;
- {$ENDIF}
- Result := IndyTextEncoding_UTF16LE;
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function IndyOSDefaultEncoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
- {$I IdDeprecatedImplBugOn.inc}
- begin
- {$IFNDEF DOTNET}
- if not AOwnedByIndy then begin
- // TODO: SysUtils.TEncoding.Default uses ANSI on Windows
- // but uses UTF-8 on POSIX, so we should do the same...
- //Result := {$IFDEF WINDOWS}TIdMBCSEncoding{$ELSE}TIdUTF8Encoding{$ENDIF}.Create;
- Result := TIdMBCSEncoding.Create;
- Exit;
- end;
- {$ENDIF}
- Result := IndyTextEncoding_OSDefault;
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function IndyUTF7Encoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
- {$I IdDeprecatedImplBugOn.inc}
- begin
- {$IFNDEF DOTNET}
- if not AOwnedByIndy then begin
- Result := TIdUTF7Encoding.Create;
- Exit;
- end;
- {$ENDIF}
- Result := IndyTextEncoding_UTF7;
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function IndyUTF8Encoding{$IFNDEF DOTNET}(const AOwnedByIndy: Boolean = True){$ENDIF}: IIdTextEncoding;
- {$I IdDeprecatedImplBugOn.inc}
- begin
- {$IFNDEF DOTNET}
- if not AOwnedByIndy then begin
- Result := TIdUTF8Encoding.Create;
- Exit;
- end;
- {$ENDIF}
- Result := IndyTextEncoding_UTF8;
- end;
- {$IFNDEF DOTNET}
- function GetEncodingCodePage(AEncoding: IIdTextEncoding): UInt16;
- begin
- Result := 0;
- if AEncoding = nil then begin
- Exit;
- end;
- // RLebeau 2/15/2019: AEncoding is checked this way until IIdTextEncoding is updated to expose its assigned CodePage...
- {$IFDEF SUPPORTS_CHARSET_ENCODING}
- {
- if AEncoding is TIdMBCSEncoding then begin
- // TODO: normalize FCharSet for easier comparisons...
- 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
- 0, 1: Result := 65000;
- 2, 3: Result := 65001;
- 4..7: Result := 1200;
- 8, 9: Result := 1201;
- 10: Result := ($IFDEF HAS_SetCodePage)DefaultSystemCodePage($ELSE)0($ENDIF);
- 11: Result := 28591;
- // TODO: add support for UTF-32...
- else
- if IsCharsetASCII(TIdMBCSEncoding(AEncoding).FCharSet) then begin
- Result := 20127;
- end;
- end;
- end
- else
- }
- {$ELSE}
- {$IFDEF SUPPORTS_CODEPAGE_ENCODING}
- {
- if AEncoding is TIdMBCSEncoding then begin
- Result := TIdMBCSEncoding(AEncoding).FCodePage;
- end
- else
- }
- {$ENDIF}
- {$ENDIF}
- if (AEncoding = GIdOSDefaultEncoding) then
- begin
- {$IFDEF HAS_SetCodePage}
- Result := DefaultSystemCodePage;
- {$ELSE}
- {$IFDEF WINDOWS}
- Result := GetACP();
- {$ENDIF}
- {$ENDIF}
- end
- else if (AEncoding = GId8BitEncoding) {or (AEncoding is TId8BitEncoding)} then
- begin
- Result := 28591;
- end
- else if (AEncoding = GIdASCIIEncoding) {or (AEncoding is TIdASCIIEncoding)} then
- begin
- Result := 20127;
- end
- else if (AEncoding = GIdUTF16BigEndianEncoding) {or (AEncoding is TIdUTF16BigEndianEncoding)} then
- begin
- Result := 1201;
- end
- else if (AEncoding = GIdUTF16LittleEndianEncoding) {or (AEncoding is TIdUTF16LittleEndianEncoding)} then
- begin
- Result := 1200;
- end
- else if (AEncoding = GIdUTF7Encoding) {or (AEncoding is TIdUTF7Encoding)} then
- begin
- Result := 65000;
- end
- else if (AEncoding = GIdUTF8Encoding) {or (AEncoding is TIdUTF8Encoding)} then
- begin
- Result := 65001;
- end;
- end;
- {$ENDIF}
- function LoadLibFunction(const ALibHandle: TIdLibHandle; const AProcName: TIdLibFuncName): Pointer;
- begin
- {$I IdRangeCheckingOff.inc}
- Result := {$IFDEF WINDOWS}Windows.{$ENDIF}GetProcAddress(ALibHandle, PIdLibFuncNameChar(AProcName));
- {$I IdRangeCheckingOn.inc}
- end;
- {$IFDEF UNIX}
- function HackLoadFileName(const ALibName, ALibVer : String) : string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF OSX_OR_IOS}
- Result := ALibName + ALibVer + LIBEXT;
- {$ELSE}
- Result := ALibName + LIBEXT + ALibVer;
- {$ENDIF}
- end;
- function HackLoad(const ALibName : String; const ALibVersions : array of String) : TIdLibHandle;
- var
- i : Integer;
- function LoadLibVer(const ALibVer: string): TIdLibHandle;
- var
- FileName: string;
- begin
- FileName := HackLoadFileName(ALibName, ALibVer);
- {$IFDEF USE_SAFELOADLIBRARY}
- Result := SafeLoadLibrary(FileName);
- {$ELSE}
- {$IFDEF KYLIXCOMPAT}
- // Workaround that is required under Linux (changed RTLD_GLOBAL with RTLD_LAZY Note: also work with LoadLibrary())
- // TODO: use ToSingleByteFileSystemEncodedFileName() to encode the filename:
- // Result := TIdLibHandle(dlopen(PAnsiChar(ToSingleByteFileSystemEncodedFileName(FileName)), RTLD_LAZY));
- // TODO: use dynlibs.SysLoadLibraryU() instead:
- // Result := SysLoadLibraryU(FileName);
- Result := TIdLibHandle(dlopen(PAnsiChar(FileName), RTLD_LAZY));
- {$ELSE}
- Result := LoadLibrary(FileName);
- {$ENDIF}
- {$ENDIF}
- {$IFDEF USE_INVALIDATE_MOD_CACHE}
- InvalidateModuleCache;
- {$ENDIF}
- end;
- begin
- if High(ALibVersions) > -1 then begin
- Result := IdNilHandle;
- for i := Low(ALibVersions) to High(ALibVersions) do
- begin
- Result := LoadLibVer(ALibVersions[i]);
- if Result <> IdNilHandle then begin
- Break;
- end;
- end;
- end else begin
- Result := LoadLibVer('');
- end;
- end;
- {$ENDIF}
- procedure IndyRaiseLastError;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFNDEF HAS_RaiseLastOSError}
- RaiseLastWin32Error;
- {$ELSE}
- RaiseLastOSError;
- {$ENDIF}
- end;
- {$IFDEF HAS_Exception_RaiseOuterException}
- procedure IndyRaiseOuterException(AOuterException: Exception);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Exception.RaiseOuterException(AOuterException);
- end;
- {$ELSE}
- {$IFDEF DCC}
- // RLebeau: There is no Exception.InnerException property to capture the inner
- // exception into, but we can still raise the outer exception using Delphi's
- // 'raise ... at [address]' syntax, at least. This way, the debugger (and
- // exception loggers) can show the outer exception occuring in the caller
- // rather than inside this function...
- {$IFDEF HAS_System_ReturnAddress}
- procedure IndyRaiseOuterException(AOuterException: Exception);
- begin
- raise AOuterException at ReturnAddress;
- end;
- {$ELSE}
- // RLebeau: Delphi RTL functions like SysUtils.Abort(), Classes.TList.Error(),
- // and Classes.TStrings.Error() raise their respective exceptions at the
- // caller's return address using Delphi's 'raise ... at [address]' syntax,
- // however they do so in different ways depending on Delphi version!
- //
- // ----------------
- // SysUtils.Abort()
- // ----------------
- // Delphi 5-2007: Abort() calls an internal helper function that returns the
- // caller's return address from the call stack - [EBP-4] in Delphi 5, [EBP+4]
- // in Delphi 6+ - and then passes that value to 'raise'. Not sure why [EBP-4]
- // was being used in Delphi 5. Maybe a typo?
- //
- // Delphi 2009-XE: Abort() JMP's into an internal helper procedure that takes
- // a Pointer parameter as input (passed in EAX) and passes it to 'raise'.
- // Delphi 2009-2010 POP's the caller's return address from the call stack
- // into EAX. Delphi XE simply MOV's [ESP] into EAX instead.
- // ----------------
- // TList.Error()
- // TStrings.Error()
- // ----------------
- // Delphi 5-2010: Error() calls an internal helper function that returns the
- // caller's return address from the call stack - always [EBP+4] - and then passes
- // that value to 'raise'.
- //
- // Delphi XE: no helper is used. Error() is wrapped with {$O-} to force a stack
- // frame, and then reads the caller's return address directly from the call stack
- // (using pointer math to find it) and passes it to 'raise'.
- // ----------------
- //
- // To be safe, we will use the MOV [ESP] approach here, as it is the simplest.
- // We only have to worry about this in Delphi's Windows 32bit compiler, as the
- // 64bit and mobile compilers have System.ReturnAddress available...
- // disable stack frames to reduce instructions
- {$I IdStackFramesOff.inc}
- procedure IndyRaiseOuterException(AOuterException: Exception);
- procedure RaiseE(E: Exception; ReturnAddr: Pointer);
- begin
- raise E at ReturnAddr;
- end;
- asm
- // AOuterException is already in EAX...
- // MOV EAX, AOuterException
- MOV EDX, [ESP]
- JMP RaiseE
- end;
- {$I IdStackFramesOn.inc}
- {$ENDIF}
- {$ELSE}
- // Not Delphi, so just raise the exception as-is until we know what else to do with it...
- procedure IndyRaiseOuterException(AOuterException: Exception);
- begin
- raise AOuterException;
- end;
- {$ENDIF}
- {$ENDIF}
- {$IFNDEF DOTNET}
- function InterlockedExchangeTHandle(var VTarget: THandle; const AValue: THandle): THandle;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF HAS_TInterlocked}
- {$IFDEF THANDLE_32}
- Result := THandle(TInterlocked.Exchange(Integer(VTarget), Integer(AValue)));
- {$ENDIF}
- //Temporary workaround. TInterlocked for Emb really should accept 64 bit unsigned values as set of parameters
- //for TInterlocked.Exchange since 64-bit wide integers are common on 64 bit platforms.
- {$IFDEF THANDLE_64}
- Result := THandle(TInterlocked.Exchange(Int64(VTarget), Int64(AValue)));
- {$ENDIF}
- {$ELSE}
- {$IFDEF THANDLE_32}
- Result := THandle(InterlockedExchange(Integer(VTarget), Integer(AValue)));
- {$ENDIF}
- {$IFDEF THANDLE_64}
- Result := THandle(InterlockedExchange64(Int64(VTarget), Int64(AValue)));
- {$ENDIF}
- {$ENDIF}
- end;
- function InterlockedExchangeTLibHandle(var VTarget: TIdLibHandle; const AValue: TIdLibHandle): TIdLibHandle;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := TIdLibHandle(
- {$IFDEF HAS_TInterlocked}
- TInterlocked.Exchange(
- {$IFDEF CPU64}
- Int64(VTarget), Int64(AValue)
- {$ELSE}
- Integer(VTarget), Integer(AValue)
- {$ENDIF}
- )
- {$ELSE}
- {$IFDEF CPU64}
- InterlockedExchange64(Int64(VTarget), Int64(AValue))
- {$ELSE}
- InterlockedExchange(Integer(VTarget), Integer(AValue))
- {$ENDIF}
- {$ENDIF}
- );
- end;
- {$UNDEF DYNAMICLOAD_InterlockedCompareExchange}
- {$IFNDEF HAS_TInterlocked}
- {$IFNDEF FPC}
- // RLebeau: InterlockedCompareExchange() is not available prior to Win2K,
- // so need to fallback to some other logic on older systems. Not too many
- // people still support those systems anymore, so we will make this optional.
- //
- // InterlockedCompareExchange64(), on the other hand, is not available until
- // Windows Vista (and not defined in any version of Windows.pas up to Delphi
- // XE), so always dynamically load it in order to support WinXP 64-bit...
- {$IFDEF CPU64}
- {$DEFINE DYNAMICLOAD_InterlockedCompareExchange}
- {$ELSE}
- {.$DEFINE STATICLOAD_InterlockedCompareExchange}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$IFDEF DYNAMICLOAD_InterlockedCompareExchange}
- // See http://code.google.com/p/delphi-toolbox/source/browse/trunk/RTLEx/RTLEx.BasicOp.Atomic.pas
- // for how to perform interlocked operations in assembler...
- type
- TInterlockedCompareExchangeFunc = function(var Destination: PtrInt; Exchange, Comparand: PtrInt): PtrInt; stdcall;
- var
- InterlockedCompareExchange: TInterlockedCompareExchangeFunc = nil;
- function Impl_InterlockedCompareExchange(var Destination: PtrInt; Exchange, Comparand: PtrInt): PtrInt; stdcall;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF CPU64}
- // TODO: use LOCK CMPXCHG8B directly so this is more atomic...
- {$ELSE}
- // TODO: use LOCK CMPXCHG directly so this is more atomic...
- {$ENDIF}
- Result := Destination;
- if Destination = Comparand then begin
- Destination := Exchange;
- end;
- end;
- function Stub_InterlockedCompareExchange(var Destination: PtrInt; Exchange, Comparand: PtrInt): PtrInt; stdcall;
- function GetImpl: Pointer;
- const
- cKernel32 = 'KERNEL32'; {do not localize}
- // TODO: what is Embarcadero's 64-bit define going to be?
- cInterlockedCompareExchange = {$IFDEF CPU64}'InterlockedCompareExchange64'{$ELSE}'InterlockedCompareExchange'{$ENDIF}; {do not localize}
- begin
- Result := LoadLibFunction(GetModuleHandle(cKernel32), cInterlockedCompareExchange);
- if Result = nil then begin
- Result := @Impl_InterlockedCompareExchange;
- end;
- end;
- begin
- @InterlockedCompareExchange := GetImpl();
- Result := InterlockedCompareExchange(Destination, Exchange, Comparand);
- end;
- {$ENDIF}
- function InterlockedCompareExchangePtr(var VTarget: Pointer; const AValue, Compare: Pointer): Pointer;
- {$IFNDEF DYNAMICLOAD_InterlockedCompareExchange}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF DYNAMICLOAD_InterlockedCompareExchange}
- Result := Pointer(IdGlobal.InterlockedCompareExchange(PtrInt(VTarget), PtrInt(AValue), PtrInt(Compare)));
- {$ELSE}
- {$IFDEF HAS_TInterlocked}
- Result := TInterlocked.CompareExchange(VTarget, AValue, Compare);
- {$ELSE}
- {$IFDEF HAS_InterlockedCompareExchangePointer}
- Result := InterlockedCompareExchangePointer(VTarget, AValue, Compare);
- {$ELSE}
- {$IFDEF HAS_InterlockedCompareExchange_Pointers}
- //work around a conflicting definition for InterlockedCompareExchange
- Result := {$IFDEF FPC}system.{$ENDIF}InterlockedCompareExchange(VTarget, AValue, Compare);
- {$ELSE}
- {$IFDEF FPC}
- Result := Pointer(
- {$IFDEF CPU64}InterlockedCompareExchange64{$ELSE}InterlockedCompareExchange{$ENDIF}
- (PtrInt(VTarget), PtrInt(AValue), PtrInt(Compare))
- );
- {$ELSE}
- // Delphi 64-bit is handled by HAS_InterlockedCompareExchangePointer
- Result := Pointer(InterlockedCompareExchange(Integer(VTarget), Integer(AValue), Integer(Compare)));
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- end;
- function InterlockedCompareExchangeObj(var VTarget: TObject; const AValue, Compare: TObject): TObject;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF HAS_TInterlocked}
- // for ARC, we have to use the TObject overload of TInterlocked to ensure
- // that the reference counts of the objects are managed correctly...
- Result := TInterlocked.CompareExchange(VTarget, AValue, Compare);
- {$ELSE}
- Result := TObject(InterlockedCompareExchangePtr(Pointer(VTarget), Pointer(AValue), Pointer(Compare)));
- {$ENDIF}
- end;
- function InterlockedCompareExchangeIntf(var VTarget: IInterface; const AValue, Compare: IInterface): IInterface;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // TInterlocked does not have an overload for IInterface.
- // We have to ensure that the reference counts of the interfaces are managed correctly...
- if AValue <> nil then begin
- AValue._AddRef;
- end;
- Result := IInterface(InterlockedCompareExchangePtr(Pointer(VTarget), Pointer(AValue), Pointer(Compare)));
- if (AValue <> nil) and (Pointer(Result) <> Pointer(Compare)) then begin
- AValue._Release;
- end;
- end;
- {$ENDIF}
- {Little Endian Byte order functions from:
- From: http://community.borland.com/article/0,1410,16854,00.html
- Big-endian and little-endian formated integers - by Borland Developer Support Staff
- Note that I will NOT do big Endian functions because the stacks can handle that
- with HostToNetwork and NetworkToHost functions.
- You should use these functions for writing data that sent and received in Little
- Endian Form. Do NOT assume endianness of what's written. It can work in unpredictable
- ways on other architectures.
- }
- function HostToLittleEndian(const AValue : UInt16) : UInt16;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // TODO: FreePascal has a NtoLE() function in its System unit to
- // "Convert Native-ordered integer to a Little Endian-ordered integer"
- {.$IFDEF FPC}
- //Result := NtoLE(AValue);
- {.$ELSE}
- {$IFDEF DOTNET}
- //I think that is Little Endian but I'm not completely sure
- Result := AValue;
- {$ELSE}
- {$IFDEF ENDIAN_LITTLE}
- Result := AValue;
- {$ENDIF}
- {$IFDEF ENDIAN_BIG}
- Result := swap(AValue);
- {$ENDIF}
- {$ENDIF}
- {.$ENDIF}
- end;
- function HostToLittleEndian(const AValue : UInt32) : UInt32;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // TODO: FreePascal has a NtoLE() function in its System unit to
- // "Convert Native-ordered integer to a Little Endian-ordered integer"
- {.$IFDEF FPC}
- //Result := NtoLE(AValue);
- {.$ELSE}
- {$IFDEF DOTNET}
- //I think that is Little Endian but I'm not completely sure
- Result := AValue;
- {$ELSE}
- {$IFDEF ENDIAN_LITTLE}
- Result := AValue;
- {$ENDIF}
- {$IFDEF ENDIAN_BIG}
- Result := swap(AValue shr 16) or (UInt32(swap(AValue and $FFFF)) shl 16);
- {$ENDIF}
- {$ENDIF}
- {.$ENDIF}
- end;
- function HostToLittleEndian(const AValue : Integer) : Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // TODO: FreePascal has a NtoLE() function in its System unit to
- // "Convert Native-ordered integer to a Little Endian-ordered integer"
- {.$IFDEF FPC}
- //Result := NtoLE(AValue);
- {.$ELSE}
- {$IFDEF DOTNET}
- //I think that is Little Endian but I'm not completely sure
- Result := AValue;
- {$ELSE}
- {$IFDEF ENDIAN_LITTLE}
- Result := AValue;
- {$ENDIF}
- {$IFDEF ENDIAN_BIG}
- Result := swap(AValue);
- {$ENDIF}
- {$ENDIF}
- {.$ENDIF}
- end;
- function LittleEndianToHost(const AValue : UInt16) : UInt16;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // TODO: FreePascal has a LEtoN() function in its System unit to
- // "Convert Little Endian-ordered integer to Native-ordered integer"
- {.$IFDEF FPC}
- //Result := LEtoN(AValue);
- {.$ELSE}
- {$IFDEF DOTNET}
- //I think that is Little Endian but I'm not completely sure
- Result := AValue;
- {$ELSE}
- {$IFDEF ENDIAN_LITTLE}
- Result := AValue;
- {$ENDIF}
- {$IFDEF ENDIAN_BIG}
- Result := swap(AValue);
- {$ENDIF}
- {$ENDIF}
- {.$ENDIF}
- end;
- function LittleEndianToHost(const AValue : UInt32): UInt32;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // TODO: FreePascal has a LEtoN() function in its System unit to
- // "Convert Little Endian-ordered integer to Native-ordered integer"
- {.$IFDEF FPC}
- //Result := LEtoN(AValue);
- {.$ELSE}
- {$IFDEF DOTNET}
- //I think that is Little Endian but I'm not completely sure
- Result := AValue;
- {$ELSE}
- {$IFDEF ENDIAN_LITTLE}
- Result := AValue;
- {$ENDIF}
- {$IFDEF ENDIAN_BIG}
- Result := swap(AValue shr 16) or (UInt32(swap(AValue and $FFFF)) shl 16);
- {$ENDIF}
- {$ENDIF}
- {.$ENDIF}
- end;
- function LittleEndianToHost(const AValue : Integer): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // TODO: FreePascal has a LEtoN() function in its System unit to
- // "Convert Little Endian-ordered integer to Native-ordered integer"
- {.$IFDEF FPC}
- //Result := LEtoN(AValue);
- {.$ELSE}
- {$IFDEF DOTNET}
- //I think that is Little Endian but I'm not completely sure
- Result := AValue;
- {$ELSE}
- {$IFDEF ENDIAN_LITTLE}
- Result := AValue;
- {$ENDIF}
- {$IFDEF ENDIAN_BIG}
- Result := Swap(AValue);
- {$ENDIF}
- {$ENDIF}
- {.$ENDIF}
- end;
- // TODO: add an AIndex parameter
- procedure FillBytes(var VBytes : TIdBytes; const ACount : Integer; const AValue : Byte);
- {$IFDEF STRING_IS_ANSI}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ELSE}
- var
- I: Integer;
- {$ENDIF}
- begin
- // RLebeau: FillChar() is bad to use on Delphi/C++Builder 2009+ for filling
- // byte buffers as it is actually designed for filling character buffers
- // instead. Now that Char maps to WideChar, this causes problems for FillChar().
- {$IFDEF STRING_IS_UNICODE}
- //System.&Array.Clear(VBytes, 0, ACount);
- // TODO: optimize this
- for I := 0 to ACount-1 do begin
- VBytes[I] := AValue;
- end;
- {$ELSE}
- FillChar(VBytes[0], ACount, AValue);
- {$ENDIF}
- end;
- // RLebeau 10/22/2013: prior to Delphi 2010, fmCreate was an all-encompassing
- // bitmask, no other flags could be combined with it. The RTL was updated in
- // Delphi 2010 to allow other flags to be specified along with fmCreate. So
- // at best, we will now be able to allow read-only access to other processes
- // in Delphi 2010 and later, and at worst we will continue having exclusive
- // rights to the file in Delphi 2009 and earlier, just like we always did...
- constructor TIdFileCreateStream.Create(const AFile : String);
- begin
- inherited Create(AFile, fmCreate or fmOpenReadWrite or fmShareDenyWrite);
- end;
- constructor TIdAppendFileStream.Create(const AFile : String);
- begin
- if FileExists(AFile) then begin
- inherited Create(AFile, fmOpenReadWrite or fmShareDenyWrite);
- TIdStreamHelper.Seek(Self, 0, soEnd);
- end
- else begin
- inherited Create(AFile, fmCreate or fmOpenReadWrite or fmShareDenyWrite);
- end;
- end;
- constructor TIdReadFileNonExclusiveStream.Create(const AFile : String);
- begin
- inherited Create(AFile, fmOpenRead or fmShareDenyNone);
- end;
- constructor TIdReadFileExclusiveStream.Create(const AFile : String);
- begin
- inherited Create(AFile, fmOpenRead or fmShareDenyWrite);
- end;
- function IsASCIILDH(const AByte: Byte): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := True;
- //Verify the absence of non-LDH ASCII code points; that is, the
- //absence of 0..2C, 2E..2F, 3A..40, 5B..60, and 7B..7F.
- //Permissable chars are in this set
- //['-','0'..'9','A'..'Z','a'..'z']
- if AByte <= $2C then begin
- Result := False;
- end
- else if (AByte >= $2E) and (AByte <= $2F) then begin
- Result := False;
- end
- else if (AByte >= $3A) and (AByte <= $40) then begin
- Result := False;
- end
- else if (AByte >= $5B) and (AByte <= $60) then begin
- Result := False;
- end
- else if (AByte >= $7B) and (AByte <= $7F) then begin
- Result := False;
- end;
- end;
- function IsASCIILDH(const ABytes: TIdBytes): Boolean;
- var
- i: Integer;
- begin
- for i := 0 to Length(ABytes)-1 do begin
- if not IsASCIILDH(ABytes[i]) then
- begin
- Result := False;
- Exit;
- end;
- end;
- Result := True;
- end;
- function IsASCII(const AByte: Byte): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := AByte <= $7F;
- end;
- function IsASCII(const ABytes: TIdBytes): Boolean;
- var
- i: Integer;
- begin
- for i := 0 to Length(ABytes) -1 do begin
- if not IsASCII(ABytes[i]) then begin
- Result := False;
- Exit;
- end;
- end;
- Result := True;
- end;
- function StartsWithACE(const ABytes: TIdBytes): Boolean;
- const
- cDash = Ord('-');
- var
- LS: {$IFDEF STRING_IS_IMMUTABLE}TIdStringBuilder{$ELSE}string{$ENDIF};
- begin
- Result := False;
- if Length(ABytes) >= 4 then
- begin
- if (ABytes[2] = cDash) and (ABytes[3] = cDash) then
- begin
- // TODO: just do byte comparisons so String conversions are not needed...
- {$IFDEF STRING_IS_IMMUTABLE}
- LS := TIdStringBuilder.Create(2);
- LS.Append(Char(ABytes[0]));
- LS.Append(Char(ABytes[1]));
- {$ELSE}
- SetLength(LS, 2);
- LS[1] := Char(ABytes[0]);
- LS[2] := Char(ABytes[1]);
- {$ENDIF}
- Result := PosInStrArray(LS{$IFDEF STRING_IS_IMMUTABLE}.ToString{$ENDIF},
- ['bl','bq','dq','lq','mq','ra','wq','zq'], False) > -1;{do not localize}
- end;
- end;
- end;
- function PosInSmallIntArray(const ASearchInt: Int16; const AArray: array of Int16): Integer;
- begin
- for Result := Low(AArray) to High(AArray) do begin
- if ASearchInt = AArray[Result] then begin
- Exit;
- end;
- end;
- Result := -1;
- end;
- {This searches an array of string for an occurance of SearchStr}
- function PosInStrArray(const SearchStr: string; const Contents: array of string; const CaseSensitive: Boolean = True): Integer;
- begin
- for Result := Low(Contents) to High(Contents) do begin
- if CaseSensitive then begin
- if SearchStr = Contents[Result] then begin
- Exit;
- end;
- end else begin
- if TextIsSame(SearchStr, Contents[Result]) then begin
- Exit;
- end;
- end;
- end;
- Result := -1;
- end;
- //IPv4 address conversion
- function ByteToHex(const AByte: Byte): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$IFDEF STRING_IS_IMMUTABLE}
- var
- LSB: TIdStringBuilder;
- {$ENDIF}
- begin
- {$IFDEF STRING_IS_IMMUTABLE}
- LSB := TIdStringBuilder.Create(2);
- LSB.Append(IdHexDigits[(AByte and $F0) shr 4]);
- LSB.Append(IdHexDigits[AByte and $F]);
- Result := LSB.ToString;
- {$ELSE}
- SetLength(Result, 2);
- Result[1] := IdHexDigits[(AByte and $F0) shr 4];
- Result[2] := IdHexDigits[AByte and $F];
- {$ENDIF}
- end;
- function UInt32ToHex(const ALongWord : UInt32) : String;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := ByteToHex((ALongWord and $FF000000) shr 24)
- + ByteToHex((ALongWord and $00FF0000) shr 16)
- + ByteToHex((ALongWord and $0000FF00) shr 8)
- + ByteToHex(ALongWord and $000000FF);
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function LongWordToHex(const ALongWord : UInt32) : String;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := UInt32ToHex(ALongWord);
- end;
- function ToHex(const AValue: TIdBytes; const ACount: Integer = -1;
- const AIndex: Integer = 0): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- I, LCount: Integer;
- CH1, CH2: Char;
- {$IFDEF STRING_IS_IMMUTABLE}
- LSB: TIdStringBuilder;
- {$ELSE}
- LOffset: Integer;
- {$ENDIF}
- begin
- Result := '';
- LCount := IndyLength(AValue, ACount, AIndex);
- if LCount > 0 then begin
- {$IFDEF STRING_IS_IMMUTABLE}
- LSB := TIdStringBuilder.Create(LCount*2);
- {$ELSE}
- SetLength(Result, LCount*2);
- LOffset := 0;
- {$ENDIF}
- for I := 0 to LCount-1 do begin
- CH1 := IdHexDigits[(AValue[AIndex+I] and $F0) shr 4];
- CH2 := IdHexDigits[AValue[AIndex+I] and $F];
- {$IFDEF STRING_IS_IMMUTABLE}
- LSB.Append(CH1);
- LSB.Append(CH2);
- {$ELSE}
- Result[LOffset+1] := CH1;
- Result[LOffset+2] := CH2;
- Inc(LOffset, 2);
- {$ENDIF}
- end;
- {$IFDEF STRING_IS_IMMUTABLE}
- Result := LSB.ToString;
- {$ENDIF}
- end;
- end;
- function ToHex(const AValue: array of UInt32): string;
- var
- {$IFDEF STRING_IS_IMMUTABLE}
- LSB: TIdStringBuilder;
- {$ENDIF}
- P: {$IFDEF DOTNET}TIdBytes{$ELSE}PByteArray{$ENDIF};
- i, j: Integer;
- begin
- Result := '';
- if Length(AValue) > 0 then
- begin
- {$IFDEF STRING_IS_IMMUTABLE}
- LSB := TIdStringBuilder.Create(Length(AValue)*SizeOf(UInt32)*2);
- {$ELSE}
- SetLength(Result, Length(AValue)*SizeOf(UInt32)*2);
- {$ENDIF}
- for i := 0 to High(AValue) do begin
- {$IFDEF DOTNET}
- P := ToBytes(AValue[i]);
- {$ELSE}
- P := PByteArray(@AValue[i]);
- {$ENDIF}
- for j := 0 to SizeOf(UInt32)-1 do begin
- {$IFDEF STRING_IS_IMMUTABLE}
- LSB.Append(IdHexDigits[(P[j] and $F0) shr 4]);
- LSB.Append(IdHexDigits[P[j] and $F]);
- {$ELSE}
- Result[(i*SizeOf(UInt32))+(j*2)+1] := IdHexDigits[(P^[j] and $F0) shr 4];
- Result[(i*SizeOf(UInt32))+(j*2)+2] := IdHexDigits[P^[j] and $F];
- {$ENDIF}
- end;
- end;//for
- {$IFDEF STRING_IS_IMMUTABLE}
- Result := LSB.ToString;
- {$ENDIF}
- end;
- end;
- function IPv4ToHex(const AIPAddress: string; const ADotted: Boolean): string;
- var
- i: Integer;
- LBuf, LTmp: string;
- begin
- LBuf := Trim(AIPAddress);
- Result := IdHexPrefix;
- for i := 0 to 3 do begin
- LTmp := ByteToHex(IndyStrToInt(Fetch(LBuf, '.', True)));
- if ADotted then begin
- Result := Result + '.' + IdHexPrefix + LTmp;
- end else begin
- Result := Result + LTmp;
- end;
- end;
- end;
- {$IFNDEF DOTNET}
- function OctalToInt64(const AValue: string): Int64;
- var
- i: Integer;
- begin
- Result := 0;
- for i := 1 to Length(AValue) do begin
- Result := (Result shl 3) + IndyStrToInt(AValue[i], 0);
- end;
- end;
- {$ENDIF}
- function ByteToOctal(const AByte: Byte): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$IFDEF STRING_IS_IMMUTABLE}
- var
- LSB: TIdStringBuilder;
- C: Char;
- {$ENDIF}
- begin
- {$IFDEF STRING_IS_IMMUTABLE}
- C := IdOctalDigits[(AByte shr 6) and $7];
- if C <> '0' then begin
- LSB := TIdStringBuilder.Create(4);
- LSB.Append(Char('0')); {do not localize}
- end else begin
- LSB := TIdStringBuilder.Create(3);
- end;
- LSB.Append(C);
- LSB.Append(IdOctalDigits[(AByte shr 3) and $7]);
- LSB.Append(IdOctalDigits[AByte and $7]);
- Result := LSB.ToString;
- {$ELSE}
- SetLength(Result, 3);
- Result[1] := IdOctalDigits[(AByte shr 6) and $7];
- Result[2] := IdOctalDigits[(AByte shr 3) and $7];
- Result[3] := IdOctalDigits[AByte and $7];
- if Result[1] <> '0' then begin {do not localize}
- Result := '0' + Result; {do not localize}
- end;
- {$ENDIF}
- end;
- function IPv4ToOctal(const AIPAddress: string): string;
- var
- i: Integer;
- LBuf: string;
- begin
- LBuf := Trim(AIPAddress);
- Result := ByteToOctal(IndyStrToInt(Fetch(LBuf, '.', True), 0));
- for i := 0 to 2 do begin
- Result := Result + '.' + ByteToOctal(IndyStrToInt(Fetch(LBuf, '.', True), 0));
- end;
- end;
- procedure CopyTIdBytes(const ASource: TIdBytes; const ASourceIndex: Integer;
- var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- System.array.Copy(ASource, ASourceIndex, VDest, ADestIndex, ALength);
- {$ELSE}
- //if these asserts fail, then it indicates an attempted buffer overrun.
- Assert(ASourceIndex >= 0);
- Assert((ASourceIndex+ALength) <= Length(ASource));
- if ALength > 0 then
- Move(ASource[ASourceIndex], VDest[ADestIndex], ALength);
- {$ENDIF}
- end;
- procedure CopyTIdChar(const ASource: Char; var VDest: TIdBytes; const ADestIndex: Integer;
- ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- );
- var
- LChars: {$IFDEF DOTNET}array[0..0] of Char{$ELSE}TIdWideChars{$ENDIF};
- begin
- EnsureEncoding(ADestEncoding);
- {$IFDEF STRING_IS_UNICODE}
- {$IFNDEF DOTNET}
- SetLength(LChars, 1);
- {$ENDIF}
- LChars[0] := ASource;
- ADestEncoding.GetBytes(LChars, 0, 1, VDest, ADestIndex);
- {$ELSE}
- EnsureEncoding(ASrcEncoding, encOSDefault);
- LChars := ASrcEncoding.GetChars(RawToBytes(ASource, 1));
- ADestEncoding.GetBytes(LChars, 0, Length(LChars), VDest, ADestIndex);
- {$ENDIF}
- end;
- procedure CopyTIdInt16(const ASource: Int16; var VDest: TIdBytes; const ADestIndex: Integer);
- {$IFDEF DOTNET}
- var
- LShort : TIdBytes;
- {$ELSE}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF DOTNET}
- LShort := System.BitConverter.GetBytes(ASource);
- System.array.Copy(LShort, 0, VDest, ADestIndex, SizeOf(Int16));
- {$ELSE}
- PInt16(@VDest[ADestIndex])^ := ASource;
- {$ENDIF}
- end;
- {$I IdDeprecatedImplBugOff.inc}
- procedure CopyTIdShort(const ASource: Int16; var VDest: TIdBytes; const ADestIndex: Integer);
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- CopyTIdInt16(ASource, VDest, ADestIndex);
- end;
- procedure CopyTIdUInt16(const ASource: UInt16; var VDest: TIdBytes; const ADestIndex: Integer);
- {$IFDEF DOTNET}
- var
- LWord : TIdBytes;
- {$ELSE}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF DOTNET}
- LWord := System.BitConverter.GetBytes(ASource);
- System.array.Copy(LWord, 0, VDest, ADestIndex, SizeOf(UInt16));
- {$ELSE}
- PUInt16(@VDest[ADestIndex])^ := ASource;
- {$ENDIF}
- end;
- {$I IdDeprecatedImplBugOff.inc}
- procedure CopyTIdWord(const ASource: UInt16; var VDest: TIdBytes; const ADestIndex: Integer);
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- CopyTIdUInt16(ASource, VDest, ADestIndex);
- end;
- procedure CopyTIdUInt32(const ASource: UInt32; var VDest: TIdBytes; const ADestIndex: Integer);
- {$IFDEF DOTNET}
- var
- LWord : TIdBytes;
- {$ELSE}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF DOTNET}
- LWord := System.BitConverter.GetBytes(ASource);
- System.array.Copy(LWord, 0, VDest, ADestIndex, SizeOf(UInt32));
- {$ELSE}
- PUInt32(@VDest[ADestIndex])^ := ASource;
- {$ENDIF}
- end;
- {$I IdDeprecatedImplBugOff.inc}
- procedure CopyTIdLongWord(const ASource: UInt32; var VDest: TIdBytes; const ADestIndex: Integer);
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- CopyTIdUInt32(ASource, VDest, ADestIndex);
- end;
- procedure CopyTIdInt32(const ASource: Int32; var VDest: TIdBytes; const ADestIndex: Integer);
- {$IFDEF DOTNET}
- var
- LInt : TIdBytes;
- {$ELSE}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF DOTNET}
- LInt := System.BitConverter.GetBytes(ASource);
- System.array.Copy(LInt, 0, VDest, ADestIndex, SizeOf(Int32));
- {$ELSE}
- PInt32(@VDest[ADestIndex])^ := ASource;
- {$ENDIF}
- end;
- {$I IdDeprecatedImplBugOff.inc}
- procedure CopyTIdLongInt(const ASource: Int32; var VDest: TIdBytes; const ADestIndex: Integer);
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- CopyTIdInt32(ASource, VDest, ADestIndex);
- end;
- procedure CopyTIdInt64(const ASource: Int64; var VDest: TIdBytes; const ADestIndex: Integer);
- {$IFDEF DOTNET}
- var
- LWord : TIdBytes;
- {$ELSE}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF DOTNET}
- LWord := System.BitConverter.GetBytes(ASource);
- System.array.Copy(LWord, 0, VDest, ADestIndex, SizeOf(Int64));
- {$ELSE}
- PInt64(@VDest[ADestIndex])^ := ASource;
- {$ENDIF}
- end;
- procedure CopyTIdUInt64(const ASource: TIdUInt64;
- var VDest: TIdBytes; const ADestIndex: Integer);
- {$IFDEF DOTNET}
- var
- LWord : TIdBytes;
- {$ELSE}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF DOTNET}
- LWord := System.BitConverter.GetBytes(ASource);
- System.array.Copy(LWord, 0, VDest, ADestIndex, SizeOf(UInt64));
- {$ELSE}
- PUInt64(@VDest[ADestIndex])^ := ASource{$IFDEF TIdUInt64_HAS_QuadPart}.QuadPart{$ENDIF};
- {$ENDIF}
- end;
- {$IFDEF UInt64_IS_NATIVE}
- {$IFDEF TIdUInt64_HAS_QuadPart}
- {$DEFINE USE_TIdTicks_TIdUInt64_CONVERSION}
- {$ENDIF}
- {$ENDIF}
- procedure CopyTIdTicks(const ASource: TIdTicks; var VDest: TIdBytes; const ADestIndex: Integer);
- {$IFDEF USE_TIdTicks_TIdUInt64_CONVERSION}
- var
- LValue: TIdUInt64;
- {$ELSE}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF USE_TIdTicks_TIdUInt64_CONVERSION}
- // In C++Builder 2006/2007, TIdUInt64 is a packed record, but TIdTicks is
- // an alias for a native UInt64, so need a conversion here to get around
- // a compiler error: "E2010 Incompatible types: 'TIdUInt64' and 'UInt64'"...
- LValue.QuadPart := ASource;
- CopyTIdUInt64(LValue, VDest, ADestIndex);
- {$ELSE}
- {$IFDEF UInt64_IS_NATIVE}
- CopyTIdUInt64(ASource, VDest, ADestIndex);
- {$ELSE}
- CopyTIdInt64(ASource, VDest, ADestIndex);
- {$ENDIF}
- {$ENDIF}
- end;
- procedure CopyTIdIPV6Address(const ASource: TIdIPv6Address; var VDest: TIdBytes; const ADestIndex: Integer);
- {$IFDEF DOTNET}
- var
- i : Integer;
- {$ELSE}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF DOTNET}
- for i := 0 to 7 do begin
- CopyTIdUInt16(ASource[i], VDest, ADestIndex + (i * 2));
- end;
- {$ELSE}
- Move(ASource, VDest[ADestIndex], 16);
- {$ENDIF}
- end;
- procedure CopyTIdByteArray(const ASource: array of Byte; const ASourceIndex: Integer;
- var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer);
- begin
- {$IFDEF DOTNET}
- System.array.Copy(ASource, ASourceIndex, VDest, ADestIndex, ALength);
- {$ELSE}
- Move(ASource[ASourceIndex], VDest[ADestIndex], ALength);
- {$ENDIF}
- end;
- procedure CopyTIdString(const ASource: String; var VDest: TIdBytes;
- const ADestIndex: Integer; const ALength: Integer = -1;
- ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ); overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- CopyTIdString(ASource, 1, VDest, ADestIndex, ALength, ADestEncoding
- {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
- );
- end;
- procedure CopyTIdString(const ASource: String; const ASourceIndex: Integer;
- var VDest: TIdBytes; const ADestIndex: Integer; const ALength: Integer = -1;
- ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ); overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LLength: Integer;
- {$IFDEF STRING_IS_ANSI}
- LTmp: TIdWideChars;
- {$ENDIF}
- begin
- {$IFDEF STRING_IS_ANSI}
- LTmp := nil; // keep the compiler happy
- {$ENDIF}
- LLength := IndyLength(ASource, ALength, ASourceIndex);
- if LLength > 0 then begin
- EnsureEncoding(ADestEncoding);
- {$IFDEF STRING_IS_UNICODE}
- ADestEncoding.GetBytes(ASource, ASourceIndex, LLength, VDest, ADestIndex);
- {$ELSE}
- EnsureEncoding(ASrcEncoding, encOSDefault);
- LTmp := ASrcEncoding.GetChars(RawToBytes(ASource[ASourceIndex], LLength)); // convert to Unicode
- ADestEncoding.GetBytes(LTmp, 0, Length(LTmp), VDest, ADestIndex);
- {$ENDIF}
- end;
- end;
- // TODO: define STRING_UNICODE_MISMATCH for WinCE in IdCompilerDefines.inc?
- {$IFDEF WINDOWS}
- {$IFDEF WINCE}
- {$IFNDEF STRING_IS_UNICODE}
- {$DEFINE DEBUG_STRING_MISMATCH}
- {$ENDIF}
- {$ELSE}
- {$IFDEF STRING_UNICODE_MISMATCH}
- {$DEFINE DEBUG_STRING_MISMATCH}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- procedure DebugOutput(const AText: string);
- {$IFDEF DEBUG_STRING_MISMATCH}
- var
- LTemp: {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF};
- {$ELSE}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- begin
- // TODO: support other debugging platforms
- {$IFDEF KYLIX}
- __write(stderr, AText, Length(AText));
- __write(stderr, EOL, Length(EOL));
- {$ENDIF}
- {$IFDEF WINDOWS}
- {$IFDEF DEBUG_STRING_MISMATCH}
- LTemp := {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF}(AText); // explicit convert to Ansi/Unicode
- OutputDebugString({$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF}(LTemp));
- {$ELSE}
- OutputDebugString(PChar(AText));
- {$ENDIF}
- {$ENDIF}
- {$IFDEF DOTNET}
- System.Diagnostics.Debug.WriteLine(AText);
- {$ENDIF}
- end;
- function CurrentThreadId: TIdThreadID;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- {$IFDEF DOTNET_2_OR_ABOVE}
- {
- [Warning] IdGlobal.pas(1416): W1000 Symbol 'GetCurrentThreadId'
- is deprecated: 'AppDomain.GetCurrentThreadId has been deprecated because
- it does not provide a stable Id when managed threads are running on fibers
- (aka lightweight threads). To get a stable identifier for a managed thread,
- use the ManagedThreadId property on Thread.
- http://go.microsoft.com/fwlink/?linkid=14202'
- }
- Result := System.Threading.Thread.CurrentThread.ManagedThreadId;
- // Thread.ManagedThreadId;
- {$ENDIF}
- {$IFDEF DOTNET_1_1}
- // 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)
- Result := AppDomain.GetCurrentThreadId;
- // RLebeau
- // TODO: find if there is something like the following instead:
- // System.Diagnostics.Thread.GetCurrentThread.ID
- // System.Threading.Thread.CurrentThread.ID
- {$ENDIF}
- {$ELSE}
- // TODO: is GetCurrentThreadId() available on Linux?
- Result := GetCurrentThreadID;
- {$ENDIF}
- end;
- {$UNDEF KYLIXCOMPAT_OR_VCL_POSIX}
- {$IFDEF KYLIXCOMPAT}
- {$DEFINE KYLIXCOMPAT_OR_VCL_POSIX}
- {$ENDIF}
- {$IFDEF USE_VCL_POSIX}
- {$DEFINE KYLIXCOMPAT_OR_VCL_POSIX}
- {$ENDIF}
- function CurrentProcessId: TIdPID;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := System.Diagnostics.Process.GetCurrentProcess.ID;
- {$ELSE}
- {$IFDEF WINDOWS}
- Result := GetCurrentProcessID;
- {$ELSE}
- {$IFDEF KYLIXCOMPAT_OR_VCL_POSIX}
- Result := getpid;
- {$ELSE}
- {$IFDEF USE_BASEUNIX}
- Result := fpgetpid;
- {$ELSE}
- {$message error CurrentProcessId is not implemented on this platform!}
- Result := 0;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- end;
- function Fetch(var AInput: string; const ADelim: string = IdFetchDelimDefault;
- const ADelete: Boolean = IdFetchDeleteDefault;
- const ACaseSensitive: Boolean = IdFetchCaseSensitiveDefault): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LPos: Integer;
- begin
- if ACaseSensitive then begin
- if ADelim = #0 then begin
- // AnsiPos does not work with #0
- LPos := Pos(ADelim, AInput);
- end else begin
- LPos := IndyPos(ADelim, AInput);
- end;
- if LPos = 0 then begin
- Result := AInput;
- if ADelete then begin
- AInput := ''; {Do not Localize}
- end;
- end
- else begin
- Result := Copy(AInput, 1, LPos - 1);
- if ADelete then begin
- //slower Delete(AInput, 1, LPos + Length(ADelim) - 1); because the
- //remaining part is larger than the deleted
- AInput := Copy(AInput, LPos + Length(ADelim), MaxInt);
- end;
- end;
- end else begin
- Result := FetchCaseInsensitive(AInput, ADelim, ADelete);
- end;
- end;
- function FetchCaseInsensitive(var AInput: string; const ADelim: string;
- const ADelete: Boolean): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LPos: Integer;
- begin
- if ADelim = #0 then begin
- // AnsiPos does not work with #0
- LPos := Pos(ADelim, AInput);
- end else begin
- //? may be AnsiUpperCase?
- LPos := IndyPos(UpperCase(ADelim), UpperCase(AInput));
- end;
- if LPos = 0 then begin
- Result := AInput;
- if ADelete then begin
- AInput := ''; {Do not Localize}
- end;
- end else begin
- Result := Copy(AInput, 1, LPos - 1);
- if ADelete then begin
- //faster than Delete(AInput, 1, LPos + Length(ADelim) - 1); because the
- //remaining part is larger than the deleted
- AInput := Copy(AInput, LPos + Length(ADelim), MaxInt);
- end;
- end;
- end;
- function GetThreadHandle(AThread: TThread): TIdThreadHandle;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF UNIX}
- Result := AThread.ThreadID; // RLebeau: is it right to return an ID where a thread object handle is expected instead?
- {$ENDIF}
- {$IFDEF WINDOWS}
- Result := AThread.Handle;
- {$ENDIF}
- {$IFDEF DOTNET}
- Result := AThread.Handle;
- {$ENDIF}
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function Ticks: UInt32;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // TODO: maybe throw an exception if Ticks64() exceeds the 49.7 day limit of UInt32?
- Result := UInt32(Ticks64() mod High(UInt32));
- end;
- // RLebeau: breaking up the Ticks64() implementation into separate platform blocks,
- // instead of trying to do it all in one implementation. This way, the code is
- // cleaner, and if I miss a platform then the compiler should complain about Ticks64()
- // being unresolved...
- // TODO: move these to platform-specific units instead, maybe even to the TIdStack classes?
- {$IFDEF DOTNET}
- function Ticks64: TIdTicks;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // Must cast to a cardinal
- //
- // http://lists.ximian.com/archives/public/mono-bugs/2003-November/009293.html
- // Other references in Google.
- // Bug in .NET. It acts like Win32, not as per .NET docs but goes negative after 25 days.
- //
- // There may be a problem in the future if .NET changes this to work as docced with 25 days.
- // Will need to check our routines then and somehow counteract / detect this.
- // One possibility is that we could just wrap it ourselves in this routine.
- // TODO: use DateTime.Ticks instead?
- //Result := DateTime.Now.Ticks div 10000;
- Result := TIdTicks(Environment.TickCount);
- end;
- {$ELSE}
- {$IFDEF WINDOWS}
- type
- TGetTickCount64Func = function: UInt64; stdcall;
- var
- GetTickCount64: TGetTickCount64Func = nil;
- function Impl_GetTickCount64: UInt64; stdcall;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // TODO: implement some kind of accumulator so the Result
- // keeps growing even when GetTickCount() wraps back to 0.
- // Or maybe access the CPU's TSC via the x86 RDTSC instruction...
- Result := UInt64(Windows.GetTickCount);
- end;
- function Stub_GetTickCount64: UInt64; stdcall;
- function GetImpl: Pointer;
- begin
- Result := LoadLibFunction(GetModuleHandle('KERNEL32'), 'GetTickCount64'); {do not localize}
- if Result = nil then begin
- Result := @Impl_GetTickCount64;
- end;
- end;
- begin
- @GetTickCount64 := GetImpl();
- Result := GetTickCount64();
- end;
- function Ticks64: TIdTicks;
- {$IFDEF USE_HI_PERF_COUNTER_FOR_TICKS}
- var
- nTime, freq: {$IFDEF WINCE}LARGE_INTEGER{$ELSE}Int64{$ENDIF};
- {$ENDIF}
- begin
- // S.G. 27/11/2002: Changed to use high-performance counters as per suggested
- // S.G. 27/11/2002: by David B. Ferguson ([email protected])
- // RLebeau 11/12/2009: removed the high-performance counters again. They
- // are not reliable on multi-core systems, and are now starting to cause
- // problems with TIdIOHandler.ReadLn() timeouts under Windows XP SP3, both
- // 32-bit and 64-bit. Refer to these discussions:
- //
- // http://www.virtualdub.org/blog/pivot/entry.php?id=106
- // http://blogs.msdn.com/oldnewthing/archive/2008/09/08/8931563.aspx
- {$IFDEF USE_HI_PERF_COUNTER_FOR_TICKS}
- {$IFDEF WINCE}
- if Windows.QueryPerformanceCounter(@nTime) then begin
- if Windows.QueryPerformanceFrequency(@freq) then begin
- Result := Trunc((nTime.QuadPart / Freq.QuadPart) * 1000) and High(TIdTicks);
- Exit;
- end;
- end;
- {$ELSE}
- if Windows.QueryPerformanceCounter(nTime) then begin
- if Windows.QueryPerformanceFrequency(freq) then begin
- Result := Trunc((nTime / Freq) * 1000) and High(TIdTicks);
- Exit;
- end;
- end;
- {$ENDIF}
- {$ENDIF}
- Result := TIdTicks(GetTickCount64());
- end;
- {$ELSE}
- {$IFDEF USE_clock_gettime}
- {$IFDEF LINUX}
- // according to Linux's /usr/include/linux/time.h
- const
- CLOCK_MONOTONIC = 1;
- {$ENDIF}
- {$IFDEF FREEBSD}
- // according to FreeBSD's /usr/include/time.h
- const
- CLOCK_MONOTONIC = 4;
- {$ENDIF}
- {$IFDEF ANDROID}
- // according to Android NDK's /include/time.h
- const
- CLOCK_MONOTONIC = 1;
- {$ENDIF}
- function clock_gettime(clockid: Integer; var pts: timespec): Integer; cdecl; external 'libc';
- function Ticks64: TIdTicks;
- var
- ts: timespec;
- begin
- // TODO: use CLOCK_BOOTTIME on platforms that support it? It takes system
- // suspension into account, whereas CLOCK_MONOTONIC does not...
- clock_gettime(CLOCK_MONOTONIC, ts);
- {$I IdRangeCheckingOff.inc}
- {$I IdOverflowCheckingOff.inc}
- Result := (Int64(ts.tv_sec) * 1000) + (ts.tv_nsec div 1000000);
- {$I IdOverflowCheckingOn.inc}
- {$I IdRangeCheckingOn.inc}
- end;
- {$ELSE}
- {$IFDEF UNIX}
- {$IFDEF OSX}
- {$IFDEF FPC}
- //RLebeau: FPC does not provide mach_timebase_info() and mach_absolute_time() yet...
- function mach_timebase_info(var TimebaseInfoData: TTimebaseInfoData): Integer; cdecl; external 'libc';
- function mach_absolute_time: QWORD; cdecl; external 'libc';
- {$ENDIF}
- {$ENDIF}
- function Ticks64: TIdTicks;
- {$IFDEF OSX}
- {$IFDEF USE_INLINE} inline;{$ENDIF}
- {$ELSE}
- var
- tv: timeval;
- {$ENDIF}
- begin
- {$IFDEF OSX}
- // TODO: mach_absolute_time() does NOT count ticks while the system is
- // sleeping! We can use time() to account for that:
- //
- // "time() carries on incrementing while the device is asleep, but of
- // course can be manipulated by the operating system or user. However,
- // the Kernel boottime (a timestamp of when the system last booted)
- // also changes when the system clock is changed, therefore even though
- // both these values are not fixed, the offset between them is."
- //
- // time_t uptime()
- // {
- // struct timeval boottime;
- // int mib[2] = {CTL_KERN, KERN_BOOTTIME};
- // size_t size = sizeof(boottime);
- // time_t now;
- // time_t uptime = -1;
- // time(&now);
- // if ((sysctl(mib, 2, &boottime, &size, NULL, 0) != -1) && (boottime.tv_sec != 0))
- // {
- // uptime = now - boottime.tv_sec;
- // }
- // return uptime;
- // }
- //
- // However, KERN_BOOTTIME only has *seconds* precision (timeval.tv_usecs is always 0).
- // mach_absolute_time() returns billionth of seconds, so divide by one million to get milliseconds
- Result := (mach_absolute_time() * GMachTimeBaseInfo.numer) div (1000000 * GMachTimeBaseInfo.denom);
- {$ELSE}
- // TODO: raise an exception if gettimeofday() fails...
- {$IFDEF KYLIXCOMPAT_OR_VCL_POSIX}
- gettimeofday(tv, nil);
- {$ELSE}
- {$IFDEF USE_BASEUNIX}
- fpgettimeofday(@tv,nil);
- {$ELSE}
- {$message error gettimeofday is not called on this platform!}
- FillChar(tv, sizeof(tv), 0);
- {$ENDIF}
- {$ENDIF}
- {
- I've implemented this correctly for now. I'll argue for using
- an int64 internally, since apparently quite some functionality
- (throttle, etc etc) depends on it, and this value may wrap
- at any point in time.
- For Windows: Uptime > 72 hours isn't really that rare any more,
- For Linux: no control over when this wraps.
- IdEcho has code to circumvent the wrap, but its not very good
- to have code for that at all spots where it might be relevant.
- }
- {$I IdRangeCheckingOff.inc}
- Result := (Int64(tv.tv_sec) * 1000) + (tv.tv_usec div 1000);
- {$I IdRangeCheckingOn.inc}
- {$ENDIF}
- end;
- {$ELSE}
- function Ticks64: TIdTicks;
- begin
- {$message error Ticks64 is not implemented on this platform!}
- Result := 0;
- end;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$I IdDeprecatedImplBugOff.inc}
- function GetTickDiff(const AOldTickCount, ANewTickCount: UInt32): UInt32;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {This is just in case the TickCount rolled back to zero}
- if ANewTickCount >= AOldTickCount then begin
- Result := ANewTickCount - AOldTickCount;
- end else begin
- Result := ((High(UInt32) - AOldTickCount) + ANewTickCount) + 1;
- end;
- end;
- function GetTickDiff64(const AOldTickCount, ANewTickCount: TIdTicks): TIdTicks;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {This is just in case the TickCount rolled back to zero}
- if ANewTickCount >= AOldTickCount then begin
- Result := TIdTicks(ANewTickCount - AOldTickCount);
- end else begin
- Result := TIdTicks(((High(TIdTicks) - AOldTickCount) + ANewTickCount) + 1);
- end;
- end;
- function GetElapsedTicks(const AOldTickCount: TIdTicks): UInt32;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := UInt32(GetTickDiff64(AOldTickCount, Ticks64));
- end;
- function GetElapsedTicks64(const AOldTickCount: TIdTicks): TIdTicks;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := GetTickDiff64(AOldTickCount, Ticks64);
- end;
- {$IFNDEF DOTNET}
- // TODO: define STRING_UNICODE_MISMATCH for WinCE in IdCompilerDefines.inc?
- {$IFDEF WINDOWS}
- {$IFDEF WINCE}
- {$IFNDEF STRING_IS_UNICODE}
- {$DEFINE SERVICE_STRING_MISMATCH}
- {$ENDIF}
- {$ELSE}
- {$IFDEF STRING_UNICODE_MISMATCH}
- {$DEFINE SERVICE_STRING_MISMATCH}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- function ServicesFilePath: string;
- var
- sLocation: {$IFDEF SERVICE_STRING_MISMATCH}TIdPlatformString{$ELSE}string{$ENDIF};
- begin
- {$IFDEF UNIX}
- sLocation := '/etc/'; // assume Berkeley standard placement {do not localize}
- {$ENDIF}
- {$IFDEF WINDOWS}
- {$IFNDEF WINCE}
- SetLength(sLocation, MAX_PATH);
- SetLength(sLocation, GetWindowsDirectory(PIdPlatformChar(sLocation), MAX_PATH));
- sLocation := IndyIncludeTrailingPathDelimiter(string(sLocation));
- if IndyWindowsPlatform = VER_PLATFORM_WIN32_NT then begin
- sLocation := sLocation + 'system32\drivers\etc\'; {do not localize}
- end;
- {$ELSE}
- // GetWindowsDirectory() does not exist in WinCE, and there is no system folder, either
- sLocation := '\Windows\'; {do not localize}
- {$ENDIF}
- {$ENDIF}
- Result := sLocation + 'services'; {do not localize}
- end;
- {$ENDIF}
- {$IFNDEF DOTNET}
- // IdPorts returns a list of defined ports in /etc/services
- function IdPorts: TIdPortList;
- var
- s: string;
- idx, iPosSlash: {$IFDEF BYTE_COMPARE_SETS}Byte{$ELSE}Integer{$ENDIF};
- i: {$IFDEF HAS_GENERICS_TList}Integer{$ELSE}PtrInt{$ENDIF};
- iPrev: PtrInt;
- sl: TStringList;
- begin
- if GIdPorts = nil then
- begin
- GIdPorts := TIdPortList.Create;
- sl := TStringList.Create;
- try
- // TODO: use TStreamReader instead, on versions that support it
- sl.LoadFromFile(ServicesFilePath); {do not localize}
- iPrev := 0;
- for idx := 0 to sl.Count - 1 do
- begin
- s := sl[idx];
- iPosSlash := IndyPos('/', s); {do not localize}
- if (iPosSlash > 0) and (not (IndyPos('#', s) in [1..iPosSlash])) then {do not localize}
- begin // presumably found a port number that isn't commented {Do not Localize}
- i := iPosSlash;
- repeat
- Dec(i);
- if i = 0 then begin
- raise EIdCorruptServicesFile.CreateFmt(RSCorruptServicesFile, [ServicesFilePath]); {do not localize}
- end;
- //TODO: Make Whitespace a function to elim warning
- until Ord(s[i]) in IdWhiteSpace;
- i := IndyStrToInt(Copy(s, i+1, iPosSlash-i-1));
- if i <> iPrev then begin
- GIdPorts.Add(
- {$IFDEF HAS_GENERICS_TList}i{$ELSE}Pointer(i){$ENDIF}
- );
- end;
- iPrev := i;
- end;
- end;
- finally
- sl.Free;
- end;
- end;
- Result := GIdPorts;
- end;
- {$ENDIF}
- function iif(ATest: Boolean; const ATrue: Integer; const AFalse: Integer): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if ATest then begin
- Result := ATrue;
- end else begin
- Result := AFalse;
- end;
- end;
- function iif(ATest: Boolean; const ATrue: string; const AFalse: string): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if ATest then begin
- Result := ATrue;
- end else begin
- Result := AFalse;
- end;
- end;
- function iif(ATest: Boolean; const ATrue: Boolean; const AFalse: Boolean): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if ATest then begin
- Result := ATrue;
- end else begin
- Result := AFalse;
- end;
- end;
- function iif(const AEncoding, ADefEncoding: IIdTextEncoding; ADefEncodingType: IdTextEncodingType = encASCII): IIdTextEncoding;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := AEncoding;
- if Result = nil then
- begin
- Result := ADefEncoding;
- EnsureEncoding(Result, ADefEncodingType);
- end;
- end;
- function InMainThread: Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := System.Threading.Thread.CurrentThread = MainThread;
- {$ELSE}
- Result := GetCurrentThreadID = MainThreadID;
- {$ENDIF}
- end;
- procedure WriteMemoryStreamToStream(Src: TMemoryStream; Dest: TStream; Count: TIdStreamSize);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Dest.Write(Src.Memory, Count);
- {$ELSE}
- Dest.Write(Src.Memory^, Count);
- {$ENDIF}
- end;
- {$IFNDEF DOTNET_EXCLUDE}
- function IsCurrentThread(AThread: TThread): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := AThread.ThreadID = GetCurrentThreadID;
- end;
- {$ENDIF}
- //convert a dword into an IPv4 address in dotted form
- function MakeUInt32IntoIPv4Address(const ADWord: UInt32): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := IntToStr((ADWord shr 24) and $FF) + '.';
- Result := Result + IntToStr((ADWord shr 16) and $FF) + '.';
- Result := Result + IntToStr((ADWord shr 8) and $FF) + '.';
- Result := Result + IntToStr(ADWord and $FF);
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function MakeDWordIntoIPv4Address(const ADWord: UInt32): string;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := MakeUInt32IntoIPv4Address(ADWord);
- end;
- function IsAlpha(const AChar: Char): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // TODO: under XE3.5+, use TCharHelper.IsLetter() instead
- // TODO: under D2009+, use TCharacter.IsLetter() instead
- // Do not use IsCharAlpha or IsCharAlphaNumeric - they are Win32 routines
- Result := ((AChar >= 'a') and (AChar <= 'z')) or ((AChar >= 'A') and (AChar <= 'Z')); {Do not Localize}
- end;
- function IsAlpha(const AString: String; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- i: Integer;
- LLen: Integer;
- begin
- Result := False;
- LLen := IndyLength(AString, ALength, AIndex);
- if LLen > 0 then begin
- for i := 0 to LLen-1 do begin
- if not IsAlpha(AString[AIndex+i]) then begin
- Exit;
- end;
- end;
- Result := True;
- end;
- end;
- function IsAlphaNumeric(const AChar: Char): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // Do not use IsCharAlpha or IsCharAlphaNumeric - they are Win32 routines
- Result := IsAlpha(AChar) or IsNumeric(AChar);
- end;
- function IsAlphaNumeric(const AString: String; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- i: Integer;
- LLen: Integer;
- begin
- Result := False;
- LLen := IndyLength(AString, ALength, AIndex);
- if LLen > 0 then begin
- for i := 0 to LLen-1 do begin
- if not IsAlphaNumeric(AString[AIndex+i]) then begin
- Exit;
- end;
- end;
- Result := True;
- end;
- end;
- function IsOctal(const AChar: Char): Boolean; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := (AChar >= '0') and (AChar <= '7') {Do not Localize}
- end;
- function IsOctal(const AString: string; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- i: Integer;
- LLen: Integer;
- begin
- Result := False;
- LLen := IndyLength(AString, ALength, AIndex);
- if LLen > 0 then begin
- for i := 0 to LLen-1 do begin
- if not IsOctal(AString[AIndex+i]) then begin
- Exit;
- end;
- end;
- Result := True;
- end;
- end;
- function IsHexidecimal(const AChar: Char): Boolean; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := ((AChar >= '0') and (AChar <= '9')) {Do not Localize}
- or ((AChar >= 'A') and (AChar <= 'F')) {Do not Localize}
- or ((AChar >= 'a') and (AChar <= 'f')); {Do not Localize}
- end;
- function IsHexidecimal(const AString: string; const ALength: Integer = -1; const AIndex: Integer = 1): Boolean; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- i: Integer;
- LLen: Integer;
- begin
- Result := False;
- LLen := IndyLength(AString, ALength, AIndex);
- if LLen > 0 then begin
- for i := 0 to LLen-1 do begin
- if not IsHexidecimal(AString[AIndex+i]) then begin
- Exit;
- end;
- end;
- Result := True;
- end;
- end;
- {$HINTS OFF}
- function IsNumeric(const AString: string): Boolean;
- var
- LCode: Integer;
- LVoid: Int64;
- begin
- Val(AString, LVoid, LCode);
- Result := LCode = 0;
- end;
- {$HINTS ON}
- function IsNumeric(const AString: string; const ALength: Integer; const AIndex: Integer = 1): Boolean;
- var
- I: Integer;
- LLen: Integer;
- begin
- Result := False;
- LLen := IndyLength(AString, ALength, AIndex);
- if LLen > 0 then begin
- for I := 0 to LLen-1 do begin
- if not IsNumeric(AString[AIndex+i]) then begin
- Exit;
- end;
- end;
- Result := True;
- end;
- end;
- function IsNumeric(const AChar: Char): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // TODO: under XE3.5+, use TCharHelper.IsDigit() instead
- // TODO: under D2009+, use TCharacter.IsDigit() instead
- // Do not use IsCharAlpha or IsCharAlphaNumeric - they are Win32 routines
- Result := (AChar >= '0') and (AChar <= '9'); {Do not Localize}
- end;
- {
- This is an adaptation of the StrToInt64 routine in SysUtils.
- We had to adapt it to work with Int64 because the one with Integers
- can not deal with anything greater than MaxInt and IP addresses are
- always $0-$FFFFFFFF (unsigned)
- }
- {$IFNDEF HAS_StrToInt64Def}
- function StrToInt64Def(const S: string; const Default: Integer): Int64;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- E: Integer;
- begin
- Val(S, Result, E);
- if E <> 0 then begin
- Result := Default;
- end;
- end;
- {$ENDIF}
- function IPv4MakeUInt32InRange(const AInt: Int64; const A256Power: Integer): UInt32;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- //Note that this function is only for stripping off some extra bits
- //from an address that might appear in some spam E-Mails.
- begin
- case A256Power of
- 4: Result := (AInt and POWER_4);
- 3: Result := (AInt and POWER_3);
- 2: Result := (AInt and POWER_2);
- else
- Result := (AInt and POWER_1);
- end;
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function IPv4MakeLongWordInRange(const AInt: Int64; const A256Power: Integer): UInt32;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := IPv4MakeUInt32InRange(AInt, A256Power);
- end;
- function IPv4ToUInt32(const AIPAddress: string): UInt32;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LErr: Boolean;
- begin
- Result := IPv4ToUInt32(AIPAddress, LErr);
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function IPv4ToDWord(const AIPAddress: string): UInt32; overload;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := IPv4ToUInt32(AIPAddress);
- end;
- function IPv4ToUInt32(const AIPAddress: string; var VErr: Boolean): UInt32;
- var
- {$IFDEF DOTNET}
- AIPaddr: IPAddress;
- {$ELSE}
- LBuf, LBuf2: string;
- L256Power: Integer;
- LParts: Integer; //how many parts should we process at a time
- {$ENDIF}
- begin
- VErr := True;
- Result := 0;
- {$IFDEF DOTNET}
- AIPaddr := System.Net.IPAddress.Parse(AIPAddress);
- try
- try
- if AIPaddr.AddressFamily = Addressfamily.InterNetwork then begin
- {$IFDEF DOTNET_2_OR_ABOVE}
- //This looks funny but it's just to circvument a warning about
- //a depreciated property in AIPaddr. We can safely assume
- //this is an IPv4 address.
- Result := BytesToUInt32( AIPAddr.GetAddressBytes,0);
- {$ENDIF}
- {$IFDEF DOTNET_1_1}
- Result := AIPaddr.Address;
- {$ENDIF}
- VErr := False;
- end;
- except
- VErr := True;
- end;
- finally
- FreeAndNil(AIPaddr);
- end;
- {$ELSE}
- // S.G. 11/8/2003: Added overflow checking disabling and change multiplys by SHLs.
- // Locally disable overflow checking so we can safely use SHL and SHR
- {$I IdOverflowCheckingOff.inc}
- L256Power := 4;
- LBuf2 := AIPAddress;
- repeat
- LBuf := Fetch(LBuf2, '.');
- if LBuf = '' then begin
- Break;
- end;
- //We do things this way because we have to treat
- //IP address parts differently than a whole number
- //and sometimes, there can be missing periods.
- if (LBuf2 = '') and (L256Power > 1) then begin
- LParts := L256Power;
- Result := Result shl (L256Power SHL 3);
- end else begin
- LParts := 1;
- Result := Result shl 8;
- end;
- if TextStartsWith(LBuf, IdHexPrefix) then begin
- //this is a hexideciaml number
- if not IsHexidecimal(Copy(LBuf, 3, MaxInt)) then begin
- Exit;
- end;
- Result := Result + IPv4MakeUInt32InRange(StrToInt64Def(LBuf, 0), LParts);
- end else begin
- if not IsNumeric(LBuf) then begin
- //There was an error meaning an invalid IP address
- Exit;
- end;
- if TextStartsWith(LBuf, '0') and IsOctal(LBuf) then begin {do not localize}
- //this is octal
- Result := Result + IPv4MakeUInt32InRange(OctalToInt64(LBuf), LParts);
- end else begin
- //this must be a decimal
- Result := Result + IPv4MakeUInt32InRange(StrToInt64Def(LBuf, 0), LParts);
- end;
- end;
- Dec(L256Power);
- until False;
- VErr := False;
- // Restore overflow checking
- {$I IdOverflowCheckingOn.inc}
- {$ENDIF}
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function IPv4ToDWord(const AIPAddress: string; var VErr: Boolean): UInt32;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := IPv4ToUInt32(AIPAddress, VErr);
- end;
- function IPv6AddressToStr(const AValue: TIdIPv6Address): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- i: Integer;
- begin
- Result := IntToHex(AValue[0], 4);
- for i := 1 to 7 do begin
- Result := Result + ':' + IntToHex(AValue[i], 4);
- end;
- end;
- function MakeCanonicalIPv4Address(const AAddr: string): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LErr: Boolean;
- LIP: UInt32;
- begin
- LIP := IPv4ToUInt32(AAddr, LErr);
- if LErr then begin
- Result := '';
- end else begin
- Result := MakeUInt32IntoIPv4Address(LIP);
- end;
- end;
- function MakeCanonicalIPv6Address(const AAddr: string): string;
- // return an empty string if the address is invalid,
- // for easy checking if its an address or not.
- var
- p, i: Integer;
- {$IFDEF BYTE_COMPARE_SETS}
- dots, colons: Byte;
- {$ELSE}
- dots, colons: Integer;
- {$ENDIF}
- colonpos: array[1..8] of Integer;
- dotpos: array[1..3] of Integer;
- LAddr: string;
- num: Integer;
- haddoublecolon: boolean;
- fillzeros: Integer;
- begin
- Result := ''; // error
- LAddr := AAddr;
- if Length(LAddr) = 0 then begin
- Exit;
- end;
- if TextStartsWith(LAddr, ':') then begin
- LAddr := '0' + LAddr;
- end;
- if TextEndsWith(LAddr, ':') then begin
- LAddr := LAddr + '0';
- end;
- dots := 0;
- colons := 0;
- for p := 1 to Length(LAddr) do begin
- case LAddr[p] of
- '.': begin
- Inc(dots);
- if dots < 4 then begin
- dotpos[dots] := p;
- end else begin
- Exit; // error in address
- end;
- end;
- ':': begin
- Inc(colons);
- if colons < 8 then begin
- colonpos[colons] := p;
- end else begin
- Exit; // error in address
- end;
- end;
- 'a'..'f',
- 'A'..'F': if dots > 0 then Exit;
- // allow only decimal stuff within dotted portion, ignore otherwise
- '0'..'9': ; // do nothing
- else
- Exit; // error in address
- end; // case
- end; // for
- if not (dots in [0,3]) then begin
- Exit; // you have to write 0 or 3 dots...
- end;
- if dots = 3 then begin
- if not (colons in [2..6]) then begin
- Exit; // must not have 7 colons if we have dots
- end;
- if colonpos[colons] > dotpos[1] then begin
- Exit; // x:x:x.x:x:x is not valid
- end;
- end else begin
- if not (colons in [2..7]) then begin
- Exit; // must at least have two colons
- end;
- end;
- // now start :-)
- num := IndyStrToInt('$'+Copy(LAddr, 1, colonpos[1]-1), -1);
- if (num < 0) or (num > 65535) then begin
- Exit; // huh? odd number...
- end;
- Result := IntToHex(num, 1) + ':';
- haddoublecolon := False;
- for p := 2 to colons do begin
- if colonpos[p - 1] = colonpos[p]-1 then begin
- if haddoublecolon then begin
- Result := '';
- Exit; // only a single double-dot allowed!
- end;
- haddoublecolon := True;
- fillzeros := 8 - colons;
- if dots > 0 then begin
- Dec(fillzeros);
- end;
- for i := 1 to fillzeros do begin
- Result := Result + '0:'; {do not localize}
- end;
- end else begin
- num := IndyStrToInt('$' + Copy(LAddr, colonpos[p - 1] + 1, colonpos[p] - colonpos[p - 1] - 1), -1);
- if (num < 0) or (num > 65535) then begin
- Result := '';
- Exit; // huh? odd number...
- end;
- Result := Result + IntToHex(num,1) + ':';
- end;
- end; // end of colon separated part
- if dots = 0 then begin
- num := IndyStrToInt('$' + Copy(LAddr, colonpos[colons] + 1, MaxInt), -1);
- if (num < 0) or (num > 65535) then begin
- Result := '';
- Exit; // huh? odd number...
- end;
- Result := Result + IntToHex(num,1) + ':';
- end;
- if dots > 0 then begin
- num := IndyStrToInt(Copy(LAddr, colonpos[colons] + 1, dotpos[1] - colonpos[colons] -1),-1);
- if (num < 0) or (num > 255) then begin
- Result := '';
- Exit;
- end;
- Result := Result + IntToHex(num, 2);
- num := IndyStrToInt(Copy(LAddr, dotpos[1]+1, dotpos[2]-dotpos[1]-1),-1);
- if (num < 0) or (num > 255) then begin
- Result := '';
- Exit;
- end;
- Result := Result + IntToHex(num, 2) + ':';
- num := IndyStrToInt(Copy(LAddr, dotpos[2] + 1, dotpos[3] - dotpos[2] -1),-1);
- if (num < 0) or (num > 255) then begin
- Result := '';
- Exit;
- end;
- Result := Result + IntToHex(num, 2);
- num := IndyStrToInt(Copy(LAddr, dotpos[3] + 1, 3), -1);
- if (num < 0) or (num > 255) then begin
- Result := '';
- Exit;
- end;
- Result := Result + IntToHex(num, 2) + ':';
- end;
- SetLength(Result, Length(Result) - 1);
- end;
- procedure IPv6ToIdIPv6Address(const AIPAddress: String; var VAddress: TIdIPv6Address);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LErr: Boolean;
- begin
- IPv6ToIdIPv6Address(AIPAddress, VAddress, LErr);
- if LErr then begin
- raise EIdInvalidIPv6Address.CreateFmt(RSInvalidIPv6Address, [AIPAddress]);
- end;
- end;
- procedure IPv6ToIdIPv6Address(const AIPAddress: String; var VAddress: TIdIPv6Address; var VErr: Boolean);
- var
- LAddress: string;
- I: Integer;
- begin
- LAddress := MakeCanonicalIPv6Address(AIPAddress);
- VErr := (LAddress = '');
- if VErr then begin
- Exit;
- end;
- for I := 0 to 7 do begin
- VAddress[I] := IndyStrToInt('$' + Fetch(LAddress,':'), 0);
- end;
- end;
- function IndyMax(const AValueOne, AValueTwo: Int64): Int64;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if AValueOne < AValueTwo then begin
- Result := AValueTwo;
- end else begin
- Result := AValueOne;
- end;
- end;
- function IndyMax(const AValueOne, AValueTwo: Int32): Int32;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if AValueOne < AValueTwo then begin
- Result := AValueTwo;
- end else begin
- Result := AValueOne;
- end;
- end;
- function IndyMax(const AValueOne, AValueTwo: UInt16): UInt16;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if AValueOne < AValueTwo then begin
- Result := AValueTwo;
- end else begin
- Result := AValueOne;
- end;
- end;
- {$IFNDEF DOTNET}
- // TODO: validate this with Unicode data
- function MemoryPos(const ASubStr: string; MemBuff: PChar; MemorySize: Integer): Integer;
- var
- LSearchLength: Integer;
- LS1: Integer;
- LChar: Char;
- LPS, LPM: PChar;
- begin
- LSearchLength := Length(ASubStr);
- if (LSearchLength = 0) or (LSearchLength > (MemorySize * SizeOf(Char))) then begin
- Result := 0;
- Exit;
- end;
- LChar := PChar(Pointer(ASubStr))^; //first char
- LPS := PChar(Pointer(ASubStr))+1;//tail string
- LPM := MemBuff;
- LS1 := LSearchLength-1;
- LSearchLength := MemorySize-LS1;//MemorySize-LS+1
- if LS1 = 0 then begin //optimization for freq used LF
- while LSearchLength > 0 do begin
- if LPM^ = LChar then begin
- Result := LPM-MemBuff + 1;
- Exit;
- end;
- Inc(LPM);
- Dec(LSearchLength);
- end;//while
- end else begin
- while LSearchLength > 0 do begin
- if LPM^ = LChar then begin
- Inc(LPM);
- if CompareMem(LPM, LPS, LS1 * SizeOf(Char)) then begin
- Result := LPM - MemBuff;
- Exit;
- end;
- end else begin
- Inc(LPM);
- end;
- Dec(LSearchLength);
- end;
- end;
- Result := 0;
- end;
- {$ENDIF}
- function IndyMin(const AValueOne, AValueTwo: Int32): Int32;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if AValueOne > AValueTwo then begin
- Result := AValueTwo;
- end else begin
- Result := AValueOne;
- end;
- end;
- function IndyMin(const AValueOne, AValueTwo: Int64): Int64;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if AValueOne > AValueTwo then begin
- Result := AValueTwo;
- end else begin
- Result := AValueOne;
- end;
- end;
- function IndyMin(const AValueOne, AValueTwo: UInt16): UInt16;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if AValueOne > AValueTwo then begin
- Result := AValueTwo;
- end else begin
- Result := AValueOne;
- end;
- end;
- function PosIdx(const ASubStr, AStr: string; AStartPos: UInt32): UInt32;
- {$IFDEF DOTNET}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ELSE}
- // use best register allocation on Win32
- function FindStr(ALStartPos, EndPos: UInt32; StartChar: Char; const ALStr: string): UInt32;
- begin
- for Result := ALStartPos to EndPos do begin
- if ALStr[Result] = StartChar then begin
- Exit;
- end;
- end;
- Result := 0;
- end;
- // use best register allocation on Win32
- function FindNextStr(ALStartPos, EndPos: UInt32; const ALStr, ALSubStr: string): UInt32;
- begin
- for Result := ALStartPos + 1 to EndPos do begin
- if ALStr[Result] <> ALSubStr[Result - ALStartPos + 1] then begin
- Exit;
- end;
- end;
- Result := 0;
- end;
- var
- StartChar: Char;
- LenSubStr, LenStr: UInt32;
- EndPos: UInt32;
- {$ENDIF}
- begin
- if AStartPos = 0 then begin
- AStartPos := 1;
- end;
- {$IFDEF DOTNET}
- Result := AStr.IndexOf(ASubStr, AStartPos-1) + 1;
- {$ELSE}
- Result := 0;
- LenSubStr := Length(ASubStr);
- LenStr := Length(AStr);
- if (LenSubStr = 0) or (AStr = '') or (LenSubStr > (LenStr - (AStartPos - 1))) then begin
- Exit;
- end;
- StartChar := ASubStr[1];
- EndPos := LenStr - LenSubStr + 1;
- if LenSubStr = 1 then begin
- Result := FindStr(AStartPos, EndPos, StartChar, AStr)
- end else
- begin
- repeat
- Result := FindStr(AStartPos, EndPos, StartChar, AStr);
- if Result = 0 then begin
- Break;
- end;
- AStartPos := Result;
- Result := FindNextStr(Result, AStartPos + LenSubStr - 1, AStr, ASubStr);
- if Result = 0 then
- begin
- Result := AStartPos;
- Exit;
- end;
- Inc(AStartPos);
- until False;
- end;
- {$ENDIF}
- end;
- function SBPos(const Substr, S: string): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // Necessary because of "Compiler magic"
- Result := Pos(Substr, S);
- end;
- {$IFNDEF DOTNET}
- function SBStrScan(Str: PChar; Chr: Char): PChar;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := SysUtils.StrScan(Str, Chr);
- end;
- {$ENDIF}
- {$IFNDEF DOTNET}
- //Don't rename this back to AnsiPos because that conceals a symbol in Windows
- function InternalAnsiPos(const Substr, S: string): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := SysUtils.AnsiPos(Substr, S);
- end;
- function InternalAnsiStrScan(Str: PChar; Chr: Char): PChar;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := SysUtils.AnsiStrScan(Str, Chr);
- end;
- {$ENDIF}
- {$UNDEF USE_TTHREAD_PRIORITY_PROP}
- {$IFDEF DOTNET}
- {$DEFINE USE_TTHREAD_PRIORITY_PROP}
- {$ENDIF}
- {$IFDEF WINDOWS}
- {$DEFINE USE_TTHREAD_PRIORITY_PROP}
- {$ENDIF}
- {$IFDEF UNIX}
- {$IFDEF USE_VCL_POSIX}
- // TODO: does this apply?
- {.$DEFINE USE_TTHREAD_PRIORITY_PROP}
- {$ENDIF}
- {$IFDEF KYLIXCOMPAT} // TODO: use KYLIXCOMPAT_OR_VCL_POSIX instead?
- {$IFNDEF INT_THREAD_PRIORITY}
- {$DEFINE USE_TTHREAD_PRIORITY_PROP}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- procedure IndySetThreadPriority(AThread: TThread; const APriority: TIdThreadPriority;
- const APolicy: Integer = -MaxInt);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF USE_TTHREAD_PRIORITY_PROP}
- AThread.Priority := APriority;
- {$ELSE}
- {$IFDEF UNIX}
- // Linux only allows root to adjust thread priorities, so we just ignore this call in Linux?
- // actually, why not allow it if root
- // and also allow setting *down* threadpriority (anyone can do that)
- // note that priority is called "niceness" and positive is lower priority
- {$IFDEF KYLIXCOMPAT} // TODO: use KYLIXCOMPAT_OR_VCL_POSIX instead?
- if (getpriority(PRIO_PROCESS, 0) < APriority) or (geteuid = 0) then begin
- setpriority(PRIO_PROCESS, 0, APriority);
- end;
- {$ELSE}
- {$IFDEF USE_BASEUNIX}
- if (fpgetpriority(PRIO_PROCESS, 0) < cint(APriority)) or (fpgeteuid = 0) then begin
- fpsetpriority(PRIO_PROCESS, 0, cint(APriority));
- end;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- end;
- procedure IndySleep(ATime: UInt32);
- {$IFDEF USE_VCL_POSIX}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LTime: TimeVal;
- {$ELSE}
- {$IFDEF UNIX}
- var
- LTime: TTimeVal;
- {$ELSE}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF DOTNET}
- Thread.Sleep(ATime);
- {$ELSE}
- {$IFDEF WINDOWS}
- Windows.Sleep(ATime);
- {$ELSE}
- {$IFDEF UNIX}
- // *nix: Is there any reason for not using nanosleep() instead?
- // what if the user just calls sleep? without doing anything...
- // cannot use GStack.WSSelectRead(nil, ATime)
- // since no readsocketlist exists to get the fdset
- LTime.tv_sec := ATime div 1000;
- LTime.tv_usec := (ATime mod 1000) * 1000;
- {$IFDEF USE_VCL_POSIX}
- select(0, nil, nil, nil, @LTime);
- {$ELSE}
- {$IFDEF KYLIXCOMPAT}
- Libc.Select(0, nil, nil, nil, @LTime);
- {$ELSE}
- {$IFDEF USE_BASEUNIX}
- fpSelect(0, nil, nil, nil, @LTime);
- {$ELSE}
- {$message error select is not called on this platform!}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ELSE}
- {$message error IndySleep is not implemented on this platform!}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- end;
- {$I IdDeprecatedImplBugOff.inc}
- procedure SplitColumnsNoTrim(const AData: string; AStrings: TStrings; const ADelim: string = ' ');
- {$I IdDeprecatedImplBugOn.inc}
- begin
- SplitDelimitedString(AData, AStrings, False, ADelim{$IFNDEF USE_OBJECT_ARC}, True{$ENDIF});
- end;
- {$I IdDeprecatedImplBugOff.inc}
- procedure SplitColumns(const AData: string; AStrings: TStrings; const ADelim: string = ' ');
- {$I IdDeprecatedImplBugOn.inc}
- begin
- SplitDelimitedString(AData, AStrings, True, ADelim{$IFNDEF USE_OBJECT_ARC}, True{$ENDIF});
- end;
- procedure SplitDelimitedString(const AData: string; AStrings: TStrings; ATrim: Boolean;
- const ADelim: string = ' '{$IFNDEF USE_OBJECT_ARC}; AIncludePositions: Boolean = False{$ENDIF});
- var
- i: Integer;
- LData: string;
- LDelim: Integer; //delim len
- LLeft: string;
- LLastPos, LLeadingSpaceCnt: PtrInt;
- begin
- Assert(Assigned(AStrings));
- AStrings.BeginUpdate;
- try
- AStrings.Clear;
- LDelim := Length(ADelim);
- LLastPos := 1;
- if ATrim then begin
- LData := Trim(AData);
- if LData = '' then begin //if WhiteStr
- Exit;
- end;
- LLeadingSpaceCnt := 0;
- while AData[LLeadingSpaceCnt + 1] <= #32 do begin
- Inc(LLeadingSpaceCnt);
- end;
- i := Pos(ADelim, LData);
- while I > 0 do begin
- LLeft := Copy(LData, LLastPos, I - LLastPos); //'abc d' len:=i(=4)-1 {Do not Localize}
- if LLeft > '' then begin {Do not Localize}
- {$IFNDEF USE_OBJECT_ARC}
- if AIncludePositions then begin
- AStrings.AddObject(Trim(LLeft), TObject(LLastPos + LLeadingSpaceCnt));
- end else
- {$ENDIF}
- begin
- AStrings.Add(Trim(LLeft));
- end;
- end;
- LLastPos := I + LDelim; //first char after Delim
- i := PosIdx(ADelim, LData, LLastPos);
- end;//while found
- if LLastPos <= Length(LData) then begin
- {$IFNDEF USE_OBJECT_ARC}
- if AIncludePositions then begin
- AStrings.AddObject(Trim(Copy(LData, LLastPos, MaxInt)), TObject(LLastPos + LLeadingSpaceCnt));
- end else
- {$ENDIF}
- begin
- AStrings.Add(Trim(Copy(LData, LLastPos, MaxInt)));
- end;
- end;
- end else
- begin
- i := Pos(ADelim, AData);
- while I > 0 do begin
- LLeft := Copy(AData, LLastPos, I - LLastPos); //'abc d' len:=i(=4)-1 {Do not Localize}
- if LLeft <> '' then begin {Do not Localize}
- {$IFNDEF USE_OBJECT_ARC}
- if AIncludePositions then begin
- AStrings.AddObject(LLeft, TObject(LLastPos));
- end else
- {$ENDIF}
- begin
- AStrings.Add(LLeft);
- end;
- end;
- LLastPos := I + LDelim; //first char after Delim
- i := PosIdx(ADelim, AData, LLastPos);
- end;
- if LLastPos <= Length(AData) then begin
- {$IFNDEF USE_OBJECT_ARC}
- if AIncludePositions then begin
- AStrings.AddObject(Copy(AData, LLastPos, MaxInt), TObject(LLastPos));
- end else
- {$ENDIF}
- begin
- AStrings.Add(Copy(AData, LLastPos, MaxInt));
- end;
- end;
- end;
- finally
- AStrings.EndUpdate;
- end;
- end;
- {$IFDEF USE_OBJECT_ARC}
- constructor TIdStringPosition.Create(const AValue: String; const APosition: Integer);
- begin
- Value := AValue;
- Position := APosition;
- end;
- procedure SplitDelimitedString(const AData: string; AStrings: TIdStringPositionList;
- ATrim: Boolean; const ADelim: string = ' ');
- var
- i: Integer;
- LData: string;
- LDelim: Integer; //delim len
- LLeft: string;
- LLastPos, LLeadingSpaceCnt: Integer;
- begin
- Assert(Assigned(AStrings));
- AStrings.Clear;
- LDelim := Length(ADelim);
- LLastPos := 1;
- if ATrim then begin
- LData := Trim(AData);
- if LData = '' then begin //if WhiteStr
- Exit;
- end;
- LLeadingSpaceCnt := 0;
- while AData[LLeadingSpaceCnt + 1] <= #32 do begin
- Inc(LLeadingSpaceCnt);
- end;
- i := Pos(ADelim, LData);
- while I > 0 do begin
- LLeft := Copy(LData, LLastPos, I - LLastPos); //'abc d' len:=i(=4)-1 {Do not Localize}
- if LLeft > '' then begin {Do not Localize}
- AStrings.Add(TIdStringPosition.Create(Trim(LLeft), LLastPos + LLeadingSpaceCnt));
- end;
- LLastPos := I + LDelim; //first char after Delim
- i := PosIdx(ADelim, LData, LLastPos);
- end;//while found
- if LLastPos <= Length(LData) then begin
- AStrings.Add(TIdStringPosition.Create(Trim(Copy(LData, LLastPos, MaxInt)), LLastPos + LLeadingSpaceCnt));
- end;
- end else
- begin
- i := Pos(ADelim, AData);
- while I > 0 do begin
- LLeft := Copy(AData, LLastPos, I - LLastPos); //'abc d' len:=i(=4)-1 {Do not Localize}
- if LLeft <> '' then begin {Do not Localize}
- AStrings.Add(TIdStringPosition.Create(LLeft, LLastPos));
- end;
- LLastPos := I + LDelim; //first char after Delim
- i := PosIdx(ADelim, AData, LLastPos);
- end;
- if LLastPos <= Length(AData) then begin
- AStrings.Add(TIdStringPosition.Create(Copy(AData, LLastPos, MaxInt), LLastPos));
- end;
- end;
- end;
- {$ENDIF}
- {$IFDEF DOTNET}
- procedure SetThreadName(const AName: string; AThread: System.Threading.Thread = nil);
- begin
- if AThread = nil then begin
- AThread := System.Threading.Thread.CurrentThread;
- end;
- // cannot rename a previously-named thread
- if AThread.Name = nil then begin
- AThread.Name := AName;
- end;
- end;
- {$ELSE}
- procedure SetThreadName(const AName: string; AThreadID: UInt32 = $FFFFFFFF);
- {$IFDEF HAS_NAMED_THREADS}
- {$IFDEF HAS_TThread_NameThreadForDebugging}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ELSE}
- {$IFDEF WINDOWS}
- const
- MS_VC_EXCEPTION = $406D1388;
- type
- TThreadNameInfo = record
- RecType: UInt32; // Must be 0x1000
- Name: PAnsiChar; // Pointer to name (in user address space)
- ThreadID: UInt32; // Thread ID (-1 indicates caller thread)
- Flags: UInt32; // Reserved for future use. Must be zero
- end;
- var
- {$IFDEF STRING_IS_UNICODE}
- LName: AnsiString;
- {$ENDIF}
- LThreadNameInfo: TThreadNameInfo;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF HAS_NAMED_THREADS}
- {$IFDEF HAS_TThread_NameThreadForDebugging}
- TThread.NameThreadForDebugging(
- {$IFDEF HAS_AnsiString}
- AnsiString(AName) // explicit convert to Ansi
- {$ELSE}
- AName
- {$ENDIF},
- AThreadID
- );
- {$ELSE}
- {$IFDEF WINDOWS}
- {$IFDEF STRING_IS_UNICODE}
- LName := AnsiString(AName); // explicit convert to Ansi
- {$ENDIF}
- LThreadNameInfo.RecType := $1000;
- LThreadNameInfo.Name := PAnsiChar({$IFDEF STRING_IS_UNICODE}LName{$ELSE}AName{$ENDIF});
- LThreadNameInfo.ThreadID := AThreadID;
- LThreadNameInfo.Flags := 0;
- try
- // This is a wierdo Windows way to pass the info in
- RaiseException(MS_VC_EXCEPTION, 0, SizeOf(LThreadNameInfo) div SizeOf(UInt32),
- PDWord(@LThreadNameInfo));
- except
- end;
- {$ENDIF}
- {$ENDIF}
- {$ELSE}
- // Do nothing. No support in this compiler for it.
- {$ENDIF}
- end;
- {$ENDIF}
- {$IFDEF DOTNET}
- {$IFNDEF DOTNET_2_OR_ABOVE}
- { TEvent }
- constructor TEvent.Create(EventAttributes: IntPtr; ManualReset, InitialState: Boolean; const Name: string);
- begin
- inherited Create;
- // Name not used
- if ManualReset then begin
- FEvent := ManualResetEvent.Create(InitialState);
- end else begin
- FEvent := AutoResetEvent.Create(InitialState);
- end;
- end;
- constructor TEvent.Create;
- begin
- Create(nil, True, False, ''); {Do not Localize}
- end;
- destructor TEvent.Destroy;
- begin
- if Assigned(FEvent) then begin
- FEvent.Close;
- end;
- FreeAndNil(FEvent);
- inherited Destroy;
- end;
- procedure TEvent.SetEvent;
- begin
- if FEvent is ManualResetEvent then begin
- ManualResetEvent(FEvent).&Set;
- end else begin
- AutoResetEvent(FEvent).&Set;
- end;
- end;
- procedure TEvent.ResetEvent;
- begin
- if FEvent is ManualResetEvent then begin
- ManualResetEvent(FEvent).Reset;
- end else begin
- AutoResetEvent(FEvent).Reset;
- end;
- end;
- function TEvent.WaitFor(Timeout: UInt32): TWaitResult;
- var
- Passed: Boolean;
- begin
- try
- if Timeout = INFINITE then begin
- Passed := FEvent.WaitOne;
- end else begin
- Passed := FEvent.WaitOne(Timeout, True);
- end;
- if Passed then begin
- Result := wrSignaled;
- end else begin
- Result := wrTimeout;
- end;
- except
- Result := wrError;
- end;
- end;
- { TCriticalSection }
- procedure TCriticalSection.Acquire;
- begin
- Enter;
- end;
- procedure TCriticalSection.Release;
- begin
- Leave;
- end;
- function TCriticalSection.TryEnter: Boolean;
- begin
- Result := System.Threading.Monitor.TryEnter(Self);
- end;
- procedure TCriticalSection.Enter;
- begin
- System.Threading.Monitor.Enter(Self);
- end;
- procedure TCriticalSection.Leave;
- begin
- System.Threading.Monitor.Exit(Self);
- end;
- {$ENDIF}
- {$ENDIF}
- { TIdLocalEvent }
- constructor TIdLocalEvent.Create(const AInitialState: Boolean = False; const AManualReset: Boolean = False);
- begin
- inherited Create(nil, AManualReset, AInitialState, ''); {Do not Localize}
- end;
- function TIdLocalEvent.WaitForEver: TWaitResult;
- begin
- Result := WaitFor(Infinite);
- end;
- procedure ToDo(const AMsg: string);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- raise EIdException.Create(AMsg); // TODO: create a new Exception class for this
- end;
- // RLebeau: the following three functions are utility functions
- // that determine the usable amount of data in various buffer types.
- // There are many operations in Indy that allow the user to specify
- // data sizes, or to have Indy calculate it. So these functions
- // help reduce code duplication.
- function IndyLength(const ABuffer: String; const ALength: Integer = -1; const AIndex: Integer = 1): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LAvailable: Integer;
- begin
- Assert(AIndex >= 1);
- LAvailable := IndyMax(Length(ABuffer)-AIndex+1, 0);
- if ALength < 0 then begin
- Result := LAvailable;
- end else begin
- Result := IndyMin(LAvailable, ALength);
- end;
- end;
- function IndyLength(const ABuffer: TIdBytes; const ALength: Integer = -1; const AIndex: Integer = 0): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LAvailable: Integer;
- begin
- Assert(AIndex >= 0);
- LAvailable := IndyMax(Length(ABuffer)-AIndex, 0);
- if ALength < 0 then begin
- Result := LAvailable;
- end else begin
- Result := IndyMin(LAvailable, ALength);
- end;
- end;
- function IndyLength(const ABuffer: TStream; const ALength: TIdStreamSize = -1): TIdStreamSize; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LAvailable: TIdStreamSize;
- begin
- LAvailable := IndyMax(ABuffer.Size - ABuffer.Position, 0);
- if ALength < 0 then begin
- Result := LAvailable;
- end else begin
- Result := IndyMin(LAvailable, ALength);
- end;
- end;
- const
- wdays: array[1..7] of string = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'); {do not localize}
- monthnames: array[1..12] of string = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', {do not localize}
- 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); {do not localize}
- {$IFDEF HAS_TFormatSettings}
- //Delphi5 does not have TFormatSettings
- //this should be changed to a singleton?
- function GetEnglishSetting: TFormatSettings;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result.CurrencyFormat := $00; // 0 = '$1'
- Result.NegCurrFormat := $00; //0 = '($1)'
- Result.CurrencyString := '$'; {do not localize}
- Result.CurrencyDecimals := 2;
- Result.ThousandSeparator := ','; {do not localize}
- Result.DecimalSeparator := '.'; {do not localize}
- Result.DateSeparator := '/'; {do not localize}
- Result.ShortDateFormat := 'M/d/yyyy'; {do not localize}
- Result.LongDateFormat := 'dddd, MMMM dd, yyyy'; {do not localize}
- Result.TimeSeparator := ':'; {do not localize}
- Result.TimeAMString := 'AM'; {do not localize}
- Result.TimePMString := 'PM'; {do not localize}
- Result.LongTimeFormat := 'h:mm:ss AMPM'; {do not localize}
- Result.ShortTimeFormat := 'h:mm AMPM'; {do not localize}
- // TODO: use hard-coded names instead?
- Result.ShortMonthNames[1] := monthnames[1]; //'Jan';
- Result.ShortMonthNames[2] := monthnames[2]; //'Feb';
- Result.ShortMonthNames[3] := monthnames[3]; //'Mar';
- Result.ShortMonthNames[4] := monthnames[4]; //'Apr';
- Result.ShortMonthNames[5] := monthnames[5]; //'May';
- Result.ShortMonthNames[6] := monthnames[6]; //'Jun';
- Result.ShortMonthNames[7] := monthnames[7]; //'Jul';
- Result.ShortMonthNames[8] := monthnames[8]; //'Aug';
- Result.ShortMonthNames[9] := monthnames[9]; //'Sep';
- Result.ShortMonthNames[10] := monthnames[10];// 'Oct';
- Result.ShortMonthNames[11] := monthnames[11]; //'Nov';
- Result.ShortMonthNames[12] := monthnames[12]; //'Dec';
- Result.LongMonthNames[1] := 'January'; {do not localize}
- Result.LongMonthNames[2] := 'February'; {do not localize}
- Result.LongMonthNames[3] := 'March'; {do not localize}
- Result.LongMonthNames[4] := 'April'; {do not localize}
- Result.LongMonthNames[5] := 'May'; {do not localize}
- Result.LongMonthNames[6] := 'June'; {do not localize}
- Result.LongMonthNames[7] := 'July'; {do not localize}
- Result.LongMonthNames[8] := 'August'; {do not localize}
- Result.LongMonthNames[9] := 'September'; {do not localize}
- Result.LongMonthNames[10] := 'October'; {do not localize}
- Result.LongMonthNames[11] := 'November'; {do not localize}
- Result.LongMonthNames[12] := 'December'; {do not localize}
- // TODO: use hard-coded names instead?
- Result.ShortDayNames[1] := wdays[1]; //'Sun';
- Result.ShortDayNames[2] := wdays[2]; //'Mon';
- Result.ShortDayNames[3] := wdays[3]; //'Tue';
- Result.ShortDayNames[4] := wdays[4]; //'Wed';
- Result.ShortDayNames[5] := wdays[5]; //'Thu';
- Result.ShortDayNames[6] := wdays[6]; //'Fri';
- Result.ShortDayNames[7] := wdays[7]; //'Sat';
- Result.LongDayNames[1] := 'Sunday'; {do not localize}
- Result.LongDayNames[2] := 'Monday'; {do not localize}
- Result.LongDayNames[3] := 'Tuesday'; {do not localize}
- Result.LongDayNames[4] := 'Wednesday'; {do not localize}
- Result.LongDayNames[5] := 'Thursday'; {do not localize}
- Result.LongDayNames[6] := 'Friday'; {do not localize}
- Result.LongDayNames[7] := 'Saturday'; {do not localize}
- Result.ListSeparator := ','; {do not localize}
- end;
- {$ENDIF}
- // RLebeau 10/24/2008: In the RTM release of Delphi/C++Builder 2009, the
- // overloaded version of SysUtils.Format() that has a TFormatSettings parameter
- // has an internal bug that causes an EConvertError exception when UnicodeString
- // parameters greater than 4094 characters are passed to it. Refer to QC #67934
- // for details. The bug is fixed in 2009 Update 1. For RTM, call FormatBuf()
- // directly to work around the problem...
- function IndyFormat(const AFormat: string; const Args: array of const): string;
- {$IFNDEF DOTNET}
- {$IFDEF HAS_TFormatSettings}
- var
- EnglishFmt: TFormatSettings;
- {$IFDEF BROKEN_FmtStr}
- Len, BufLen: Integer;
- Buffer: array[0..4095] of Char;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF DOTNET}
- // RLebeau 10/29/09: temporary workaround until we figure out how to use
- // SysUtils.FormatBuf() correctly under .NET in D2009 RTM...
- Result := SysUtils.Format(AFormat, Args);
- {$ELSE}
- {$IFDEF HAS_TFormatSettings}
- EnglishFmt := GetEnglishSetting;
- {$IFDEF BROKEN_FmtStr}
- BufLen := Length(Buffer);
- if Length(AFormat) < (Length(Buffer) - (Length(Buffer) div 4)) then
- begin
- Len := SysUtils.FormatBuf(Buffer, Length(Buffer) - 1, Pointer(AFormat)^,
- Length(AFormat), Args, EnglishFmt);
- end else
- begin
- BufLen := Length(AFormat);
- Len := BufLen;
- end;
- if Len >= BufLen - 1 then
- begin
- while Len >= BufLen - 1 do
- begin
- Inc(BufLen, BufLen);
- Result := ''; // prevent copying of existing data, for speed
- SetLength(Result, BufLen);
- Len := SysUtils.FormatBuf(PChar(Result), BufLen - 1, Pointer(AFormat)^,
- Length(AFormat), Args, EnglishFmt);
- end;
- SetLength(Result, Len);
- end else
- begin
- SetString(Result, Buffer, Len);
- {$IFDEF STRING_IS_ANSI}
- // TODO: do we need to use SetCodePage() here?
- {$ENDIF}
- end;
- {$ELSE}
- Result := SysUtils.Format(AFormat, Args, EnglishFmt);
- {$ENDIF}
- {$ELSE}
- //Is there a way to get delphi5 to use locale in format? something like:
- // SetThreadLocale(TheNewLocaleId);
- // GetFormatSettings;
- // Application.UpdateFormatSettings := False; //needed?
- // format()
- // set locale back to prior
- Result := SysUtils.Format(AFormat, Args);
- {$ENDIF}
- {$ENDIF}
- end;
- function DateTimeGMTToHttpStr(const GMTValue: TDateTime) : String;
- // should adhere to RFC 2616
- var
- wDay, wMonth, wYear: Word;
- begin
- DecodeDate(GMTValue, wYear, wMonth, wDay);
- Result := IndyFormat('%s, %.2d %s %.4d %s %s', {do not localize}
- [wdays[DayOfWeek(GMTValue)], wDay, monthnames[wMonth],
- wYear, FormatDateTime('HH":"nn":"ss',GMTValue), 'GMT']); {do not localize}
- end;
- function DateTimeGMTToCookieStr(const GMTValue: TDateTime; const AUseNetscapeFmt: Boolean = True) : String;
- var
- wDay, wMonth, wYear: Word;
- LDelim: Char;
- begin
- DecodeDate(GMTValue, wYear, wMonth, wDay);
- // RLebeau: cookie draft-23 requires HTTP servers to format an Expires value as follows:
- //
- // Wdy, DD Mon YYYY HH:MM:SS GMT
- //
- // However, Netscape style formatting, which RFCs 2109 and 2965 allow
- // (but draft-23 obsoletes), are more common:
- //
- // Wdy, DD-Mon-YY HH:MM:SS GMT (original)
- // Wdy, DD-Mon-YYYY HH:MM:SS GMT (RFC 1123)
- //
- if AUseNetscapeFmt then begin
- LDelim := '-'; {do not localize}
- end else begin
- LDelim := ' '; {do not localize}
- end;
- Result := IndyFormat('%s, %.2d%s%s%s%.4d %s %s', {do not localize}
- [wdays[DayOfWeek(GMTValue)], wDay, LDelim, monthnames[wMonth], LDelim, wYear,
- FormatDateTime('HH":"nn":"ss',GMTValue), 'GMT']); {do not localize}
- end;
- function DateTimeGMTToImapStr(const GMTValue: TDateTime) : String;
- var
- wDay, wMonth, wYear: Word;
- LDay: String;
- begin
- DecodeDate(GMTValue, wYear, wMonth, wDay);
- LDay := IntToStr(wDay);
- if Length(LDay) < 2 then begin
- LDay := ' ' + LDay; // NOTE: space NOT zero!
- end;
- Result := IndyFormat('%s-%s-%d %s %s', {do not localize}
- [LDay, monthnames[wMonth], wYear, FormatDateTime('HH":"nn":"ss',GMTValue), {do not localize}
- '+0000']); {do not localize}
- end;
- function LocalDateTimeToHttpStr(const Value: TDateTime) : String;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := DateTimeGMTToHttpStr(LocalTimeToUTCTime(Value));
- end;
- function LocalDateTimeToCookieStr(const Value: TDateTime; const AUseNetscapeFmt: Boolean = True) : String;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := DateTimeGMTToCookieStr(LocalTimeToUTCTime(Value), AUseNetscapeFmt);
- end;
- function LocalDateTimeToImapStr(const Value: TDateTime) : String;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := DateTimeGMTToImapStr(LocalTimeToUTCTime(Value));
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function DateTimeToInternetStr(const Value: TDateTime; const AUseGMTStr : Boolean = False) : String;
- {$I IdDeprecatedImplBugOn.inc}
- begin
- Result := LocalDateTimeToGMT(Value, AUseGMTStr);
- end;
- {This should never be localized}
- function LocalDateTimeToGMT(const Value: TDateTime; const AUseGMTStr: Boolean = False) : String;
- var
- wDay, wMonth, wYear: Word;
- begin
- DecodeDate(Value, wYear, wMonth, wDay);
- Result := IndyFormat('%s, %d %s %d %s %s', {do not localize}
- [wdays[DayOfWeek(Value)], wDay, monthnames[wMonth],
- wYear, FormatDateTime('HH":"nn":"ss', Value), {do not localize}
- UTCOffsetToStr(OffsetFromUTC, AUseGMTStr)]);
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function DateTimeToGmtOffSetStr(ADateTime: TDateTime; const AUseGMTStr: Boolean = False): string;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := UTCOffsetToStr(ADateTime, AUseGMTStr);
- end;
- function OffsetFromUTC: TDateTime;
- {$IFDEF DOTNET}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ELSE}
- {$IFNDEF HAS_GetLocalTimeOffset}
- {$IFNDEF HAS_DateUtils_TTimeZone}
- {$IFDEF WINDOWS}
- var
- iBias: Integer;
- tmez: TTimeZoneInformation;
- {$ELSE}
- {$IFDEF UNIX}
- {$IFDEF USE_VCL_POSIX}
- var
- T : Time_t;
- TV : TimeVal;
- UT : tm;
- {$ELSE}
- {$IFDEF KYLIXCOMPAT}
- var
- T : Time_T;
- TV : TTimeVal;
- UT : TUnixTime;
- {$ELSE}
- {$IFDEF USE_BASEUNIX}
- var
- timeval: TTimeVal;
- timezone: TTimeZone;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := System.Timezone.CurrentTimezone.GetUTCOffset(DateTime.FromOADate(Now)).TotalDays;
- {$ELSE}
- {$IFDEF HAS_GetLocalTimeOffset}
- // RLebeau: Note that on Linux/Unix, this information may be inaccurate around
- // the DST time changes (for optimization). In that case, the unix.ReReadLocalTime()
- // function must be used to re-initialize the timezone information...
- // RLebeau 1/15/2022: the value returned by OffsetFromUTC() is meant to be *subtracted*
- // from a local time, and *added* to a UTC time. However, the value returned by
- // FPC's GetLocalTimeOffset() is the opposite - it is meant to be *added* to local time,
- // and *subtracted* from UTC time. So, we need to flip its sign here...
- Result := -1 * (GetLocalTimeOffset() / 60 / 24);
- {$ELSE}
- {$IFDEF HAS_DateUtils_TTimeZone}
- Result := TTimeZone.Local.UtcOffset.TotalMinutes / 60 / 24;
- {$ELSE}
- {$IFDEF WINDOWS}
- case GetTimeZoneInformation({$IFDEF WINCE}@{$ENDIF}tmez) of
- TIME_ZONE_ID_INVALID :
- raise EIdFailedToRetreiveTimeZoneInfo.Create(RSFailedTimeZoneInfo);
- TIME_ZONE_ID_UNKNOWN :
- iBias := tmez.Bias;
- TIME_ZONE_ID_DAYLIGHT : begin
- iBias := tmez.Bias;
- if tmez.DaylightDate.wMonth <> 0 then begin
- iBias := iBias + tmez.DaylightBias;
- end;
- end;
- TIME_ZONE_ID_STANDARD : begin
- iBias := tmez.Bias;
- if tmez.StandardDate.wMonth <> 0 then begin
- iBias := iBias + tmez.StandardBias;
- end;
- end
- else
- begin
- raise EIdFailedToRetreiveTimeZoneInfo.Create(RSFailedTimeZoneInfo);
- end;
- end;
- {We use ABS because EncodeTime will only accept positive values}
- Result := EncodeTime(Abs(iBias) div 60, Abs(iBias) mod 60, 0, 0);
- {The GetTimeZone function returns values oriented towards converting
- a GMT time into a local time. We wish to do the opposite by returning
- the difference between the local time and GMT. So I just make a positive
- value negative and leave a negative value as positive}
- if iBias > 0 then begin
- Result := 0.0 - Result;
- end;
- {$ELSE}
- {$IFDEF UNIX}
- // TODO: raise EIdFailedToRetreiveTimeZoneInfo if gettimeofday() fails...
- {$IFDEF KYLIXCOMPAT_OR_VCL_POSIX}
- {from http://edn.embarcadero.com/article/27890 but without multiplying the Result by -1}
- gettimeofday(TV, nil);
- T := TV.tv_sec;
- localtime_r({$IFDEF KYLIXCOMPAT}@{$ENDIF}T, UT);
- Result := UT.{$IFDEF KYLIXCOMPAT}__tm_gmtoff{$ELSE}tm_gmtoff{$ENDIF} / 60 / 60 / 24;
- {$ELSE}
- {$IFDEF USE_BASEUNIX}
- fpGetTimeOfDay (@TimeVal, @TimeZone);
- Result := -1 * (timezone.tz_minuteswest / 60 / 24);
- {$ELSE}
- {$message error gettimeofday is not called on this platform!}
- Result := GOffsetFromUTC;
- {$ENDIF}
- {$ENDIF}
- {$ELSE}
- {$message error no platform API called to get UTC offset!}
- Result := GOffsetFromUTC;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- end;
- function UTCOffsetToStr(const AOffset: TDateTime; const AUseGMTStr: Boolean = False): string;
- var
- AHour, AMin, ASec, AMSec: Word;
- s: string;
- {$IFDEF STRING_IS_IMMUTABLE}
- LSB: TIdStringBuilder;
- {$ENDIF}
- begin
- if (AOffset = 0.0) and AUseGMTStr then
- begin
- Result := 'GMT'; {do not localize}
- end else
- begin
- DecodeTime(AOffset, AHour, AMin, ASec, AMSec);
- s := IndyFormat(' %0.2d%0.2d', [AHour, AMin]); {do not localize}
- {$IFDEF STRING_IS_IMMUTABLE}
- LSB := TIdStringBuilder.Create(5);
- LSB.Append(s);
- if AOffset < 0.0 then begin
- LSB[0] := '-'; {do not localize}
- end else begin
- LSB[0] := '+'; {do not localize}
- end;
- Result := LSB.ToString;
- {$ELSE}
- Result := s;
- if AOffset < 0.0 then begin
- Result[1] := '-'; {do not localize}
- end else begin
- Result[1] := '+'; {do not localize}
- end;
- {$ENDIF}
- end;
- end;
- function LocalTimeToUTCTime(const Value: TDateTime): TDateTime;
- begin
- {$IFDEF HAS_LocalTimeToUniversal}
- Result := LocalTimeToUniversal(Value);
- {$ELSE}
- {$IFDEF HAS_DateUtils_TTimeZone}
- Result := TTimeZone.Local.ToUniversalTime(Value);
- {$ELSE}
- Result := Value - OffsetFromUTC;
- {$ENDIF}
- {$ENDIF}
- end;
- function UTCTimeToLocalTime(const Value: TDateTime): TDateTime;
- begin
- {$IFDEF HAS_UniversalTimeToLocal}
- Result := UniversalTimeToLocal(Value);
- {$ELSE}
- {$IFDEF HAS_DateUtils_TTimeZone}
- Result := TTimeZone.Local.ToLocalTime(Value);
- {$ELSE}
- Result := Value + OffsetFromUTC;
- {$ENDIF}
- {$ENDIF}
- end;
- function IndyIncludeTrailingPathDelimiter(const S: string): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF HAS_SysUtils_IncludeExcludeTrailingPathDelimiter}
- Result := SysUtils.IncludeTrailingPathDelimiter(S);
- {$ELSE}
- Result := SysUtils.IncludeTrailingBackslash(S);
- {$ENDIF}
- end;
- function IndyExcludeTrailingPathDelimiter(const S: string): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF HAS_SysUtils_IncludeExcludeTrailingPathDelimiter}
- Result := SysUtils.ExcludeTrailingPathDelimiter(S);
- {$ELSE}
- Result := SysUtils.ExcludeTrailingBackslash(S);
- {$ENDIF}
- end;
- function StringsReplace(const S: String; const OldPattern, NewPattern: array of string): string;
- var
- i : Integer;
- begin
- // TODO: re-write this to not use ReplaceAll() in a loop anymore. If
- // OldPattern contains multiple strings, a string appearing later in the
- // list may be replaced multiple times by accident if it appears in the
- // Result of an earlier string replacement.
- Result := s;
- for i := Low(OldPattern) to High(OldPattern) do begin
- Result := ReplaceAll(Result, OldPattern[i], NewPattern[i]);
- end;
- end;
- {$IFNDEF DOTNET}
- {$IFNDEF HAS_PosEx}
- function PosEx(const SubStr, S: string; Offset: Integer): Integer;
- var
- I, LIterCnt, L, J: Integer;
- PSubStr, PS: PChar;
- begin
- Result := 0;
- if SubStr = '' then begin
- Exit;
- end;
- { Calculate the number of possible iterations. Not valid if Offset < 1. }
- LIterCnt := Length(S) - Offset - Length(SubStr) + 1;
- { Only continue if the number of iterations is positive or zero (there is space to check) }
- if (Offset > 0) and (LIterCnt >= 0) then
- begin
- L := Length(SubStr);
- PSubStr := PChar(SubStr);
- PS := PChar(S);
- Inc(PS, Offset - 1);
- for I := 0 to LIterCnt do
- begin
- J := 0;
- while (J >= 0) and (J < L) do
- begin
- if PS[I + J] = PSubStr[J] then begin
- Inc(J);
- end else begin
- J := -1;
- end;
- end;
- if J >= L then begin
- Result := I + Offset;
- Exit;
- end;
- end;
- end;
- end;
- {$ENDIF}
- {$ENDIF}
- function ReplaceAll(const S: String; const OldPattern, NewPattern: String): String;
- var
- I, PatLen: Integer;
- {$IFDEF DOTNET}
- J: Integer;
- {$ELSE}
- NumBytes: Integer;
- {$ENDIF}
- begin
- PatLen := Length(OldPattern);
- if Length(NewPattern) = PatLen then begin
- Result := S;
- I := Pos(OldPattern, Result);
- if I > 0 then begin
- UniqueString(Result);
- {$IFNDEF DOTNET}
- NumBytes := PatLen * SizeOf(Char);
- {$ENDIF}
- repeat
- {$IFDEF DOTNET}
- for J := 1 to PatLen do begin
- Result[I+J-1] := NewPattern[J];
- end;
- {$ELSE}
- Move(PChar(NewPattern)^, Result[I], NumBytes);
- {$ENDIF}
- I := PosEx(OldPattern, Result, I + PatLen);
- until I = 0;
- end;
- end else begin
- Result := SysUtils.StringReplace(S, OldPattern, NewPattern, [rfReplaceAll]);
- end;
- end;
- function ReplaceOnlyFirst(const S, OldPattern, NewPattern: string): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := SysUtils.StringReplace(s, OldPattern, NewPattern, []);
- end;
- function IndyStrToInt(const S: string): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := StrToInt(Trim(S));
- end;
- function IndyStrToInt(const S: string; ADefault: Integer): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := StrToIntDef(Trim(S), ADefault);
- end;
- function CompareDate(const D1, D2: TDateTime): Integer;
- var
- LTM1, LTM2 : TTimeStamp;
- begin
- // TODO: use DateUtils.CompareDateTime() instead...
- LTM1 := DateTimeToTimeStamp(D1);
- LTM2 := DateTimeToTimeStamp(D2);
- if LTM1.Date = LTM2.Date then begin
- if LTM1.Time < LTM2.Time then begin
- Result := -1;
- end
- else if LTM1.Time > LTM2.Time then begin
- Result := 1;
- end
- else begin
- Result := 0;
- end;
- end
- else if LTM1.Date > LTM2.Date then begin
- Result := 1;
- end
- else begin
- Result := -1;
- end;
- end;
- function AddMSecToTime(const ADateTime: TDateTime; const AMSec: Integer): TDateTime;
- {$IFDEF HAS_UNIT_DateUtils}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ELSE}
- var
- LTM : TTimeStamp;
- {$ENDIF}
- begin
- {$IFDEF HAS_UNIT_DateUtils}
- Result := DateUtils.IncMilliSecond(ADateTime, AMSec);
- {$ELSE}
- LTM := DateTimeToTimeStamp(ADateTime);
- LTM.Time := LTM.Time + AMSec;
- Result := TimeStampToDateTime(LTM);
- {$ENDIF}
- end;
- function IndyFileAge(const AFileName: string): TDateTime;
- {$IFDEF HAS_2PARAM_FileAge}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ELSE}
- var
- LAge: Integer;
- {$ENDIF}
- begin
- {$IFDEF HAS_2PARAM_FileAge}
- //single-parameter fileage is deprecated in d2006 and above
- if not FileAge(AFileName, Result) then begin
- Result := 0;
- end;
- {$ELSE}
- LAge := SysUtils.FileAge(AFileName);
- if LAge <> -1 then begin
- Result := FileDateToDateTime(LAge);
- end else begin
- Result := 0.0;
- end;
- {$ENDIF}
- end;
- function IndyDirectoryExists(const ADirectory: string): Boolean;
- {$IFDEF HAS_SysUtils_DirectoryExists}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ELSE}
- var
- Code: Integer;
- {$IFDEF STRING_UNICODE_MISMATCH}
- LStr: TIdPlatformString;
- {$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF HAS_SysUtils_DirectoryExists}
- Result := SysUtils.DirectoryExists(ADirectory);
- {$ELSE}
- // RLebeau 2/16/2006: Removed dependency on the FileCtrl unit
- {$IFDEF STRING_UNICODE_MISMATCH}
- LStr := TIdPlatformString(ADirectory); // explicit convert to Ansi/Unicode
- Code := GetFileAttributes(PIdPlatformChar(LStr));
- {$ELSE}
- Code := GetFileAttributes(PChar(ADirectory));
- {$ENDIF}
- Result := (Code <> -1) and ((Code and FILE_ATTRIBUTE_DIRECTORY) <> 0);
- {$ENDIF}
- end;
- function IndyStrToInt64(const S: string; const ADefault: Int64): Int64;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := SysUtils.StrToInt64Def(Trim(S), ADefault);
- end;
- function IndyStrToInt64(const S: string): Int64;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := SysUtils.StrToInt64(Trim(S));
- end;
- function IndyStrToStreamSize(const S: string; const ADefault: TIdStreamSize): TIdStreamSize;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF STREAM_SIZE_64}
- Result := IndyStrToInt64(S, ADefault);
- {$ELSE}
- Result := IndyStrToInt(S, ADefault);
- {$ENDIF}
- end;
- function IndyStrToStreamSize(const S: string): TIdStreamSize;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF STREAM_SIZE_64}
- Result := IndyStrToInt64(S);
- {$ELSE}
- Result := IndyStrToInt(S);
- {$ENDIF}
- end;
- function ToBytes(const AValue: string; ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ): TIdBytes; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := ToBytes(AValue, -1, 1, ADestEncoding
- {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
- );
- end;
- function ToBytes(const AValue: string; const ALength: Integer; const AIndex: Integer = 1;
- ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ): TIdBytes; overload;
- var
- LLength: Integer;
- {$IFDEF STRING_IS_ANSI}
- LBytes: TIdBytes;
- {$ENDIF}
- begin
- {$IFDEF STRING_IS_ANSI}
- LBytes := nil; // keep the compiler happy
- {$ENDIF}
- LLength := IndyLength(AValue, ALength, AIndex);
- if LLength > 0 then
- begin
- EnsureEncoding(ADestEncoding);
- {$IFDEF STRING_IS_UNICODE}
- SetLength(Result, ADestEncoding.GetByteCount(AValue, AIndex, LLength));
- if Length(Result) > 0 then begin
- ADestEncoding.GetBytes(AValue, AIndex, LLength, Result, 0);
- end;
- {$ELSE}
- EnsureEncoding(ASrcEncoding, encOSDefault);
- LBytes := RawToBytes(AValue[AIndex], LLength);
- CheckByteEncoding(LBytes, ASrcEncoding, ADestEncoding);
- Result := LBytes;
- {$ENDIF}
- end else begin
- SetLength(Result, 0);
- end;
- end;
- function ToBytes(const AValue: Char; ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ): TIdBytes; overload;
- var
- {$IFDEF STRING_IS_UNICODE}
- LChars: {$IFDEF DOTNET}array[0..0] of Char{$ELSE}TIdWideChars{$ENDIF};
- {$ELSE}
- LBytes: TIdBytes;
- {$ENDIF}
- begin
- EnsureEncoding(ADestEncoding);
- {$IFDEF STRING_IS_UNICODE}
- {$IFNDEF DOTNET}
- SetLength(LChars, 1);
- {$ENDIF}
- LChars[0] := AValue;
- Result := ADestEncoding.GetBytes(LChars);
- {$ELSE}
- EnsureEncoding(ASrcEncoding, encOSDefault);
- LBytes := RawToBytes(AValue, 1);
- CheckByteEncoding(LBytes, ASrcEncoding, ADestEncoding);
- Result := LBytes;
- {$ENDIF}
- end;
- function ToBytes(const AValue: Int64): TIdBytes; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := System.BitConverter.GetBytes(AValue);
- {$ELSE}
- SetLength(Result, SizeOf(Int64));
- PInt64(@Result[0])^ := AValue;
- {$ENDIF}
- end;
- function ToBytes(const AValue: TIdUInt64): TIdBytes; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := System.BitConverter.GetBytes(AValue);
- {$ELSE}
- SetLength(Result, SizeOf(UInt64));
- PUInt64(@Result[0])^ := AValue{$IFDEF TIdUInt64_HAS_QuadPart}.QuadPart{$ENDIF};
- {$ENDIF}
- end;
- function ToBytes(const AValue: Int32): TIdBytes; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := System.BitConverter.GetBytes(AValue);
- {$ELSE}
- SetLength(Result, SizeOf(Int32));
- PInt32(@Result[0])^ := AValue;
- {$ENDIF}
- end;
- function ToBytes(const AValue: UInt32): TIdBytes; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := System.BitConverter.GetBytes(AValue);
- {$ELSE}
- SetLength(Result, SizeOf(UInt32));
- PUInt32(@Result[0])^ := AValue;
- {$ENDIF}
- end;
- function ToBytes(const AValue: Int16): TIdBytes; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := System.BitConverter.GetBytes(AValue);
- {$ELSE}
- SetLength(Result, SizeOf(Int16));
- PInt16(@Result[0])^ := AValue;
- {$ENDIF}
- end;
- function ToBytes(const AValue: UInt16): TIdBytes; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := System.BitConverter.GetBytes(AValue);
- {$ELSE}
- SetLength(Result, SizeOf(UInt16));
- PUInt16(@Result[0])^ := AValue;
- {$ENDIF}
- end;
- function ToBytes(const AValue: Int8): TIdBytes; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- SetLength(Result, SizeOf(Int8));
- Result[0] := Byte(AValue);
- end;
- function ToBytes(const AValue: UInt8): TIdBytes; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- SetLength(Result, SizeOf(UInt8));
- Result[0] := AValue;
- end;
- function ToBytes(const AValue: TIdBytes; const ASize: Integer; const AIndex: Integer = 0): TIdBytes; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LSize: Integer;
- begin
- LSize := IndyLength(AValue, ASize, AIndex);
- SetLength(Result, LSize);
- if LSize > 0 then begin
- CopyTIdBytes(AValue, AIndex, Result, 0, LSize);
- end;
- end;
- {$IFNDEF DOTNET}
- function RawToBytes(const AValue; const ASize: Integer): TIdBytes;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- SetLength(Result, ASize);
- if ASize > 0 then begin
- Move(AValue, Result[0], ASize);
- end;
- end;
- {$ENDIF}
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: Char; ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- );
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LChars: {$IFDEF DOTNET}array[0..0] of Char{$ELSE}TIdWideChars{$ENDIF};
- begin
- EnsureEncoding(ADestEncoding);
- {$IFDEF STRING_IS_UNICODE}
- {$IFNDEF DOTNET}
- SetLength(LChars, 1);
- {$ENDIF}
- LChars[0] := AValue;
- {$ELSE}
- EnsureEncoding(ASrcEncoding, encOSDefault);
- LChars := ASrcEncoding.GetChars(RawToBytes(AValue, 1)); // convert to Unicode
- {$ENDIF}
- Assert(Length(Bytes) >= ADestEncoding.GetByteCount(LChars));
- ADestEncoding.GetBytes(LChars, 0, Length(LChars), Bytes, 0);
- end;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int32);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(Bytes) >= SizeOf(AValue));
- CopyTIdInt32(AValue, Bytes, 0);
- end;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int16);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(Bytes) >= SizeOf(AValue));
- CopyTIdInt16(AValue, Bytes, 0);
- end;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: UInt16);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(Bytes) >= SizeOf(AValue));
- CopyTIdUInt16(AValue, Bytes, 0);
- end;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int8);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(Bytes) >= SizeOf(AValue));
- Bytes[0] := Byte(AValue);
- end;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: UInt8);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(Bytes) >= SizeOf(AValue));
- Bytes[0] := AValue;
- end;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: UInt32);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(Bytes) >= SizeOf(AValue));
- CopyTIdUInt32(AValue, Bytes, 0);
- end;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: Int64);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(Bytes) >= SizeOf(AValue));
- CopyTIdInt64(AValue, Bytes, 0);
- end;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: TIdUInt64);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(Bytes) >= SizeOf(AValue));
- CopyTIdUInt64(AValue, Bytes, 0);
- end;
- procedure ToBytesF(var Bytes: TIdBytes; const AValue: TIdBytes; const ASize: Integer; const AIndex: Integer = 0);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(Bytes) >= ASize);
- CopyTIdBytes(AValue, AIndex, Bytes, 0, ASize);
- end;
- {$IFNDEF DOTNET}
- procedure RawToBytesF(var Bytes: TIdBytes; const AValue; const ASize: Integer);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(Bytes) >= ASize);
- if ASize > 0 then begin
- Move(AValue, Bytes[0], ASize);
- end;
- end;
- {$ENDIF}
- function BytesToChar(const AValue: TIdBytes; const AIndex: Integer = 0;
- AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): Char; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- BytesToChar(AValue, Result, AIndex, AByteEncoding{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
- end;
- function BytesToChar(const AValue: TIdBytes; var VChar: Char; const AIndex: Integer = 0;
- AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): Integer; overload;
- var
- I, J, NumChars, NumBytes: Integer;
- {$IFDEF DOTNET}
- LChars: array[0..1] of Char;
- {$ELSE}
- LChars: TIdWideChars;
- {$IFDEF STRING_IS_ANSI}
- LWTmp: WideString;
- LATmp: TIdBytes;
- {$ENDIF}
- {$ENDIF}
- begin
- Result := 0;
- EnsureEncoding(AByteEncoding);
- // 2 Chars to handle UTF-16 surrogates
- NumBytes := IndyMin(IndyLength(AValue, -1, AIndex), AByteEncoding.GetMaxByteCount(2));
- {$IFNDEF DOTNET}
- SetLength(LChars, 2);
- {$ENDIF}
- NumChars := 0;
- if NumBytes > 0 then
- begin
- for I := 1 to NumBytes do
- begin
- NumChars := AByteEncoding.GetChars(AValue, AIndex, I, LChars, 0);
- Inc(Result);
- if NumChars > 0 then begin
- // RLebeau 10/19/2012: when Indy switched to its own UTF-8 implementation
- // to avoid the MB_ERR_INVALID_CHARS flag on Windows, it accidentally broke
- // this loop! Since this is not commonly used, this was not noticed until
- // now. On Windows at least, GetChars() now returns >0 for an invalid
- // sequence, so we have to check if any of the returned characters are the
- // Unicode U+FFFD character, indicating bad data...
- for J := 0 to NumChars-1 do begin
- if LChars[J] = TIdWideChar($FFFD) then begin
- // keep reading...
- NumChars := 0;
- Break;
- end;
- end;
- if NumChars > 0 then begin
- Break;
- end;
- end;
- end;
- end;
- {$IFDEF STRING_IS_UNICODE}
- // RLebeau: if the bytes were decoded into surrogates, the second
- // surrogate is lost here, as it can't be returned unless we cache
- // it somewhere for the the next BytesToChar() call to retreive. Just
- // raise an error for now. Users will have to update their code to
- // read surrogates differently...
- Assert(NumChars = 1);
- VChar := LChars[0];
- {$ELSE}
- // RLebeau: since we can only return an AnsiChar here, let's convert
- // the decoded characters, surrogates and all, into their Ansi
- // representation. This will have the same problem as above if the
- // conversion results in a multibyte character sequence...
- EnsureEncoding(ADestEncoding, encOSDefault);
- SetString(LWTmp, PWideChar(LChars), NumChars);
- LATmp := ADestEncoding.GetBytes(LWTmp); // convert to Ansi
- Assert(Length(LATmp) = 1);
- VChar := Char(LATmp[0]);
- {$ENDIF}
- end;
- function BytesToInt32(const AValue: TIdBytes; const AIndex: Integer = 0): Int32;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(AValue) >= (AIndex+SizeOf(Int32)));
- {$IFDEF DOTNET}
- Result := System.BitConverter.ToInt32(AValue, AIndex);
- {$ELSE}
- Result := PInt32(@AValue[AIndex])^;
- {$ENDIF}
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function BytesToLongInt(const AValue: TIdBytes; const AIndex: Integer = 0): Integer;
- {$I IdDeprecatedImplBugOff.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := BytesToInt32(AValue, AIndex);
- end;
- function BytesToInt64(const AValue: TIdBytes; const AIndex: Integer = 0): Int64;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(AValue) >= (AIndex+SizeOf(Int64)));
- {$IFDEF DOTNET}
- Result := System.BitConverter.ToInt64(AValue, AIndex);
- {$ELSE}
- Result := PInt64(@AValue[AIndex])^;
- {$ENDIF}
- end;
- function BytesToUInt64(const AValue: TIdBytes; const AIndex: Integer = 0): TIdUInt64;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(AValue) >= (AIndex+SizeOf(TIdUInt64)));
- {$IFDEF DOTNET}
- Result := System.BitConverter.ToUInt64(AValue, AIndex);
- {$ELSE}
- Result{$IFDEF TIdUInt64_HAS_QuadPart}.QuadPart{$ENDIF} := PUInt64(@AValue[AIndex])^;
- {$ENDIF}
- end;
- function BytesToTicks(const AValue: TIdBytes; const AIndex: Integer = 0): TIdTicks;
- {$IFDEF USE_TIdTicks_TIdUInt64_CONVERSION}
- var
- LValue: TIdUInt64;
- {$ELSE}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF USE_TIdTicks_TIdUInt64_CONVERSION}
- // In C++Builder 2006/2007, TIdUInt64 is a packed record, but TIdTicks is
- // an alias for a native UInt64 , so need a conversion here to get around
- // a compiler error: "E2010 Incompatible types: 'UInt64' and 'TIdUInt64'"...
- LValue := BytesToUInt64(AValue, AIndex);
- Result := LValue.QuadPart;
- {$ELSE}
- {$IFDEF UInt64_IS_NATIVE}
- Result := BytesToUInt64(AValue, AIndex);
- {$ELSE}
- Result := BytesToInt64(AValue, AIndex);
- {$ENDIF}
- {$ENDIF}
- end;
- function BytesToUInt16(const AValue: TIdBytes; const AIndex: Integer = 0): UInt16;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(AValue) >= (AIndex+SizeOf(UInt16)));
- {$IFDEF DOTNET}
- Result := System.BitConverter.ToUInt16(AValue, AIndex);
- {$ELSE}
- Result := PUInt16(@AValue[AIndex])^;
- {$ENDIF}
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function BytesToWord(const AValue: TIdBytes; const AIndex: Integer = 0): UInt16;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := BytesToUInt16(AValue, AIndex);
- end;
- function BytesToInt16(const AValue: TIdBytes; const AIndex: Integer = 0): Int16;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(AValue) >= (AIndex+SizeOf(Int16)));
- {$IFDEF DOTNET}
- Result := System.BitConverter.ToInt16(AValue, AIndex);
- {$ELSE}
- Result := PInt16(@AValue[AIndex])^;
- {$ENDIF}
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function BytesToShort(const AValue: TIdBytes; const AIndex: Integer = 0): Int16;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := BytesToInt16(AValue, AIndex);
- end;
- function BytesToIPv4Str(const AValue: TIdBytes; const AIndex: Integer = 0): String;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(AValue) >= (AIndex+4));
- Result := IntToStr(Ord(AValue[AIndex])) + '.' +
- IntToStr(Ord(AValue[AIndex+1])) + '.' +
- IntToStr(Ord(AValue[AIndex+2])) + '.' +
- IntToStr(Ord(AValue[AIndex+3]));
- end;
- procedure BytesToIPv6(const AValue: TIdBytes; var VAddress: TIdIPv6Address; const AIndex: Integer = 0);
- {$IFDEF DOTNET}
- var
- I: Integer;
- {$ELSE}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$ENDIF}
- begin
- Assert(Length(AValue) >= (AIndex+16));
- {$IFDEF DOTNET}
- for i := 0 to 7 do begin
- VAddress[i] := TwoByteToUInt16(AValue[(i*2)+AIndex], AValue[(i*2)+1+AIndex]);
- end;
- {$ELSE}
- Move(AValue[AIndex], VAddress[0], 16);
- {$ENDIF}
- end;
- function BytesToUInt32(const AValue: TIdBytes; const AIndex: Integer = 0): UInt32;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(AValue) >= (AIndex+SizeOf(UInt32)));
- {$IFDEF DOTNET}
- Result := System.BitConverter.ToUInt32(AValue, AIndex);
- {$ELSE}
- Result := PUInt32(@AValue[AIndex])^;
- {$ENDIF}
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function BytesToLongWord(const AValue: TIdBytes; const AIndex: Integer = 0): UInt32;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := BytesToUInt32(AValue, AIndex);
- end;
- function BytesToString(const AValue: TIdBytes; AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): string; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := BytesToString(AValue, 0, -1, AByteEncoding
- {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
- );
- end;
- function BytesToString(const AValue: TIdBytes; const AStartIndex: Integer;
- const ALength: Integer = -1; AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): string; overload;
- var
- LLength: Integer;
- {$IFDEF STRING_IS_ANSI}
- LBytes: TIdBytes;
- {$ENDIF}
- begin
- {$IFDEF STRING_IS_ANSI}
- LBytes := nil; // keep the compiler happy
- {$ENDIF}
- LLength := IndyLength(AValue, ALength, AStartIndex);
- if LLength > 0 then begin
- EnsureEncoding(AByteEncoding);
- {$IFDEF STRING_IS_UNICODE}
- Result := AByteEncoding.GetString(AValue, AStartIndex, LLength);
- {$ELSE}
- EnsureEncoding(ADestEncoding);
- if (AStartIndex = 0) and (LLength = Length(AValue)) then begin
- LBytes := AValue;
- end else begin
- LBytes := Copy(AValue, AStartIndex, LLength);
- end;
- CheckByteEncoding(LBytes, AByteEncoding, ADestEncoding);
- SetString(Result, PAnsiChar(LBytes), Length(LBytes));
- {$IFDEF HAS_SetCodePage}
- // on compilers that support AnsiString codepages,
- // set the string's codepage to match ADestEncoding...
- SetCodePage(PRawByteString(@Result)^, GetEncodingCodePage(ADestEncoding), False);
- {$ENDIF}
- {$ENDIF}
- end else begin
- Result := '';
- end;
- end;
- function BytesToStringRaw(const AValue: TIdBytes): string; overload;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := BytesToStringRaw(AValue, 0, -1);
- end;
- function BytesToStringRaw(const AValue: TIdBytes; const AStartIndex: Integer;
- const ALength: Integer = -1): string;
- var
- LLength: Integer;
- begin
- LLength := IndyLength(AValue, ALength, AStartIndex);
- if LLength > 0 then begin
- {$IFDEF STRING_IS_UNICODE}
- Result := IndyTextEncoding_8Bit.GetString(AValue, AStartIndex, LLength);
- {$ELSE}
- SetString(Result, PAnsiChar(@AValue[AStartIndex]), LLength);
- {$IFDEF HAS_SetCodePage}
- // on compilers that support AnsiString codepages,
- // set the string's codepage to something like ISO-8859-1...
- SetCodePage(PRawByteString(@Result)^, 28591, False);
- {$ENDIF}
- {$ENDIF}
- end else begin
- Result := '';
- end;
- end;
- {$IFNDEF DOTNET}
- procedure BytesToRaw(const AValue: TIdBytes; var VBuffer; const ASize: Integer);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Assert(Length(AValue) >= ASize);
- Move(AValue[0], VBuffer, ASize);
- end;
- {$ENDIF}
- function TwoByteToUInt16(AByte1, AByte2: Byte): UInt16;
- //Since Replys are returned as Strings, we need a routine to convert two
- // characters which are a 2 byte U Int into a two byte unsigned Integer
- var
- LWord: TIdBytes;
- begin
- SetLength(LWord, SizeOf(UInt16));
- LWord[0] := AByte1;
- LWord[1] := AByte2;
- Result := BytesToUInt16(LWord);
- // Result := UInt16((AByte1 shl 8) and $FF00) or UInt16(AByte2 and $00FF);
- end;
- {$I IdDeprecatedImplBugOff.inc}
- function TwoByteToWord(AByte1, AByte2: Byte): UInt16;
- {$I IdDeprecatedImplBugOn.inc}
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := TwoByteToUInt16(AByte1, AByte2);
- end;
- function ReadStringFromStream(AStream: TStream; ASize: Integer = -1;
- AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): string;
- var
- LBytes: TIdBytes;
- begin
- ASize := TIdStreamHelper.ReadBytes(AStream, LBytes, ASize);
- Result := BytesToString(LBytes, 0, ASize, AByteEncoding
- {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
- );
- end;
- function ReadTIdBytesFromStream(const AStream: TStream; var ABytes: TIdBytes;
- const Count: TIdStreamSize; const AIndex: Integer = 0): TIdStreamSize;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := TIdStreamHelper.ReadBytes(AStream, ABytes, Count, AIndex);
- end;
- function ReadCharFromStream(AStream: TStream; var VChar: Char;
- AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): Integer;
- var
- StartPos: TIdStreamSize;
- Lb: Byte;
- I, NumChars, NumBytes: Integer;
- LBytes: TIdBytes;
- {$IFDEF DOTNET}
- LChars: array[0..1] of Char;
- {$ELSE}
- LChars: TIdWideChars;
- {$IFDEF STRING_IS_ANSI}
- LWTmp: WideString;
- LATmp: TIdBytes;
- {$ENDIF}
- {$ENDIF}
- function ReadByte: Byte;
- begin
- if AStream.Read(Result{$IFNDEF DOTNET}, 1{$ENDIF}) <> 1 then begin
- raise EIdException.Create('Unable to read byte'); {do not localize} // TODO: add a resource string, and create a new Exception class for this
- end;
- end;
- begin
- Result := 0;
- {$IFDEF STRING_IS_ANSI}
- LATmp := nil; // keep the compiler happy
- {$ENDIF}
- EnsureEncoding(AByteEncoding);
- StartPos := AStream.Position;
- // don't raise an exception here, backwards compatibility for now
- if AStream.Read(Lb{$IFNDEF DOTNET}, 1{$ENDIF}) <> 1 then begin
- Exit;
- end;
- Result := 1;
- // 2 Chars to handle UTF-16 surrogates
- NumBytes := AByteEncoding.GetMaxByteCount(2);
- SetLength(LBytes, NumBytes);
- {$IFNDEF DOTNET}
- SetLength(LChars, 2);
- {$ENDIF}
- try
- repeat
- LBytes[Result-1] := Lb;
- NumChars := AByteEncoding.GetChars(LBytes, 0, Result, LChars, 0);
- if NumChars > 0 then begin
- // RLebeau 10/19/2012: when Indy switched to its own UTF-8 implementation
- // to avoid the MB_ERR_INVALID_CHARS flag on Windows, it accidentally broke
- // this loop! Since this is not commonly used, this was not noticed until
- // now. On Windows at least, GetChars() now returns >0 for an invalid
- // sequence, so we have to check if any of the returned characters are the
- // Unicode U+FFFD character, indicating bad data...
- for I := 0 to NumChars-1 do begin
- if LChars[I] = TIdWideChar($FFFD) then begin
- // keep reading...
- NumChars := 0;
- Break;
- end;
- end;
- if NumChars > 0 then begin
- Break;
- end;
- end;
- if Result = NumBytes then begin
- Break;
- end;
- Lb := ReadByte;
- Inc(Result);
- until False;
- except
- AStream.Position := StartPos;
- raise;
- end;
- {$IFDEF STRING_IS_UNICODE}
- // RLebeau: if the bytes were decoded into surrogates, the second
- // surrogate is lost here, as it can't be returned unless we cache
- // it somewhere for the the next ReadTIdBytesFromStream() call to
- // retreive. Just raise an error for now. Users will have to
- // update their code to read surrogates differently...
- Assert(NumChars = 1);
- VChar := LChars[0];
- {$ELSE}
- // RLebeau: since we can only return an AnsiChar here, let's convert
- // the decoded characters, surrogates and all, into their Ansi
- // representation. This will have the same problem as above if the
- // conversion results in a multibyte character sequence...
- EnsureEncoding(ADestEncoding, encOSDefault);
- SetString(LWTmp, PWideChar(LChars), NumChars);
- LATmp := ADestEncoding.GetBytes(LWTmp); // convert to Ansi
- Assert(Length(LATmp) = 1);
- VChar := Char(LATmp[0]);
- {$ENDIF}
- end;
- procedure WriteTIdBytesToStream(const AStream: TStream; const ABytes: TIdBytes;
- const ASize: Integer = -1; const AIndex: Integer = 0);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- TIdStreamHelper.Write(AStream, ABytes, ASize, AIndex);
- end;
- procedure WriteStringToStream(AStream: TStream; const AStr: string;
- ADestEncoding: IIdTextEncoding
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- );
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- WriteStringToStream(AStream, AStr, -1, 1, ADestEncoding
- {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
- );
- end;
- procedure WriteStringToStream(AStream: TStream; const AStr: string;
- const ALength: Integer = -1; const AIndex: Integer = 1;
- ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- );
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- LLength: Integer;
- LBytes: TIdBytes;
- begin
- LBytes := nil;
- LLength := IndyLength(AStr, ALength, AIndex);
- if LLength > 0 then
- begin
- LBytes := ToBytes(AStr, LLength, AIndex, ADestEncoding
- {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
- );
- TIdStreamHelper.Write(AStream, LBytes);
- end;
- end;
- {$IFDEF DOTNET}
- function TIdBaseStream.Read(var VBuffer: array of Byte; AOffset, ACount: Longint): Longint;
- var
- LBytes: TIdBytes;
- begin
- // this is a silly work around really, but array of Byte and TIdByte aren't
- // interchangable in a var parameter, though really they *should be*
- SetLength(LBytes, ACount - AOffset);
- Result := IdRead(LBytes, 0, ACount - AOffset);
- CopyTIdByteArray(LBytes, 0, VBuffer, AOffset, Result);
- end;
- function TIdBaseStream.Write(const ABuffer: array of Byte; AOffset, ACount: Longint): Longint;
- begin
- Result := IdWrite(ABuffer, AOffset, ACount);
- end;
- function TIdBaseStream.Seek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64;
- begin
- Result := IdSeek(AOffset, AOrigin);
- end;
- procedure TIdBaseStream.SetSize(ASize: Int64);
- begin
- IdSetSize(ASize);
- end;
- {$ELSE}
- {$IFDEF STREAM_SIZE_64}
- procedure TIdBaseStream.SetSize(const NewSize: Int64);
- begin
- IdSetSize(NewSize);
- end;
- {$ELSE}
- procedure TIdBaseStream.SetSize(ASize: Integer);
- begin
- IdSetSize(ASize);
- end;
- {$ENDIF}
- function TIdBaseStream.Read(var Buffer; Count: Longint): Longint;
- var
- LBytes: TIdBytes;
- begin
- SetLength(LBytes, Count);
- Result := IdRead(LBytes, 0, Count);
- if Result > 0 then begin
- Move(LBytes[0], Buffer, Result);
- end;
- end;
- function TIdBaseStream.Write(const Buffer; Count: Longint): Longint;
- begin
- if Count > 0 then begin
- Result := IdWrite(RawToBytes(Buffer, Count), 0, Count);
- end else begin
- Result := 0;
- end;
- end;
- {$IFDEF STREAM_SIZE_64}
- function TIdBaseStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
- begin
- Result := IdSeek(Offset, Origin);
- end;
- {$ELSE}
- function TIdBaseStream.Seek(Offset: Longint; Origin: Word): Longint;
- var
- LSeek : TSeekOrigin;
- begin
- case Origin of
- soFromBeginning : LSeek := soBeginning;
- soFromCurrent : LSeek := soCurrent;
- soFromEnd : LSeek := soEnd;
- else
- Result := 0;
- Exit;
- end;
- Result := IdSeek(Offset, LSeek) and $FFFFFFFF;
- end;
- {$ENDIF}
- {$ENDIF}
- function TIdCalculateSizeStream.IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint;
- begin
- Result := 0;
- end;
- function TIdCalculateSizeStream.IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint;
- var
- I: Integer;
- begin
- I := IndyLength(ABuffer, ACount, AOffset);
- if I > 0 then begin
- Inc(FPosition, I);
- if FPosition > FSize then begin
- FSize := FPosition;
- end;
- end;
- Result := I;
- end;
- function TIdCalculateSizeStream.IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64;
- begin
- case AOrigin of
- soBeginning: begin
- FPosition := AOffset;
- end;
- soCurrent: begin
- FPosition := FPosition + AOffset;
- end;
- soEnd: begin
- FPosition := FSize + AOffset;
- end;
- end;
- if FPosition < 0 then begin
- FPosition := 0;
- end;
- Result := FPosition;
- end;
- procedure TIdCalculateSizeStream.IdSetSize(ASize: Int64);
- begin
- if ASize < 0 then begin
- ASize := 0;
- end;
- if FSize <> ASize then begin
- FSize := ASize;
- if FSize < FPosition then begin
- FPosition := FSize;
- end;
- end;
- end;
- function TIdEventStream.IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint;
- begin
- Result := 0;
- if Assigned(FOnRead) then begin
- FOnRead(VBuffer, AOffset, ACount, Result);
- end;
- end;
- function TIdEventStream.IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint;
- begin
- if Assigned(FOnWrite) then begin
- Result := 0;
- FOnWrite(ABuffer, AOffset, ACount, Result);
- end else begin
- Result := ACount;
- end;
- end;
- function TIdEventStream.IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64;
- begin
- Result := 0;
- if Assigned(FOnSeek) then begin
- FOnSeek(AOffset, AOrigin, Result);
- end;
- end;
- procedure TIdEventStream.IdSetSize(ASize: Int64);
- begin
- if Assigned(FOnSetSize) then begin
- FOnSetSize(ASize);
- end;
- end;
- {$IFNDEF DOTNET}
- constructor TIdMemoryBufferStream.Create(APtr: Pointer; ASize: TIdNativeInt);
- begin
- inherited Create;
- SetPointer(APtr, ASize);
- end;
- {$UNDEF USE_PBYTE_ARITHMETIC}
- {$IFDEF FPC}
- {$DEFINE USE_PBYTE_ARITHMETIC}
- {$ELSE}
- {$IFDEF VCL_XE2_OR_ABOVE}
- {$DEFINE USE_PBYTE_ARITHMETIC}
- {$ENDIF}
- {$ENDIF}
- function TIdMemoryBufferStream.Write(const Buffer; Count: Longint): Longint;
- var
- LAvailable: TIdStreamSize;
- LNumToCopy: Longint;
- begin
- Result := 0;
- LAvailable := Size - Position;
- if LAvailable > 0 then
- begin
- {$IFDEF STREAM_SIZE_64}
- LNumToCopy := Longint(IndyMin(LAvailable, TIdStreamSize(Count)));
- {$ELSE}
- LNumToCopy := IndyMin(LAvailable, Count);
- {$ENDIF}
- if LNumToCopy > 0 then
- begin
- System.Move(Buffer, ({$IFDEF USE_PBYTE_ARITHMETIC}PByte{$ELSE}PIdAnsiChar{$ENDIF}(Memory) + Position)^, LNumToCopy);
- TIdStreamHelper.Seek(Self, LNumToCopy, soCurrent);
- Result := LNumToCopy;
- end;
- end;
- end;
- {$ENDIF}
- function TIdReadOnlyMemoryBufferStream.Write(const Buffer; Count: Longint): Longint;
- begin
- // TODO: raise an exception instead?
- Result := 0;
- end;
- procedure AppendBytes(var VBytes: TIdBytes; const AToAdd: TIdBytes; const AIndex: Integer = 0; const ALength: Integer = -1);
- var
- LOldLen, LAddLen: Integer;
- begin
- LAddLen := IndyLength(AToAdd, ALength, AIndex);
- if LAddLen > 0 then begin
- LOldLen := Length(VBytes);
- SetLength(VBytes, LOldLen + LAddLen);
- CopyTIdBytes(AToAdd, AIndex, VBytes, LOldLen, LAddLen);
- end;
- end;
- procedure AppendByte(var VBytes: TIdBytes; const AByte: Byte);
- var
- LOldLen: Integer;
- begin
- LOldLen := Length(VBytes);
- SetLength(VBytes, LOldLen + 1);
- VBytes[LOldLen] := AByte;
- end;
- procedure AppendString(var VBytes: TIdBytes; const AStr: String; const ALength: Integer = -1;
- ADestEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- );
- var
- LBytes: TIdBytes;
- LLength, LOldLen: Integer;
- begin
- LBytes := nil; // keep the compiler happy
- LLength := IndyLength(AStr, ALength);
- if LLength > 0 then begin
- LBytes := ToBytes(AStr, LLength, 1, ADestEncoding
- {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
- );
- LOldLen := Length(VBytes);
- LLength := Length(LBytes);
- SetLength(VBytes, LOldLen + LLength);
- CopyTIdBytes(LBytes, 0, VBytes, LOldLen, LLength);
- end;
- end;
- procedure ExpandBytes(var VBytes: TIdBytes; const AIndex: Integer; const ACount: Integer; const AFillByte: Byte = 0);
- var
- I: Integer;
- begin
- if ACount > 0 then begin
- // if AIndex is at the end of the buffer then the operation is appending bytes
- if AIndex <> Length(VBytes) then begin
- //if these asserts fail, then it indicates an attempted buffer overrun.
- Assert(AIndex >= 0);
- Assert(AIndex < Length(VBytes));
- end;
- SetLength(VBytes, Length(VBytes) + ACount);
- // move any existing bytes at the index to the end of the buffer
- for I := Length(VBytes)-1 downto AIndex+ACount do begin
- VBytes[I] := VBytes[I-ACount];
- end;
- // fill in the new space with the fill byte
- for I := AIndex to AIndex+ACount-1 do begin
- VBytes[I] := AFillByte;
- end;
- end;
- end;
- procedure InsertBytes(var VBytes: TIdBytes; const ADestIndex: Integer;
- const ASource: TIdBytes; const ASourceIndex: Integer = 0);
- var
- LAddLen: Integer;
- begin
- LAddLen := IndyLength(ASource, -1, ASourceIndex);
- if LAddLen > 0 then begin
- ExpandBytes(VBytes, ADestIndex, LAddLen);
- CopyTIdBytes(ASource, ASourceIndex, VBytes, ADestIndex, LAddLen);
- end;
- end;
- procedure InsertByte(var VBytes: TIdBytes; const AByte: Byte; const AIndex: Integer);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- ExpandBytes(VBytes, AIndex, 1, AByte);
- end;
- procedure RemoveBytes(var VBytes: TIdBytes; const ACount: Integer; const AIndex: Integer = 0);
- var
- I: Integer;
- LActual: Integer;
- begin
- //TODO: check the reference count of VBytes, if >1 then make a new copy
- Assert(AIndex >= 0);
- LActual := IndyMin(Length(VBytes)-AIndex, ACount);
- if LActual > 0 then begin
- if (AIndex + LActual) < Length(VBytes) then begin
- // RLebeau: TODO - use Move() here instead?
- for I := AIndex to Length(VBytes)-LActual-1 do begin
- VBytes[I] := VBytes[I+LActual];
- end;
- end;
- SetLength(VBytes, Length(VBytes)-LActual);
- end;
- end;
- procedure IdDelete(var s: string; AOffset, ACount: Integer);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Delete(s, AOffset, ACount);
- end;
- procedure IdInsert(const Source: string; var S: string; Index: Integer);
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Insert(Source, S, Index);
- end;
- function TextIsSame(const A1, A2: string): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := System.String.Compare(A1, A2, True) = 0;
- {$ELSE}
- Result := AnsiCompareText(A1, A2) = 0;
- {$ENDIF}
- end;
- // TODO: define STRING_UNICODE_MISMATCH for WinCE in IdCompilerDefines.inc?
- {$IFDEF WINDOWS}
- {$IFDEF WINCE}
- {$IFNDEF STRING_IS_UNICODE}
- {$DEFINE COMPARE_STRING_MISMATCH}
- {$ENDIF}
- {$ELSE}
- {$IFDEF STRING_UNICODE_MISMATCH}
- {$DEFINE COMPARE_STRING_MISMATCH}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- function TextStartsWith(const S, SubS: string): Boolean;
- var
- LLen: Integer;
- {$IFDEF WINDOWS}
- {$IFDEF COMPARE_STRING_MISMATCH}
- LS, LSubS: {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF};
- P1, P2: {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF};
- {$ENDIF}
- {$ENDIF}
- begin
- LLen := Length(SubS);
- Result := LLen <= Length(S);
- if Result then
- begin
- {$IFDEF DOTNET}
- Result := System.String.Compare(S, 0, SubS, 0, LLen, True) = 0;
- {$ELSE}
- {$IFDEF WINDOWS}
- {$IFDEF COMPARE_STRING_MISMATCH}
- // explicit convert to Ansi/Unicode
- LS := {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF}(S);
- LSubS := {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF}(SubS);
- LLen := Length(LSubS);
- Result := LLen <= Length(LS);
- if Result then begin
- P1 := {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF}(LS);
- P2 := {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF}(LSubS);
- Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, P1, LLen, P2, LLen) = 2;
- end;
- {$ELSE}
- Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PChar(S), LLen, PChar(SubS), LLen) = 2;
- {$ENDIF}
- {$ELSE}
- Result := AnsiCompareText(Copy(S, 1, LLen), SubS) = 0;
- {$ENDIF}
- {$ENDIF}
- end;
- end;
- function TextEndsWith(const S, SubS: string): Boolean;
- var
- LLen: Integer;
- {$IFDEF WINDOWS}
- {$IFDEF COMPARE_STRING_MISMATCH}
- LS, LSubS: {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF};
- P1, P2: {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF};
- {$ELSE}
- P: PChar;
- {$ENDIF}
- {$ENDIF}
- begin
- LLen := Length(SubS);
- Result := LLen <= Length(S);
- if Result then
- begin
- {$IFDEF DOTNET}
- Result := System.String.Compare(S, Length(S)-LLen, SubS, 0, LLen, True) = 0;
- {$ELSE}
- {$IFDEF WINDOWS}
- {$IFDEF COMPARE_STRING_MISMATCH}
- // explicit convert to Ansi/Unicode
- LS := {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF}(S);
- LSubS := {$IFDEF WINCE}TIdUnicodeString{$ELSE}TIdPlatformString{$ENDIF}(SubS);
- LLen := Length(LSubS);
- Result := LLen <= Length(S);
- if Result then begin
- P1 := {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF}(LS);
- P2 := {$IFDEF WINCE}PIdWideChar{$ELSE}PIdPlatformChar{$ENDIF}(LSubS);
- Inc(P1, Length(LS)-LLen);
- Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, P1, LLen, P2, LLen) = 2;
- end;
- {$ELSE}
- P := PChar(S);
- Inc(P, Length(S)-LLen);
- Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, P, LLen, PChar(SubS), LLen) = 2;
- {$ENDIF}
- {$ELSE}
- Result := AnsiCompareText(Copy(S, Length(S)-LLen+1, LLen), SubS) = 0;
- {$ENDIF}
- {$ENDIF}
- end;
- end;
- function IndyLowerCase(const A1: string): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := A1.ToLower;
- {$ELSE}
- Result := AnsiLowerCase(A1);
- {$ENDIF}
- end;
- function IndyUpperCase(const A1: string): string;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := A1.ToUpper;
- {$ELSE}
- Result := AnsiUpperCase(A1);
- {$ENDIF}
- end;
- function IndyCompareStr(const A1, A2: string): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF DOTNET}
- Result := CompareStr(A1, A2);
- {$ELSE}
- Result := AnsiCompareStr(A1, A2);
- {$ENDIF}
- end;
- function CharPosInSet(const AString: string; const ACharPos: Integer; const ASet: String): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$IFNDEF DOTNET}
- var
- LChar: Char;
- I: Integer;
- {$ENDIF}
- begin
- Result := 0;
- if ACharPos < 1 then begin
- raise EIdException.Create('Invalid ACharPos');{ do not localize } // TODO: add a resource string, and create a new Exception class for this
- end;
- if ACharPos <= Length(AString) then begin
- {$IFDEF DOTNET}
- Result := ASet.IndexOf(AString[ACharPos]) + 1;
- {$ELSE}
- // RLebeau 5/8/08: Calling Pos() with a Char as input creates a temporary
- // String. Normally this is fine, but profiling reveils this to be a big
- // bottleneck for code that makes a lot of calls to CharIsInSet(), so we
- // will scan through ASet looking for the character without a conversion...
- //
- // Result := IndyPos(AString[ACharPos], ASet);
- //
- LChar := AString[ACharPos];
- for I := 1 to Length(ASet) do begin
- if ASet[I] = LChar then begin
- Result := I;
- Exit;
- end;
- end;
- {$ENDIF}
- end;
- end;
- function CharIsInSet(const AString: string; const ACharPos: Integer; const ASet: String): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := CharPosInSet(AString, ACharPos, ASet) > 0;
- end;
- function CharIsInEOL(const AString: string; const ACharPos: Integer): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := CharPosInSet(AString, ACharPos, EOL) > 0;
- end;
- function CharEquals(const AString: string; const ACharPos: Integer; const AValue: Char): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if ACharPos < 1 then begin
- raise EIdException.Create('Invalid ACharPos');{ do not localize } // TODO: add a resource string, and create a new Exception class for this
- end;
- Result := ACharPos <= Length(AString);
- if Result then begin
- Result := AString[ACharPos] = AValue;
- end;
- end;
- {$IFDEF STRING_IS_IMMUTABLE}
- {$IFDEF DOTNET}
- {$DEFINE HAS_String_IndexOf}
- {$ENDIF}
- {$IFDEF HAS_SysUtils_TStringHelper}
- {$DEFINE HAS_String_IndexOf}
- {$ENDIF}
- function CharPosInSet(const ASB: TIdStringBuilder; const ACharPos: Integer; const ASet: String): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- {$IFNDEF HAS_String_IndexOf}
- var
- LChar: Char;
- I: Integer;
- {$ENDIF}
- begin
- Result := 0;
- if ACharPos < 1 then begin
- raise EIdException.Create('Invalid ACharPos');{ do not localize } // TODO: add a resource string, and create a new Exception class for this
- end;
- if ACharPos <= ASB.Length then begin
- {$IFDEF HAS_String_IndexOf}
- Result := ASet.IndexOf(ASB[ACharPos-1]) + 1;
- {$ELSE}
- // RLebeau 5/8/08: Calling Pos() with a Char as input creates a temporary
- // String. Normally this is fine, but profiling reveils this to be a big
- // bottleneck for code that makes a lot of calls to CharIsInSet(), so we
- // will scan through ASet looking for the character without a conversion...
- //
- // Result := IndyPos(ASB[ACharPos-1], ASet);
- //
- LChar := ASB[ACharPos-1];
- for I := 1 to Length(ASet) do begin
- if ASet[I] = LChar then begin
- Result := I;
- Exit;
- end;
- end;
- {$ENDIF}
- end;
- end;
- function CharIsInSet(const ASB: TIdStringBuilder; const ACharPos: Integer; const ASet: String): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := CharPosInSet(ASB, ACharPos, ASet) > 0;
- end;
- function CharIsInEOL(const ASB: TIdStringBuilder; const ACharPos: Integer): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := CharPosInSet(ASB, ACharPos, EOL) > 0;
- end;
- function CharEquals(const ASB: TIdStringBuilder; const ACharPos: Integer; const AValue: Char): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if ACharPos < 1 then begin
- raise EIdException.Create('Invalid ACharPos');{ do not localize } // TODO: add a resource string, and create a new Exception class for this
- end;
- Result := ACharPos <= ASB.Length;
- if Result then begin
- Result := ASB[ACharPos-1] = AValue;
- end;
- end;
- {$ENDIF}
- function ByteIndex(const AByte: Byte; const ABytes: TIdBytes; const AStartIndex: Integer = 0): Integer;
- var
- I: Integer;
- begin
- Result := -1;
- for I := AStartIndex to Length(ABytes)-1 do begin
- if ABytes[I] = AByte then begin
- Result := I;
- Exit;
- end;
- end;
- end;
- function ByteIdxInSet(const ABytes: TIdBytes; const AIndex: Integer; const ASet: TIdBytes): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- if AIndex < 0 then begin
- raise EIdException.Create('Invalid AIndex'); {do not localize} // TODO: add a resource string, and create a new Exception class for this
- end;
- if AIndex < Length(ABytes) then begin
- Result := ByteIndex(ABytes[AIndex], ASet);
- end else begin
- Result := -1;
- end;
- end;
- function ByteIsInSet(const ABytes: TIdBytes; const AIndex: Integer; const ASet: TIdBytes): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- Result := ByteIdxInSet(ABytes, AIndex, ASet) > -1;
- end;
- function ByteIsInEOL(const ABytes: TIdBytes; const AIndex: Integer): Boolean;
- var
- LSet: TIdBytes;
- begin
- SetLength(LSet, 2);
- LSet[0] := 13;
- LSet[1] := 10;
- Result := ByteIsInSet(ABytes, AIndex, LSet);
- end;
- function ReadLnFromStream(AStream: TStream; AMaxLineLength: Integer = -1;
- AExceptionIfEOF: Boolean = False; AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): string; overload;
- begin
- if (not ReadLnFromStream(AStream, Result, AMaxLineLength, AByteEncoding
- {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
- )) and AExceptionIfEOF then
- begin
- raise EIdEndOfStream.CreateFmt(RSEndOfStream, ['ReadLnFromStream', AStream.Position]); {do not localize}
- end;
- end;
- //TODO: Continue to optimize this function. Its performance severely impacts the coders
- function ReadLnFromStream(AStream: TStream; var VLine: String; AMaxLineLength: Integer = -1;
- AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): Boolean; overload;
- const
- LBUFMAXSIZE = 2048;
- var
- LStringLen, LResultLen, LBufSize: Integer;
- LBuf: TIdBytes;
- LLine: TIdBytes;
- // LBuf: packed array [0..LBUFMAXSIZE] of Char;
- LStrmPos, LStrmSize: TIdStreamSize; //LBytesToRead = stream size - Position
- LCrEncountered: Boolean;
- function FindEOL(const ABuf: TIdBytes; var VLineBufSize: Integer; var VCrEncountered: Boolean): Integer;
- var
- i: Integer;
- begin
- Result := VLineBufSize; //EOL not found => use all
- i := 0;
- while i < VLineBufSize do begin
- case ABuf[i] of
- Ord(LF): begin
- Result := i; {string size}
- VCrEncountered := True;
- VLineBufSize := i+1;
- Break;
- end;
- Ord(CR): begin
- Result := i; {string size}
- VCrEncountered := True;
- Inc(i); //crLF?
- if (i < VLineBufSize) and (ABuf[i] = Ord(LF)) then begin
- VLineBufSize := i+1;
- end else begin
- VLineBufSize := i;
- end;
- Break;
- end;
- end;
- Inc(i);
- end;
- end;
- begin
- Assert(AStream<>nil);
- VLine := '';
- SetLength(LLine, 0);
- if AMaxLineLength < 0 then begin
- AMaxLineLength := MaxInt;
- end;
- { we store the stream size for the whole routine to prevent
- so do not incur a performance penalty with TStream.Size. It has
- to use something such as Seek each time the size is obtained}
- {4 seek vs 3 seek}
- LStrmPos := AStream.Position;
- LStrmSize := AStream.Size;
- if LStrmPos >= LStrmSize then begin
- Result := False;
- Exit;
- end;
- SetLength(LBuf, LBUFMAXSIZE);
- LCrEncountered := False;
- repeat
- LBufSize := ReadTIdBytesFromStream(AStream, LBuf, IndyMin(LStrmSize - LStrmPos, LBUFMAXSIZE));
- if LBufSize < 1 then begin
- Break; // TODO: throw a stream read exception instead?
- end;
- LStringLen := FindEOL(LBuf, LBufSize, LCrEncountered);
- Inc(LStrmPos, LBufSize);
- LResultLen := Length(VLine);
- if (LResultLen + LStringLen) > AMaxLineLength then begin
- LStringLen := AMaxLineLength - LResultLen;
- LCrEncountered := True;
- Dec(LStrmPos, LBufSize);
- Inc(LStrmPos, LStringLen);
- end;
- if LStringLen > 0 then begin
- LBufSize := Length(LLine);
- SetLength(LLine, LBufSize+LStringLen);
- CopyTIdBytes(LBuf, 0, LLine, LBufSize, LStringLen);
- end;
- until (LStrmPos >= LStrmSize) or LCrEncountered;
- // RLebeau: why is the original Position being restored here, instead
- // of leaving the Position at the end of the line?
- AStream.Position := LStrmPos;
- VLine := BytesToString(LLine, 0, -1, AByteEncoding
- {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
- );
- Result := True;
- end;
- {$IFDEF REGISTER_EXPECTED_MEMORY_LEAK}
- function IndyRegisterExpectedMemoryLeak(AAddress: Pointer): Boolean;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- // use only System.RegisterExpectedMemoryLeak() on systems that support
- // it. We should use whatever the RTL's active memory manager is. The user
- // can override the RTL's version of FastMM (2006+ only) with any memory
- // manager they want, such as MadExcept.
- //
- // Fallback to specific memory managers if System.RegisterExpectedMemoryLeak()
- // is not available.
- {$IFDEF HAS_System_RegisterExpectedMemoryLeak}
- // RLebeau 4/21/08: not quite sure what the difference is between the
- // SysRegisterExpectedMemoryLeak() and RegisterExpectedMemoryLeak()
- // functions in the System unit, but calling RegisterExpectedMemoryLeak()
- // is causing stack overflows when FastMM is not active, so call
- // SysRegisterExpectedMemoryLeak() instead...
- // RLebeau 7/4/09: According to Pierre Le Riche, developer of FastMM:
- //
- // "SysRegisterExpectedMemoryLeak() is the leak registration routine for
- // the built-in memory manager. FastMM.RegisterExpectedMemoryLeak is the
- // leak registration code for FastMM. Both of these are thus hardwired to
- // a specific memory manager. In order to register a leak for the
- // *currently installed* memory manager, which is what you typically want
- // to do, you have to call System.RegisterExpectedMemoryLeak().
- // System.RegisterExpectedMemoryLeak() redirects to the leak registration
- // code of the installed memory manager."
- {$I IdSymbolPlatformOff.inc}
- //Result := System.SysRegisterExpectedMemoryLeak(AAddress);
- Result := System.RegisterExpectedMemoryLeak(AAddress);
- {$I IdSymbolPlatformOn.inc}
- {$ELSE}
- // RLebeau 10/5/2014: the user can override the RTL's version of FastMM
- // (2006+ only) with any memory manager, such as MadExcept, so check for
- // that...
- {$IFDEF USE_FASTMM4}
- Result := FastMM4.RegisterExpectedMemoryLeak(AAddress);
- {$ELSE}
- {$IFDEF USE_MADEXCEPT}
- Result := madExcept.HideLeak(AAddress);
- {$ELSE}
- {$IFDEF USE_LEAKCHECK}
- Result := LeakCheck.RegisterExpectedMemoryLeak(AAddress);
- {$ELSE}
- Result := False;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- end;
- {$ENDIF}
- function IndyAddPair(AStrings: TStrings; const AName, AValue: String): TStrings;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF HAS_TStrings_AddPair}
- Result := AStrings.AddPair(AName, AValue);
- {$ELSE}
- {$IFDEF HAS_TStrings_NameValueSeparator}
- AStrings.Add(AName + AStrings.NameValueSeparator + AValue);
- {$ELSE}
- AStrings.Add(AName + '=' + AValue); {do not localize}
- {$ENDIF}
- Result := AStrings;
- {$ENDIF}
- end;
- function IndyAddPair(AStrings: TStrings; const AName, AValue: String; AObject: TObject): TStrings;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- begin
- {$IFDEF HAS_TStrings_AddPair}
- Result := AStrings.AddPair(AName, AValue, AObject);
- {$ELSE}
- {$IFDEF HAS_TStrings_NameValueSeparator}
- AStrings.AddObject(AName + AStrings.NameValueSeparator + AValue, AObject);
- {$ELSE}
- AStrings.AddObject(AName + '=' + AValue, AObject);
- {$ENDIF}
- Result := AStrings;
- {$ENDIF}
- end;
- function InternalIndyIndexOf(AStrings: TStrings; const AStr: string;
- const ACaseSensitive: Boolean = False): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- I: Integer;
- begin
- Result := -1;
- for I := 0 to AStrings.Count - 1 do begin
- if ACaseSensitive then begin
- if AStrings[I] = AStr then begin
- Result := I;
- Exit;
- end;
- end else begin
- if TextIsSame(AStrings[I], AStr) then begin
- Result := I;
- Exit;
- end;
- end;
- end;
- end;
- function IndyIndexOf(AStrings: TStrings; const AStr: string;
- const ACaseSensitive: Boolean = False): Integer;
- begin
- {$IFDEF HAS_TStringList_CaseSensitive}
- if AStrings is TStringList then begin
- Result := IndyIndexOf(TStringList(AStrings), AStr, ACaseSensitive);
- Exit;
- end;
- {$ENDIF}
- Result := InternalIndyIndexOf(AStrings, AStr, ACaseSensitive);
- end;
- {$IFDEF HAS_TStringList_CaseSensitive}
- function IndyIndexOf(AStrings: TStringList; const AStr: string;
- const ACaseSensitive: Boolean = False): Integer;
- begin
- if AStrings.CaseSensitive = ACaseSensitive then begin
- Result := AStrings.IndexOf(AStr);
- end else begin
- Result := InternalIndyIndexOf(AStrings, AStr, ACaseSensitive);
- end;
- end;
- {$ENDIF}
- function InternalIndyIndexOfName(AStrings: TStrings; const AName: string;
- const ACaseSensitive: Boolean = False): Integer;
- {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- I: Integer;
- begin
- Result := -1;
- for I := 0 to AStrings.Count - 1 do begin
- if ACaseSensitive then begin
- if AStrings.Names[I] = AName then begin
- Result := I;
- Exit;
- end;
- end
- else if TextIsSame(AStrings.Names[I], AName) then begin
- Result := I;
- Exit;
- end;
- end;
- end;
- function IndyIndexOfName(AStrings: TStrings; const AName: string;
- const ACaseSensitive: Boolean = False): Integer;
- begin
- {$IFDEF HAS_TStringList_CaseSensitive}
- if AStrings is TStringList then begin
- Result := IndyIndexOfName(TStringList(AStrings), AName, ACaseSensitive);
- Exit;
- end;
- {$ENDIF}
- Result := InternalIndyIndexOfName(AStrings, AName, ACaseSensitive);
- end;
- {$IFDEF HAS_TStringList_CaseSensitive}
- function IndyIndexOfName(AStrings: TStringList; const AName: string;
- const ACaseSensitive: Boolean = False): Integer;
- begin
- if AStrings.CaseSensitive = ACaseSensitive then begin
- Result := AStrings.IndexOfName(AName);
- end else begin
- Result := InternalIndyIndexOfName(AStrings, AName, ACaseSensitive);
- end;
- end;
- {$ENDIF}
- function IndyValueFromIndex(AStrings: TStrings; const AIndex: Integer): String;
- {$IFNDEF HAS_TStrings_ValueFromIndex}
- var
- LTmp: string;
- LPos: Integer;
- {$IFDEF HAS_TStrings_NameValueSeparator}
- LChar: Char;
- {$ENDIF}
- {$ENDIF}
- begin
- {$IFDEF HAS_TStrings_ValueFromIndex}
- Result := AStrings.ValueFromIndex[AIndex];
- {$ELSE}
- Result := '';
- if AIndex >= 0 then
- begin
- LTmp := AStrings.Strings[AIndex];
- {$IFDEF HAS_TStrings_NameValueSeparator}
- // RLebeau 11/8/16: Calling Pos() with a Char as input creates a temporary
- // String. Normally this is fine, but profiling reveils this to be a big
- // bottleneck for code that makes a lot of calls to Pos() in a loop, so we
- // will scan through the string looking for the character without a conversion...
- //
- // LPos := Pos(AStrings.NameValueSeparator, LTmp); {do not localize}
- // if LPos > 0 then begin
- //
- LChar := AStrings.NameValueSeparator;
- for LPos := 1 to Length(LTmp) do begin
- //if CharEquals(LTmp, LPos, LChar) then begin
- if LTmp[LPos] = LChar then begin
- Result := Copy(LTmp, LPos+1, MaxInt);
- Exit;
- end;
- end;
- {$ELSE}
- LPos := Pos('=', LTmp); {do not localize}
- if LPos > 0 then begin
- Result := Copy(LTmp, LPos+1, MaxInt);
- end;
- {$ENDIF}
- end;
- {$ENDIF}
- end;
- {$IFDEF WINDOWS}
- function IndyWindowsMajorVersion: Integer;
- begin
- {$IFDEF WINCE}
- Result := SysUtils.WinCEMajorVersion;
- {$ELSE}
- Result := SysUtils.Win32MajorVersion;
- {$ENDIF}
- end;
- function IndyWindowsMinorVersion: Integer;
- begin
- {$IFDEF WINCE}
- Result := SysUtils.WinCEMinorVersion;
- {$ELSE}
- Result := SysUtils.Win32MinorVersion;
- {$ENDIF}
- end;
- function IndyWindowsBuildNumber: Integer;
- begin
- // for this, you need to strip off some junk to do comparisons
- {$IFDEF WINCE}
- Result := SysUtils.WinCEBuildNumber and $FFFF;
- {$ELSE}
- Result := SysUtils.Win32BuildNumber and $FFFF;
- {$ENDIF}
- end;
- function IndyWindowsPlatform: Integer;
- begin
- {$IFDEF WINCE}
- Result := SysUtils.WinCEPlatform;
- {$ELSE}
- Result := SysUtils.Win32Platform;
- {$ENDIF}
- end;
- function IndyCheckWindowsVersion(const AMajor: Integer; const AMinor: Integer = 0): Boolean;
- var
- LMajor, LMinor: Integer;
- begin
- LMajor := IndyWindowsMajorVersion;
- LMinor := IndyWindowsMinorVersion;
- Result := (LMajor > AMajor) or ((LMajor = AMajor) and (LMinor >= AMinor));
- end;
- {$ENDIF}
- // Embarcadero changed the signature of FreeAndNil() in 10.4 Denali...
- {$UNDEF HAS_FreeAndNil_TObject_Param}
- {$IFNDEF USE_OBJECT_ARC}
- {$IFDEF DCC}
- {$IFDEF VCL_10_4_OR_ABOVE}
- {$DEFINE HAS_FreeAndNil_TObject_Param}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- procedure IdDisposeAndNil(var Obj);
- {$IFDEF USE_OBJECT_ARC}
- var
- Temp: {Pointer}TObject;
- {$ENDIF}
- begin
- {$IFDEF USE_OBJECT_ARC}
- // RLebeau: was originally calling DisposeOf() on Obj directly, but nil'ing
- // Obj first prevented the calling code from invoking __ObjRelease() on Obj.
- // Don't do that in ARC. __ObjRelease() needs to be called, even if disposed,
- // to allow the compiler/RTL to finalize Obj so any managed members it has
- // can be cleaned up properly...
- {
- Temp := Pointer(Obj);
- Pointer(Obj) := nil;
- TObject(Temp).DisposeOf;
- }
- Pointer(Temp) := Pointer(Obj);
- Pointer(Obj) := nil;
- Temp.DisposeOf;
- // __ObjRelease() is called when Temp goes out of scope
- {$ELSE}
- FreeAndNil({$IFDEF HAS_FreeAndNil_TObject_Param}TObject(Obj){$ELSE}Obj{$ENDIF});
- {$ENDIF}
- end;
- initialization
- // AnsiPos does not handle strings with #0 and is also very slow compared to Pos
- {$IFDEF DOTNET}
- IndyPos := SBPos;
- {$ELSE}
- if LeadBytes = [] then begin
- IndyPos := SBPos;
- end else begin
- IndyPos := InternalAnsiPos;
- end;
- {$ENDIF}
- {$IFDEF DYNAMICLOAD_InterlockedCompareExchange}
- InterlockedCompareExchange := Stub_InterlockedCompareExchange;
- {$ENDIF}
- {$IFDEF WINDOWS}
- GetTickCount64 := Stub_GetTickCount64;
- {$ENDIF}
- {$IFDEF UNIX}
- {$IFDEF OSX}
- mach_timebase_info(GMachTimeBaseInfo);
- {$ENDIF}
- {$ENDIF}
- {$IFNDEF DOTNET}
- finalization
- FreeAndNil(GIdPorts);
- {$ENDIF}
- end.
|