IdGlobalProtocols.pas 201 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382
  1. {
  2. $Project$
  3. $Workfile$
  4. $Revision$
  5. $DateUTC$
  6. $Id$
  7. This file is part of the Indy (Internet Direct) project, and is offered
  8. under the dual-licensing agreement described on the Indy website.
  9. (http://www.indyproject.org/)
  10. Copyright:
  11. (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
  12. }
  13. {
  14. $Log$
  15. }
  16. {
  17. 10 Indy10 1.9 5/4/2005 7:06:24 PM J. Peter Mugaas Attempt to
  18. fix another junked part of the file.
  19. 9 Indy10 1.8 5/4/2005 7:02:50 PM J. Peter Mugaas Attempt to
  20. fix a junked file.
  21. 8 Indy10 1.7 5/4/2005 6:31:08 PM J. Peter Mugaas These
  22. should now work. I moved a TextWrapping function out of TIdHeaderList
  23. and into IdGlobalProtocols so the FTP List output object can use it and
  24. so we can rework the routine slightly to use StringBuilder in DotNET.
  25. 7 Indy10 1.6 4/28/2005 11:02:30 PM J. Peter Mugaas Removed
  26. StrToInt64Def symbol. We now use Sys.StrToInt64 instead.
  27. 6 Indy10 1.5 4/28/2005 10:23:14 PM J. Peter Mugaas Should now
  28. work with new API change in CharInSet.
  29. 5 Indy10 1.4 4/20/2005 10:44:24 PM Ben Taylor IdSys
  30. changes
  31. 4 Indy10 1.3 4/20/2005 12:43:48 AM J. Peter Mugaas Removed
  32. SysUtils from most units and added it to IdGlobalProtocols (works best
  33. that way).
  34. 3 Indy10 1.2 4/19/2005 5:19:11 PM J. Peter Mugaas Removed
  35. SysUtils and fixed EIdException reference.
  36. 2 Indy10 1.1 4/19/2005 10:15:26 AM J. Peter Mugaas Updates
  37. Rev 1.31 04/03/2005 21:21:56 HHariri
  38. Fix for DirectoryExists and removal of FileCtrl dependency
  39. Rev 1.30 3/3/2005 10:12:38 AM JPMugaas
  40. Fix for compiler warning about DotNET and ByteType.
  41. Rev 1.29 2/12/2005 8:08:02 AM JPMugaas
  42. Attempt to fix MDTM bug where msec was being sent.
  43. Rev 1.28 2/10/2005 2:24:40 PM JPMugaas
  44. Minor Restructures for some new UnixTime Service components.
  45. Rev 1.27 1/15/2005 6:02:46 PM JPMugaas
  46. Byte extract with byte order now use updated code in IdGlobal.
  47. Rev 1.26 1/8/2005 3:59:58 PM JPMugaas
  48. New functions for reading integer values to and from TIdBytes using the
  49. network byte order functions. They should be used for embedding values in
  50. some Internet Protocols such as FSP, SNTP, and maybe others.
  51. Rev 1.25 12/3/2004 3:16:20 PM DSiders
  52. Fixed assignment error in MakeTempFilename.
  53. Rev 1.24 12/1/2004 4:40:42 AM JPMugaas
  54. Fix for GMT Time routine. This has been tested.
  55. Rev 1.23 11/14/2004 10:28:42 PM JPMugaas
  56. Compiler warning in IdGlobalProtocol about an undefined result.
  57. Rev 1.22 12/11/2004 9:31:22 HHariri
  58. Fix for Delphi 5
  59. Rev 1.21 11/11/2004 11:18:04 PM JPMugaas
  60. Function to get the Last Modified file in GMT instead of localtime. Needed
  61. by TIdFSP.
  62. Rev 1.20 2004.10.27 9:17:50 AM czhower
  63. For TIdStrings
  64. Rev 1.19 10/26/2004 10:07:02 PM JPMugaas
  65. Updated refs.
  66. Rev 1.18 10/13/2004 7:48:52 PM DSiders
  67. Modified GetUniqueFilename to pass correct argument type to tempnam function.
  68. Rev 1.17 10/6/2004 11:39:48 PM DSiders
  69. Modified MakeTempFilename to use GetUniqueFilename. File extensions are
  70. omitted on Linux.
  71. Modified GetUniqueFilename to use tempnam function on Linux. Validates path
  72. on Win32 and .Net. Uses platform-specific temp path on Win32 and .Net.
  73. Rev 1.16 9/5/2004 2:55:52 AM JPMugaas
  74. Fixed a range check error in
  75. function TwoCharToWord(AChar1,AChar2: Char):Word;.
  76. Rev 1.15 8/10/04 8:47:16 PM RLebeau
  77. Bug fix for TIdMimeTable.AddMimeType()
  78. Rev 1.14 8/5/04 5:44:40 PM RLebeau
  79. Added GetMIMEDefaultFileExt() function
  80. Rev 1.13 7/23/04 6:51:34 PM RLebeau
  81. Added extra exception handling to IndyCopyFile()
  82. Updated CopyFileTo() to call IndyCopyFile()
  83. TFileStream access right tweak for FileSizeByName()
  84. Rev 1.12 7/8/04 5:23:46 PM RLebeau
  85. Updated CardinalToFourChar() to remove use of local TIdBytes variable
  86. Rev 1.11 11/06/2004 00:22:38 CCostelloe
  87. Implemented GetClockValue for Linux
  88. Rev 1.10 09/06/2004 10:03:00 CCostelloe
  89. Kylix 3 patch
  90. Rev 1.9 02/05/2004 13:20:50 CCostelloe
  91. Added RemoveHeaderEntry for use by IdMessage and IdMessageParts (typically
  92. removing old boundary)
  93. Rev 1.8 2/22/2004 12:09:38 AM JPMugaas
  94. Fixes for IMAP4Server compile failure in DotNET. This also fixes a potential
  95. problem where file handles can be leaked in the server needlessly.
  96. Rev 1.7 2/19/2004 11:53:00 PM JPMugaas
  97. Moved some functions out of CoderQuotedPrintable for reuse.
  98. Rev 1.6 2/19/2004 11:40:28 PM JPMugaas
  99. Character to hex translation routine added for QP and some
  100. internationalization work.
  101. Rev 1.5 2/19/2004 3:22:40 PM JPMugaas
  102. ABNFToText and related functions added for some RFC 2234. This is somee
  103. groundwork for RFC 2640 - Internationalization of the File Transfer Protocol.
  104. Rev 1.4 2/16/2004 1:53:34 PM JPMugaas
  105. Moved some routines to the system package.
  106. Rev 1.3 2/11/2004 5:17:50 AM JPMugaas
  107. Bit flip functionality was removed because is problematic on some
  108. architectures. They were used in place of the standard network byte order
  109. conversion routines. On an Intel chip, flip works the same as those but in
  110. architectures where network order is the same as host order, some functions
  111. will fail and you may get strange results. The network byte order conversion
  112. functions provide transparancy amoung architectures.
  113. Rev 1.2 2/9/2004 11:27:48 AM JPMugaas
  114. Some functions weren't working as expected. Renamed them to describe them
  115. better.
  116. Rev 1.1 2/7/2004 7:18:38 PM JPMugaas
  117. Moved some functions out of IdDNSCommon so we can use them elsewhere.
  118. Rev 1.0 2004.02.03 7:46:04 PM czhower
  119. New names
  120. Rev 1.43 1/31/2004 3:31:58 PM JPMugaas
  121. Removed some File System stuff for new package.
  122. Rev 1.42 1/31/2004 1:00:26 AM JPMugaas
  123. FileDateByName was changed to LocalFileDateByName as that uses the Local Time
  124. Zone.
  125. Added BMTDateByName for some GMT-based stuff.
  126. We now use the IdFileSystem*.pas units instead of SysUtils for directory
  127. functions. This should remove a dependancy on platform specific things in
  128. DotNET.
  129. Rev 1.41 1/29/2004 6:22:22 AM JPMugaas
  130. IndyComputerName will now use Environment.MachineName in DotNET. This should
  131. fix the ESMTP bug where IndyComputerName would return nothing causing an EHLO
  132. and HELO command to fail in TIdSMTP under DotNET.
  133. Rev 1.40 2004.01.22 5:58:56 PM czhower
  134. IdCriticalSection
  135. Rev 1.39 14/01/2004 00:16:10 CCostelloe
  136. Updated to remove deprecated warnings by using
  137. TextIsSame/IndyLowerCase/IndyUpperCase
  138. Rev 1.38 2003.12.28 6:50:30 PM czhower
  139. Update for Ticks function
  140. Rev 1.37 4/12/2003 10:24:06 PM GGrieve
  141. Fix to Compile
  142. Rev 1.36 11/29/2003 12:19:50 AM JPMugaas
  143. CompareDateTime added for more accurate DateTime comparisons. Sometimes
  144. comparing two floating point values for equality will fail because they are
  145. of different percision and some fractions such as 1/3 and pi (7/22) can never
  146. be calculated 100% accurately.
  147. Rev 1.35 25/11/2003 12:24:20 PM SGrobety
  148. various IdStream fixes with ReadLn/D6
  149. Rev 1.34 10/16/2003 11:18:10 PM DSiders
  150. Added localization comments.
  151. Corrected spelling error in coimments.
  152. Rev 1.33 10/15/2003 9:53:58 PM GGrieve
  153. Add TIdInterfacedObject
  154. Rev 1.32 10/10/2003 10:52:12 PM BGooijen
  155. Removed IdHexDigits
  156. Rev 1.31 10/8/2003 9:52:40 PM GGrieve
  157. reintroduce GetSystemLocale as IdGetDefaultCharSet
  158. Rev 1.30 10/8/2003 2:25:40 PM GGrieve
  159. Update ROL and ROR for DotNet
  160. Rev 1.29 10/5/2003 11:43:32 PM GGrieve
  161. Add IsLeadChar
  162. Rev 1.28 10/5/2003 5:00:10 PM GGrieve
  163. GetComputerName (once was IndyGetHostName)
  164. Rev 1.27 10/4/2003 9:14:26 PM GGrieve
  165. Remove TIdCardinalBytes - replace with other methods
  166. Rev 1.26 10/3/2003 11:55:50 PM GGrieve
  167. First full DotNet version
  168. Rev 1.25 10/3/2003 5:39:30 PM GGrieve
  169. dotnet work
  170. Rev 1.24 2003.10.02 10:52:48 PM czhower
  171. .Net
  172. Rev 1.23 2003.10.02 9:27:50 PM czhower
  173. DotNet Excludes
  174. Rev 1.22 9/18/2003 07:41:46 PM JPMugaas
  175. Moved GetThreadHandle to IdCoreGlobal.
  176. Rev 1.21 9/10/2003 03:26:42 AM JPMugaas
  177. Added EnsureMsgIDBrackets() function. Checked in on behalf of Remy Lebeau
  178. Rev 1.20 6/27/2003 05:53:28 AM JPMugaas
  179. Removed IsNumeric. That's now in IdCoreGlobal.
  180. Rev 1.19 2003.06.23 2:57:18 PM czhower
  181. Comments added
  182. Rev 1.18 2003.06.23 9:46:54 AM czhower
  183. Russian, Ukranian support for headers.
  184. Rev 1.17 2003.06.13 2:24:40 PM czhower
  185. Expanded TIdCardinalBytes
  186. Rev 1.16 5/13/2003 12:45:50 PM JPMugaas
  187. GetClockValue added for unique clock values.
  188. Rev 1.15 5/8/2003 08:43:14 PM JPMugaas
  189. Function for finding an integer's position in an array of integers. This is
  190. required by some SASL code.
  191. Rev 1.14 4/21/2003 7:52:58 PM BGooijen
  192. other nt version detection, removed non-existing windows versions
  193. Rev 1.13 4/18/2003 09:28:24 PM JPMugaas
  194. Changed Win32 Operating System detection so it can distinguish between
  195. workstation OS NT versions and server versions. I also added specific
  196. detection for Windows NT 4.0 with a Service Pack below 6 (requested by Bas).
  197. Rev 1.12 2003.04.16 10:06:22 PM czhower
  198. Moved DebugOutput to IdCoreGlobal
  199. Rev 1.11 4/10/2003 02:54:32 PM JPMugaas
  200. Improvement for FTP STOU command. Unique filename now uses
  201. IdGlobal.GetUniqueFileName instead of Rand. I also fixed GetUniqueFileName
  202. so that it can accept an empty path specification.
  203. Rev 1.10 4/5/2003 10:39:06 PM BGooijen
  204. LAM,LPM were not initialized
  205. Rev 1.9 4/5/2003 04:12:00 AM JPMugaas
  206. Date Time should now be able to process AM/PM.
  207. Rev 1.8 4/4/2003 11:02:56 AM JPMugaas
  208. Added GetUniqueFileName for the Virtual FTP File System component.
  209. Rev 1.7 20/3/2003 19:15:46 GGrieve
  210. Fix GMTToLocalDateTime for empty content
  211. Rev 1.6 3/9/2003 04:34:40 PM JPMugaas
  212. FileDateByName now works on directories.
  213. Rev 1.5 2/14/2003 11:50:58 AM JPMugaas
  214. Removed a function for giving an OS identifier in the FTP server because we
  215. no longer use that function.
  216. Rev 1.4 1/27/2003 12:30:22 AM JPMugaas
  217. Forgot to add a space after one OS type. That makes the job a little easier
  218. for the FTP Server SYST command handler.
  219. Rev 1.3 1/26/2003 11:56:30 PM JPMugaas
  220. Added function for returning an OS descriptor for combining with a FTP Server
  221. SysDescription for the SYST command reply. This can also optionally return
  222. the true system identifier.
  223. Rev 1.2 1/9/2003 05:39:08 PM JPMugaas
  224. Added workaround for if the date is missing a space after a comma.
  225. Rev 1.1 12/29/2002 2:13:14 PM JPMugaas
  226. Moved THandle to IdCoreGlobal for new function used in the core.
  227. Rev 1.0 11/13/2002 08:29:32 AM JPMugaas
  228. Initial import from FTP VC.
  229. }
  230. unit IdGlobalProtocols;
  231. interface
  232. {$i IdCompilerDefines.inc}
  233. uses
  234. Classes,
  235. {$IFDEF WINDOWS}
  236. Windows,
  237. {$ENDIF}
  238. IdCharsets,
  239. IdGlobal,
  240. IdException,
  241. SysUtils;
  242. const
  243. LWS = TAB + CHAR32;
  244. // TODO: get rid of these and use the ones in the IdGlobal unit
  245. wdays: array[1..7] of string =
  246. ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'); {do not localize}
  247. monthnames: array[1..12] of string =
  248. ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); {do not localize}
  249. type
  250. //WinCE only has Unicode functions for files.
  251. {$IFDEF WINCE}
  252. TIdFileName = TIdUnicodeString;
  253. PIdFileNameChar = PWideChar;
  254. {$ELSE}
  255. TIdFileName = String;
  256. PIdFileNameChar = PChar;
  257. {$ENDIF}
  258. TIdReadLnFunction = function: string of object;
  259. TStringEvent = procedure(ASender: TComponent; const AString: String);
  260. TIdMimeTable = class(TObject)
  261. protected
  262. FLoadTypesFromOS: Boolean;
  263. FOnBuildCache: TNotifyEvent;
  264. FMIMEList: TStrings;
  265. FFileExt: TStrings;
  266. procedure BuildDefaultCache; virtual;
  267. public
  268. property LoadTypesFromOS: Boolean read FLoadTypesFromOS write FLoadTypesFromOS;
  269. procedure BuildCache; virtual;
  270. procedure AddMimeType(const Ext, MIMEType: string; const ARaiseOnError: Boolean = True);
  271. function GetFileMIMEType(const AFileName: string): string;
  272. function GetDefaultFileExt(const MIMEType: string): string;
  273. procedure LoadFromStrings(const AStrings: TStrings; const MimeSeparator: Char = '='); {Do not Localize}
  274. procedure SaveToStrings(const AStrings: TStrings; const MimeSeparator: Char = '='); {Do not Localize}
  275. constructor Create(const AutoFill: Boolean = True); reintroduce; virtual;
  276. destructor Destroy; override;
  277. //
  278. property OnBuildCache: TNotifyEvent read FOnBuildCache write FOnBuildCache;
  279. end;
  280. {$UNDEF INTF_USES_STDCALL}
  281. {$IFDEF DCC}
  282. {$DEFINE INTF_USES_STDCALL}
  283. {$ELSE}
  284. {$IFDEF WINDOWS}
  285. {$DEFINE INTF_USES_STDCALL}
  286. {$ENDIF}
  287. {$ENDIF}
  288. TIdInterfacedObject = class (TInterfacedObject)
  289. public
  290. function _AddRef: {$IFDEF FPC}Longint{$ELSE}Integer{$ENDIF}; {$IFDEF INTF_USES_STDCALL}stdcall{$ELSE}cdecl{$ENDIF};
  291. function _Release: {$IFDEF FPC}Longint{$ELSE}Integer{$ENDIF}; {$IFDEF INTF_USES_STDCALL}stdcall{$ELSE}cdecl{$ENDIF};
  292. end;
  293. TIdHeaderQuotingType = (QuotePlain, QuoteRFC822, QuoteMIME, QuoteHTTP);
  294. //
  295. EIdExtensionAlreadyExists = class(EIdException);
  296. // Procs - KEEP THESE ALPHABETICAL!!!!!
  297. // procedure BuildMIMETypeMap(dest: TIdStringList);
  298. // TODO: IdStrings have optimized SplitColumns* functions, can we remove it?
  299. function ABNFToText(const AText : String) : String;
  300. function BinStrToInt(const ABinary: String): Integer;
  301. function BreakApart(BaseString, BreakString: string; StringList: TStrings): TStrings;
  302. function UInt32ToFourChar(AValue : UInt32): string;
  303. function LongWordToFourChar(AValue : UInt32): string; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use UInt32ToFourChar()'{$ENDIF};{$ENDIF}
  304. function CharRange(const AMin, AMax : Char): String;
  305. procedure CommaSeparatedToStringList(AList: TStrings; const Value:string);
  306. function CompareDateTime(const ADateTime1, ADateTime2 : TDateTime) : Integer;
  307. function ContentTypeToEncoding(const AContentType: string; AQuoteType: TIdHeaderQuotingType): IIdTextEncoding;
  308. function CharsetToEncoding(const ACharset: string): IIdTextEncoding;
  309. function ReadStringAsContentType(AStream: TStream; const AContentType: String;
  310. AQuoteType: TIdHeaderQuotingType
  311. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}): String;
  312. procedure ReadStringsAsContentType(AStream: TStream; AStrings: TStrings;
  313. const AContentType: String; AQuoteType: TIdHeaderQuotingType
  314. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF});
  315. procedure WriteStringAsContentType(AStream: TStream; const AStr, AContentType: String;
  316. AQuoteType: TIdHeaderQuotingType
  317. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF});
  318. procedure WriteStringsAsContentType(AStream: TStream; const AStrings: TStrings;
  319. const AContentType: String; AQuoteType: TIdHeaderQuotingType
  320. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF});
  321. procedure WriteStringAsCharset(AStream: TStream; const AStr, ACharset: string
  322. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF});
  323. procedure WriteStringsAsCharset(AStream: TStream; const AStrings: TStrings;
  324. const ACharset: string
  325. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF});
  326. function ReadStringAsCharset(AStream: TStream; const ACharset: String
  327. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}): String;
  328. procedure ReadStringsAsCharset(AStream: TStream; AStrings: TStrings; const ACharset: string
  329. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF});
  330. {
  331. These are for handling binary values that are in Network Byte order. They call
  332. ntohs, ntols, htons, and htons which are required by SNTP and FSP
  333. (probably some other protocols). They aren't aren't in IdGlobals because that
  334. doesn't refer to IdStack so you can't use GStack there.
  335. }
  336. procedure CopyBytesToHostUInt32(const ASource : TIdBytes; const ASourceIndex: Integer; var VDest : UInt32);
  337. procedure CopyBytesToHostUInt16(const ASource : TIdBytes; const ASourceIndex: Integer; var VDest : UInt16);
  338. procedure CopyTIdNetworkUInt32(const ASource: UInt32; var VDest: TIdBytes; const ADestIndex: Integer);
  339. procedure CopyTIdNetworkUInt16(const ASource: UInt16; var VDest: TIdBytes; const ADestIndex: Integer);
  340. procedure CopyBytesToHostLongWord(const ASource : TIdBytes; const ASourceIndex: Integer; var VDest : UInt32); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use CopyBytesToHostUInt32'{$ENDIF};{$ENDIF}
  341. procedure CopyBytesToHostWord(const ASource : TIdBytes; const ASourceIndex: Integer; var VDest : UInt16); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use CopyBytesToHostWord'{$ENDIF};{$ENDIF}
  342. procedure CopyTIdNetworkLongWord(const ASource: UInt32; var VDest: TIdBytes; const ADestIndex: Integer); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use CopyTIdNetworkLongWord'{$ENDIF};{$ENDIF}
  343. procedure CopyTIdNetworkWord(const ASource: UInt16; var VDest: TIdBytes; const ADestIndex: Integer); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use CopyTIdNetworkWord'{$ENDIF};{$ENDIF}
  344. function CopyFileTo(const Source, Destination: TIdFileName): Boolean;
  345. function DomainName(const AHost: String): String;
  346. function EnsureMsgIDBrackets(const AMsgID: String): String;
  347. function ExtractHeaderItem(const AHeaderLine: String): String;
  348. function ExtractHeaderSubItem(const AHeaderLine, ASubItem: String; AQuoteType: TIdHeaderQuotingType): String;
  349. function ReplaceHeaderSubItem(const AHeaderLine, ASubItem, AValue: String; AQuoteType: TIdHeaderQuotingType): String; overload;
  350. function ReplaceHeaderSubItem(const AHeaderLine, ASubItem, AValue: String; var VOld: String; AQuoteType: TIdHeaderQuotingType): String; overload;
  351. function IsHeaderMediaType(const AHeaderLine, AMediaType: String): Boolean;
  352. function IsHeaderMediaTypes(const AHeaderLine: String; const AMediaTypes: array of String): Boolean;
  353. function ExtractHeaderMediaType(const AHeaderLine: String): String;
  354. function ExtractHeaderMediaSubType(const AHeaderLine: String): String;
  355. function IsHeaderValue(const AHeaderLine: String; const AValue: String): Boolean; overload;
  356. function IsHeaderValue(const AHeaderLine: String; const AValues: array of String): Boolean; overload;
  357. function FileSizeByName(const AFilename: TIdFileName): Int64;
  358. {$IFDEF WINDOWS}
  359. function IsVolume(const APathName : TIdFileName) : Boolean;
  360. {$ENDIF}
  361. //MLIST FTP DateTime conversion functions
  362. function FTPMLSToGMTDateTime(const ATimeStamp : String):TDateTime;
  363. function FTPMLSToLocalDateTime(const ATimeStamp : String):TDateTime;
  364. function FTPGMTDateTimeToMLS(const ATimeStamp : TDateTime; const AIncludeMSecs : Boolean=True): String;
  365. function FTPLocalDateTimeToMLS(const ATimeStamp : TDateTime; const AIncludeMSecs : Boolean=True): String;
  366. function GetClockValue : Int64;
  367. function GetMIMETypeFromFile(const AFile: TIdFileName): string;
  368. function GetMIMEDefaultFileExt(const MIMEType: string): TIdFileName;
  369. function GetGMTDateByName(const AFileName : TIdFileName) : TDateTime;
  370. function GetGMTOffsetStr(const S: string): string;
  371. function GmtOffsetStrToDateTime(const S: string): TDateTime;
  372. function GMTToLocalDateTime(S: string): TDateTime;
  373. function CookieStrToLocalDateTime(S: string): TDateTime;
  374. function IdGetDefaultCharSet : TIdCharSet;
  375. function IntToBin(Value: UInt32): string;
  376. function IndyComputerName : String; // DotNet: see comments regarding GDotNetComputerName below
  377. function IndyCurrentYear : Integer;
  378. function IndyStrToBool(const AString: String): Boolean;
  379. function IsDomain(const S: String): Boolean;
  380. function IsFQDN(const S: String): Boolean;
  381. function IsBinary(const AChar : Char) : Boolean;
  382. function IsHex(const AChar : Char) : Boolean;
  383. function IsHostname(const S: String): Boolean;
  384. {$IFDEF STRING_IS_ANSI}
  385. function IsLeadChar(ACh : Char): Boolean;
  386. {$ENDIF}
  387. function IsTopDomain(const AStr: string): Boolean;
  388. function IsValidIP(const S: String): Boolean;
  389. function MakeTempFilename(const APath: TIdFileName = ''): TIdFileName;
  390. function OrdFourByteToUInt32(AByte1, AByte2, AByte3, AByte4 : Byte): UInt32;
  391. function OrdFourByteToLongWord(AByte1, AByte2, AByte3, AByte4 : Byte): UInt32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use OrdFourByteToUInt32()'{$ENDIF};{$ENDIF}
  392. procedure UInt32ToOrdFourByte(const AValue: UInt32; var VByte1, VByte2, VByte3, VByte4 : Byte);
  393. procedure LongWordToOrdFourByte(const AValue: UInt32; var VByte1, VByte2, VByte3, VByte4 : Byte); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use UInt32ToOrdFourByte()'{$ENDIF};{$ENDIF}
  394. function PadString(const AString : String; const ALen : Integer; const AChar: Char): String;
  395. function UnquotedStr(const AStr : String): String;
  396. function ProcessPath(const ABasePath: String; const APath: String; const APathDelim: string = '/'): string; {Do not Localize}
  397. function RightStr(const AStr: String; const Len: Integer): String;
  398. // still to figure out how to reproduce these under .Net
  399. // TODO: deprecate these, as Indy does not use them at all...
  400. function ROL(const AVal: UInt32; AShift: Byte): UInt32;
  401. function ROR(const AVal: UInt32; AShift: Byte): UInt32;
  402. function RPos(const ASub, AIn: String; AStart: Integer = -1): Integer;
  403. function IndySetLocalTime(Value: TDateTime): Boolean;
  404. function StartsWith(const ANSIStr, APattern : String) : Boolean;
  405. function StrInternetToDateTime(Value: string): TDateTime;
  406. function StrToDay(const ADay: string): Byte;
  407. function StrToMonth(const AMonth: string): Byte;
  408. function StrToWord(const Value: String): Word;
  409. function TimeZoneBias: TDateTime; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IdGlobal.LocalTimeToUTCTime() or IdGlobal.UTCTimeToLocalTime()'{$ENDIF};{$ENDIF}
  410. //these are for FSP but may also help with MySQL
  411. function UnixDateTimeToDelphiDateTime(UnixDateTime: UInt32): TDateTime;
  412. function DateTimeToUnix(ADateTime: TDateTime): UInt32;
  413. function TwoCharToUInt16(AChar1, AChar2: Char): Word;
  414. function TwoCharToWord(AChar1, AChar2: Char): Word; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use TwoCharToUInt16()'{$ENDIF};{$ENDIF}
  415. function UpCaseFirst(const AStr: string): string;
  416. function UpCaseFirstWord(const AStr: string): string;
  417. function GetUniqueFileName(const APath, APrefix, AExt : String) : String;
  418. procedure UInt16ToTwoBytes(AWord : Word; ByteArray: TIdBytes; Index: integer);
  419. procedure WordToTwoBytes(AWord : Word; ByteArray: TIdBytes; Index: integer); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use UInt16ToTwoBytes()'{$ENDIF};{$ENDIF}
  420. function UInt16ToStr(const Value: Word): String;
  421. function WordToStr(const Value: Word): String; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use UInt16ToStr()'{$ENDIF};{$ENDIF}
  422. //moved here so I can IFDEF a DotNET ver. that uses StringBuilder
  423. function IndyWrapText(const ALine, ABreakStr, ABreakChars : string; MaxCol: Integer): string;
  424. //The following is for working on email headers and message part headers...
  425. function RemoveHeaderEntry(const AHeader, AEntry: string; AQuoteType: TIdHeaderQuotingType): string; overload;
  426. function RemoveHeaderEntry(const AHeader, AEntry: string; var VOld: String; AQuoteType: TIdHeaderQuotingType): string; overload;
  427. function RemoveHeaderEntries(const AHeader: string; const AEntries: array of string; AQuoteType: TIdHeaderQuotingType): string;
  428. {
  429. Three functions for easier manipulating of strings. Don't know of any
  430. system functions to perform these actions. If there aren't and someone
  431. can find an optimised way of performing then please implement...
  432. }
  433. function FindFirstOf(const AFind, AText: string; const ALength: Integer = -1; const AStartPos: Integer = 1): Integer;
  434. function FindFirstNotOf(const AFind, AText: string; const ALength: Integer = -1; const AStartPos: Integer = 1): Integer;
  435. function TrimAllOf(const ATrim, AText: string): string;
  436. procedure ParseMetaHTTPEquiv(AStream: TStream; AHeaders : TStrings; var VCharSet: string);
  437. type
  438. TIdEncodingNeededEvent = function(const ACharset: String): IIdTextEncoding;
  439. var
  440. {$IFDEF UNIX}
  441. // For linux the user needs to set these variables to be accurate where used (mail, etc)
  442. GIdDefaultCharSet : TIdCharSet = idcs_ISO_8859_1; // idcsISO_8859_1;
  443. {$ENDIF}
  444. GIdEncodingNeeded: TIdEncodingNeededEvent = nil;
  445. IndyFalseBoolStrs : array of String;
  446. IndyTrueBoolStrs : array of String;
  447. //This is from: http://www.swissdelphicenter.ch/en/showcode.php?id=844
  448. const
  449. // Sets UnixStartDate to TIdDateTime of 01/01/1970
  450. UNIXSTARTDATE : TDateTime = 25569.0;
  451. {This indicates that the default date is Jan 1, 1900 which was specified
  452. by RFC 868.}
  453. TIME_BASEDATE = 2;
  454. //These are moved here to facilitate inlining
  455. const
  456. HexNumbers = '01234567890ABCDEF'; {Do not Localize}
  457. BinNumbers = '01'; {Do not localize}
  458. implementation
  459. uses
  460. {$IFDEF USE_VCL_POSIX}
  461. {$IFDEF OSX}
  462. Macapi.CoreServices,
  463. {$ENDIF}
  464. {$ENDIF}
  465. {$IFDEF UNIX}
  466. {$IFDEF USE_VCL_POSIX}
  467. Posix.SysStat, Posix.SysTime, Posix.Time, Posix.Unistd,
  468. {$ELSE}
  469. {$IFDEF KYLIXCOMPAT}
  470. Libc,
  471. {$ELSE}
  472. {$IFDEF USE_BASEUNIX}
  473. BaseUnix, Unix,
  474. {$ENDIF}
  475. {$ENDIF}
  476. {$ENDIF}
  477. {$ENDIF}
  478. {$IFDEF HAS_UNIT_DateUtils}
  479. DateUtils,
  480. {$ENDIF}
  481. {$IFDEF WINDOWS}
  482. Messages,
  483. Registry,
  484. {$ENDIF}
  485. {$IFDEF DOTNET}
  486. System.IO,
  487. System.Text,
  488. {$ENDIF}
  489. IdResourceStringsProtocols,
  490. IdStack
  491. {$IFDEF HAS_IOUtils_TPath}
  492. {$IFDEF VCL_XE2_OR_ABOVE}
  493. , System.IOUtils
  494. {$ELSE}
  495. , IOUtils
  496. {$ENDIF}
  497. {$ENDIF}
  498. {$IFDEF USE_OBJECT_ARC}
  499. {$IFDEF HAS_UNIT_Generics_Collections}
  500. , System.Generics.Collections
  501. {$ENDIF}
  502. {$ENDIF}
  503. ;
  504. //
  505. function UnquotedStr(const AStr : String): String;
  506. begin
  507. Result := AStr;
  508. if TextStartsWith(Result, '"') then begin
  509. IdDelete(Result, 1, 1);
  510. Result := Fetch(Result, '"');
  511. end;
  512. end;
  513. {This is taken from Borland's SysUtils and modified for our folding} {Do not Localize}
  514. function IndyWrapText(const ALine, ABreakStr, ABreakChars : string; MaxCol: Integer): string;
  515. const
  516. QuoteChars = '"'; {Do not Localize}
  517. var
  518. LCol, LPos: Integer;
  519. LLinePos, LLineLen: Integer;
  520. LBreakLen, LBreakPos: Integer;
  521. LQuoteChar, LCurChar: Char;
  522. LExistingBreak: Boolean;
  523. begin
  524. LCol := 1;
  525. LPos := 1;
  526. LLinePos := 1;
  527. LBreakPos := 0;
  528. LQuoteChar := ' '; {Do not Localize}
  529. LExistingBreak := False;
  530. LLineLen := Length(ALine);
  531. LBreakLen := Length(ABreakStr);
  532. Result := ''; {Do not Localize}
  533. while LPos <= LLineLen do begin
  534. LCurChar := ALine[LPos];
  535. {$IFDEF STRING_IS_ANSI}
  536. if IsLeadChar(LCurChar) then begin
  537. Inc(LPos);
  538. Inc(LCol);
  539. end else begin //if CurChar in LeadBytes then
  540. {$ENDIF}
  541. if LCurChar = ABreakStr[1] then begin
  542. if LQuoteChar = ' ' then begin {Do not Localize}
  543. LExistingBreak := TextIsSame(ABreakStr, Copy(ALine, LPos, LBreakLen));
  544. if LExistingBreak then begin
  545. Inc(LPos, LBreakLen-1);
  546. LBreakPos := LPos;
  547. end; //if ExistingBreak then
  548. end // if QuoteChar = ' ' then {Do not Localize}
  549. end else begin// if CurChar = BreakStr[1] then
  550. if CharIsInSet(LCurChar, 1, ABreakChars) then begin
  551. if LQuoteChar = ' ' then begin {Do not Localize}
  552. LBreakPos := LPos;
  553. end;
  554. end else begin // if CurChar in BreakChars then
  555. if CharIsInSet(LCurChar, 1, QuoteChars) then begin
  556. if LCurChar = LQuoteChar then begin
  557. LQuoteChar := ' '; {Do not Localize}
  558. end else begin
  559. if LQuoteChar = ' ' then begin {Do not Localize}
  560. LQuoteChar := LCurChar;
  561. end;
  562. end;
  563. end;
  564. end;
  565. end;
  566. {$IFDEF STRING_IS_ANSI}
  567. end;
  568. {$ENDIF}
  569. Inc(LPos);
  570. Inc(LCol);
  571. if not (CharIsInSet(LQuoteChar, 1, QuoteChars)) and
  572. (LExistingBreak or
  573. ((LCol > MaxCol) and (LBreakPos > LLinePos))) then begin
  574. LCol := LPos - LBreakPos;
  575. Result := Result + Copy(ALine, LLinePos, LBreakPos - LLinePos + 1);
  576. if not (CharIsInSet(LCurChar, 1, QuoteChars)) then begin
  577. while (LPos <= LLineLen) and (CharIsInSet(ALine, LPos, ABreakChars + #13+#10)) do begin
  578. Inc(LPos);
  579. end;
  580. if not LExistingBreak and (LPos < LLineLen) then begin
  581. Result := Result + ABreakStr;
  582. end;
  583. end;
  584. Inc(LBreakPos);
  585. LLinePos := LBreakPos;
  586. LExistingBreak := False;
  587. end; //if not
  588. end; //while Pos <= LineLen do
  589. Result := Result + Copy(ALine, LLinePos, MaxInt);
  590. end;
  591. function IndyCurrentYear : Integer;
  592. {$IFDEF HAS_CurrentYear}
  593. {$IFDEF USE_INLINE} inline; {$ENDIF}
  594. {$ELSE}
  595. var
  596. LYear, LMonth, LDay : Word;
  597. {$ENDIF}
  598. begin
  599. {$IFDEF HAS_CurrentYear}
  600. Result := CurrentYear;
  601. {$ELSE}
  602. DecodeDate(Now, LYear, LMonth, LDay);
  603. Result := LYear;
  604. {$ENDIF}
  605. end;
  606. function CharRange(const AMin, AMax : Char): String;
  607. var
  608. i : Char;
  609. {$IFDEF STRING_IS_IMMUTABLE}
  610. LSB : TIdStringBuilder;
  611. {$ENDIF}
  612. begin
  613. {$IFDEF STRING_IS_IMMUTABLE}
  614. LSB := TIdStringBuilder.Create(Ord(AMax) - Ord(AMin) + 1);
  615. for i := AMin to AMax do begin
  616. LSB.Append(i);
  617. end;
  618. Result := LSB.ToString;
  619. {$ELSE}
  620. SetLength(Result, Ord(AMax) - Ord(AMin) + 1);
  621. for i := AMin to AMax do begin
  622. Result[Ord(i) - Ord(AMin) + 1] := i;
  623. end;
  624. {$ENDIF}
  625. end;
  626. {$IFDEF WINDOWS}
  627. var
  628. GTempPath: TIdFileName;
  629. {$ENDIF}
  630. function StartsWith(const ANSIStr, APattern : String) : Boolean;
  631. {$IFDEF USE_INLINE} inline; {$ENDIF}
  632. begin
  633. Result := TextStartsWith(ANSIStr, APattern) {do not localize}
  634. //tentative fix for a problem with Korean indicated by "SungDong Kim" <[email protected]>
  635. {$IFNDEF DOTNET}
  636. //note that in DotNET, everything is MBCS
  637. and (ByteType(ANSIStr, 1) = mbSingleByte)
  638. {$ENDIF} ;
  639. //just in case someone is doing a recursive listing and there's a dir with the name total
  640. end;
  641. function UnixDateTimeToDelphiDateTime(UnixDateTime: UInt32): TDateTime;
  642. {$IFDEF USE_INLINE} inline; {$ENDIF}
  643. begin
  644. Result := (UnixDateTime / 86400) + UnixStartDate;
  645. {
  646. From: http://homepages.borland.com/efg2lab/Library/UseNet/1999/0309b.txt
  647. }
  648. // Result := EncodeDate(1970, 1, 1) + (UnixDateTime / 86400); {86400=No. of secs. per day}
  649. end;
  650. function DateTimeToUnix(ADateTime: TDateTime): UInt32;
  651. {$IFDEF USE_INLINE} inline; {$ENDIF}
  652. begin
  653. //example: DateTimeToUnix(now);
  654. Result := Round((ADateTime - UnixStartDate) * 86400);
  655. end;
  656. {$I IdDeprecatedImplBugOff.inc}
  657. procedure CopyBytesToHostWord(const ASource : TIdBytes; const ASourceIndex: Integer; var VDest : UInt16);
  658. {$I IdDeprecatedImplBugOn.inc}
  659. {$IFDEF USE_INLINE} inline; {$ENDIF}
  660. begin
  661. CopyBytesToHostUInt16(ASource, ASourceIndex, VDest);
  662. end;
  663. procedure CopyBytesToHostUInt16(const ASource : TIdBytes; const ASourceIndex: Integer; var VDest : UInt16);
  664. {$IFDEF USE_INLINE} inline; {$ENDIF}
  665. begin
  666. VDest := BytesToUInt16(ASource, ASourceIndex);
  667. VDest := GStack.NetworkToHost(VDest);
  668. end;
  669. {$I IdDeprecatedImplBugOff.inc}
  670. procedure CopyBytesToHostLongWord(const ASource : TIdBytes; const ASourceIndex: Integer; var VDest : UInt32);
  671. {$I IdDeprecatedImplBugOn.inc}
  672. {$IFDEF USE_INLINE} inline; {$ENDIF}
  673. begin
  674. CopyBytesToHostUInt32(ASource, ASourceIndex, VDest);
  675. end;
  676. procedure CopyBytesToHostUInt32(const ASource : TIdBytes; const ASourceIndex: Integer; var VDest : UInt32);
  677. {$IFDEF USE_INLINE} inline; {$ENDIF}
  678. begin
  679. VDest := BytesToUInt32(ASource, ASourceIndex);
  680. VDest := GStack.NetworkToHost(VDest);
  681. end;
  682. {$I IdDeprecatedImplBugOff.inc}
  683. procedure CopyTIdNetworkWord(const ASource: UInt16; var VDest: TIdBytes; const ADestIndex: Integer);
  684. {$I IdDeprecatedImplBugOn.inc}
  685. {$IFDEF USE_INLINE} inline; {$ENDIF}
  686. begin
  687. CopyTIdNetworkUInt16(ASource, VDest, ADestIndex);
  688. end;
  689. procedure CopyTIdNetworkUInt16(const ASource: UInt16; var VDest: TIdBytes; const ADestIndex: Integer);
  690. {$IFDEF USE_INLINE} inline; {$ENDIF}
  691. begin
  692. CopyTIdUInt16(GStack.HostToNetwork(ASource),VDest,ADestIndex);
  693. end;
  694. {$I IdDeprecatedImplBugOff.inc}
  695. procedure CopyTIdNetworkLongWord(const ASource: UInt32; var VDest: TIdBytes; const ADestIndex: Integer);
  696. {$I IdDeprecatedImplBugOn.inc}
  697. {$IFDEF USE_INLINE} inline; {$ENDIF}
  698. begin
  699. CopyTIdNetworkUInt32(ASource, VDest, ADestIndex);
  700. end;
  701. procedure CopyTIdNetworkUInt32(const ASource: UInt32; var VDest: TIdBytes; const ADestIndex: Integer);
  702. {$IFDEF USE_INLINE} inline; {$ENDIF}
  703. begin
  704. CopyTIdUInt32(GStack.HostToNetwork(ASource),VDest,ADestIndex);
  705. end;
  706. function UInt32ToFourChar(AValue : UInt32): string;
  707. {$IFDEF USE_INLINE} inline; {$ENDIF}
  708. begin
  709. Result := BytesToStringRaw(ToBytes(AValue));
  710. end;
  711. {$I IdDeprecatedImplBugOff.inc}
  712. function LongWordToFourChar(AValue : UInt32): string;
  713. {$I IdDeprecatedImplBugOn.inc}
  714. {$IFDEF USE_INLINE} inline; {$ENDIF}
  715. begin
  716. Result := UInt32ToFourChar(AValue);
  717. end;
  718. procedure UInt16ToTwoBytes(AWord : Word; ByteArray: TIdBytes; Index: integer);
  719. {$IFDEF USE_INLINE} inline; {$ENDIF}
  720. begin
  721. //ByteArray[Index] := AWord div 256;
  722. //ByteArray[Index + 1] := AWord mod 256;
  723. ByteArray[Index + 1] := AWord div 256;
  724. ByteArray[Index] := AWord mod 256;
  725. end;
  726. {$I IdDeprecatedImplBugOff.inc}
  727. procedure WordToTwoBytes(AWord : Word; ByteArray: TIdBytes; Index: integer);
  728. {$I IdDeprecatedImplBugOn.inc}
  729. {$IFDEF USE_INLINE}inline;{$ENDIF}
  730. begin
  731. UInt16ToTwoBytes(AWord, ByteArray, Index);
  732. end;
  733. function StrToWord(const Value: String): Word;
  734. {$IFDEF USE_INLINE} inline; {$ENDIF}
  735. begin
  736. if Length(Value) > 1 then begin
  737. {$IFDEF STRING_IS_UNICODE}
  738. Result := TwoCharToUInt16(Value[1], Value[2]);
  739. {$ELSE}
  740. Result := PWord(Pointer(Value))^;
  741. {$ENDIF}
  742. end else begin
  743. Result := 0;
  744. end;
  745. end;
  746. function UInt16ToStr(const Value: Word): String;
  747. {$IFDEF USE_INLINE} inline; {$ENDIF}
  748. begin
  749. {$IFDEF STRING_IS_UNICODE}
  750. Result := BytesToStringRaw(ToBytes(Value));
  751. {$ELSE}
  752. SetLength(Result, SizeOf(Value));
  753. Move(Value, Result[1], SizeOf(Value));
  754. {$ENDIF}
  755. end;
  756. {$I IdDeprecatedImplBugOff.inc}
  757. function WordToStr(const Value: Word): String;
  758. {$I IdDeprecatedImplBugOn.inc}
  759. {$IFDEF USE_INLINE} inline; {$ENDIF}
  760. begin
  761. Result := UInt16ToStr(Value);
  762. end;
  763. function OrdFourByteToUInt32(AByte1, AByte2, AByte3, AByte4 : Byte): UInt32;
  764. {$IFDEF USE_INLINE} inline; {$ENDIF}
  765. var
  766. LValue: TIdBytes;
  767. begin
  768. SetLength(LValue, SizeOf(UInt32));
  769. LValue[0] := AByte1;
  770. LValue[1] := AByte2;
  771. LValue[2] := AByte3;
  772. LValue[3] := AByte4;
  773. Result := BytesToUInt32(LValue);
  774. end;
  775. {$I IdDeprecatedImplBugOff.inc}
  776. function OrdFourByteToLongWord(AByte1, AByte2, AByte3, AByte4 : Byte): UInt32;
  777. {$I IdDeprecatedImplBugOn.inc}
  778. {$IFDEF USE_INLINE} inline; {$ENDIF}
  779. begin
  780. Result := OrdFourByteToUInt32(AByte1, AByte2, AByte3, AByte4);
  781. end;
  782. procedure UInt32ToOrdFourByte(const AValue: UInt32; var VByte1, VByte2, VByte3, VByte4 : Byte);
  783. {$IFDEF USE_INLINE} inline; {$ENDIF}
  784. var
  785. LValue: TIdBytes;
  786. begin
  787. LValue := ToBytes(AValue);
  788. VByte1 := LValue[0];
  789. VByte2 := LValue[1];
  790. VByte3 := LValue[2];
  791. VByte4 := LValue[3];
  792. end;
  793. {$I IdDeprecatedImplBugOff.inc}
  794. procedure LongWordToOrdFourByte(const AValue: UInt32; var VByte1, VByte2, VByte3, VByte4 : Byte);
  795. {$I IdDeprecatedImplBugOn.inc}
  796. {$IFDEF USE_INLINE} inline; {$ENDIF}
  797. begin
  798. UInt32ToOrdFourByte(AValue, VByte1, VByte2, VByte3, VByte4);
  799. end;
  800. function TwoCharToUInt16(AChar1, AChar2: Char): UInt16;
  801. //Since Replys are returned as Strings, we need a rountime to convert two
  802. // characters which are a 2 byte U Int into a two byte unsigned integer
  803. var
  804. LWord: TIdBytes;
  805. begin
  806. SetLength(LWord, SizeOf(UInt16));
  807. LWord[0] := Ord(AChar1);
  808. LWord[1] := Ord(AChar2);
  809. Result := BytesToUInt16(LWord);
  810. // Result := Word((Ord(AChar1) shl 8) and $FF00) or Word(Ord(AChar2) and $00FF);
  811. end;
  812. {$I IdDeprecatedImplBugOff.inc}
  813. function TwoCharToWord(AChar1, AChar2: Char): Word;
  814. {$I IdDeprecatedImplBugOn.inc}
  815. {$IFDEF USE_INLINE}inline;{$ENDIF}
  816. begin
  817. Result := TwoCharToUInt16(AChar1, AChar2);
  818. end;
  819. function CompareDateTime(const ADateTime1, ADateTime2 : TDateTime) : Integer;
  820. var
  821. LYear1, LYear2 : Word;
  822. LMonth1, LMonth2 : Word;
  823. LDay1, LDay2 : Word;
  824. LHour1, LHour2 : Word;
  825. LMin1, LMin2 : Word;
  826. LSec1, LSec2 : Word;
  827. LMSec1, LMSec2 : Word;
  828. {
  829. The return value is less than 0 if ADateTime1 is less than ADateTime2,
  830. 0 if ADateTime1 equals ADateTime2, or
  831. greater than 0 if ADateTime1 is greater than ADateTime2.
  832. }
  833. begin
  834. DecodeDate(ADateTime1, LYear1, LMonth1, LDay1);
  835. DecodeDate(ADateTime2, LYear2, LMonth2, LDay2);
  836. // year
  837. Result := LYear1 - LYear2;
  838. if Result <> 0 then begin
  839. Exit;
  840. end;
  841. // month
  842. Result := LMonth1 - LMonth2;
  843. if Result <> 0 then begin
  844. Exit;
  845. end;
  846. // day
  847. Result := LDay1 - LDay2;
  848. if Result <> 0 then begin
  849. Exit;
  850. end;
  851. DecodeTime(ADateTime1, LHour1, LMin1, LSec1, LMSec1);
  852. DecodeTime(ADateTime2, LHour2, LMin2, LSec2, LMSec2);
  853. //hour
  854. Result := LHour1 - LHour2;
  855. if Result <> 0 then begin
  856. Exit;
  857. end;
  858. //minute
  859. Result := LMin1 - LMin2;
  860. if Result <> 0 then begin
  861. Exit;
  862. end;
  863. //second
  864. Result := LSec1 - LSec2;
  865. if Result <> 0 then begin
  866. Exit;
  867. end;
  868. //millasecond
  869. Result := LMSec1 - LMSec2;
  870. end;
  871. {This is an internal procedure so the StrInternetToDateTime and GMTToLocalDateTime can share common code}
  872. function RawStrInternetToDateTime(var Value: string; var VDateTime: TDateTime): Boolean;
  873. var
  874. i: Integer;
  875. Dt, Mo, Yr, Ho, Min, Sec, MSec: Word;
  876. sYear, sTime, sDelim: string;
  877. //flags for if AM/PM marker found
  878. LAM, LPM : Boolean;
  879. procedure ParseDayOfMonth;
  880. begin
  881. Dt := IndyStrToInt( Fetch(Value, sDelim), 1);
  882. Value := TrimLeft(Value);
  883. end;
  884. procedure ParseMonth;
  885. begin
  886. Mo := StrToMonth( Fetch (Value, sDelim) );
  887. Value := TrimLeft(Value);
  888. end;
  889. function ParseISO8601: Boolean;
  890. var
  891. S: String;
  892. Len, Offset, Found: Integer;
  893. begin
  894. Result := False;
  895. // TODO: implement logic from IdVCard.ParseISO8601DateAndOrTime() here and then remove that function
  896. {
  897. var
  898. LDate: TIdISO8601DateComps;
  899. LTime: TIdISO8601TimeComps;
  900. begin
  901. Result := ParseISO8601DateAndOrTime(Value, LDate, LTime);
  902. if Result then begin
  903. VDateTime := EncodeDate(LDate.Year, LDate.Month, LDate.Day) + EncodeTime(LTime.Hour, LTime.Min, LTime.Sec, LTime.MSec);
  904. Value := LTime.UTFOffset;
  905. end;
  906. end;
  907. }
  908. S := Value;
  909. Len := Length(S);
  910. if not IsNumeric(S, 4) then begin
  911. Exit;
  912. end;
  913. // defaults for omitted values
  914. Dt := 1;
  915. Mo := 1;
  916. Ho := 0;
  917. Min := 0;
  918. Sec := 0;
  919. MSec := 0;
  920. Yr := IndyStrToInt( Copy(S, 1, 4) );
  921. Offset := 5;
  922. if Offset <= Len then
  923. begin
  924. if (not CharEquals(S, Offset, '-')) or (not IsNumeric(S, 2, Offset+1)) then begin
  925. Exit;
  926. end;
  927. Mo := IndyStrToInt( Copy(S, Offset+1, 2) );
  928. Inc(Offset, 3);
  929. if Offset <= Len then
  930. begin
  931. if (not CharEquals(S, Offset, '-')) or {Do not Localize}
  932. (not IsNumeric(S, 2, Offset+1)) then
  933. begin
  934. Exit;
  935. end;
  936. Dt := IndyStrToInt( Copy(S, Offset+1, 2) );
  937. Inc(Offset, 3);
  938. if Offset <= Len then
  939. begin
  940. if (not CharEquals(S, Offset, 'T')) or {Do not Localize}
  941. (not IsNumeric(S, 2, Offset+1)) or
  942. (not CharEquals(S, Offset+3, ':')) then {Do not Localize}
  943. begin
  944. Exit;
  945. end;
  946. Ho := IndyStrToInt( Copy(S, Offset+1, 2) );
  947. Inc(Offset, 4);
  948. if not IsNumeric(S, 2, Offset) then begin
  949. Exit;
  950. end;
  951. Min := IndyStrToInt( Copy(S, Offset, 2) );
  952. Inc(Offset, 2);
  953. if Offset > Len then begin
  954. Exit;
  955. end;
  956. if CharEquals(S, Offset, ':') then {Do not Localize}
  957. begin
  958. if not IsNumeric(S, 2, Offset+1) then begin
  959. Exit;
  960. end;
  961. Sec := IndyStrToInt( Copy(S, Offset+1, 2) );
  962. Inc(Offset, 3);
  963. if Offset > Len then begin
  964. Exit;
  965. end;
  966. if CharEquals(S, Offset, '.') then {Do not Localize}
  967. begin
  968. Found := FindFirstNotOf('0123456789', S, -1, Offset+1); {Do not Localize}
  969. if Found = 0 then begin
  970. Exit;
  971. end;
  972. MSec := IndyStrToInt( Copy(S, Offset+1, Found-Offset-1) );
  973. Inc(Offset, Found-Offset+1);
  974. end;
  975. end;
  976. end;
  977. end;
  978. end;
  979. VDateTime := EncodeDate(Yr, Mo, Dt) + EncodeTime(Ho, Min, Sec, MSec);
  980. Value := Copy(S, Offset, MaxInt);
  981. Result := True;
  982. end;
  983. begin
  984. Result := False;
  985. VDateTime := 0.0;
  986. Value := Trim(Value);
  987. if Length(Value) = 0 then begin
  988. Exit;
  989. end;
  990. try
  991. // RLebeau: have noticed some HTTP servers deliver dates using ISO-8601
  992. // format even though this is in violation of the HTTP specs!
  993. if ParseISO8601 then begin
  994. Result := True;
  995. Exit;
  996. end;
  997. {Day of Week}
  998. if StrToDay(Copy(Value, 1, 3)) > 0 then begin
  999. //workaround in case a space is missing after the initial column
  1000. if CharEquals(Value, 4, ',') and (not CharEquals(Value, 5, ' ')) then begin
  1001. Insert(' ', Value, 5);
  1002. end;
  1003. Fetch(Value);
  1004. Value := TrimLeft(Value);
  1005. end;
  1006. // Workaround for some buggy web servers which use '-' to separate the date parts. {Do not Localize}
  1007. i := IndyPos('-', Value); {Do not Localize}
  1008. if (i > 1) and (i < IndyPos(' ', Value)) then begin {Do not Localize}
  1009. sDelim := '-'; {Do not Localize}
  1010. end else begin
  1011. sDelim := ' '; {Do not Localize}
  1012. end;
  1013. //workaround for improper dates such as 'Fri, Sep 7 2001' {Do not Localize}
  1014. //RFC 2822 states that they should be like 'Fri, 7 Sep 2001' {Do not Localize}
  1015. if StrToMonth(Fetch(Value, sDelim, False)) > 0 then begin
  1016. {Month}
  1017. ParseMonth;
  1018. {Day of Month}
  1019. ParseDayOfMonth;
  1020. end else begin
  1021. {Day of Month}
  1022. ParseDayOfMonth;
  1023. {Month}
  1024. ParseMonth;
  1025. end;
  1026. {Year}
  1027. // There is some strange date/time formats like
  1028. // DayOfWeek Month DayOfMonth Time Year
  1029. sYear := Fetch(Value);
  1030. Yr := IndyStrToInt(sYear, High(Word));
  1031. if Yr = High(Word) then begin // Is sTime valid Integer?
  1032. sTime := sYear;
  1033. sYear := Fetch(Value);
  1034. Value := TrimRight(sTime + ' ' + Value);
  1035. Yr := IndyStrToInt(sYear);
  1036. end;
  1037. // RLebeau: According to RFC 2822, Section 4.3:
  1038. //
  1039. // "Where a two or three digit year occurs in a date, the year is to be
  1040. // interpreted as follows: If a two digit year is encountered whose
  1041. // value is between 00 and 49, the year is interpreted by adding 2000,
  1042. // ending up with a value between 2000 and 2049. If a two digit year is
  1043. // encountered with a value between 50 and 99, or any three digit year
  1044. // is encountered, the year is interpreted by adding 1900."
  1045. if Length(sYear) = 2 then begin
  1046. if {(Yr >= 0) and} (Yr <= 49) then begin
  1047. Inc(Yr, 2000);
  1048. end
  1049. else if (Yr >= 50) and (Yr <= 99) then begin
  1050. Inc(Yr, 1900);
  1051. end;
  1052. end
  1053. else if Length(sYear) = 3 then begin
  1054. Inc(Yr, 1900);
  1055. end;
  1056. VDateTime := EncodeDate(Yr, Mo, Dt);
  1057. // SG 26/9/00: Changed so that ANY time format is accepted
  1058. if IndyPos('AM', Value) > 0 then begin{do not localize}
  1059. LAM := True;
  1060. LPM := False;
  1061. Value := Fetch(Value, 'AM'); {do not localize}
  1062. end
  1063. else if IndyPos('PM', Value) > 0 then begin {do not localize}
  1064. LAM := False;
  1065. LPM := True;
  1066. Value := Fetch(Value, 'PM'); {do not localize}
  1067. end else begin
  1068. LAM := False;
  1069. LPM := False;
  1070. end;
  1071. // RLebeau 03/04/2009: some countries use dot instead of colon
  1072. // for the time separator
  1073. i := IndyPos('.', Value); {do not localize}
  1074. if (i > 0) and (i < IndyPos(' ', Value)) then begin {do not localize}
  1075. sDelim := '.'; {do not localize}
  1076. end else begin
  1077. sDelim := ':'; {do not localize}
  1078. end;
  1079. i := IndyPos(sDelim, Value);
  1080. if i > 0 then begin
  1081. // Copy time string up until next space (before GMT offset)
  1082. sTime := Fetch(Value, ' '); {do not localize}
  1083. {Hour}
  1084. Ho := IndyStrToInt( Fetch(sTime, sDelim), 0);
  1085. {Minute}
  1086. Min := IndyStrToInt( Fetch(sTime, sDelim), 0);
  1087. {Second}
  1088. Sec := IndyStrToInt( Fetch(sTime), 0);
  1089. MSec := 0; // TODO
  1090. {AM/PM part if present}
  1091. Value := TrimLeft(Value);
  1092. if LAM then begin
  1093. if Ho = 12 then begin
  1094. Ho := 0;
  1095. end;
  1096. end
  1097. else if LPM then begin
  1098. //in the 12 hour format, afternoon is 12:00PM followed by 1:00PM
  1099. //while midnight is written as 12:00 AM
  1100. //Not exactly technically correct but pretty accurate
  1101. if Ho < 12 then begin
  1102. Inc(Ho, 12);
  1103. end;
  1104. end;
  1105. {The date and time stamp returned}
  1106. VDateTime := VDateTime + EncodeTime(Ho, Min, Sec, MSec);
  1107. end;
  1108. Value := TrimLeft(Value);
  1109. Result := True;
  1110. except
  1111. VDateTime := 0.0;
  1112. Result := False;
  1113. end;
  1114. end;
  1115. {This should never be localized}
  1116. function StrInternetToDateTime(Value: string): TDateTime;
  1117. begin
  1118. RawStrInternetToDateTime(Value, Result);
  1119. end;
  1120. function FTPMLSToGMTDateTime(const ATimeStamp : String):TDateTime;
  1121. var
  1122. LYear, LMonth, LDay, LHour, LMin, LSec, LMSec : Integer;
  1123. LBuffer : String;
  1124. begin
  1125. Result := 0;
  1126. LBuffer := ATimeStamp;
  1127. if LBuffer <> '' then begin
  1128. // 1234 56 78 90 12 34
  1129. // ---------- ---------
  1130. // 1998 11 07 08 52 15
  1131. LYear := IndyStrToInt( Copy( LBuffer,1,4),0);
  1132. LMonth := IndyStrToInt(Copy(LBuffer,5,2),0);
  1133. LDay := IndyStrToInt(Copy(LBuffer,7,2),0);
  1134. LHour := IndyStrToInt(Copy(LBuffer,9,2),0);
  1135. LMin := IndyStrToInt(Copy(LBuffer,11,2),0);
  1136. LSec := IndyStrToInt(Copy(LBuffer,13,2),0);
  1137. Fetch(LBuffer,'.');
  1138. LMSec := IndyStrToInt(LBuffer,0);
  1139. Result := EncodeDate(LYear,LMonth,LDay);
  1140. Result := Result + EncodeTime(LHour,LMin,LSec,LMSec);
  1141. end;
  1142. end;
  1143. function FTPMLSToLocalDateTime(const ATimeStamp : String):TDateTime;
  1144. {$IFDEF USE_INLINE} inline; {$ENDIF}
  1145. begin
  1146. Result := 0.0;
  1147. if ATimeStamp <> '' then begin
  1148. Result := FTPMLSToGMTDateTime(ATimeStamp);
  1149. // Apply local offset
  1150. Result := UTCTimeToLocalTime(Result);
  1151. end;
  1152. end;
  1153. function FTPGMTDateTimeToMLS(const ATimeStamp : TDateTime; const AIncludeMSecs : Boolean=True): String;
  1154. var
  1155. LYear, LMonth, LDay,
  1156. LHour, LMin, LSec, LMSec : Word;
  1157. begin
  1158. DecodeDate(ATimeStamp,LYear,LMonth,LDay);
  1159. DecodeTime(ATimeStamp,LHour,LMin,LSec,LMSec);
  1160. Result := IndyFormat('%4d%2d%2d%2d%2d%2d',[LYear,LMonth,LDay,LHour,LMin,LSec]);
  1161. if AIncludeMSecs then begin
  1162. if (LMSec <> 0) then begin
  1163. Result := Result + IndyFormat('.%3d',[LMSec]);
  1164. end;
  1165. end;
  1166. Result := ReplaceAll(Result, ' ', '0');
  1167. end;
  1168. {
  1169. Note that MS-DOS displays the time in the Local Time Zone - MLISx commands use
  1170. stamps based on GMT)
  1171. }
  1172. function FTPLocalDateTimeToMLS(const ATimeStamp : TDateTime; const AIncludeMSecs : Boolean=True): String;
  1173. {$IFDEF USE_INLINE} inline; {$ENDIF}
  1174. begin
  1175. Result := FTPGMTDateTimeToMLS(LocalTimeToUTCTime(ATimeStamp), AIncludeMSecs);
  1176. end;
  1177. function BreakApart(BaseString, BreakString: string; StringList: TStrings): TStrings;
  1178. var
  1179. EndOfCurrentString: integer;
  1180. begin
  1181. // TODO: use SplitDelimitedString() instead?
  1182. // SplitDelimitedString(BaseString, StringList, False, BreakString);
  1183. repeat
  1184. EndOfCurrentString := Pos(BreakString, BaseString);
  1185. if EndOfCurrentString = 0 then begin
  1186. StringList.Add(BaseString);
  1187. Break;
  1188. end;
  1189. StringList.Add(Copy(BaseString, 1, EndOfCurrentString - 1));
  1190. Delete(BaseString, 1, EndOfCurrentString + Length(BreakString) - 1); //Copy(BaseString, EndOfCurrentString + length(BreakString), length(BaseString) - EndOfCurrentString);
  1191. until False;
  1192. Result := StringList;
  1193. end;
  1194. procedure CommaSeparatedToStringList(AList: TStrings; const Value: string);
  1195. var
  1196. iStart,
  1197. iEnd,
  1198. iQuote,
  1199. iPos,
  1200. iLength : integer ;
  1201. sTemp : string ;
  1202. begin
  1203. iQuote := 0;
  1204. iPos := 1 ;
  1205. iLength := Length(Value);
  1206. AList.Clear ;
  1207. while iPos <= iLength do begin
  1208. iStart := iPos ;
  1209. iEnd := iStart ;
  1210. while iPos <= iLength do begin
  1211. if Value[iPos] = '"' then begin {do not localize}
  1212. Inc(iQuote);
  1213. end;
  1214. if Value[iPos] = ',' then begin {do not localize}
  1215. if iQuote <> 1 then begin
  1216. Break;
  1217. end;
  1218. end;
  1219. Inc(iEnd);
  1220. Inc(iPos);
  1221. end ;
  1222. sTemp := Trim(Copy(Value, iStart, iEnd - iStart));
  1223. if Length(sTemp) > 0 then begin
  1224. AList.Add(sTemp);
  1225. end;
  1226. iPos := iEnd + 1 ;
  1227. iQuote := 0 ;
  1228. end ;
  1229. end;
  1230. {$UNDEF NATIVEFILEAPI}
  1231. {$UNDEF NATIVECOPYAPI}
  1232. {$IFDEF DOTNET}
  1233. {$DEFINE NATIVEFILEAPI}
  1234. {$DEFINE NATIVECOPYAPI}
  1235. {$ENDIF}
  1236. {$IFDEF WINDOWS}
  1237. {$DEFINE NATIVEFILEAPI}
  1238. {$DEFINE NATIVECOPYAPI}
  1239. {$ENDIF}
  1240. {$IFDEF UNIX}
  1241. {$DEFINE NATIVEFILEAPI}
  1242. {$ENDIF}
  1243. function CopyFileTo(const Source, Destination: TIdFileName): Boolean;
  1244. {$IFDEF NATIVECOPYAPI}
  1245. {$IFDEF USE_INLINE}inline;{$ENDIF}
  1246. {$IFDEF WIN32_OR_WIN64}
  1247. var
  1248. LOldErrorMode : Integer;
  1249. {$ENDIF}
  1250. {$ELSE}
  1251. var
  1252. SourceF, DestF : File;
  1253. NumRead, NumWritten: Integer;
  1254. Buffer: array[1..2048] of Byte;
  1255. {$ENDIF}
  1256. begin
  1257. {$IFDEF DOTNET}
  1258. try
  1259. System.IO.File.Copy(Source, Destination, True);
  1260. Result := True; // or you'll get an exception
  1261. except
  1262. Result := False;
  1263. end;
  1264. {$ENDIF}
  1265. {$IFDEF WINDOWS}
  1266. {$IFDEF WIN32_OR_WIN64}
  1267. // TODO: use SetThreadErrorMode() instead, when available...
  1268. LOldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  1269. try
  1270. {$ENDIF}
  1271. Result := CopyFile(PIdFileNameChar(Source), PIdFileNameChar(Destination), False);
  1272. {$IFDEF WIN32_OR_WIN64}
  1273. finally
  1274. SetErrorMode(LOldErrorMode);
  1275. end;
  1276. {$ENDIF}
  1277. {$ENDIF}
  1278. {$IFNDEF NATIVECOPYAPI}
  1279. //mostly from http://delphi.about.com/od/fileio/a/untypedfiles.htm
  1280. //note that I do use the I+ and I- directive.
  1281. // decided not to use streams because some may not handle more than
  1282. // 2GB'sand it would run counter to the intent of this, return false
  1283. //on failure.
  1284. //This is intended to be generic because it may run in many different
  1285. //Operating systems
  1286. // -TODO: Change to use a Linux copy function
  1287. // There is no native Linux copy function (at least "cp" doesn't use one
  1288. // and I can't find one anywhere (Johannes Berg))
  1289. {$I IdIOChecksOff.inc}
  1290. Assign(SourceF, Source);
  1291. Reset(SourceF, 1);
  1292. Result := IOResult = 0;
  1293. if not Result then begin
  1294. Exit;
  1295. end;
  1296. Assign(DestF, Destination);
  1297. Rewrite(DestF, 1);
  1298. Result := IOResult = 0;
  1299. if Result then begin
  1300. repeat
  1301. BlockRead(SourceF, Buffer, SizeOf(Buffer), NumRead);
  1302. Result := IOResult = 0;
  1303. if (not Result) or (NumRead = 0) then begin
  1304. Break;
  1305. end;
  1306. BlockWrite(DestF, Buffer, NumRead, NumWritten);
  1307. Result := (IOResult = 0) and (NumWritten = NumRead);
  1308. until not Result;
  1309. Close(DestF);
  1310. end;
  1311. Close(SourceF);
  1312. // Restore IO checking
  1313. {$I IdIOChecksOn.inc}
  1314. {$ENDIF}
  1315. end;
  1316. {$IFDEF WINDOWS}
  1317. function TempPath: TIdFileName;
  1318. var
  1319. i: Integer;
  1320. begin
  1321. SetLength(Result, MAX_PATH);
  1322. i := GetTempPath(MAX_PATH, PIdFileNameChar(Result));
  1323. if i > 0 then begin
  1324. SetLength(Result, i);
  1325. Result := IndyIncludeTrailingPathDelimiter(Result);
  1326. end else begin
  1327. Result := '';
  1328. end;
  1329. end;
  1330. {$ENDIF}
  1331. function MakeTempFilename(const APath: TIdFileName = ''): TIdFileName;
  1332. {$IFNDEF FPC}
  1333. var
  1334. lPath: TIdFileName;
  1335. lExt: TIdFileName;
  1336. {$ENDIF}
  1337. begin
  1338. {$IFDEF FPC}
  1339. //Do not use Tempnam in Unix-like Operating systems. That function is dangerous
  1340. //and you will be warned about it when compiling. FreePascal has GetTempFileName. Use
  1341. //that instead.
  1342. Result := GetTempFileName(APath, 'Indy'); {Do not Localize}
  1343. {$ELSE}
  1344. // NOT using TPath.GetTempFileName() in Delphi 2010+, or System.IO.Path.GetTempFileName()
  1345. // on .NET. They force use of the system temp path instead of allowing APath, and they
  1346. // do not support custom file prefixes...
  1347. lPath := APath;
  1348. lExt := {$IFDEF UNIX}''{$ELSE}'.tmp'{$ENDIF}; {Do not Localize}
  1349. {$IFDEF WINDOWS}
  1350. if lPath = '' then begin
  1351. // TODO: query this dynamically, in case the user changes the path after this unit
  1352. // is initialized. This is the only spot where GTempPath is used...
  1353. lPath := GTempPath;
  1354. end;
  1355. {$ELSE}
  1356. {$IFDEF DOTNET}
  1357. if lPath = '' then begin
  1358. lPath := System.IO.Path.GetTempPath;
  1359. end;
  1360. {$ELSE}
  1361. {$IFDEF HAS_IOUtils_TPath}
  1362. if lPath = '' then begin
  1363. lPath := {$IFDEF VCL_XE2_OR_ABOVE}System.{$ENDIF}IOUtils.TPath.GetTempPath;
  1364. end;
  1365. {$ENDIF}
  1366. {$ENDIF}
  1367. {$ENDIF}
  1368. Result := GetUniqueFilename(lPath, 'Indy', lExt);
  1369. {$ENDIF}
  1370. end;
  1371. function GetUniqueFileName(const APath, APrefix, AExt : String) : String;
  1372. var
  1373. {$IFDEF FPC}
  1374. LPrefix: string;
  1375. {$ELSE}
  1376. LTicks : TIdTicks;
  1377. LNamePart : Int64;
  1378. LExt : String;
  1379. LFName: String;
  1380. {$ENDIF}
  1381. begin
  1382. {$IFDEF FPC}
  1383. //Do not use Tempnam in Unix-like Operating systems. That function is dangerous
  1384. //and you will be warned about it when compiling. FreePascal has GetTempFileName. Use
  1385. //that instead.
  1386. LPrefix := APrefix;
  1387. if LPrefix = '' then begin
  1388. LPrefix := 'Indy'; {Do not localize}
  1389. end;
  1390. Result := GetTempFileName(APath, LPrefix);
  1391. {$ELSE}
  1392. // NOT using TPath.GetTempFileName() in Delphi 2010+, or System.IO.Path.GetTempFileName()
  1393. // on .NET. They force use of the system temp path instead of allowing APath, and they
  1394. // do not support custom file prefixes...
  1395. // TODO: on Windows, use Winapi.GetTempFileName(), at least...
  1396. LExt := AExt;
  1397. // period is optional in the extension... force it
  1398. if LExt <> '' then begin
  1399. if LExt[1] <> '.' then begin
  1400. LExt := '.' + LExt;
  1401. end;
  1402. end;
  1403. // validate path and add path delimiter before file name prefix
  1404. if APath <> '' then begin
  1405. if not IndyDirectoryExists(APath) then begin
  1406. // TODO: fail with an error instead...
  1407. LFName := APrefix;
  1408. end else begin
  1409. // uses the Indy function... not the Borland one
  1410. LFName := IndyIncludeTrailingPathDelimiter(APath) + APrefix;
  1411. end;
  1412. end else begin
  1413. // TODO: without a starting path, we cannot check for file existance, so fail...
  1414. LFName := APrefix;
  1415. end;
  1416. // TODO: use a GUID instead of ticks on platforms that support that...
  1417. LTicks := Ticks64;
  1418. // RLebeau 6/20/2017: casting to TIdTicks to address a compiler bug in Delphi 7
  1419. if LTicks > TIdTicks(High(Int64)) then begin
  1420. LTicks := TIdTicks(High(Int64));
  1421. end;
  1422. LNamePart := Int64(LTicks);
  1423. repeat
  1424. Result := LFName + IntToHex(LNamePart, 8) + LExt;
  1425. if not FileExists(Result) then begin
  1426. Break;
  1427. end;
  1428. if LNamePart = High(Int64) then begin
  1429. LNamePart := 0; // wrap to zero, not negative
  1430. end else begin;
  1431. Inc(LNamePart);
  1432. end;
  1433. // TODO: if we wrap all the way back around to the starting value, fail with an error...
  1434. until False;
  1435. {$ENDIF}
  1436. end;
  1437. // Find a token given a direction (>= 0 from start; < 0 from end)
  1438. // S.G. 19/4/00:
  1439. // Changed to be more readable
  1440. // TODO: make this faster
  1441. function RPos(const ASub, AIn: String; AStart: Integer = -1): Integer;
  1442. var
  1443. i: Integer;
  1444. LStartPos: Integer;
  1445. LTokenLen: Integer;
  1446. begin
  1447. Result := 0;
  1448. LTokenLen := Length(ASub);
  1449. // Get starting position
  1450. if AStart < 0 then begin
  1451. AStart := Length(AIn);
  1452. end;
  1453. if AStart < (Length(AIn) - LTokenLen + 1) then begin
  1454. LStartPos := AStart;
  1455. end else begin
  1456. LStartPos := (Length(AIn) - LTokenLen + 1);
  1457. end;
  1458. // Search for the string
  1459. for i := LStartPos downto 1 do begin
  1460. // TODO: remove the need for Copy()
  1461. if TextIsSame(Copy(AIn, i, LTokenLen), ASub) then begin
  1462. Result := i;
  1463. Break;
  1464. end;
  1465. end;
  1466. end;
  1467. {$IFDEF WINDOWS}
  1468. function IsVolume(const APathName : TIdFileName) : Boolean;
  1469. {$IFDEF USE_INLINE}inline;{$ENDIF}
  1470. begin
  1471. Result := TextEndsWith(APathName, ':') or TextEndsWith(APathName, ':\');
  1472. end;
  1473. {$ENDIF}
  1474. // OS-independant version
  1475. function FileSizeByName(const AFilename: TIdFileName): Int64;
  1476. //Leave in for HTTP Server
  1477. {$IFDEF DOTNET}
  1478. var
  1479. LFile : System.IO.FileInfo;
  1480. {$ELSE}
  1481. {$IFDEF USE_INLINE} inline; {$ENDIF}
  1482. {$IFDEF WINDOWS}
  1483. var
  1484. LHandle : THandle;
  1485. LRec : TWin32FindData;
  1486. {$IFDEF WIN32_OR_WIN64}
  1487. LOldErrorMode : Integer;
  1488. {$ENDIF}
  1489. {$ENDIF}
  1490. {$IFDEF UNIX}
  1491. var
  1492. {$IFDEF USE_VCL_POSIX}
  1493. LRec : _Stat;
  1494. {$IFDEF USE_MARSHALLED_PTRS}
  1495. M: TMarshaller;
  1496. {$ENDIF}
  1497. {$ELSE}
  1498. {$IFDEF KYLIXCOMPAT}
  1499. LRec : TStatBuf;
  1500. {$ELSE}
  1501. LRec : TStat;
  1502. LU : time_t;
  1503. {$ENDIF}
  1504. {$ENDIF}
  1505. {$ENDIF}
  1506. {$IFNDEF NATIVEFILEAPI}
  1507. var
  1508. LStream: TIdReadFileExclusiveStream;
  1509. {$ENDIF}
  1510. {$ENDIF}
  1511. begin
  1512. {$IFDEF DOTNET}
  1513. Result := -1;
  1514. LFile := System.IO.FileInfo.Create(AFileName);
  1515. if LFile.Exists then begin
  1516. Result := LFile.Length;
  1517. end;
  1518. {$ENDIF}
  1519. {$IFDEF WINDOWS}
  1520. Result := -1;
  1521. //check to see if something like "a:\" is specified and fail in that case.
  1522. //FindFirstFile would probably succede even though a drive is not a proper
  1523. //file.
  1524. if not IsVolume(AFileName) then begin
  1525. {
  1526. IMPORTANT!!!
  1527. For servers in Windows, you probably want the API call to fail rather than
  1528. get a "Cancel Try Again Continue " dialog-box box if a drive is not
  1529. ready or there's some other critical I/O error.
  1530. }
  1531. {$IFDEF WIN32_OR_WIN64}
  1532. // TODO: use SetThreadErrorMode() instead, when available...
  1533. LOldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  1534. try
  1535. {$ENDIF}
  1536. // TODO: use GetFileAttributesEx(GetFileExInfoStandard) if available...
  1537. LHandle := Windows.FindFirstFile(PIdFileNameChar(AFileName), LRec);
  1538. if LHandle <> INVALID_HANDLE_VALUE then begin
  1539. Windows.FindClose(LHandle);
  1540. if (LRec.dwFileAttributes and Windows.FILE_ATTRIBUTE_DIRECTORY) = 0 then begin
  1541. // TODO: use ULARGE_INTEGER instead...
  1542. Result := (Int64(LRec.nFileSizeHigh) shl 32) + LRec.nFileSizeLow;
  1543. end;
  1544. end;
  1545. {$IFDEF WIN32_OR_WIN64}
  1546. finally
  1547. SetErrorMode(LOldErrorMode);
  1548. end;
  1549. {$ENDIF}
  1550. end;
  1551. {$ENDIF}
  1552. {$IFDEF UNIX}
  1553. Result := -1;
  1554. {$IFDEF USE_VCL_POSIX}
  1555. //This is messy with IFDEF's but I want to be able to handle 63 bit file sizes.
  1556. if stat(
  1557. {$IFDEF USE_MARSHALLED_PTRS}
  1558. M.AsAnsi(AFileName).ToPointer
  1559. {$ELSE}
  1560. PAnsiChar(
  1561. {$IFDEF STRING_IS_ANSI}
  1562. AFileName
  1563. {$ELSE}
  1564. AnsiString(AFileName) // explicit convert to Ansi
  1565. {$ENDIF}
  1566. )
  1567. {$ENDIF}
  1568. , LRec) = 0 then
  1569. begin
  1570. Result := LRec.st_size;
  1571. end;
  1572. {$ELSE}
  1573. //Note that we can use stat here because we are only looking at the date.
  1574. if {$IFDEF KYLIXCOMPAT}stat{$ELSE}fpstat{$ENDIF}(
  1575. PAnsiChar(
  1576. {$IFDEF STRING_IS_ANSI}
  1577. AFileName
  1578. {$ELSE}
  1579. AnsiString(AFileName) // explicit convert to Ansi
  1580. {$ENDIF}
  1581. ), LRec) = 0 then
  1582. begin
  1583. Result := LRec.st_Size;
  1584. end;
  1585. {$ENDIF}
  1586. {$ENDIF}
  1587. {$IFNDEF NATIVEFILEAPI}
  1588. Result := -1;
  1589. if FileExists(AFilename) then begin
  1590. // the other cases simply return -1 on error, so make sure to do the same here
  1591. try
  1592. // TODO: maybe use TIdReadFileNonExclusiveStream instead?
  1593. LStream := TIdReadFileExclusiveStream.Create(AFilename);
  1594. try
  1595. Result := LStream.Size;
  1596. finally
  1597. LStream.Free;
  1598. end;
  1599. except
  1600. end;
  1601. end;
  1602. {$ENDIF}
  1603. end;
  1604. function GetGMTDateByName(const AFileName : TIdFileName) : TDateTime;
  1605. {$IFDEF WINDOWS}
  1606. var
  1607. LRec : TWin32FindData;
  1608. LHandle : THandle;
  1609. LTime : {$IFDEF WINCE}TSystemTime{$ELSE}Integer{$ENDIF};
  1610. {$IFDEF WIN32_OR_WIN64}
  1611. LOldErrorMode : Integer;
  1612. {$ENDIF}
  1613. {$ELSE}
  1614. {$IFDEF UNIX}
  1615. var
  1616. LTime : Integer;
  1617. {$IFDEF USE_VCL_POSIX}
  1618. LRec : _Stat;
  1619. {$IFDEF USE_MARSHALLED_PTRS}
  1620. M: TMarshaller;
  1621. {$ENDIF}
  1622. {$ELSE}
  1623. {$IFDEF KYLIXCOMPAT}
  1624. LRec : TStatBuf;
  1625. LU : TUnixTime;
  1626. {$ELSE}
  1627. {$IFDEF USE_BASEUNIX}
  1628. LRec : TStat;
  1629. {$ENDIF}
  1630. {$ENDIF}
  1631. {$ENDIF}
  1632. {$ENDIF}
  1633. {$ENDIF}
  1634. begin
  1635. Result := -1;
  1636. {$IFDEF DOTNET}
  1637. if System.IO.File.Exists(AFileName) then begin
  1638. Result := System.IO.File.GetLastWriteTimeUtc(AFileName).ToOADate;
  1639. end;
  1640. {$ELSE}
  1641. {$IFDEF WINDOWS}
  1642. if not IsVolume(AFileName) then begin
  1643. {$IFDEF WIN32_OR_WIN64}
  1644. // TODO: use SetThreadErrorMode() instead, when available...
  1645. LOldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  1646. try
  1647. {$ENDIF}
  1648. // TODO: use GetFileAttributesEx() on systems that support it
  1649. LHandle := Windows.FindFirstFile(PIdFileNameChar(AFileName), LRec);
  1650. {$IFDEF WIN32_OR_WIN64}
  1651. finally
  1652. SetErrorMode(LOldErrorMode);
  1653. end;
  1654. {$ENDIF}
  1655. if LHandle <> INVALID_HANDLE_VALUE then begin
  1656. Windows.FindClose(LHandle);
  1657. {$IFDEF WINCE}
  1658. FileTimeToSystemTime(@LRec, @LTime);
  1659. Result := SystemTimeToDateTime(LTime);
  1660. {$ELSE}
  1661. FileTimeToDosDateTime(LRec.ftLastWriteTime, LongRec(LTime).Hi, LongRec(LTime).Lo);
  1662. Result := FileDateToDateTime(LTime);
  1663. {$ENDIF}
  1664. end;
  1665. end;
  1666. {$ELSE}
  1667. {$IFDEF UNIX}
  1668. //Note that we can use stat here because we are only looking at the date.
  1669. {$IFDEF USE_VCL_POSIX}
  1670. if stat(
  1671. {$IFDEF USE_MARSHALLED_PTRS}
  1672. M.AsAnsi(AFileName).ToPointer
  1673. {$ELSE}
  1674. PAnsiChar(
  1675. {$IFDEF STRING_IS_ANSI}
  1676. AFileName
  1677. {$ELSE}
  1678. AnsiString(AFileName) // explicit convert to Ansi
  1679. {$ENDIF}
  1680. )
  1681. {$ENDIF}
  1682. , LRec) = 0 then
  1683. begin
  1684. LTime := LRec.st_mtime;
  1685. Result := DateUtils.UnixToDateTime(LTime);
  1686. end;
  1687. {$ELSE}
  1688. {$IFDEF KYLIXCOMPAT}
  1689. if stat(PAnsiChar(AnsiString(AFileName)), LRec) = 0 then
  1690. begin
  1691. gmtime_r(@LTime, LU);
  1692. Result := EncodeDate(LU.tm_year + 1900, LU.tm_mon + 1, LU.tm_mday) +
  1693. EncodeTime(LU.tm_hour, LU.tm_min, LU.tm_sec, 0);
  1694. end;
  1695. {$ELSE}
  1696. {$IFDEF USE_BASEUNIX}
  1697. if fpstat(PAnsiChar(AnsiString(AFileName)), LRec) = 0 then
  1698. begin
  1699. LTime := LRec.st_mtime;
  1700. Result := UnixToDateTime(LTime);
  1701. end;
  1702. {$ELSE}
  1703. {$message error stat is not called on this platform!}
  1704. {$ENDIF}
  1705. {$ENDIF}
  1706. {$ENDIF}
  1707. {$ELSE}
  1708. {$message error GetGMTDateByName is not implemented on this platform!}
  1709. {$ENDIF}
  1710. {$ENDIF}
  1711. {$ENDIF}
  1712. end;
  1713. function RightStr(const AStr: String; const Len: Integer): String;
  1714. var
  1715. LStrLen : Integer;
  1716. begin
  1717. LStrLen := Length(AStr);
  1718. if (Len > LStrLen) or (Len < 0) then begin
  1719. Result := AStr;
  1720. end else begin
  1721. //+1 is necessary for the Index because it is one based
  1722. Result := Copy(AStr, LStrLen - Len+1, Len);
  1723. end;
  1724. end;
  1725. {$I IdDeprecatedImplBugOff.inc}
  1726. function TimeZoneBias: TDateTime;
  1727. {$I IdDeprecatedImplBugOn.inc}
  1728. {$IFDEF USE_INLINE} inline; {$ENDIF}
  1729. begin
  1730. Result := -OffsetFromUTC;
  1731. end;
  1732. function IndyStrToBool(const AString : String) : Boolean;
  1733. begin
  1734. // First check against each of the elements of the FalseBoolStrs
  1735. if PosInStrArray(AString, IndyFalseBoolStrs, False) <> -1 then begin
  1736. Result := False;
  1737. Exit;
  1738. end;
  1739. // Second check against each of the elements of the TrueBoolStrs
  1740. if PosInStrArray(AString, IndyTrueBoolStrs, False) <> -1 then begin
  1741. Result := True;
  1742. Exit;
  1743. end;
  1744. // None of the strings match, so convert to numeric (allowing an
  1745. // EConvertException to be thrown if not) and test against zero.
  1746. // If zero, return false, otherwise return true.
  1747. Result := IndyStrToInt(AString) <> 0;
  1748. end;
  1749. function IndySetLocalTime(Value: TDateTime): Boolean;
  1750. {$IFNDEF WINDOWS}
  1751. {$IFDEF USE_INLINE}inline;{$ENDIF}
  1752. {$ELSE}
  1753. var
  1754. dSysTime: TSystemTime;
  1755. buffer: DWord;
  1756. tkp, tpko: TTokenPrivileges;
  1757. hToken: THandle;
  1758. {$ENDIF}
  1759. begin
  1760. Result := False;
  1761. {$IFDEF LINUX}
  1762. //TODO: Implement SetTime for Linux. This call is not critical.
  1763. {$ENDIF}
  1764. {$IFDEF DOTNET}
  1765. //TODO: Figure out how to do this
  1766. {$ENDIF}
  1767. {$IFDEF WINDOWS}
  1768. {I admit that this routine is a little more complicated than the one
  1769. in Indy 8.0. However, this routine does support Windows NT privileges
  1770. meaning it will work if you have administrative rights under that OS
  1771. Original author Kerry G. Neighbour with modifications and testing
  1772. from J. Peter Mugaas}
  1773. {$IFNDEF WINCE}
  1774. // RLebeau 2/1/2008: MSDN says that SetLocalTime() does the adjustment
  1775. // automatically, so why is it being done manually?
  1776. if IndyWindowsPlatform = VER_PLATFORM_WIN32_NT then begin
  1777. if not Windows.OpenProcessToken(Windows.GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then begin
  1778. Exit;
  1779. end;
  1780. if not Windows.LookupPrivilegeValue(nil, 'SeSystemtimePrivilege', tkp.Privileges[0].Luid) then begin {Do not Localize}
  1781. Windows.CloseHandle(hToken);
  1782. Exit;
  1783. end;
  1784. tkp.PrivilegeCount := 1;
  1785. tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
  1786. if not Windows.AdjustTokenPrivileges(hToken, FALSE, tkp, SizeOf(tkp), tpko, buffer) then begin
  1787. Windows.CloseHandle(hToken);
  1788. Exit;
  1789. end;
  1790. end;
  1791. {$ENDIF}
  1792. DateTimeToSystemTime(Value, dSysTime);
  1793. Result := Windows.SetLocalTime({$IFDEF FPC}@{$ENDIF}dSysTime);
  1794. {$IFNDEF WINCE}
  1795. if Result then begin
  1796. // RLebeau 2/1/2008: According to MSDN:
  1797. //
  1798. // "The system uses UTC internally. Therefore, when you call SetLocalTime(),
  1799. // the system uses the current time zone information to perform the conversion,
  1800. // including the daylight saving time setting. Note that the system uses the
  1801. // daylight saving time setting of the current time, not the new time you are
  1802. // setting. Therefore, to ensure the correct result, call SetLocalTime() a
  1803. // second time, now that the first call has updated the daylight saving time
  1804. // setting."
  1805. //
  1806. // TODO: adjust the Time manually so only 1 call to SetLocalTime() is needed...
  1807. if IndyWindowsPlatform = VER_PLATFORM_WIN32_NT then begin
  1808. Windows.SetLocalTime({$IFDEF FPC}@{$ENDIF}dSysTime);
  1809. // Windows 2000+ will broadcast WM_TIMECHANGE automatically...
  1810. if not IndyCheckWindowsVersion(5) then begin // Windows 2000 = v5.0
  1811. SendMessage(HWND_BROADCAST, WM_TIMECHANGE, 0, 0);
  1812. end;
  1813. end else begin
  1814. SendMessage(HWND_BROADCAST, WM_TIMECHANGE, 0, 0);
  1815. end;
  1816. end;
  1817. {Undo the Process Privilege change we had done for the
  1818. set time and close the handle that was allocated}
  1819. if IndyWindowsPlatform = VER_PLATFORM_WIN32_NT then begin
  1820. Windows.AdjustTokenPrivileges(hToken, False, tpko, SizeOf(tpko), tkp, Buffer);
  1821. Windows.CloseHandle(hToken);
  1822. end;
  1823. {$ENDIF}
  1824. {$ENDIF}
  1825. end;
  1826. function StrToDay(const ADay: string): Byte;
  1827. {$IFDEF USE_INLINE} inline; {$ENDIF}
  1828. begin
  1829. // RLebeau 03/04/2009: TODO - support localized strings as well...
  1830. Result := Succ(
  1831. PosInStrArray(ADay,
  1832. ['SUN','MON','TUE','WED','THU','FRI','SAT'], {do not localize}
  1833. False));
  1834. end;
  1835. function StrToMonth(const AMonth: string): Byte;
  1836. const
  1837. // RLebeau 1/7/09: using Char() for #128-#255 because in D2009, the compiler
  1838. // may change characters >= #128 from their Ansi codepage value to their true
  1839. // Unicode codepoint value, depending on the codepage used for the source code.
  1840. // For instance, #128 may become #$20AC...
  1841. // RLebeau 3/12/2018: adding full-length month names.
  1842. // duplicate values shared by multiple languages are not duplicated in the array
  1843. Months: array[0..14] of array[1..12] of string = (
  1844. // English
  1845. ('JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN', 'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC'),
  1846. ('JANUARY', 'FEBRUARY', 'MARCH', 'APRIL', '', 'JUNE', 'JULY', 'AUGUST', 'SEPTEMBER', 'OCTOBER', 'NOVEMBER', 'DECEMBER'),
  1847. ('', '', '', '', '', '', '', '', 'SEPT', '', '', ''),
  1848. // German
  1849. ('J'+Char($C4)+'N', '', 'MRZ', '', 'MAI', 'JUNI', 'JULI', '', '', 'OKT', '', 'DEZ'),
  1850. ('JANUAR', 'FEBRUAR', 'M'+Char($C4)+'RZ', '', 'MAI', '', '', '', '', 'OKTOBER', '', 'DEZEMBER'),
  1851. // Spanish
  1852. ('ENO', 'FBRO', 'MZO', 'ABR', '', '', '', 'AGTO', 'SBRE', 'OBRE', 'NBRE', 'DBRE'),
  1853. ('ENERO', 'FBRERO', 'MARZO', 'ABRIL', 'MAYO', 'JUNIO', 'JULIO', 'AGOSTO', 'SEPTIEMBRE', 'OCTUBRE', 'NOVIEMBRE', 'DICIEMBRE'),
  1854. ('', '', '', 'AB', '', '', '', '', 'SET', '', '', 'DIC'),
  1855. // Dutch
  1856. ('', '', 'MRT', '', '', '', '', '', '', '', '', ''),
  1857. ('JANUARI', 'FEBRUARI', 'MAART', '', 'MEI', '', '', 'AUGUSTUS', '', '', '', ''),
  1858. // French
  1859. ('JANV', 'F'+Char($C9)+'V', '', 'AVR', '', '', 'JUIL', 'AO'+Char($DB), '', '', '', 'D'+Char($C9)+'C'),
  1860. ('JANVIER', 'F'+Char($C9)+'VRIER', 'MARS', 'AVRIL', '', 'JUIN', 'JUILLET', 'AO'+Char($DB)+'T', 'SEPTEMBRE', 'OCTOBRE', 'NOVEMBRE', 'D'+Char($C9)+'CEMBRE'),
  1861. ('', 'F'+Char($C9)+'VR', '', '', '', '', 'JUI', '', '', '', '', ''),
  1862. // Slovenian
  1863. ('', '', '', '', '', '', '', 'AVG', '', '', '', ''),
  1864. ('', '', 'MAREC', '', 'MAJ', 'JUNJI', 'JULIJ', 'AVGUST', '', '', '', ''));
  1865. var
  1866. i, j: Integer;
  1867. begin
  1868. Result := 0;
  1869. if AMonth = '' then begin
  1870. Exit;
  1871. end;
  1872. for i := Low(Months) to High(Months) do begin
  1873. for j := Low(Months[i]) to High(Months[i]) do begin
  1874. if Months[i][j] <> '' then begin
  1875. if TextIsSame(AMonth, Months[i][j]) then begin
  1876. Result := j;
  1877. Exit;
  1878. end;
  1879. end;
  1880. end;
  1881. end;
  1882. end;
  1883. // TODO: use this instead?
  1884. {
  1885. function StrToMonth(const AMonth: string): Byte;
  1886. const
  1887. Months: array[1..12] of array[0..9] of string = (
  1888. ('JAN', 'JANUARY', 'JANUAR', 'ENERO', 'ENO', 'JANUARI', 'JANVIER', 'JANV', '', ''),
  1889. ('FEB', 'FEBRUARY', 'FEBRUAR'. 'FBRERO', 'FBRO', 'FEBRUARI', 'F'+Char($C9)+'VRIER', 'F'+Char($C9)+'V', 'F'+Char($C9)+'VR', ''),
  1890. ('MAR', 'MARCH', 'M'+Char($C4)+'RZ', 'MRZ', 'MARZO', 'MZO', 'MAART', 'MRT', 'MARS', 'MAJ'),
  1891. ('APR', 'APRIL', 'ABRIL', 'ABR', 'AB', 'AVRIL', 'AVR', '', '', ''),
  1892. ('MAY', 'MAI', 'MAYO', 'MEI', 'MAJ', '', '', '', '', ''),
  1893. ('JUN', 'JUNE', 'JUNI', 'JUNIO', 'JUIN', 'JUNJI', '', '', '', ''),
  1894. ('JUL', 'JULY', 'JULI', 'JULIO', 'JUILLET', 'JUIL', 'JUI', 'JULIJ', '', ''),
  1895. ('AUG', 'AUGUST', 'AGOSTO', 'AGTO', 'AUGUSTUS', 'AO'+Char($DB)+'T', 'AO'+Char($DB), 'AVGUST', 'AVG', ''),
  1896. ('SEP', 'SEPTEMBER', 'SEPT', 'SEPTIEMBRE', 'SBRE', 'SET', 'SEPTEMBRE', '', '', ''),
  1897. ('OCT', 'OCTOBER', 'OKTOBER', 'OKT', 'OCTUBRE', 'OBRE', 'OCTOBRE', '', '', ''),
  1898. ('NOV', 'NOVEMBER', 'NOVIEMBRE', 'NBRE', 'NOVEMBRE', '', '', '', '', ''),
  1899. ('DEC', 'DECEMBER', 'DEZEMBER', 'DEZ', 'DICIEMBRE', 'DBRE', 'DIC', 'D'+Char($C9)+'CEMBRE', 'D'+Char($C9)+'C', ''));
  1900. var
  1901. i, j: Integer;
  1902. begin
  1903. Result := 0;
  1904. if AMonth = '' then begin
  1905. Exit;
  1906. end;
  1907. case AMonth[0] of
  1908. 'J', 'j': begin
  1909. if PosInStrArray(AMonth, Months[1], False) <> -1 then begin
  1910. Result := 1;
  1911. end;
  1912. if PosInStrArray(AMonth, Months[6], False) <> -1 then begin
  1913. Result := 6;
  1914. end;
  1915. if PosInStrArray(AMonth, Months[7], False) <> -1 then begin
  1916. Result := 7;
  1917. end;
  1918. end;
  1919. 'E', 'e': begin
  1920. if PosInStrArray(AMonth, Months[1], False) <> -1 then begin
  1921. Result := 1;
  1922. end;
  1923. end;
  1924. 'F', 'f': begin
  1925. if PosInStrArray(AMonth, Months[2], False) <> -1 then begin
  1926. Result := 2;
  1927. end;
  1928. end;
  1929. 'M', 'm': begin
  1930. if PosInStrArray(AMonth, Months[3], False) <> -1 then begin
  1931. Result := 3;
  1932. end;
  1933. if PosInStrArray(AMonth, Months[5], False) <> -1 then begin
  1934. Result := 5;
  1935. end;
  1936. end;
  1937. 'A', 'a': begin
  1938. if PosInStrArray(AMonth, Months[4], False) <> -1 then begin
  1939. Result := 4;
  1940. end;
  1941. if PosInStrArray(AMonth, Months[8], False) <> -1 then begin
  1942. Result := 8;
  1943. end;
  1944. end;
  1945. 'S', 's': begin
  1946. if PosInStrArray(AMonth, Months[9], False) <> -1 then begin
  1947. Result := 4;
  1948. end;
  1949. end;
  1950. 'O', 'o': begin
  1951. if PosInStrArray(AMonth, Months[10], False) <> -1 then begin
  1952. Result := 10;
  1953. end;
  1954. end;
  1955. 'N', 'n': begin
  1956. if PosInStrArray(AMonth, Months[11], False) <> -1 then begin
  1957. Result := 11;
  1958. end;
  1959. end;
  1960. 'D', 'd': begin
  1961. if PosInStrArray(AMonth, Months[12], False) <> -1 then begin
  1962. Result := 12;
  1963. end;
  1964. end;
  1965. end;
  1966. end;
  1967. }
  1968. function UpCaseFirst(const AStr: string): string;
  1969. {$IFDEF USE_INLINE} inline; {$ENDIF}
  1970. {$IFDEF STRING_IS_IMMUTABLE}
  1971. var
  1972. LSB: TIdStringBuilder;
  1973. {$ENDIF}
  1974. begin
  1975. // TODO: support Unicode surrogates in the first position?
  1976. {$IFDEF STRING_IS_IMMUTABLE}
  1977. LSB := TIdStringBuilder.Create(LowerCase(TrimLeft(AStr)));
  1978. if LSB.Length > 0 then begin {Do not Localize}
  1979. LSB[0] := UpCase(LSB[0]);
  1980. end;
  1981. Result := LSB.ToString;
  1982. {$ELSE}
  1983. Result := LowerCase(TrimLeft(AStr));
  1984. if Result <> '' then begin {Do not Localize}
  1985. Result[1] := UpCase(Result[1]);
  1986. end;
  1987. {$ENDIF}
  1988. end;
  1989. function UpCaseFirstWord(const AStr: string): string;
  1990. var
  1991. I: Integer;
  1992. begin
  1993. for I := 1 to Length(AStr) do begin
  1994. if CharIsInSet(AStr, I, LWS) then begin
  1995. if I > 1 then begin
  1996. Result := UpperCase(Copy(AStr, 1, I-1)) + Copy(AStr, I, MaxInt);
  1997. Exit;
  1998. end;
  1999. Break;
  2000. end;
  2001. end;
  2002. Result := UpperCase(AStr);
  2003. end;
  2004. function IsHex(const AChar : Char) : Boolean;
  2005. {$IFDEF USE_INLINE} inline; {$ENDIF}
  2006. begin
  2007. Result := IndyPos(UpperCase(AChar), HexNumbers) > 0;
  2008. end;
  2009. function IsBinary(const AChar : Char) : Boolean;
  2010. {$IFDEF USE_INLINE} inline; {$ENDIF}
  2011. begin
  2012. Result := IndyPos(UpperCase(AChar), BinNumbers) > 0;
  2013. end;
  2014. function BinStrToInt(const ABinary: String): Integer;
  2015. var
  2016. I: Integer;
  2017. //From: http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20622755.html
  2018. begin
  2019. Result := 0;
  2020. for I := 1 to Length(ABinary) do begin
  2021. Result := Result shl 1 or (Byte(ABinary[I]) and 1);
  2022. end;
  2023. end;
  2024. function ABNFToText(const AText : String) : String;
  2025. type
  2026. TIdRuleMode = (data, rule, decimal, hex, binary);
  2027. var
  2028. i : Integer;
  2029. LR : TIdRuleMode;
  2030. LNum : String;
  2031. begin
  2032. LR := data;
  2033. Result := '';
  2034. for i := 1 to Length(AText) do begin
  2035. case LR of
  2036. data :
  2037. if (AText[i] = '%') and (i < Length(AText)) then begin
  2038. LR := rule;
  2039. end else begin
  2040. Result := Result + AText[i];
  2041. end;
  2042. rule :
  2043. case AText[i] of
  2044. 'd','D' : LR := decimal;
  2045. 'x','X' : LR := hex;
  2046. 'b','B' : LR := binary;
  2047. else
  2048. begin
  2049. LR := data;
  2050. Result := Result + '%';
  2051. end;
  2052. end;
  2053. decimal :
  2054. If IsNumeric(AText[i]) then begin
  2055. LNum := LNum + AText[i];
  2056. if IndyStrToInt(LNum, 0) > $FF then begin
  2057. IdDelete(LNum,Length(LNum),1);
  2058. Result := Result + Char(IndyStrToInt(LNum, 0));
  2059. LR := Data;
  2060. Result := Result + AText[i];
  2061. end;
  2062. end else begin
  2063. Result := Result + Char(IndyStrToInt(LNum, 0));
  2064. LNum := '';
  2065. if AText[i] <> '.' then begin
  2066. LR := Data;
  2067. Result := Result + AText[i];
  2068. end;
  2069. end;
  2070. hex :
  2071. If IsHex(AText[i]) and (Length(LNum) < 2) then begin
  2072. LNum := LNum + AText[i];
  2073. if IndyStrToInt('$'+LNum, 0) > $FF then begin
  2074. IdDelete(LNum,Length(LNum),1);
  2075. Result := Result + Char(IndyStrToInt(LNum,0));
  2076. LR := Data;
  2077. Result := Result + AText[i];
  2078. end;
  2079. end else begin
  2080. Result := Result + Char(IndyStrToInt('$'+LNum, 0));
  2081. LNum := '';
  2082. if AText[i] <> '.' then begin
  2083. LR := Data;
  2084. Result := Result + AText[i];
  2085. end;
  2086. end;
  2087. binary :
  2088. If IsBinary(AText[i]) and (Length(LNum)<8) then begin
  2089. LNum := LNum + AText[i];
  2090. if (BinStrToInt(LNum)>$FF) then begin
  2091. IdDelete(LNum,Length(LNum),1);
  2092. Result := Result + Char(BinStrToInt(LNum));
  2093. LR := Data;
  2094. Result := Result + AText[i];
  2095. end;
  2096. end else begin
  2097. Result := Result + Char(IndyStrToInt('$'+LNum, 0));
  2098. LNum := '';
  2099. if AText[i] <> '.' then begin
  2100. LR := Data;
  2101. Result := Result + AText[i];
  2102. end;
  2103. end;
  2104. end;
  2105. end;
  2106. end;
  2107. function GetMIMETypeFromFile(const AFile: TIdFileName): string;
  2108. var
  2109. MIMEMap: TIdMIMETable;
  2110. begin
  2111. MIMEMap := TIdMimeTable.Create(True);
  2112. try
  2113. Result := MIMEMap.GetFileMIMEType(AFile);
  2114. finally
  2115. MIMEMap.Free;
  2116. end;
  2117. end;
  2118. function GetMIMEDefaultFileExt(const MIMEType: string): TIdFileName;
  2119. var
  2120. MIMEMap: TIdMIMETable;
  2121. begin
  2122. MIMEMap := TIdMimeTable.Create(True);
  2123. try
  2124. Result := MIMEMap.GetDefaultFileExt(MIMEType);
  2125. finally
  2126. MIMEMap.Free;
  2127. end;
  2128. end;
  2129. // RLebeau: According to RFC 2822 Section 4.3:
  2130. //
  2131. // In the obsolete time zone, "UT" and "GMT" are indications of
  2132. // "Universal Time" and "Greenwich Mean Time" respectively and are both
  2133. // semantically identical to "+0000".
  2134. //
  2135. // The remaining three character zones are the US time zones. The first
  2136. // letter, "E", "C", "M", or "P" stands for "Eastern", "Central",
  2137. // "Mountain" and "Pacific". The second letter is either "S" for
  2138. // "Standard" time, or "D" for "Daylight" (or summer) time. Their
  2139. // interpretations are as follows:
  2140. //
  2141. // EDT is semantically equivalent to -0400
  2142. // EST is semantically equivalent to -0500
  2143. // CDT is semantically equivalent to -0500
  2144. // CST is semantically equivalent to -0600
  2145. // MDT is semantically equivalent to -0600
  2146. // MST is semantically equivalent to -0700
  2147. // PDT is semantically equivalent to -0700
  2148. // PST is semantically equivalent to -0800
  2149. //
  2150. // The 1 character military time zones were defined in a non-standard
  2151. // way in [RFC822] and are therefore unpredictable in their meaning.
  2152. // The original definitions of the military zones "A" through "I" are
  2153. // equivalent to "+0100" through "+0900" respectively; "K", "L", and "M"
  2154. // are equivalent to "+1000", "+1100", and "+1200" respectively; "N"
  2155. // through "Y" are equivalent to "-0100" through "-1200" respectively;
  2156. // and "Z" is equivalent to "+0000". However, because of the error in
  2157. // [RFC822], they SHOULD all be considered equivalent to "-0000" unless
  2158. // there is out-of-band information confirming their meaning.
  2159. //
  2160. // Other multi-character (usually between 3 and 5) alphabetic time zones
  2161. // have been used in Internet messages. Any such time zone whose
  2162. // meaning is not known SHOULD be considered equivalent to "-0000"
  2163. // unless there is out-of-band information confirming their meaning.
  2164. // RLebeau: according to http://en.wikipedia.org/wiki/Central_European_Time:
  2165. //
  2166. // Central European Time (CET) is one of the names of the time zone that is
  2167. // 1 hour ahead of Coordinated Universal Time. It is used in most European
  2168. // and some North African countries.
  2169. //
  2170. // Its time offset is normally UTC+1. During daylight saving time, Central
  2171. // European Summer Time (CEST) is used instead (UTC+2). The current time
  2172. // offset is UTC+1.
  2173. // RLebeau: other abbreviations taken from:
  2174. // http://www.timeanddate.com/library/abbreviations/timezones/
  2175. // http://en.wikipedia.org/wiki/List_of_time_zone_abbreviations
  2176. function TimeZoneToGmtOffsetStr(const ATimeZone: String): String;
  2177. type
  2178. TimeZoneOffset = record
  2179. TimeZone: String;
  2180. Offset: String;
  2181. end;
  2182. const
  2183. cTimeZones: array[0..244] of TimeZoneOffset = (
  2184. (TimeZone:'A'; Offset:'+0100'), // Alpha Time Zone - Military {do not localize}
  2185. (TimeZone:'ACDT'; Offset:'+1030'), // Australian Central Daylight Time {do not localize}
  2186. (TimeZone:'ACST'; Offset:'+0930'), // Australian Central Standard Time {do not localize}
  2187. (TimeZone:'ACT'; Offset:'+0800'), // ASEAN Common Time {do not localize}
  2188. (TimeZone:'ADT'; Offset:'-0300'), // Atlantic Daylight Time - North America {do not localize}
  2189. (TimeZone:'AEDT'; Offset:'+1100'), // Australian Eastern Daylight Time {do not localize}
  2190. (TimeZone:'AEST'; Offset:'+1000'), // Australian Eastern Standard Time {do not localize}
  2191. (TimeZone:'AFT'; Offset:'+0430'), // Afghanistan Time {do not localize}
  2192. (TimeZone:'AKDT'; Offset:'-0800'), // Alaska Daylight Time {do not localize}
  2193. (TimeZone:'AKST'; Offset:'-0900'), // Alaska Standard Time {do not localize}
  2194. (TimeZone:'AMST'; Offset:'-0300'), // Amazon Summer Time (Brazil) {do not localize}
  2195. (TimeZone:'AMST'; Offset:'+0500'), // Armenia Summer Time {do not localize}
  2196. (TimeZone:'AMT'; Offset:'-0400'), // Amazon Time (Brazil) {do not localize}
  2197. (TimeZone:'AMT'; Offset:'+0400'), // Armenia Time {do not localize}
  2198. (TimeZone:'ART'; Offset:'-0300'), // Argentina Time {do not localize}
  2199. (TimeZone:'AST'; Offset:'-0400'), // Atlantic Standard Time - North America {do not localize}
  2200. (TimeZone:'AST'; Offset:'+0300'), // Arabia Standard Time {do not localize}
  2201. (TimeZone:'AWDT'; Offset:'+0900'), // Australian Western Daylight Time {do not localize}
  2202. (TimeZone:'AWST'; Offset:'+0800'), // Australian Western Standard Time {do not localize}
  2203. (TimeZone:'AZOST';Offset:'-0100'), // Azores Standard Time {do not localize}
  2204. (TimeZone:'AZT'; Offset:'+0400'), // Azerbaijan Time {do not localize}
  2205. (TimeZone:'B'; Offset:'+0200'), // Bravo Time Zone - Military {do not localize}
  2206. (TimeZone:'BDT'; Offset:'+0800'), // Brunei Time {do not localize}
  2207. (TimeZone:'BIOT'; Offset:'+0600'), // British Indian Ocean Time {do not localize}
  2208. (TimeZone:'BIT'; Offset:'-1200'), // Baker Island Time {do not localize}
  2209. (TimeZone:'BOT'; Offset:'-0400'), // Bolivia Time {do not localize}
  2210. (TimeZone:'BRT'; Offset:'-0300'), // Brasilia Time {do not localize}
  2211. (TimeZone:'BST'; Offset:'+0100'), // British Summer Time - Europe {do not localize}
  2212. (TimeZone:'BST'; Offset:'+0600'), // Bangladesh Standard Time {do not localize}
  2213. (TimeZone:'BTT'; Offset:'+0600'), // Bhutan Time {do not localize}
  2214. (TimeZone:'C'; Offset:'+0300'), // Charlie Time Zone - Military {do not localize}
  2215. (TimeZone:'CAT'; Offset:'+0200'), // Central Africa Time {do not localize}
  2216. (TimeZone:'CCT'; Offset:'+0630'), // Cocos Islands Time {do not localize}
  2217. (TimeZone:'CDT'; Offset:'+1030'), // Central Daylight Time - Australia {do not localize}
  2218. (TimeZone:'CDT'; Offset:'-0500'), // Central Daylight Time - North America {do not localize}
  2219. (TimeZone:'CEDT'; Offset:'+0200'), // Central European Daylight Time {do not localize}
  2220. (TimeZone:'CEST'; Offset:'+0200'), // Central European Summer Time {do not localize}
  2221. (TimeZone:'CET'; Offset:'+0100'), // Central European Time {do not localize}
  2222. (TimeZone:'CHADT';Offset:'+1345'), // Chatham Daylight Time {do not localize}
  2223. (TimeZone:'CHAST';Offset:'+1245'), // Chatham Standard Time {do not localize}
  2224. (TimeZone:'CHOT'; Offset:'+0800'), // Choibalsan {do not localize}
  2225. (TimeZone:'ChST'; Offset:'+1000'), // Chamorro Standard Time {do not localize}
  2226. (TimeZone:'CHUT'; Offset:'+1000'), // Chuuk Time {do not localize}
  2227. (TimeZone:'CIST'; Offset:'-0800'), // Clipperton Island Standard Time {do not localize}
  2228. (TimeZone:'CIT'; Offset:'+0800'), // Central Indonesia Time {do not localize}
  2229. (TimeZone:'CKT'; Offset:'-1000'), // Cook Island Time {do not localize}
  2230. (TimeZone:'CLST'; Offset:'-0300'), // Chile Summer Time {do not localize}
  2231. (TimeZone:'CLT'; Offset:'-0400'), // Chile Standard Time {do not localize}
  2232. (TimeZone:'COST'; Offset:'-0400'), // Colombia Summer Time {do not localize}
  2233. (TimeZone:'COT'; Offset:'-0500'), // Colombia Time {do not localize}
  2234. (TimeZone:'CST'; Offset:'+1030'), // Central Summer Time - Australia {do not localize}
  2235. (TimeZone:'CST'; Offset:'+0930'), // Central Standard Time - Australia {do not localize}
  2236. (TimeZone:'CST'; Offset:'-0600'), // Central Standard Time - North America {do not localize}
  2237. (TimeZone:'CST'; Offset:'+0800'), // China Standard Time {do not localize}
  2238. (TimeZone:'CST'; Offset:'-0500'), // Cuba Standard Time {do not localize}
  2239. (TimeZone:'CT'; Offset:'+0800'), // China time {do not localize}
  2240. (TimeZone:'CVT'; Offset:'-0100'), // Cape Verde Time {do not localize}
  2241. (TimeZone:'CWST'; Offset:'+0845'), // Central Western Standard Time (Australia) unofficial {do not localize}
  2242. (TimeZone:'CXT'; Offset:'+0700'), // Christmas Island Time - Australia {do not localize}
  2243. (TimeZone:'D'; Offset:'+0400'), // Delta Time Zone - Military {do not localize}
  2244. (TimeZone:'DAVT'; Offset:'+0700'), // Davis Time {do not localize}
  2245. (TimeZone:'DDUT'; Offset:'+1000'), // Dumont d'Urville Time {do not localize}
  2246. (TimeZone:'DFT'; Offset:'+0100'), // AIX specific equivalent of Central European Time {do not localize}
  2247. (TimeZone:'E'; Offset:'+0500'), // Echo Time Zone - Military {do not localize}
  2248. (TimeZone:'EASST';Offset:'-0500'), // Easter Island Standard Summer Time {do not localize}
  2249. (TimeZone:'EAST'; Offset:'-0600'), // Easter Island Standard Time {do not localize}
  2250. (TimeZone:'EAT'; Offset:'+0300'), // East Africa Time {do not localize}
  2251. (TimeZone:'ECT'; Offset:'-0400'), // Eastern Caribbean Time (does not recognise DST) {do not localize}
  2252. (TimeZone:'ECT'; Offset:'-0500'), // Ecuador Time {do not localize}
  2253. (TimeZone:'EDT'; Offset:'+1100'), // Eastern Daylight Time - Australia {do not localize}
  2254. (TimeZone:'EDT'; Offset:'-0400'), // Eastern Daylight Time - North America {do not localize}
  2255. (TimeZone:'EEDT'; Offset:'+0300'), // Eastern European Daylight Time {do not localize}
  2256. (TimeZone:'EEST'; Offset:'+0300'), // Eastern European Summer Time {do not localize}
  2257. (TimeZone:'EET'; Offset:'+0200'), // Eastern European Time {do not localize}
  2258. (TimeZone:'EGST'; Offset:'+0000'), // Eastern Greenland Summer Time {do not localize}
  2259. (TimeZone:'EGT'; Offset:'-0100'), // Eastern Greenland Time {do not localize}
  2260. (TimeZone:'EIT'; Offset:'+0900'), // Eastern Indonesian Time {do not localize}
  2261. (TimeZone:'EST'; Offset:'+1100'), // Eastern Summer Time - Australia {do not localize}
  2262. (TimeZone:'EST'; Offset:'+1000'), // Eastern Standard Time - Australia {do not localize}
  2263. (TimeZone:'EST'; Offset:'-0500'), // Eastern Standard Time - North America {do not localize}
  2264. (TimeZone:'F'; Offset:'+0600'), // Foxtrot Time Zone - Military {do not localize}
  2265. (TimeZone:'FET'; Offset:'+0300'), // Further-eastern European Time {do not localize}
  2266. (TimeZone:'FJT'; Offset:'+1200'), // Fiji Time {do not localize}
  2267. (TimeZone:'FKST'; Offset:'-0300'), // Falkland Islands Standard Time {do not localize}
  2268. (TimeZone:'FKST'; Offset:'-0300'), // Falkland Islands Summer Time {do not localize}
  2269. (TimeZone:'FKT'; Offset:'-0400'), // Falkland Islands Time {do not localize}
  2270. (TimeZone:'FNT'; Offset:'-0200'), // Fernando de Noronha Time {do not localize}
  2271. (TimeZone:'G'; Offset:'+0700'), // Golf Time Zone - Military {do not localize}
  2272. (TimeZone:'GALT'; Offset:'-0600'), // Galapagos Time {do not localize}
  2273. (TimeZone:'GAMT'; Offset:'-0900'), // Gambier Islands {do not localize}
  2274. (TimeZone:'GET'; Offset:'+0400'), // Georgia Standard Time {do not localize}
  2275. (TimeZone:'GFT'; Offset:'-0300'), // French Guiana Time {do not localize}
  2276. (TimeZone:'GILT'; Offset:'+1200'), // Gilbert Island Time {do not localize}
  2277. (TimeZone:'GIT'; Offset:'-0900'), // Gambier Island Time {do not localize}
  2278. (TimeZone:'GMT'; Offset:'+0000'), // Greenwich Mean Time - Europe {do not localize}
  2279. (TimeZone:'GST'; Offset:'-0200'), // South Georgia and the South Sandwich Islands {do not localize}
  2280. (TimeZone:'GST'; Offset:'+0400'), // Gulf Standard Time {do not localize}
  2281. (TimeZone:'GYT'; Offset:'-0400'), // Guyana Time {do not localize}
  2282. (TimeZone:'H'; Offset:'+0800'), // Hotel Time Zone - Military {do not localize}
  2283. (TimeZone:'HAA'; Offset:'-0300'), // Heure Avancée de l'Atlantique - North America {do not localize}
  2284. (TimeZone:'HAC'; Offset:'-0500'), // Heure Avancée du Centre - North America {do not localize}
  2285. (TimeZone:'HADT'; Offset:'-0900'), // Hawaii-Aleutian Daylight Time - North America {do not localize}
  2286. (TimeZone:'HAE'; Offset:'-0400'), // Heure Avancée de l'Est - North America {do not localize}
  2287. (TimeZone:'HAEC'; Offset:'+0200'), // Heure Avancée d'Europe Centrale francised name for CEST {do not localize}
  2288. (TimeZone:'HAP'; Offset:'-0700'), // Heure Avancée du Pacifique - North America {do not localize}
  2289. (TimeZone:'HAR'; Offset:'-0600'), // Heure Avancée des Rocheuses - North America {do not localize}
  2290. (TimeZone:'HAST'; Offset:'-1000'), // Hawaii-Aleutian Standard Time - North America {do not localize}
  2291. (TimeZone:'HAT'; Offset:'-0230'), // Heure Avancée de Terre-Neuve - North America {do not localize}
  2292. (TimeZone:'HAY'; Offset:'-0800'), // Heure Avancée du Yukon - North America {do not localize}
  2293. (TimeZone:'HKT'; Offset:'+0800'), // Hong Kong Time {do not localize}
  2294. (TimeZone:'HMT'; Offset:'+0500'), // Heard and McDonald Islands Time {do not localize}
  2295. (TimeZone:'HNA'; Offset:'-0400'), // Heure Normale de l'Atlantique - North America {do not localize}
  2296. (TimeZone:'HNC'; Offset:'-0600'), // Heure Normale du Centre - North America {do not localize}
  2297. (TimeZone:'HNE'; Offset:'-0500'), // Heure Normale de l'Est - North America {do not localize}
  2298. (TimeZone:'HNP'; Offset:'-0800'), // Heure Normale du Pacifique - North America {do not localize}
  2299. (TimeZone:'HNR'; Offset:'-0700'), // Heure Normale des Rocheuses - North America {do not localize}
  2300. (TimeZone:'HNT'; Offset:'-0330'), // Heure Normale de Terre-Neuve - North America {do not localize}
  2301. (TimeZone:'HNY'; Offset:'-0900'), // Heure Normale du Yukon - North America {do not localize}
  2302. (TimeZone:'HOVT'; Offset:'+0700'), // Khovd Time {do not localize}
  2303. (TimeZone:'HST'; Offset:'-1000'), // Hawaii Standard Time {do not localize}
  2304. (TimeZone:'I'; Offset:'+0900'), // India Time Zone - Military {do not localize}
  2305. (TimeZone:'ICT'; Offset:'+0700'), // Indochina Time {do not localize}
  2306. (TimeZone:'IDT'; Offset:'+0300'), // Israel Daylight Time {do not localize}
  2307. (TimeZone:'IOT'; Offset:'+0300'), // Indian Ocean Time {do not localize}
  2308. (TimeZone:'IRDT'; Offset:'+0430'), // Iran Daylight Time {do not localize}
  2309. (TimeZone:'IRKT'; Offset:'+0900'), // Irkutsk Time {do not localize}
  2310. (TimeZone:'IRST'; Offset:'+0330'), // Iran Standard Time {do not localize}
  2311. (TimeZone:'IST'; Offset:'+0100'), // Irish Summer Time - Europe {do not localize}
  2312. (TimeZone:'IST'; Offset:'+0530'), // Indian Standard Time {do not localize}
  2313. (TimeZone:'IST'; Offset:'+0200'), // Israel Standard Time {do not localize}
  2314. (TimeZone:'JST'; Offset:'+0900'), // Japan Standard Time {do not localize}
  2315. (TimeZone:'K'; Offset:'+1000'), // Kilo Time Zone - Military {do not localize}
  2316. (TimeZone:'KGT'; Offset:'+0600'), // Kyrgyzstan time {do not localize}
  2317. (TimeZone:'KOST'; Offset:'+1100'), // Kosrae Time {do not localize}
  2318. (TimeZone:'KRAT'; Offset:'+0700'), // Krasnoyarsk Time {do not localize}
  2319. (TimeZone:'KST'; Offset:'+0900'), // Korea Standard Time {do not localize}
  2320. (TimeZone:'L'; Offset:'+1100'), // Lima Time Zone - Military {do not localize}
  2321. (TimeZone:'LHST'; Offset:'+1030'), // Lord Howe Standard Time {do not localize}
  2322. (TimeZone:'LHST'; Offset:'+1100'), // Lord Howe Summer Time {do not localize}
  2323. (TimeZone:'LINT'; Offset:'+1400'), // Line Islands Time {do not localize}
  2324. (TimeZone:'M'; Offset:'+1200'), // Mike Time Zone - Military {do not localize}
  2325. (TimeZone:'MAGT'; Offset:'+1200'), // Magadan Time {do not localize}
  2326. (TimeZone:'MART'; Offset:'-0930'), // Marquesas Islands Time {do not localize}
  2327. (TimeZone:'MAWT'; Offset:'+0500'), // Mawson Station Time {do not localize}
  2328. (TimeZone:'MDT'; Offset:'-0600'), // Mountain Daylight Time - North America {do not localize}
  2329. (TimeZone:'MEHSZ';Offset:'+0300'), // Mitteleuropäische Hochsommerzeit - Europe {do not localize}
  2330. (TimeZone:'MEST'; Offset:'+0200'), // Middle European Saving Time Same zone as CEST {do not localize}
  2331. (TimeZone:'MESZ'; Offset:'+0200'), // Mitteleuroäische Sommerzeit - Europe {do not localize}
  2332. (TimeZone:'MET'; Offset:'+0100'), // Middle European Time Same zone as CET {do not localize}
  2333. (TimeZone:'MEZ'; Offset:'+0100'), // Mitteleuropäische Zeit - Europe {do not localize}
  2334. (TimeZone:'MHT'; Offset:'+1200'), // Marshall Islands {do not localize}
  2335. (TimeZone:'MIST'; Offset:'+1100'), // Macquarie Island Station Time {do not localize}
  2336. (TimeZone:'MIT'; Offset:'-0930'), // Marquesas Islands Time {do not localize}
  2337. (TimeZone:'MMT'; Offset:'+0630'), // Myanmar Time {do not localize}
  2338. (TimeZone:'MSD'; Offset:'+0400'), // Moscow Daylight Time - Europe {do not localize}
  2339. (TimeZone:'MSK'; Offset:'+0300'), // Moscow Standard Time - Europe {do not localize}
  2340. (TimeZone:'MST'; Offset:'-0700'), // Mountain Standard Time - North America {do not localize}
  2341. (TimeZone:'MST'; Offset:'+0800'), // Malaysia Standard Time {do not localize}
  2342. (TimeZone:'MST'; Offset:'+0630'), // Myanmar Standard Time {do not localize}
  2343. (TimeZone:'MUT'; Offset:'+0400'), // Mauritius Time {do not localize}
  2344. (TimeZone:'MVT'; Offset:'+0500'), // Maldives Time {do not localize}
  2345. (TimeZone:'MYT'; Offset:'+0800'), // Malaysia Time {do not localize}
  2346. (TimeZone:'N'; Offset:'-0100'), // November Time Zone - Military {do not localize}
  2347. (TimeZone:'NCT'; Offset:'+1100'), // New Caledonia Time [do not localize}
  2348. (TimeZone:'NDT'; Offset:'-0230'), // Newfoundland Daylight Time - North America {do not localize}
  2349. (TimeZone:'NFT'; Offset:'+1130'), // Norfolk (Island), Time - Australia {do not localize}
  2350. (TimeZone:'NPT'; Offset:'+0545'), // Nepal Time {do not localize}
  2351. (TimeZone:'NST'; Offset:'-0330'), // Newfoundland Standard Time - North America {do not localize}
  2352. (TimeZone:'NT'; Offset:'-0330'), // Newfoundland Time {do not localize}
  2353. (TimeZone:'NUT'; Offset:'-1100'), // Niue Time {do not localize}
  2354. (TimeZone:'NZDT'; Offset:'+1300'), // New Zealand Daylight Time {do not localize}
  2355. (TimeZone:'NZST'; Offset:'+1200'), // New Zealand Standard Time {do not localize}
  2356. (TimeZone:'O'; Offset:'-0200'), // Oscar Time Zone - Military {do not localize}
  2357. (TimeZone:'OMST'; Offset:'+0700'), // Omsk Time {do not localize}
  2358. (TimeZone:'ORAT'; Offset:'+0500'), // Oral Time {do not localize}
  2359. (TimeZone:'P'; Offset:'-0300'), // Papa Time Zone - Military {do not localize}
  2360. (TimeZone:'PDT'; Offset:'-0700'), // Pacific Daylight Time - North America {do not localize}
  2361. (TimeZone:'PET'; Offset:'-0500'), // Peru Time {do not localize}
  2362. (TimeZone:'PETT'; Offset:'+1200'), // Kamchatka Time {do not localize}
  2363. (TimeZone:'PGT'; Offset:'+1000'), // Papua New Guinea Time {do not localize}
  2364. (TimeZone:'PHOT'; Offset:'+1300'), // Phoenix Island Time {do not localize}
  2365. (TimeZone:'PKT'; Offset:'+0500'), // Pakistan Standard Time {do not localize}
  2366. (TimeZone:'PMDT'; Offset:'-0200'), // Saint Pierre and Miquelon Daylight time {do not localize}
  2367. (TimeZone:'PMST'; Offset:'-0300'), // Saint Pierre and Miquelon Standard Time {do not localize}
  2368. (TimeZone:'PONT'; Offset:'+1100'), // Pohnpei Standard Time [do not localize]
  2369. (TimeZone:'PST'; Offset:'-0800'), // Pacific Standard Time - North America {do not localize}
  2370. (TimeZone:'PST'; Offset:'+0800'), // Philippine Standard Time {do not localize}
  2371. (TimeZone:'PYST'; Offset:'-0300'), // Paraguay Summer Time (South America) {do not localize}
  2372. (TimeZone:'PYT'; Offset:'-0400'), // Paraguay Time (South America) {do not localize}
  2373. (TimeZone:'Q'; Offset:'-0400'), // Quebec Time Zone - Military {do not localize}
  2374. (TimeZone:'R'; Offset:'-0500'), // Romeo Time Zone - Military {do not localize}
  2375. (TimeZone:'RET'; Offset:'+0400'), // Réunion Time {do not localize}
  2376. (TimeZone:'ROTT'; Offset:'-0300'), // Rothera Research Station Time {do not localize}
  2377. (TimeZone:'S'; Offset:'-0600'), // Sierra Time Zone - Military {do not localize}
  2378. (TimeZone:'SAKT'; Offset:'+1100'), // Sakhalin Island time {do not localize}
  2379. (TimeZone:'SAMT'; Offset:'+0400'), // Samara Time {do not localize}
  2380. (TimeZone:'SAST'; Offset:'+0200'), // South African Standard Time {do not localize}
  2381. (TimeZone:'SBT'; Offset:'+1100'), // Solomon Islands Time {do not localize}
  2382. (TimeZone:'SCT'; Offset:'+0400'), // Seychelles Time {do not localize}
  2383. (TimeZone:'SGT'; Offset:'+0800'), // Singapore Time {do not localize}
  2384. (TimeZone:'SLST'; Offset:'+0530'), // Sri Lanka Time {do not localize}
  2385. (TimeZone:'SRT'; Offset:'-0300'), // Suriname Time {do not localize}
  2386. (TimeZone:'SST'; Offset:'-1100'), // Samoa Standard Time {do not localize}
  2387. (TimeZone:'SST'; Offset:'+0800'), // Singapore Standard Time {do not localize}
  2388. (TimeZone:'SYOT'; Offset:'+0300'), // Showa Station Time {do not localize}
  2389. (TimeZone:'T'; Offset:'-0700'), // Tango Time Zone - Military {do not localize}
  2390. (TimeZone:'TAHT'; Offset:'-1000'), // Tahiti Time {do not localize}
  2391. (TimeZone:'THA'; Offset:'+0700'), // Thailand Standard Time {do not localize}
  2392. (TimeZone:'TFT'; Offset:'+0500'), // Indian/Kerguelen {do not localize}
  2393. (TimeZone:'TJT'; Offset:'+0500'), // Tajikistan Time {do not localize}
  2394. (TimeZone:'TKT'; Offset:'+1300'), // Tokelau Time {do not localize}
  2395. (TimeZone:'TLT'; Offset:'+0900'), // Timor Leste Time {do not localize}
  2396. (TimeZone:'TMT'; Offset:'+0500'), // Turkmenistan Time {do not localize}
  2397. (TimeZone:'TOT'; Offset:'+1300'), // Tonga Time {do not localize}
  2398. (TimeZone:'TVT'; Offset:'+1200'), // Tuvalu Time {do not localize}
  2399. (TimeZone:'U'; Offset:'-0800'), // Uniform Time Zone - Military {do not localize}
  2400. (TimeZone:'UCT'; Offset:'+0000'), // Coordinated Universal Time {do not localize}
  2401. (TimeZone:'ULAT'; Offset:'+0800'), // Ulaanbaatar Time {do not localize}
  2402. (TimeZone:'UT'; Offset:'+0000'), // Universal Time - Europe {do not localize}
  2403. (TimeZone:'UTC'; Offset:'+0000'), // Coordinated Universal Time - Europe {do not localize}
  2404. (TimeZone:'UYST'; Offset:'-0200'), // Uruguay Summer Time {do not localize}
  2405. (TimeZone:'UYT'; Offset:'-0300'), // Uruguay Standard Time {do not localize}
  2406. (TimeZone:'UZT'; Offset:'+0500'), // Uzbekistan Time {do not localize}
  2407. (TimeZone:'V'; Offset:'-0900'), // Victor Time Zone - Military {do not localize}
  2408. (TimeZone:'VET'; Offset:'-0430'), // Venezuelan Standard Time {do not localize}
  2409. (TimeZone:'VLAT'; Offset:'+1000'), // Vladivostok Time {do not localize}
  2410. (TimeZone:'VOLT'; Offset:'+0400'), // Volgograd Time {do not localize}
  2411. (TimeZone:'VOST'; Offset:'+0600'), // Vostok Station Time {do not localize}
  2412. (TimeZone:'VUT'; Offset:'+1100'), // Vanuatu Time {do not localize}
  2413. (TimeZone:'W'; Offset:'-1000'), // Whiskey Time Zone - Military {do not localize}
  2414. (TimeZone:'WAKT'; Offset:'+1200'), // Wake Island Time {do not localize}
  2415. (TimeZone:'WAST'; Offset:'+0200'), // West Africa Summer Time {do not localize}
  2416. (TimeZone:'WAT'; Offset:'+0100'), // West Africa Time {do not localize}
  2417. (TimeZone:'WDT'; Offset:'+0900'), // Western Daylight Time - Australia {do not localize}
  2418. (TimeZone:'WEDT'; Offset:'+0100'), // Western European Daylight Time - Europe {do not localize}
  2419. (TimeZone:'WEST'; Offset:'+0100'), // Western European Summer Time - Europe {do not localize}
  2420. (TimeZone:'WET'; Offset:'+0000'), // Western European Time - Europe {do not localize}
  2421. (TimeZone:'WIT'; Offset:'+0700'), // Western Indonesian Time {do not localize}
  2422. (TimeZone:'WST'; Offset:'+0900'), // Western Summer Time - Australia {do not localize}
  2423. (TimeZone:'WST'; Offset:'+0800'), // Western Standard Time - Australia {do not localize}
  2424. (TimeZone:'X'; Offset:'-1100'), // X-ray Time Zone - Military {do not localize}
  2425. (TimeZone:'Y'; Offset:'-1200'), // Yankee Time Zone - Military {do not localize}
  2426. (TimeZone:'YAKT'; Offset:'+1000'), // Yakutsk Time {do not localize}
  2427. (TimeZone:'YEKT'; Offset:'+0600'), // Yekaterinburg Time {do not localize}
  2428. (TimeZone:'Z'; Offset:'+0000') // Zulu Time Zone - Military {do not localize}
  2429. );
  2430. var
  2431. I: Integer;
  2432. begin
  2433. for I := Low(cTimeZones) to High(cTimeZones) do begin
  2434. if TextIsSame(ATimeZone, cTimeZones[I].TimeZone) then begin
  2435. Result := cTimeZones[I].Offset;
  2436. Exit;
  2437. end;
  2438. end;
  2439. Result := '-0000' {do not localize}
  2440. end;
  2441. function GetGMTOffsetStr(const S: string): string;
  2442. var
  2443. Ignored: TDateTime;
  2444. begin
  2445. Result := S;
  2446. if not RawStrInternetToDateTime(Result, Ignored) then begin
  2447. Result := '';
  2448. end;
  2449. end;
  2450. function GmtOffsetStrToDateTime(const S: string): TDateTime;
  2451. var
  2452. sTmp: String;
  2453. begin
  2454. Result := 0.0;
  2455. sTmp := Trim(S);
  2456. sTmp := Fetch(sTmp);
  2457. if Length(sTmp) > 0 then begin
  2458. if not CharIsInSet(sTmp, 1, '-+') then begin {do not localize}
  2459. sTmp := TimeZoneToGmtOffsetStr(sTmp);
  2460. end else
  2461. begin
  2462. // ISO 8601 has a colon in the middle, ignore it
  2463. if Length(sTmp) = 6 then begin
  2464. if CharEquals(sTmp, 4, ':') then begin {do not localize}
  2465. IdDelete(sTmp, 4, 1);
  2466. end;
  2467. end
  2468. // ISO 8601 allows the minutes to be omitted, add them
  2469. else if Length(sTmp) = 3 then begin
  2470. sTmp := sTmp + '00';
  2471. end;
  2472. if (Length(sTmp) <> 5) or (not IsNumeric(sTmp, 2, 2)) or (not IsNumeric(sTmp, 2, 4)) then begin
  2473. Exit;
  2474. end;
  2475. end;
  2476. try
  2477. Result := EncodeTime(IndyStrToInt(Copy(sTmp, 2, 2)), IndyStrToInt(Copy(sTmp, 4, 2)), 0, 0);
  2478. if CharEquals(sTmp, 1, '-') then begin {do not localize}
  2479. Result := -Result;
  2480. end;
  2481. except
  2482. Result := 0.0;
  2483. end;
  2484. end;
  2485. end;
  2486. {-Always returns date/time relative to GMT!! -Replaces StrInternetToDateTime}
  2487. function GMTToLocalDateTime(S: string): TDateTime;
  2488. var
  2489. DateTimeOffset: TDateTime;
  2490. begin
  2491. if RawStrInternetToDateTime(S, Result) then begin
  2492. DateTimeOffset := GmtOffsetStrToDateTime(S);
  2493. {-Apply GMT and local offsets}
  2494. Result := UTCTimeToLocalTime(Result - DateTimeOffset);
  2495. end;
  2496. end;
  2497. {$IFNDEF HAS_TryStrToInt}
  2498. // TODO: declare this in the interface section...
  2499. function TryStrToInt(const S: string; out Value: Integer): Boolean;
  2500. {$IFDEF USE_INLINE}inline;{$ENDIF}
  2501. var
  2502. E: Integer;
  2503. begin
  2504. Val(S, Value, E);
  2505. Result := E = 0;
  2506. end;
  2507. {$ENDIF}
  2508. { Using the algorithm defined in RFC 6265 section 5.1.1 }
  2509. function CookieStrToLocalDateTime(S: string): TDateTime;
  2510. const
  2511. {
  2512. delimiter = %x09 / %x20-2F / %x3B-40 / %x5B-60 / %x7B-7E
  2513. non-delimiter = %x00-08 / %x0A-1F / DIGIT / ":" / ALPHA / %x7F-FF
  2514. }
  2515. cDelimiters = #9' !"#$%&''()*+,-./;<=>?@[\]^_`{|}~';
  2516. var
  2517. LStartPos, LEndPos: Integer;
  2518. LFoundTime, LFoundDayOfMonth, LFoundMonth, LFoundYear: Boolean;
  2519. LHour, LMinute, LSecond: Integer;
  2520. LYear, LMonth, LDayOfMonth: Integer;
  2521. function ExtractDigits(var AStr: String; MinDigits, MaxDigits: Integer): String;
  2522. var
  2523. LLength: Integer;
  2524. begin
  2525. Result := '';
  2526. LLength := 0;
  2527. while (LLength < Length(AStr)) and (LLength < MaxDigits) do
  2528. begin
  2529. if not IsNumeric(AStr[LLength+1]) then begin
  2530. Break;
  2531. end;
  2532. Inc(LLength);
  2533. end;
  2534. if (LLength > 0) and (LLength >= MinDigits) then begin
  2535. Result := Copy(AStr, 1, LLength);
  2536. AStr := Copy(AStr, LLength+1, MaxInt);
  2537. end;
  2538. end;
  2539. function ParseTime(const AStr: String): Boolean;
  2540. var
  2541. S, LTemp: String;
  2542. begin
  2543. {
  2544. non-digit = %x00-2F / %x3A-FF
  2545. time = hms-time [ non-digit *OCTET ]
  2546. hms-time = time-field ":" time-field ":" time-field
  2547. time-field = 1*2DIGIT
  2548. }
  2549. Result := False;
  2550. S := AStr;
  2551. LTemp := ExtractDigits(S, 1, 2);
  2552. if (LTemp = '') or (not CharEquals(S, 1, ':')) then begin
  2553. Exit;
  2554. end;
  2555. if not TryStrToInt(LTemp, LHour) then begin
  2556. Exit;
  2557. end;
  2558. IdDelete(S, 1, 1);
  2559. LTemp := ExtractDigits(S, 1, 2);
  2560. if (LTemp = '') or (not CharEquals(S, 1, ':')) then begin
  2561. Exit;
  2562. end;
  2563. if not TryStrToInt(LTemp, LMinute) then begin
  2564. Exit;
  2565. end;
  2566. IdDelete(S, 1, 1);
  2567. LTemp := ExtractDigits(S, 1, 2);
  2568. if LTemp = '' then begin
  2569. Exit;
  2570. end;
  2571. if S <> '' then begin
  2572. if IsNumeric(S, 1, 1) then begin
  2573. raise Exception.Create('Invalid Cookie Time');
  2574. end;
  2575. end;
  2576. if not TryStrToInt(LTemp, LSecond) then begin
  2577. Exit;
  2578. end;
  2579. if LHour > 23 then begin
  2580. raise Exception.Create('Invalid Cookie Time');
  2581. end;
  2582. if LMinute > 59 then begin
  2583. raise Exception.Create('Invalid Cookie Time');
  2584. end;
  2585. if LSecond > 59 then begin
  2586. raise Exception.Create('Invalid Cookie Time');
  2587. end;
  2588. Result := True;
  2589. end;
  2590. function ParseDayOfMonth(const AStr: String): Boolean;
  2591. var
  2592. S, LTemp: String;
  2593. begin
  2594. {
  2595. non-digit = %x00-2F / %x3A-FF
  2596. day-of-month = 1*2DIGIT [ non-digit *OCTET ]
  2597. }
  2598. Result := False;
  2599. S := AStr;
  2600. LTemp := ExtractDigits(S, 1, 2);
  2601. if LTemp = '' then begin
  2602. Exit;
  2603. end;
  2604. if S <> '' then begin
  2605. if IsNumeric(S, 1, 1) then begin
  2606. raise Exception.Create('Invalid Cookie Day of Month');
  2607. end;
  2608. end;
  2609. if not TryStrToInt(LTemp, LDayOfMonth) then begin
  2610. Exit;
  2611. end;
  2612. if (LDayOfMonth < 1) or (LDayOfMonth > 31) then begin
  2613. raise Exception.Create('Invalid Cookie Day of Month');
  2614. end;
  2615. Result := True;
  2616. end;
  2617. function ParseMonth(const AStr: String): Boolean;
  2618. var
  2619. S, LTemp: String;
  2620. begin
  2621. {
  2622. month = ( "jan" / "feb" / "mar" / "apr" /
  2623. "may" / "jun" / "jul" / "aug" /
  2624. "sep" / "oct" / "nov" / "dec" ) *OCTET
  2625. }
  2626. Result := False;
  2627. LMonth := PosInStrArray(Copy(AStr, 1, 3), ['jan', 'feb', 'mar', 'apr', 'may', 'jun', 'jul', 'aug', 'sep', 'oct', 'nov', 'dec'], False) + 1;
  2628. if LMonth = 0 then begin
  2629. // RLebeau: per JP, some cookies have been encountered that use numbers
  2630. // instead of names, even though this is not allowed by various RFCs...
  2631. S := AStr;
  2632. LTemp := ExtractDigits(S, 1, 2);
  2633. if LTemp = '' then begin
  2634. Exit;
  2635. end;
  2636. if S <> '' then begin
  2637. if IsNumeric(S, 1, 1) then begin
  2638. raise Exception.Create('Invalid Cookie Month');
  2639. end;
  2640. end;
  2641. if not TryStrToInt(LTemp, LMonth) then begin
  2642. Exit;
  2643. end;
  2644. if (LMonth < 1) or (LMonth > 12) then begin
  2645. raise Exception.Create('Invalid Cookie Month');
  2646. end;
  2647. end;
  2648. Result := True;
  2649. end;
  2650. function ParseYear(const AStr: String): Boolean;
  2651. var
  2652. S, LTemp: String;
  2653. begin
  2654. // year = 2*4DIGIT [ non-digit *OCTET ]
  2655. Result := False;
  2656. S := AStr;
  2657. LTemp := ExtractDigits(S, 2, 4);
  2658. if (LTemp = '') or IsNumeric(S, 1, 1) then begin
  2659. Exit;
  2660. end;
  2661. if not TryStrToInt(AStr, LYear) then begin
  2662. Exit;
  2663. end;
  2664. if (LYear >= 70) and (LYear <= 99) then begin
  2665. Inc(LYear, 1900);
  2666. end
  2667. else if (LYear >= 0) and (LYear <= 69) then begin
  2668. Inc(LYear, 2000);
  2669. end;
  2670. if LYear < 1601 then begin
  2671. raise Exception.Create('Invalid Cookie Year');
  2672. end;
  2673. Result := True;
  2674. end;
  2675. procedure ProcessToken(const AStr: String);
  2676. begin
  2677. if not LFoundTime then begin
  2678. if ParseTime(AStr) then begin
  2679. LFoundTime := True;
  2680. Exit;
  2681. end;
  2682. end;
  2683. if not LFoundDayOfMonth then begin
  2684. if ParseDayOfMonth(AStr) then begin
  2685. LFoundDayOfMonth := True;
  2686. Exit;
  2687. end;
  2688. end;
  2689. if not LFoundMonth then begin
  2690. if ParseMonth(AStr) then begin
  2691. LFoundMonth := True;
  2692. Exit;
  2693. end;
  2694. end;
  2695. if not LFoundYear then begin
  2696. if ParseYear(AStr) then begin
  2697. LFoundYear := True;
  2698. Exit;
  2699. end;
  2700. end;
  2701. end;
  2702. begin
  2703. LFoundTime := False;
  2704. LFoundDayOfMonth := False;
  2705. LFoundMonth := False;
  2706. LFoundYear := False;
  2707. try
  2708. LEndPos := 0;
  2709. repeat
  2710. LStartPos := FindFirstNotOf(cDelimiters, S, -1, LEndPos+1);
  2711. if LStartPos = 0 then begin
  2712. Break;
  2713. end;
  2714. LEndPos := FindFirstOf(cDelimiters, S, -1, LStartPos+1);
  2715. if LEndPos = 0 then begin
  2716. ProcessToken(Copy(S, LStartPos, MaxInt));
  2717. Break;
  2718. end;
  2719. ProcessToken(Copy(S, LStartPos, LEndPos-LStartPos));
  2720. until False;
  2721. if (not LFoundDayOfMonth) or (not LFoundMonth) or (not LFoundYear) or (not LFoundTime) then begin
  2722. raise Exception.Create('Invalid Cookie Date format');
  2723. end;
  2724. Result := EncodeDate(LYear, LMonth, LDayOfMonth) + EncodeTime(LHour, LMinute, LSecond, 0);
  2725. Result := UTCTimeToLocalTime(Result);
  2726. except
  2727. Result := 0.0;
  2728. end;
  2729. end;
  2730. { Takes a UInt32 value and returns the string representation of it's binary value} {Do not Localize}
  2731. function IntToBin(Value: UInt32): string;
  2732. var
  2733. i: Integer;
  2734. {$IFDEF STRING_IS_IMMUTABLE}
  2735. LSB: TStringBuilder;
  2736. {$ENDIF}
  2737. begin
  2738. {$IFDEF STRING_IS_IMMUTABLE}
  2739. LSB := TStringBuilder.Create(32);
  2740. {$ELSE}
  2741. SetLength(Result, 32);
  2742. {$ENDIF}
  2743. for i := 1 to 32 do begin
  2744. if ((Value shl (i-1)) shr 31) = 0 then begin
  2745. {$IFDEF STRING_IS_IMMUTABLE}
  2746. LSB.Append(Char('0')); {do not localize}
  2747. {$ELSE}
  2748. Result[i] := '0'; {do not localize}
  2749. {$ENDIF}
  2750. end else begin
  2751. {$IFDEF STRING_IS_IMMUTABLE}
  2752. LSB.Append(Char('1')); {do not localize}
  2753. {$ELSE}
  2754. Result[i] := '1'; {do not localize}
  2755. {$ENDIF}
  2756. end;
  2757. end;
  2758. {$IFDEF STRING_IS_IMMUTABLE}
  2759. Result := LSB.ToString;
  2760. {$ENDIF}
  2761. end;
  2762. { TIdMimeTable }
  2763. {$IFDEF UNIX}
  2764. procedure LoadMIME(const AFileName : String; AMIMEList : TStrings);
  2765. var
  2766. KeyList: TStringList;
  2767. i, p: Integer;
  2768. s, LMimeType, LExtension: String;
  2769. begin
  2770. if FileExists(AFileName) then begin {Do not localize}
  2771. // build list from /etc/mime.types style list file
  2772. // I'm lazy so I'm using a stringlist to load the file, ideally
  2773. // this should not be done, reading the file line by line is better
  2774. // I think - at least in terms of storage
  2775. KeyList := TStringList.Create;
  2776. try
  2777. // TODO: use TStreamReader instead, on versions that support it
  2778. KeyList.LoadFromFile(AFileName); {Do not localize}
  2779. for i := 0 to KeyList.Count -1 do begin
  2780. s := KeyList[i];
  2781. p := IndyPos('#', s); {Do not localize}
  2782. if p > 0 then begin
  2783. SetLength(s, p-1);
  2784. end;
  2785. if s <> '' then begin {Do not localize}
  2786. s := Trim(s);
  2787. LMimeType := IndyLowerCase(Fetch(s));
  2788. if LMimeType <> '' then begin {Do not localize}
  2789. while s <> '' do begin {Do not localize}
  2790. LExtension := IndyLowerCase(Fetch(s));
  2791. if LExtension <> '' then {Do not localize}
  2792. try
  2793. if LExtension[1] <> '.' then begin
  2794. LExtension := '.' + LExtension; {Do not localize}
  2795. end;
  2796. AMIMEList.Values[LExtension] := LMimeType;
  2797. except
  2798. on EListError do {ignore} ;
  2799. end;
  2800. end;
  2801. end;
  2802. end;
  2803. end;
  2804. except
  2805. on EFOpenError do {ignore} ;
  2806. end;
  2807. End;
  2808. end;
  2809. {$ENDIF}
  2810. procedure FillMimeTable(const AMIMEList: TStrings; const ALoadFromOS: Boolean = True);
  2811. {$IFDEF WINDOWS}
  2812. var
  2813. reg: TRegistry;
  2814. KeyList: TStringList;
  2815. i: Integer;
  2816. s, LExt: String;
  2817. {$ENDIF}
  2818. begin
  2819. { Protect if someone is already filled (custom MomeConst) }
  2820. if not Assigned(AMIMEList) then begin
  2821. Exit;
  2822. end;
  2823. if AMIMEList.Count > 0 then begin
  2824. Exit;
  2825. end;
  2826. {NOTE: All of these strings should never be translated
  2827. because they are protocol specific and are important for some
  2828. web-browsers}
  2829. { Animation }
  2830. AMIMEList.Add('.nml=animation/narrative'); {Do not Localize}
  2831. { Audio }
  2832. AMIMEList.Add('.aac=audio/mp4');
  2833. AMIMEList.Add('.aif=audio/x-aiff'); {Do not Localize}
  2834. AMIMEList.Add('.aifc=audio/x-aiff'); {Do not Localize}
  2835. AMIMEList.Add('.aiff=audio/x-aiff'); {Do not Localize}
  2836. AMIMEList.Add('.au=audio/basic'); {Do not Localize}
  2837. AMIMEList.Add('.gsm=audio/x-gsm'); {Do not Localize}
  2838. AMIMEList.Add('.kar=audio/midi'); {Do not Localize}
  2839. AMIMEList.Add('.m3u=audio/mpegurl'); {Do not Localize}
  2840. AMIMEList.Add('.m4a=audio/x-mpg'); {Do not Localize}
  2841. AMIMEList.Add('.mid=audio/midi'); {Do not Localize}
  2842. AMIMEList.Add('.midi=audio/midi'); {Do not Localize}
  2843. AMIMEList.Add('.mpega=audio/x-mpg'); {Do not Localize}
  2844. AMIMEList.Add('.mp2=audio/x-mpg'); {Do not Localize}
  2845. AMIMEList.Add('.mp3=audio/x-mpg'); {Do not Localize}
  2846. AMIMEList.Add('.mpga=audio/x-mpg'); {Do not Localize}
  2847. AMIMEList.Add('.m3u=audio/x-mpegurl'); {Do not Localize}
  2848. AMIMEList.Add('.pls=audio/x-scpls'); {Do not Localize}
  2849. AMIMEList.Add('.qcp=audio/vnd.qcelp'); {Do not Localize}
  2850. AMIMEList.Add('.ra=audio/x-realaudio'); {Do not Localize}
  2851. AMIMEList.Add('.ram=audio/x-pn-realaudio'); {Do not Localize}
  2852. AMIMEList.Add('.rm=audio/x-pn-realaudio'); {Do not Localize}
  2853. AMIMEList.Add('.sd2=audio/x-sd2'); {Do not Localize}
  2854. AMIMEList.Add('.sid=audio/prs.sid'); {Do not Localize}
  2855. AMIMEList.Add('.snd=audio/basic'); {Do not Localize}
  2856. AMIMEList.Add('.wav=audio/x-wav'); {Do not Localize}
  2857. AMIMEList.Add('.wax=audio/x-ms-wax'); {Do not Localize}
  2858. AMIMEList.Add('.wma=audio/x-ms-wma'); {Do not Localize}
  2859. AMIMEList.Add('.mjf=audio/x-vnd.AudioExplosion.MjuiceMediaFile'); {Do not Localize}
  2860. { Image }
  2861. AMIMEList.Add('.art=image/x-jg'); {Do not Localize}
  2862. AMIMEList.Add('.bmp=image/bmp'); {Do not Localize}
  2863. AMIMEList.Add('.cdr=image/x-coreldraw'); {Do not Localize}
  2864. AMIMEList.Add('.cdt=image/x-coreldrawtemplate'); {Do not Localize}
  2865. AMIMEList.Add('.cpt=image/x-corelphotopaint'); {Do not Localize}
  2866. AMIMEList.Add('.djv=image/vnd.djvu'); {Do not Localize}
  2867. AMIMEList.Add('.djvu=image/vnd.djvu'); {Do not Localize}
  2868. AMIMEList.Add('.gif=image/gif'); {Do not Localize}
  2869. AMIMEList.Add('.ief=image/ief'); {Do not Localize}
  2870. AMIMEList.Add('.ico=image/x-icon'); {Do not Localize}
  2871. AMIMEList.Add('.jng=image/x-jng'); {Do not Localize}
  2872. AMIMEList.Add('.jpg=image/jpeg'); {Do not Localize}
  2873. AMIMEList.Add('.jpeg=image/jpeg'); {Do not Localize}
  2874. AMIMEList.Add('.jpe=image/jpeg'); {Do not Localize}
  2875. AMIMEList.Add('.pat=image/x-coreldrawpattern'); {Do not Localize}
  2876. AMIMEList.Add('.pcx=image/pcx'); {Do not Localize}
  2877. AMIMEList.Add('.pbm=image/x-portable-bitmap'); {Do not Localize}
  2878. AMIMEList.Add('.pgm=image/x-portable-graymap'); {Do not Localize}
  2879. AMIMEList.Add('.pict=image/x-pict'); {Do not Localize}
  2880. AMIMEList.Add('.png=image/x-png'); {Do not Localize}
  2881. AMIMEList.Add('.pnm=image/x-portable-anymap'); {Do not Localize}
  2882. AMIMEList.Add('.pntg=image/x-macpaint'); {Do not Localize}
  2883. AMIMEList.Add('.ppm=image/x-portable-pixmap'); {Do not Localize}
  2884. AMIMEList.Add('.psd=image/x-psd'); {Do not Localize}
  2885. AMIMEList.Add('.qtif=image/x-quicktime'); {Do not Localize}
  2886. AMIMEList.Add('.ras=image/x-cmu-raster'); {Do not Localize}
  2887. AMIMEList.Add('.rf=image/vnd.rn-realflash'); {Do not Localize}
  2888. AMIMEList.Add('.rgb=image/x-rgb'); {Do not Localize}
  2889. AMIMEList.Add('.rp=image/vnd.rn-realpix'); {Do not Localize}
  2890. AMIMEList.Add('.sgi=image/x-sgi'); {Do not Localize}
  2891. AMIMEList.Add('.svg=image/svg+xml'); {Do not Localize}
  2892. AMIMEList.Add('.svgz=image/svg+xml'); {Do not Localize}
  2893. AMIMEList.Add('.targa=image/x-targa'); {Do not Localize}
  2894. AMIMEList.Add('.tif=image/x-tiff'); {Do not Localize}
  2895. AMIMEList.Add('.wbmp=image/vnd.wap.wbmp'); {Do not Localize}
  2896. AMIMEList.Add('.webp=image/webp'); {Do not localize}
  2897. AMIMEList.Add('.xbm=image/xbm'); {Do not Localize}
  2898. AMIMEList.Add('.xbm=image/x-xbitmap'); {Do not Localize}
  2899. AMIMEList.Add('.xpm=image/x-xpixmap'); {Do not Localize}
  2900. AMIMEList.Add('.xwd=image/x-xwindowdump'); {Do not Localize}
  2901. { Text }
  2902. AMIMEList.Add('.323=text/h323'); {Do not Localize}
  2903. AMIMEList.Add('.xml=text/xml'); {Do not Localize}
  2904. AMIMEList.Add('.uls=text/iuls'); {Do not Localize}
  2905. AMIMEList.Add('.txt=text/plain'); {Do not Localize}
  2906. AMIMEList.Add('.rtx=text/richtext'); {Do not Localize}
  2907. AMIMEList.Add('.wsc=text/scriptlet'); {Do not Localize}
  2908. AMIMEList.Add('.rt=text/vnd.rn-realtext'); {Do not Localize}
  2909. AMIMEList.Add('.htt=text/webviewhtml'); {Do not Localize}
  2910. AMIMEList.Add('.htc=text/x-component'); {Do not Localize}
  2911. AMIMEList.Add('.vcf=text/x-vcard'); {Do not Localize}
  2912. { Video }
  2913. AMIMEList.Add('.asf=video/x-ms-asf'); {Do not Localize}
  2914. AMIMEList.Add('.asx=video/x-ms-asf'); {Do not Localize}
  2915. AMIMEList.Add('.avi=video/x-msvideo'); {Do not Localize}
  2916. AMIMEList.Add('.dl=video/dl'); {Do not Localize}
  2917. AMIMEList.Add('.dv=video/dv'); {Do not Localize}
  2918. AMIMEList.Add('.flc=video/flc'); {Do not Localize}
  2919. AMIMEList.Add('.fli=video/fli'); {Do not Localize}
  2920. AMIMEList.Add('.gl=video/gl'); {Do not Localize}
  2921. AMIMEList.Add('.lsf=video/x-la-asf'); {Do not Localize}
  2922. AMIMEList.Add('.lsx=video/x-la-asf'); {Do not Localize}
  2923. AMIMEList.Add('.mng=video/x-mng'); {Do not Localize}
  2924. AMIMEList.Add('.mp2=video/mpeg'); {Do not Localize}
  2925. AMIMEList.Add('.mp3=video/mpeg'); {Do not Localize}
  2926. AMIMEList.Add('.mp4=video/mpeg'); {Do not Localize}
  2927. AMIMEList.Add('.mpeg=video/x-mpeg2a'); {Do not Localize}
  2928. AMIMEList.Add('.mpa=video/mpeg'); {Do not Localize}
  2929. AMIMEList.Add('.mpe=video/mpeg'); {Do not Localize}
  2930. AMIMEList.Add('.mpg=video/mpeg'); {Do not Localize}
  2931. AMIMEList.Add('.ogv=video/ogg'); {Do not Localize}
  2932. AMIMEList.Add('.moov=video/quicktime'); {Do not Localize}
  2933. AMIMEList.Add('.mov=video/quicktime'); {Do not Localize}
  2934. AMIMEList.Add('.mxu=video/vnd.mpegurl'); {Do not Localize}
  2935. AMIMEList.Add('.qt=video/quicktime'); {Do not Localize}
  2936. AMIMEList.Add('.qtc=video/x-qtc'); {Do not loccalize}
  2937. AMIMEList.Add('.rv=video/vnd.rn-realvideo'); {Do not Localize}
  2938. AMIMEList.Add('.ivf=video/x-ivf'); {Do not Localize}
  2939. AMIMEList.Add('.webm=video/webm'); {Do not Localize}
  2940. AMIMEList.Add('.wm=video/x-ms-wm'); {Do not Localize}
  2941. AMIMEList.Add('.wmp=video/x-ms-wmp'); {Do not Localize}
  2942. AMIMEList.Add('.wmv=video/x-ms-wmv'); {Do not Localize}
  2943. AMIMEList.Add('.wmx=video/x-ms-wmx'); {Do not Localize}
  2944. AMIMEList.Add('.wvx=video/x-ms-wvx'); {Do not Localize}
  2945. AMIMEList.Add('.rms=video/vnd.rn-realvideo-secure'); {Do not Localize}
  2946. AMIMEList.Add('.asx=video/x-ms-asf-plugin'); {Do not Localize}
  2947. AMIMEList.Add('.movie=video/x-sgi-movie'); {Do not Localize}
  2948. { Application }
  2949. AMIMEList.Add('.7z=application/x-7z-compressed'); {Do not Localize}
  2950. AMIMEList.Add('.a=application/x-archive'); {Do not Localize}
  2951. AMIMEList.Add('.aab=application/x-authorware-bin'); {Do not Localize}
  2952. AMIMEList.Add('.aam=application/x-authorware-map'); {Do not Localize}
  2953. AMIMEList.Add('.aas=application/x-authorware-seg'); {Do not Localize}
  2954. AMIMEList.Add('.abw=application/x-abiword'); {Do not Localize}
  2955. AMIMEList.Add('.ace=application/x-ace-compressed'); {Do not Localize}
  2956. AMIMEList.Add('.ai=application/postscript'); {Do not Localize}
  2957. AMIMEList.Add('.alz=application/x-alz-compressed'); {Do not Localize}
  2958. AMIMEList.Add('.ani=application/x-navi-animation'); {Do not Localize}
  2959. AMIMEList.Add('.arj=application/x-arj'); {Do not Localize}
  2960. AMIMEList.Add('.asf=application/vnd.ms-asf'); {Do not Localize}
  2961. AMIMEList.Add('.bat=application/x-msdos-program'); {Do not Localize}
  2962. AMIMEList.Add('.bcpio=application/x-bcpio'); {Do not Localize}
  2963. AMIMEList.Add('.boz=application/x-bzip2'); {Do not Localize}
  2964. AMIMEList.Add('.bz=application/x-bzip');
  2965. AMIMEList.Add('.bz2=application/x-bzip2'); {Do not Localize}
  2966. AMIMEList.Add('.cab=application/vnd.ms-cab-compressed'); {Do not Localize}
  2967. AMIMEList.Add('.cat=application/vnd.ms-pki.seccat'); {Do not Localize}
  2968. AMIMEList.Add('.ccn=application/x-cnc'); {Do not Localize}
  2969. AMIMEList.Add('.cco=application/x-cocoa'); {Do not Localize}
  2970. AMIMEList.Add('.cdf=application/x-cdf'); {Do not Localize}
  2971. AMIMEList.Add('.cer=application/x-x509-ca-cert'); {Do not Localize}
  2972. AMIMEList.Add('.chm=application/vnd.ms-htmlhelp'); {Do not Localize}
  2973. AMIMEList.Add('.chrt=application/vnd.kde.kchart'); {Do not Localize}
  2974. AMIMEList.Add('.cil=application/vnd.ms-artgalry'); {Do not Localize}
  2975. AMIMEList.Add('.class=application/java-vm'); {Do not Localize}
  2976. AMIMEList.Add('.com=application/x-msdos-program'); {Do not Localize}
  2977. AMIMEList.Add('.clp=application/x-msclip'); {Do not Localize}
  2978. AMIMEList.Add('.cpio=application/x-cpio'); {Do not Localize}
  2979. AMIMEList.Add('.cpt=application/mac-compactpro'); {Do not Localize}
  2980. AMIMEList.Add('.cqk=application/x-calquick'); {Do not Localize}
  2981. AMIMEList.Add('.crd=application/x-mscardfile'); {Do not Localize}
  2982. AMIMEList.Add('.crl=application/pkix-crl'); {Do not Localize}
  2983. AMIMEList.Add('.csh=application/x-csh'); {Do not Localize}
  2984. AMIMEList.Add('.dar=application/x-dar'); {Do not Localize}
  2985. AMIMEList.Add('.dbf=application/x-dbase'); {Do not Localize}
  2986. AMIMEList.Add('.dcr=application/x-director'); {Do not Localize}
  2987. AMIMEList.Add('.deb=application/x-debian-package'); {Do not Localize}
  2988. AMIMEList.Add('.dir=application/x-director'); {Do not Localize}
  2989. AMIMEList.Add('.dist=vnd.apple.installer+xml'); {Do not Localize}
  2990. AMIMEList.Add('.distz=vnd.apple.installer+xml'); {Do not Localize}
  2991. AMIMEList.Add('.dll=application/x-msdos-program'); {Do not Localize}
  2992. AMIMEList.Add('.dmg=application/x-apple-diskimage'); {Do not Localize}
  2993. AMIMEList.Add('.doc=application/msword'); {Do not Localize}
  2994. AMIMEList.Add('.dot=application/msword'); {Do not Localize}
  2995. AMIMEList.Add('.dvi=application/x-dvi'); {Do not Localize}
  2996. AMIMEList.Add('.dxr=application/x-director'); {Do not Localize}
  2997. AMIMEList.Add('.ebk=application/x-expandedbook'); {Do not Localize}
  2998. AMIMEList.Add('.eps=application/postscript'); {Do not Localize}
  2999. AMIMEList.Add('.evy=application/envoy'); {Do not Localize}
  3000. AMIMEList.Add('.exe=application/x-msdos-program'); {Do not Localize}
  3001. AMIMEList.Add('.fdf=application/vnd.fdf'); {Do not Localize}
  3002. AMIMEList.Add('.fif=application/fractals'); {Do not Localize}
  3003. AMIMEList.Add('.flm=application/vnd.kde.kivio'); {Do not Localize}
  3004. AMIMEList.Add('.fml=application/x-file-mirror-list'); {Do not Localize}
  3005. AMIMEList.Add('.gzip=application/x-gzip'); {Do not Localize}
  3006. AMIMEList.Add('.gnumeric=application/x-gnumeric'); {Do not Localize}
  3007. AMIMEList.Add('.gtar=application/x-gtar'); {Do not Localize}
  3008. AMIMEList.Add('.gz=application/x-gzip'); {Do not Localize}
  3009. AMIMEList.Add('.hdf=application/x-hdf'); {Do not Localize}
  3010. AMIMEList.Add('.hlp=application/winhlp'); {Do not Localize}
  3011. AMIMEList.Add('.hpf=application/x-icq-hpf'); {Do not Localize}
  3012. AMIMEList.Add('.hqx=application/mac-binhex40'); {Do not Localize}
  3013. AMIMEList.Add('.hta=application/hta'); {Do not Localize}
  3014. AMIMEList.Add('.ims=application/vnd.ms-ims'); {Do not Localize}
  3015. AMIMEList.Add('.ins=application/x-internet-signup'); {Do not Localize}
  3016. AMIMEList.Add('.iii=application/x-iphone'); {Do not Localize}
  3017. AMIMEList.Add('.iso=application/x-iso9660-image'); {Do not Localize}
  3018. AMIMEList.Add('.jar=application/java-archive'); {Do not Localize}
  3019. AMIMEList.Add('.karbon=application/vnd.kde.karbon'); {Do not Localize}
  3020. AMIMEList.Add('.kfo=application/vnd.kde.kformula'); {Do not Localize}
  3021. AMIMEList.Add('.kon=application/vnd.kde.kontour'); {Do not Localize}
  3022. AMIMEList.Add('.kpr=application/vnd.kde.kpresenter'); {Do not Localize}
  3023. AMIMEList.Add('.kpt=application/vnd.kde.kpresenter'); {Do not Localize}
  3024. AMIMEList.Add('.kwd=application/vnd.kde.kword'); {Do not Localize}
  3025. AMIMEList.Add('.kwt=application/vnd.kde.kword'); {Do not Localize}
  3026. AMIMEList.Add('.latex=application/x-latex'); {Do not Localize}
  3027. AMIMEList.Add('.lha=application/x-lzh'); {Do not Localize}
  3028. AMIMEList.Add('.lcc=application/fastman'); {Do not Localize}
  3029. AMIMEList.Add('.lrm=application/vnd.ms-lrm'); {Do not Localize}
  3030. AMIMEList.Add('.lz=application/x-lzip'); {Do not Localize}
  3031. AMIMEList.Add('.lzh=application/x-lzh'); {Do not Localize}
  3032. AMIMEList.Add('.lzma=application/x-lzma'); {Do not Localize}
  3033. AMIMEList.Add('.lzo=application/x-lzop'); {Do not Localize}
  3034. AMIMEList.Add('.lzx=application/x-lzx');
  3035. AMIMEList.Add('.m13=application/x-msmediaview'); {Do not Localize}
  3036. AMIMEList.Add('.m14=application/x-msmediaview'); {Do not Localize}
  3037. AMIMEList.Add('.mpp=application/vnd.ms-project'); {Do not Localize}
  3038. AMIMEList.Add('.mvb=application/x-msmediaview'); {Do not Localize}
  3039. AMIMEList.Add('.man=application/x-troff-man'); {Do not Localize}
  3040. AMIMEList.Add('.mdb=application/x-msaccess'); {Do not Localize}
  3041. AMIMEList.Add('.me=application/x-troff-me'); {Do not Localize}
  3042. AMIMEList.Add('.ms=application/x-troff-ms'); {Do not Localize}
  3043. AMIMEList.Add('.msi=application/x-msi'); {Do not Localize}
  3044. AMIMEList.Add('.mpkg=vnd.apple.installer+xml'); {Do not Localize}
  3045. AMIMEList.Add('.mny=application/x-msmoney'); {Do not Localize}
  3046. AMIMEList.Add('.nix=application/x-mix-transfer'); {Do not Localize}
  3047. AMIMEList.Add('.o=application/x-object'); {Do not Localize}
  3048. AMIMEList.Add('.oda=application/oda'); {Do not Localize}
  3049. AMIMEList.Add('.odb=application/vnd.oasis.opendocument.database'); {Do not Localize}
  3050. AMIMEList.Add('.odc=application/vnd.oasis.opendocument.chart'); {Do not Localize}
  3051. AMIMEList.Add('.odf=application/vnd.oasis.opendocument.formula'); {Do not Localize}
  3052. AMIMEList.Add('.odg=application/vnd.oasis.opendocument.graphics'); {Do not Localize}
  3053. AMIMEList.Add('.odi=application/vnd.oasis.opendocument.image'); {Do not Localize}
  3054. AMIMEList.Add('.odm=application/vnd.oasis.opendocument.text-master'); {Do not Localize}
  3055. AMIMEList.Add('.odp=application/vnd.oasis.opendocument.presentation'); {Do not Localize}
  3056. AMIMEList.Add('.ods=application/vnd.oasis.opendocument.spreadsheet'); {Do not Localize}
  3057. AMIMEList.Add('.ogg=application/ogg'); {Do not Localize}
  3058. AMIMEList.Add('.odt=application/vnd.oasis.opendocument.text'); {Do not Localize}
  3059. AMIMEList.Add('.otg=application/vnd.oasis.opendocument.graphics-template'); {Do not Localize}
  3060. AMIMEList.Add('.oth=application/vnd.oasis.opendocument.text-web'); {Do not Localize}
  3061. AMIMEList.Add('.otp=application/vnd.oasis.opendocument.presentation-template'); {Do not Localize}
  3062. AMIMEList.Add('.ots=application/vnd.oasis.opendocument.spreadsheet-template'); {Do not Localize}
  3063. AMIMEList.Add('.ott=application/vnd.oasis.opendocument.text-template'); {Do not Localize}
  3064. AMIMEList.Add('.p10=application/pkcs10'); {Do not Localize}
  3065. AMIMEList.Add('.p12=application/x-pkcs12'); {Do not Localize}
  3066. AMIMEList.Add('.p7b=application/x-pkcs7-certificates'); {Do not Localize}
  3067. AMIMEList.Add('.p7m=application/pkcs7-mime'); {Do not Localize}
  3068. AMIMEList.Add('.p7r=application/x-pkcs7-certreqresp'); {Do not Localize}
  3069. AMIMEList.Add('.p7s=application/pkcs7-signature'); {Do not Localize}
  3070. AMIMEList.Add('.package=application/vnd.autopackage'); {Do not Localize}
  3071. AMIMEList.Add('.pfr=application/font-tdpfr'); {Do not Localize}
  3072. AMIMEList.Add('.pkg=vnd.apple.installer+xml'); {Do not Localize}
  3073. AMIMEList.Add('.pdf=application/pdf'); {Do not Localize}
  3074. AMIMEList.Add('.pko=application/vnd.ms-pki.pko'); {Do not Localize}
  3075. AMIMEList.Add('.pl=application/x-perl'); {Do not Localize}
  3076. AMIMEList.Add('.pnq=application/x-icq-pnq'); {Do not Localize}
  3077. AMIMEList.Add('.pot=application/mspowerpoint'); {Do not Localize}
  3078. AMIMEList.Add('.pps=application/mspowerpoint'); {Do not Localize}
  3079. AMIMEList.Add('.ppt=application/mspowerpoint'); {Do not Localize}
  3080. AMIMEList.Add('.ppz=application/mspowerpoint'); {Do not Localize}
  3081. AMIMEList.Add('.ps=application/postscript'); {Do not Localize}
  3082. AMIMEList.Add('.pub=application/x-mspublisher'); {Do not Localize}
  3083. AMIMEList.Add('.qpw=application/x-quattropro'); {Do not Localize}
  3084. AMIMEList.Add('.qtl=application/x-quicktimeplayer'); {Do not Localize}
  3085. AMIMEList.Add('.rar=application/rar'); {Do not Localize}
  3086. AMIMEList.Add('.rdf=application/rdf+xml'); {Do not Localize}
  3087. AMIMEList.Add('.rjs=application/vnd.rn-realsystem-rjs'); {Do not Localize}
  3088. AMIMEList.Add('.rm=application/vnd.rn-realmedia'); {Do not Localize}
  3089. AMIMEList.Add('.rmf=application/vnd.rmf'); {Do not Localize}
  3090. AMIMEList.Add('.rmp=application/vnd.rn-rn_music_package'); {Do not Localize}
  3091. AMIMEList.Add('.rmx=application/vnd.rn-realsystem-rmx'); {Do not Localize}
  3092. AMIMEList.Add('.rnx=application/vnd.rn-realplayer'); {Do not Localize}
  3093. AMIMEList.Add('.rpm=application/x-redhat-package-manager');
  3094. AMIMEList.Add('.rsml=application/vnd.rn-rsml'); {Do not Localize}
  3095. AMIMEList.Add('.rtsp=application/x-rtsp'); {Do not Localize}
  3096. AMIMEList.Add('.rss=application/rss+xml'); {Do not Localize}
  3097. AMIMEList.Add('.scm=application/x-icq-scm'); {Do not Localize}
  3098. AMIMEList.Add('.ser=application/java-serialized-object'); {Do not Localize}
  3099. AMIMEList.Add('.scd=application/x-msschedule'); {Do not Localize}
  3100. AMIMEList.Add('.sda=application/vnd.stardivision.draw'); {Do not Localize}
  3101. AMIMEList.Add('.sdc=application/vnd.stardivision.calc'); {Do not Localize}
  3102. AMIMEList.Add('.sdd=application/vnd.stardivision.impress'); {Do not Localize}
  3103. AMIMEList.Add('.sdp=application/x-sdp'); {Do not Localize}
  3104. AMIMEList.Add('.setpay=application/set-payment-initiation'); {Do not Localize}
  3105. AMIMEList.Add('.setreg=application/set-registration-initiation'); {Do not Localize}
  3106. AMIMEList.Add('.sh=application/x-sh'); {Do not Localize}
  3107. AMIMEList.Add('.shar=application/x-shar'); {Do not Localize}
  3108. AMIMEList.Add('.shw=application/presentations'); {Do not Localize}
  3109. AMIMEList.Add('.sit=application/x-stuffit'); {Do not Localize}
  3110. AMIMEList.Add('.sitx=application/x-stuffitx'); {Do not localize}
  3111. AMIMEList.Add('.skd=application/x-koan'); {Do not Localize}
  3112. AMIMEList.Add('.skm=application/x-koan'); {Do not Localize}
  3113. AMIMEList.Add('.skp=application/x-koan'); {Do not Localize}
  3114. AMIMEList.Add('.skt=application/x-koan'); {Do not Localize}
  3115. AMIMEList.Add('.smf=application/vnd.stardivision.math'); {Do not Localize}
  3116. AMIMEList.Add('.smi=application/smil'); {Do not Localize}
  3117. AMIMEList.Add('.smil=application/smil'); {Do not Localize}
  3118. AMIMEList.Add('.spl=application/futuresplash'); {Do not Localize}
  3119. AMIMEList.Add('.ssm=application/streamingmedia'); {Do not Localize}
  3120. AMIMEList.Add('.sst=application/vnd.ms-pki.certstore'); {Do not Localize}
  3121. AMIMEList.Add('.stc=application/vnd.sun.xml.calc.template'); {Do not Localize}
  3122. AMIMEList.Add('.std=application/vnd.sun.xml.draw.template'); {Do not Localize}
  3123. AMIMEList.Add('.sti=application/vnd.sun.xml.impress.template'); {Do not Localize}
  3124. AMIMEList.Add('.stl=application/vnd.ms-pki.stl'); {Do not Localize}
  3125. AMIMEList.Add('.stw=application/vnd.sun.xml.writer.template'); {Do not Localize}
  3126. AMIMEList.Add('.svi=application/softvision'); {Do not Localize}
  3127. AMIMEList.Add('.sv4cpio=application/x-sv4cpio'); {Do not Localize}
  3128. AMIMEList.Add('.sv4crc=application/x-sv4crc'); {Do not Localize}
  3129. AMIMEList.Add('.swf=application/x-shockwave-flash'); {Do not Localize}
  3130. AMIMEList.Add('.swf1=application/x-shockwave-flash'); {Do not Localize}
  3131. AMIMEList.Add('.sxc=application/vnd.sun.xml.calc'); {Do not Localize}
  3132. AMIMEList.Add('.sxi=application/vnd.sun.xml.impress'); {Do not Localize}
  3133. AMIMEList.Add('.sxm=application/vnd.sun.xml.math'); {Do not Localize}
  3134. AMIMEList.Add('.sxw=application/vnd.sun.xml.writer'); {Do not Localize}
  3135. AMIMEList.Add('.sxg=application/vnd.sun.xml.writer.global'); {Do not Localize}
  3136. AMIMEList.Add('.t=application/x-troff'); {Do not Localize}
  3137. AMIMEList.Add('.tar=application/x-tar'); {Do not Localize}
  3138. AMIMEList.Add('.tcl=application/x-tcl'); {Do not Localize}
  3139. AMIMEList.Add('.tex=application/x-tex'); {Do not Localize}
  3140. AMIMEList.Add('.texi=application/x-texinfo'); {Do not Localize}
  3141. AMIMEList.Add('.texinfo=application/x-texinfo'); {Do not Localize}
  3142. AMIMEList.Add('.tbz=application/x-bzip-compressed-tar'); {Do not Localize}
  3143. AMIMEList.Add('.tbz2=application/x-bzip-compressed-tar'); {Do not Localize}
  3144. AMIMEList.Add('.tgz=application/x-compressed-tar'); {Do not Localize}
  3145. AMIMEList.Add('.tlz=application/x-lzma-compressed-tar'); {Do not Localize}
  3146. AMIMEList.Add('.tr=application/x-troff'); {Do not Localize}
  3147. AMIMEList.Add('.trm=application/x-msterminal'); {Do not Localize}
  3148. AMIMEList.Add('.troff=application/x-troff'); {Do not Localize}
  3149. AMIMEList.Add('.tsp=application/dsptype'); {Do not Localize}
  3150. AMIMEList.Add('.torrent=application/x-bittorrent'); {Do not Localize}
  3151. AMIMEList.Add('.ttz=application/t-time'); {Do not Localize}
  3152. AMIMEList.Add('.txz=application/x-xz-compressed-tar'); {Do not localize}
  3153. AMIMEList.Add('.udeb=application/x-debian-package'); {Do not Localize}
  3154. AMIMEList.Add('.uin=application/x-icq'); {Do not Localize}
  3155. AMIMEList.Add('.urls=application/x-url-list'); {Do not Localize}
  3156. AMIMEList.Add('.ustar=application/x-ustar'); {Do not Localize}
  3157. AMIMEList.Add('.vcd=application/x-cdlink'); {Do not Localize}
  3158. AMIMEList.Add('.vor=application/vnd.stardivision.writer'); {Do not Localize}
  3159. AMIMEList.Add('.vsl=application/x-cnet-vsl'); {Do not Localize}
  3160. AMIMEList.Add('.wcm=application/vnd.ms-works'); {Do not Localize}
  3161. AMIMEList.Add('.wb1=application/x-quattropro'); {Do not Localize}
  3162. AMIMEList.Add('.wb2=application/x-quattropro'); {Do not Localize}
  3163. AMIMEList.Add('.wb3=application/x-quattropro'); {Do not Localize}
  3164. AMIMEList.Add('.wdb=application/vnd.ms-works'); {Do not Localize}
  3165. AMIMEList.Add('.wks=application/vnd.ms-works'); {Do not Localize}
  3166. AMIMEList.Add('.wmd=application/x-ms-wmd'); {Do not Localize}
  3167. AMIMEList.Add('.wms=application/x-ms-wms'); {Do not Localize}
  3168. AMIMEList.Add('.wmz=application/x-ms-wmz'); {Do not Localize}
  3169. AMIMEList.Add('.wp5=application/wordperfect5.1'); {Do not Localize}
  3170. AMIMEList.Add('.wpd=application/wordperfect'); {Do not Localize}
  3171. AMIMEList.Add('.wpl=application/vnd.ms-wpl'); {Do not Localize}
  3172. AMIMEList.Add('.wps=application/vnd.ms-works'); {Do not Localize}
  3173. AMIMEList.Add('.wri=application/x-mswrite'); {Do not Localize}
  3174. AMIMEList.Add('.xfdf=application/vnd.adobe.xfdf'); {Do not Localize}
  3175. AMIMEList.Add('.xls=application/x-msexcel'); {Do not Localize}
  3176. AMIMEList.Add('.xlb=application/x-msexcel'); {Do not Localize}
  3177. AMIMEList.Add('.xpi=application/x-xpinstall'); {Do not Localize}
  3178. AMIMEList.Add('.xps=application/vnd.ms-xpsdocument'); {Do not Localize}
  3179. AMIMEList.Add('.xsd=application/vnd.sun.xml.draw'); {Do not Localize}
  3180. AMIMEList.Add('.xul=application/vnd.mozilla.xul+xml'); {Do not Localize}
  3181. AMIMEList.Add('.z=application/x-compress'); {Do not Localize}
  3182. AMIMEList.Add('.zoo=application/x-zoo'); {Do not Localize}
  3183. AMIMEList.Add('.zip=application/x-zip-compressed'); {Do not Localize}
  3184. { WAP }
  3185. AMIMEList.Add('.wbmp=image/vnd.wap.wbmp'); {Do not Localize}
  3186. AMIMEList.Add('.wml=text/vnd.wap.wml'); {Do not Localize}
  3187. AMIMEList.Add('.wmlc=application/vnd.wap.wmlc'); {Do not Localize}
  3188. AMIMEList.Add('.wmls=text/vnd.wap.wmlscript'); {Do not Localize}
  3189. AMIMEList.Add('.wmlsc=application/vnd.wap.wmlscriptc'); {Do not Localize}
  3190. { Non-web text}
  3191. {
  3192. IMPORTANT!!
  3193. You should not use a text MIME type definition unless you are
  3194. extremely certain that the file will NOT be a binary. Some browsers
  3195. will display the text instead of saving to disk and it looks ugly
  3196. if a web-browser shows all of the 8bit charactors.
  3197. }
  3198. //of course, we have to add this :-).
  3199. AMIMEList.Add('.asm=text/x-asm'); {Do not Localize}
  3200. AMIMEList.Add('.p=text/x-pascal'); {Do not Localize}
  3201. AMIMEList.Add('.pas=text/x-pascal'); {Do not Localize}
  3202. AMIMEList.Add('.cs=text/x-csharp'); {Do not Localize}
  3203. AMIMEList.Add('.c=text/x-csrc'); {Do not Localize}
  3204. AMIMEList.Add('.c++=text/x-c++src'); {Do not Localize}
  3205. AMIMEList.Add('.cpp=text/x-c++src'); {Do not Localize}
  3206. AMIMEList.Add('.cxx=text/x-c++src'); {Do not Localize}
  3207. AMIMEList.Add('.cc=text/x-c++src'); {Do not Localize}
  3208. AMIMEList.Add('.h=text/x-chdr'); {Do not localize}
  3209. AMIMEList.Add('.h++=text/x-c++hdr'); {Do not Localize}
  3210. AMIMEList.Add('.hpp=text/x-c++hdr'); {Do not Localize}
  3211. AMIMEList.Add('.hxx=text/x-c++hdr'); {Do not Localize}
  3212. AMIMEList.Add('.hh=text/x-c++hdr'); {Do not Localize}
  3213. AMIMEList.Add('.java=text/x-java'); {Do not Localize}
  3214. { WEB }
  3215. AMIMEList.Add('.css=text/css'); {Do not Localize}
  3216. AMIMEList.Add('.js=text/javascript'); {Do not Localize}
  3217. AMIMEList.Add('.htm=text/html'); {Do not Localize}
  3218. AMIMEList.Add('.html=text/html'); {Do not Localize}
  3219. AMIMEList.Add('.xhtml=application/xhtml+xml'); {Do not localize}
  3220. AMIMEList.Add('.xht=application/xhtml+xml'); {Do not localize}
  3221. AMIMEList.Add('.rdf=application/rdf+xml'); {Do not localize}
  3222. AMIMEList.Add('.rss=application/rss+xml'); {Do not localize}
  3223. AMIMEList.Add('.ls=text/javascript'); {Do not Localize}
  3224. AMIMEList.Add('.mocha=text/javascript'); {Do not Localize}
  3225. AMIMEList.Add('.shtml=server-parsed-html'); {Do not Localize}
  3226. AMIMEList.Add('.xml=text/xml'); {Do not Localize}
  3227. AMIMEList.Add('.sgm=text/sgml'); {Do not Localize}
  3228. AMIMEList.Add('.sgml=text/sgml'); {Do not Localize}
  3229. { Message }
  3230. AMIMEList.Add('.mht=message/rfc822'); {Do not Localize}
  3231. if not ALoadFromOS then begin
  3232. Exit;
  3233. end;
  3234. {$IFDEF WINDOWS}
  3235. // Build the file type/MIME type map
  3236. Reg := TRegistry.Create;
  3237. try
  3238. KeyList := TStringList.create;
  3239. try
  3240. Reg.RootKey := HKEY_CLASSES_ROOT;
  3241. // TODO: use RegEnumKeyEx() directly to avoid wasting memory loading keys we don't care about...
  3242. if Reg.OpenKeyReadOnly('\') then begin {do not localize}
  3243. Reg.GetKeyNames(KeyList);
  3244. Reg.Closekey;
  3245. end;
  3246. // get a list of registered extentions
  3247. for i := 0 to KeyList.Count - 1 do begin
  3248. LExt := KeyList[i];
  3249. if TextStartsWith(LExt, '.') then begin {do not localize}
  3250. if Reg.OpenKeyReadOnly(LExt) then begin
  3251. s := Reg.ReadString('Content Type'); {do not localize}
  3252. if Length(s) > 0 then begin
  3253. AMIMEList.Values[IndyLowerCase(LExt)] := IndyLowerCase(s);
  3254. end;
  3255. Reg.CloseKey;
  3256. end;
  3257. end;
  3258. end;
  3259. if Reg.OpenKeyReadOnly('\MIME\Database\Content Type') then begin {do not localize}
  3260. // get a list of registered MIME types
  3261. KeyList.Clear;
  3262. Reg.GetKeyNames(KeyList);
  3263. Reg.CloseKey;
  3264. for i := 0 to KeyList.Count - 1 do begin
  3265. if Reg.OpenKeyReadOnly('\MIME\Database\Content Type\' + KeyList[i]) then begin {do not localize}
  3266. LExt := IndyLowerCase(Reg.ReadString('Extension')); {do not localize}
  3267. if Length(LExt) > 0 then begin
  3268. if LExt[1] <> '.' then begin
  3269. LExt := '.' + LExt; {do not localize}
  3270. end;
  3271. AMIMEList.Values[LExt] := IndyLowerCase(KeyList[i]);
  3272. end;
  3273. Reg.CloseKey;
  3274. end;
  3275. end;
  3276. end;
  3277. finally
  3278. KeyList.Free;
  3279. end;
  3280. finally
  3281. Reg.Free;
  3282. end;
  3283. {$ENDIF}
  3284. {$IFDEF UNIX}
  3285. {
  3286. /etc/mime.types is not present in all Linux distributions.
  3287. It turns out that "/etc/htdig/mime.types" and
  3288. "/etc/usr/share/webmin/mime..types" are in the same format as what
  3289. Johannes Berg had expected.
  3290. Just read those files for best coverage. MIME Tables are not centralized
  3291. on Linux.
  3292. }
  3293. LoadMIME('/etc/mime.types', AMIMEList); {do not localize}
  3294. LoadMIME('/etc/htdig/mime.types', AMIMEList); {do not localize}
  3295. LoadMIME('/etc/usr/share/webmin/mime.types', AMIMEList); {do not localize}
  3296. {$ENDIF}
  3297. end;
  3298. procedure TIdMimeTable.AddMimeType(const Ext, MIMEType: string; const ARaiseOnError: Boolean = True);
  3299. var
  3300. LExt,
  3301. LMIMEType: string;
  3302. begin
  3303. { Check and fix extension }
  3304. LExt := IndyLowerCase(Ext);
  3305. if Length(LExt) = 0 then begin
  3306. if ARaiseOnError then begin
  3307. raise EIdException.Create(RSMIMEExtensionEmpty); // TODO: create a new Exception class for this
  3308. end;
  3309. Exit;
  3310. end;
  3311. { Check and fix MIMEType }
  3312. LMIMEType := IndyLowerCase(MIMEType);
  3313. if Length(LMIMEType) = 0 then begin
  3314. if ARaiseOnError then begin
  3315. raise EIdException.Create(RSMIMEMIMETypeEmpty); // TODO: create a new Exception class for this
  3316. end;
  3317. Exit;
  3318. end;
  3319. if LExt[1] <> '.' then begin {do not localize}
  3320. LExt := '.' + LExt; {do not localize}
  3321. end;
  3322. { Check list }
  3323. if FFileExt.IndexOf(LExt) = -1 then begin
  3324. // TODO: multiple MIME types can belong to the same file extension.
  3325. // Change this logic to have FFileExt contain "<ext>=<mimetype>"
  3326. // pairs so an extension can map to a prefered MIME type, and have
  3327. // FMIMEList contain "<mimetype>=<ext>" pairs for simple lookup.
  3328. FFileExt.Add(LExt);
  3329. FMIMEList.Add(LMIMEType);
  3330. end else begin
  3331. if ARaiseOnError then begin
  3332. raise EIdException.Create(RSMIMEMIMEExtAlreadyExists); // TODO: create a new Exception class for this
  3333. end;
  3334. Exit;
  3335. end;
  3336. end;
  3337. procedure TIdMimeTable.BuildCache;
  3338. begin
  3339. if Assigned(FOnBuildCache) then begin
  3340. FOnBuildCache(Self);
  3341. end else begin
  3342. if FFileExt.Count = 0 then begin
  3343. BuildDefaultCache;
  3344. end;
  3345. end;
  3346. end;
  3347. procedure TIdMimeTable.BuildDefaultCache;
  3348. {This is just to provide some default values only}
  3349. var
  3350. LKeys : TStringList;
  3351. begin
  3352. LKeys := TStringList.Create;
  3353. try
  3354. FillMIMETable(LKeys, LoadTypesFromOS);
  3355. LoadFromStrings(LKeys);
  3356. finally
  3357. FreeAndNil(LKeys);
  3358. end;
  3359. end;
  3360. constructor TIdMimeTable.Create(const AutoFill: Boolean);
  3361. begin
  3362. inherited Create;
  3363. FLoadTypesFromOS := True;
  3364. FFileExt := TStringList.Create;
  3365. FMIMEList := TStringList.Create;
  3366. if AutoFill then begin
  3367. BuildCache;
  3368. end;
  3369. end;
  3370. destructor TIdMimeTable.Destroy;
  3371. begin
  3372. FreeAndNil(FMIMEList);
  3373. FreeAndNil(FFileExt);
  3374. inherited Destroy;
  3375. end;
  3376. function TIdMimeTable.GetDefaultFileExt(const MIMEType: string): String;
  3377. var
  3378. Index : Integer;
  3379. LMimeType: string;
  3380. begin
  3381. LMimeType := IndyLowerCase(MIMEType);
  3382. Index := FMIMEList.IndexOf(LMimeType);
  3383. if Index = -1 then begin
  3384. BuildCache;
  3385. Index := FMIMEList.IndexOf(LMIMEType);
  3386. end;
  3387. if Index <> -1 then begin
  3388. // TODO: multiple MIME types can belong to the same file extension.
  3389. // Change this logic to have FFileExt contain "<ext>=<mimetype>"
  3390. // pairs so an extension can map to a prefered MIME type, and have
  3391. // FMIMEList contain "<mimetype>=<ext>" pairs for simple lookup.
  3392. Result := FFileExt[Index];
  3393. end else begin
  3394. Result := ''; {Do not Localize}
  3395. end;
  3396. end;
  3397. function TIdMimeTable.GetFileMIMEType(const AFileName: string): string;
  3398. var
  3399. Index : Integer;
  3400. LExt: string;
  3401. begin
  3402. LExt := IndyLowerCase(ExtractFileExt(AFileName));
  3403. Index := FFileExt.IndexOf(LExt);
  3404. if Index = -1 then begin
  3405. BuildCache;
  3406. Index := FFileExt.IndexOf(LExt);
  3407. end;
  3408. if Index <> -1 then begin
  3409. // TODO: multiple MIME types can belong to the same file extension.
  3410. // Change this logic to have FFileExt contain "<ext>=<mimetype>"
  3411. // pairs so an extension can map to a prefered MIME type, and have
  3412. // FMIMEList contain "<mimetype>=<ext>" pairs for simple lookup.
  3413. Result := FMIMEList[Index];
  3414. end else begin
  3415. Result := 'application/octet-stream' {do not localize}
  3416. end;
  3417. end;
  3418. procedure TIdMimeTable.LoadFromStrings(const AStrings: TStrings; const MimeSeparator: Char = '='); {Do not Localize}
  3419. var
  3420. I, P: Integer;
  3421. S, Ext: string;
  3422. begin
  3423. Assert(AStrings <> nil);
  3424. FFileExt.Clear;
  3425. FMIMEList.Clear;
  3426. for I := 0 to AStrings.Count - 1 do begin
  3427. S := AStrings[I];
  3428. // RLebeau 12/13/15: Calling Pos() with a Char as input creates a temporary
  3429. // String. Normally this is fine, but profiling reveils this to be a big
  3430. // bottleneck for code that makes a lot of calls to Pos() in a loop, so we
  3431. // will scan through the string looking for the character without a conversion...
  3432. //
  3433. // P := Pos(MimeSeparator, S);
  3434. // if P > 0 then begin
  3435. //
  3436. for P := 1 to Length(S) do begin
  3437. //if CharEquals(S, P, MimeSeparator) then begin
  3438. if S[P] = MimeSeparator then begin
  3439. Ext := IndyLowerCase(Copy(S, 1, P - 1));
  3440. AddMimeType(Ext, Copy(S, P + 1, MaxInt), False);
  3441. Break;
  3442. end;
  3443. end;
  3444. end;
  3445. end;
  3446. procedure TIdMimeTable.SaveToStrings(const AStrings: TStrings;
  3447. const MimeSeparator: Char);
  3448. var
  3449. I : Integer;
  3450. begin
  3451. Assert(AStrings <> nil);
  3452. AStrings.BeginUpdate;
  3453. try
  3454. AStrings.Clear;
  3455. for I := 0 to FFileExt.Count - 1 do begin
  3456. AStrings.Add(FFileExt[I] + MimeSeparator + FMIMEList[I]);
  3457. end;
  3458. finally
  3459. AStrings.EndUpdate;
  3460. end;
  3461. end;
  3462. function IsValidIP(const S: String): Boolean;
  3463. {$IFDEF USE_INLINE}inline;{$ENDIF}
  3464. var
  3465. LErr: Boolean;
  3466. begin
  3467. LErr := False; // keep the compiler happy
  3468. IPv4ToUInt32(S, LErr);
  3469. if LErr then begin
  3470. LErr := (MakeCanonicalIPv6Address(S) = '');
  3471. end;
  3472. Result := not LErr;
  3473. end;
  3474. //everything that does not start with '.' is treated as hostname
  3475. function IsHostname(const S: String): Boolean;
  3476. {$IFDEF USE_INLINE} inline; {$ENDIF}
  3477. begin
  3478. Result := (not TextStartsWith(S, '.')) and (not IsValidIP(S)) ; {Do not Localize}
  3479. end;
  3480. function IsTopDomain(const AStr: string): Boolean;
  3481. Var
  3482. i: Integer;
  3483. S1,LTmp: String;
  3484. begin
  3485. i := 0;
  3486. LTmp := UpperCase(Trim(AStr));
  3487. while IndyPos('.', LTmp) > 0 do begin {Do not Localize}
  3488. S1 := LTmp;
  3489. Fetch(LTmp, '.'); {Do not Localize}
  3490. i := i + 1;
  3491. end;
  3492. Result := ((Length(LTmp) > 2) and (i = 1));
  3493. if Length(LTmp) = 2 then begin // Country domain names
  3494. S1 := Fetch(S1, '.'); {Do not Localize}
  3495. // here will be the exceptions check: com.uk, co.uk, com.tw and etc.
  3496. if LTmp = 'UK' then begin {Do not Localize}
  3497. if S1 = 'CO' then begin
  3498. result := i = 2; {Do not Localize}
  3499. end;
  3500. if S1 = 'COM' then begin
  3501. result := i = 2; {Do not Localize}
  3502. end;
  3503. end;
  3504. if LTmp = 'TW' then begin {Do not Localize}
  3505. if S1 = 'CO' then begin
  3506. result := i = 2; {Do not Localize}
  3507. end;
  3508. if S1 = 'COM' then begin
  3509. result := i = 2; {Do not Localize}
  3510. end;
  3511. end;
  3512. end;
  3513. end;
  3514. function IsDomain(const S: String): Boolean;
  3515. {$IFDEF USE_INLINE} inline; {$ENDIF}
  3516. begin
  3517. Result := (not IsHostname(S)) and (IndyPos('.', S) > 0) and (not IsTopDomain(S)); {Do not Localize}
  3518. end;
  3519. function DomainName(const AHost: String): String;
  3520. {$IFDEF USE_INLINE} inline; {$ENDIF}
  3521. begin
  3522. Result := Copy(AHost, IndyPos('.', AHost), Length(AHost)); {Do not Localize}
  3523. end;
  3524. function IsFQDN(const S: String): Boolean;
  3525. {$IFDEF USE_INLINE} inline; {$ENDIF}
  3526. begin
  3527. Result := IsHostName(S) and IsDomain(DomainName(S));
  3528. end;
  3529. // The password for extracting password.bin from password.zip is indyrules
  3530. function PadString(const AString : String; const ALen : Integer; const AChar: Char): String;
  3531. {$IFDEF USE_INLINE} inline; {$ENDIF}
  3532. begin
  3533. if Length(Result) >= ALen then begin
  3534. Result := AString;
  3535. end else begin
  3536. Result := AString + StringOfChar(AChar, ALen-Length(AString));
  3537. end;
  3538. end;
  3539. function ProcessPath(const ABasePath: string;
  3540. const APath: string;
  3541. const APathDelim: string = '/'): string; {Do not Localize}
  3542. // Dont add / - sometimes a file is passed in as well and the only way to determine is
  3543. // to test against the actual targets
  3544. var
  3545. i: Integer;
  3546. LPreserveTrail: Boolean;
  3547. LWork: string;
  3548. begin
  3549. if TextStartsWith(APath, APathDelim) then begin
  3550. Result := APath;
  3551. end else begin
  3552. Result := ''; {Do not Localize}
  3553. LPreserveTrail := (Length(APath) = 0) or TextEndsWith(APath, APathDelim);
  3554. LWork := ABasePath;
  3555. // If LWork = '' then we just want it to be APath, no prefixed / {Do not Localize}
  3556. if (Length(LWork) > 0) and (not TextEndsWith(LWork, APathDelim)) then begin
  3557. LWork := LWork + APathDelim;
  3558. end;
  3559. LWork := LWork + APath;
  3560. if Length(LWork) > 0 then begin
  3561. i := 1;
  3562. while i <= Length(LWork) do begin
  3563. if LWork[i] = APathDelim then begin
  3564. if i = 1 then begin
  3565. Result := APathDelim;
  3566. end
  3567. else if not TextEndsWith(Result, APathDelim) then begin
  3568. Result := Result + LWork[i];
  3569. end;
  3570. end else begin
  3571. if LWork[i] = '.' then begin {Do not Localize}
  3572. // If the last character was a PathDelim then the . is a relative path modifier.
  3573. // If it doesnt follow a PathDelim, its part of a filename
  3574. if TextEndsWith(Result, APathDelim) and (Copy(LWork, i, 2) = '..') then begin {Do not Localize}
  3575. // Delete the last PathDelim
  3576. Delete(Result, Length(Result), 1);
  3577. // Delete up to the next PathDelim
  3578. while (Length(Result) > 0) and (not TextEndsWith(Result, APathDelim)) do begin
  3579. Delete(Result, Length(Result), 1);
  3580. end;
  3581. // Skip over second .
  3582. Inc(i);
  3583. end else begin
  3584. Result := Result + LWork[i];
  3585. end;
  3586. end else begin
  3587. Result := Result + LWork[i];
  3588. end;
  3589. end;
  3590. Inc(i);
  3591. end;
  3592. end;
  3593. // Sometimes .. semantics can put a PathDelim on the end
  3594. // But dont modify if it is only a PathDelim and nothing else, or it was there to begin with
  3595. if (Result <> APathDelim) and TextEndsWith(Result, APathDelim) and (not LPreserveTrail) then begin
  3596. Delete(Result, Length(Result), 1);
  3597. end;
  3598. end;
  3599. end;
  3600. {** HTML Parsing code for extracting Metadata. It can also be the basis of a Full HTML parser ***}
  3601. const
  3602. HTML_DOCWHITESPACE = #0+#9+#10+#13+#32; {do not localize}
  3603. HTML_ALLOWABLE_ALPHANUMBERIC = 'abcdefghijklmnopqrstuvwxyz'+ {do not localize}
  3604. 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'+ {do not localize}
  3605. '1234567890-_:.'; {do not localize}
  3606. HTML_QUOTECHARS = '''"'; {do not localize}
  3607. HTML_MainDocParts : array [0..2] of string = ('TITLE','HEAD', 'BODY'); {do not localize}
  3608. HTML_HeadDocAttrs : array [0..3] of string = ('META','TITLE','SCRIPT','LINK'); {do not localize}
  3609. HTML_MetaAttrs : array [0..1] of string = ('HTTP-EQUIV', 'charset'); {do not localize}
  3610. function ParseUntilEndOfTag(const AStr : String; var VPos : Integer;
  3611. const ALen : Integer): String; {$IFDEF USE_INLINE}inline;{$ENDIF}
  3612. var
  3613. LStart: Integer;
  3614. begin
  3615. LStart := VPos;
  3616. while VPos <= ALen do begin
  3617. if AStr[VPos] = '>' then begin {do not localize}
  3618. Break;
  3619. end;
  3620. Inc(VPos);
  3621. end;
  3622. Result := Copy(AStr, LStart, VPos - LStart);
  3623. end;
  3624. procedure DiscardUntilEndOfTag(const AStr : String; var VPos : Integer;
  3625. const ALen : Integer); {$IFDEF USE_INLINE}inline;{$ENDIF}
  3626. begin
  3627. while VPos <= ALen do begin
  3628. if AStr[VPos] = '>' then begin {do not localize}
  3629. Break;
  3630. end;
  3631. Inc(VPos);
  3632. end;
  3633. end;
  3634. function ExtractDocWhiteSpace(const AStr : String; var VPos : Integer;
  3635. const ALen : Integer) : String; {$IFDEF USE_INLINE}inline;{$ENDIF}
  3636. var
  3637. LStart: Integer;
  3638. begin
  3639. LStart := VPos;
  3640. while VPos <= ALen do begin
  3641. if not CharIsInSet(AStr, VPos, HTML_DOCWHITESPACE) then begin
  3642. Break;
  3643. end;
  3644. Inc(VPos);
  3645. end;
  3646. Result := Copy(AStr, LStart, VPos-LStart);
  3647. end;
  3648. procedure DiscardDocWhiteSpace(const AStr : String; var VPos : Integer; const ALen : Integer); {$IFDEF USE_INLINE}inline; {$ENDIF}
  3649. begin
  3650. while VPos <= ALen do begin
  3651. if not CharIsInSet(AStr, VPos, HTML_DOCWHITESPACE) then begin
  3652. Break;
  3653. end;
  3654. Inc(VPos);
  3655. end;
  3656. end;
  3657. function ParseWord(const AStr : String; var VPos : Integer;
  3658. const ALen : Integer) : String; {$IFDEF USE_INLINE}inline;{$ENDIF}
  3659. var
  3660. LStart: Integer;
  3661. begin
  3662. LStart := VPos;
  3663. while VPos <= ALen do begin
  3664. if not CharIsInSet(AStr, VPos, HTML_ALLOWABLE_ALPHANUMBERIC) then begin
  3665. Break;
  3666. end;
  3667. Inc(VPos);
  3668. end;
  3669. Result := Copy(AStr, LStart, VPos-LStart);
  3670. end;
  3671. procedure DiscardWord(const AStr : String; var VPos : Integer;
  3672. const ALen : Integer); {$IFDEF USE_INLINE}inline;{$ENDIF}
  3673. begin
  3674. while VPos <= ALen do begin
  3675. if not CharIsInSet(AStr, VPos, HTML_ALLOWABLE_ALPHANUMBERIC) then begin
  3676. Break;
  3677. end;
  3678. Inc(VPos);
  3679. end;
  3680. end;
  3681. function ParseUntil(const AStr : String; const AChar : Char;
  3682. var VPos : Integer; const ALen : Integer) : String; {$IFDEF USE_INLINE}inline;{$ENDIF}
  3683. var
  3684. LStart: Integer;
  3685. begin
  3686. LStart := VPos;
  3687. while VPos <= ALen do begin
  3688. if AStr[VPos] = AChar then begin
  3689. Break;
  3690. end;
  3691. Inc(VPos);
  3692. end;
  3693. Result := Copy(AStr, LStart, VPos-LStart);
  3694. end;
  3695. procedure DiscardUntil(const AStr : String; const AChar : Char;
  3696. var VPos : Integer; const ALen : Integer); {$IFDEF USE_INLINE}inline;{$ENDIF}
  3697. begin
  3698. while VPos <= ALen do begin
  3699. if AStr[VPos] = AChar then begin
  3700. Break;
  3701. end;
  3702. Inc(VPos);
  3703. end;
  3704. end;
  3705. function ParseUntilCharOrEndOfTag(const AStr : String; const AChar: Char;
  3706. var VPos : Integer; const ALen : Integer): String; {$IFDEF USE_INLINE}inline;{$ENDIF}
  3707. var
  3708. LStart: Integer;
  3709. begin
  3710. LStart := VPos;
  3711. while VPos <= ALen do begin
  3712. if (AStr[VPos] = AChar) or (AStr[VPos] = '>') then begin {do not localize}
  3713. Break;
  3714. end;
  3715. Inc(VPos);
  3716. end;
  3717. Result := Copy(AStr, LStart, VPos - LStart);
  3718. end;
  3719. procedure DiscardUntilCharOrEndOfTag(const AStr : String; const AChar: Char;
  3720. var VPos : Integer; const ALen : Integer); {$IFDEF USE_INLINE}inline;{$ENDIF}
  3721. begin
  3722. while VPos <= ALen do begin
  3723. if (AStr[VPos] = AChar) or (AStr[VPos] = '>') then begin {do not localize}
  3724. Break;
  3725. end;
  3726. Inc(VPos);
  3727. end;
  3728. end;
  3729. function ParseHTTPMetaEquiveData(const AStr : String; var VPos : Integer;
  3730. const ALen : Integer) : String; {$IFDEF USE_INLINE}inline;{$ENDIF}
  3731. var
  3732. LQuoteChar : Char;
  3733. LWord : String;
  3734. begin
  3735. Result := '';
  3736. DiscardDocWhiteSpace(AStr, VPos, ALen);
  3737. if CharIsInSet(AStr, VPos, HTML_QUOTECHARS) then begin
  3738. LQuoteChar := AStr[VPos];
  3739. Inc(VPos);
  3740. if VPos > ALen then begin
  3741. Exit;
  3742. end;
  3743. LWord := ParseUntil(AStr, LQuoteChar, VPos, ALen);
  3744. Inc(VPos);
  3745. end else begin
  3746. if VPos > ALen then begin
  3747. Exit;
  3748. end;
  3749. LWord := ParseWord(AStr, VPos, ALen);
  3750. end;
  3751. Result := LWord + ':'; {do not localize}
  3752. repeat
  3753. DiscardDocWhiteSpace(AStr, VPos, ALen);
  3754. if VPos > ALen then begin
  3755. Break;
  3756. end;
  3757. if AStr[VPos] = '/' then begin {do not localize}
  3758. Inc(VPos);
  3759. if VPos > ALen then begin
  3760. Break;
  3761. end;
  3762. end;
  3763. if AStr[VPos] = '>' then begin {do not localize}
  3764. Break;
  3765. end;
  3766. LWord := ParseWord(AStr, VPos, ALen);
  3767. if VPos > ALen then begin
  3768. Break;
  3769. end;
  3770. if AStr[VPos] = '=' then begin {do not localize}
  3771. Inc(VPos);
  3772. DiscardDocWhiteSpace(AStr, VPos, ALen);
  3773. if CharIsInSet(AStr, VPos, HTML_QUOTECHARS) then begin
  3774. LQuoteChar := AStr[VPos];
  3775. Inc(VPos);
  3776. if TextIsSame(LWord, 'CONTENT') then begin
  3777. Result := Result + ' ' + ParseUntil(AStr, LQuoteChar, VPos, ALen);
  3778. Inc(VPos);
  3779. // RLebeau: this is a special case for handling a malformed tag
  3780. // that was encountered in the wild:
  3781. // <meta http-equiv="Content-Type" content="text/html; charset="window-1255">
  3782. if VPos > ALen then begin
  3783. Break;
  3784. end;
  3785. if CharIsInSet(AStr, VPos, HTML_DOCWHITESPACE + '/>') then begin
  3786. Continue;
  3787. end;
  3788. Result := Result + ParseUntil(AStr, LQuoteChar, VPos, ALen);
  3789. Inc(VPos);
  3790. end else begin
  3791. DiscardUntil(AStr, LQuoteChar, VPos, ALen);
  3792. Inc(VPos);
  3793. end;
  3794. end else begin
  3795. if TextIsSame(LWord, 'CONTENT') then begin
  3796. Result := Result + ' ' + ParseUntilCharOrEndOfTag(AStr, ' ', VPos, ALen); {do not localize}
  3797. end else begin
  3798. DiscardUntilCharOrEndOfTag(AStr, ' ', VPos, ALen); {do not localize}
  3799. end;
  3800. end;
  3801. end else begin
  3802. Inc(VPos);
  3803. end;
  3804. until False;
  3805. end;
  3806. function ParseMetaCharsetData(const AStr : String; var VPos : Integer;
  3807. const ALen : Integer) : String; {$IFDEF USE_INLINE}inline;{$ENDIF}
  3808. var
  3809. LQuoteChar : Char;
  3810. LWord : String;
  3811. begin
  3812. Result := '';
  3813. DiscardDocWhiteSpace(AStr, VPos, ALen);
  3814. if CharIsInSet(AStr, VPos, HTML_QUOTECHARS) then begin
  3815. LQuoteChar := AStr[VPos];
  3816. Inc(VPos);
  3817. if VPos > ALen then begin
  3818. Exit;
  3819. end;
  3820. LWord := ParseUntil(AStr, LQuoteChar, VPos, ALen);
  3821. Inc(VPos);
  3822. end else begin
  3823. if VPos > ALen then begin
  3824. Exit;
  3825. end;
  3826. LWord := ParseWord(AStr, VPos, ALen);
  3827. end;
  3828. DiscardUntilEndOfTag(AStr, VPos, ALen);
  3829. Result := LWord;
  3830. end;
  3831. procedure DiscardToEndOfComment(const AStr : String; var VPos : Integer; const ALen : Integer); {$IFDEF USE_INLINE}inline; {$ENDIF}
  3832. var
  3833. i : Integer;
  3834. begin
  3835. DiscardUntil(AStr, '-', VPos, ALen); {do not localize}
  3836. i := 0;
  3837. while VPos <= ALen do begin
  3838. if AStr[VPos] = '-' then begin {do not localize}
  3839. if i < 2 then begin
  3840. Inc(i);
  3841. end;
  3842. end else begin
  3843. if (AStr[VPos] = '>') and (i = 2) then begin {do not localize}
  3844. Break;
  3845. end;
  3846. i := 0;
  3847. end;
  3848. Inc(VPos);
  3849. end;
  3850. end;
  3851. function ParseForCloseTag(const AStr, ATagWord : String; var VPos : Integer; const ALen : Integer) : String; {$IFDEF USE_INLINE}inline; {$ENDIF}
  3852. var
  3853. LWord, LTmp : String;
  3854. begin
  3855. Result := '';
  3856. while VPos <= ALen do begin
  3857. Result := Result + ParseUntil(AStr, '<', VPos, ALen); {do not localize}
  3858. if AStr[VPos] = '<' then begin
  3859. Inc(VPos);
  3860. end;
  3861. LTmp := '<' + ExtractDocWhiteSpace(AStr, VPos, ALen); {do not localize}
  3862. if AStr[VPos] = '/' then begin {do not localize}
  3863. Inc(VPos);
  3864. LTmp := LTmp + '/'; {do not localize}
  3865. LWord := ParseWord(AStr, VPos, ALen);
  3866. if TextIsSame(LWord, ATagWord) then begin
  3867. DiscardUntilEndOfTag(AStr, VPos, ALen);
  3868. Break;
  3869. end;
  3870. end;
  3871. Result := Result + LTmp + LWord + ParseUntilEndOfTag(AStr, VPos, ALen); {do not localize}
  3872. Inc(VPos);
  3873. end;
  3874. end;
  3875. procedure DiscardUntilCloseTag(const AStr, ATagWord : String; var VPos : Integer;
  3876. const ALen : Integer; const AIsScript : Boolean = False); {$IFDEF USE_INLINE}inline; {$ENDIF}
  3877. var
  3878. LWord, LTmp : String;
  3879. begin
  3880. while VPos <= ALen do begin
  3881. DiscardUntil(AStr, '<', VPos, ALen); {do not localize}
  3882. if AStr[VPos] = '<' then begin {do not localize}
  3883. Inc(VPos);
  3884. end;
  3885. LTmp := '<' + ExtractDocWhiteSpace(AStr, VPos, ALen);
  3886. if AStr[VPos] = '/' then begin {do not localize}
  3887. Inc(VPos);
  3888. LTmp := LTmp + '/'; {do not localize}
  3889. LWord := ParseWord(AStr, VPos, ALen);
  3890. if TextIsSame(LWord, ATagWord) then begin
  3891. DiscardUntilEndOfTag(AStr, VPos, ALen);
  3892. Break;
  3893. end;
  3894. end;
  3895. if not AIsScript then begin
  3896. DiscardUntilEndOfTag(AStr, VPos, ALen);
  3897. end;
  3898. Inc(VPos);
  3899. end;
  3900. end;
  3901. procedure ParseMetaHTTPEquiv(AStream: TStream; AHeaders : TStrings; var VCharSet: string);
  3902. type
  3903. TIdHTMLMode = (none, html, title, head, body, comment);
  3904. var
  3905. LRawData : String;
  3906. LWord : String;
  3907. LMode : TIdHTMLMode;
  3908. LPos : Integer;
  3909. LLen : Integer;
  3910. LEncoding: IIdTextEncoding;
  3911. begin
  3912. VCharSet := '';
  3913. {if AHeaders <> nil then begin
  3914. AHeaders.Clear;
  3915. end;}
  3916. if AStream = nil then begin
  3917. Exit; // just in case
  3918. end;
  3919. AStream.Position := 0;
  3920. LEncoding := IndyTextEncoding_8Bit;
  3921. // TODO: parse the stream as-is without reading it into a String first...
  3922. LRawData := ReadStringFromStream(AStream, -1, LEncoding{$IFDEF STRING_IS_ANSI}, LEncoding{$ENDIF});
  3923. LEncoding := nil;
  3924. LMode := none;
  3925. LPos := 0;
  3926. LLen := Length(LRawData);
  3927. if AHeaders <> nil then begin
  3928. AHeaders.BeginUpdate;
  3929. end;
  3930. try
  3931. repeat
  3932. Inc(LPos);
  3933. if LPos > LLen then begin
  3934. Break;
  3935. end;
  3936. if LRawData[LPos] = '<' then begin {do not localize}
  3937. Inc(LPos);
  3938. if LPos > LLen then begin
  3939. Break;
  3940. end;
  3941. if LRawData[LPos] = '?' then begin {do not localize}
  3942. Inc(LPos);
  3943. if LPos > LLen then begin
  3944. Break;
  3945. end;
  3946. end
  3947. else if LRawData[LPos] = '!' then begin {do not localize}
  3948. Inc(LPos);
  3949. if LPos > LLen then begin
  3950. Break;
  3951. end;
  3952. //we have to handle comments separately since they appear in any mode.
  3953. if Copy(LRawData, LPos, 2) = '--' then begin {do not localize}
  3954. Inc(LPos, 2);
  3955. DiscardToEndOfComment(LRawData, LPos, LLen);
  3956. Continue;
  3957. end;
  3958. end;
  3959. DiscardDocWhiteSpace(LRawData, LPos, LLen);
  3960. LWord := ParseWord(LRawData, LPos, LLen);
  3961. case LMode of
  3962. none :
  3963. begin
  3964. DiscardUntilEndOfTag(LRawData, LPos, LLen);
  3965. if TextIsSame(LWord, 'HTML') then begin
  3966. LMode := html;
  3967. end;
  3968. end;
  3969. html :
  3970. begin
  3971. DiscardUntilEndOfTag(LRawData, LPos, LLen);
  3972. case PosInStrArray(LWord, HTML_MainDocParts, False) of
  3973. 0 : LMode := title;//title
  3974. 1 : LMode := head; //head
  3975. 2 : LMode := body; //body
  3976. end;
  3977. end;
  3978. head :
  3979. begin
  3980. case PosInStrArray(LWord, HTML_HeadDocAttrs, False) of
  3981. 0 : //'META'
  3982. begin
  3983. DiscardDocWhiteSpace(LRawData, LPos, LLen);
  3984. LWord := ParseWord(LRawData, LPos, LLen);
  3985. // '<meta http-equiv="..." content="...">'
  3986. // '<meta charset="...">' (used in HTML5)
  3987. // TODO: use ParseUntilEndOfTag() here
  3988. case PosInStrArray(LWord, HTML_MetaAttrs, False) of {do not localize}
  3989. 0: // HTTP-EQUIV
  3990. begin
  3991. DiscardDocWhiteSpace(LRawData, LPos, LLen);
  3992. if LRawData[LPos] = '=' then begin {do not localize}
  3993. Inc(LPos);
  3994. if LPos > LLen then begin
  3995. Break;
  3996. end;
  3997. if AHeaders <> nil then begin
  3998. AHeaders.Add( ParseHTTPMetaEquiveData(LRawData, LPos, LLen) );
  3999. end else begin
  4000. ParseHTTPMetaEquiveData(LRawData, LPos, LLen);
  4001. end;
  4002. end;
  4003. end;
  4004. 1: // charset
  4005. begin
  4006. DiscardDocWhiteSpace(LRawData, LPos, LLen);
  4007. if LRawData[LPos] = '=' then begin {do not localize}
  4008. Inc(LPos);
  4009. if LPos > LLen then begin
  4010. Break;
  4011. end;
  4012. VCharset := ParseMetaCharsetData(LRawData, LPos, LLen);
  4013. end;
  4014. end;
  4015. else
  4016. DiscardUntilEndOfTag(LRawData, LPos, LLen);
  4017. end;
  4018. end;
  4019. 1 : //'TITLE'
  4020. begin
  4021. DiscardUntilEndOfTag(LRawData, LPos, LLen);
  4022. DiscardUntilCloseTag(LRawData, 'TITLE', LPos, LLen); {do not localize}
  4023. end;
  4024. 2 : //'SCRIPT'
  4025. begin
  4026. DiscardUntilEndOfTag(LRawData, LPos, LLen);
  4027. DiscardUntilCloseTag(LRawData, 'SCRIPT', LPos, LLen, True); {do not localize}
  4028. end;
  4029. 3 : //'LINK'
  4030. begin
  4031. DiscardUntilEndOfTag(LRawData, LPos, LLen); {do not localize}
  4032. end;
  4033. end;
  4034. end;
  4035. body: begin
  4036. Exit;
  4037. end;
  4038. end;
  4039. end;
  4040. until False;
  4041. finally
  4042. if AHeaders <> nil then begin
  4043. AHeaders.EndUpdate;
  4044. end;
  4045. end;
  4046. end;
  4047. {*************************************************************************************************}
  4048. // make sure that an RFC MsgID has angle brackets on it
  4049. function EnsureMsgIDBrackets(const AMsgID: String): String;
  4050. {$IFDEF USE_INLINE} inline; {$ENDIF}
  4051. begin
  4052. Result := AMsgID;
  4053. if Length(Result) > 0 then begin
  4054. if Result[1] <> '<' then begin {do not localize}
  4055. Result := '<' + Result; {do not localize}
  4056. end;
  4057. if Result[Length(Result)] <> '>' then begin {do not localize}
  4058. Result := Result + '>'; {do not localize}
  4059. end;
  4060. end;
  4061. end;
  4062. function ExtractHeaderItem(const AHeaderLine: String): String;
  4063. var
  4064. s: string;
  4065. begin
  4066. // Store in s and not Result because of Fetch semantics
  4067. s := AHeaderLine;
  4068. Result := Trim(Fetch(s, ';')); {do not localize}
  4069. end;
  4070. const
  4071. QuoteSpecials: array[TIdHeaderQuotingType] of String = (
  4072. {Plain } '', {do not localize}
  4073. {RFC822} '()<>@,;:\"./', {do not localize}
  4074. {MIME } '()<>@,;:\"/[]?=', {do not localize}
  4075. {HTTP } '()<>@,;:\"/[]?={} '#9 {do not localize}
  4076. );
  4077. {$IFDEF USE_OBJECT_ARC}
  4078. // Under ARC, SplitHeaderSubItems() cannot put a non-TObject pointer value in
  4079. // the TStrings.Objects[] property...
  4080. type
  4081. TIdHeaderNameValueItem = record
  4082. Name, Value: String;
  4083. Quoted: Boolean;
  4084. constructor Create(const AName, AValue: String; const AQuoted: Boolean);
  4085. end;
  4086. TIdHeaderNameValueList = class(TList<TIdHeaderNameValueItem>)
  4087. public
  4088. function GetValue(const AName: string): string;
  4089. function IndexOfName(const AName: string): Integer;
  4090. procedure SetValue(const AIndex: Integer; const AValue: String);
  4091. end;
  4092. constructor TIdHeaderNameValueItem.Create(const AName, AValue: String; const AQuoted: Boolean);
  4093. begin
  4094. Name := AName;
  4095. Value := AValue;
  4096. Quoted := AQuoted;
  4097. end;
  4098. function TIdHeaderNameValueList.GetValue(const AName: string): string;
  4099. var
  4100. I: Integer;
  4101. begin
  4102. I := IndexOfName(AName);
  4103. if I <> -1 then begin
  4104. Result := Items[I].Value;
  4105. end else begin
  4106. Result := '';
  4107. end;
  4108. end;
  4109. function TIdHeaderNameValueList.IndexOfName(const AName: string): Integer;
  4110. var
  4111. I: Integer;
  4112. begin
  4113. Result := -1;
  4114. for I := 0 to Count-1 do
  4115. begin
  4116. if TextIsSame(Items[I].Name, AName) then
  4117. begin
  4118. Result := I;
  4119. Exit;
  4120. end;
  4121. end;
  4122. end;
  4123. procedure TIdHeaderNameValueList.SetValue(const AIndex: Integer; const AValue: String);
  4124. var
  4125. LItem: TIdHeaderNameValueItem;
  4126. begin
  4127. LItem := Items[AIndex];
  4128. LItem.Value := AValue;
  4129. Items[AIndex] := LItem;
  4130. end;
  4131. {$ENDIF}
  4132. procedure SplitHeaderSubItems(AHeaderLine: String;
  4133. AItems: {$IFDEF USE_OBJECT_ARC}TIdHeaderNameValueList{$ELSE}TStrings{$ENDIF};
  4134. AQuoteType: TIdHeaderQuotingType);
  4135. var
  4136. LName, LValue, LSep: String;
  4137. LQuoted: Boolean;
  4138. I: Integer;
  4139. function FetchQuotedString(var VHeaderLine: string): string;
  4140. begin
  4141. Result := '';
  4142. Delete(VHeaderLine, 1, 1);
  4143. I := 1;
  4144. while I <= Length(VHeaderLine) do begin
  4145. if VHeaderLine[I] = '\' then begin
  4146. // TODO: disable this logic for HTTP 1.0
  4147. if I < Length(VHeaderLine) then begin
  4148. Delete(VHeaderLine, I, 1);
  4149. end;
  4150. end
  4151. else if VHeaderLine[I] = '"' then begin
  4152. Result := Copy(VHeaderLine, 1, I-1);
  4153. VHeaderLine := Copy(VHeaderLine, I+1, MaxInt);
  4154. Break;
  4155. end;
  4156. Inc(I);
  4157. end;
  4158. Fetch(VHeaderLine, ';');
  4159. end;
  4160. begin
  4161. Fetch(AHeaderLine, ';'); {do not localize}
  4162. LSep := CharRange(#0, #32) + QuoteSpecials[AQuoteType] + #127;
  4163. while AHeaderLine <> '' do
  4164. begin
  4165. AHeaderLine := TrimLeft(AHeaderLine);
  4166. if AHeaderLine = '' then begin
  4167. Exit;
  4168. end;
  4169. LName := Trim(Fetch(AHeaderLine, '=')); {do not localize}
  4170. AHeaderLine := TrimLeft(AHeaderLine);
  4171. LQuoted := TextStartsWith(AHeaderLine, '"'); {do not localize}
  4172. if LQuoted then
  4173. begin
  4174. LValue := FetchQuotedString(AHeaderLine);
  4175. end else begin
  4176. I := FindFirstOf(LSep, AHeaderLine);
  4177. if I <> 0 then
  4178. begin
  4179. LValue := Copy(AHeaderLine, 1, I-1);
  4180. if AHeaderLine[I] = ';' then begin {do not localize}
  4181. Inc(I);
  4182. end;
  4183. Delete(AHeaderLine, 1, I-1);
  4184. end else begin
  4185. LValue := AHeaderLine;
  4186. AHeaderLine := '';
  4187. end;
  4188. end;
  4189. if (LName <> '') and ((LValue <> '') or LQuoted) then begin
  4190. {$IFDEF USE_OBJECT_ARC}
  4191. AItems.Add(TIdHeaderNameValueItem.Create(LName, LValue, LQuoted));
  4192. {$ELSE}
  4193. IndyAddPair(AItems, LName, LValue, TObject(LQuoted));
  4194. {$ENDIF}
  4195. end;
  4196. end;
  4197. end;
  4198. function ExtractHeaderSubItem(const AHeaderLine, ASubItem: String;
  4199. AQuoteType: TIdHeaderQuotingType): String;
  4200. var
  4201. LItems: {$IFDEF USE_OBJECT_ARC}TIdHeaderNameValueList{$ELSE}TStringList{$ENDIF};
  4202. {$IFNDEF USE_OBJECT_ARC}
  4203. {$IFNDEF HAS_TStringList_CaseSensitive}
  4204. I: Integer;
  4205. {$ENDIF}
  4206. {$ENDIF}
  4207. begin
  4208. Result := '';
  4209. // TODO: instead of splitting the header into a list of name=value pairs,
  4210. // allocating memory for it, just parse the input string in-place and extract
  4211. // the necessary substring from it...
  4212. LItems := {$IFDEF USE_OBJECT_ARC}TIdHeaderNameValueList{$ELSE}TStringList{$ENDIF}.Create;
  4213. try
  4214. SplitHeaderSubItems(AHeaderLine, LItems, AQuoteType);
  4215. {$IFDEF USE_OBJECT_ARC}
  4216. Result := LItems.GetValue(ASubItem);
  4217. {$ELSE}
  4218. {$IFDEF HAS_TStringList_CaseSensitive}
  4219. LItems.CaseSensitive := False;
  4220. Result := LItems.Values[ASubItem];
  4221. {$ELSE}
  4222. I := IndyIndexOfName(LItems, ASubItem);
  4223. if I <> -1 then begin
  4224. Result := IndyValueFromIndex(LItems, I);
  4225. end;
  4226. {$ENDIF}
  4227. {$ENDIF}
  4228. finally
  4229. LItems.Free;
  4230. end;
  4231. end;
  4232. function ReplaceHeaderSubItem(const AHeaderLine, ASubItem, AValue: String;
  4233. AQuoteType: TIdHeaderQuotingType): String;
  4234. var
  4235. LOld: String;
  4236. begin
  4237. Result := ReplaceHeaderSubItem(AHeaderLine, ASubItem, AValue, LOld, AQuoteType);
  4238. end;
  4239. function ReplaceHeaderSubItem(const AHeaderLine, ASubItem, AValue: String;
  4240. var VOld: String; AQuoteType: TIdHeaderQuotingType): String;
  4241. var
  4242. LItems: {$IFDEF USE_OBJECT_ARC}TIdHeaderNameValueList{$ELSE}TStringList{$ENDIF};
  4243. I: Integer;
  4244. LValue: string;
  4245. function QuoteString(const S: String; const AForceQuotes: Boolean): String;
  4246. var
  4247. I: Integer;
  4248. LAddQuotes: Boolean;
  4249. LNeedQuotes, LNeedEscape: String;
  4250. begin
  4251. Result := '';
  4252. if Length(S) = 0 then begin
  4253. Exit;
  4254. end;
  4255. LAddQuotes := AForceQuotes;
  4256. LNeedQuotes := CharRange(#0, #32) + QuoteSpecials[AQuoteType] + #127;
  4257. // TODO: disable this logic for HTTP 1.0
  4258. LNeedEscape := '"\'; {Do not Localize}
  4259. if AQuoteType in [QuoteRFC822, QuoteMIME] then begin
  4260. LNeedEscape := LNeedEscape + CR; {Do not Localize}
  4261. end;
  4262. for I := 1 to Length(S) do begin
  4263. if CharIsInSet(S, I, LNeedEscape) then begin
  4264. LAddQuotes := True;
  4265. Result := Result + '\'; {do not localize}
  4266. end
  4267. else if CharIsInSet(S, I, LNeedQuotes) then begin
  4268. LAddQuotes := True;
  4269. end;
  4270. Result := Result + S[I];
  4271. end;
  4272. if LAddQuotes then begin
  4273. Result := '"' + Result + '"';
  4274. end;
  4275. end;
  4276. begin
  4277. Result := '';
  4278. // TODO: instead of splitting the header into a list of name=value pairs,
  4279. // allocating memory for it, and then putting the list back together, just
  4280. // parse the input string in-place and extract/replace the necessary
  4281. // substring from it as needed, preserving the rest of the string as-is...
  4282. LItems := {$IFDEF USE_OBJECT_ARC}TIdHeaderNameValueList{$ELSE}TStringList{$ENDIF}.Create;
  4283. try
  4284. SplitHeaderSubItems(AHeaderLine, LItems, AQuoteType);
  4285. {$IFDEF USE_OBJECT_ARC}
  4286. I := LItems.IndexOfName(ASubItem);
  4287. {$ELSE}
  4288. {$IFDEF HAS_TStringList_CaseSensitive}
  4289. LItems.CaseSensitive := False;
  4290. {$ENDIF}
  4291. I := IndyIndexOfName(LItems, ASubItem);
  4292. {$ENDIF}
  4293. if I >= 0 then begin
  4294. {$IFDEF USE_OBJECT_ARC}
  4295. VOld := LItems[I].Value;
  4296. {$ELSE}
  4297. VOld := LItems.Strings[I];
  4298. Fetch(VOld, '=');
  4299. {$ENDIF}
  4300. end else begin
  4301. VOld := '';
  4302. end;
  4303. LValue := Trim(AValue);
  4304. if LValue <> '' then begin
  4305. {$IFDEF USE_OBJECT_ARC}
  4306. if I < 0 then begin
  4307. LItems.Add(TIdHeaderNameValueItem.Create(ASubItem, LValue, False));
  4308. end else begin
  4309. LItems.SetValue(I, LValue);
  4310. end;
  4311. {$ELSE}
  4312. if I < 0 then begin
  4313. IndyAddPair(LItems, ASubItem, LValue);
  4314. end else begin
  4315. {$IFDEF HAS_TStrings_ValueFromIndex}
  4316. LItems.ValueFromIndex[I] := LValue;
  4317. {$ELSE}
  4318. LItems.Strings[I] := ASubItem + '=' + LValue; {do not localize}
  4319. {$ENDIF}
  4320. end;
  4321. {$ENDIF}
  4322. end
  4323. else if I < 0 then begin
  4324. // subitem not found, just return the original header as-is...
  4325. Result := AHeaderLine;
  4326. Exit;
  4327. end else begin
  4328. LItems.Delete(I);
  4329. end;
  4330. Result := ExtractHeaderItem(AHeaderLine);
  4331. if Result <> '' then begin
  4332. for I := 0 to LItems.Count-1 do begin
  4333. {$IFDEF USE_OBJECT_ARC}
  4334. Result := Result + '; ' + LItems[I].Name + '=' + QuoteString(LItems[I].Value, LItems[I].Quoted); {do not localize}
  4335. {$ELSE}
  4336. Result := Result + '; ' + LItems.Names[I] + '=' + QuoteString(IndyValueFromIndex(LItems, I), Boolean(LItems.Objects[I])); {do not localize}
  4337. {$ENDIF}
  4338. end;
  4339. end;
  4340. finally
  4341. LItems.Free;
  4342. end;
  4343. end;
  4344. function MediaTypeMatches(const AValue, AMediaType: String): Boolean;
  4345. begin
  4346. if Pos('/', AMediaType) > 0 then begin {do not localize}
  4347. Result := TextIsSame(AValue, AMediaType);
  4348. end else begin
  4349. Result := TextStartsWith(AValue, AMediaType + '/'); {do not localize}
  4350. end;
  4351. end;
  4352. function IsHeaderMediaType(const AHeaderLine, AMediaType: String): Boolean;
  4353. begin
  4354. Result := MediaTypeMatches(ExtractHeaderItem(AHeaderLine), AMediaType);
  4355. end;
  4356. function IsHeaderMediaTypes(const AHeaderLine: String; const AMediaTypes: array of String): Boolean;
  4357. var
  4358. LHeader: String;
  4359. I: Integer;
  4360. begin
  4361. Result := False;
  4362. LHeader := ExtractHeaderItem(AHeaderLine);
  4363. for I := Low(AMediaTypes) to High(AMediaTypes) do begin
  4364. if MediaTypeMatches(LHeader, AMediaTypes[I]) then begin
  4365. Result := True;
  4366. Exit;
  4367. end;
  4368. end;
  4369. end;
  4370. function ExtractHeaderMediaType(const AHeaderLine: String): String;
  4371. var
  4372. S: String;
  4373. I: Integer;
  4374. begin
  4375. S := ExtractHeaderItem(AHeaderLine);
  4376. I := Pos('/', S);
  4377. if I > 0 then begin
  4378. Result := Copy(S, 1, I-1);
  4379. end else begin
  4380. Result := '';
  4381. end;
  4382. end;
  4383. function ExtractHeaderMediaSubType(const AHeaderLine: String): String;
  4384. var
  4385. S: String;
  4386. I: Integer;
  4387. begin
  4388. S := ExtractHeaderItem(AHeaderLine);
  4389. I := Pos('/', S);
  4390. if I > 0 then begin
  4391. Result := Copy(S, I+1, Length(S));
  4392. end else begin
  4393. Result := '';
  4394. end;
  4395. end;
  4396. function IsHeaderValue(const AHeaderLine: String; const AValue: String): Boolean;
  4397. begin
  4398. Result := TextIsSame(ExtractHeaderItem(AHeaderLine), AValue);
  4399. end;
  4400. function IsHeaderValue(const AHeaderLine: String; const AValues: array of String): Boolean;
  4401. begin
  4402. Result := PosInStrArray(ExtractHeaderItem(AHeaderLine), AValues, False) <> -1;
  4403. end;
  4404. function GetClockValue : Int64;
  4405. {$IFDEF DOTNET}
  4406. {$IFDEF USE_INLINE} inline; {$ENDIF}
  4407. {$ELSE}
  4408. {$IFDEF WINDOWS}
  4409. type
  4410. TInt64Rec = record
  4411. case Integer of
  4412. 0 : (High : UInt32;
  4413. Low : UInt32);
  4414. 1 : (Long : Int64);
  4415. end;
  4416. var
  4417. LFTime : TFileTime;
  4418. {$ELSE}
  4419. {$IFDEF UNIX}
  4420. {$IFNDEF USE_VCL_POSIX}
  4421. var
  4422. TheTms: tms;
  4423. {$ENDIF}
  4424. {$ENDIF}
  4425. {$ENDIF}
  4426. {$ENDIF}
  4427. begin
  4428. {$IFDEF DOTNET}
  4429. Result := System.DateTime.Now.Ticks;
  4430. {$ELSE}
  4431. {$IFDEF WINDOWS}
  4432. {$IFDEF WINCE}
  4433. // TODO
  4434. {$ELSE}
  4435. Windows.GetSystemTimeAsFileTime(LFTime);
  4436. TInt64Rec(Result).Low := LFTime.dwLowDateTime;
  4437. TInt64Rec(Result).High := LFTime.dwHighDateTime;
  4438. {$ENDIF}
  4439. {$ELSE}
  4440. {$IFDEF UNIX}
  4441. //Is the following correct?
  4442. {$IFDEF USE_VCL_POSIX}
  4443. Result := time(nil);
  4444. {$ELSE}
  4445. {$IFDEF KYLIXCOMPAT}
  4446. Result := Times(TheTms);
  4447. {$ELSE}
  4448. {$IFDEF USE_BASEUNIX}
  4449. Result := fptimes(TheTms);
  4450. {$ELSE}
  4451. {$message error time is not called on this platform!}
  4452. {$ENDIF}
  4453. {$ENDIF}
  4454. {$ENDIF}
  4455. {$ELSE}
  4456. {$message error GetClockValue is not implemented on this platform!}
  4457. {$ENDIF}
  4458. {$ENDIF}
  4459. {$ENDIF}
  4460. end;
  4461. // TODO: should we just get rid of the inline assembly here and let the compiler generate opcode as needed?
  4462. {$UNDEF NO_NATIVE_ASM}
  4463. {$IFDEF DOTNET}
  4464. {$DEFINE NO_NATIVE_ASM}
  4465. {$ENDIF}
  4466. {$IFDEF IOS}
  4467. {$IFDEF CPUARM}
  4468. {$DEFINE NO_NATIVE_ASM}
  4469. {$ENDIF}
  4470. {$ENDIF}
  4471. {$IFDEF OSX} // !!! ADDED OSX BY EMBT
  4472. {$IFDEF CPUX64}
  4473. {$DEFINE NO_NATIVE_ASM}
  4474. {$ENDIF}
  4475. {$IFDEF CPUARM64}
  4476. {$DEFINE NO_NATIVE_ASM}
  4477. {$ENDIF}
  4478. {$ENDIF}
  4479. {$IFDEF ANDROID}
  4480. {$DEFINE NO_NATIVE_ASM}
  4481. {$ENDIF}
  4482. {$IFDEF FPC}
  4483. {$IFNDEF CPUI386}
  4484. {$DEFINE NO_NATIVE_ASM}
  4485. {$ENDIF}
  4486. {$ENDIF}
  4487. {$IFDEF LINUX64}
  4488. {$DEFINE NO_NATIVE_ASM}
  4489. {$ENDIF}
  4490. {$IFDEF NO_NATIVE_ASM}
  4491. function ROL(const AVal: UInt32; AShift: Byte): UInt32;
  4492. {$IFDEF USE_INLINE} inline; {$ENDIF}
  4493. begin
  4494. Result := (AVal shl AShift) or (AVal shr (32 - AShift));
  4495. end;
  4496. function ROR(const AVal: UInt32; AShift: Byte): UInt32;
  4497. {$IFDEF USE_INLINE} inline; {$ENDIF}
  4498. begin
  4499. Result := (AVal shr AShift) or (AVal shl (32 - AShift)) ;
  4500. end;
  4501. {$ELSE}
  4502. // 32-bit: Arg1=EAX, Arg2=DL
  4503. // 64-bit: Arg1=ECX, Arg2=DL
  4504. function ROL(const AVal: UInt32; AShift: Byte): UInt32; assembler;
  4505. asm
  4506. {$IFDEF CPU64}
  4507. mov eax, ecx
  4508. {$ENDIF}
  4509. mov cl, dl
  4510. rol eax, cl
  4511. end;
  4512. function ROR(const AVal: UInt32; AShift: Byte): UInt32; assembler;
  4513. asm
  4514. {$IFDEF CPU64}
  4515. mov eax, ecx
  4516. {$ENDIF}
  4517. mov cl, dl
  4518. ror eax, cl
  4519. end;
  4520. {$ENDIF}
  4521. function IndyComputerName: string;
  4522. {$IFDEF DOTNET}
  4523. {$IFDEF USE_INLINE} inline; {$ENDIF}
  4524. {$ENDIF}
  4525. {$IFDEF UNIX}
  4526. const
  4527. sMaxHostName = 255;
  4528. var
  4529. LHost: array[0..sMaxHostName] of TIdAnsiChar;
  4530. {$IFDEF USE_MARSHALLED_PTRS}
  4531. LHostPtr: TPtrWrapper;
  4532. {$ENDIF}
  4533. {$ENDIF}
  4534. {$IFDEF WINDOWS}
  4535. var
  4536. {$IFDEF WINCE}
  4537. Reg: TRegistry;
  4538. {$ELSE}
  4539. LHost: array[0..MAX_COMPUTERNAME_LENGTH] of Char;
  4540. i: DWORD;
  4541. {$ENDIF}
  4542. {$ENDIF}
  4543. begin
  4544. Result := '';
  4545. {$IFDEF UNIX}
  4546. //TODO: No need for LHost at all? Prob can use just Result
  4547. {$IFDEF KYLIXCOMPAT}
  4548. if GetHostname(LHost, sMaxHostName) <> -1 then begin
  4549. Result := String(LHost);
  4550. end;
  4551. {$ENDIF}
  4552. {$IFDEF USE_BASEUNIX}
  4553. Result := GetHostName;
  4554. {$ENDIF}
  4555. {$IFDEF USE_VCL_POSIX}
  4556. {$IFDEF USE_MARSHALLED_PTRS}
  4557. LHostPtr := TPtrWrapper.Create(@LHost[0]);
  4558. {$ENDIF}
  4559. if Posix.Unistd.gethostname(
  4560. {$IFDEF USE_MARSHALLED_PTRS}
  4561. LHostPtr.ToPointer
  4562. {$ELSE}
  4563. LHost
  4564. {$ENDIF},
  4565. sMaxHostName) <> -1 then
  4566. begin
  4567. LHost[sMaxHostName] := TIdAnsiChar(0);
  4568. {$IFDEF USE_MARSHALLED_PTRS}
  4569. Result := TMarshal.ReadStringAsAnsi(LHostPtr);
  4570. {$ELSE}
  4571. Result := String(LHost);
  4572. {$ENDIF}
  4573. end;
  4574. {$ENDIF}
  4575. {$ENDIF}
  4576. {$IFDEF WINDOWS}
  4577. {$IFDEF WINCE}
  4578. Reg := TRegistry.Create;
  4579. try
  4580. Reg.RootKey := HKEY_LOCAL_MACHINE;
  4581. if Reg.OpenKeyReadOnly('\Ident') then begin
  4582. Result := Reg.ReadString('Name');
  4583. Reg.CloseKey;
  4584. end;
  4585. finally
  4586. Reg.Free;
  4587. end;
  4588. {$ELSE}
  4589. i := MAX_COMPUTERNAME_LENGTH;
  4590. if {$IFDEF STRING_IS_UNICODE}GetComputerNameW{$ELSE}GetComputerNameA{$ENDIF}(LHost, i) then begin
  4591. SetString(Result, LHost, i);
  4592. {$IFDEF STRING_IS_ANSI}
  4593. // on compilers that support AnsiString codepages,
  4594. // set the string's codepage to match the OS...
  4595. {$IFDEF HAS_SetCodePage}
  4596. SetCodePage(PRawByteString(@Result)^, GetACP(), False);
  4597. {$ENDIF}
  4598. {$ENDIF}
  4599. end;
  4600. {$ENDIF}
  4601. {$ENDIF}
  4602. {$IFDEF DOTNET}
  4603. Result := Environment.MachineName;
  4604. {$ENDIF}
  4605. end;
  4606. {$IFDEF STRING_IS_ANSI}
  4607. function IsLeadChar(ACh : Char): Boolean;
  4608. {$IFDEF USE_INLINE} inline; {$ENDIF}
  4609. begin
  4610. Result := ACh in LeadBytes;
  4611. end;
  4612. {$ENDIF}
  4613. function IdGetDefaultCharSet: TIdCharSet;
  4614. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4615. begin
  4616. {$IFDEF UNIX}
  4617. Result := GIdDefaultCharSet;
  4618. {$ENDIF}
  4619. {$IFDEF DOTNET}
  4620. Result := idcs_UNICODE_1_1;
  4621. // not a particular Unicode encoding - just unicode in general
  4622. // i.e. DotNet native string is 2 byte Unicode, we do not concern ourselves
  4623. // with Byte order. (though we have to concern ourselves once we start
  4624. // writing to some stream or Bytes
  4625. {$ENDIF}
  4626. {$IFDEF WINDOWS}
  4627. // Many defaults are set here when the choice is ambiguous. However for
  4628. // IdMessage OnInitializeISO can be used by user to choose other.
  4629. case SysLocale.PriLangID of
  4630. LANG_CHINESE: begin
  4631. if SysLocale.SubLangID = SUBLANG_CHINESE_SIMPLIFIED then begin
  4632. Result := idcs_GB2312;
  4633. end else begin
  4634. Result := idcs_Big5;
  4635. end;
  4636. end;
  4637. LANG_JAPANESE: Result := idcs_ISO_2022_JP;
  4638. LANG_KOREAN: Result := idcs_csEUCKR;
  4639. // Kudzu
  4640. // 1251 is the Windows standard for Russian but its not used in emails.
  4641. // KOI8-R is by far the most widely used and thus the default.
  4642. LANG_RUSSIAN: Result := idcs_KOI8_R;
  4643. // Kudzu
  4644. // Ukranian is about 50/50 KOI8u and 1251, but 1251 is the newer one and
  4645. // the Windows one so we default to it.
  4646. LANG_UKRAINIAN: Result := idcs_windows_1251;
  4647. else begin
  4648. {$IFDEF STRING_IS_UNICODE}
  4649. Result := idcs_UNICODE_1_1;
  4650. // not a particular Unicode encoding - just unicode in general
  4651. // i.e. Delphi/C++Builder 2009+ native string is 2 byte Unicode,
  4652. // we do not concern ourselves with Byte order. (though we have
  4653. // to concern ourselves once we start writing to some stream or
  4654. // Bytes
  4655. {$ELSE}
  4656. Result := idcs_ISO_8859_1;
  4657. {$ENDIF}
  4658. end;
  4659. end;
  4660. {$ENDIF}
  4661. end;
  4662. //The following is for working on email headers and message part headers.
  4663. //For example, to remove the boundary from the ContentType header, call
  4664. //ContentType := RemoveHeaderEntry(ContentType, 'boundary', QuoteMIME);
  4665. function RemoveHeaderEntry(const AHeader, AEntry: string;
  4666. AQuoteType: TIdHeaderQuotingType): string;
  4667. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4668. begin
  4669. Result := ReplaceHeaderSubItem(AHeader, AEntry, '', AQuoteType);
  4670. end;
  4671. function RemoveHeaderEntry(const AHeader, AEntry: string; var VOld: String;
  4672. AQuoteType: TIdHeaderQuotingType): string;
  4673. {$IFDEF USE_INLINE}inline;{$ENDIF}
  4674. begin
  4675. Result := ReplaceHeaderSubItem(AHeader, AEntry, '', VOld, AQuoteType);
  4676. end;
  4677. function RemoveHeaderEntries(const AHeader: string; const AEntries: array of string;
  4678. AQuoteType: TIdHeaderQuotingType): string;
  4679. var
  4680. I: Integer;
  4681. begin
  4682. Result := AHeader;
  4683. if Length(AEntries) > 0 then begin
  4684. for I := Low(AEntries) to High(AEntries) do begin
  4685. Result := ReplaceHeaderSubItem(Result, AEntries[I], '', AQuoteType);
  4686. end;
  4687. end;
  4688. end;
  4689. {
  4690. Three functions for easier manipulating of strings. Don't know of any
  4691. system functions to perform these actions. If there aren't and someone
  4692. can find an optimised way of performing then please implement...
  4693. }
  4694. function FindFirstOf(const AFind, AText: string; const ALength: Integer = -1;
  4695. const AStartPos: Integer = 1): Integer;
  4696. var
  4697. I, LLength, LPos: Integer;
  4698. begin
  4699. Result := 0;
  4700. if Length(AFind) > 0 then begin
  4701. LLength := IndyLength(AText, ALength, AStartPos);
  4702. if LLength > 0 then begin
  4703. for I := 0 to LLength-1 do begin
  4704. LPos := AStartPos + I;
  4705. if IndyPos(AText[LPos], AFind) <> 0 then begin
  4706. Result := LPos;
  4707. Exit;
  4708. end;
  4709. end;
  4710. end;
  4711. end;
  4712. end;
  4713. function FindFirstNotOf(const AFind, AText: string; const ALength: Integer = -1;
  4714. const AStartPos: Integer = 1): Integer;
  4715. var
  4716. I, LLength, LPos: Integer;
  4717. begin
  4718. Result := 0;
  4719. LLength := IndyLength(AText, ALength, AStartPos);
  4720. if LLength > 0 then begin
  4721. if Length(AFind) = 0 then begin
  4722. Result := AStartPos;
  4723. Exit;
  4724. end;
  4725. for I := 0 to LLength-1 do begin
  4726. LPos := AStartPos + I;
  4727. if IndyPos(AText[LPos], AFind) = 0 then begin
  4728. Result := LPos;
  4729. Exit;
  4730. end;
  4731. end;
  4732. end;
  4733. end;
  4734. function TrimAllOf(const ATrim, AText: string): string;
  4735. var
  4736. Len: Integer;
  4737. begin
  4738. Result := AText;
  4739. Len := Length(Result);
  4740. while Len > 0 do begin
  4741. if IndyPos(Result[1], ATrim) > 0 then begin
  4742. IdDelete(Result, 1, 1);
  4743. Dec(Len);
  4744. end else begin
  4745. Break;
  4746. end;
  4747. end;
  4748. while Len > 0 do begin
  4749. if IndyPos(Result[Len], ATrim) > 0 then begin
  4750. IdDelete(Result, Len, 1);
  4751. Dec(Len);
  4752. end else begin
  4753. Break;
  4754. end;
  4755. end;
  4756. end;
  4757. function ContentTypeToEncoding(const AContentType: String;
  4758. AQuoteType: TIdHeaderQuotingType): IIdTextEncoding;
  4759. var
  4760. LCharset: String;
  4761. begin
  4762. LCharset := ExtractHeaderSubItem(AContentType, 'charset', AQuoteType); {do not localize}
  4763. Result := CharsetToEncoding(LCharset);
  4764. end;
  4765. function CharsetToEncoding(const ACharset: String): IIdTextEncoding;
  4766. {$IFNDEF DOTNET_OR_ICONV}
  4767. var
  4768. CP: Word;
  4769. {$ENDIF}
  4770. begin
  4771. Result := nil;
  4772. if ACharSet <> '' then
  4773. begin
  4774. // let the user provide a custom encoding first, if desired...
  4775. if Assigned(GIdEncodingNeeded) then begin
  4776. Result := GIdEncodingNeeded(ACharSet);
  4777. if Assigned(Result) then begin
  4778. Exit;
  4779. end;
  4780. end;
  4781. { TODO: finish implementing this
  4782. if PosInStrArray(
  4783. ACharSet,
  4784. ['ISO-2022-JP', 'ISO-2022-JP-1', 'ISO-2022-JP-2', 'ISO-2022-JP-3', 'ISO-2022-JP-2004'], {do not localize
  4785. False) <> -1 then
  4786. begin
  4787. Result := TIdTextEncoding_ISO2022JP.Create;
  4788. Exit;
  4789. end;
  4790. }
  4791. { TODO: implement this
  4792. if TextIsSame(ACharSet, 'ISO-2022-KR') then {do not localize
  4793. begin
  4794. Result := TIdTextEncoding_ISO2022KR.Create;
  4795. Exit;
  4796. end;
  4797. }
  4798. // RLebeau 3/13/09: if there is a problem initializing an encoding
  4799. // class for the requested charset, either because the charset is
  4800. // not known to Indy, or because the OS does not support it natively,
  4801. // just return the 8-bit encoding as a fallback for now. The data
  4802. // being handled by it likely won't be encoded/decoded properly, but
  4803. // at least the error won't cause exceptions in the user's code, and
  4804. // maybe the user will know how to encode/decode the data manually
  4805. // as a workaround...
  4806. try
  4807. {$IFDEF DOTNET_OR_ICONV}
  4808. Result := IndyTextEncoding(ACharset);
  4809. {$ELSE}
  4810. CP := CharsetToCodePage(ACharset);
  4811. if CP <> 0 then begin
  4812. Result := IndyTextEncoding(CP);
  4813. end;
  4814. {$ENDIF}
  4815. except end;
  4816. end;
  4817. {JPM - I have decided to temporarily make this 8-bit because I'm concerned
  4818. about how binary files will be handled by the ASCII encoder (where there may
  4819. be 8bit byte-values. In addition, there are numerous charsets for various
  4820. languages and codepages that do some special mapping for them would be a mess.}
  4821. {RLebeau: technically, we should be returning a 7-bit encoding, as the
  4822. default charset for "text/" content types is "us-ascii".}
  4823. if not Assigned(Result) then
  4824. begin
  4825. Result := IndyTextEncoding_8Bit;
  4826. end;
  4827. end;
  4828. procedure WriteStringAsContentType(AStream: TStream; const AStr, AContentType: String;
  4829. AQuoteType: TIdHeaderQuotingType
  4830. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF});
  4831. begin
  4832. WriteStringToStream(AStream, AStr, ContentTypeToEncoding(AContentType, AQuoteType){$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF});
  4833. end;
  4834. procedure WriteStringsAsContentType(AStream: TStream; const AStrings: TStrings;
  4835. const AContentType: String; AQuoteType: TIdHeaderQuotingType
  4836. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF});
  4837. begin
  4838. // RLebeau 10/06/2010: not using TStrings.SaveToStream() in D2009+
  4839. // anymore, as it may save a BOM which we do not want here...
  4840. // TODO: instead of writing AString.Text as a whole, loop through AStrings
  4841. // writing the individual strings to avoid unnecessary memory allocations...
  4842. WriteStringToStream(AStream, AStrings.Text, ContentTypeToEncoding(AContentType, AQuoteType){$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF});
  4843. end;
  4844. procedure WriteStringAsCharset(AStream: TStream; const AStr, ACharset: string
  4845. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF});
  4846. begin
  4847. WriteStringToStream(AStream, AStr, CharsetToEncoding(ACharset){$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF});
  4848. end;
  4849. procedure WriteStringsAsCharset(AStream: TStream; const AStrings: TStrings;
  4850. const ACharset: string
  4851. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF});
  4852. begin
  4853. // RLebeau 10/06/2010: not using TStrings.SaveToStream() in D2009+
  4854. // anymore, as it may save a BOM which we do not want here...
  4855. // TODO: instead of writing AString.Text as a whole, loop through AStrings
  4856. // writing the individual strings to avoid unnecessary memory allocations...
  4857. WriteStringToStream(AStream, AStrings.Text, CharsetToEncoding(ACharset){$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF});
  4858. end;
  4859. function ReadStringAsContentType(AStream: TStream; const AContentType: String;
  4860. AQuoteType: TIdHeaderQuotingType
  4861. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  4862. ): String;
  4863. begin
  4864. Result := ReadStringFromStream(AStream, -1, ContentTypeToEncoding(AContentType, AQuoteType){$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
  4865. end;
  4866. procedure ReadStringsAsContentType(AStream: TStream; AStrings: TStrings;
  4867. const AContentType: String; AQuoteType: TIdHeaderQuotingType
  4868. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  4869. );
  4870. begin
  4871. // TODO: TStrings.Text truncates on an embedded null character, but the
  4872. // decoded string may contain nulls, depending on the source! Maybe use
  4873. // SplitDelimitedString() instead, but give it a new parameter to let it
  4874. // know to parse line breaks so it can handle CR, LF, and CRLF equally.
  4875. // Otherwise, create a new function that mimics the TStrings.Text setter
  4876. // but without the null character limitation...
  4877. AStrings.Text := ReadStringFromStream(AStream, -1, ContentTypeToEncoding(AContentType, AQuoteType){$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
  4878. end;
  4879. function ReadStringAsCharset(AStream: TStream; const ACharset: String
  4880. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  4881. ): String;
  4882. begin
  4883. //TODO: Figure out what should happen with Unicode content type.
  4884. Result := ReadStringFromStream(AStream, -1, CharsetToEncoding(ACharset){$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
  4885. end;
  4886. procedure ReadStringsAsCharset(AStream: TStream; AStrings: TStrings; const ACharset: String
  4887. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  4888. );
  4889. begin
  4890. // TODO: TStrings.Text truncates on an embedded null character, but the
  4891. // decoded string may contain nulls, depending on the source! Maybe use
  4892. // SplitDelimitedString() instead, but give it a new parameter to let it
  4893. // know to parse line breaks so it can handle CR, LF, and CRLF equally.
  4894. // Otherwise, create a new function that mimics the TStrings.Text setter
  4895. // but without the null character limitation...
  4896. AStrings.Text := ReadStringFromStream(AStream, -1, CharsetToEncoding(ACharset){$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
  4897. end;
  4898. { TIdInterfacedObject }
  4899. function TIdInterfacedObject._AddRef: {$IFDEF FPC}Longint{$ELSE}Integer{$ENDIF}; {$IFDEF INTF_USES_STDCALL}stdcall{$ELSE}cdecl{$ENDIF};
  4900. begin
  4901. {$IFDEF DOTNET}
  4902. Result := 1;
  4903. {$ELSE}
  4904. Result := inherited _AddRef;
  4905. {$ENDIF}
  4906. end;
  4907. function TIdInterfacedObject._Release: {$IFDEF FPC}Longint{$ELSE}Integer{$ENDIF}; {$IFDEF INTF_USES_STDCALL}stdcall{$ELSE}cdecl{$ENDIF};
  4908. begin
  4909. {$IFDEF DOTNET}
  4910. Result := 1;
  4911. {$ELSE}
  4912. Result := inherited _Release;
  4913. {$ENDIF}
  4914. end;
  4915. initialization
  4916. {$IFDEF WINDOWS}
  4917. GTempPath := TempPath;
  4918. {$ENDIF}
  4919. SetLength(IndyFalseBoolStrs, 1);
  4920. IndyFalseBoolStrs[Low(IndyFalseBoolStrs)] := 'FALSE'; {Do not Localize}
  4921. SetLength(IndyTrueBoolStrs, 1);
  4922. IndyTrueBoolStrs[Low(IndyTrueBoolStrs)] := 'TRUE'; {Do not Localize}
  4923. end.