IdIMAP4.pas 295 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590559155925593559455955596559755985599560056015602560356045605560656075608560956105611561256135614561556165617561856195620562156225623562456255626562756285629563056315632563356345635563656375638563956405641564256435644564556465647564856495650565156525653565456555656565756585659566056615662566356645665566656675668566956705671567256735674567556765677567856795680568156825683568456855686568756885689569056915692569356945695569656975698569957005701570257035704570557065707570857095710571157125713571457155716571757185719572057215722572357245725572657275728572957305731573257335734573557365737573857395740574157425743574457455746574757485749575057515752575357545755575657575758575957605761576257635764576557665767576857695770577157725773577457755776577757785779578057815782578357845785578657875788578957905791579257935794579557965797579857995800580158025803580458055806580758085809581058115812581358145815581658175818581958205821582258235824582558265827582858295830583158325833583458355836583758385839584058415842584358445845584658475848584958505851585258535854585558565857585858595860586158625863586458655866586758685869587058715872587358745875587658775878587958805881588258835884588558865887588858895890589158925893589458955896589758985899590059015902590359045905590659075908590959105911591259135914591559165917591859195920592159225923592459255926592759285929593059315932593359345935593659375938593959405941594259435944594559465947594859495950595159525953595459555956595759585959596059615962596359645965596659675968596959705971597259735974597559765977597859795980598159825983598459855986598759885989599059915992599359945995599659975998599960006001600260036004600560066007600860096010601160126013601460156016601760186019602060216022602360246025602660276028602960306031603260336034603560366037603860396040604160426043604460456046604760486049605060516052605360546055605660576058605960606061606260636064606560666067606860696070607160726073607460756076607760786079608060816082608360846085608660876088608960906091609260936094609560966097609860996100610161026103610461056106610761086109611061116112611361146115611661176118611961206121612261236124612561266127612861296130613161326133613461356136613761386139614061416142614361446145614661476148614961506151615261536154615561566157615861596160616161626163616461656166616761686169617061716172617361746175617661776178617961806181618261836184618561866187618861896190619161926193619461956196619761986199620062016202620362046205620662076208620962106211621262136214621562166217621862196220622162226223622462256226622762286229623062316232623362346235623662376238623962406241624262436244624562466247624862496250625162526253625462556256625762586259626062616262626362646265626662676268626962706271627262736274627562766277627862796280628162826283628462856286628762886289629062916292629362946295629662976298629963006301630263036304630563066307630863096310631163126313631463156316631763186319632063216322632363246325632663276328632963306331633263336334633563366337633863396340634163426343634463456346634763486349635063516352635363546355635663576358635963606361636263636364636563666367636863696370637163726373637463756376637763786379638063816382638363846385638663876388638963906391639263936394639563966397639863996400640164026403640464056406640764086409641064116412641364146415641664176418641964206421642264236424642564266427642864296430643164326433643464356436643764386439644064416442644364446445644664476448644964506451645264536454645564566457645864596460646164626463646464656466646764686469647064716472647364746475647664776478647964806481648264836484648564866487648864896490649164926493649464956496649764986499650065016502650365046505650665076508650965106511651265136514651565166517651865196520652165226523652465256526652765286529653065316532653365346535653665376538653965406541654265436544654565466547654865496550655165526553655465556556655765586559656065616562656365646565656665676568656965706571657265736574657565766577657865796580658165826583658465856586658765886589659065916592659365946595659665976598659966006601660266036604660566066607660866096610661166126613661466156616661766186619662066216622662366246625662666276628662966306631663266336634663566366637663866396640664166426643664466456646664766486649665066516652665366546655665666576658665966606661666266636664666566666667666866696670667166726673667466756676667766786679668066816682668366846685668666876688668966906691669266936694669566966697669866996700670167026703670467056706670767086709671067116712671367146715671667176718671967206721672267236724672567266727672867296730673167326733673467356736673767386739674067416742674367446745674667476748674967506751675267536754675567566757675867596760676167626763676467656766676767686769677067716772677367746775677667776778677967806781678267836784678567866787678867896790679167926793679467956796679767986799680068016802680368046805680668076808680968106811681268136814681568166817681868196820682168226823682468256826682768286829683068316832683368346835683668376838683968406841684268436844684568466847684868496850685168526853685468556856685768586859686068616862686368646865686668676868686968706871687268736874687568766877687868796880688168826883688468856886688768886889689068916892689368946895689668976898689969006901690269036904690569066907690869096910691169126913691469156916691769186919692069216922692369246925692669276928692969306931693269336934693569366937693869396940694169426943694469456946694769486949695069516952695369546955695669576958695969606961696269636964696569666967696869696970697169726973697469756976697769786979698069816982698369846985698669876988698969906991699269936994699569966997699869997000700170027003700470057006700770087009701070117012701370147015701670177018701970207021702270237024702570267027702870297030703170327033703470357036703770387039704070417042704370447045704670477048704970507051705270537054705570567057705870597060706170627063706470657066706770687069707070717072707370747075707670777078707970807081708270837084708570867087708870897090709170927093709470957096709770987099710071017102710371047105710671077108710971107111711271137114711571167117711871197120712171227123712471257126712771287129713071317132713371347135713671377138713971407141714271437144714571467147714871497150715171527153715471557156715771587159716071617162716371647165716671677168716971707171717271737174717571767177717871797180718171827183718471857186718771887189719071917192719371947195719671977198719972007201720272037204720572067207720872097210721172127213721472157216721772187219722072217222722372247225722672277228722972307231723272337234723572367237723872397240724172427243724472457246724772487249725072517252725372547255725672577258725972607261726272637264726572667267726872697270727172727273727472757276
  1. {
  2. $Project$
  3. $Workfile$
  4. $Revision$
  5. $DateUTC$
  6. $Id$
  7. This file is part of the Indy (Internet Direct) project, and is offered
  8. under the dual-licensing agreement described on the Indy website.
  9. (http://www.indyproject.org/)
  10. Copyright:
  11. (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
  12. }
  13. {
  14. $Log$
  15. }
  16. {
  17. Rev 1.66 3/24/2005 3:03:28 AM DSiders
  18. Modified TIdIMAP4.ParseStatusResult to correct an endless loop parsing an odd
  19. number of status messages/values in the server response.
  20. Rev 1.65 3/23/2005 3:03:40 PM DSiders
  21. Modified TIdIMAP4.Destroy to free resources for Capabilities and MUtf7
  22. properties.
  23. Rev 1.64 3/4/2005 3:08:42 PM JPMugaas
  24. Removed compiler warning with stream. You sometimes need to use IdStreamVCL.
  25. Rev 1.63 3/3/2005 12:54:04 PM JPMugaas
  26. Replaced TStringList with TIdStringList.
  27. Rev 1.62 3/3/2005 12:09:04 PM JPMugaas
  28. TStrings were replaced with TIdStrings.
  29. Rev 1.60 20/02/2005 20:41:06 CCostelloe
  30. Cleanup and reorganisations
  31. Rev 1.59 11/29/2004 2:46:10 AM JPMugaas
  32. I hope that this fixes a compile error.
  33. Rev 1.58 11/27/04 3:11:56 AM RLebeau
  34. Fixed bug in ownership of SASLMechanisms property.
  35. Updated to use TextIsSame() instead of Uppercase() comparisons.
  36. Rev 1.57 11/8/2004 8:39:00 AM DSiders
  37. Removed comment in TIdIMAP4.SearchMailBox implementation that caused DOM
  38. problem when locating the symbol id.
  39. Rev 1.56 10/26/2004 10:19:58 PM JPMugaas
  40. Updated refs.
  41. Rev 1.55 2004.10.26 2:19:56 PM czhower
  42. Resolved alias conflict.
  43. Rev 1.54 6/11/2004 9:36:34 AM DSiders
  44. Added "Do not Localize" comments.
  45. Rev 1.53 6/4/04 12:48:12 PM RLebeau
  46. ContentTransferEncoding bug fix
  47. Rev 1.52 01/06/2004 19:03:46 CCostelloe
  48. .NET bug fix
  49. Rev 1.51 01/06/2004 01:16:18 CCostelloe
  50. Various improvements
  51. Rev 1.50 20/05/2004 22:04:14 CCostelloe
  52. IdStreamVCL changes
  53. Rev 1.49 20/05/2004 08:43:12 CCostelloe
  54. IdStream change
  55. Rev 1.48 16/05/2004 20:40:46 CCostelloe
  56. New TIdText/TIdAttachment processing
  57. Rev 1.47 24/04/2004 23:54:42 CCostelloe
  58. IMAP-style UTF-7 encoding/decoding of mailbox names added
  59. Rev 1.46 13/04/2004 22:24:28 CCostelloe
  60. Bug fix (FCapabilities not created if not DOTNET)
  61. Rev 1.45 3/18/2004 2:32:40 AM JPMugaas
  62. Should compile under D8 properly.
  63. Rev 1.44 3/8/2004 10:10:32 AM JPMugaas
  64. IMAP4 should now have SASLMechanisms again. Those work in DotNET now.
  65. SSL abstraction is now supported even in DotNET so that should not be
  66. IFDEF'ed out.
  67. Rev 1.43 07/03/2004 17:55:16 CCostelloe
  68. Updates to cover changes in other units
  69. Rev 1.42 2/4/2004 2:36:58 AM JPMugaas
  70. Moved more units down to the implementation clause in the units to make them
  71. easier to compile.
  72. Rev 1.41 2/3/2004 4:12:50 PM JPMugaas
  73. Fixed up units so they should compile.
  74. Rev 1.40 2004.02.03 5:43:48 PM czhower
  75. Name changes
  76. Rev 1.39 2004.02.03 2:12:10 PM czhower
  77. $I path change
  78. Rev 1.38 1/27/2004 4:01:12 PM SPerry
  79. StringStream ->IdStringStream
  80. Rev 1.37 1/25/2004 3:11:12 PM JPMugaas
  81. SASL Interface reworked to make it easier for developers to use.
  82. SSL and SASL reenabled components.
  83. Rev 1.36 23/01/2004 01:48:28 CCostelloe
  84. Added BinHex4.0 encoding support for parts
  85. Rev 1.35 1/21/2004 3:10:40 PM JPMugaas
  86. InitComponent
  87. Rev 1.34 31/12/2003 09:40:32 CCostelloe
  88. ChangeReplyClass removed, replaced AnsiSameText with TextIsSame, stream code
  89. not tested.
  90. Rev 1.33 28/12/2003 23:48:18 CCostelloe
  91. More TEMPORARY fixes to get it to compile under D7 and D8 .NET
  92. Rev 1.32 22/12/2003 01:20:20 CCostelloe
  93. .NET fixes. This is a TEMPORARY combined Indy9/10/.NET master file.
  94. Rev 1.31 14/12/2003 21:03:16 CCostelloe
  95. First version for .NET
  96. Rev 1.30 10/17/2003 12:11:06 AM DSiders
  97. Added localization comments.
  98. Added resource strings for exception messages.
  99. Rev 1.29 2003.10.12 3:53:10 PM czhower
  100. compile todos
  101. Rev 1.28 10/12/2003 1:49:50 PM BGooijen
  102. Changed comment of last checkin
  103. Rev 1.27 10/12/2003 1:43:34 PM BGooijen
  104. Changed IdCompilerDefines.inc to Core\IdCompilerDefines.inc
  105. Rev 1.26 20/09/2003 15:38:38 CCostelloe
  106. More patches added for different IMAP servers
  107. Rev 1.25 12/08/2003 01:17:38 CCostelloe
  108. Retrieve and AppendMsg updated to suit changes made to attachment encoding
  109. changes in other units
  110. Rev 1.24 21/07/2003 01:22:24 CCostelloe
  111. Added CopyMsg and UIDCopyMsgs. (UID)Receive(Peek) rewritten. AppendMsg
  112. still buggy with attachments. Public variable FGreetingBanner added. Added
  113. "if Connected then " to Destroy. Attachment filenames now decoded if
  114. necessary. Added support for multisection parts. Resolved issue of some
  115. servers leaving out the trailing "NIL NIL NIL" at the end of some body
  116. structures. UIDRetrieveAllHeaders removed
  117. Rev 1.23 18/06/2003 21:53:36 CCostelloe
  118. Rewrote GetResponse from scratch. Restored Capabilities for login. Compiles
  119. and runs properly (may be a couple of minor bugs not yet discovered).
  120. Rev 1.22 6/16/2003 11:48:18 PM JPMugaas
  121. Capabilities has to be restored for SASL and SSL support.
  122. Rev 1.21 17/06/2003 01:33:46 CCostelloe
  123. Updated to support new LoginSASL. Compiles OK, may not yet run OK.
  124. Rev 1.20 12/06/2003 10:17:54 CCostelloe
  125. Partial update for Indy 10's new Reply structure. Compiles but does not run
  126. correctly. Checked in to show problem with Get/SetNumericCode in IdReplyIMAP.
  127. Rev 1.19 04/06/2003 02:33:44 CCostelloe
  128. Compiles under Indy 10 with the revised Indy 10 structure, but does not yet
  129. work properly due to some of the changes. Will be fixed by me in a later
  130. check-in.
  131. Rev 1.18 14/05/2003 01:55:50 CCostelloe
  132. This version (with the extra IMAP functionality recently added) now compiles
  133. on Indy 10 and works in a real application.
  134. Rev 1.17 5/12/2003 02:19:56 AM JPMugaas
  135. Now should work properly again. I also removed all warnings and errors in
  136. Indy 10.
  137. Rev 1.16 5/11/2003 07:35:44 PM JPMugaas
  138. Rev 1.15 5/11/2003 07:11:06 PM JPMugaas
  139. Fixed to eliminate some warnings and compile errors in Indy 10.
  140. Rev 1.14 11/05/2003 23:53:52 CCostelloe
  141. Bug fix due to Windows 98 / 2000 discrepancies
  142. Rev 1.13 11/05/2003 23:08:36 CCostelloe
  143. Lots more bug fixes, plus IMAP code moved up from IdRFCReply
  144. Rev 1.12 5/10/2003 07:31:22 PM JPMugaas
  145. Updated with some bug fixes and some cleanups.
  146. Rev 1.11 5/9/2003 10:51:26 AM JPMugaas
  147. Bug fixes. Now works as it should. Verified.
  148. Rev 1.9 5/9/2003 03:49:44 AM JPMugaas
  149. IMAP4 now supports SASL. Merged some code from Ciaran which handles the +
  150. SASL continue reply in IMAP4 and makes a few improvements. Verified to work
  151. on two servers.
  152. Rev 1.8 5/8/2003 05:41:48 PM JPMugaas
  153. Added constant for SASL continuation.
  154. Rev 1.7 5/8/2003 03:17:50 PM JPMugaas
  155. Flattened ou the SASL authentication API, made a custom descendant of SASL
  156. enabled TIdMessageClient classes.
  157. Rev 1.6 5/8/2003 11:27:52 AM JPMugaas
  158. Moved feature negoation properties down to the ExplicitTLSClient level as
  159. feature negotiation goes hand in hand with explicit TLS support.
  160. Rev 1.5 5/8/2003 02:17:44 AM JPMugaas
  161. Fixed an AV in IdPOP3 with SASL list on forms. Made exceptions for SASL
  162. mechanisms missing more consistant, made IdPOP3 support feature feature
  163. negotiation, and consolidated some duplicate code.
  164. Rev 1.4 5/7/2003 10:20:32 PM JPMugaas
  165. Rev 1.3 5/7/2003 04:35:30 AM JPMugaas
  166. IMAP4 should now compile. Started on prelimary SSL support (not finished
  167. yet).
  168. Rev 1.2 15/04/2003 00:57:08 CCostelloe
  169. Rev 1.1 2/24/2003 09:03:06 PM JPMugaas
  170. Rev 1.0 11/13/2002 07:54:50 AM JPMugaas
  171. 2001-FEB-27 IC: First version most of the IMAP features are implemented and
  172. the core IdPOP3 features are implemented to allow a seamless
  173. switch.
  174. The unit is currently oriented to a session connection and not
  175. to constant connection, because of that server events that are
  176. raised from another user actions are not supported.
  177. 2001-APR-18 IC: Added support for the session's connection state with a
  178. special exception for commands preformed in wrong connection
  179. states. Exceptions were also added for response errors.
  180. 2001-MAY-05 IC:
  181. 2001-Mar-13 DS: Fixed Bug # 494813 in CheckMsgSeen where LastCmdResult.Text
  182. was not using the Ln index variable to access server
  183. responses.
  184. 2002-Apr-12 DS: fixed bug # 506026 in TIdIMAP4.ListSubscribedMailBoxes. Call
  185. ParseLSubResut instead of ParseListResult.
  186. 2003-Mar-31 CC: Added GetUID and UIDSearchMailBox, sorted out some bugs (details
  187. shown in comments in those functions which start with "CC:").
  188. 2003-Apr-15 CC2:Sorted out some more bugs (details shown in comments in those
  189. functions which start with "CC2:"). Set FMailBoxSeparator
  190. in ParseListResult and ParseLSubResult.
  191. Some IMAP servers generally return "OK completed" even if they
  192. returned no data, such as passing a non-existent message
  193. number to them: they possibly should return NO or BAD; the
  194. functions here have been changed to return FALSE unless they
  195. get good data back, even if the server answers OK. Similar
  196. change made for other functions.
  197. There are a few exceptions, e.g. ListMailBoxes may only return
  198. "OK completed" if the user has no mailboxes, these are noted.
  199. Also, RetrieveStructure(), UIDRetrieveStructure, RetrievePart,
  200. UIDRetrievePart, RetrievePartPeek and UIDRetrievePartPeek
  201. added to allow user to find the structure of a message and
  202. just retrieve the part or parts he needs.
  203. 2003-Apr-30 CC3:Added functionality to retrieve the text of a message (only)
  204. via RetrieveText / UIDRetrieveText / RetrieveTextPeek /
  205. UIDRetrieveTextPeek.
  206. Return codes now generally reflect if the function succeeded
  207. instead of returning True even though function fails.
  208. 2003-May-15 CC4:Added functionality to retrieve individual parts of a message
  209. to a file, including the decoding of those parts.
  210. 2003-May-29 CC5:Response of some servers to UID version of commands varies,
  211. code changed to deal with those (UID position varies).
  212. Some servers return NO such as when you request an envelope
  213. for a message number that does not exist: functions return
  214. False instead of throwing an exception, as was done for other
  215. servers. The general logic is that if a valid result is
  216. returned from the IMAP server, return True; if there is no
  217. result (but the command is validly structured), return FALSE;
  218. if the command is badly structured or if it gives a response
  219. that this code does not expect, throw an exception (typically
  220. when we get a BAD response instead of OK or NO).
  221. Added IsNumberValid, IsUIDValid to prevent rubbishy parameters
  222. being passed through to IMAP functions.
  223. Sender field now filled in correctly in ParseEnvelope
  224. functions.
  225. All fields in ParseEnvelopeAddress are cleared out first,
  226. avoids an unwitting error where some entries, such as CC list,
  227. will append entries to existing entries.
  228. Full test script now used that tests every TIdIMAP command,
  229. more bugs eradicated.
  230. First version to pass testing against both CommuniGate and
  231. Cyrus IMAP servers.
  232. Not tested against Microsoft Exchange, don't have an Exchange
  233. account to test it against.
  234. 2003-Jun-10 CC6:Added (UID)RetrieveEnvelopeRaw, in case the user wants to do
  235. their own envelope parsing.
  236. Code in RetrievePart altered to make it more consistent.
  237. Altered to incorporate Indy 10's use of IdReplyIMAP4 (not
  238. complete at this stage).
  239. ReceiveBody added to IdIMAP4, due to the response of some
  240. servers, which gets (UID)Receive(Peek) functions to work on
  241. more servers.
  242. 2003-Jun-20 CC7:ReceiveBody altered to work with Indy 10. Made changes due to
  243. LoginSASL moving from TIdMessageSASLClient to TIdSASLList.
  244. Public variable FGreetingBanner added to help user identify
  245. the IMAP server he is connected to (may help him decide the
  246. best strategy). Made AppendMsg work a bit better (now uses
  247. platform-independent EOL and supports ExtraHeaders field).
  248. Added 2nd version of AppendMsg. Added "if Connected then "
  249. to Destroy. Attachment filenames now decoded if necessary.
  250. Added support for multisection parts.
  251. 2003-Jul-16 CC8:Added RemoveAnyAdditionalResponses. Resolved issue of some
  252. servers leaving out the trailing "NIL NIL NIL" at the end of
  253. some body structures. (UID)Retrieve(Peek) functions
  254. integrated via InternalRetrieve, new method of implementing
  255. these functions (all variations of Retrieve) added for Indy
  256. 10 based on getting message by the byte-count and then feeding
  257. it into the standard message parser.
  258. UIDRetrieveAllHeaders removed: it was never implemented anyway
  259. but it makes no sense to retrieve a non-contiguous list which
  260. would have gaps due to missing UIDs.
  261. In the Indy 10 version, AppendMsg functions were altered to
  262. support the sending of attachments (attachments had never
  263. been supported in AppendMsg prior to this).
  264. Added CopyMsg and UIDCopyMsgs to complete the command set.
  265. 2003-Jul-30 CC9:Removed wDoublePoint so that the code is compliant with
  266. the guidelines. Allowed for servers that don't implement
  267. search commands in Indy 9 (OK in 10). InternalRetrieve
  268. altered to (hopefully) deal with optional "FLAGS (\Seen)"
  269. in response.
  270. 2003-Aug-22 CCA:Yet another IMAP oddity - a server returns NIL for the
  271. mailbox separator, ParseListResult modified. Added "Length
  272. (LLine) > 0)" test to stop GPF on empty line in ReceiveBody.
  273. 2003-Sep-26 CCB:Changed SendCmd altered to try to remove anything that may
  274. be unprocessed from a previous (probably failed) command.
  275. This uses the property FMilliSecsToWaitToClearBuffer, which
  276. defaults to 10ms.
  277. Added EIdDisconnectedProbablyIdledOut, trapped in
  278. GetInternalResponse.
  279. Unsolicited responses now filtered out (they are now transferred
  280. from FLastCmdResult.Text to a new field, FLastCmdResult.Extra,
  281. leaving just the responses we want to our command in
  282. FLastCmdResult.Text).
  283. 2003-Oct-21 CCC:Original GetLineResponse merged with GetResponse to reduce
  284. complexity and to add filtering unsolicited responses when
  285. we are looking for single-line responses (which GetLineResponse
  286. did), removed/coded-out much of these functions to make the
  287. code much simpler.
  288. Removed RemoveAnyAdditionalResponses, no longer needed.
  289. Parsing of body structure reworked to support ParentPart concept
  290. allowing parsing of indefinitely-nested MIME parts. Note that
  291. a`MIME "alternative" message with a plain-text and a html part
  292. will have part[0] marked "alternative" with size 0 and ImapPartNumber
  293. of 1, a part[1] of type text/plain with a ParentPart of 0 and an
  294. ImapPartNumber of 1.1, and finally a part[2] of type text/html
  295. again with a ParentPart of 0 and an ImapPartNumber of 1.2.
  296. Imap part number changed from an integer to string, allowing
  297. retrieval of IMAP sub-parts, e.g. part '3.2' is the 2nd subpart
  298. of part 3.
  299. 2003-Nov-20 CCD:Added UIDRetrievePartHeader & RetrievePartHeader. Started to
  300. use an abstracted parsing method for the command response in
  301. UIDRetrieveFlags. Added function FindHowServerCreatesFolders.
  302. 2003-Dec-04 CCE:Copied DotNet connection changes from IdSMTP to tempoarily bypass
  303. the SASL authentications until they are ported.
  304. 2004-Jan-23 CCF:Finished .NET port, added BinHex4.0 encoding.
  305. 2004-Apr-16 CCG:Added UTF-7 decoding/encoding code kindly written and submitted by
  306. Roman Puls for encoding/decoding mailbox names. IMAP does not use
  307. standard UTF-7 code (what's new?!) so these routines are localised
  308. to this unit.
  309. }
  310. unit IdIMAP4;
  311. {
  312. IMAP 4 (Internet Message Access Protocol - Version 4 Rev 1)
  313. By Idan Cohen [email protected]
  314. }
  315. interface
  316. { Todo -oIC :
  317. Change the mailbox list commands so that they receive TMailBoxTree
  318. structures and so they can store in them the mailbox name and it's attributes. }
  319. { Todo -oIC :
  320. Add support for \* special flag in messages, and check for \Recent
  321. flag in STORE command because it cant be stored (will get no reply!!!) }
  322. { Todo -oIC :
  323. 5.1.2. Mailbox Namespace Naming Convention
  324. By convention, the first hierarchical element of any mailbox name
  325. which begins with "#" identifies the "namespace" of the remainder of
  326. the name. This makes it possible to disambiguate between different
  327. types of mailbox stores, each of which have their own namespaces.
  328. For example, implementations which offer access to USENET
  329. newsgroups MAY use the "#news" namespace to partition the USENET
  330. newsgroup namespace from that of other mailboxes. Thus, the
  331. comp.mail.misc newsgroup would have an mailbox name of
  332. "#news.comp.mail.misc", and the name "comp.mail.misc" could refer
  333. to a different object (e.g. a user's private mailbox). }
  334. { TO BE CONSIDERED -CC :
  335. Double-quotes in mailbox names can cause major but subtle failures. Maybe
  336. add the automatic stripping of double-quotes if passed in mailbox names,
  337. to avoid ending up with ""INBOX""
  338. }
  339. {CC3: WARNING - if the following gives a "File not found" error on compilation,
  340. you need to add the path "C:\Program Files\Borland\Delphi7\Source\Indy" in
  341. Project -> Options -> Directories/Conditionals -> Search Path}
  342. {$I IdCompilerDefines.inc}
  343. uses
  344. Classes,
  345. {$IFNDEF VCL_6_OR_ABOVE}IdCTypes,{$ENDIF}
  346. IdMessage,
  347. IdAssignedNumbers,
  348. IdMailBox,
  349. IdException,
  350. IdGlobal,
  351. IdMessageParts,
  352. IdMessageClient,
  353. IdReply,
  354. IdComponent,
  355. IdMessageCoder,
  356. IdHeaderList,
  357. IdCoderHeader,
  358. IdCoderMIME,
  359. IdCoderQuotedPrintable,
  360. IdCoderBinHex4,
  361. IdSASLCollection,
  362. IdMessageCollection,
  363. IdBaseComponent;
  364. { MUTF7 }
  365. type
  366. EmUTF7Error = class(EIdSilentException);
  367. EmUTF7Encode = class(EmUTF7Error);
  368. EmUTF7Decode = class(EmUTF7Error);
  369. type
  370. // TODO: make an IIdTextEncoding implementation for Modified UTF-7
  371. TIdMUTF7 = class(TObject)
  372. public
  373. function Encode(const aString : TIdUnicodeString): String;
  374. function Decode(const aString : String): TIdUnicodeString;
  375. function Valid(const aMUTF7String : String): Boolean;
  376. function Append(const aMUTF7String: String; const aStr: TIdUnicodeString): String;
  377. end;
  378. { TIdIMAP4 }
  379. const
  380. wsOk = 1;
  381. wsNo = 2;
  382. wsBad = 3;
  383. wsPreAuth = 4;
  384. wsBye = 5;
  385. wsContinue = 6;
  386. type
  387. TIdIMAP4FolderTreatment = ( //Result codes from FindHowServerCreatesFolders
  388. ftAllowsTopLevelCreation, //Folders can be created at the same level as Inbox (the top level)
  389. ftFoldersMustBeUnderInbox, //Folders must be created under INBOX, such as INBOX.Sent
  390. ftDoesNotAllowFolderCreation, //Wont allow you create folders at top level or under Inbox (may be read-only connection)
  391. ftCannotTestBecauseHasNoInbox, //Wont allow top-level creation but cannot test creation under Inbox because it does not exist
  392. ftCannotRetrieveAnyFolders //No folders present for that user, cannot be determined
  393. );
  394. type
  395. TIdIMAP4AuthenticationType = (
  396. iatUserPass,
  397. iatSASL
  398. );
  399. const
  400. DEF_IMAP4_AUTH = iatUserPass;
  401. IDF_DEFAULT_MS_TO_WAIT_TO_CLEAR_BUFFER = 10;
  402. {CC3: TIdImapMessagePart and TIdImapMessageParts added for retrieving
  403. individual parts of a message via IMAP, because IMAP uses some additional
  404. terms.
  405. Note that (rarely) an IMAP can have two sub-"parts" in the one part -
  406. they are sent in the one part by the server, typically a plain-text and
  407. html version with a boundary at the start, in between, and at the end.
  408. TIdIMAP fills in the boundary in that case, and the FSubpart holds the
  409. info on the second part. I call these multisection parts.}
  410. type
  411. TIdImapMessagePart = class(TCollectionItem)
  412. protected
  413. FBodyType: string;
  414. FBodySubType: string;
  415. FFileName: string;
  416. FDescription: string;
  417. FEncoding: TIdMessageEncoding;
  418. FCharSet: string;
  419. FContentTransferEncoding: string;
  420. FSize: Int64;
  421. FUnparsedEntry: string; {Text returned from server: useful for debugging or workarounds}
  422. FBoundary: string; {Only used for multisection parts}
  423. FParentPart: Integer;
  424. FImapPartNumber: string;
  425. public
  426. constructor Create(Collection: TCollection); override;
  427. property BodyType : String read FBodyType write FBodyType;
  428. property BodySubType : String read FBodySubType write FBodySubType;
  429. property FileName : String read FFileName write FFileName;
  430. property Description : String read FDescription write FDescription;
  431. property Encoding: TIdMessageEncoding read FEncoding write FEncoding;
  432. property CharSet: string read FCharSet write FCharSet;
  433. property ContentTransferEncoding : String read FContentTransferEncoding write FContentTransferEncoding;
  434. property Size : Int64 read FSize write FSize;
  435. property UnparsedEntry : string read FUnparsedEntry write FUnparsedEntry;
  436. property Boundary : string read FBoundary write FBoundary;
  437. property ParentPart: integer read FParentPart write FParentPart;
  438. property ImapPartNumber: string read FImapPartNumber write FImapPartNumber;
  439. end;
  440. {CC3: Added for validating message number}
  441. EIdNumberInvalid = class(EIdException);
  442. {CCB: Added for server disconnecting you if idle too long...}
  443. EIdDisconnectedProbablyIdledOut = class(EIdException);
  444. TIdImapMessageParts = class(TOwnedCollection)
  445. protected
  446. function GetItem(Index: Integer): TIdImapMessagePart;
  447. procedure SetItem(Index: Integer; const Value: TIdImapMessagePart);
  448. public
  449. constructor Create(AOwner: TPersistent); reintroduce;
  450. function Add: TIdImapMessagePart; reintroduce;
  451. property Items[Index: Integer]: TIdImapMessagePart read GetItem write SetItem; default;
  452. end;
  453. {CCD: Added to parse out responses, because the order in which the responses appear
  454. varies between servers. A typical line that gets parsed into this is:
  455. * 9 FETCH (UID 1234 FLAGS (\Seen \Deleted))
  456. }
  457. TIdIMAPLineStruct = class(TObject)
  458. protected
  459. HasStar: Boolean; //Line starts with a '*'
  460. MessageNumber: string; //Line has a message number (after the *)
  461. Command: string; //IMAP servers send back the command they are responding to, e.g. FETCH
  462. UID: string; //Sometimes the UID is echoed back
  463. Flags: TIdMessageFlagsSet; //Sometimes the FLAGS are echoed back
  464. FlagsStr: string; //unparsed FLAGS for the message
  465. Complete: Boolean; //If false, line has no closing bracket (response continues on following line(s))
  466. ByteCount: integer; //The value in a trailing byte count like {123}, -1 means not present
  467. IMAPFunction: string; //E.g. FLAGS
  468. IMAPValue: string; //E.g. '(\Seen \Deleted)'
  469. GmailMsgID: string; //Gmail-specific unique identifier for the message
  470. GmailThreadID: string; //Gmail-specific thread identifier for the message
  471. GmailLabels: string; //Gmail-specific labels for the message
  472. end;
  473. TIdIMAP4Commands = (
  474. cmdCAPABILITY,
  475. cmdNOOP,
  476. cmdLOGOUT,
  477. cmdAUTHENTICATE,
  478. cmdLOGIN,
  479. cmdSELECT,
  480. cmdEXAMINE,
  481. cmdCREATE,
  482. cmdDELETE,
  483. cmdRENAME,
  484. cmdSUBSCRIBE,
  485. cmdUNSUBSCRIBE,
  486. cmdLIST,
  487. cmdLSUB,
  488. cmdSTATUS,
  489. cmdAPPEND,
  490. cmdCHECK,
  491. cmdCLOSE,
  492. cmdEXPUNGE,
  493. cmdSEARCH,
  494. cmdFETCH,
  495. cmdSTORE,
  496. cmdCOPY,
  497. cmdUID,
  498. cmdXCmd
  499. );
  500. {CC3: Add csUnexpectedlyDisconnected for when we receive "Connection reset by peer"}
  501. TIdIMAP4ConnectionState = (
  502. csAny,
  503. csNonAuthenticated,
  504. csAuthenticated,
  505. csSelected,
  506. csUnexpectedlyDisconnected
  507. );
  508. {****************************************************************************
  509. Universal commands CAPABILITY, NOOP, and LOGOUT
  510. Authenticated state commands SELECT, EXAMINE, CREATE, DELETE, RENAME,
  511. SUBSCRIBE, UNSUBSCRIBE, LIST, LSUB, STATUS, and APPEND
  512. Selected state commands CHECK, CLOSE, EXPUNGE, SEARCH, FETCH, STORE, COPY, and UID
  513. *****************************************************************************}
  514. TIdIMAP4SearchKey = (
  515. skAll, //All messages in the mailbox; the default initial key for ANDing.
  516. skAnswered, //Messages with the \Answered flag set.
  517. skBcc, //Messages that contain the specified string in the envelope structure's BCC field.
  518. skBefore, //Messages whose internal date is earlier than the specified date.
  519. skBody, //Messages that contain the specified string in the body of the message.
  520. skCc, //Messages that contain the specified string in the envelope structure's CC field.
  521. skDeleted, //Messages with the \Deleted flag set.
  522. skDraft, //Messages with the \Draft flag set.
  523. skFlagged, //Messages with the \Flagged flag set.
  524. skFrom, //Messages that contain the specified string in the envelope structure's FROM field.
  525. skHeader, //Messages that have a header with the specified field-name (as defined in [RFC-822])
  526. //and that contains the specified string in the [RFC-822] field-body.
  527. skKeyword, //Messages with the specified keyword set.
  528. skLarger, //Messages with an [RFC-822] size larger than the specified number of octets.
  529. skNew, //Messages that have the \Recent flag set but not the \Seen flag.
  530. //This is functionally equivalent to "(RECENT UNSEEN)".
  531. skNot, //Messages that do not match the specified search key.
  532. skOld, //Messages that do not have the \Recent flag set. This is functionally
  533. //equivalent to "NOT RECENT" (as opposed to "NOT NEW").
  534. skOn, //Messages whose internal date is within the specified date.
  535. skOr, //Messages that match either search key.
  536. skRecent, //Messages that have the \Recent flag set.
  537. skSeen, //Messages that have the \Seen flag set.
  538. skSentBefore,//Messages whose [RFC-822] Date: header is earlier than the specified date.
  539. skSentOn, //Messages whose [RFC-822] Date: header is within the specified date.
  540. skSentSince, //Messages whose [RFC-822] Date: header is within or later than the specified date.
  541. skSince, //Messages whose internal date is within or later than the specified date.
  542. skSmaller, //Messages with an [RFC-822] size smaller than the specified number of octets.
  543. skSubject, //Messages that contain the specified string in the envelope structure's SUBJECT field.
  544. skText, //Messages that contain the specified string in the header or body of the message.
  545. skTo, //Messages that contain the specified string in the envelope structure's TO field.
  546. skUID, //Messages with unique identifiers corresponding to the specified unique identifier set.
  547. skUnanswered,//Messages that do not have the \Answered flag set.
  548. skUndeleted, //Messages that do not have the \Deleted flag set.
  549. skUndraft, //Messages that do not have the \Draft flag set.
  550. skUnflagged, //Messages that do not have the \Flagged flag set.
  551. skUnKeyWord, //Messages that do not have the specified keyword set.
  552. skUnseen,
  553. skGmailRaw, //Gmail-specific extension to access full Gmail search syntax
  554. skGmailMsgID, //Gmail-specific unique message identifier
  555. skGmailThreadID, //Gmail-specific thread identifier
  556. skGmailLabels //Gmail-specific labels
  557. );
  558. TIdIMAP4SearchKeyArray = array of TIdIMAP4SearchKey;
  559. TIdIMAP4SearchRec = record
  560. Date: TDateTime;
  561. Size: Int64;
  562. Text: String;
  563. SearchKey : TIdIMAP4SearchKey;
  564. FieldName: String;
  565. end;
  566. TIdIMAP4SearchRecArray = array of TIdIMAP4SearchRec;
  567. TIdIMAP4StatusDataItem = (
  568. mdMessages,
  569. mdRecent,
  570. mdUIDNext,
  571. mdUIDValidity,
  572. mdUnseen
  573. );
  574. TIdIMAP4StoreDataItem = (
  575. sdReplace,
  576. sdReplaceSilent,
  577. sdAdd,
  578. sdAddSilent,
  579. sdRemove,
  580. sdRemoveSilent
  581. );
  582. TIdRetrieveOnSelect = (
  583. rsDisabled,
  584. rsHeaders,
  585. rsMessages
  586. );
  587. TIdAlertEvent = procedure(ASender: TObject; const AAlertMsg: String) of object;
  588. TIdIMAP4 = class(TIdMessageClient)
  589. protected
  590. FCmdCounter : Integer;
  591. FConnectionState : TIdIMAP4ConnectionState;
  592. FMailBox : TIdMailBox;
  593. FMailBoxSeparator: Char;
  594. FOnAlert: TIdAlertEvent;
  595. FRetrieveOnSelect: TIdRetrieveOnSelect;
  596. FMilliSecsToWaitToClearBuffer: integer;
  597. FMUTF7: TIdMUTF7;
  598. FOnWorkForPart: TWorkEvent;
  599. FOnWorkBeginForPart: TWorkBeginEvent;
  600. FOnWorkEndForPart: TWorkEndEvent;
  601. FGreetingBanner : String; {CC7: Added because it may help identify the server}
  602. FHasCapa : Boolean;
  603. FSASLMechanisms : TIdSASLEntries;
  604. FAuthType : TIdIMAP4AuthenticationType;
  605. FLineStruct: TIdIMAPLineStruct;
  606. function GetReplyClass:TIdReplyClass; override;
  607. function GetSupportsTLS: Boolean; override;
  608. function CheckConnectionState(AAllowedState: TIdIMAP4ConnectionState): TIdIMAP4ConnectionState; overload;
  609. function CheckConnectionState(const AAllowedStates: array of TIdIMAP4ConnectionState): TIdIMAP4ConnectionState; overload;
  610. function CheckReplyForCapabilities: Boolean;
  611. procedure BeginWorkForPart(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
  612. procedure DoWorkForPart(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
  613. procedure EndWorkForPart(ASender: TObject; AWorkMode: TWorkMode);
  614. //The following call FMUTF7 but do exception-handling on invalid strings...
  615. function DoMUTFEncode(const aString : String): String;
  616. function DoMUTFDecode(const aString : String): String;
  617. function GetCmdCounter: String;
  618. function GetConnectionStateName: String;
  619. function GetNewCmdCounter: String;
  620. property LastCmdCounter: String read GetCmdCounter;
  621. property NewCmdCounter: String read GetNewCmdCounter;
  622. { General Functions }
  623. function ArrayToNumberStr (const AMsgNumList: array of UInt32): String;
  624. function MessageFlagSetToStr (const AFlags: TIdMessageFlagsSet): String;
  625. procedure StripCRLFs(var AText: string); overload; virtual; //Allow users to optimise
  626. procedure StripCRLFs(ASourceStream, ADestStream: TStream); overload;
  627. { Parser Functions }
  628. procedure ParseImapPart(ABodyStructure: string;
  629. AImapParts: TIdImapMessageParts; AThisImapPart: TIdImapMessagePart;
  630. AParentImapPart: TIdImapMessagePart; APartNumber: integer);
  631. procedure ParseMessagePart(ABodyStructure: string; AMessageParts: TIdMessageParts;
  632. AThisMessagePart: TIdMessagePart; AParentMessagePart: TIdMessagePart;
  633. APartNumber: integer);
  634. procedure ParseBodyStructureResult(ABodyStructure: string; ATheParts: TIdMessageParts; AImapParts: TIdImapMessageParts);
  635. procedure ParseBodyStructurePart(APartString: string; AThePart: TIdMessagePart; AImapPart: TIdImapMessagePart);
  636. procedure ParseTheLine(ALine: string; APartsList: TStrings);
  637. procedure ParseIntoParts(APartString: string; AParams: TStrings);
  638. procedure ParseIntoBrackettedQuotedAndUnquotedParts(APartString: string; AParams: TStrings; AKeepBrackets: Boolean);
  639. procedure BreakApartParamsInQuotes(const AParam: string; AParsedList: TStrings);
  640. function GetNextWord(AParam: string): string;
  641. function GetNextQuotedParam(AParam: string; ARemoveQuotes: Boolean): string;
  642. procedure ParseExpungeResult (AMB: TIdMailBox; ACmdResultDetails: TStrings);
  643. procedure ParseListResult (AMBList: TStrings; ACmdResultDetails: TStrings);
  644. procedure ParseLSubResult(AMBList: TStrings; ACmdResultDetails: TStrings);
  645. procedure InternalParseListResult(ACmd: string; AMBList: TStrings; ACmdResultDetails: TStrings);
  646. procedure ParseMailBoxAttributeString(AAttributesList: String; var AAttributes: TIdMailBoxAttributesSet);
  647. procedure ParseMessageFlagString (AFlagsList: String; var AFlags: TIdMessageFlagsSet);
  648. procedure ParseSelectResult (AMB: TIdMailBox; ACmdResultDetails: TStrings);
  649. procedure ParseStatusResult (AMB: TIdMailBox; ACmdResultDetails: TStrings);
  650. procedure ParseSearchResult (AMB: TIdMailBox; ACmdResultDetails: TStrings);
  651. procedure ParseEnvelopeResult (AMsg: TIdMessage; ACmdResultStr: String);
  652. function ParseLastCmdResult(ALine: string; AExpectedCommand: string; AExpectedIMAPFunction: array of string): Boolean;
  653. procedure ParseLastCmdResultButAppendInfo(ALine: string);
  654. function InternalRetrieve(const AMsgNum: UInt32; AUseUID: Boolean; AUsePeek: Boolean; AMsg: TIdMessage): Boolean;
  655. function InternalRetrievePart(const AMsgNum: UInt32; const APartNum: string;
  656. AUseUID: Boolean; AUsePeek: Boolean;
  657. ADestStream: TStream;
  658. var ABuffer: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  659. var ABufferLength: Integer; {NOTE: var args cannot have default params}
  660. ADestFileNameAndPath: string = ''; {Do not Localize}
  661. AContentTransferEncoding: string = 'text'): Boolean; {Do not Localize}
  662. //Retrieves the specified number of headers of the selected mailbox to the specified TIdMessageCollection.
  663. function InternalRetrieveHeaders(AMsgList: TIdMessageCollection; ACount: Integer): Boolean;
  664. //Retrieves the specified number of messages of the selected mailbox to the specified TIdMessageCollection.
  665. function InternalRetrieveMsgs(AMsgList: TIdMessageCollection; ACount: Integer): Boolean;
  666. function InternalSearchMailBox(const ASearchInfo: array of TIdIMAP4SearchRec; AUseUID: Boolean; const ACharSet: string): Boolean;
  667. function ParseBodyStructureSectionAsEquates(AParam: string): string;
  668. function ParseBodyStructureSectionAsEquates2(AParam: string): string;
  669. function InternalRetrieveText(const AMsgNum: UInt32; var AText: string;
  670. AUseUID: Boolean; AUsePeek: Boolean; AUseFirstPartInsteadOfText: Boolean): Boolean;
  671. function IsCapabilityListed(ACapability: string): Boolean;
  672. function InternalRetrieveEnvelope(const AMsgNum: UInt32; AMsg: TIdMessage; ADestList: TStrings): Boolean;
  673. function UIDInternalRetrieveEnvelope(const AMsgUID: String; AMsg: TIdMessage; ADestList: TStrings): Boolean;
  674. function InternalRetrievePartHeader(const AMsgNum: UInt32; const APartNum: string; const AUseUID: Boolean;
  675. AHeaders: TIdHeaderList): Boolean;
  676. function ReceiveHeader(AMsg: TIdMessage; const AAltTerm: string = ''): string; override;
  677. {CC3: Need to validate message numbers (relative and UIDs) and part numbers, because otherwise
  678. the routines wait for a response that never arrives and so functions never return.
  679. Also used for validating part numbers.}
  680. function IsNumberValid(const ANumber: UInt32): Boolean;
  681. function IsUIDValid(const AUID: string): Boolean;
  682. function IsImapPartNumberValid(const APartNum: Integer): Boolean; overload;
  683. function IsImapPartNumberValid(const APartNum: string): Boolean; overload;
  684. function IsItDigitsAndOptionallyPeriod(const AStr: string; AAllowPeriod: Boolean): Boolean;
  685. {CC6: Override IdMessageClient's ReceiveBody due to the responses from some servers...}
  686. procedure ReceiveBody(AMsg: TIdMessage; const ADelim: string = '.'); override; {Do not Localize}
  687. procedure InitComponent; override;
  688. procedure SetMailBox(const Value: TIdMailBox);
  689. procedure SetSASLMechanisms(AValue: TIdSASLEntries);
  690. public
  691. { TIdIMAP4 Commands }
  692. {$IFDEF WORKAROUND_INLINE_CONSTRUCTORS}
  693. constructor Create(AOwner: TComponent); reintroduce; overload;
  694. {$ENDIF}
  695. destructor Destroy; override;
  696. //Requests a listing of capabilities that the server supports...
  697. function Capability: Boolean; overload;
  698. function Capability(ASlCapability: TStrings): Boolean; overload;
  699. function FindHowServerCreatesFolders: TIdIMAP4FolderTreatment;
  700. procedure DoAlert(const AMsg: String);
  701. property ConnectionState: TIdIMAP4ConnectionState read FConnectionState;
  702. property MailBox: TIdMailBox read FMailBox write SetMailBox;
  703. {CC7: Two versions of AppendMsg are provided. The first is the normal one you
  704. would use. The second allows you to specify an alternative header list which
  705. will be used in place of AMsg.Headers.
  706. An email client may need the second type if it sends an email via IdSMTP and wants
  707. to copy it to a "Sent" IMAP folder. In Indy 10,
  708. IdSMTP puts the generated headers in the LastGeneratedHeaders field, so you
  709. can use the second version of AppendMsg, passing it AMsg.LastGeneratedHeaders as
  710. the AAlternativeHeaders field. Note that IdSMTP puts both the Headers and
  711. the ExtraHeaders fields in LastGeneratedHeaders.}
  712. function AppendMsg(const AMBName: String; AMsg: TIdMessage; const AFlags: TIdMessageFlagsSet = [];
  713. const AInternalDateTimeGMT: TDateTime = 0.0): Boolean; overload;
  714. function AppendMsg(const AMBName: String; AMsg: TIdMessage; AAlternativeHeaders: TIdHeaderList;
  715. const AFlags: TIdMessageFlagsSet = []; const AInternalDateTimeGMT: TDateTime = 0.0): Boolean; overload;
  716. //The following are used for raw (unparsed) messages in a file or stream...
  717. function AppendMsgNoEncodeFromFile(const AMBName: String; ASourceFile: string; const AFlags: TIdMessageFlagsSet = [];
  718. const AInternalDateTimeGMT: TDateTime = 0.0): Boolean;
  719. function AppendMsgNoEncodeFromStream(const AMBName: String; AStream: TStream; const AFlags: TIdMessageFlagsSet = [];
  720. const AInternalDateTimeGMT: TDateTime = 0.0): Boolean;
  721. //Requests a checkpoint of the currently selected mailbox. Does NOTHING on most servers.
  722. function CheckMailBox: Boolean;
  723. //Checks if the message was read or not.
  724. function CheckMsgSeen(const AMsgNum: UInt32): Boolean;
  725. //Method for logging in manually if you didn't login at connect
  726. procedure Login; virtual;
  727. //Connects and logins to the IMAP4 account.
  728. function Connect(const AAutoLogin: boolean = true): Boolean; reintroduce; virtual;
  729. //Closes the current selected mailbox in the account.
  730. function CloseMailBox: Boolean;
  731. //Creates a new mailbox with the specified name in the account.
  732. function CreateMailBox(const AMBName: String): Boolean;
  733. //Deletes the specified mailbox from the account.
  734. function DeleteMailBox(const AMBName: String): Boolean;
  735. //Marks messages for deletion, it will be deleted when the mailbox is purged.
  736. function DeleteMsgs(const AMsgNumList: array of UInt32): Boolean;
  737. //Logouts and disconnects from the IMAP account.
  738. procedure Disconnect(ANotifyPeer: Boolean); override;
  739. procedure DisconnectNotifyPeer; override;
  740. //Examines the specified mailbox and inserts the results to the TIdMailBox provided.
  741. function ExamineMailBox(const AMBName: String; AMB: TIdMailBox): Boolean;
  742. //Expunges (deletes the marked files) the current selected mailbox in the account.
  743. function ExpungeMailBox: Boolean;
  744. //Sends a NOOP (No Operation) to keep the account connection with the server alive.
  745. procedure KeepAlive;
  746. //Returns a list of all the child mailboxes (one level down) to the mailbox supplied.
  747. //This should be used when you fear that there are too many mailboxes and the listing of
  748. //all of them could be time consuming, so this should be used to retrieve specific mailboxes.
  749. function ListInferiorMailBoxes(AMailBoxList, AInferiorMailBoxList: TStrings): Boolean;
  750. //Returns a list of all the mailboxes in the user account.
  751. function ListMailBoxes(AMailBoxList: TStrings): Boolean;
  752. //Returns a list of all the subscribed mailboxes in the user account.
  753. function ListSubscribedMailBoxes (AMailBoxList: TStrings): Boolean;
  754. //Renames the specified mailbox in the account.
  755. function RenameMailBox(const AOldMBName, ANewMBName: String): Boolean;
  756. //Searches the current selected mailbox for messages matching the SearchRec and
  757. //returns the results to the mailbox SearchResults array.
  758. function SearchMailBox(const ASearchInfo: array of TIdIMAP4SearchRec; const ACharSet: string = ''): Boolean;
  759. //Selects the current a mailbox in the account.
  760. function SelectMailBox(const AMBName: String): Boolean;
  761. //Retrieves the status of the indicated mailbox.
  762. {CC2: It is pointless calling StatusMailBox with AStatusDataItems set to []
  763. because you are asking the IMAP server to update none of the status flags.
  764. Instead, if called with no AStatusDataItems specified, we use the standard flags
  765. returned by SelectMailBox, which allows the user to easily check if the mailbox
  766. has changed.}
  767. function StatusMailBox(const AMBName: String; AMB: TIdMailBox): Boolean; overload;
  768. function StatusMailBox(const AMBName: String; AMB: TIdMailBox;
  769. const AStatusDataItems: array of TIdIMAP4StatusDataItem): Boolean; overload;
  770. //Changes (adds or removes) message flags.
  771. function StoreFlags(const AMsgNumList: array of UInt32; const AStoreMethod: TIdIMAP4StoreDataItem;
  772. const AFlags: TIdMessageFlagsSet): Boolean;
  773. //Changes (adds or removes) a message value.
  774. function StoreValue(const AMsgNumList: array of UInt32; const AStoreMethod: TIdIMAP4StoreDataItem;
  775. const AField, AValue: String): Boolean;
  776. //Adds the specified mailbox name to the server's set of "active" or "subscribed"
  777. //mailboxes as returned by the LSUB command.
  778. function SubscribeMailBox(const AMBName: String): Boolean;
  779. {CC8: Added CopyMsg, should have always been there...}
  780. function CopyMsg(const AMsgNum: UInt32; const AMBName: String): Boolean;
  781. //Copies a message from the current selected mailbox to the specified mailbox. {Do not Localize}
  782. function CopyMsgs(const AMsgNumList: array of UInt32; const AMBName: String): Boolean;
  783. //Retrieves a whole message while marking it read.
  784. function Retrieve(const AMsgNum: UInt32; AMsg: TIdMessage): Boolean;
  785. //Retrieves a whole message "raw" and saves it to file, while marking it read.
  786. function RetrieveNoDecodeToFile(const AMsgNum: UInt32; ADestFile: string): Boolean;
  787. function RetrieveNoDecodeToFilePeek(const AMsgNum: UInt32; ADestFile: string): Boolean;
  788. function RetrieveNoDecodeToStream(const AMsgNum: UInt32; AStream: TStream): Boolean;
  789. function RetrieveNoDecodeToStreamPeek(const AMsgNum: UInt32; AStream: TStream): Boolean;
  790. //Retrieves all envelope of the selected mailbox to the specified TIdMessageCollection.
  791. function RetrieveAllEnvelopes(AMsgList: TIdMessageCollection): Boolean;
  792. //Retrieves all headers of the selected mailbox to the specified TIdMessageCollection.
  793. function RetrieveAllHeaders(AMsgList: TIdMessageCollection): Boolean;
  794. //Retrieves the first NN headers of the selected mailbox to the specified TIdMessageCollection.
  795. function RetrieveFirstHeaders(AMsgList: TIdMessageCollection; ACount: Integer): Boolean;
  796. //Retrieves all messages of the selected mailbox to the specified TIdMessageCollection.
  797. function RetrieveAllMsgs(AMsgList: TIdMessageCollection): Boolean;
  798. //Retrieves the first NN messages of the selected mailbox to the specified TIdMessageCollection.
  799. function RetrieveFirstMsgs(AMsgList: TIdMessageCollection; ACount: Integer): Boolean;
  800. //Retrieves the message envelope, parses it, and discards the envelope.
  801. function RetrieveEnvelope(const AMsgNum: UInt32; AMsg: TIdMessage): Boolean;
  802. //Retrieves the message envelope into a TStringList but does NOT parse it.
  803. function RetrieveEnvelopeRaw(const AMsgNum: UInt32; ADestList: TStrings): Boolean;
  804. //Returnes the message flag values.
  805. function RetrieveFlags(const AMsgNum: UInt32; var AFlags: TIdMessageFlagsSet): Boolean;
  806. //Returnes a requested message value.
  807. function RetrieveValue(const AMsgNum: UInt32; const AField: string; var AValue: string): Boolean;
  808. {CC2: Following added for retrieving individual parts of a message...}
  809. function InternalRetrieveStructure(const AMsgNum: UInt32; AMsg: TIdMessage; AParts: TIdImapMessageParts): Boolean;
  810. //Retrieve only the message structure (this tells you what parts are in the message).
  811. function RetrieveStructure(const AMsgNum: UInt32; AMsg: TIdMessage): Boolean; overload;
  812. function RetrieveStructure(const AMsgNum: UInt32; AParts: TIdImapMessageParts): Boolean; overload;
  813. {CC2: Following added for retrieving individual parts of a message...}
  814. {Retrieve a specific individual part of a message to a stream (part/sub-part like '2' or '2.3')...}
  815. function RetrievePart(const AMsgNum: UInt32; const APartNum: string;
  816. ADestStream: TStream; AContentTransferEncoding: string = 'text'): Boolean; overload; {Do not Localize}
  817. {Retrieve a specific individual part of a message where part is an integer or sub-part like '2.3'...}
  818. function RetrievePart(const AMsgNum: UInt32; const APartNum: string;
  819. var ABuffer: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  820. var ABufferLength: Integer; AContentTransferEncoding: string = 'text'): Boolean; overload; {Do not Localize}
  821. {Retrieve a specific individual part of a message where part is an integer (for backward compatibility)...}
  822. function RetrievePart(const AMsgNum: UInt32; const APartNum: Integer;
  823. var ABuffer: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  824. var ABufferLength: Integer; AContentTransferEncoding: string = 'text'): Boolean; overload; {Do not Localize}
  825. {Retrieve a specific individual part of a message to a stream (part/sub-part like '2' or '2.3')
  826. without marking the message as "read"...}
  827. function RetrievePartPeek(const AMsgNum: UInt32; const APartNum: string;
  828. ADestStream: TStream; AContentTransferEncoding: string = 'text'): Boolean; overload; {Do not Localize}
  829. {Retrieve a specific individual part of a message where part is an integer or sub-part like '2.3'
  830. without marking the message as "read"...}
  831. function RetrievePartPeek(const AMsgNum: UInt32; const APartNum: string;
  832. var ABuffer: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  833. var ABufferLength: Integer; AContentTransferEncoding: string = 'text'): Boolean; overload; {Do not Localize}
  834. {Retrieve a specific individual part of a message where part is an integer (for backward compatibility)
  835. without marking the message as "read"...}
  836. function RetrievePartPeek(const AMsgNum: UInt32; const APartNum: Integer;
  837. var ABuffer: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  838. var ABufferLength: Integer; AContentTransferEncoding: string = 'text'): Boolean; overload; {Do not Localize}
  839. {CC2: Following added for retrieving individual parts of a message...}
  840. {Retrieve a specific individual part of a message where part is an integer (for backward compatibility)...}
  841. function RetrievePartToFile(const AMsgNum: UInt32; const APartNum: Integer;
  842. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean; overload;
  843. {Retrieve a specific individual part of a message where part is an integer or sub-part like '2.3'...}
  844. function RetrievePartToFile(const AMsgNum: UInt32; const APartNum: string;
  845. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean; overload;
  846. {CC2: Following added for retrieving individual parts of a message...}
  847. {Retrieve a specific individual part of a message where part is an integer (for backward compatibility)
  848. without marking the message as "read"...}
  849. function RetrievePartToFilePeek(const AMsgNum: UInt32; const APartNum: Integer;
  850. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean; overload;
  851. {Retrieve a specific individual part of a message where part is an integer or sub-part like '2.3'
  852. without marking the message as "read"...}
  853. function RetrievePartToFilePeek(const AMsgNum: UInt32; const APartNum: string;
  854. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean; overload;
  855. {CC3: Following added for retrieving the text-only part of a message...}
  856. function RetrieveText(const AMsgNum: UInt32; var AText: string): Boolean;
  857. {CC4: An alternative for retrieving the text-only part of a message which
  858. may give a better response from some IMAP implementations...}
  859. function RetrieveText2(const AMsgNum: UInt32; var AText: string): Boolean;
  860. {CC3: Following added for retrieving the text-only part of a message
  861. without marking the message as "read"...}
  862. function RetrieveTextPeek(const AMsgNum: UInt32; var AText: string): Boolean;
  863. function RetrieveTextPeek2(const AMsgNum: UInt32; var AText: string): Boolean;
  864. //Retrieves only the message header.
  865. function RetrieveHeader (const AMsgNum: UInt32; AMsg: TIdMessage): Boolean;
  866. //CCD: Retrieve the header for a particular part...
  867. function RetrievePartHeader(const AMsgNum: UInt32; const APartNum: string; AHeaders: TIdHeaderList): Boolean;
  868. //Retrives the current selected mailbox size.
  869. function RetrieveMailBoxSize: Int64;
  870. //Returnes the message size.
  871. function RetrieveMsgSize(const AMsgNum: UInt32): Int64;
  872. //Retrieves a whole message while keeping its Seen flag unchanged
  873. //(preserving the previous value).
  874. function RetrievePeek(const AMsgNum: UInt32; AMsg: TIdMessage): Boolean;
  875. //Get the UID corresponding to a relative message number.
  876. function GetUID(const AMsgNum: UInt32; var AUID: string): Boolean;
  877. //Copies a message from the current selected mailbox to the specified mailbox.
  878. function UIDCopyMsg(const AMsgUID: String; const AMBName: String): Boolean;
  879. {CC8: Added UID version of CopyMsgs...}
  880. function UIDCopyMsgs(const AMsgUIDList: TStrings; const AMBName: String): Boolean;
  881. //Checks if the message was read or not.
  882. function UIDCheckMsgSeen(const AMsgUID: String): Boolean;
  883. //Marks a message for deletion, it will be deleted when the mailbox will be purged.
  884. function UIDDeleteMsg(const AMsgUID: String): Boolean;
  885. function UIDDeleteMsgs(const AMsgUIDList: array of String): Boolean;
  886. //Retrieves all envelope and UID of the selected mailbox to the specified TIdMessageCollection.
  887. function UIDRetrieveAllEnvelopes(AMsgList: TIdMessageCollection): Boolean;
  888. //Retrieves a whole message while marking it read.
  889. function UIDRetrieve(const AMsgUID: String; AMsg: TIdMessage): Boolean;
  890. //Retrieves a whole message "raw" and saves it to file, while marking it read.
  891. function UIDRetrieveNoDecodeToFile(const AMsgUID: String; ADestFile: string): Boolean;
  892. function UIDRetrieveNoDecodeToFilePeek(const AMsgUID: String; ADestFile: string): Boolean;
  893. function UIDRetrieveNoDecodeToStream(const AMsgUID: String; AStream: TStream): Boolean;
  894. function UIDRetrieveNoDecodeToStreamPeek(const AMsgUID: String; AStream: TStream): Boolean;
  895. //Retrieves the message envelope, parses it, and discards the envelope.
  896. function UIDRetrieveEnvelope(const AMsgUID: String; AMsg: TIdMessage): Boolean;
  897. //Retrieves the message envelope into a TStringList but does NOT parse it.
  898. function UIDRetrieveEnvelopeRaw(const AMsgUID: String; ADestList: TStrings): Boolean;
  899. //Returnes the message flag values.
  900. function UIDRetrieveFlags(const AMsgUID: String; var AFlags: TIdMessageFlagsSet): Boolean;
  901. //Returnes a requested message value.
  902. function UIDRetrieveValue(const AMsgUID: String; const AField: string; var AValue: string): Boolean;
  903. {CC2: Following added for retrieving individual parts of a message...}
  904. function UIDInternalRetrieveStructure(const AMsgUID: String; AMsg: TIdMessage; AParts: TIdImapMessageParts): Boolean;
  905. //Retrieve only the message structure (this tells you what parts are in the message).
  906. function UIDRetrieveStructure(const AMsgUID: String; AMsg: TIdMessage): Boolean; overload;
  907. function UIDRetrieveStructure(const AMsgUID: String; AParts: TIdImapMessageParts): Boolean; overload;
  908. {Retrieve a specific individual part of a message to a stream (part/sub-part like '2' or '2.3')...}
  909. function UIDRetrievePart(const AMsgUID: String; const APartNum: string;
  910. var ADestStream: TStream; AContentTransferEncoding: string = 'text'): Boolean; overload; {Do not Localize}
  911. {Retrieve a specific individual part of a message where part is an integer or sub-part like '2.3'...}
  912. function UIDRetrievePart(const AMsgUID: String; const APartNum: string;
  913. var ABuffer: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  914. var ABufferLength: Integer; AContentTransferEncoding: string = 'text'): Boolean; overload; {Do not Localize}
  915. {Retrieve a specific individual part of a message where part is an integer (for backward compatibility)...}
  916. function UIDRetrievePart(const AMsgUID: String; const APartNum: Integer;
  917. var ABuffer: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  918. var ABufferLength: Integer; AContentTransferEncoding: string = 'text'): Boolean; overload; {Do not Localize}
  919. {Retrieve a specific individual part of a message to a stream (part/sub-part like '2' or '2.3')
  920. without marking the message as "read"...}
  921. function UIDRetrievePartPeek(const AMsgUID: String; const APartNum: string;
  922. var ADestStream: TStream; AContentTransferEncoding: string = 'text'): Boolean; overload; {Do not Localize}
  923. {Retrieve a specific individual part of a message where part is an integer or sub-part like '2.3'...}
  924. function UIDRetrievePartPeek(const AMsgUID: String; const APartNum: string;
  925. var ABuffer: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  926. var ABufferLength: Integer; AContentTransferEncoding: string = 'text'): Boolean; overload; {Do not Localize}
  927. {Retrieve a specific individual part of a message where part is an integer (for backward compatibility)...}
  928. function UIDRetrievePartPeek(const AMsgUID: String; const APartNum: Integer;
  929. var ABuffer: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  930. var ABufferLength: Integer; AContentTransferEncoding: string = 'text'): Boolean; overload; {Do not Localize}
  931. {Retrieve a specific individual part of a message where part is an integer (for backward compatibility)...}
  932. function UIDRetrievePartToFile(const AMsgUID: String; const APartNum: Integer;
  933. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean; overload;
  934. {Retrieve a specific individual part of a message where part is an integer or sub-part like '2.3'...}
  935. function UIDRetrievePartToFile(const AMsgUID: String; const APartNum: string;
  936. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean; overload;
  937. {Retrieve a specific individual part of a message where part is an integer (for backward compatibility)...}
  938. function UIDRetrievePartToFilePeek(const AMsgUID: String; const APartNum: Integer;
  939. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean; overload;
  940. {Retrieve a specific individual part of a message where part is an integer or sub-part like '2.3'...}
  941. function UIDRetrievePartToFilePeek(const AMsgUID: String; const APartNum: string;
  942. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean; overload;
  943. {Following added for retrieving the text-only part of a message...}
  944. function UIDRetrieveText(const AMsgUID: String; var AText: string): Boolean;
  945. function UIDRetrieveText2(const AMsgUID: String; var AText: string): Boolean;
  946. {Following added for retrieving the text-only part of a message without marking the message as read...}
  947. function UIDRetrieveTextPeek(const AMsgUID: String; var AText: string): Boolean;
  948. function UIDRetrieveTextPeek2(const AMsgUID: String; var AText: string): Boolean;
  949. //Retrieves only the message header.
  950. function UIDRetrieveHeader(const AMsgUID: String; AMsg: TIdMessage): Boolean;
  951. //Retrieve the header for a particular part...
  952. function UIDRetrievePartHeader(const AMsgUID: String; const APartNum: string; AHeaders: TIdHeaderList): Boolean;
  953. //Retrives the current selected mailbox size.
  954. function UIDRetrieveMailBoxSize: Int64;
  955. //Returnes the message size.
  956. function UIDRetrieveMsgSize(const AMsgUID: String): Int64;
  957. //Retrieves a whole message while keeping its Seen flag untucked
  958. //(preserving the previous value).
  959. function UIDRetrievePeek(const AMsgUID: String; AMsg: TIdMessage): Boolean;
  960. //Searches the current selected mailbox for messages matching the SearchRec and
  961. //returnes the results as UIDs to the mailbox SearchResults array.
  962. function UIDSearchMailBox(const ASearchInfo: array of TIdIMAP4SearchRec; const ACharSet: String = ''): Boolean;
  963. //Changes (adds or removes) message flags.
  964. function UIDStoreFlags(const AMsgUID: String; const AStoreMethod: TIdIMAP4StoreDataItem;
  965. const AFlags: TIdMessageFlagsSet): Boolean; overload;
  966. function UIDStoreFlags(const AMsgUIDList: array of String; const AStoreMethod: TIdIMAP4StoreDataItem;
  967. const AFlags: TIdMessageFlagsSet): Boolean; overload;
  968. //Changes (adds or removes) a message value.
  969. function UIDStoreValue(const AMsgUID: String; const AStoreMethod: TIdIMAP4StoreDataItem;
  970. const AField, AValue: String): Boolean; overload;
  971. function UIDStoreValue(const AMsgUIDList: array of String; const AStoreMethod: TIdIMAP4StoreDataItem;
  972. const AField, AValue: string): Boolean; overload;
  973. //Removes the specified mailbox name from the server's set of "active" or "subscribed"
  974. //mailboxes as returned by the LSUB command.
  975. function UnsubscribeMailBox(const AMBName: String): Boolean;
  976. { IdTCPConnection Commands }
  977. function GetInternalResponse(const ATag: String; AExpectedResponses: array of String; ASingleLineMode: Boolean;
  978. ASingleLineMayBeSplit: Boolean = True): string; reintroduce; overload;
  979. function GetResponse: string; reintroduce; overload;
  980. function SendCmd(const AOut: string; AExpectedResponses: array of String;
  981. ASingleLineMode: Boolean = False; ASingleLineMayBeSplit: Boolean = True): string; reintroduce; overload;
  982. function SendCmd(const ATag, AOut: string; AExpectedResponses: array of String;
  983. ASingleLineMode: Boolean = False; ASingleLineMayBeSplit: Boolean = True): string; overload;
  984. function ReadLnWait: string; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IOHandler.ReadLnWait()'{$ENDIF};{$ENDIF}
  985. procedure WriteLn(const AOut: string = ''); {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use IOHandler.WriteLn()'{$ENDIF};{$ENDIF}
  986. { IdTCPConnection Commands }
  987. property IPVersion;
  988. published
  989. property OnAlert: TIdAlertEvent read FOnAlert write FOnAlert;
  990. property Password;
  991. property RetrieveOnSelect: TIdRetrieveOnSelect read FRetrieveOnSelect write FRetrieveOnSelect default rsDisabled;
  992. property Port default IdPORT_IMAP4;
  993. property Username;
  994. property MailBoxSeparator: Char read FMailBoxSeparator write FMailBoxSeparator default '/'; {Do not Localize}
  995. {GreetingBanner added because it may help identify the server...}
  996. property GreetingBanner : string read FGreetingBanner;
  997. property Host;
  998. property UseTLS;
  999. property SASLMechanisms : TIdSASLEntries read FSASLMechanisms write SetSASLMechanisms;
  1000. property AuthType : TIdIMAP4AuthenticationType read FAuthType write FAuthType default DEF_IMAP4_AUTH;
  1001. property MilliSecsToWaitToClearBuffer: integer read FMilliSecsToWaitToClearBuffer write FMilliSecsToWaitToClearBuffer;
  1002. {The following is the OnWork property for use when retrieving PARTS of a message.
  1003. It is also used for AppendMsg and Retrieve. This is in addition to the normal
  1004. OnWork property, which is exposed by TIdIMAP4, but which is only activated during
  1005. IMAP sending & receiving of commands (subject to the general OnWork caveats, i.e.
  1006. it is only called during certain methods, note OnWork[Begin][End] are all only
  1007. called in the methods AllData(), PerformCapture() and Read/WriteStream() ).
  1008. When a PART of a message is processed, use this for progress notification of
  1009. retrieval of IMAP parts, such as retrieving attachments. OnWorkBegin and
  1010. OnWorkEnd are not exposed, because they won't be activated during the processing
  1011. of a part.}
  1012. property OnWorkForPart: TWorkEvent read FOnWorkForPart write FOnWorkForPart;
  1013. property OnWorkBeginForPart: TWorkBeginEvent read FOnWorkBeginForPart write FOnWorkBeginForPart;
  1014. property OnWorkEndForPart: TWorkEndEvent read FOnWorkEndForPart write FOnWorkEndForPart;
  1015. end;
  1016. implementation
  1017. uses
  1018. //facilitate inlining on
  1019. {$IFDEF KYLIXCOMPAT}
  1020. Libc,
  1021. {$IFDEF MACOSX}
  1022. Posix.Unistd,
  1023. {$ENDIF}
  1024. {$ENDIF}
  1025. //facilitate inlining only.
  1026. {$IFDEF WINDOWS}
  1027. {$IFDEF USE_INLINE}
  1028. Windows,
  1029. {$ELSE}
  1030. //facilitate inlining only.
  1031. {$IFDEF VCL_2009_OR_ABOVE}
  1032. Windows,
  1033. {$ENDIF}
  1034. {$ENDIF}
  1035. {$ENDIF}
  1036. {$IFDEF DOTNET}
  1037. {$IFDEF USE_INLINE}
  1038. System.IO,
  1039. {$ENDIF}
  1040. {$ENDIF}
  1041. {$IFDEF DOTNET}
  1042. IdStreamNET,
  1043. {$ELSE}
  1044. IdStreamVCL,
  1045. {$ENDIF}
  1046. {$IFDEF HAS_UNIT_Generics_Collections}
  1047. System.Generics.Collections,
  1048. {$ENDIF}
  1049. IdCoder,
  1050. IdEMailAddress,
  1051. IdExplicitTLSClientServerBase,
  1052. IdGlobalProtocols,
  1053. IdExceptionCore,
  1054. IdStack,
  1055. IdStackConsts,
  1056. IdStream,
  1057. IdTCPStream,
  1058. IdText,
  1059. IdAttachment,
  1060. IdResourceStringsProtocols,
  1061. IdBuffer,
  1062. IdAttachmentMemory,
  1063. IdReplyIMAP4,
  1064. IdTCPConnection,
  1065. IdSSL,
  1066. IdSASL,
  1067. IdMessageHelper,
  1068. SysUtils;
  1069. // TODO: move this to IdCompilerDefines.inc
  1070. {$IFDEF DCC}
  1071. // class helpers were first introduced in D2005, but were buggy and not
  1072. // officially supported until D2006...
  1073. {$IFDEF VCL_2006_OR_ABOVE}
  1074. {$DEFINE HAS_CLASS_HELPER}
  1075. {$ENDIF}
  1076. {$ENDIF}
  1077. {$IFDEF FPC}
  1078. {$IFDEF FPC_2_6_0_OR_ABOVE}
  1079. {$DEFINE HAS_CLASS_HELPER}
  1080. {$ENDIF}
  1081. {$ENDIF}
  1082. type
  1083. TIdIMAP4FetchDataItem = (
  1084. fdAll, //Macro equivalent to: (FLAGS INTERNALDATE RFC822.SIZE ENVELOPE)
  1085. fdBody, //Non-extensible form of BODYSTRUCTURE.
  1086. fdBodyExtensible,
  1087. fdBodyPeek,
  1088. fdBodyStructure, //The [MIME-IMB] body structure of the message. This
  1089. //is computed by the server by parsing the [MIME-IMB]
  1090. //header fields in the [RFC-822] header and [MIME-IMB] headers.
  1091. fdEnvelope, //The envelope structure of the message. This is
  1092. //computed by the server by parsing the [RFC-822]
  1093. //header into the component parts, defaulting various
  1094. //fields as necessary.
  1095. fdFast, //Macro equivalent to: (FLAGS INTERNALDATE RFC822.SIZE)
  1096. fdFlags, //The flags that are set for this message.
  1097. fdFull, //Macro equivalent to: (FLAGS INTERNALDATE RFC822.SIZE ENVELOPE BODY)
  1098. fdInternalDate, //The internal date of the message.
  1099. fdRFC822, //Functionally equivalent to BODY[], differing in the
  1100. //syntax of the resulting untagged FETCH data (RFC822
  1101. //is returned).
  1102. fdRFC822Header, //Functionally equivalent to BODY.PEEK[HEADER],
  1103. //differing in the syntax of the resulting untagged
  1104. //FETCH data (RFC822.HEADER is returned).
  1105. fdRFC822Size, //The [RFC-822] size of the message.
  1106. fdRFC822Text, //Functionally equivalent to BODY[TEXT], differing in
  1107. //the syntax of the resulting untagged FETCH data
  1108. //(RFC822.TEXT is returned).
  1109. fdHeader, //CC: Added to get the header of a part
  1110. fdUID, //The unique identifier for the message.
  1111. fdGmailMsgID, //Gmail-specific unique identifier for the message.
  1112. fdGmailThreadID, //Gmail-specific thread identifier for the message.
  1113. fdGmailLabels //Gmail-specific labels for the message.
  1114. );
  1115. const
  1116. IMAP4Commands : array [TIdIMAP4Commands] of String = (
  1117. { Client Commands - Any State}
  1118. 'CAPABILITY', {Do not Localize}
  1119. 'NOOP', {Do not Localize}
  1120. 'LOGOUT', {Do not Localize}
  1121. { Client Commands - Non Authenticated State}
  1122. 'AUTHENTICATE', {Do not Localize}
  1123. 'LOGIN', {Do not Localize}
  1124. { Client Commands - Authenticated State}
  1125. 'SELECT', {Do not Localize}
  1126. 'EXAMINE', {Do not Localize}
  1127. 'CREATE', {Do not Localize}
  1128. 'DELETE', {Do not Localize}
  1129. 'RENAME', {Do not Localize}
  1130. 'SUBSCRIBE', {Do not Localize}
  1131. 'UNSUBSCRIBE', {Do not Localize}
  1132. 'LIST', {Do not Localize}
  1133. 'LSUB', {Do not Localize}
  1134. 'STATUS', {Do not Localize}
  1135. 'APPEND', {Do not Localize}
  1136. { Client Commands - Selected State}
  1137. 'CHECK', {Do not Localize}
  1138. 'CLOSE', {Do not Localize}
  1139. 'EXPUNGE', {Do not Localize}
  1140. 'SEARCH', {Do not Localize}
  1141. 'FETCH', {Do not Localize}
  1142. 'STORE', {Do not Localize}
  1143. 'COPY', {Do not Localize}
  1144. 'UID', {Do not Localize}
  1145. { Client Commands - Experimental/ Expansion}
  1146. 'X' {Do not Localize}
  1147. );
  1148. IMAP4FetchDataItem : array [TIdIMAP4FetchDataItem] of String = (
  1149. 'ALL', {Do not Localize} //Macro equivalent to: (FLAGS INTERNALDATE RFC822.SIZE ENVELOPE)
  1150. 'BODY', {Do not Localize} //Non-extensible form of BODYSTRUCTURE.
  1151. 'BODY[%s]<%s>', {Do not Localize}
  1152. 'BODY.PEEK[]', {Do not Localize}
  1153. 'BODYSTRUCTURE', {Do not Localize} //The [MIME-IMB] body structure of the message. This
  1154. //is computed by the server by parsing the [MIME-IMB]
  1155. //header fields in the [RFC-822] header and [MIME-IMB] headers.
  1156. 'ENVELOPE', {Do not Localize} //The envelope structure of the message. This is
  1157. //computed by the server by parsing the [RFC-822]
  1158. //header into the component parts, defaulting various
  1159. //fields as necessary.
  1160. 'FAST', {Do not Localize} //Macro equivalent to: (FLAGS INTERNALDATE RFC822.SIZE)
  1161. 'FLAGS', {Do not Localize} //The flags that are set for this message.
  1162. 'FULL', {Do not Localize} //Macro equivalent to: (FLAGS INTERNALDATE RFC822.SIZE ENVELOPE BODY)
  1163. 'INTERNALDATE', {Do not Localize} //The internal date of the message.
  1164. 'RFC822', {Do not Localize} //Functionally equivalent to BODY[], differing in the
  1165. //syntax of the resulting untagged FETCH data (RFC822
  1166. //is returned).
  1167. 'RFC822.HEADER', {Do not Localize} //Functionally equivalent to BODY.PEEK[HEADER],
  1168. //differing in the syntax of the resulting untagged
  1169. //FETCH data (RFC822.HEADER is returned).
  1170. 'RFC822.SIZE', {Do not Localize} //The [RFC-822] size of the message.
  1171. 'RFC822.TEXT', {Do not Localize} //Functionally equivalent to BODY[TEXT], differing in
  1172. //the syntax of the resulting untagged FETCH data
  1173. //(RFC822.TEXT is returned).
  1174. 'HEADER', {Do not Localize} //CC: Added to get the header of a part
  1175. 'UID', {Do not Localize} //The unique identifier for the message.
  1176. 'X-GM-MSGID', {Do not Localize} //Gmail-specific unique identifier for the message.
  1177. 'X-GM-THRID', {Do not Localize} //Gmail-specific thread identifier for the message.
  1178. 'X-GM-LABELS' {Do not Localize} //Gmail-specific labels for the message.
  1179. );
  1180. IMAP4SearchKeys : array [TIdIMAP4SearchKey] of String = (
  1181. 'ALL', {Do not Localize} //All messages in the mailbox; the default initial key for ANDing.
  1182. 'ANSWERED', {Do not Localize} //Messages with the \Answered flag set.
  1183. 'BCC', {Do not Localize} //Messages that contain the specified string in the envelope structure's BCC field.
  1184. 'BEFORE', {Do not Localize} //Messages whose internal date is earlier than the specified date.
  1185. 'BODY', {Do not Localize} //Messages that contain the specified string in the body of the message.
  1186. 'CC', {Do not Localize} //Messages that contain the specified string in the envelope structure's CC field.
  1187. 'DELETED', {Do not Localize} //Messages with the \Deleted flag set.
  1188. 'DRAFT', {Do not Localize} //Messages with the \Draft flag set.
  1189. 'FLAGGED', {Do not Localize} //Messages with the \Flagged flag set.
  1190. 'FROM', {Do not Localize} //Messages that contain the specified string in the envelope structure's FROM field.
  1191. 'HEADER', {Do not Localize} //Messages that have a header with the specified field-name (as defined in [RFC-822])
  1192. //and that contains the specified string in the [RFC-822] field-body.
  1193. 'KEYWORD', {Do not Localize} //Messages with the specified keyword set.
  1194. 'LARGER', {Do not Localize} //Messages with an [RFC-822] size larger than the specified number of octets.
  1195. 'NEW', {Do not Localize} //Messages that have the \Recent flag set but not the \Seen flag.
  1196. //This is functionally equivalent to "(RECENT UNSEEN)".
  1197. 'NOT', {Do not Localize} //Messages that do not match the specified search key.
  1198. 'OLD', {Do not Localize} //Messages that do not have the \Recent flag set. This is functionally
  1199. //equivalent to "NOT RECENT" (as opposed to "NOT NEW").
  1200. 'ON', {Do not Localize} //Messages whose internal date is within the specified date.
  1201. 'OR', {Do not Localize} //Messages that match either search key.
  1202. 'RECENT', {Do not Localize} //Messages that have the \Recent flag set.
  1203. 'SEEN', {Do not Localize} //Messages that have the \Seen flag set.
  1204. 'SENTBEFORE',{Do not Localize} //Messages whose [RFC-822] Date: header is earlier than the specified date.
  1205. 'SENTON', {Do not Localize} //Messages whose [RFC-822] Date: header is within the specified date.
  1206. 'SENTSINCE', {Do not Localize} //Messages whose [RFC-822] Date: header is within or later than the specified date.
  1207. 'SINCE', {Do not Localize} //Messages whose internal date is within or later than the specified date.
  1208. 'SMALLER', {Do not Localize} //Messages with an [RFC-822] size smaller than the specified number of octets.
  1209. 'SUBJECT', {Do not Localize} //Messages that contain the specified string in the envelope structure's SUBJECT field.
  1210. 'TEXT', {Do not Localize} //Messages that contain the specified string in the header or body of the message.
  1211. 'TO', {Do not Localize} //Messages that contain the specified string in the envelope structure's TO field.
  1212. 'UID', {Do not Localize} //Messages with unique identifiers corresponding to the specified unique identifier set.
  1213. 'UNANSWERED',{Do not Localize} //Messages that do not have the \Answered flag set.
  1214. 'UNDELETED', {Do not Localize} //Messages that do not have the \Deleted flag set.
  1215. 'UNDRAFT', {Do not Localize} //Messages that do not have the \Draft flag set.
  1216. 'UNFLAGGED', {Do not Localize} //Messages that do not have the \Flagged flag set.
  1217. 'UNKEYWORD', {Do not Localize} //Messages that do not have the specified keyword set.
  1218. 'UNSEEN', {Do not Localize}
  1219. 'X-GM-RAW', {Do not Localize} //Gmail extension to SEARCH command to allow full access to Gmail search syntax
  1220. 'X-GM-MSGID',{Do not Localize} //Gmail extension to SEARCH command to allow access to Gmail message identifier
  1221. 'X-GM-THRID',{Do not Localize} //Gmail extension to SEARCH command to allow access to Gmail thread identifier
  1222. 'X-GM-LABELS'{Do not Localize} //Gmail extension to SEARCH command to allow access to Gmail labels
  1223. );
  1224. IMAP4StatusDataItem : array [TIdIMAP4StatusDataItem] of String = (
  1225. 'MESSAGES', {Do not Localize}
  1226. 'RECENT', {Do not Localize}
  1227. 'UIDNEXT', {Do not Localize}
  1228. 'UIDVALIDITY', {Do not Localize}
  1229. 'UNSEEN' {Do not Localize}
  1230. );
  1231. function IMAPQuotedStr(const S: String): String;
  1232. begin
  1233. Result := '"' + StringsReplace(S, ['\', '"'], ['\\', '\"']) + '"'; {Do not Localize}
  1234. end;
  1235. { TIdSASLEntriesIMAP4 }
  1236. // RLebeau 2/8/2013 - TIdSASLEntries.LoginSASL() uses TIdTCPConnection.SendCmd()
  1237. // but TIdIMAP4 does not override the necessary virtuals to make that SendCmd()
  1238. // work correctly with IMAP. TIdIMAP reintroduces its own SendCmd() implementation,
  1239. // which TIdSASLEntries does not call. Until that can be changed, we will have
  1240. // to send the IMAP 'AUTHENTICATE' command manually! Doing it this way so as
  1241. // not to introduce an interface change that breaks backwards compatibility...
  1242. function CheckStrFail(const AStr : String; const AOk, ACont: array of string) : Boolean;
  1243. begin
  1244. //Result := PosInStrArray(AStr, AOk + ACont) = -1;
  1245. Result := (PosInStrArray(AStr, AOk) = -1) and
  1246. (PosInStrArray(AStr, ACont) = -1);
  1247. end;
  1248. function PerformSASLLogin_IMAP(ASASL: TIdSASL; AEncoder: TIdEncoder;
  1249. ADecoder: TIdDecoder; AClient : TIdIMAP4): Boolean;
  1250. const
  1251. AOkReplies: array[0..0] of string = (IMAP_OK);
  1252. AContinueReplies: array[0..0] of string = (IMAP_CONT);
  1253. var
  1254. S: String;
  1255. AuthStarted: Boolean;
  1256. begin
  1257. Result := False;
  1258. AuthStarted := False;
  1259. // TODO: use UTF-8 when base64-encoding strings...
  1260. if AClient.IsCapabilityListed('SASL-IR') then begin {Do not localize}
  1261. if ASASL.TryStartAuthenticate(AClient.Host, AClient.Port, IdGSKSSN_imap, S) then begin
  1262. AClient.SendCmd(AClient.NewCmdCounter, 'AUTHENTICATE ' + String(ASASL.ServiceName) + ' ' + AEncoder.Encode(S), [], True); {Do not Localize}
  1263. if CheckStrFail(AClient.LastCmdResult.Code, AOkReplies, AContinueReplies) then begin
  1264. ASASL.FinishAuthenticate;
  1265. Exit; // this mechanism is not supported
  1266. end;
  1267. AuthStarted := True;
  1268. end;
  1269. end;
  1270. if not AuthStarted then begin
  1271. AClient.SendCmd(AClient.NewCmdCounter, 'AUTHENTICATE ' + String(ASASL.ServiceName), [], True); {Do not Localize}
  1272. if CheckStrFail(AClient.LastCmdResult.Code, AOkReplies, AContinueReplies) then begin
  1273. Exit; // this mechanism is not supported
  1274. end;
  1275. end;
  1276. if (PosInStrArray(AClient.LastCmdResult.Code, AOkReplies) > -1) then begin
  1277. if AuthStarted then begin
  1278. ASASL.FinishAuthenticate;
  1279. end;
  1280. Result := True;
  1281. Exit; // we've authenticated successfully :)
  1282. end;
  1283. // must be a continue reply...
  1284. if not AuthStarted then begin
  1285. S := ADecoder.DecodeString(TrimRight(TIdReplyIMAP4(AClient.LastCmdResult).Extra.Text));
  1286. S := ASASL.StartAuthenticate(S, AClient.Host, AClient.Port, IdGSKSSN_imap);
  1287. AClient.IOHandler.WriteLn(AEncoder.Encode(S));
  1288. AClient.GetInternalResponse(AClient.LastCmdCounter, [], True);
  1289. if CheckStrFail(AClient.LastCmdResult.Code, AOkReplies, AContinueReplies) then
  1290. begin
  1291. ASASL.FinishAuthenticate;
  1292. Exit;
  1293. end;
  1294. end;
  1295. while PosInStrArray(AClient.LastCmdResult.Code, AContinueReplies) > -1 do begin
  1296. S := ADecoder.DecodeString(TrimRight(TIdReplyIMAP4(AClient.LastCmdResult).Extra.Text));
  1297. S := ASASL.ContinueAuthenticate(S, AClient.Host, AClient.Port, IdGSKSSN_imap);
  1298. AClient.IOHandler.WriteLn(AEncoder.Encode(S));
  1299. AClient.GetInternalResponse(AClient.LastCmdCounter, [], True);
  1300. if CheckStrFail(AClient.LastCmdResult.Code, AOkReplies, AContinueReplies) then
  1301. begin
  1302. ASASL.FinishAuthenticate;
  1303. Exit;
  1304. end;
  1305. end;
  1306. Result := (PosInStrArray(AClient.LastCmdResult.Code, AOkReplies) > -1);
  1307. ASASL.FinishAuthenticate;
  1308. end;
  1309. type
  1310. {$IFDEF HAS_GENERICS_TList}
  1311. TIdSASLList = TList<TIdSASL>;
  1312. {$ELSE}
  1313. // TODO: flesh out to match TList<TIdSASL> for non-Generics compilers
  1314. TIdSASLList = TList;
  1315. {$ENDIF}
  1316. TIdSASLEntriesIMAP4 = class(TIdSASLEntries)
  1317. public
  1318. procedure LoginSASL_IMAP(AClient: TIdIMAP4);
  1319. end;
  1320. procedure TIdSASLEntriesIMAP4.LoginSASL_IMAP(AClient: TIdIMAP4);
  1321. var
  1322. i : Integer;
  1323. LE : TIdEncoderMIME;
  1324. LD : TIdDecoderMIME;
  1325. LSupportedSASL : TStrings;
  1326. LSASLList: TIdSASLList;
  1327. LSASL : TIdSASL;
  1328. LError : TIdReply;
  1329. function SetupErrorReply: TIdReply;
  1330. begin
  1331. Result := TIdReplyClass(AClient.LastCmdResult.ClassType).Create(nil);
  1332. Result.Assign(AClient.LastCmdResult);
  1333. end;
  1334. begin
  1335. // make sure the collection is not empty
  1336. CheckIfEmpty;
  1337. //create a list of mechanisms that both parties support
  1338. LSASLList := TIdSASLList.Create;
  1339. try
  1340. LSupportedSASL := TStringList.Create;
  1341. try
  1342. ParseCapaReplyToList(AClient.FCapabilities, LSupportedSASL, 'AUTH'); {Do not Localize}
  1343. for i := Count-1 downto 0 do begin
  1344. LSASL := Items[i].SASL;
  1345. if LSASL <> nil then begin
  1346. if not LSASL.IsAuthProtocolAvailable(LSupportedSASL) then begin
  1347. Continue;
  1348. end;
  1349. if LSASLList.IndexOf(LSASL) = -1 then begin
  1350. LSASLList.Add(LSASL);
  1351. end;
  1352. end;
  1353. end;
  1354. finally
  1355. FreeAndNil(LSupportedSASL);
  1356. end;
  1357. if LSASLList.Count = 0 then begin
  1358. raise EIdSASLNotSupported.Create(RSSASLNotSupported);
  1359. end;
  1360. //now do it
  1361. LE := nil;
  1362. try
  1363. LD := nil;
  1364. try
  1365. LError := nil;
  1366. try
  1367. for i := 0 to LSASLList.Count-1 do begin
  1368. LSASL := {$IFDEF HAS_GENERICS_TList}LSASLList.Items[i]{$ELSE}TIdSASL(LSASLList.Items[i]){$ENDIF};
  1369. if not LSASL.IsReadyToStart then begin
  1370. Continue;
  1371. end;
  1372. if not Assigned(LE) then begin
  1373. LE := TIdEncoderMIME.Create(nil);
  1374. end;
  1375. if not Assigned(LD) then begin
  1376. LD := TIdDecoderMIME.Create(nil);
  1377. end;
  1378. if PerformSASLLogin_IMAP(LSASL, LE, LD, AClient) then begin
  1379. Exit;
  1380. end;
  1381. if not Assigned(LError) then begin
  1382. LError := SetupErrorReply;
  1383. end;
  1384. end;
  1385. if Assigned(LError) then begin
  1386. LError.RaiseReplyError;
  1387. end else begin
  1388. raise EIdSASLNotReady.Create(RSSASLNotReady);
  1389. end;
  1390. finally
  1391. FreeAndNil(LError);
  1392. end;
  1393. finally
  1394. FreeAndNil(LD);
  1395. end;
  1396. finally
  1397. FreeAndNil(LE);
  1398. end;
  1399. finally
  1400. FreeAndNil(LSASLList);
  1401. end;
  1402. end;
  1403. { TIdIMAP4WorkHelper }
  1404. type
  1405. TIdIMAP4WorkHelper = class(TIdComponent)
  1406. protected
  1407. fIMAP4: TIdIMAP4;
  1408. fOldTarget: TIdComponent;
  1409. public
  1410. constructor Create(AIMAP4: TIdIMAP4); reintroduce;
  1411. destructor Destroy; override;
  1412. end;
  1413. constructor TIdIMAP4WorkHelper.Create(AIMAP4: TIdIMAP4);
  1414. begin
  1415. inherited Create(nil);
  1416. fIMAP4 := AIMAP4;
  1417. fOldTarget := fIMAP4.WorkTarget;
  1418. fIMAP4.WorkTarget := Self;
  1419. Self.OnWorkBegin := fIMAP4.BeginWorkForPart;
  1420. Self.OnWork := fIMAP4.DoWorkForPart;
  1421. Self.OnWorkEnd := fIMAP4.EndWorkForPart;
  1422. end;
  1423. destructor TIdIMAP4WorkHelper.Destroy;
  1424. begin
  1425. fIMAP4.WorkTarget := fOldTarget;
  1426. inherited Destroy;
  1427. end;
  1428. { TIdEMUTF7 }
  1429. const
  1430. b64Chars : String =
  1431. 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+,'; {Do not Localize}
  1432. b64Index : array [0..127] of Integer = (
  1433. -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, // 16
  1434. -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, // 32
  1435. -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,62,63,-1,-1,-1, // 48
  1436. 52,53,54,55,56,57,58,59,60,61,-1,-1,-1,-1,-1,-1, // 64
  1437. -1,00,01,02,03,04,05,06,07,08,09,10,11,12,13,14, // 80
  1438. 15,16,17,18,19,20,21,22,23,24,25,-1,-1,-1,-1,-1, // 96
  1439. -1,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40, // 112
  1440. 41,42,43,44,45,46,47,48,49,50,51,-1,-1,-1,-1,-1 // 128
  1441. );
  1442. b64Table : array[0..127] of Integer = (
  1443. $FF,$FF,$FF,$FF, $FF,$FF,$FF,$FF, $FF,$FF,$FF,$FF, $FF,$FF,$FF,$FF, // 16
  1444. $FF,$FF,$FF,$FF, $FF,$FF,$FF,$FF, $FF,$FF,$FF,$FF, $FF,$FF,$FF,$FF, // 32
  1445. $20,$21,$22,$23, $24,$25,$FF,$27, $28,$29,$2A,$2B, $2C,$2D,$2E,$2F, // 48
  1446. $30,$31,$32,$33, $34,$35,$36,$37, $38,$39,$3A,$3B, $3C,$3D,$3E,$3F, // 64
  1447. $40,$41,$42,$43, $44,$45,$46,$47, $48,$49,$4A,$4B, $4C,$4D,$4E,$4F, // 80
  1448. $50,$51,$52,$53, $54,$55,$56,$57, $58,$59,$5A,$5B, $5C,$5D,$5E,$5F, // 96
  1449. $60,$61,$62,$63, $64,$65,$66,$67, $68,$69,$6A,$6B, $6C,$6D,$6E,$6F, // 112
  1450. $70,$71,$72,$73, $74,$75,$76,$77, $78,$79,$7A,$7B, $7C,$7D,$7E,$FF);// 128
  1451. // TODO: re-write this to derive from IdCoder3To4.pas or IdCoderMIME.pas classes...
  1452. function TIdMUTF7.Encode(const aString: TIdUnicodeString): String;
  1453. { -- MUTF7Encode -------------------------------------------------------------
  1454. PRE: nothing
  1455. POST: returns a string encoded as described in IETF RFC 3501, section 5.1.3
  1456. based upon RFC 2152
  1457. 2004-03-02 roman puls: speed improvements of around 2000 percent due to
  1458. replacement of pchar/while loops to delphi-style string/for
  1459. loops. Minor changes for '&' handling. Delphi 8 compatible.
  1460. 2004-02-29 roman puls: initial version ---}
  1461. var
  1462. c : Word;
  1463. bitBuf : UInt32;
  1464. bitShift : Integer;
  1465. x : Integer;
  1466. escaped : Boolean;
  1467. CharToAppend: Char;
  1468. {$IFDEF STRING_IS_IMMUTABLE}
  1469. LSB: TIdStringBuilder;
  1470. {$ENDIF}
  1471. begin
  1472. Result := '';
  1473. escaped := False;
  1474. bitShift := 0;
  1475. bitBuf := 0;
  1476. {$IFDEF STRING_IS_IMMUTABLE}
  1477. LSB := TIdStringBuilder.Create;
  1478. {$ENDIF}
  1479. for x := 1 to Length(aString) do begin
  1480. c := Word(aString[x]);
  1481. // c must be < 128 _and_ in table b64table
  1482. if (c <= $7f) and (b64Table[c] <> $FF) or (aString[x] = '&') then begin // we can directly encode that char
  1483. if escaped then begin
  1484. if (bitShift > 0) then begin // flush bitbuffer if needed
  1485. CharToAppend := b64Chars[(bitBuf shl (6 - bitShift) and $3F) + 1];
  1486. {$IFDEF STRING_IS_IMMUTABLE}
  1487. LSB.Append(CharToAppend);
  1488. {$ELSE}
  1489. Result := Result + CharToAppend;
  1490. {$ENDIF}
  1491. end;
  1492. {$IFDEF STRING_IS_IMMUTABLE}
  1493. LSB.Append(Char('-')); // leave escape sequence
  1494. {$ELSE}
  1495. Result := Result + '-'; // leave escape sequence
  1496. {$ENDIF}
  1497. escaped := False;
  1498. end;
  1499. if (aString[x] = '&') then begin // escape special char "&"
  1500. {$IFDEF STRING_IS_IMMUTABLE}
  1501. LSB.Append('&-');
  1502. {$ELSE}
  1503. Result := Result + '&-';
  1504. {$ENDIF}
  1505. end else begin
  1506. CharToAppend := Char(c);
  1507. {$IFDEF STRING_IS_IMMUTABLE}
  1508. LSB.Append(CharToAppend); // store direct translated char
  1509. {$ELSE}
  1510. Result := Result + CharToAppend; // store direct translated char
  1511. {$ENDIF}
  1512. end;
  1513. end else begin
  1514. if not escaped then begin
  1515. {$IFDEF STRING_IS_IMMUTABLE}
  1516. LSB.Append(Char('&'));
  1517. {$ELSE}
  1518. Result := Result + '&';
  1519. {$ENDIF}
  1520. bitShift := 0;
  1521. bitBuf := 0;
  1522. escaped := True;
  1523. end;
  1524. bitbuf := (bitBuf shl 16) or c; // shift and store new bye
  1525. Inc(bitShift, 16);
  1526. while (bitShift >= 6) do begin // flush buffer as far as we can
  1527. Dec(bitShift, 6);
  1528. CharToAppend := b64Chars[((bitBuf shr bitShift) and $3F) + 1];
  1529. {$IFDEF STRING_IS_IMMUTABLE}
  1530. LSB.Append(CharToAppend);
  1531. {$ELSE}
  1532. Result := Result + CharToAppend;
  1533. {$ENDIF}
  1534. end;
  1535. end;
  1536. end;
  1537. // we love duplicate work but must test for flush buffers for the price
  1538. // of speed (loop)
  1539. if escaped then begin
  1540. if (bitShift > 0) then begin
  1541. CharToAppend := b64Chars[(bitBuf shl (6 - bitShift) and $3F) + 1];
  1542. {$IFDEF STRING_IS_IMMUTABLE}
  1543. LSB.Append(CharToAppend);
  1544. {$ELSE}
  1545. Result := Result + CharToAppend;
  1546. {$ENDIF}
  1547. end;
  1548. {$IFDEF STRING_IS_IMMUTABLE}
  1549. LSB.Append(Char('-'));
  1550. {$ELSE}
  1551. Result := Result + '-';
  1552. {$ENDIF}
  1553. end;
  1554. {$IFDEF STRING_IS_IMMUTABLE}
  1555. Result := LSB.ToString;
  1556. {$ENDIF}
  1557. end;
  1558. function TIdMUTF7.Decode(const aString: String): TIdUnicodeString;
  1559. { -- mUTF7Decode -------------------------------------------------------------
  1560. PRE: aString encoding must conform to IETF RFC 3501, section 5.1.3
  1561. POST: SUCCESS: an 8bit string
  1562. FAILURE: an exception of type EMUTF7Decode
  1563. 2004-03-02 roman puls: speed improvements of around 400 percent due to
  1564. replacement of pchar/while loops to delphi-style string/for
  1565. loops. Delphi 8 compatible.
  1566. 2004-02-29 roman puls: initial version ---}
  1567. const
  1568. bitMasks: array[0..4] of UInt32 = ($00000000, $00000001, $00000003, $00000007, $0000000F);
  1569. var
  1570. ch : Byte;
  1571. last : Char;
  1572. bitBuf : UInt32;
  1573. escaped : Boolean;
  1574. x, bitShift: Integer;
  1575. CharToAppend: WideChar;
  1576. {$IFDEF STRING_IS_IMMUTABLE}
  1577. LSB: TIdStringBuilder;
  1578. {$ENDIF}
  1579. begin
  1580. Result := '';
  1581. escaped := False;
  1582. bitShift := 0;
  1583. last := #0;
  1584. bitBuf := 0;
  1585. {$IFDEF STRING_IS_IMMUTABLE}
  1586. LSB := TIdStringBuilder.Create;
  1587. {$ENDIF}
  1588. for x := 1 to Length(aString) do begin
  1589. ch := Byte(aString[x]);
  1590. if not escaped then begin
  1591. if (aString[x] = '&') then begin // escape sequence found
  1592. escaped := True;
  1593. bitBuf := 0;
  1594. bitShift := 0;
  1595. last := '&';
  1596. end
  1597. else if (ch < $80) and (b64Table[ch] <> $FF) then begin
  1598. {$IFDEF STRING_IS_IMMUTABLE}
  1599. LSB.Append(WideChar(ch));
  1600. {$ELSE}
  1601. Result := Result + WideChar(ch);
  1602. {$ENDIF}
  1603. end else begin
  1604. raise EMUTF7Decode.CreateFmt('Illegal char #%d in UTF7 sequence.', [Integer(ch)]); {do not localize}
  1605. end;
  1606. end else begin // we're escaped
  1607. { break out of escape mode }
  1608. if (aString[x] = '-') then begin
  1609. // extra check for pending bits
  1610. if (last = '&') then begin // special sequence '&-' ?
  1611. {$IFDEF STRING_IS_IMMUTABLE}
  1612. LSB.Append(Char('&'));
  1613. {$ELSE}
  1614. Result := Result + '&';
  1615. {$ENDIF}
  1616. end else begin
  1617. if (bitShift >= 16) then begin
  1618. Dec(bitShift, 16);
  1619. CharToAppend := WideChar((bitBuf shr bitShift) and $FFFF);
  1620. {$IFDEF STRING_IS_IMMUTABLE}
  1621. LSB.Append(CharToAppend);
  1622. {$ELSE}
  1623. Result := Result + CharToAppend;
  1624. {$ENDIF}
  1625. end;
  1626. if (bitShift > 4) or ((bitBuf and bitMasks[bitShift]) <> 0) then begin // check for bitboundaries
  1627. raise EMUTF7Decode.Create('Illegal bit sequence in MUTF7 string'); {do not localize}
  1628. end;
  1629. end;
  1630. escaped := False;
  1631. end else begin // still escaped
  1632. // check range for ch: must be < 128 and in b64table
  1633. if (ch >= $80) or (b64Index[ch] = -1) then begin
  1634. raise EMUTF7Decode.CreateFmt('Illegal char #%d in UTF7 sequence.', [Integer(ch)]); {do not localize}
  1635. end;
  1636. ch := b64Index[ch];
  1637. bitBuf := (bitBuf shl 6) or (ch and $3F);
  1638. Inc(bitShift, 6);
  1639. if (bitShift >= 16) then begin
  1640. Dec(bitShift, 16);
  1641. CharToAppend := WideChar((bitBuf shr bitShift) and $FFFF);
  1642. {$IFDEF STRING_IS_IMMUTABLE}
  1643. LSB.Append(CharToAppend);
  1644. {$ELSE}
  1645. Result := Result + CharToAppend;
  1646. {$ENDIF}
  1647. end;
  1648. end;
  1649. last := #0;
  1650. end;
  1651. end;
  1652. if escaped then begin
  1653. raise EmUTF7Decode.Create('Missing unescape in UTF7 sequence.'); {do not localize}
  1654. end;
  1655. {$IFDEF STRING_IS_IMMUTABLE}
  1656. Result := LSB.ToString;
  1657. {$ENDIF}
  1658. end;
  1659. function TIdMUTF7.Valid(const aMUTF7String : String): Boolean;
  1660. { -- mUTF7valid -------------------------------------------------------------
  1661. PRE: NIL
  1662. POST: returns true if string is correctly encoded (as described in mUTF7Encode)
  1663. returns false otherwise
  1664. }
  1665. begin
  1666. try
  1667. Result := (aMUTF7String = {mUTF7}Encode({mUTF7}Decode(aMUTF7String)));
  1668. except
  1669. on e: EmUTF7Error do begin
  1670. Result := False;
  1671. end;
  1672. // do not handle others
  1673. end;
  1674. end;
  1675. function TIdMUTF7.Append(const aMUTF7String: String; const aStr : TIdUnicodeString): String;
  1676. { -- mUTF7Append -------------------------------------------------------------
  1677. PRE: aMUTF7String is complying to mUTF7Encode's description
  1678. POST: SUCCESS: a concatenation of both input strings in mUTF
  1679. FAILURE: an exception of EMUTF7Decode or EMUTF7Encode will be raised
  1680. }
  1681. begin
  1682. Result := {mUTF7}Encode({mUTF7}Decode(aMUTF7String) + aStr);
  1683. end;
  1684. { TIdImapMessageParts }
  1685. constructor TIdImapMessagePart.Create(Collection: TCollection);
  1686. begin
  1687. {Make sure these are initialised properly...}
  1688. inherited Create(Collection);
  1689. FParentPart := -1;
  1690. FBoundary := ''; {Do not Localize}
  1691. end;
  1692. constructor TIdImapMessageParts.Create(AOwner: TPersistent);
  1693. begin
  1694. inherited Create(AOwner, TIdImapMessagePart);
  1695. end;
  1696. function TIdImapMessageParts.GetItem(Index: Integer): TIdImapMessagePart;
  1697. begin
  1698. Result := TIdImapMessagePart(inherited GetItem(Index));
  1699. end;
  1700. function TIdImapMessageParts.Add: TIdImapMessagePart;
  1701. begin
  1702. Result := TIdImapMessagePart(inherited Add);
  1703. end;
  1704. procedure TIdImapMessageParts.SetItem(Index: Integer; const Value: TIdImapMessagePart);
  1705. begin
  1706. inherited SetItem(Index, Value);
  1707. end;
  1708. { TIdIMAP4 }
  1709. procedure TIdIMAP4.BeginWorkForPart(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
  1710. begin
  1711. if Assigned(FOnWorkBeginForPart) then begin
  1712. FOnWorkBeginForPart(Self, AWorkMode, AWorkCountMax);
  1713. end;
  1714. end;
  1715. procedure TIdIMAP4.DoWorkForPart(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
  1716. begin
  1717. if Assigned(FOnWorkForPart) then begin
  1718. FOnWorkForPart(Self, AWorkMode, AWorkCount);
  1719. end;
  1720. end;
  1721. procedure TIdIMAP4.EndWorkForPart(ASender: TObject; AWorkMode: TWorkMode);
  1722. begin
  1723. if Assigned(FOnWorkEndForPart) then begin
  1724. FOnWorkEndForPart(Self, AWorkMode);
  1725. end;
  1726. end;
  1727. //The following call FMUTF7 but do exception-handling on invalid strings...
  1728. function TIdIMAP4.DoMUTFEncode(const aString : String): String;
  1729. begin
  1730. // TODO: if the server advertises the "UTF8=ACCEPT" capability, use
  1731. // a UTF-8 quoted string instead of IMAP's Modified UTF-7...
  1732. try
  1733. Result := FMUTF7.Encode(
  1734. {$IFDEF STRING_IS_UNICODE}
  1735. aString
  1736. {$ELSE}
  1737. TIdUnicodeString(aString) // explicit convert to Unicode
  1738. {$ENDIF}
  1739. );
  1740. except
  1741. Result := aString;
  1742. end;
  1743. end;
  1744. function TIdIMAP4.DoMUTFDecode(const aString : String): String;
  1745. begin
  1746. try
  1747. {$IFDEF STRING_IS_UNICODE}
  1748. Result := FMUTF7.Decode(aString);
  1749. {$ELSE}
  1750. Result := String(FMUTF7.Decode(aString)); // explicit convert to Ansi
  1751. {$ENDIF}
  1752. except
  1753. Result := aString;
  1754. end;
  1755. end;
  1756. function TIdIMAP4.GetReplyClass:TIdReplyClass;
  1757. begin
  1758. Result := TIdReplyIMAP4;
  1759. end;
  1760. function TIdIMAP4.GetSupportsTLS: Boolean;
  1761. begin
  1762. Result := IsCapabilityListed('STARTTLS'); //do not localize
  1763. end;
  1764. function TIdIMAP4.CheckConnectionState(AAllowedState: TIdIMAP4ConnectionState): TIdIMAP4ConnectionState;
  1765. begin
  1766. if FConnectionState = AAllowedState then begin
  1767. Result := FConnectionState;
  1768. end else begin
  1769. raise EIdConnectionStateError.CreateFmt(RSIMAP4ConnectionStateError, [GetConnectionStateName]);
  1770. end;
  1771. end;
  1772. function TIdIMAP4.CheckConnectionState(const AAllowedStates: array of TIdIMAP4ConnectionState): TIdIMAP4ConnectionState;
  1773. var
  1774. i: integer;
  1775. begin
  1776. if High(AAllowedStates) > -1 then begin
  1777. // Cannot use PosInSmallIntArray() here...
  1778. for i := Low(AAllowedStates) to High(AAllowedStates) do begin
  1779. if FConnectionState = AAllowedStates[i] then begin
  1780. Result := FConnectionState;
  1781. Exit;
  1782. end;
  1783. end;
  1784. end;
  1785. raise EIdConnectionStateError.CreateFmt(RSIMAP4ConnectionStateError, [GetConnectionStateName]);
  1786. end;
  1787. function TIdIMAP4.CheckReplyForCapabilities: Boolean;
  1788. var
  1789. I: Integer;
  1790. LExtra: TStrings;
  1791. begin
  1792. FCapabilities.Clear;
  1793. FHasCapa := False;
  1794. LExtra := TIdReplyIMAP4(FLastCmdResult).Extra;
  1795. for I := 0 to LExtra.Count-1 do begin
  1796. if TextStartsWith(LExtra.Strings[I], 'CAPABILITY ') then begin {Do not Localize}
  1797. BreakApart(LExtra.Strings[I], ' ', FCapabilities); {Do not Localize}
  1798. // RLebeau: do not delete the first item anymore! It specifies the IMAP
  1799. // version/revision, which is needed to support certain extensions, like
  1800. // 'IMAP4rev1'...
  1801. {FCapabilities.Delete(0);}
  1802. FHasCapa := True;
  1803. Break;
  1804. end;
  1805. end;
  1806. Result := FHasCapa;
  1807. end;
  1808. function TIdIMAP4.FindHowServerCreatesFolders: TIdIMAP4FolderTreatment;
  1809. var
  1810. LUsersFolders: TStringList;
  1811. LN: integer;
  1812. LInbox: string;
  1813. LTestFolder: string;
  1814. begin
  1815. LUsersFolders := TStringList.Create;
  1816. try
  1817. {$IFDEF HAS_TStringList_CaseSensitive}
  1818. LUsersFolders.CaseSensitive := False;
  1819. {$ENDIF}
  1820. //Get folder names...
  1821. if not ListMailBoxes(LUsersFolders) then begin
  1822. Result := ftCannotRetrieveAnyFolders;
  1823. Exit;
  1824. end;
  1825. if LUsersFolders.Count = 0 then begin
  1826. Result := ftCannotRetrieveAnyFolders;
  1827. Exit;
  1828. end;
  1829. //Do we have an Inbox?
  1830. LN := IndyIndexOf(LUsersFolders, 'INBOX'); {Do not Localize}
  1831. if LN = -1 then begin
  1832. Result := ftCannotTestBecauseHasNoInbox;
  1833. Exit;
  1834. end;
  1835. LInbox := LUsersFolders.Strings[LN];
  1836. //Make sure our test folder does not already exist at the top level...
  1837. LTestFolder := 'CiaransTestFolder'; {Do not Localize}
  1838. while IndyIndexOf(LUsersFolders, LTestFolder) <> -1 do begin
  1839. LTestFolder := LTestFolder + '9'; {Do not Localize}
  1840. end;
  1841. //Try to create LTestFolder at the top level...
  1842. if CreateMailbox(LTestFolder) then begin
  1843. //We were able to create it at the top level - delete it and exit..
  1844. DeleteMailbox(LTestFolder);
  1845. Result := ftAllowsTopLevelCreation;
  1846. Exit;
  1847. end;
  1848. //See if our test folder does not exist under INBOX...
  1849. LTestFolder := LInbox + FMailBoxSeparator + 'CiaransTestFolder'; {Do not Localize}
  1850. while IndyIndexOf(LUsersFolders, LTestFolder) <> -1 do begin
  1851. LTestFolder := LTestFolder + '9'; {Do not Localize}
  1852. end;
  1853. //Try to create LTestFolder under Inbox...
  1854. if CreateMailbox(LTestFolder) then begin
  1855. //We were able to create it under the top level - delete it and exit..
  1856. DeleteMailbox(LTestFolder);
  1857. Result := ftFoldersMustBeUnderInbox;
  1858. Exit;
  1859. end;
  1860. //It does not allow us create folders under any level (read-only?)...
  1861. Result := ftDoesNotAllowFolderCreation;
  1862. finally
  1863. FreeAndNil(LUsersFolders);
  1864. end;
  1865. end;
  1866. function TIdIMAP4.IsNumberValid(const ANumber: UInt32): Boolean;
  1867. {CC3: Need to validate message numbers (relative and UIDs), because otherwise
  1868. the routines wait for a response that never arrives and so functions never return.}
  1869. begin
  1870. if ANumber < 1 then begin
  1871. raise EIdNumberInvalid.Create(RSIMAP4NumberInvalid);
  1872. end;
  1873. Result := True;
  1874. end;
  1875. {$IFNDEF HAS_TryStrToInt64}
  1876. // TODO: move this to IdGlobalProtocols...
  1877. function TryStrToInt64(const S: string; out Value: Int64): Boolean;
  1878. {$IFDEF USE_INLINE}inline;{$ENDIF}
  1879. var
  1880. E: Integer;
  1881. begin
  1882. Val(S, Value, E);
  1883. Result := E = 0;
  1884. end;
  1885. {$ENDIF}
  1886. function UIDToUInt32(const AUID: String): UInt32;
  1887. var
  1888. LNumber: Int64;
  1889. begin
  1890. if Length(AUID) = 0 then begin
  1891. raise EIdNumberInvalid.Create(RSIMAP4NumberInvalid);
  1892. end;
  1893. if not TryStrToInt64(AUID, LNumber) then begin
  1894. raise EIdNumberInvalid.Create(RSIMAP4NumberInvalid);
  1895. end;
  1896. if (LNumber < 1) or (LNumber > Int64(High(UInt32))) then begin
  1897. raise EIdNumberInvalid.Create(RSIMAP4NumberInvalid);
  1898. end;
  1899. Result := UInt32(LNumber);
  1900. end;
  1901. function TIdIMAP4.IsUIDValid(const AUID: string): Boolean;
  1902. {CC3: Need to validate message numbers (relative and UIDs), because otherwise
  1903. the routines wait for a response that never arrives and so functions never return.}
  1904. begin
  1905. //Must be digits only (no - or .)
  1906. IsItDigitsAndOptionallyPeriod(AUID, False);
  1907. UIDToUInt32(AUID);
  1908. Result := True;
  1909. end;
  1910. function TIdIMAP4.IsImapPartNumberValid(const APartNum: Integer): Boolean;
  1911. begin
  1912. if APartNum < 1 then begin
  1913. raise EIdNumberInvalid.Create(RSIMAP4NumberInvalid);
  1914. end;
  1915. Result := True;
  1916. end;
  1917. function TIdIMAP4.IsImapPartNumberValid(const APartNum: string): Boolean;
  1918. {CC3: IMAP part numbers are 3 or 4.5 etc, i.e. digits or period allowed}
  1919. begin
  1920. Result := IsItDigitsAndOptionallyPeriod(APartNum, True);
  1921. end;
  1922. function TIdIMAP4.IsItDigitsAndOptionallyPeriod(const AStr: string; AAllowPeriod: Boolean): Boolean;
  1923. var
  1924. LN: integer;
  1925. begin
  1926. if Length(AStr) = 0 then begin
  1927. raise EIdNumberInvalid.Create(RSIMAP4NumberInvalid);
  1928. end;
  1929. if AAllowPeriod then begin
  1930. for LN := 1 to Length(AStr) do begin
  1931. if not IsNumeric(AStr[LN]) then begin
  1932. if AStr[LN] <> '.' then begin {Do not Localize}
  1933. raise EIdNumberInvalid.Create(RSIMAP4NumberInvalid);
  1934. end;
  1935. end;
  1936. end;
  1937. end
  1938. else if not IsNumeric(AStr) then begin
  1939. raise EIdNumberInvalid.Create(RSIMAP4NumberInvalid);
  1940. end;
  1941. Result := True;
  1942. end;
  1943. function TIdIMAP4.GetUID(const AMsgNum: UInt32; var AUID: string): Boolean;
  1944. {This gets the message UID from the message relative number.}
  1945. begin
  1946. Result := False;
  1947. AUID := ''; {Do not Localize}
  1948. IsNumberValid(AMsgNum);
  1949. CheckConnectionState(csSelected);
  1950. {Some servers return NO if the requested message number is not present
  1951. (e.g. Cyrus), others return OK but no data (CommuniGate).}
  1952. SendCmd(NewCmdCounter,
  1953. IMAP4Commands[cmdFetch] + ' ' + IntToStr(Int64(AMsgNum)) + ' (' + IMAP4FetchDataItem[fdUID] + ')', {Do not Localize}
  1954. [IMAP4Commands[cmdFetch]]);
  1955. if LastCmdResult.Code = IMAP_OK then begin
  1956. //Might as well leave 3rd param as [] because ParseLastCmdResult always grabs the UID...
  1957. if LastCmdResult.Text.Count > 0 then begin
  1958. if ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch], []) then begin
  1959. AUID := FLineStruct.UID;
  1960. Result := True;
  1961. end;
  1962. end;
  1963. end;
  1964. end;
  1965. {$I IdDeprecatedImplBugOff.inc}
  1966. procedure TIdIMAP4.WriteLn(const AOut: string = '');
  1967. {$I IdDeprecatedImplBugOn.inc}
  1968. begin
  1969. IOHandler.WriteLn(AOut);
  1970. end;
  1971. {$I IdDeprecatedImplBugOff.inc}
  1972. function TIdIMAP4.ReadLnWait: string;
  1973. {$I IdDeprecatedImplBugOn.inc}
  1974. begin
  1975. Result := IOHandler.ReadLnWait; {This can have hit an exception of Connection Reset By Peer (timeout)}
  1976. end;
  1977. { IdTCPConnection Commands... }
  1978. function TIdIMAP4.GetInternalResponse(const ATag: String; AExpectedResponses: array of String;
  1979. ASingleLineMode: Boolean; ASingleLineMayBeSplit: Boolean {= True}): string;
  1980. {ASingleLineMode is True if the caller just wants the FIRST line of the response,
  1981. e.g., he may be looking only for "* FETCH (blah blah)", because he needs to parse
  1982. that line to figure out how the rest will follow. This arises with a number of the
  1983. FETCH commands where the caller needs to get the byte-count from the first line
  1984. before he can retrieve the rest of the response.
  1985. Note "FETCH" would have to be in AExpectedResponses.
  1986. When False, the caller wants everything up to and including the reply terminator
  1987. (e.g. "C45 OK Completed").
  1988. In ASingleLineMode, we ignore any lines that dont have one of AExpectedResponses
  1989. at the start, otherwise we add all lines to .Text and later strip out any lines that
  1990. dont have one of AExpectedResponses at the start.
  1991. ASingleLineMayBeSplit (which should only be used with ASingleLineMode = True) deals
  1992. with the case where the server cannot or does not fit a single-line
  1993. response onto one line. This arises when FETCHing the BODYSTRUCTURE, which can
  1994. be very long. The server (Courier, anyway) signals it by adding a byte-count to
  1995. the end of the first line, that would not normally be present.}
  1996. //For example, for normal short responses, the server would send:
  1997. // * FETCH (BODYSTRUCTURE (Part1 Part2))
  1998. //but if it splits it, it sends:
  1999. // * FETCH (BODYSTRUCTURE (Part1 {7}
  2000. // Part2))
  2001. //The number in the curly brackets {7} is the byte count following the line break.
  2002. {WARNING: If you use ASingleLineMayBeSplit on a line that is EXPECTED to end
  2003. with a byte-count, the code will break, so don't use it unless absolutely
  2004. necessary.}
  2005. var
  2006. LLine: String;
  2007. LResponse: TStringList;
  2008. LWord: string;
  2009. LPos: integer;
  2010. LStrippedLineLength: Integer;
  2011. LGotALineWithAnExpectedResponse: Boolean;
  2012. LStrippedLine: string;
  2013. LSplitLine: string;
  2014. begin
  2015. LGotALineWithAnExpectedResponse := False;
  2016. LResponse := TStringList.Create;
  2017. try
  2018. repeat
  2019. LLine := IOHandler.ReadLnWait;
  2020. {CCB: Trap case of server telling you that you have been disconnected, usually because
  2021. you were inactive for too long (get "* BYE idle time too long"). }
  2022. if TextStartsWith(LLine, '* BYE') then begin {Do not Localize}
  2023. {If BYE is in AExpectedResponses, this means we are expecting to
  2024. disconnect, i.e. it is a LOGOUT.}
  2025. if PosInStrArray('BYE', AExpectedResponses) = -1 then begin {Do not Localize}
  2026. {We were not expecting a BYE response.
  2027. For the moment, throw an exception. Could modify this by adding a
  2028. ReconnectOnDisconnect property to automatically reconnect?}
  2029. FConnectionState := csUnexpectedlyDisconnected;
  2030. raise EIdDisconnectedProbablyIdledOut.Create(RSIMAP4DisconnectedProbablyIdledOut);
  2031. end;
  2032. end;
  2033. if ASingleLineMode then begin
  2034. //See if it may continue on the next line...
  2035. if ASingleLineMayBeSplit then begin
  2036. //If the line is split, it will have a byte-count field at the end...
  2037. if TextEndsWith(LLine, '}') then begin
  2038. //It is split.
  2039. LStrippedLine := LLine;
  2040. LLine := '';
  2041. repeat
  2042. //First, remove the byte count...
  2043. LPos := Length(LStrippedLine)-1;
  2044. while LPos >= 1 do begin
  2045. if LStrippedLine[LPos] = '{' then begin
  2046. Break;
  2047. end;
  2048. Dec(LPos);
  2049. end;
  2050. LWord := Copy(LStrippedLine, LPos+1, (Length(LStrippedLine)-LPos)-1);
  2051. if TextIsSame(LWord, 'NIL') then begin
  2052. LStrippedLineLength := 0;
  2053. end else begin
  2054. LStrippedLineLength := StrToInt(LWord);
  2055. end;
  2056. LStrippedLine := Copy(LStrippedLine, 1, LPos-1);
  2057. //The rest of the reply is on the following line...
  2058. LSplitLine := IOHandler.ReadString(LStrippedLineLength);
  2059. // At this point LSplitLine should be parsed and the following characters should be escaped... " CR LF.
  2060. LLine := LLine + LStrippedLine + LSplitLine;
  2061. LStrippedLine := IOHandler.ReadLn; //Cannot thrash LLine, need it later
  2062. until not TextEndsWith(LStrippedLine, '}');
  2063. LLine := LLine + LStrippedLine;
  2064. end;
  2065. end;
  2066. LStrippedLine := LLine;
  2067. if TextStartsWith(LLine, '* ') then begin {Do not Localize}
  2068. LStrippedLine := Copy(LLine, 3, MaxInt);
  2069. end;
  2070. LGotALineWithAnExpectedResponse := TIdReplyIMAP4(FLastCmdResult).DoesLineHaveExpectedResponse(LStrippedLine, AExpectedResponses);
  2071. if LGotALineWithAnExpectedResponse then begin
  2072. FLastCmdResult.Text.Clear;
  2073. TIdReplyIMAP4(FLastCmdResult).Extra.Clear;
  2074. FLastCmdResult.Text.Add(LStrippedLine);
  2075. end;
  2076. end else
  2077. begin
  2078. //If the line is split, it will have a byte-count field at the end...
  2079. if TextEndsWith(LLine, '}') then begin
  2080. LStrippedLine := LLine;
  2081. LLine := '';
  2082. repeat
  2083. //It is split.
  2084. //First, remove the byte count...
  2085. LPos := Length(LStrippedLine)-1;
  2086. while LPos >= 1 do begin
  2087. if LStrippedLine[LPos] = '{' then begin
  2088. Break;
  2089. end;
  2090. Dec(LPos);
  2091. end;
  2092. LWord := Copy(LStrippedLine, LPos+1, (Length(LStrippedLine)-LPos)-1);
  2093. if TextIsSame(LWord, 'NIL') then begin
  2094. LStrippedLineLength := 0;
  2095. end else begin
  2096. LStrippedLineLength := StrToInt(LWord);
  2097. end;
  2098. LStrippedLine := Copy(LStrippedLine, 1, LPos-1);
  2099. //The rest of the reply is on the following line...
  2100. LSplitLine := IOHandler.ReadString(LStrippedLineLength);
  2101. // At this point LSplitLine should be parsed and the following characters should be escaped... " CR LF.
  2102. LLine := LLine + LStrippedLine + LSplitLine;
  2103. LStrippedLine := IOHandler.ReadLn; //Cannot thrash LLine, need it later
  2104. until not TextEndsWith(LStrippedLine, '}');
  2105. LLine := LLine + LStrippedLine;
  2106. end;
  2107. end;
  2108. LResponse.Add(LLine);
  2109. //Need to get the 1st word on the line in case it is +, PREAUTH, etc...
  2110. LPos := Pos(' ', LLine); {Do not Localize}
  2111. if LPos <> 0 then begin
  2112. {There are at least two words on this line...}
  2113. LWord := Trim(Copy(LLine, 1, LPos-1));
  2114. end else begin
  2115. {No space, so this line is a single word. A bit weird, but it
  2116. could be just an OK...}
  2117. LWord := LLine; {A bit pedantic, but emphasises we have a word, not a line}
  2118. end;
  2119. until
  2120. TextStartsWith(LLine, ATag)
  2121. or (PosInStrArray(LWord, VALID_TAGGEDREPLIES) <> -1)
  2122. or LGotALineWithAnExpectedResponse;
  2123. if LGotALineWithAnExpectedResponse then begin
  2124. //This only arises if ASingleLineMode is True...
  2125. FLastCmdResult.Code := IMAP_OK;
  2126. end else begin
  2127. FLastCmdResult.FormattedReply := LResponse;
  2128. TIdReplyIMAP4(FLastCmdResult).RemoveUnsolicitedResponses(AExpectedResponses);
  2129. end;
  2130. Result := FLastCmdResult.Code;
  2131. finally
  2132. FreeAndNil(LResponse);
  2133. end;
  2134. end;
  2135. function TIdIMAP4.SendCmd(const AOut: string; AExpectedResponses: array of String;
  2136. ASingleLineMode: Boolean = False; ASingleLineMayBeSplit: Boolean = True): string;
  2137. begin
  2138. Result := SendCmd(NewCmdCounter, AOut, AExpectedResponses, ASingleLineMode, ASingleLineMayBeSplit);
  2139. end;
  2140. function TIdIMAP4.SendCmd(const ATag, AOut: string; AExpectedResponses: array of String;
  2141. ASingleLineMode: Boolean = False; ASingleLineMayBeSplit: Boolean = True): string;
  2142. var
  2143. LCmd: String;
  2144. begin
  2145. {CC3: Catch "Connection reset by peer"...}
  2146. try
  2147. if (AOut <> #0) then begin
  2148. //Remove anything that may be unprocessed from a previous (probably failed) command...
  2149. repeat
  2150. IOHandler.InputBuffer.Clear;
  2151. until not IOHandler.CheckForDataOnSource(MilliSecsToWaitToClearBuffer);
  2152. LCmd := ATag + ' ' + AOut;
  2153. CheckConnected;
  2154. PrepareCmd(LCmd);
  2155. IOHandler.WriteLn(LCmd);
  2156. end;
  2157. Result := GetInternalResponse(ATag, AExpectedResponses, ASingleLineMode, ASingleLineMayBeSplit);
  2158. except
  2159. on E: EIdSocketError do begin
  2160. if ((E.LastError = Id_WSAECONNABORTED) or (E.LastError = Id_WSAECONNRESET)) then begin
  2161. FConnectionState := csUnexpectedlyDisconnected;
  2162. end;
  2163. raise;
  2164. end;
  2165. end;
  2166. end;
  2167. { ...IdTCPConnection Commands }
  2168. procedure TIdIMAP4.DoAlert(const AMsg: String);
  2169. begin
  2170. if Assigned(OnAlert) then begin
  2171. OnAlert(Self, AMsg);
  2172. end;
  2173. end;
  2174. procedure TIdIMAP4.SetMailBox(const Value: TIdMailBox);
  2175. begin
  2176. FMailBox.Assign(Value);
  2177. end;
  2178. procedure TIdIMAP4.SetSASLMechanisms(AValue: TIdSASLEntries);
  2179. begin
  2180. FSASLMechanisms.Assign(AValue);
  2181. end;
  2182. procedure TIdIMAP4.Login;
  2183. var
  2184. LIO: TIdSSLIOHandlerSocketBase;
  2185. begin
  2186. try
  2187. if (IOHandler is TIdSSLIOHandlerSocketBase) and (UseTLS in ExplicitTLSVals) then begin
  2188. LIO := TIdSSLIOHandlerSocketBase(IOHandler);
  2189. //we check passthrough because we can either be using TLS currently with
  2190. //implicit TLS support or because STARTLS was issued previously.
  2191. if LIO.PassThrough then begin
  2192. if SupportsTLS then begin
  2193. if SendCmd(NewCmdCounter, 'STARTTLS', []) = IMAP_OK then begin {Do not Localize}
  2194. TLSHandshake;
  2195. //obtain capabilities again - RFC2595
  2196. Capability;
  2197. end else begin
  2198. ProcessTLSNegCmdFailed;
  2199. end;
  2200. end else begin
  2201. ProcessTLSNotAvail;
  2202. end;
  2203. end;
  2204. end;
  2205. FConnectionState := csNonAuthenticated;
  2206. FCmdCounter := 0;
  2207. if FAuthType = iatUserPass then begin
  2208. if Length(Password) <> 0 then begin {Do not Localize}
  2209. SendCmd(NewCmdCounter, IMAP4Commands[cmdLogin] + ' ' + Username + ' ' + IMAPQuotedStr(Password), [IMAP_OK]); {Do not Localize}
  2210. end else begin
  2211. SendCmd(NewCmdCounter, IMAP4Commands[cmdLogin] + ' ' + Username, [IMAP_OK]); {Do not Localize}
  2212. end;
  2213. if LastCmdResult.Code <> IMAP_OK then begin
  2214. RaiseExceptionForLastCmdResult;
  2215. end;
  2216. end else
  2217. begin
  2218. if not FHasCapa then begin
  2219. Capability;
  2220. end;
  2221. // FSASLMechanisms.LoginSASL('AUTHENTICATE', FHost, FPort, IdGSKSSN_imap, [IMAP_OK], [IMAP_CONT], Self, FCapabilities, 'AUTH', IsCapabilityListed('SASL-IR')); {Do not Localize}
  2222. TIdSASLEntriesIMAP4(FSASLMechanisms).LoginSASL_IMAP(Self);
  2223. end;
  2224. FConnectionState := csAuthenticated;
  2225. // RLebeau: check if the response includes new Capabilities, if not then query for them...
  2226. if not CheckReplyForCapabilities then begin
  2227. Capability;
  2228. end;
  2229. except
  2230. Disconnect;
  2231. raise;
  2232. end;
  2233. end;
  2234. function TIdIMAP4.Connect(const AAutoLogin: Boolean = True): Boolean;
  2235. begin
  2236. {CC2: Need to set FConnectionState to csNonAuthenticated here. If not, then
  2237. an unsuccessful connect after a previous successful connect (such as when a
  2238. client program changes users) can leave it as csAuthenticated.}
  2239. FConnectionState := csNonAuthenticated;
  2240. try
  2241. {CC2: Don't call Connect if already connected, this could be just a change of user}
  2242. if not Connected then begin
  2243. inherited Connect;
  2244. GetResponse;
  2245. // if PosInStrArray(LastCmdResult.Code, [IMAP_OK, IMAP_PREAUTH]) = -1 then begin
  2246. {Should have got OK or PREAUTH in the greeting. Happened with some server,
  2247. may need further investigation and coding...}
  2248. // end;
  2249. {CC7: Save FGreetingBanner so the user can use it to determine what type of
  2250. server he is connected to...}
  2251. if LastCmdResult.Text.Count > 0 then begin
  2252. FGreetingBanner := LastCmdResult.Text[0];
  2253. end else begin
  2254. FGreetingBanner := '';
  2255. end;
  2256. if LastCmdResult.Code = IMAP_PREAUTH then begin
  2257. FConnectionState := csAuthenticated;
  2258. FCmdCounter := 0;
  2259. // RLebeau: check if the greeting includes initial Capabilities, if not then query for them...
  2260. if not CheckReplyForCapabilities then begin
  2261. Capability;
  2262. end;
  2263. end else begin
  2264. // RLebeau: check if the greeting includes initial Capabilities...
  2265. CheckReplyForCapabilities;
  2266. end;
  2267. end;
  2268. if AAutoLogin then begin
  2269. Login;
  2270. end;
  2271. except
  2272. Disconnect(False);
  2273. raise;
  2274. end;
  2275. Result := True;
  2276. end;
  2277. {$IFDEF WORKAROUND_INLINE_CONSTRUCTORS}
  2278. constructor TIdIMAP4.Create(AOwner: TComponent);
  2279. begin
  2280. inherited Create(AOwner);
  2281. end;
  2282. {$ENDIF}
  2283. procedure TIdIMAP4.InitComponent;
  2284. begin
  2285. inherited InitComponent;
  2286. FMailBox := TIdMailBox.Create(Self);
  2287. //FSASLMechanisms := TIdSASLEntries.Create(Self);
  2288. FSASLMechanisms := TIdSASLEntriesIMAP4.Create(Self);
  2289. Port := IdPORT_IMAP4;
  2290. FLineStruct := TIdIMAPLineStruct.Create;
  2291. {$IFDEF HAS_TStringList_CaseSensitive}
  2292. TStringList(FCapabilities).CaseSensitive := False; // TODO: move this to TIdExplicitTLSClient.InitComponent()
  2293. {$ENDIF}
  2294. FMUTF7 := TIdMUTF7.Create;
  2295. //Todo: Not sure which number is appropriate. Should be tested further.
  2296. FRegularProtPort := IdPORT_IMAP4;
  2297. FImplicitTLSProtPort := IdPORT_IMAP4S;
  2298. FExplicitTLSProtPort := IdPORT_IMAP4;
  2299. FMilliSecsToWaitToClearBuffer := IDF_DEFAULT_MS_TO_WAIT_TO_CLEAR_BUFFER;
  2300. FCmdCounter := 0;
  2301. FConnectionState := csNonAuthenticated;
  2302. FRetrieveOnSelect := rsDisabled;
  2303. {CC2: FMailBoxSeparator is now detected when a mailbox is selected, following
  2304. line is probably redundant, but leave it here as a default just in case.}
  2305. FMailBoxSeparator := '/'; {Do not Localize}
  2306. end;
  2307. procedure TIdIMAP4.Disconnect(ANotifyPeer: Boolean);
  2308. begin
  2309. try
  2310. inherited Disconnect(ANotifyPeer);
  2311. finally
  2312. FConnectionState := csNonAuthenticated;
  2313. FCapabilities.Clear;
  2314. end;
  2315. end;
  2316. procedure TIdIMAP4.DisconnectNotifyPeer;
  2317. begin
  2318. inherited DisconnectNotifyPeer;
  2319. //IMPORTANT: Logout must pass 'BYE' as the first
  2320. //element of the AExpectedResponses array (the 3rd param in SendCmd
  2321. //below), because this flags to GetInternalResponse that this is the
  2322. //logout, and it must EXPECT the BYE response
  2323. SendCmd(NewCmdCounter, IMAP4Commands[cmdLogout], ['BYE']); {Do not Localize}
  2324. end;
  2325. procedure TIdIMAP4.KeepAlive;
  2326. begin
  2327. //Available in any state.
  2328. SendCmd(NewCmdCounter, IMAP4Commands[cmdNoop], []);
  2329. end;
  2330. function TIdIMAP4.IsCapabilityListed(ACapability: string):Boolean;
  2331. begin
  2332. if not FHasCapa then begin
  2333. Capability;
  2334. end;
  2335. Result := IndyIndexOf(TStringList(FCapabilities), ACapability) <> -1;
  2336. end;
  2337. function TIdIMAP4.Capability: Boolean;
  2338. begin
  2339. FHasCapa := Capability(FCapabilities);
  2340. Result := FHasCapa;
  2341. end;
  2342. function TIdIMAP4.Capability(ASlCapability: TStrings): Boolean;
  2343. begin
  2344. //Available in any state.
  2345. Result := False;
  2346. ASlCapability.BeginUpdate;
  2347. try
  2348. ASlCapability.Clear;
  2349. SendCmd(NewCmdCounter, IMAP4Commands[CmdCapability], [IMAP4Commands[CmdCapability]]);
  2350. if LastCmdResult.Code = IMAP_OK then begin
  2351. if LastCmdResult.Text.Count > 0 then begin
  2352. BreakApart(LastCmdResult.Text[0], ' ', ASlCapability); {Do not Localize}
  2353. end;
  2354. // RLebeau: do not delete the first item anymore! It specifies the IMAP
  2355. // version/revision, which is needed to support certain extensions, like
  2356. // 'IMAP4rev1'...
  2357. {
  2358. if ASlCapability.Count > 0 then begin
  2359. ASlCapability.Delete(0);
  2360. end;
  2361. }
  2362. Result := True;
  2363. end;
  2364. finally
  2365. ASlCapability.EndUpdate;
  2366. end;
  2367. end;
  2368. function TIdIMAP4.GetCmdCounter: String;
  2369. begin
  2370. Result := 'C' + IntToStr(FCmdCounter); {Do not Localize}
  2371. end;
  2372. function TIdIMAP4.GetNewCmdCounter: String;
  2373. begin
  2374. Inc(FCmdCounter);
  2375. Result := 'C' + IntToStr(FCmdCounter); {Do not Localize}
  2376. end;
  2377. destructor TIdIMAP4.Destroy;
  2378. begin
  2379. {Disconnect before we die}
  2380. { Note we have to pass false to an overloaded method or an exception is
  2381. raised in the destructor. That can cause weirdness in the IDE. }
  2382. if Connected then begin
  2383. Disconnect(False);
  2384. end;
  2385. FreeAndNil(FMailBox);
  2386. FreeAndNil(FSASLMechanisms);
  2387. FreeAndNil(FLineStruct);
  2388. FreeAndNil(FMUTF7);
  2389. inherited Destroy;
  2390. end;
  2391. function TIdIMAP4.SelectMailBox(const AMBName: String): Boolean;
  2392. begin
  2393. Result := False;
  2394. CheckConnectionState([csAuthenticated, csSelected]);
  2395. SendCmd(NewCmdCounter,
  2396. IMAP4Commands[cmdSelect] + ' "' + DoMUTFEncode(AMBName) + '"', {Do not Localize}
  2397. ['FLAGS', 'OK', 'EXISTS', 'RECENT', '[READ-WRITE]', '[ALERT]']); {Do not Localize}
  2398. if LastCmdResult.Code = IMAP_OK then begin
  2399. //Put the parse in the IMAP Class and send the MB;
  2400. ParseSelectResult(FMailBox, LastCmdResult.Text);
  2401. FMailBox.Name := AMBName;
  2402. FConnectionState := csSelected;
  2403. case RetrieveOnSelect of
  2404. rsHeaders: RetrieveAllHeaders(FMailBox.MessageList);
  2405. rsMessages: RetrieveAllMsgs(FMailBox.MessageList);
  2406. end;
  2407. Result := True;
  2408. end;
  2409. end;
  2410. function TIdIMAP4.ExamineMailBox(const AMBName: String; AMB: TIdMailBox): Boolean;
  2411. begin
  2412. Result := False;
  2413. CheckConnectionState([csAuthenticated, csSelected]);
  2414. //TO DO: Check that Examine's expected responses really are STATUS, FLAGS and OK...
  2415. SendCmd(NewCmdCounter,
  2416. IMAP4Commands[cmdExamine] + ' "' + DoMUTFEncode(AMBName) + '"', {Do not Localize}
  2417. ['STATUS', 'FLAGS', 'OK', 'EXISTS', 'RECENT', '[READ-WRITE]', '[ALERT]']); {Do not Localize}
  2418. if LastCmdResult.Code = IMAP_OK then begin
  2419. ParseSelectResult(AMB, LastCmdResult.Text);
  2420. AMB.Name := AMBName;
  2421. FConnectionState := csSelected;
  2422. Result := True;
  2423. end;
  2424. end;
  2425. function TIdIMAP4.CloseMailBox: Boolean;
  2426. begin
  2427. Result := False;
  2428. CheckConnectionState(csSelected);
  2429. SendCmd(NewCmdCounter, IMAP4Commands[cmdClose], []);
  2430. if LastCmdResult.Code = IMAP_OK then begin
  2431. MailBox.Clear;
  2432. FConnectionState := csAuthenticated;
  2433. Result := True;
  2434. end;
  2435. end;
  2436. function TIdIMAP4.CreateMailBox(const AMBName: String): Boolean;
  2437. begin
  2438. {CC5: Recode to return False if NO returned rather than throwing an exception...}
  2439. Result := False;
  2440. CheckConnectionState([csAuthenticated, csSelected]);
  2441. {CC5: The NO response is typically due to Permission Denied}
  2442. SendCmd(NewCmdCounter, IMAP4Commands[cmdCreate] + ' "' + DoMUTFEncode(AMBName) + '"', []); {Do not Localize}
  2443. if LastCmdResult.Code = IMAP_OK then begin
  2444. Result := True;
  2445. end;
  2446. end;
  2447. function TIdIMAP4.DeleteMailBox(const AMBName: String): Boolean;
  2448. begin
  2449. {CC5: Recode to return False if NO returned rather than throwing an exception...}
  2450. Result := False;
  2451. CheckConnectionState([csAuthenticated, csSelected]);
  2452. {CC5: The NO response is typically due to Permission Denied}
  2453. SendCmd(NewCmdCounter, IMAP4Commands[cmdDelete] + ' "' + DoMUTFEncode(AMBName) + '"', []); {Do not Localize}
  2454. if LastCmdResult.Code = IMAP_OK then begin
  2455. Result := True;
  2456. end;
  2457. end;
  2458. function TIdIMAP4.RenameMailBox(const AOldMBName, ANewMBName: String): Boolean;
  2459. begin
  2460. {CC5: Recode to return False if NO returned rather than throwing an exception...}
  2461. Result := False;
  2462. CheckConnectionState([csAuthenticated, csSelected]);
  2463. {CC5: The NO response is typically due to Permission Denied}
  2464. SendCmd(NewCmdCounter,
  2465. IMAP4Commands[cmdRename] + ' "' + DoMUTFEncode(AOldMBName) + '" "' + DoMUTFEncode(ANewMBName) + '"', {Do not Localize}
  2466. []);
  2467. if LastCmdResult.Code = IMAP_OK then begin
  2468. Result := True;
  2469. end;
  2470. end;
  2471. function TIdIMAP4.StatusMailBox(const AMBName: String; AMB: TIdMailBox): Boolean;
  2472. {CC2: It is pointless calling StatusMailBox with AStatusDataItems set to []
  2473. because you are asking the IMAP server to update none of the status flags.
  2474. Instead, if called with no AStatusDataItems specified, use the standard flags
  2475. returned by SelectMailBox, which allows the user to easily check if the mailbox
  2476. has changed. Overload the functions, since AStatusDataItems cannot be set
  2477. to nil.}
  2478. var
  2479. AStatusDataItems: array[1..5] of TIdIMAP4StatusDataItem;
  2480. begin
  2481. AStatusDataItems[1] := mdMessages;
  2482. AStatusDataItems[2] := mdRecent;
  2483. AStatusDataItems[3] := mdUIDNext;
  2484. AStatusDataItems[4] := mdUIDValidity;
  2485. AStatusDataItems[5] := mdUnseen;
  2486. Result := StatusMailBox(AMBName, AMB, AStatusDataItems);
  2487. end;
  2488. function TIdIMAP4.StatusMailBox(const AMBName: String; AMB: TIdMailBox; const AStatusDataItems: array of TIdIMAP4StatusDataItem): Boolean;
  2489. var
  2490. LDataItems : string;
  2491. Ln : Integer;
  2492. begin
  2493. Result := False;
  2494. CheckConnectionState([csAuthenticated, csSelected]);
  2495. for Ln := Low(AStatusDataItems) to High(AStatusDataItems) do begin
  2496. case AStatusDataItems[Ln] of
  2497. mdMessages: LDataItems := LDataItems + IMAP4StatusDataItem[mdMessages] + ' '; {Do not Localize}
  2498. mdRecent: LDataItems := LDataItems + IMAP4StatusDataItem[mdRecent] + ' '; {Do not Localize}
  2499. mdUIDNext: LDataItems := LDataItems + IMAP4StatusDataItem[mdUIDNext] + ' '; {Do not Localize}
  2500. mdUIDValidity: LDataItems := LDataItems + IMAP4StatusDataItem[mdUIDValidity] + ' '; {Do not Localize}
  2501. mdUnseen: LDataItems := LDataItems + IMAP4StatusDataItem[mdUnseen] + ' '; {Do not Localize}
  2502. end;
  2503. end;
  2504. SendCmd(NewCmdCounter,
  2505. IMAP4Commands[cmdStatus] + ' "' + DoMUTFEncode(AMBName) + '" (' + Trim(LDataItems) + ')', {Do not Localize}
  2506. [IMAP4Commands[cmdStatus]]);
  2507. if LastCmdResult.Code = IMAP_OK then begin
  2508. ParseStatusResult(AMB, LastCmdResult.Text);
  2509. Result := True;
  2510. end;
  2511. end;
  2512. function TIdIMAP4.CheckMailBox: Boolean;
  2513. begin
  2514. Result := False;
  2515. CheckConnectionState(csSelected);
  2516. SendCmd(NewCmdCounter, IMAP4Commands[cmdCheck], []);
  2517. if LastCmdResult.Code = IMAP_OK then begin
  2518. Result := True;
  2519. end;
  2520. end;
  2521. function TIdIMAP4.ExpungeMailBox: Boolean;
  2522. begin
  2523. Result := False;
  2524. CheckConnectionState(csSelected);
  2525. SendCmd(NewCmdCounter, IMAP4Commands[cmdExpunge], []);
  2526. if LastCmdResult.Code = IMAP_OK then begin
  2527. ParseExpungeResult(FMailBox, LastCmdResult.Text);
  2528. Result := True;
  2529. end;
  2530. end;
  2531. //This function is needed because when using the regular DateToStr with dd/MMM/yyyy
  2532. //(which is the IMAP needed convension) may give the month as the local language
  2533. //three letter month instead of the English month needed.
  2534. function DateToIMAPDateStr (const ADate: TDateTime): String;
  2535. var
  2536. LDay, LMonth, LYear : Word;
  2537. begin
  2538. {Do not use the global settings from the system unit here because:
  2539. 1) It might not be thread safe
  2540. 2) Changing the settings could create problems for a user who's local date conventions
  2541. are diffrent than dd-mm-yyyy. Some people prefer mm-dd-yyy. Don't mess with a user's display settings.
  2542. 3) Using the display settings for dates may not always work as expected if a user
  2543. changes their settings at a time between whn you do it but before the date is formatted.
  2544. }
  2545. DecodeDate(ADate, LYear, LMonth, LDay);
  2546. Result := IndyFormat('%.2d-%s-%.4d', [LDay, UpperCase(monthnames[LMonth]), LYear]); {Do not Localize}
  2547. end;
  2548. function TIdIMAP4.InternalSearchMailBox(const ASearchInfo: array of TIdIMAP4SearchRec;
  2549. AUseUID: Boolean; const ACharSet: string): Boolean;
  2550. var
  2551. LCmd: String;
  2552. Ln : Integer;
  2553. LTextBuf: TIdBytes;
  2554. LCharSet: string;
  2555. LEncoding: IIdTextEncoding;
  2556. LLiteral: string;
  2557. LCanUseNonSyncLiteral, LNonSyncLiteralIsLimited, LUseNonSyncLiteral: Boolean;
  2558. LUseUTF8QuotedString: Boolean;
  2559. function RequiresEncoding(const S: String): Boolean;
  2560. var
  2561. I: Integer;
  2562. begin
  2563. Result := False;
  2564. for I := 1 to Length(S) do begin
  2565. if Ord(S[I]) > $7F then begin
  2566. Result := True;
  2567. Exit;
  2568. end;
  2569. end;
  2570. end;
  2571. function IsCharsetNeeded: Boolean;
  2572. var
  2573. I : Integer;
  2574. begin
  2575. Result := False;
  2576. for I := Low(ASearchInfo) to High(ASearchInfo) do begin
  2577. case ASearchInfo[I].SearchKey of
  2578. skBcc,
  2579. skBody,
  2580. skCc,
  2581. skFrom,
  2582. skHeader,
  2583. skSubject,
  2584. skText,
  2585. skTo,
  2586. skGmailRaw,
  2587. skGmailMsgID,
  2588. skGmailThreadID,
  2589. skGmailLabels:
  2590. if RequiresEncoding(ASearchInfo[I].Text) then begin
  2591. Result := True;
  2592. Exit;
  2593. end;
  2594. end;
  2595. end;
  2596. end;
  2597. begin
  2598. Result := False;
  2599. LTextBuf := nil; // keep the compiler happy
  2600. CheckConnectionState(csSelected);
  2601. LCmd := NewCmdCounter + ' '; {Do not Localize}
  2602. if AUseUID then begin
  2603. LCmd := LCmd + IMAP4Commands[cmdUID] + ' '; {Do not Localize}
  2604. end;
  2605. LCmd := LCmd + IMAP4Commands[cmdSearch];
  2606. if IsCharsetNeeded then begin
  2607. LNonSyncLiteralIsLimited := IsCapabilityListed('LITERAL-'); {Do not localize}
  2608. LCanUseNonSyncLiteral := LNonSyncLiteralIsLimited or
  2609. IsCapabilityListed('LITERAL+'); {Do not localize}
  2610. LUseUTF8QuotedString := IsCapabilityListed('UTF8=ACCEPT') or {Do not localize}
  2611. IsCapabilityListed('UTF8=ONLY') or {Do not localize}
  2612. IsCapabilityListed('UTF8=ALL'); {Do not localize}
  2613. if LUseUTF8QuotedString then begin
  2614. LCharSet := 'UTF-8'; {Do not Localize}
  2615. end else begin
  2616. LCharSet := Trim(ACharSet);
  2617. if LCharSet = '' then begin
  2618. LCharSet := 'UTF-8'; {Do not Localize}
  2619. end;
  2620. end;
  2621. LCmd := LCmd + ' CHARSET ' + LCharSet; {Do not localize}
  2622. LEncoding := CharsetToEncoding(LCharSet);
  2623. end else begin
  2624. // keep the compiler happy...
  2625. LNonSyncLiteralIsLimited := False;
  2626. LCanUseNonSyncLiteral := False;
  2627. LUseUTF8QuotedString := False;
  2628. end;
  2629. {CC3: Catch "Connection reset by peer"...}
  2630. try
  2631. //Remove anything that may be unprocessed from a previous (probably failed) command...
  2632. repeat
  2633. IOHandler.InputBuffer.Clear;
  2634. until not IOHandler.CheckForDataOnSource(MilliSecsToWaitToClearBuffer);
  2635. CheckConnected;
  2636. //IMAP.PrepareCmd(LCmd);
  2637. // now encode the search values. Most values are ASCII and do not need
  2638. // special encoding. For text values that do need to be encoded, IMAP
  2639. // string literals have to be used in order to support 8-bit octets in
  2640. // charset encoded payloads...
  2641. for Ln := Low(ASearchInfo) to High(ASearchInfo) do begin
  2642. case ASearchInfo[Ln].SearchKey of
  2643. skAll,
  2644. skAnswered,
  2645. skDeleted,
  2646. skDraft,
  2647. skFlagged,
  2648. skNew,
  2649. skNot,
  2650. skOld,
  2651. skOr,
  2652. skRecent,
  2653. skSeen,
  2654. skUnanswered,
  2655. skUndeleted,
  2656. skUndraft,
  2657. skUnflagged,
  2658. skUnKeyWord,
  2659. skUnseen:
  2660. LCmd := LCmd + ' ' + IMAP4SearchKeys[ASearchInfo[Ln].SearchKey]; {Do not Localize}
  2661. skHeader:
  2662. begin
  2663. // TODO: support RFC 5738 to allow for UTF-8 encoded quoted strings
  2664. if not RequiresEncoding(ASearchInfo[Ln].Text) then begin
  2665. LCmd := LCmd + ' ' + IMAP4SearchKeys[ASearchInfo[Ln].SearchKey] + ' ' + ASearchInfo[Ln].FieldName + ' ' + IMAPQuotedStr(ASearchInfo[Ln].Text); {Do not Localize}
  2666. end else
  2667. begin
  2668. if LUseUTF8QuotedString then begin
  2669. LCmd := LCmd + ' ' + IMAP4SearchKeys[ASearchInfo[Ln].SearchKey] + ' ' + ASearchInfo[Ln].FieldName + ' *'; {Do not Localize}
  2670. IOHandler.Write(LCmd);
  2671. IOHandler.Write(IMAPQuotedStr(ASearchInfo[Ln].Text), LEncoding{$IFDEF STRING_IS_ANSI}, IndyTextEncoding_OSDefault{$ENDIF});
  2672. end else
  2673. begin
  2674. LTextBuf := ToBytes(ASearchInfo[Ln].Text, LEncoding{$IFDEF STRING_IS_ANSI}, IndyTextEncoding_OSDefault{$ENDIF});
  2675. LUseNonSyncLiteral := LCanUseNonSyncLiteral and ((not LNonSyncLiteralIsLimited) or (Length(LTextBuf) <= 4096));
  2676. if LUseNonSyncLiteral then begin
  2677. LLiteral := '{' + IntToStr(Length(LTextBuf)) + '+}'; {Do not Localize}
  2678. end else begin
  2679. LLiteral := '{' + IntToStr(Length(LTextBuf)) + '}'; {Do not Localize}
  2680. end;
  2681. LCmd := LCmd + ' ' + IMAP4SearchKeys[ASearchInfo[Ln].SearchKey] + ' ' + ASearchInfo[Ln].FieldName + ' ' + LLiteral; {Do not Localize}
  2682. IOHandler.WriteLn(LCmd);
  2683. if not LUseNonSyncLiteral then begin
  2684. if GetInternalResponse(LastCmdCounter, [IMAP4Commands[cmdSearch], IMAP4Commands[cmdUID]], False) <> IMAP_CONT then begin
  2685. RaiseExceptionForLastCmdResult;
  2686. end;
  2687. end;
  2688. IOHandler.Write(LTextBuf);
  2689. end;
  2690. LTextBuf := nil;
  2691. LCmd := '';
  2692. end;
  2693. end;
  2694. skKeyword,
  2695. skUID:
  2696. LCmd := LCmd + ' ' + IMAP4SearchKeys[ASearchInfo[Ln].SearchKey] + ' ' + ASearchInfo[Ln].Text; {Do not Localize}
  2697. skBcc,
  2698. skBody,
  2699. skCc,
  2700. skFrom,
  2701. skSubject,
  2702. skText,
  2703. skTo,
  2704. skGmailRaw,
  2705. skGmailMsgID,
  2706. skGmailThreadID,
  2707. skGmailLabels:
  2708. begin
  2709. // TODO: support RFC 5738 to allow for UTF-8 encoded quoted strings
  2710. if not RequiresEncoding(ASearchInfo[Ln].Text) then begin
  2711. LCmd := LCmd + ' ' + IMAP4SearchKeys[ASearchInfo[Ln].SearchKey] + ' ' + IMAPQuotedStr(ASearchInfo[Ln].Text); {Do not Localize}
  2712. end else
  2713. begin
  2714. if LUseUTF8QuotedString then begin
  2715. LCmd := LCmd + ' ' + IMAP4SearchKeys[ASearchInfo[Ln].SearchKey] + ' *'; {Do not Localize}
  2716. IOHandler.Write(LCmd);
  2717. IOHandler.Write(IMAPQuotedStr(ASearchInfo[Ln].Text), LEncoding{$IFDEF STRING_IS_ANSI}, IndyTextEncoding_OSDefault{$ENDIF});
  2718. end else
  2719. begin
  2720. LTextBuf := ToBytes(ASearchInfo[Ln].Text, LEncoding{$IFDEF STRING_IS_ANSI}, IndyTextEncoding_OSDefault{$ENDIF});
  2721. LUseNonSyncLiteral := LCanUseNonSyncLiteral and ((not LNonSyncLiteralIsLimited) or (Length(LTextBuf) <= 4096));
  2722. if LUseNonSyncLiteral then begin
  2723. LLiteral := '{' + IntToStr(Length(LTextBuf)) + '+}'; {Do not Localize}
  2724. end else begin
  2725. LLiteral := '{' + IntToStr(Length(LTextBuf)) + '}'; {Do not Localize}
  2726. end;
  2727. LCmd := LCmd + ' ' + IMAP4SearchKeys[ASearchInfo[Ln].SearchKey] + ' ' + LLiteral; {Do not Localize}
  2728. IOHandler.WriteLn(LCmd);
  2729. if not LUseNonSyncLiteral then begin
  2730. if GetInternalResponse(LastCmdCounter, [IMAP4Commands[cmdSearch], IMAP4Commands[cmdUID]], False) <> IMAP_CONT then begin
  2731. RaiseExceptionForLastCmdResult;
  2732. end;
  2733. end;
  2734. IOHandler.Write(LTextBuf);
  2735. end;
  2736. LTextBuf := nil;
  2737. LCmd := '';
  2738. end;
  2739. end;
  2740. skBefore,
  2741. skOn,
  2742. skSentBefore,
  2743. skSentOn,
  2744. skSentSince,
  2745. skSince:
  2746. LCmd := LCmd + ' ' + IMAP4SearchKeys[ASearchInfo[Ln].SearchKey] + ' ' + DateToIMAPDateStr(ASearchInfo[Ln].Date); {Do not Localize}
  2747. skLarger,
  2748. skSmaller:
  2749. LCmd := LCmd + ' ' + IMAP4SearchKeys[ASearchInfo[Ln].SearchKey] + ' ' + IntToStr(ASearchInfo[Ln].Size); {Do not Localize}
  2750. end;
  2751. end;
  2752. if LCmd <> '' then begin
  2753. IOHandler.Write(LCmd);
  2754. end;
  2755. // After we send the last of the data, we need to send an EXTRA CRLF to terminates the SEARCH command...
  2756. IOHandler.WriteLn;
  2757. if GetInternalResponse(LastCmdCounter, [IMAP4Commands[cmdSearch], IMAP4Commands[cmdUID]], False) = IMAP_OK then begin
  2758. ParseSearchResult(FMailBox, LastCmdResult.Text);
  2759. Result := True;
  2760. end;
  2761. except
  2762. on E: EIdSocketError do begin
  2763. if ((E.LastError = Id_WSAECONNABORTED) or (E.LastError = Id_WSAECONNRESET)) then begin
  2764. FConnectionState := csUnexpectedlyDisconnected;
  2765. end;
  2766. raise;
  2767. end;
  2768. end;
  2769. end;
  2770. function TIdIMAP4.SearchMailBox(const ASearchInfo: array of TIdIMAP4SearchRec;
  2771. const ACharSet: string = ''): Boolean;
  2772. begin
  2773. Result := InternalSearchMailBox(ASearchInfo, False, ACharSet);
  2774. end;
  2775. function TIdIMAP4.UIDSearchMailBox(const ASearchInfo: array of TIdIMAP4SearchRec;
  2776. const ACharSet: string = '') : Boolean;
  2777. begin
  2778. Result := InternalSearchMailBox(ASearchInfo, True, ACharSet);
  2779. end;
  2780. function TIdIMAP4.SubscribeMailBox(const AMBName: String): Boolean;
  2781. begin
  2782. Result := False;
  2783. CheckConnectionState([csAuthenticated, csSelected]);
  2784. SendCmd(NewCmdCounter,
  2785. IMAP4Commands[cmdSubscribe] + ' "' + DoMUTFEncode(AMBName) + '"', {Do not Localize}
  2786. []);
  2787. if LastCmdResult.Code = IMAP_OK then begin
  2788. Result := True;
  2789. end;
  2790. end;
  2791. function TIdIMAP4.UnsubscribeMailBox(const AMBName: String): Boolean;
  2792. begin
  2793. Result := False;
  2794. CheckConnectionState([csAuthenticated, csSelected]);
  2795. SendCmd(NewCmdCounter,
  2796. IMAP4Commands[cmdUnsubscribe] + ' "' + DoMUTFEncode(AMBName) + '"', {Do not Localize}
  2797. []);
  2798. if LastCmdResult.Code = IMAP_OK then begin
  2799. Result := True;
  2800. end;
  2801. end;
  2802. function TIdIMAP4.ListMailBoxes(AMailBoxList: TStrings): Boolean;
  2803. begin
  2804. Result := False;
  2805. {CC2: This is one of the few cases where the server can return only "OK completed"
  2806. meaning that the user has no mailboxes.}
  2807. CheckConnectionState([csAuthenticated, csSelected]);
  2808. SendCmd(NewCmdCounter, IMAP4Commands[cmdList] + ' "" *', [IMAP4Commands[cmdList]]); {Do not Localize}
  2809. if LastCmdResult.Code = IMAP_OK then begin
  2810. ParseListResult(AMailBoxList, LastCmdResult.Text);
  2811. Result := True;
  2812. end;
  2813. end;
  2814. function TIdIMAP4.ListInferiorMailBoxes(AMailBoxList, AInferiorMailBoxList: TStrings): Boolean;
  2815. var
  2816. Ln : Integer;
  2817. LAuxMailBoxList : TStringList;
  2818. begin
  2819. Result := False;
  2820. {CC2: This is one of the few cases where the server can return only "OK completed"
  2821. meaning that the user has no inferior mailboxes.}
  2822. CheckConnectionState([csAuthenticated, csSelected]);
  2823. if AMailBoxList = nil then begin
  2824. SendCmd(NewCmdCounter, IMAP4Commands[cmdList] + ' "" %', [IMAP4Commands[cmdList]]); {Do not Localize}
  2825. if LastCmdResult.Code = IMAP_OK then begin
  2826. ParseListResult(AInferiorMailBoxList, LastCmdResult.Text);
  2827. //The INBOX mailbox is added because I think it always has to exist
  2828. //in an IMAP4 account (default) but it does not list it in this command.
  2829. Result := True;
  2830. end;
  2831. end else begin
  2832. LAuxMailBoxList := TStringList.Create;
  2833. try
  2834. AInferiorMailBoxList.Clear;
  2835. for Ln := 0 to AMailBoxList.Count - 1 do begin
  2836. SendCmd(NewCmdCounter,
  2837. IMAP4Commands[cmdList] + ' "" "' + DoMUTFEncode(AMailBoxList[Ln]) + FMailBoxSeparator + '%"', {Do not Localize}
  2838. [IMAP4Commands[cmdList]]);
  2839. if LastCmdResult.Code = IMAP_OK then begin
  2840. ParseListResult(LAuxMailBoxList, LastCmdResult.Text);
  2841. AInferiorMailBoxList.AddStrings(LAuxMailBoxList);
  2842. Result := True;
  2843. end else begin
  2844. Break;
  2845. end;
  2846. end;
  2847. finally
  2848. FreeAndNil(LAuxMailBoxList);
  2849. end;
  2850. end;
  2851. end;
  2852. function TIdIMAP4.ListSubscribedMailBoxes(AMailBoxList: TStrings): Boolean;
  2853. begin
  2854. {CC2: This is one of the few cases where the server can return only "OK completed"
  2855. meaning that the user has no subscribed mailboxes.}
  2856. Result := False;
  2857. CheckConnectionState([csAuthenticated, csSelected]);
  2858. SendCmd(NewCmdCounter, IMAP4Commands[cmdLSub] + ' "" *', [IMAP4Commands[cmdList], IMAP4Commands[cmdLSub]]); {Do not Localize}
  2859. if LastCmdResult.Code = IMAP_OK then begin
  2860. // ds - fixed bug # 506026
  2861. ParseLSubResult(AMailBoxList, LastCmdResult.Text);
  2862. Result := True;
  2863. end;
  2864. end;
  2865. function TIdIMAP4.StoreFlags(const AMsgNumList: array of UInt32;
  2866. const AStoreMethod: TIdIMAP4StoreDataItem; const AFlags: TIdMessageFlagsSet): Boolean;
  2867. begin
  2868. Result := StoreValue(AMsgNumList, AStoreMethod, IMAP4FetchDataItem[fdFlags], MessageFlagSetToStr(AFlags));
  2869. end;
  2870. function TIdIMAP4.StoreValue(const AMsgNumList: array of UInt32;
  2871. const AStoreMethod: TIdIMAP4StoreDataItem; const AField, AValue: String): Boolean;
  2872. var
  2873. LDataItem,
  2874. LMsgSet: string;
  2875. begin
  2876. Result := False;
  2877. if Length(AMsgNumList) > 0 then begin
  2878. LMsgSet := ArrayToNumberStr(AMsgNumList);
  2879. case AStoreMethod of
  2880. sdReplace, sdReplaceSilent:
  2881. LDataItem := AField+'.SILENT'; {Do not Localize}
  2882. sdAdd, sdAddSilent:
  2883. LDataItem := '+'+AField+'.SILENT'; {Do not Localize}
  2884. sdRemove, sdRemoveSilent:
  2885. LDataItem := '-'+AField+'.SILENT'; {Do not Localize}
  2886. else
  2887. Exit;
  2888. end;
  2889. CheckConnectionState(csSelected);
  2890. SendCmd(NewCmdCounter,
  2891. IMAP4Commands[cmdStore] + ' ' + LMsgSet + ' ' + LDataItem + ' (' + AValue + ')', {Do not Localize}
  2892. []);
  2893. if LastCmdResult.Code = IMAP_OK then begin
  2894. Result := True;
  2895. end;
  2896. end;
  2897. end;
  2898. function TIdIMAP4.UIDStoreFlags(const AMsgUID: String;
  2899. const AStoreMethod: TIdIMAP4StoreDataItem; const AFlags: TIdMessageFlagsSet): Boolean;
  2900. begin
  2901. Result := UIDStoreValue(AMsgUID, AStoreMethod, IMAP4FetchDataItem[fdFlags], MessageFlagSetToStr(AFlags));
  2902. end;
  2903. function TIdIMAP4.UIDStoreFlags(const AMsgUIDList: array of String;
  2904. const AStoreMethod: TIdIMAP4StoreDataItem; const AFlags: TIdMessageFlagsSet): Boolean;
  2905. begin
  2906. Result := UIDStoreValue(AMsgUIDList, AStoreMethod, IMAP4FetchDataItem[fdFlags], MessageFlagSetToStr(AFlags));
  2907. end;
  2908. function TIdIMAP4.UIDStoreValue(const AMsgUID: String;
  2909. const AStoreMethod: TIdIMAP4StoreDataItem; const AField, AValue: string): Boolean;
  2910. var
  2911. LDataItem : String;
  2912. begin
  2913. Result := False;
  2914. IsUIDValid(AMsgUID);
  2915. case AStoreMethod of
  2916. sdReplace, sdReplaceSilent:
  2917. LDataItem := AField+'.SILENT'; {Do not Localize}
  2918. sdAdd, sdAddSilent:
  2919. LDataItem := '+'+AField+'.SILENT'; {Do not localize}
  2920. sdRemove, sdRemoveSilent:
  2921. LDataItem := '-'+AField+'.SILENT'; {Do not Localize}
  2922. else
  2923. Exit;
  2924. end;
  2925. CheckConnectionState(csSelected);
  2926. SendCmd(NewCmdCounter,
  2927. IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdStore] + ' ' + AMsgUID + ' ' + LDataItem + ' (' + AValue + ')', {Do not Localize}
  2928. []);
  2929. if LastCmdResult.Code = IMAP_OK then begin
  2930. Result := True;
  2931. end;
  2932. end;
  2933. function TIdIMAP4.UIDStoreValue(const AMsgUIDList: array of String;
  2934. const AStoreMethod: TIdIMAP4StoreDataItem; const AField, AValue: String): Boolean;
  2935. var
  2936. LDataItem,
  2937. LMsgSet : String;
  2938. LN: integer;
  2939. begin
  2940. Result := False;
  2941. LMsgSet := '';
  2942. for LN := 0 to Length(AMsgUIDList) -1 do begin
  2943. IsUIDValid(AMsgUIDList[LN]);
  2944. if LN > 0 then begin
  2945. LMsgSet := LMsgSet + ','; {Do not Localize}
  2946. end;
  2947. LMsgSet := LMsgSet+AMsgUIDList[LN];
  2948. end;
  2949. case AStoreMethod of
  2950. sdReplace, sdReplaceSilent:
  2951. LDataItem := AField+'.SILENT'; {Do not Localize}
  2952. sdAdd, sdAddSilent:
  2953. LDataItem := '+'+AField+'.SILENT'; {Do not Localize}
  2954. sdRemove, sdRemoveSilent:
  2955. LDataItem := '-'+AField+'.SILENT'; {Do not Localize}
  2956. else
  2957. Exit;
  2958. end;
  2959. CheckConnectionState(csSelected);
  2960. SendCmd(NewCmdCounter,
  2961. IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdStore] + ' ' + LMsgSet + ' ' + LDataItem + ' (' + AValue + ')', {Do not Localize}
  2962. []);
  2963. if LastCmdResult.Code = IMAP_OK then begin
  2964. Result := True;
  2965. end;
  2966. end;
  2967. function TIdIMAP4.CopyMsgs(const AMsgNumList: array of UInt32; const AMBName: String): Boolean;
  2968. var
  2969. LMsgSet : String;
  2970. begin
  2971. Result := False;
  2972. if Length(AMsgNumList) > 0 then begin
  2973. LMsgSet := ArrayToNumberStr ( AMsgNumList );
  2974. CheckConnectionState(csSelected);
  2975. SendCmd(NewCmdCounter, IMAP4Commands[cmdCopy] + ' ' + LMsgSet + ' "' + DoMUTFEncode(AMBName) + '"', []); {Do not Localize}
  2976. if LastCmdResult.Code = IMAP_OK then begin
  2977. Result := True;
  2978. end;
  2979. end;
  2980. end;
  2981. function TIdIMAP4.UIDCopyMsgs(const AMsgUIDList: TStrings; const AMBName: String): Boolean;
  2982. var
  2983. LCmd : String;
  2984. LN: integer;
  2985. begin
  2986. Result := False;
  2987. if AMsgUIDList.Count > 0 then begin
  2988. LCmd := IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdCopy] + ' '; {Do not Localize}
  2989. for LN := 0 to AMsgUIDList.Count-1 do begin
  2990. IsUIDValid(AMsgUIDList.Strings[LN]);
  2991. if LN = 0 then begin
  2992. LCmd := LCmd + AMsgUIDList.Strings[LN];
  2993. end else begin
  2994. LCmd := LCmd + ',' + AMsgUIDList.Strings[LN]; {Do not Localize}
  2995. end;
  2996. end;
  2997. LCmd := LCmd + ' "' + DoMUTFEncode(AMBName) + '"'; {Do not Localize}
  2998. CheckConnectionState(csSelected);
  2999. SendCmd(NewCmdCounter, LCmd, []);
  3000. if LastCmdResult.Code = IMAP_OK then begin
  3001. Result := True;
  3002. end;
  3003. end;
  3004. end;
  3005. function TIdIMAP4.CopyMsg(const AMsgNum: UInt32; const AMBName: String): Boolean;
  3006. //Copies a message from the current selected mailbox to the specified mailbox.
  3007. begin
  3008. Result := False;
  3009. IsNumberValid(AMsgNum);
  3010. CheckConnectionState(csSelected);
  3011. SendCmd(NewCmdCounter, IMAP4Commands[cmdCopy] + ' ' + IntToStr(Int64(AMsgNum)) + ' "' + DoMUTFEncode(AMBName) + '"', []); {Do not Localize}
  3012. if LastCmdResult.Code = IMAP_OK then begin
  3013. Result := True;
  3014. end;
  3015. end;
  3016. function TIdIMAP4.UIDCopyMsg(const AMsgUID: String; const AMBName: String): Boolean;
  3017. //Copies a message from the current selected mailbox to the specified mailbox.
  3018. begin
  3019. Result := False;
  3020. IsUIDValid(AMsgUID);
  3021. CheckConnectionState(csSelected);
  3022. SendCmd(NewCmdCounter, IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdCopy] + ' ' + AMsgUID + ' "' + DoMUTFEncode(AMBName) + '"', []); {Do not Localize}
  3023. if LastCmdResult.Code = IMAP_OK then begin
  3024. Result := True;
  3025. end;
  3026. end;
  3027. function TIdIMAP4.AppendMsg(const AMBName: String; AMsg: TIdMessage; const AFlags: TIdMessageFlagsSet = [];
  3028. const AInternalDateTimeGMT: TDateTime = 0.0): Boolean;
  3029. begin
  3030. Result := AppendMsg(AMBName, AMsg, nil, AFlags, AInternalDateTimeGMT);
  3031. end;
  3032. function TIdIMAP4.AppendMsg(const AMBName: String; AMsg: TIdMessage; AAlternativeHeaders: TIdHeaderList; const AFlags: TIdMessageFlagsSet = [];
  3033. const AInternalDateTimeGMT: TDateTime = 0.0): Boolean;
  3034. var
  3035. LFlags,
  3036. LMsgLiteral, LDateTime: String;
  3037. LUseNonSyncLiteral: Boolean;
  3038. Ln: Integer;
  3039. LCmd: string;
  3040. LLength: TIdStreamSize;
  3041. LHeadersToSend, LCopiedHeaders: TIdHeaderList;
  3042. LHeadersAsString: string;
  3043. LHeadersAsBytes: TIdBytes;
  3044. LMimeBoundary: string;
  3045. LStream: TStream;
  3046. LHelper: TIdIMAP4WorkHelper;
  3047. begin
  3048. Result := False;
  3049. LHeadersasBytes := nil; // keep the compiler happy
  3050. CheckConnectionState([csAuthenticated, csSelected]);
  3051. if Length(AMBName) <> 0 then begin
  3052. LFlags := MessageFlagSetToStr(AFlags);
  3053. if LFlags <> '' then begin {Do not Localize}
  3054. LFlags := '(' + LFlags + ')'; {Do not Localize}
  3055. end;
  3056. if AInternalDateTimeGMT <> 0.0 then begin
  3057. // even though flags are optional, some servers, such as GMail, will
  3058. // fail to parse the command correctly if no flags are specified in
  3059. // front of the internal date...
  3060. if LFlags = '' then begin
  3061. LFlags := '()'; // TODO: should 'NIL' be used instead? {Do not Localize}
  3062. end;
  3063. LDateTime := '"' + DateTimeGMTToImapStr(AInternalDateTimeGMT) + '"'; {do not localize}
  3064. end;
  3065. {CC8: In Indy 10, we want to support attachments (previous versions did
  3066. not). The problem is that we have to know the size of the message
  3067. in advance of sending it for the IMAP APPEND command.
  3068. The problem is that there is no way of calculating the size of a
  3069. message without generating the encoded message. Therefore, write the
  3070. message out to a temporary stream, and then get the size of the data,
  3071. which with a bit of adjustment, will give us the size of the message
  3072. we will send.
  3073. The "adjustment" is necessary because SaveToStream generates it's own
  3074. headers, which will be different to both the ones in AMsg and
  3075. AAlternativeHeaders, in the Date header, if nothing else.}
  3076. LStream := TMemoryStream.Create;
  3077. try
  3078. {RLebeau 04/02/2014: if the user passed in AMsg.LastGeneratedHeaders
  3079. or AMsg.Headers as AAlternativeHeaders, then assume the user wants to
  3080. use the headers that existed prior to AMsg being saved below, which
  3081. may create new header values...}
  3082. LCopiedHeaders := nil;
  3083. try
  3084. if (AAlternativeHeaders <> nil) and
  3085. ((AAlternativeHeaders = AMsg.LastGeneratedHeaders) or (AAlternativeHeaders = AMsg.Headers)) then
  3086. begin
  3087. LCopiedHeaders := TIdHeaderList.Create(QuoteRFC822);
  3088. LCopiedHeaders.Assign(AAlternativeHeaders);
  3089. end;
  3090. {RLebeau 12/09/2012: this is a workaround to a design limitation in
  3091. TIdMessage.SaveToStream(). It always outputs the stream data in an
  3092. escaped format using SMTP dot transparency, but that is not used in
  3093. IMAP! Until this design is corrected, we have to use a workaround
  3094. for now. This logic is copied from TIdMessage.SaveToSteam() and
  3095. slightly tweaked...}
  3096. //AMsg.SaveToStream(LStream);
  3097. {$IFDEF HAS_CLASS_HELPER}
  3098. AMsg.SaveToStream(LStream, False, False);
  3099. {$ELSE}
  3100. TIdMessageHelper_SaveToStream(AMsg, LStream, False, False);
  3101. {$ENDIF}
  3102. LStream.Position := 0;
  3103. {We are better off making up the headers as a string first rather than predicting
  3104. its length. Slightly wasteful of memory, but it will not take up much.}
  3105. LHeadersAsString := '';
  3106. {Make sure the headers we end up using have the correct MIME boundary actually
  3107. used in the message being saved...}
  3108. if AMsg.NoEncode then begin
  3109. LMimeBoundary := AMsg.Headers.Params['Content-Type', 'boundary']; {do not localize}
  3110. end else begin
  3111. LMimeBoundary := AMsg.LastGeneratedHeaders.Params['Content-Type', 'boundary']; {do not localize}
  3112. end;
  3113. if (LCopiedHeaders = nil) and (AAlternativeHeaders <> nil) then begin
  3114. if AAlternativeHeaders.Params['Content-Type', 'boundary'] <> LMimeBoundary then {do not localize}
  3115. begin
  3116. LCopiedHeaders := TIdHeaderList.Create(QuoteRFC822);
  3117. LCopiedHeaders.Assign(AAlternativeHeaders);
  3118. end;
  3119. end;
  3120. // TODO: if AInternalDateTimeGMT is not 0.0, should we adjust the 'Date' header of the sent email to match?
  3121. if LCopiedHeaders <> nil then begin
  3122. {Use the copied headers that the user has passed to us, adjusting the MIME boundary...}
  3123. LCopiedHeaders.Params['Content-Type', 'boundary'] := LMimeBoundary; {do not localize}
  3124. LHeadersToSend := LCopiedHeaders;
  3125. end
  3126. else if AAlternativeHeaders <> nil then begin
  3127. {Use the headers that the user has passed to us...}
  3128. LHeadersToSend := AAlternativeHeaders;
  3129. end
  3130. else if AMsg.NoEncode then begin
  3131. {Use the headers that are in the message AMsg...}
  3132. LHeadersToSend := AMsg.Headers;
  3133. end else begin
  3134. {Use the headers that SaveToStream() generated...}
  3135. LHeadersToSend := AMsg.LastGeneratedHeaders;
  3136. end;
  3137. // not using LHeadersToSend.Text because it uses platform-specific line breaks
  3138. for Ln := 0 to Pred(LHeadersToSend.Count) do begin
  3139. LHeadersAsString := LHeadersAsString + LHeadersToSend[Ln] + EOL;
  3140. end;
  3141. finally
  3142. LCopiedHeaders.Free;
  3143. end;
  3144. LHeadersAsBytes := ToBytes(LHeadersAsString + EOL);
  3145. LHeadersAsString := '';
  3146. {Get the size of the headers we are sending...}
  3147. repeat until Length(ReadLnFromStream(LStream)) = 0;
  3148. {We have to subtract the size of the headers in the file and
  3149. add back the size of the headers we are to use
  3150. to get the size of the message we are going to send...}
  3151. LLength := Length(LHeadersAsBytes) + (LStream.Size - LStream.Position);
  3152. // TODO: check the server's APPENDLIMIT capability (RFC 7889) to see if
  3153. // LLength is too large, and if so then we can bail out here...
  3154. if IsCapabilityListed('LITERAL-') then begin {Do not Localize}
  3155. LUseNonSyncLiteral := LLength <= 4096;
  3156. end else begin
  3157. LUseNonSyncLiteral := IsCapabilityListed('LITERAL+'); {Do not Localize}
  3158. end;
  3159. if LUseNonSyncLiteral then begin
  3160. LMsgLiteral := '{' + IntToStr ( LLength ) + '+}'; {Do not Localize}
  3161. end else begin
  3162. LMsgLiteral := '{' + IntToStr ( LLength ) + '}'; {Do not Localize}
  3163. end;
  3164. {CC: The original code sent the APPEND command first, then followed it with the
  3165. message. Maybe this worked with some server, but most send a
  3166. response like "+ Send the additional command..." between the two,
  3167. which was not expected by the client and caused an exception.}
  3168. //CC: Added double quotes around mailbox name, else mailbox names with spaces will cause server parsing error
  3169. LCmd := IMAP4Commands[cmdAppend] + ' "' + DoMUTFEncode(AMBName) + '" '; {Do not Localize}
  3170. if Length(LFlags) <> 0 then begin
  3171. LCmd := LCmd + LFlags + ' '; {Do not Localize}
  3172. end;
  3173. if Length(LDateTime) <> 0 then begin
  3174. LCmd := LCmd + LDateTime + ' '; {Do not Localize}
  3175. end;
  3176. LCmd := LCmd + LMsgLiteral; {Do not Localize}
  3177. {CC3: Catch "Connection reset by peer"...}
  3178. try
  3179. if LUseNonSyncLiteral then begin
  3180. {Send the APPEND command and the message immediately, no + response needed...}
  3181. IOHandler.WriteLn(NewCmdCounter + ' ' + LCmd);
  3182. end else begin
  3183. {Try sending the APPEND command, get the + response, then send the message...}
  3184. SendCmd(NewCmdCounter, LCmd, []);
  3185. if LastCmdResult.Code <> IMAP_CONT then begin
  3186. Exit;
  3187. end;
  3188. end;
  3189. LHelper := TIdIMAP4WorkHelper.Create(Self);
  3190. try
  3191. IOHandler.Write(LHeadersAsBytes);
  3192. {RLebeau: passing -1 to TIdIOHandler.Write(TStream) will send the
  3193. rest of the stream starting at its current Position...}
  3194. IOHandler.Write(LStream, -1, False);
  3195. finally
  3196. FreeAndNil(LHelper);
  3197. end;
  3198. {WARNING: After we send the message (which should be exactly
  3199. LLength bytes long), we need to send an EXTRA CRLF which is in
  3200. addition to the count in LLength, because this CRLF terminates the
  3201. APPEND command...}
  3202. IOHandler.WriteLn;
  3203. if GetInternalResponse(LastCmdCounter, [IMAP4Commands[cmdAppend]], False) = IMAP_OK then begin
  3204. Result := True;
  3205. end;
  3206. except
  3207. on E: EIdSocketError do begin
  3208. if ((E.LastError = Id_WSAECONNABORTED) or (E.LastError = Id_WSAECONNRESET)) then begin
  3209. FConnectionState := csUnexpectedlyDisconnected;
  3210. end;
  3211. raise;
  3212. end;
  3213. end;
  3214. finally
  3215. LStream.Free;
  3216. end;
  3217. end;
  3218. end;
  3219. function TIdIMAP4.AppendMsgNoEncodeFromFile(const AMBName: String; ASourceFile: string; const AFlags: TIdMessageFlagsSet = [];
  3220. const AInternalDateTimeGMT: TDateTime = 0.0): Boolean;
  3221. var
  3222. LSourceStream: TIdReadFileExclusiveStream;
  3223. begin
  3224. LSourceStream := TIdReadFileExclusiveStream.Create(ASourceFile);
  3225. try
  3226. Result := AppendMsgNoEncodeFromStream(AMBName, LSourceStream, AFlags, AInternalDateTimeGMT);
  3227. finally
  3228. FreeAndNil(LSourceStream);
  3229. end;
  3230. end;
  3231. function TIdIMAP4.AppendMsgNoEncodeFromStream(const AMBName: String; AStream: TStream; const AFlags: TIdMessageFlagsSet = [];
  3232. const AInternalDateTimeGMT: TDateTime = 0.0): Boolean;
  3233. const
  3234. cTerminator: array[0..4] of Byte = (13, 10, Ord('.'), 13, 10);
  3235. var
  3236. LFlags, LDateTime, LMsgLiteral: String;
  3237. LUseNonSyncLiteral: Boolean;
  3238. I: Integer;
  3239. LFound: Boolean;
  3240. LCmd: string;
  3241. LLength: TIdStreamSize;
  3242. LTempStream: TMemoryStream;
  3243. LHelper: TIdIMAP4WorkHelper;
  3244. LBuf: TIdBytes;
  3245. begin
  3246. Result := False;
  3247. CheckConnectionState([csAuthenticated, csSelected]);
  3248. if Length(AMBName) <> 0 then begin
  3249. LFlags := MessageFlagSetToStr(AFlags);
  3250. if LFlags <> '' then begin {Do not Localize}
  3251. LFlags := '(' + LFlags + ')'; {Do not Localize}
  3252. end;
  3253. if AInternalDateTimeGMT <> 0.0 then begin
  3254. // even though flags are optional, some servers, such as GMail, will
  3255. // fail to parse the command correctly if no flags are specified in
  3256. // front of the internal date...
  3257. if LFlags = '' then begin
  3258. LFlags := '()'; // TODO: should 'NIL' be used instead? {Do not Localize}
  3259. end;
  3260. LDateTime := '"' + DateTimeGMTToImapStr(AInternalDateTimeGMT) + '"'; {Do not Localize}
  3261. end;
  3262. LLength := AStream.Size - AStream.Position;
  3263. if LLength < 0 then begin
  3264. LLength := 0;
  3265. end;
  3266. LTempStream := TMemoryStream.Create;
  3267. try
  3268. //Hunt for CRLF.CRLF, if present then we need to remove it...
  3269. // RLebeau: why? The lines of the message data are not required to be
  3270. // dot-prefixed like in SMTP, so why should TIdIMAP care about any
  3271. // termination sequences in the file? We are telling the server exactly
  3272. // how large the message actually is. What if the message data actually
  3273. // contains a valid line with just a dot on it? This code would end up
  3274. // truncating the message that is stored on the server...
  3275. SetLength(LBuf, 5);
  3276. if LLength > 0 then begin
  3277. LTempStream.CopyFrom(AStream, LLength);
  3278. LTempStream.Position := 0;
  3279. end;
  3280. repeat
  3281. if TIdStreamHelper.ReadBytes(LTempStream, LBuf, 5) < 5 then begin
  3282. Break;
  3283. end;
  3284. LFound := True;
  3285. for I := 0 to 4 do begin
  3286. if LBuf[I] <> cTerminator[I] then begin
  3287. LFound := False;
  3288. Break;
  3289. end;
  3290. end;
  3291. if LFound then begin
  3292. LLength := LTempStream.Position-5;
  3293. Break;
  3294. end;
  3295. TIdStreamHelper.Seek(LTempStream, -4, soCurrent);
  3296. until False;
  3297. if IsCapabilityListed('LITERAL-') then begin {Do not Localize}
  3298. LUseNonSyncLiteral := LLength <= 4096;
  3299. end else begin
  3300. LUseNonSyncLiteral := IsCapabilityListed('LITERAL+'); {Do not Localize}
  3301. end;
  3302. if LUseNonSyncLiteral then begin
  3303. LMsgLiteral := '{' + IntToStr(LLength) + '+}'; {Do not Localize}
  3304. end else begin
  3305. LMsgLiteral := '{' + IntToStr(LLength) + '}'; {Do not Localize}
  3306. end;
  3307. {CC: The original code sent the APPEND command first, then followed it with the
  3308. message. Maybe this worked with some server, but most send a
  3309. response like "+ Send the additional command..." between the two,
  3310. which was not expected by the client and caused an exception.}
  3311. //CC: Added double quotes around mailbox name, else mailbox names with spaces will cause server parsing error
  3312. LCmd := IMAP4Commands[cmdAppend] + ' "' + DoMUTFEncode(AMBName) + '" '; {Do not Localize}
  3313. if Length(LFlags) <> 0 then begin
  3314. LCmd := LCmd + LFlags + ' '; {Do not Localize}
  3315. end;
  3316. if Length(LDateTime) <> 0 then begin
  3317. LCmd := LCmd + LDateTime + ' '; {Do not Localize}
  3318. end;
  3319. LCmd := LCmd + LMsgLiteral; {Do not Localize}
  3320. {CC3: Catch "Connection reset by peer"...}
  3321. try
  3322. if LUseNonSyncLiteral then begin
  3323. {Send the APPEND command and the message immediately, no + response needed...}
  3324. IOHandler.WriteLn(NewCmdCounter + ' ' + LCmd);
  3325. end else begin
  3326. {Try sending the APPEND command, get the + response, then send the message...}
  3327. SendCmd(NewCmdCounter, LCmd, []);
  3328. if LastCmdResult.Code <> IMAP_CONT then begin
  3329. Exit;
  3330. end;
  3331. end;
  3332. // TODO: if AInternalDateTimeGMT is not 0.0, should we adjust the 'Date' header of the sent email to match?
  3333. LTempStream.Position := 0;
  3334. LHelper := TIdIMAP4WorkHelper.Create(Self);
  3335. try
  3336. IOHandler.Write(LTempStream, LLength);
  3337. finally
  3338. FreeAndNil(LHelper);
  3339. end;
  3340. {WARNING: After we send the message (which should be exactly
  3341. LLength bytes long), we need to send an EXTRA CRLF which is in
  3342. addition to the count in LLength, because this CRLF terminates the
  3343. APPEND command...}
  3344. IOHandler.WriteLn;
  3345. if GetInternalResponse(LastCmdCounter, [IMAP4Commands[cmdAppend]], False) = IMAP_OK then begin
  3346. Result := True;
  3347. end;
  3348. except
  3349. on E: EIdSocketError do begin
  3350. if ((E.LastError = Id_WSAECONNABORTED) or (E.LastError = Id_WSAECONNRESET)) then begin
  3351. FConnectionState := csUnexpectedlyDisconnected;
  3352. end;
  3353. raise;
  3354. end;
  3355. end;
  3356. finally
  3357. FreeAndNil(LTempStream);
  3358. end;
  3359. end;
  3360. end;
  3361. function TIdIMAP4.RetrieveEnvelope(const AMsgNum: UInt32; AMsg: TIdMessage): Boolean;
  3362. begin
  3363. Result := InternalRetrieveEnvelope(AMsgNum, AMsg, nil);
  3364. end;
  3365. function TIdIMAP4.RetrieveEnvelopeRaw(const AMsgNum: UInt32; ADestList: TStrings): Boolean;
  3366. begin
  3367. Result := InternalRetrieveEnvelope(AMsgNum, nil, ADestList);
  3368. end;
  3369. function TIdIMAP4.InternalRetrieveEnvelope(const AMsgNum: UInt32; AMsg: TIdMessage; ADestList: TStrings): Boolean;
  3370. begin
  3371. {CC2: Return False if message number is invalid...}
  3372. Result := False;
  3373. IsNumberValid(AMsgNum);
  3374. CheckConnectionState(csSelected);
  3375. {Some servers return NO if the requested message number is not present
  3376. (e.g. Cyrus), others return OK but no data (CommuniGate).}
  3377. SendCmd(NewCmdCounter,
  3378. IMAP4Commands[cmdFetch] + ' ' + IntToStr(Int64(AMsgNum)) + ' (' + IMAP4FetchDataItem[fdEnvelope] + ')', {Do not Localize}
  3379. [IMAP4Commands[cmdFetch]]);
  3380. if LastCmdResult.Code = IMAP_OK then begin
  3381. if LastCmdResult.Text.Count > 0 then begin
  3382. if ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch], [IMAP4FetchDataItem[fdEnvelope]]) then begin
  3383. if ADestList <> nil then begin
  3384. ADestList.BeginUpdate;
  3385. try
  3386. ADestList.Clear;
  3387. ADestList.Add(FLineStruct.IMAPValue);
  3388. finally
  3389. ADestList.EndUpdate;
  3390. end;
  3391. end;
  3392. if AMsg <> nil then begin
  3393. ParseEnvelopeResult(AMsg, FLineStruct.IMAPValue);
  3394. end;
  3395. Result := True;
  3396. end;
  3397. end;
  3398. end;
  3399. end;
  3400. function TIdIMAP4.UIDRetrieveEnvelope(const AMsgUID: String; AMsg: TIdMessage): Boolean;
  3401. begin
  3402. Result := UIDInternalRetrieveEnvelope(AMsgUID, AMsg, nil);
  3403. end;
  3404. function TIdIMAP4.UIDRetrieveEnvelopeRaw(const AMsgUID: String; ADestList: TStrings): Boolean;
  3405. begin
  3406. Result := UIDInternalRetrieveEnvelope(AMsgUID, nil, ADestList);
  3407. end;
  3408. function TIdIMAP4.UIDInternalRetrieveEnvelope(const AMsgUID: String; AMsg: TIdMessage; ADestList: TStrings): Boolean;
  3409. begin
  3410. {CC2: Return False if message number is invalid...}
  3411. Result := False;
  3412. IsUIDValid(AMsgUID);
  3413. CheckConnectionState(csSelected);
  3414. {Some servers return NO if the requested message number is not present
  3415. (e.g. Cyrus), others return OK but no data (CommuniGate).}
  3416. SendCmd(NewCmdCounter,
  3417. IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdFetch] + ' ' + AMsgUID + ' (' + IMAP4FetchDataItem[fdEnvelope] + ')', {Do not Localize}
  3418. [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]]);
  3419. if LastCmdResult.Code = IMAP_OK then begin
  3420. if LastCmdResult.Text.Count > 0 then begin
  3421. if ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch], [IMAP4FetchDataItem[fdEnvelope]]) then begin
  3422. if ADestList <> nil then begin
  3423. ADestList.BeginUpdate;
  3424. try
  3425. ADestList.Clear;
  3426. ADestList.Add(FLineStruct.IMAPValue);
  3427. finally
  3428. ADestList.EndUpdate;
  3429. end;
  3430. end;
  3431. if AMsg <> nil then begin
  3432. ParseEnvelopeResult(AMsg, FLineStruct.IMAPValue);
  3433. end;
  3434. Result := True;
  3435. end;
  3436. end;
  3437. end;
  3438. end;
  3439. function TIdIMAP4.RetrieveAllEnvelopes(AMsgList: TIdMessageCollection): Boolean;
  3440. {NOTE: If AMsgList is empty or does not have enough records, records will be added.
  3441. If you pass a non-empty AMsgList, it is assumed the records are in relative record
  3442. number sequence: if not, pass in an empty AMsgList and copy the results to your
  3443. own AMsgList.}
  3444. var
  3445. Ln: Integer;
  3446. LMsg: TIdMessage;
  3447. begin
  3448. Result := False;
  3449. {CC2: This is one of the few cases where the server can return only "OK completed"
  3450. meaning that the user has no envelopes.}
  3451. CheckConnectionState(csSelected);
  3452. SendCmd(NewCmdCounter,
  3453. IMAP4Commands[cmdFetch] + ' 1:* (' + IMAP4FetchDataItem[fdEnvelope] + ')', {Do not Localize}
  3454. [IMAP4Commands[cmdFetch]]);
  3455. if LastCmdResult.Code = IMAP_OK then begin
  3456. for Ln := 0 to LastCmdResult.Text.Count-1 do begin
  3457. if ParseLastCmdResult(LastCmdResult.Text[Ln], IMAP4Commands[cmdFetch], [IMAP4FetchDataItem[fdEnvelope]]) then begin
  3458. if LN >= AMsgList.Count then begin
  3459. LMsg := AMsgList.Add.Msg;
  3460. end else begin
  3461. LMsg := AMsgList.Messages[LN];
  3462. end;
  3463. ParseEnvelopeResult(LMsg, FLineStruct.IMAPValue);
  3464. end;
  3465. end;
  3466. Result := True;
  3467. end;
  3468. end;
  3469. function TIdIMAP4.UIDRetrieveAllEnvelopes(AMsgList: TIdMessageCollection): Boolean;
  3470. {NOTE: If AMsgList is empty or does not have enough records, records will be added.
  3471. If you pass a non-empty AMsgList, it is assumed the records are in relative record
  3472. number sequence: if not, pass in an empty AMsgList and copy the results to your
  3473. own AMsgList.}
  3474. var
  3475. Ln: Integer;
  3476. LMsg: TIdMessage;
  3477. begin
  3478. Result := False;
  3479. {CC2: This is one of the few cases where the server can return only "OK completed"
  3480. meaning that the user has no envelopes.}
  3481. CheckConnectionState(csSelected);
  3482. SendCmd(NewCmdCounter,
  3483. IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdFetch] + ' 1:* (' + IMAP4FetchDataItem[fdEnvelope] + ' ' + IMAP4FetchDataItem[fdFlags] + ')', {Do not Localize}
  3484. [IMAP4Commands[cmdFetch]]);
  3485. if LastCmdResult.Code = IMAP_OK then begin
  3486. for Ln := 0 to LastCmdResult.Text.Count-1 do begin
  3487. if ParseLastCmdResult(LastCmdResult.Text[Ln], IMAP4Commands[cmdFetch], [IMAP4FetchDataItem[fdEnvelope]]) then begin
  3488. if LN >= AMsgList.Count then begin
  3489. LMsg := AMsgList.Add.Msg;
  3490. end else begin
  3491. LMsg := AMsgList.Messages[LN];
  3492. end;
  3493. ParseEnvelopeResult(LMsg, FLineStruct.IMAPValue);
  3494. LMsg.UID := FLineStruct.UID;
  3495. LMsg.Flags := FLineStruct.Flags;
  3496. end;
  3497. end;
  3498. Result := True;
  3499. end;
  3500. end;
  3501. function TIdIMAP4.RetrieveText(const AMsgNum: UInt32; var AText: string): Boolean;
  3502. //Retrieve a specific individual part of a message
  3503. begin
  3504. Result := InternalRetrieveText(AMsgNum, AText, False, False, False);
  3505. end;
  3506. function TIdIMAP4.RetrieveText2(const AMsgNum: UInt32; var AText: string): Boolean;
  3507. //Retrieve a specific individual part of a message
  3508. begin
  3509. Result := InternalRetrieveText(AMsgNum, AText, False, False, True);
  3510. end;
  3511. function TIdIMAP4.RetrieveTextPeek(const AMsgNum: UInt32; var AText: string): Boolean;
  3512. {CC3: Added: Retrieve the text part of the message...}
  3513. begin
  3514. Result := InternalRetrieveText(AMsgNum, AText, False, True, False);
  3515. end;
  3516. function TIdIMAP4.RetrieveTextPeek2(const AMsgNum: UInt32; var AText: string): Boolean;
  3517. {CC3: Added: Retrieve the text part of the message...}
  3518. begin
  3519. Result := InternalRetrieveText(AMsgNum, AText, False, True, True);
  3520. end;
  3521. function TIdIMAP4.UIDRetrieveText(const AMsgUID: String; var AText: string): Boolean;
  3522. {CC3: Added: Retrieve the text part of the message...}
  3523. begin
  3524. Result := InternalRetrieveText(UIDToUInt32(AMsgUID), AText, True, False, False);
  3525. end;
  3526. function TIdIMAP4.UIDRetrieveText2(const AMsgUID: String; var AText: string): Boolean;
  3527. {CC3: Added: Retrieve the text part of the message...}
  3528. begin
  3529. Result := InternalRetrieveText(UIDToUInt32(AMsgUID), AText, True, False, True);
  3530. end;
  3531. function TIdIMAP4.UIDRetrieveTextPeek(const AMsgUID: String; var AText: string): Boolean;
  3532. {CC3: Added: Retrieve the text part of the message...}
  3533. begin
  3534. Result := InternalRetrieveText(UIDToUInt32(AMsgUID), AText, True, True, False);
  3535. end;
  3536. function TIdIMAP4.UIDRetrieveTextPeek2(const AMsgUID: String; var AText: string): Boolean;
  3537. {CC3: Added: Retrieve the text part of the message...}
  3538. begin
  3539. Result := InternalRetrieveText(UIDToUInt32(AMsgUID), AText, True, True, True);
  3540. end;
  3541. function TIdIMAP4.InternalRetrieveText(const AMsgNum: UInt32; var AText: string;
  3542. AUseUID: Boolean; AUsePeek: Boolean; AUseFirstPartInsteadOfText: Boolean): Boolean;
  3543. {CC3: Added: Retrieve the text part of the message...}
  3544. var
  3545. LCmd: string;
  3546. LParts: TIdImapMessageParts;
  3547. LThePart: TIdImapMessagePart;
  3548. LCharSet: String;
  3549. LContentTransferEncoding: string;
  3550. LTextPart: integer;
  3551. LTextPartNum: string;
  3552. LHelper: TIdIMAP4WorkHelper;
  3553. procedure DoDecode(ADecoderClass: TIdDecoderClass = nil; AStripCRLFs: Boolean = False);
  3554. var
  3555. LDecoder: TIdDecoder;
  3556. LStream: TStream;
  3557. LStrippedStream: TStringStream;
  3558. LUnstrippedStream: TStringStream;
  3559. LEncoding: IIdTextEncoding;
  3560. begin
  3561. LStream := TMemoryStream.Create;
  3562. try
  3563. if ADecoderClass <> nil then begin
  3564. LDecoder := ADecoderClass.Create(Self);
  3565. try
  3566. LDecoder.DecodeBegin(LStream);
  3567. try
  3568. LUnstrippedStream := TStringStream.Create('');
  3569. try
  3570. IOHandler.ReadStream(LUnstrippedStream, FLineStruct.ByteCount); //ReadStream uses OnWork, most other methods dont
  3571. {This is more complicated than quoted-printable because we
  3572. have to strip CRLFs that have been inserted by the MTA to
  3573. avoid overly long lines...}
  3574. if AStripCRLFs then begin
  3575. LStrippedStream := TStringStream.Create('');
  3576. try
  3577. StripCRLFs(LUnstrippedStream, LStrippedStream);
  3578. LDecoder.Decode(LStrippedStream.DataString);
  3579. finally
  3580. FreeAndNil(LStrippedStream);
  3581. end;
  3582. end else begin
  3583. LDecoder.Decode(LUnstrippedStream.DataString);
  3584. end;
  3585. finally
  3586. FreeAndNil(LUnstrippedStream);
  3587. end;
  3588. finally
  3589. LDecoder.DecodeEnd;
  3590. end;
  3591. finally
  3592. FreeAndNil(LDecoder);
  3593. end;
  3594. end else begin
  3595. IOHandler.ReadStream(LStream, FLineStruct.ByteCount); //ReadStream uses OnWork, most other methods dont
  3596. end;
  3597. LStream.Position := 0;
  3598. if LCharSet <> '' then begin
  3599. LEncoding := CharsetToEncoding(LCharSet);
  3600. AText := ReadStringFromStream(LStream, -1, LEncoding{$IFDEF STRING_IS_ANSI}, IndyTextEncoding_OSDefault{$ENDIF});
  3601. end else begin
  3602. AText := ReadStringFromStream(LStream, -1, IndyTextEncoding_8Bit{$IFDEF STRING_IS_ANSI}, IndyTextEncoding_8Bit{$ENDIF});
  3603. end;
  3604. finally
  3605. FreeAndNil(LStream);
  3606. end;
  3607. end;
  3608. begin
  3609. Result := False;
  3610. AText := ''; {Do not Localize}
  3611. IsNumberValid(AMsgNum);
  3612. CheckConnectionState(csSelected);
  3613. if AUseFirstPartInsteadOfText then begin
  3614. {In this case, we need the body structure to find out what
  3615. encoding has been applied to part 1...}
  3616. LParts := TIdImapMessageParts.Create(nil);
  3617. try
  3618. if AUseUID then begin
  3619. if not UIDRetrieveStructure(IntToStr(Int64(AMsgNum)), LParts) then begin
  3620. Exit;
  3621. end;
  3622. end else begin
  3623. if not RetrieveStructure(AMsgNum, LParts) then begin
  3624. Exit;
  3625. end;
  3626. end;
  3627. {Get the info we want out of LParts...}
  3628. {Some emails have their first parts empty, so search for the first non-empty part.}
  3629. LTextPartNum := '';
  3630. for LTextPart := 0 to LParts.Count-1 do begin
  3631. LThePart := LParts.Items[LTextPart];
  3632. if (LThePart.ImapPartNumber <> '') and (LThePart.FSize <> 0) then begin
  3633. LTextPartNum := LThePart.ImapPartNumber;
  3634. LCharSet := LThePart.CharSet;
  3635. LContentTransferEncoding := LThePart.ContentTransferEncoding;
  3636. Break;
  3637. end;
  3638. end;
  3639. // RLebeau 7/27/2021: for backwards compatibility, if no item was selected above,
  3640. // use the last item in the structure. This is likely wrong, but it is what the
  3641. // previous logic was doing, so preserving it...
  3642. if (LTextPartNum = '') and (LParts.Count > 0) then begin
  3643. LThePart := LParts.Items[LParts.Count-1];
  3644. LTextPartNum := LThePart.ImapPartNumber;
  3645. LCharSet := LThePart.CharSet;
  3646. LContentTransferEncoding := LThePart.ContentTransferEncoding;
  3647. end;
  3648. finally
  3649. FreeAndNil(LParts);
  3650. end;
  3651. end else begin
  3652. // TODO: detect LCharSet and LContentTransferEncoding...
  3653. end;
  3654. LCmd := '';
  3655. if AUseUID then begin
  3656. LCmd := LCmd + IMAP4Commands[cmdUID] + ' '; {Do not Localize}
  3657. end;
  3658. LCmd := LCmd + IMAP4Commands[cmdFetch] + ' ' + IntToStr(Int64(AMsgNum)) + ' ('; {Do not Localize}
  3659. if AUsePeek then begin
  3660. LCmd := LCmd + IMAP4FetchDataItem[fdBody]+'.PEEK'; {Do not Localize}
  3661. end else begin
  3662. LCmd := LCmd + IMAP4FetchDataItem[fdBody];
  3663. end;
  3664. if not AUseFirstPartInsteadOfText then begin
  3665. LCmd := LCmd + '[TEXT])'; {Do not Localize}
  3666. end else begin
  3667. LCmd := LCmd + '[' + LTextPartNum + '])'; {Do not Localize}
  3668. end;
  3669. SendCmd(NewCmdCounter, LCmd, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], True, False);
  3670. if LastCmdResult.Code = IMAP_OK then begin
  3671. try
  3672. {For an invalid request (non-existent part or message), NIL is returned as the size...}
  3673. if (LastCmdResult.Text.Count < 1)
  3674. or (not ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch],
  3675. [IMAP4FetchDataItem[fdBody]+'[TEXT]' , IMAP4FetchDataItem[fdBody]+'['+LTextPartNum+']'])) {do not localize}
  3676. or (PosInStrArray(FLineStruct.IMAPValue, ['NIL', '""'], False) <> -1) {do not localize}
  3677. or (FLineStruct.ByteCount < 1) then
  3678. begin
  3679. GetInternalResponse(LastCmdCounter, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], False);
  3680. Result := False;
  3681. Exit;
  3682. end;
  3683. LHelper := TIdIMAP4WorkHelper.Create(Self);
  3684. try
  3685. case PosInStrArray(LContentTransferEncoding, ['base64', 'quoted-printable', 'binhex40'], False) of {Do not Localize}
  3686. 0: DoDecode(TIdDecoderMIME, True);
  3687. 1: DoDecode(TIdDecoderQuotedPrintable);
  3688. 2: DoDecode(TIdDecoderBinHex4);
  3689. else
  3690. {Assume no encoding (8bit) or something we cannot decode...}
  3691. DoDecode();
  3692. end;
  3693. finally
  3694. FreeAndNil(LHelper);
  3695. end;
  3696. IOHandler.ReadLnWait; {Remove last line, ')' or 'UID 1)'}
  3697. if GetInternalResponse(LastCmdCounter, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], False) = IMAP_OK then begin
  3698. Result := True;
  3699. end;
  3700. except
  3701. on E: EIdSocketError do begin
  3702. if ((E.LastError = Id_WSAECONNABORTED) or (E.LastError = Id_WSAECONNRESET)) then begin
  3703. FConnectionState := csUnexpectedlyDisconnected;
  3704. end;
  3705. raise;
  3706. end;
  3707. end;
  3708. end;
  3709. end;
  3710. function TIdIMAP4.RetrieveStructure(const AMsgNum: UInt32; AMsg: TIdMessage): Boolean;
  3711. begin
  3712. Result := InternalRetrieveStructure(AMsgNum, AMsg, nil);
  3713. end;
  3714. function TIdIMAP4.RetrieveStructure(const AMsgNum: UInt32; AParts: TIdImapMessageParts): Boolean;
  3715. begin
  3716. Result := InternalRetrieveStructure(AMsgNum, nil, AParts);
  3717. end;
  3718. function TIdIMAP4.InternalRetrieveStructure(const AMsgNum: UInt32; AMsg: TIdMessage; AParts: TIdImapMessageParts): Boolean;
  3719. var
  3720. LTheParts: TIdMessageParts;
  3721. begin
  3722. Result := False;
  3723. IsNumberValid(AMsgNum);
  3724. CheckConnectionState(csSelected);
  3725. SendCmd(NewCmdCounter,
  3726. IMAP4Commands[cmdFetch] + ' ' + IntToStr(Int64(AMsgNum)) + ' (' + IMAP4FetchDataItem[fdBodyStructure] + ')',
  3727. [IMAP4Commands[cmdFetch]], True, False);
  3728. if LastCmdResult.Code = IMAP_OK then begin
  3729. {CC3: Catch "Connection reset by peer"...}
  3730. try
  3731. if LastCmdResult.Text.Count > 0 then begin
  3732. if ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch], [IMAP4FetchDataItem[fdBodyStructure]]) then begin
  3733. if AMsg <> nil then begin
  3734. LTheParts := AMsg.MessageParts;
  3735. end else begin
  3736. LTheParts := nil;
  3737. end;
  3738. ParseBodyStructureResult(FLineStruct.IMAPValue, LTheParts, AParts);
  3739. if GetInternalResponse(LastCmdCounter, [IMAP4Commands[cmdFetch]], False) = IMAP_OK then begin
  3740. Result := True;
  3741. end;
  3742. end;
  3743. end;
  3744. except
  3745. on E: EIdSocketError do begin
  3746. if ((E.LastError = Id_WSAECONNABORTED) or (E.LastError = Id_WSAECONNRESET)) then begin
  3747. FConnectionState := csUnexpectedlyDisconnected;
  3748. end;
  3749. raise;
  3750. end;
  3751. end;
  3752. end;
  3753. end;
  3754. // retrieve a specific individual part of a message
  3755. function TIdIMAP4.RetrievePart(const AMsgNum: UInt32; const APartNum: string;
  3756. ADestStream: TStream; AContentTransferEncoding: string): Boolean;
  3757. var
  3758. LDummy1: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  3759. LDummy2: Integer;
  3760. begin
  3761. if ADestStream = nil then begin
  3762. Result := False;
  3763. end else begin
  3764. Result := InternalRetrievePart(AMsgNum, APartNum, False, False, ADestStream, LDummy1, LDummy2, '', AContentTransferEncoding); {Do not Localize}
  3765. end;
  3766. end;
  3767. function TIdIMAP4.RetrievePart(const AMsgNum: UInt32; const APartNum: Integer;
  3768. var ABuffer: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  3769. var ABufferLength: Integer; AContentTransferEncoding: string): Boolean;
  3770. begin
  3771. IsImapPartNumberValid(APartNum);
  3772. Result := RetrievePart(AMsgNum, IntToStr(APartNum), ABuffer, ABufferLength, AContentTransferEncoding);
  3773. end;
  3774. // Retrieve a specific individual part of a message
  3775. function TIdIMAP4.RetrievePart(const AMsgNum: UInt32; const APartNum: string;
  3776. var ABuffer: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  3777. var ABufferLength: Integer; AContentTransferEncoding: string): Boolean;
  3778. begin
  3779. Result := InternalRetrievePart(AMsgNum, APartNum, False, False, nil, ABuffer, ABufferLength, '', AContentTransferEncoding); {Do not Localize}
  3780. end;
  3781. // retrieve a specific individual part of a message
  3782. function TIdIMAP4.RetrievePartPeek(const AMsgNum: UInt32; const APartNum: string;
  3783. ADestStream: TStream; AContentTransferEncoding: string): Boolean;
  3784. var
  3785. LDummy1: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  3786. LDummy2: Integer;
  3787. begin
  3788. if ADestStream = nil then begin
  3789. Result := False;
  3790. end else begin
  3791. Result := InternalRetrievePart(AMsgNum, APartNum, False, True, ADestStream, LDummy1, LDummy2, '', AContentTransferEncoding); {Do not Localize}
  3792. end;
  3793. end;
  3794. function TIdIMAP4.RetrievePartPeek(const AMsgNum: UInt32; const APartNum: Integer;
  3795. var ABuffer: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  3796. var ABufferLength: Integer; AContentTransferEncoding: string): Boolean;
  3797. begin
  3798. IsImapPartNumberValid(APartNum);
  3799. Result := RetrievePartPeek(AMsgNum, IntToStr(APartNum), ABuffer, ABufferLength, AContentTransferEncoding);
  3800. end;
  3801. //Retrieve a specific individual part of a message
  3802. function TIdIMAP4.RetrievePartPeek(const AMsgNum: UInt32; const APartNum: string;
  3803. var ABuffer: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  3804. var ABufferLength: Integer; AContentTransferEncoding: string): Boolean;
  3805. begin
  3806. Result := InternalRetrievePart(AMsgNum, APartNum, False, True, nil, ABuffer, ABufferLength, '', AContentTransferEncoding); {Do not Localize}
  3807. end;
  3808. // Retrieve a specific individual part of a message
  3809. function TIdIMAP4.UIDRetrievePart(const AMsgUID: String; const APartNum: string;
  3810. var ADestStream: TStream; AContentTransferEncoding: string): Boolean;
  3811. var
  3812. LDummy1: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  3813. LDummy2: Integer;
  3814. begin
  3815. if ADestStream = nil then begin
  3816. Result := False;
  3817. end else begin
  3818. Result := InternalRetrievePart(UIDToUInt32(AMsgUID), APartNum, True, False, ADestStream, LDummy1, LDummy2, '', AContentTransferEncoding); {Do not Localize}
  3819. end;
  3820. end;
  3821. function TIdIMAP4.UIDRetrievePart(const AMsgUID: String; const APartNum: Integer;
  3822. var ABuffer: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  3823. var ABufferLength: Integer; AContentTransferEncoding: string): Boolean;
  3824. begin
  3825. IsImapPartNumberValid(APartNum);
  3826. Result := UIDRetrievePart(AMsgUID, IntToStr(APartNum), ABuffer, ABufferLength, AContentTransferEncoding);
  3827. end;
  3828. // Retrieve a specific individual part of a message
  3829. function TIdIMAP4.UIDRetrievePart(const AMsgUID: String; const APartNum: string;
  3830. var ABuffer: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  3831. var ABufferLength: Integer; AContentTransferEncoding: string): Boolean;
  3832. begin
  3833. Result := InternalRetrievePart(UIDToUInt32(AMsgUID), APartNum, True, False, nil, ABuffer, ABufferLength, '', AContentTransferEncoding); {Do not Localize}
  3834. end;
  3835. // retrieve a specific individual part of a message
  3836. function TIdIMAP4.UIDRetrievePartPeek(const AMsgUID: String; const APartNum: string;
  3837. var ADestStream: TStream; AContentTransferEncoding: string): Boolean;
  3838. var
  3839. LDummy1: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  3840. LDummy2: Integer;
  3841. begin
  3842. if ADestStream = nil then begin
  3843. Result := False;
  3844. end else begin
  3845. Result := InternalRetrievePart(UIDToUInt32(AMsgUID), APartNum, True, True, ADestStream, LDummy1, LDummy2, '', AContentTransferEncoding); {Do not Localize}
  3846. end;
  3847. end;
  3848. function TIdIMAP4.UIDRetrievePartPeek(const AMsgUID: String; const APartNum: Integer;
  3849. var ABuffer: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  3850. var ABufferLength: Integer; AContentTransferEncoding: string): Boolean;
  3851. begin
  3852. IsImapPartNumberValid(APartNum);
  3853. Result := UIDRetrievePartPeek(AMsgUID, IntToStr(APartNum), ABuffer, ABufferLength, AContentTransferEncoding);
  3854. end;
  3855. function TIdIMAP4.UIDRetrievePartPeek(const AMsgUID: String; const APartNum: string;
  3856. var ABuffer: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  3857. var ABufferLength: Integer; AContentTransferEncoding: string): Boolean;
  3858. //Retrieve a specific individual part of a message
  3859. begin
  3860. Result := InternalRetrievePart(UIDToUInt32(AMsgUID), APartNum, True, True, nil, ABuffer, ABufferLength, '', AContentTransferEncoding); {Do not Localize}
  3861. end;
  3862. function TIdIMAP4.RetrievePartToFile(const AMsgNum: UInt32; const APartNum: Integer;
  3863. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean;
  3864. begin
  3865. IsImapPartNumberValid(APartNum);
  3866. Result := RetrievePartToFile(AMsgNum, IntToStr(APartNum), ALength, ADestFileNameAndPath, AContentTransferEncoding);
  3867. end;
  3868. // retrieve a specific individual part of a message
  3869. function TIdIMAP4.RetrievePartToFile(const AMsgNum: UInt32; const APartNum: string;
  3870. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean;
  3871. var
  3872. LDummy: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  3873. begin
  3874. if Length(ADestFileNameAndPath) = 0 then begin
  3875. Result := False;
  3876. end else begin
  3877. Result := InternalRetrievePart(AMsgNum, APartNum, False, False, nil,
  3878. LDummy, ALength, ADestFileNameAndPath, AContentTransferEncoding);
  3879. end;
  3880. end;
  3881. function TIdIMAP4.RetrievePartToFilePeek(const AMsgNum: UInt32; const APartNum: Integer;
  3882. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean;
  3883. begin
  3884. IsImapPartNumberValid(APartNum);
  3885. Result := RetrievePartToFilePeek(AMsgNum, IntToStr(APartNum), ALength, ADestFileNameAndPath, AContentTransferEncoding);
  3886. end;
  3887. // retrieve a specific individual part of a message
  3888. function TIdIMAP4.RetrievePartToFilePeek(const AMsgNum: UInt32; const APartNum: string;
  3889. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean;
  3890. var
  3891. LDummy: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  3892. begin
  3893. if Length(ADestFileNameAndPath) = 0 then begin
  3894. Result := False;
  3895. end else begin
  3896. Result := InternalRetrievePart(AMsgNum, APartNum, False, True, nil,
  3897. LDummy, ALength, ADestFileNameAndPath, AContentTransferEncoding);
  3898. end;
  3899. end;
  3900. function TIdIMAP4.UIDRetrievePartToFile(const AMsgUID: String; const APartNum: Integer;
  3901. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean;
  3902. begin
  3903. IsImapPartNumberValid(APartNum);
  3904. Result := UIDRetrievePartToFile(AMsgUID, IntToStr(APartNum), ALength, ADestFileNameAndPath, AContentTransferEncoding);
  3905. end;
  3906. // retrieve a specific individual part of a message
  3907. function TIdIMAP4.UIDRetrievePartToFile(const AMsgUID: String; const APartNum: string;
  3908. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean;
  3909. var
  3910. LDummy: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  3911. begin
  3912. if Length(ADestFileNameAndPath) = 0 then begin
  3913. Result := False;
  3914. end else begin
  3915. Result := InternalRetrievePart(UIDToUInt32(AMsgUID), APartNum, True, False, nil,
  3916. LDummy, ALength, ADestFileNameAndPath, AContentTransferEncoding);
  3917. end;
  3918. end;
  3919. function TIdIMAP4.UIDRetrievePartToFilePeek(const AMsgUID: String; const APartNum: Integer;
  3920. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean;
  3921. begin
  3922. IsImapPartNumberValid(APartNum);
  3923. Result := UIDRetrievePartToFilePeek(AMsgUID, IntToStr(APartNum), ALength, ADestFileNameAndPath, AContentTransferEncoding);
  3924. end;
  3925. // retrieve a specific individual part of a message
  3926. function TIdIMAP4.UIDRetrievePartToFilePeek(const AMsgUID: String; const APartNum: {Integer} string;
  3927. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean;
  3928. var
  3929. LDummy: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  3930. begin
  3931. if Length(ADestFileNameAndPath) = 0 then begin
  3932. Result := False;
  3933. end else begin
  3934. Result := InternalRetrievePart(UIDToUInt32(AMsgUID), APartNum, True, True,
  3935. nil, LDummy, ALength, ADestFileNameAndPath, AContentTransferEncoding);
  3936. end;
  3937. end;
  3938. // retrieve a specific individual part of a message
  3939. // TODO: remove the ABufferLength output parameter under DOTNET, it is redundant...
  3940. function TIdIMAP4.InternalRetrievePart(const AMsgNum: UInt32; const APartNum: {Integer} string;
  3941. AUseUID: Boolean; AUsePeek: Boolean; ADestStream: TStream;
  3942. var ABuffer: {$IFDEF DOTNET}TIdBytes{$ELSE}PByte{$ENDIF};
  3943. var ABufferLength: Integer; {NOTE: var args cannot have default params}
  3944. ADestFileNameAndPath: string;
  3945. AContentTransferEncoding: string): Boolean;
  3946. var
  3947. LCmd: string;
  3948. bCreatedStream: Boolean;
  3949. LDestStream: TStream;
  3950. // LPartSizeParam: string;
  3951. LHelper: TIdIMAP4WorkHelper;
  3952. procedure DoDecode(ADecoderClass: TIdDecoderClass = nil; AStripCRLFs: Boolean = False);
  3953. var
  3954. LDecoder: TIdDecoder;
  3955. LStream: TStream;
  3956. LStrippedStream: TStringStream;
  3957. LUnstrippedStream: TStringStream;
  3958. begin
  3959. if LDestStream = nil then begin
  3960. LStream := TMemoryStream.Create;
  3961. end else begin
  3962. LStream := LDestStream;
  3963. end;
  3964. try
  3965. if ADecoderClass <> nil then begin
  3966. LDecoder := ADecoderClass.Create(Self);
  3967. try
  3968. LDecoder.DecodeBegin(LStream);
  3969. try
  3970. LUnstrippedStream := TStringStream.Create('');
  3971. try
  3972. IOHandler.ReadStream(LUnstrippedStream, ABufferLength); //ReadStream uses OnWork, most other methods dont
  3973. {This is more complicated than quoted-printable because we
  3974. have to strip CRLFs that have been inserted by the MTA to
  3975. avoid overly long lines...}
  3976. if AStripCRLFs then begin
  3977. LStrippedStream := TStringStream.Create('');
  3978. try
  3979. StripCRLFs(LUnstrippedStream, LStrippedStream);
  3980. LDecoder.Decode(LStrippedStream.DataString);
  3981. finally
  3982. FreeAndNil(LStrippedStream);
  3983. end;
  3984. end else begin
  3985. LDecoder.Decode(LUnstrippedStream.DataString);
  3986. end;
  3987. finally
  3988. FreeAndNil(LUnstrippedStream);
  3989. end;
  3990. finally
  3991. LDecoder.DecodeEnd;
  3992. end;
  3993. finally
  3994. FreeAndNil(LDecoder);
  3995. end;
  3996. end else begin
  3997. IOHandler.ReadStream(LStream, ABufferLength); //ReadStream uses OnWork, most other methods dont
  3998. end;
  3999. if LDestStream = nil then begin
  4000. ABufferLength := LStream.Size;
  4001. {$IFDEF DOTNET}
  4002. //ABuffer is a TIdBytes.
  4003. SetLength(ABuffer, ABufferLength);
  4004. if ABufferLength > 0 then begin
  4005. LStream.Position := 0;
  4006. ReadTIdBytesFromStream(LStream, ABuffer, ABufferLength);
  4007. end;
  4008. {$ELSE}
  4009. //ABuffer is a PByte.
  4010. GetMem(ABuffer, ABufferLength);
  4011. if ABufferLength > 0 then begin
  4012. LStream.Position := 0;
  4013. LStream.ReadBuffer(ABuffer^, ABufferLength);
  4014. end;
  4015. {$ENDIF}
  4016. end;
  4017. finally
  4018. if LDestStream = nil then begin
  4019. FreeAndNil(LStream);
  4020. end;
  4021. end;
  4022. end;
  4023. begin
  4024. Result := False;
  4025. {CCC: Make sure part number is valid since it is now passed as a string...}
  4026. IsImapPartNumberValid(APartNum);
  4027. ABuffer := nil;
  4028. ABufferLength := 0;
  4029. CheckConnectionState(csSelected);
  4030. LCmd := '';
  4031. if AUseUID then begin
  4032. LCmd := LCmd + IMAP4Commands[cmdUID] + ' '; {Do not Localize}
  4033. end;
  4034. LCmd := LCmd + IMAP4Commands[cmdFetch] + ' ' + IntToStr(Int64(AMsgNum)) + ' ('; {Do not Localize}
  4035. if AUsePeek then begin
  4036. LCmd := LCmd + IMAP4FetchDataItem[fdBody]+'.PEEK'; {Do not Localize}
  4037. end else begin
  4038. LCmd := LCmd + IMAP4FetchDataItem[fdBody];
  4039. end;
  4040. LCmd := LCmd + '[' + APartNum + '])'; {Do not Localize}
  4041. SendCmd(NewCmdCounter, LCmd, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], True, False);
  4042. if LastCmdResult.Code = IMAP_OK then begin
  4043. {CC3: Catch "Connection reset by peer"...}
  4044. try
  4045. //LPartSizeParam := ''; {Do not Localize}
  4046. if ( (LastCmdResult.Text.Count < 1) or
  4047. (not ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch], []))
  4048. or (PosInStrArray(FLineStruct.IMAPValue, ['NIL', '""'], False) <> -1) {do not localize}
  4049. or (FLineStruct.ByteCount < 1) ) then
  4050. begin
  4051. GetInternalResponse(LastCmdCounter, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], False);
  4052. Result := False;
  4053. Exit;
  4054. end;
  4055. {CC4: Some messages have an empty first part. These respond as:
  4056. 17 FETCH (BODY[1] "" UID 20)
  4057. instead of the more normal:
  4058. 17 FETCH (BODY[1] {11} {This bracket is not part of the response!
  4059. ...
  4060. UID 20)
  4061. }
  4062. ABufferLength := FLineStruct.ByteCount;
  4063. bCreatedStream := False;
  4064. if ADestStream = nil then
  4065. begin
  4066. if Length(ADestFileNameAndPath) = 0 then begin
  4067. {User wants to write it to a memory block...}
  4068. LDestStream := nil;
  4069. end else begin
  4070. {User wants to write it to a file...}
  4071. LDestStream := TIdFileCreateStream.Create(ADestFileNameAndPath);
  4072. bCreatedStream := True;
  4073. end;
  4074. end else
  4075. begin
  4076. {User wants to write it to a stream ...}
  4077. LDestStream := ADestStream;
  4078. end;
  4079. try
  4080. LHelper := TIdIMAP4WorkHelper.Create(Self);
  4081. try
  4082. if TextIsSame(AContentTransferEncoding, 'base64') then begin {Do not Localize}
  4083. DoDecode(TIdDecoderMIME, True);
  4084. end else if TextIsSame(AContentTransferEncoding, 'quoted-printable') then begin {Do not Localize}
  4085. DoDecode(TIdDecoderQuotedPrintable);
  4086. end else if TextIsSame(AContentTransferEncoding, 'binhex40') then begin {Do not Localize}
  4087. DoDecode(TIdDecoderBinHex4);
  4088. end else begin
  4089. {Assume no encoding (8bit) or something we cannot decode...}
  4090. DoDecode;
  4091. end;
  4092. finally
  4093. FreeAndNil(LHelper);
  4094. end;
  4095. finally
  4096. if bCreatedStream then begin
  4097. FreeAndNil(LDestStream);
  4098. end;
  4099. end;
  4100. IOHandler.ReadLnWait; {Remove last line, ')' or 'UID 1)'}
  4101. if GetInternalResponse(LastCmdCounter, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], False) = IMAP_OK then begin
  4102. Result := True;
  4103. end;
  4104. except
  4105. on E: EIdSocketError do begin
  4106. if ((E.LastError = Id_WSAECONNABORTED) or (E.LastError = Id_WSAECONNRESET)) then begin
  4107. FConnectionState := csUnexpectedlyDisconnected;
  4108. end;
  4109. raise;
  4110. end;
  4111. end;
  4112. end;
  4113. end;
  4114. function TIdIMAP4.UIDRetrieveStructure(const AMsgUID: String; AMsg: TIdMessage): Boolean;
  4115. begin
  4116. Result := UIDInternalRetrieveStructure(AMsgUID, AMsg, nil);
  4117. end;
  4118. function TIdIMAP4.UIDRetrieveStructure(const AMsgUID: String; AParts: TIdImapMessageParts): Boolean;
  4119. begin
  4120. Result := UIDInternalRetrieveStructure(AMsgUID, nil, AParts);
  4121. end;
  4122. function TIdIMAP4.UIDInternalRetrieveStructure(const AMsgUID: String; AMsg: TIdMessage; AParts: TIdImapMessageParts): Boolean;
  4123. var
  4124. //LSlRetrieve : TStringList;
  4125. //LStr: string;
  4126. LTheParts: TIdMessageParts;
  4127. begin
  4128. Result := False;
  4129. IsUIDValid(AMsgUID);
  4130. CheckConnectionState(csSelected);
  4131. //Note: The normal single-line response may be split for huge bodystructures,
  4132. //allow for this by setting ASingleLineMayBeSplit to True...
  4133. SendCmd(NewCmdCounter,
  4134. IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdFetch] + ' ' + AMsgUID + ' (' + IMAP4FetchDataItem[fdBodyStructure] + ')', {Do not Localize}
  4135. [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]],
  4136. True, True);
  4137. if LastCmdResult.Code = IMAP_OK then begin
  4138. {CC3: Catch "Connection reset by peer"...}
  4139. try
  4140. if LastCmdResult.Text.Count > 0 then begin
  4141. if ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch], [IMAP4FetchDataItem[fdBodyStructure]]) then begin
  4142. if AMsg <> nil then begin
  4143. LTheParts := AMsg.MessageParts;
  4144. end else begin
  4145. LTheParts := nil;
  4146. end;
  4147. ParseBodyStructureResult(FLineStruct.IMAPValue, LTheParts, AParts);
  4148. if GetInternalResponse(LastCmdCounter, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], False) = IMAP_OK then begin
  4149. Result := True;
  4150. end;
  4151. end;
  4152. end;
  4153. except
  4154. on E: EIdSocketError do begin
  4155. if ((E.LastError = Id_WSAECONNABORTED) or (E.LastError = Id_WSAECONNRESET)) then begin
  4156. FConnectionState := csUnexpectedlyDisconnected;
  4157. end;
  4158. raise;
  4159. end;
  4160. end;
  4161. end;
  4162. end;
  4163. function TIdIMAP4.RetrieveHeader(const AMsgNum: UInt32; AMsg: TIdMessage): Boolean;
  4164. var
  4165. LStr: string;
  4166. begin
  4167. Result := False;
  4168. IsNumberValid(AMsgNum);
  4169. CheckConnectionState(csSelected);
  4170. SendCmd(NewCmdCounter,
  4171. IMAP4Commands[cmdFetch] + ' ' + IntToStr(Int64(AMsgNum)) + ' (' + IMAP4FetchDataItem[fdRFC822Header] + ')', {Do not Localize}
  4172. [IMAP4Commands[cmdFetch]], True, False);
  4173. if LastCmdResult.Code = IMAP_OK then begin
  4174. {CC3: Catch "Connection reset by peer"...}
  4175. try
  4176. if LastCmdResult.Text.Count > 0 then begin
  4177. if ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch], [IMAP4FetchDataItem[fdRFC822Header]])
  4178. and (FLineStruct.ByteCount > 0) then
  4179. begin
  4180. BeginWork(wmRead, FLineStruct.ByteCount); //allow ReadString to use OnWork
  4181. try
  4182. LStr := IOHandler.ReadString(FLineStruct.ByteCount);
  4183. finally
  4184. EndWork(wmRead);
  4185. end;
  4186. {CC2: Clear out body so don't get multiple copies of bodies}
  4187. AMsg.Clear;
  4188. AMsg.Headers.Text := LStr;
  4189. AMsg.ProcessHeaders;
  4190. LStr := IOHandler.ReadLnWait; {Remove trailing line after the message, probably a ')' }
  4191. ParseLastCmdResultButAppendInfo(LStr); //There may be a UID or FLAGS in this
  4192. if GetInternalResponse(LastCmdCounter, [IMAP4Commands[cmdFetch]], False) = IMAP_OK then begin
  4193. AMsg.UID := FLineStruct.UID;
  4194. AMsg.Flags := FLineStruct.Flags;
  4195. Result := True;
  4196. end;
  4197. end;
  4198. end;
  4199. except
  4200. on E: EIdSocketError do begin
  4201. if ((E.LastError = Id_WSAECONNABORTED) or (E.LastError = Id_WSAECONNRESET)) then begin
  4202. FConnectionState := csUnexpectedlyDisconnected;
  4203. end;
  4204. raise;
  4205. end;
  4206. end;
  4207. end;
  4208. end;
  4209. function TIdIMAP4.UIDRetrieveHeader(const AMsgUID: String; AMsg: TIdMessage): Boolean;
  4210. var
  4211. LStr: string;
  4212. begin
  4213. Result := False;
  4214. IsUIDValid(AMsgUID);
  4215. CheckConnectionState(csSelected);
  4216. SendCmd(NewCmdCounter,
  4217. IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdFetch] + ' ' + AMsgUID + ' (' + IMAP4FetchDataItem[fdRFC822Header] + ')', {Do not Localize}
  4218. [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], True, False);
  4219. if LastCmdResult.Code = IMAP_OK then begin
  4220. {CC3: Catch "Connection reset by peer"...}
  4221. try
  4222. if LastCmdResult.Text.Count > 0 then begin
  4223. if ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch], [IMAP4FetchDataItem[fdRFC822Header]])
  4224. and (FLineStruct.ByteCount > 0) then
  4225. begin
  4226. BeginWork(wmRead, FLineStruct.ByteCount); //allow ReadString to use OnWork
  4227. try
  4228. LStr := IOHandler.ReadString(FLineStruct.ByteCount);
  4229. finally
  4230. EndWork(wmRead);
  4231. end;
  4232. {CC2: Clear out body so don't get multiple copies of bodies}
  4233. AMsg.Clear;
  4234. AMsg.Headers.Text := LStr;
  4235. AMsg.ProcessHeaders;
  4236. LStr := IOHandler.ReadLnWait; {Remove trailing line after the message, probably a ')' }
  4237. ParseLastCmdResultButAppendInfo(LStr); //There may be a UID or FLAGS in this
  4238. if GetInternalResponse(LastCmdCounter, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], False) = IMAP_OK then begin
  4239. AMsg.UID := FLineStruct.UID;
  4240. if AMsg.UID = '' then begin
  4241. AMsg.UID := AMsgUID;
  4242. end;
  4243. AMsg.Flags := FLineStruct.Flags;
  4244. Result := True;
  4245. end;
  4246. end;
  4247. end;
  4248. except
  4249. on E: EIdSocketError do begin
  4250. if ((E.LastError = Id_WSAECONNABORTED) or (E.LastError = Id_WSAECONNRESET)) then begin
  4251. FConnectionState := csUnexpectedlyDisconnected;
  4252. end;
  4253. raise;
  4254. end;
  4255. end;
  4256. end;
  4257. end;
  4258. function TIdIMAP4.RetrievePartHeader(const AMsgNum: UInt32; const APartNum: string; AHeaders: TIdHeaderList): Boolean;
  4259. begin
  4260. Result := InternalRetrievePartHeader(AMsgNum, APartNum, False, AHeaders);
  4261. end;
  4262. function TIdIMAP4.UIDRetrievePartHeader(const AMsgUID: String; const APartNum: string; AHeaders: TIdHeaderList): Boolean;
  4263. begin
  4264. Result := InternalRetrievePartHeader(UIDToUInt32(AMsgUID), APartNum, True, AHeaders);
  4265. end;
  4266. function TIdIMAP4.InternalRetrievePartHeader(const AMsgNum: UInt32; const APartNum: string;
  4267. const AUseUID: Boolean; AHeaders: TIdHeaderList): Boolean;
  4268. var
  4269. LCmd: string;
  4270. begin
  4271. Result := False;
  4272. IsNumberValid(AMsgNum);
  4273. CheckConnectionState(csSelected);
  4274. LCmd := '';
  4275. if AUseUID then begin
  4276. LCmd := LCmd + IMAP4Commands[cmdUID] + ' '; {Do not Localize}
  4277. end;
  4278. LCmd := LCmd + IMAP4Commands[cmdFetch] + ' ' + IntToStr(Int64(AMsgNum)) + ' (' + IMAP4FetchDataItem[fdBody] + '[' + APartNum + '.' + IMAP4FetchDataItem[fdHeader] + '])'; {Do not Localize}
  4279. SendCmd(NewCmdCounter, LCmd, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], True, False);
  4280. if LastCmdResult.Code = IMAP_OK then begin
  4281. {CC3: Catch "Connection reset by peer"...}
  4282. try
  4283. if LastCmdResult.Text.Count > 0 then begin
  4284. if ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch], [])
  4285. and (PosInStrArray(FLineStruct.IMAPValue, ['NIL', '""'], False) = -1)
  4286. and (FLineStruct.ByteCount > 0) then
  4287. begin
  4288. {CC4: Some messages have an empty first part. These respond as:
  4289. 17 FETCH (BODY[1] "" UID 20)
  4290. instead of the more normal:
  4291. 17 FETCH (BODY[1] {11} {This bracket is not part of the response!
  4292. ...
  4293. UID 20)
  4294. }
  4295. BeginWork(wmRead, FLineStruct.ByteCount); //allow ReadString to use OnWork
  4296. try
  4297. AHeaders.Text := IOHandler.ReadString(FLineStruct.ByteCount);
  4298. finally
  4299. EndWork(wmRead);
  4300. end;
  4301. end;
  4302. end;
  4303. IOHandler.ReadLnWait;
  4304. if GetInternalResponse(LastCmdCounter, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], False) = IMAP_OK then begin
  4305. Result := True;
  4306. end;
  4307. except
  4308. on E: EIdSocketError do begin
  4309. if ((E.LastError = Id_WSAECONNABORTED) or (E.LastError = Id_WSAECONNRESET)) then begin
  4310. FConnectionState := csUnexpectedlyDisconnected;
  4311. end;
  4312. raise;
  4313. end;
  4314. end;
  4315. end;
  4316. end;
  4317. //This code was just pulled up from IdMessageClient so that logging could be added.
  4318. function TIdIMAP4.ReceiveHeader(AMsg: TIdMessage; const AAltTerm: string = ''): string;
  4319. begin
  4320. repeat
  4321. Result := IOHandler.ReadLn;
  4322. // Exchange Bug: Exchange sometimes returns . when getting a message instead of
  4323. // '' then a . - That is there is no seperation between the header and the message for an
  4324. // empty message.
  4325. if ((Length(AAltTerm) = 0) and (Result = '.')) or (Result = AAltTerm) then begin
  4326. Break;
  4327. end else if Length(Result) <> 0 then begin
  4328. AMsg.Headers.Append(Result);
  4329. end;
  4330. until False;
  4331. AMsg.ProcessHeaders;
  4332. end;
  4333. function TIdIMAP4.Retrieve(const AMsgNum: UInt32; AMsg: TIdMessage): Boolean;
  4334. begin
  4335. Result := InternalRetrieve(AMsgNum, False, False, AMsg);
  4336. end;
  4337. //Retrieves a whole message "raw" and saves it to file, while marking it read.
  4338. function TIdIMAP4.RetrieveNoDecodeToFile(const AMsgNum: UInt32; ADestFile: string): Boolean;
  4339. var
  4340. LMsg: TIdMessage;
  4341. begin
  4342. Result := False;
  4343. LMsg := TIdMessage.Create(nil);
  4344. try
  4345. LMsg.NoDecode := True;
  4346. LMsg.NoEncode := True;
  4347. if InternalRetrieve(AMsgNum, False, False, LMsg) then begin
  4348. {RLebeau 12/09/2012: NOT currently using the same workaround here that
  4349. is being used in AppendMsg() to avoid SMTP dot transparent output from
  4350. TIdMessage.SaveToStream(). The reason for this is because I don't
  4351. know how this method is being used and I don't want to break anything
  4352. that may be depending on that transparent output being generated...}
  4353. LMsg.SaveToFile(ADestFile);
  4354. {TODO: add an optional parameter to specify whether dot transparency
  4355. should be used or not, and then pass that to SaveToFile(). Or better,
  4356. just deprecate this method and implement a replacement that downloads
  4357. the message directly to the file without dot transparency, since it
  4358. has no meaning in IMAP. InternalRetrieve() uses an internal stream
  4359. anyway to receive the data, so let's just cut out TIdMessage here...}
  4360. Result := True;
  4361. end;
  4362. finally
  4363. FreeAndNil(LMsg);
  4364. end;
  4365. end;
  4366. //Retrieves a whole message "raw" and saves it to file
  4367. function TIdIMAP4.RetrieveNoDecodeToFilePeek(const AMsgNum: UInt32; ADestFile: string): Boolean;
  4368. var
  4369. LMsg: TIdMessage;
  4370. begin
  4371. Result := False;
  4372. LMsg := TIdMessage.Create(nil);
  4373. try
  4374. LMsg.NoDecode := True;
  4375. LMsg.NoEncode := True;
  4376. if InternalRetrieve(AMsgNum, False, True, LMsg) then begin
  4377. {RLebeau 12/09/2012: NOT currently using the same workaround here that
  4378. is being used in AppendMsg() to avoid SMTP dot transparent output from
  4379. TIdMessage.SaveToStream(). The reason for this is because I don't
  4380. know how this method is being used and I don't want to break anything
  4381. that may be depending on that transparent output being generated...}
  4382. LMsg.SaveToFile(ADestFile);
  4383. {TODO: add an optional parameter to specify whether dot transparency
  4384. should be used or not, and then pass that to SaveToFile(). Or better,
  4385. just deprecate this method and implement a replacement that downloads
  4386. the message directly to the file without dot transparency, since it
  4387. has no meaning in IMAP. InternalRetrieve() uses an internal stream
  4388. anyway to receive the data, so let's just cut out TIdMessage here...}
  4389. Result := True;
  4390. end;
  4391. finally
  4392. FreeAndNil(LMsg);
  4393. end;
  4394. end;
  4395. //Retrieves a whole message "raw" and saves it to file, while marking it read.
  4396. function TIdIMAP4.RetrieveNoDecodeToStream(const AMsgNum: UInt32; AStream: TStream): Boolean;
  4397. var
  4398. LMsg: TIdMessage;
  4399. begin
  4400. Result := False;
  4401. LMsg := TIdMessage.Create(nil);
  4402. try
  4403. LMsg.NoDecode := True;
  4404. LMsg.NoEncode := True;
  4405. if InternalRetrieve(AMsgNum, False, False, LMsg) then begin
  4406. {RLebeau 12/09/2012: NOT currently using the same workaround here that
  4407. is being used in AppendMsg() to avoid SMTP dot transparent output from
  4408. TIdMessage.SaveToStream(). The reason for this is because I don't
  4409. know how this method is being used and I don't want to break anything
  4410. that may be depending on that transparent output being generated...}
  4411. LMsg.SaveToStream(AStream);
  4412. {TODO: add an optional parameter to specify whether dot transparency
  4413. should be used or not, and then pass that to SaveToStream(). Or better,
  4414. just deprecate this method and implement a replacement that downloads
  4415. the message directly to the file without dot transparency, since it
  4416. has no meaning in IMAP. InternalRetrieve() uses an internal stream
  4417. anyway to receive the data, so let's just cut out TIdMessage here...}
  4418. Result := True;
  4419. end;
  4420. finally
  4421. FreeAndNil(LMsg);
  4422. end;
  4423. end;
  4424. //Retrieves a whole message "raw" and saves it to file
  4425. function TIdIMAP4.RetrieveNoDecodeToStreamPeek(const AMsgNum: UInt32; AStream: TStream): Boolean;
  4426. var
  4427. LMsg: TIdMessage;
  4428. begin
  4429. Result := False;
  4430. LMsg := TIdMessage.Create(nil);
  4431. try
  4432. LMsg.NoDecode := True;
  4433. LMsg.NoEncode := True;
  4434. if InternalRetrieve(AMsgNum, False, True, LMsg) then begin
  4435. {RLebeau 12/09/2012: NOT currently using the same workaround here that
  4436. is being used in AppendMsg() to avoid SMTP dot transparent output from
  4437. TIdMessage.SaveToStream(). The reason for this is because I don't
  4438. know how this method is being used and I don't want to break anything
  4439. that may be depending on that transparent output being generated...}
  4440. LMsg.SaveToStream(AStream);
  4441. {TODO: add an optional parameter to specify whether dot transparency
  4442. should be used or not, and then pass that to SaveToStream(). Or better,
  4443. just deprecate this method and implement a replacement that downloads
  4444. the message directly to the file without dot transparency, since it
  4445. has no meaning in IMAP. InternalRetrieve() uses an internal stream
  4446. anyway to receive the data, so let's just cut out TIdMessage here...}
  4447. Result := True;
  4448. end;
  4449. finally
  4450. FreeAndNil(LMsg);
  4451. end;
  4452. end;
  4453. function TIdIMAP4.RetrievePeek(const AMsgNum: UInt32; AMsg: TIdMessage): Boolean;
  4454. begin
  4455. Result := InternalRetrieve(AMsgNum, False, True, AMsg);
  4456. end;
  4457. function TIdIMAP4.UIDRetrieve(const AMsgUID: String; AMsg: TIdMessage): Boolean;
  4458. begin
  4459. Result := InternalRetrieve(UIDToUInt32(AMsgUID), True, False, AMsg);
  4460. end;
  4461. //Retrieves a whole message "raw" and saves it to file, while marking it read.
  4462. function TIdIMAP4.UIDRetrieveNoDecodeToFile(const AMsgUID: String; ADestFile: string): Boolean;
  4463. var
  4464. LMsg: TIdMessage;
  4465. begin
  4466. Result := False;
  4467. LMsg := TIdMessage.Create(nil);
  4468. try
  4469. LMsg.NoDecode := True;
  4470. LMsg.NoEncode := True;
  4471. if InternalRetrieve(UIDToUInt32(AMsgUID), True, False, LMsg) then begin
  4472. {RLebeau 12/09/2012: NOT currently using the same workaround here that
  4473. is being used in AppendMsg() to avoid SMTP dot transparent output from
  4474. TIdMessage.SaveToStream(). The reason for this is because I don't
  4475. know how this method is being used and I don't want to break anything
  4476. that may be depending on that transparent output being generated...}
  4477. LMsg.SaveToFile(ADestFile);
  4478. {TODO: add an optional parameter to specify whether dot transparency
  4479. should be used or not, and then pass that to SaveToFile(). Or better,
  4480. just deprecate this method and implement a replacement that downloads
  4481. the message directly to the file without dot transparency, since it
  4482. has no meaning in IMAP. InternalRetrieve() uses an internal stream
  4483. anyway to receive the data, so let's just cut out TIdMessage here...}
  4484. Result := True;
  4485. end;
  4486. finally
  4487. FreeAndNil(LMsg);
  4488. end;
  4489. end;
  4490. //Retrieves a whole message "raw" and saves it to file.
  4491. function TIdIMAP4.UIDRetrieveNoDecodeToFilePeek(const AMsgUID: String; ADestFile: string): Boolean;
  4492. var
  4493. LMsg: TIdMessage;
  4494. begin
  4495. Result := False;
  4496. LMsg := TIdMessage.Create(nil);
  4497. try
  4498. LMsg.NoDecode := True;
  4499. LMsg.NoEncode := True;
  4500. if InternalRetrieve(UIDToUInt32(AMsgUID), True, True, LMsg) then begin
  4501. {RLebeau 12/09/2012: NOT currently using the same workaround here that
  4502. is being used in AppendMsg() to avoid SMTP dot transparent output from
  4503. TIdMessage.SaveToStream(). The reason for this is because I don't
  4504. know how this method is being used and I don't want to break anything
  4505. that may be depending on that transparent output being generated...}
  4506. LMsg.SaveToFile(ADestFile);
  4507. {TODO: add an optional parameter to specify whether dot transparency
  4508. should be used or not, and then pass that to SaveToFile(). Or better,
  4509. just deprecate this method and implement a replacement that downloads
  4510. the message directly to the file without dot transparency, since it
  4511. has no meaning in IMAP. InternalRetrieve() uses an internal stream
  4512. anyway to receive the data, so let's just cut out TIdMessage here...}
  4513. Result := True;
  4514. end;
  4515. finally
  4516. FreeAndNil(LMsg);
  4517. end;
  4518. end;
  4519. //Retrieves a whole message "raw" and saves it to file, while marking it read.
  4520. function TIdIMAP4.UIDRetrieveNoDecodeToStream(const AMsgUID: String; AStream: TStream): Boolean;
  4521. var
  4522. LMsg: TIdMessage;
  4523. begin
  4524. Result := False;
  4525. LMsg := TIdMessage.Create(nil);
  4526. try
  4527. LMsg.NoDecode := True;
  4528. LMsg.NoEncode := True;
  4529. if InternalRetrieve(UIDToUInt32(AMsgUID), True, False, LMsg) then begin
  4530. {RLebeau 12/09/2012: NOT currently using the same workaround here that
  4531. is being used in AppendMsg() to avoid SMTP dot transparent output from
  4532. TIdMessage.SaveToStream(). The reason for this is because I don't
  4533. know how this method is being used and I don't want to break anything
  4534. that may be depending on that transparent output being generated...}
  4535. LMsg.SaveToStream(AStream);
  4536. {TODO: add an optional parameter to specify whether dot transparency
  4537. should be used or not, and then pass that to SaveToStream(). Or better,
  4538. just deprecate this method and implement a replacement that downloads
  4539. the message directly to the file without dot transparency, since it
  4540. has no meaning in IMAP. InternalRetrieve() uses an internal stream
  4541. anyway to receive the data, so let's just cut out TIdMessage here...}
  4542. Result := True;
  4543. end;
  4544. finally
  4545. FreeAndNil(LMsg);
  4546. end;
  4547. end;
  4548. //Retrieves a whole message "raw" and saves it to file.
  4549. function TIdIMAP4.UIDRetrieveNoDecodeToStreamPeek(const AMsgUID: String; AStream: TStream): Boolean;
  4550. var
  4551. LMsg: TIdMessage;
  4552. begin
  4553. Result := False;
  4554. LMsg := TIdMessage.Create(nil);
  4555. try
  4556. LMsg.NoDecode := True;
  4557. LMsg.NoEncode := True;
  4558. if InternalRetrieve(UIDToUInt32(AMsgUID), True, True, LMsg) then begin
  4559. {RLebeau 12/09/2012: NOT currently using the same workaround here that
  4560. is being used in AppendMsg() to avoid SMTP dot transparent output from
  4561. TIdMessage.SaveToStream(). The reason for this is because I don't
  4562. know how this method is being used and I don't want to break anything
  4563. that may be depending on that transparent output being generated...}
  4564. LMsg.SaveToStream(AStream);
  4565. {TODO: add an optional parameter to specify whether dot transparency
  4566. should be used or not, and then pass that to SaveToStream(). Or better,
  4567. just deprecate this method and implement a replacement that downloads
  4568. the message directly to the file without dot transparency, since it
  4569. has no meaning in IMAP. InternalRetrieve() uses an internal stream
  4570. anyway to receive the data, so let's just cut out TIdMessage here...}
  4571. Result := True;
  4572. end;
  4573. finally
  4574. FreeAndNil(LMsg);
  4575. end;
  4576. end;
  4577. function TIdIMAP4.UIDRetrievePeek(const AMsgUID: String; AMsg: TIdMessage): Boolean;
  4578. begin
  4579. Result := InternalRetrieve(UIDToUInt32(AMsgUID), True, True, AMsg);
  4580. end;
  4581. function TIdIMAP4.InternalRetrieve(const AMsgNum: UInt32; AUseUID: Boolean; AUsePeek: Boolean; AMsg: TIdMessage): Boolean;
  4582. var
  4583. LStr: String;
  4584. LCmd: string;
  4585. LDestStream: TStream;
  4586. LHelper: TIdIMAP4WorkHelper;
  4587. begin
  4588. Result := False;
  4589. IsNumberValid(AMsgNum);
  4590. CheckConnectionState(csSelected);
  4591. LCmd := '';
  4592. if AUseUID then begin
  4593. LCmd := LCmd + IMAP4Commands[cmdUID] + ' '; {Do not Localize}
  4594. end;
  4595. LCmd := LCmd + IMAP4Commands[cmdFetch] + ' ' + IntToStr(Int64(AMsgNum)) + ' ('; {Do not Localize}
  4596. if AUsePeek then begin
  4597. LCmd := LCmd + IMAP4FetchDataItem[fdBodyPeek]; {Do not Localize}
  4598. end else begin
  4599. LCmd := LCmd + IMAP4FetchDataItem[fdRFC822]; {Do not Localize}
  4600. end;
  4601. LCmd := LCmd + ')'; {Do not Localize}
  4602. SendCmd(NewCmdCounter, LCmd, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], True, False);
  4603. if LastCmdResult.Code = IMAP_OK then begin
  4604. {CC3: Catch "Connection reset by peer"...}
  4605. try
  4606. //Leave 3rd param as [] because ParseLastCmdResult can get a number of odd
  4607. //replies ( variants on Body[] )...
  4608. if (LastCmdResult.Text.Count < 1) or
  4609. (not ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch], [])) then
  4610. begin
  4611. Exit;
  4612. end;
  4613. {CC8: Retrieve via byte count instead of looking for terminator,
  4614. which was impossible to get working with all the different IMAP
  4615. servers because some left the terminator (LExpectedResponse) at
  4616. the end of a message line, so you could not decide if it was
  4617. part of the message or the terminator.}
  4618. AMsg.Clear;
  4619. if FLineStruct.ByteCount > 0 then begin
  4620. {Use a temporary memory block to suck the message into...}
  4621. // TODO: use TIdTCPStream instead and let TIdIOHandlerStreamMsg below read
  4622. // from this IOHandler directly so we don't have to waste memory reading
  4623. // potentially large messages...
  4624. LDestStream := TMemoryStream.Create;
  4625. try
  4626. LHelper := TIdIMAP4WorkHelper.Create(Self);
  4627. try
  4628. IOHandler.ReadStream(LDestStream, FLineStruct.ByteCount); //ReadStream uses OnWork, most other methods dont
  4629. finally
  4630. FreeAndNil(LHelper);
  4631. end;
  4632. {Feed stream into the standard message parser...}
  4633. LDestStream.Position := 0;
  4634. {RLebeau 12/09/2012: this is a workaround to a design limitation in
  4635. TIdMessage.LoadFromStream(). It assumes the stream data is always
  4636. in an escaped format using SMTP dot transparency, but that is not
  4637. the case in IMAP! Until this design is corrected, we have to use a
  4638. workaround for now. This logic is copied from TIdMessage.LoadFromStream()
  4639. and slightly tweaked...}
  4640. //AMsg.LoadFromStream(LDestStream);
  4641. {$IFDEF HAS_CLASS_HELPER}
  4642. AMsg.LoadFromStream(LDestStream, False, False);
  4643. {$ELSE}
  4644. TIdMessageHelper_LoadFromStream(AMsg, LDestStream, False, False);
  4645. {$ENDIF}
  4646. finally
  4647. FreeAndNil(LDestStream);
  4648. end;
  4649. end;
  4650. LStr := IOHandler.ReadLnWait; {Remove trailing line after the message, probably a ')' }
  4651. ParseLastCmdResultButAppendInfo(LStr); //There may be a UID or FLAGS in this
  4652. if GetInternalResponse(LastCmdCounter, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], False) = IMAP_OK then begin
  4653. AMsg.UID := FLineStruct.UID;
  4654. if (AMsg.UID = '') and AUseUID then begin
  4655. AMsg.UID := IntToStr(Int64(AMsgNum));
  4656. end;
  4657. AMsg.Flags := FLineStruct.Flags;
  4658. Result := True;
  4659. end;
  4660. except
  4661. on E: EIdSocketError do begin
  4662. if ((E.LastError = Id_WSAECONNABORTED) or (E.LastError = Id_WSAECONNRESET)) then begin
  4663. FConnectionState := csUnexpectedlyDisconnected;
  4664. end;
  4665. raise;
  4666. end;
  4667. end;
  4668. end;
  4669. end;
  4670. function TIdIMAP4.RetrieveAllHeaders(AMsgList: TIdMessageCollection): Boolean;
  4671. begin
  4672. Result := InternalRetrieveHeaders(AMsgList, -1);
  4673. end;
  4674. function TIdIMAP4.RetrieveFirstHeaders(AMsgList: TIdMessageCollection; ACount: Integer): Boolean;
  4675. begin
  4676. Result := InternalRetrieveHeaders(AMsgList, ACount);
  4677. end;
  4678. function TIdIMAP4.InternalRetrieveHeaders(AMsgList: TIdMessageCollection; ACount: Integer): Boolean;
  4679. var
  4680. LMsgItem : TIdMessageItem;
  4681. Ln : Integer;
  4682. begin
  4683. {CC2: This may get a response of "OK completed" if there are no messages}
  4684. CheckConnectionState(csSelected);
  4685. Result := False;
  4686. if AMsgList <> nil then begin
  4687. if (ACount < 0) or (ACount > FMailBox.TotalMsgs) then begin
  4688. ACount := FMailBox.TotalMsgs;
  4689. end;
  4690. // TODO: can this be accomplished using a single FETCH, similar to RetrieveAllEnvelopes()?
  4691. for Ln := 1 to ACount do begin
  4692. LMsgItem := AMsgList.Add;
  4693. if not RetrieveHeader(Ln, LMsgItem.Msg) then begin
  4694. Exit;
  4695. end;
  4696. end;
  4697. Result := True;
  4698. end;
  4699. end;
  4700. function TIdIMAP4.RetrieveAllMsgs(AMsgList: TIdMessageCollection): Boolean;
  4701. begin
  4702. Result := InternalRetrieveMsgs(AMsgList, -1);
  4703. end;
  4704. function TIdIMAP4.RetrieveFirstMsgs(AMsgList: TIdMessageCollection; ACount: Integer): Boolean;
  4705. begin
  4706. Result := InternalRetrieveMsgs(AMsgList, ACount);
  4707. end;
  4708. function TIdIMAP4.InternalRetrieveMsgs(AMsgList: TIdMessageCollection; ACount: Integer): Boolean;
  4709. var
  4710. LMsgItem : TIdMessageItem;
  4711. Ln : Integer;
  4712. begin
  4713. {CC2: This may get a response of "OK completed" if there are no messages}
  4714. CheckConnectionState(csSelected);
  4715. Result := False;
  4716. if AMsgList <> nil then begin
  4717. if (ACount < 0) or (ACount > FMailBox.TotalMsgs) then begin
  4718. ACount := FMailBox.TotalMsgs;
  4719. end;
  4720. // TODO: can this be accomplished using a single FETCH, similar to RetrieveAllEnvelopes()?
  4721. for Ln := 1 to ACount do begin
  4722. LMsgItem := AMsgList.Add;
  4723. if not Retrieve(Ln, LMsgItem.Msg) then begin
  4724. Exit;
  4725. end;
  4726. end;
  4727. Result := True;
  4728. end;
  4729. end;
  4730. function TIdIMAP4.DeleteMsgs(const AMsgNumList: array of UInt32): Boolean;
  4731. begin
  4732. Result := StoreFlags(AMsgNumList, sdAdd, [mfDeleted]);
  4733. end;
  4734. function TIdIMAP4.UIDDeleteMsg(const AMsgUID: String): Boolean;
  4735. begin
  4736. Result := UIDStoreFlags(AMsgUID, sdAdd, [mfDeleted]);
  4737. end;
  4738. function TIdIMAP4.UIDDeleteMsgs(const AMsgUIDList: array of String): Boolean;
  4739. begin
  4740. Result := UIDStoreFlags(AMsgUIDList, sdAdd, [mfDeleted]);
  4741. end;
  4742. function TIdIMAP4.RetrieveMailBoxSize: Int64;
  4743. var
  4744. Ln : Integer;
  4745. begin
  4746. Result := -1;
  4747. CheckConnectionState(csSelected);
  4748. {CC2: This should not be checking FMailBox.TotalMsgs because the server may
  4749. have added messages to the mailbox unknown to us, and we are going to ask the
  4750. server anyway (if it's empty, we will return 0 anyway}
  4751. SendCmd(NewCmdCounter,
  4752. IMAP4Commands[cmdFetch] + ' 1:*' + ' (' + IMAP4FetchDataItem[fdRFC822Size] + ')', {Do not Localize}
  4753. [IMAP4Commands[cmdFetch]]);
  4754. if LastCmdResult.Code = IMAP_OK then begin
  4755. Result := 0;
  4756. for Ln := 0 to FMailBox.TotalMsgs - 1 do begin
  4757. if ParseLastCmdResult(LastCmdResult.Text[Ln], IMAP4Commands[cmdFetch], [IMAP4FetchDataItem[fdRFC822Size]]) then begin
  4758. Result := Result + IndyStrToInt64( FLineStruct.IMAPValue );
  4759. end else begin
  4760. {CC2: Return -1, not 0, if we cannot parse the result...}
  4761. Result := -1;
  4762. Exit;
  4763. end;
  4764. end;
  4765. end;
  4766. end;
  4767. function TIdIMAP4.UIDRetrieveMailBoxSize: Int64;
  4768. var
  4769. Ln : Integer;
  4770. begin
  4771. Result := -1;
  4772. CheckConnectionState(csSelected);
  4773. {CC2: This should not be checking FMailBox.TotalMsgs because the server may
  4774. have added messages to the mailbox unknown to us, and we are going to ask the
  4775. server anyway (if it's empty, we will return 0 anyway}
  4776. SendCmd(NewCmdCounter,
  4777. IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdFetch] + ' 1:*' + ' (' + IMAP4FetchDataItem[fdRFC822Size] + ')', {Do not Localize}
  4778. [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]]);
  4779. if LastCmdResult.Code = IMAP_OK then begin
  4780. Result := 0;
  4781. for Ln := 0 to FMailBox.TotalMsgs - 1 do begin
  4782. if ParseLastCmdResult(LastCmdResult.Text[Ln], IMAP4Commands[cmdFetch], [IMAP4FetchDataItem[fdRFC822Size]]) then begin
  4783. Result := Result + IndyStrToInt64(FLineStruct.IMAPValue);
  4784. end else begin
  4785. {CC2: Return -1, not 0, if we cannot parse the result...}
  4786. Result := -1;
  4787. Break;
  4788. end;
  4789. end;
  4790. end;
  4791. end;
  4792. function TIdIMAP4.RetrieveMsgSize(const AMsgNum: UInt32): Int64;
  4793. begin
  4794. Result := -1;
  4795. IsNumberValid(AMsgNum);
  4796. CheckConnectionState(csSelected);
  4797. SendCmd(NewCmdCounter,
  4798. IMAP4Commands[cmdFetch] + ' ' + IntToStr(Int64(AMsgNum)) + ' (' + IMAP4FetchDataItem[fdRFC822Size] + ')', {Do not Localize}
  4799. [IMAP4Commands[cmdFetch]]);
  4800. if LastCmdResult.Code = IMAP_OK then begin
  4801. if (LastCmdResult.Text.Count > 0) and
  4802. ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch], [IMAP4FetchDataItem[fdRFC822Size]]) then begin
  4803. Result := IndyStrToInt64(FLineStruct.IMAPValue);
  4804. end;
  4805. end;
  4806. end;
  4807. function TIdIMAP4.UIDRetrieveMsgSize(const AMsgUID: String): Int64;
  4808. begin
  4809. Result := -1;
  4810. IsUIDValid(AMsgUID);
  4811. CheckConnectionState(csSelected);
  4812. SendCmd(NewCmdCounter,
  4813. IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdFetch] + ' ' + AMsgUID + ' (' + IMAP4FetchDataItem[fdRFC822Size] + ')', {Do not Localize}
  4814. [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]]);
  4815. if LastCmdResult.Code = IMAP_OK then begin
  4816. if (LastCmdResult.Text.Count > 0) and
  4817. ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch], [IMAP4FetchDataItem[fdRFC822Size]]) then begin
  4818. Result := IndyStrToInt64(FLineStruct.IMAPValue);
  4819. end;
  4820. end;
  4821. end;
  4822. function TIdIMAP4.CheckMsgSeen(const AMsgNum: UInt32): Boolean;
  4823. begin
  4824. Result := False;
  4825. IsNumberValid(AMsgNum);
  4826. CheckConnectionState(csSelected);
  4827. SendCmd(NewCmdCounter,
  4828. IMAP4Commands[cmdFetch] + ' ' + IntToStr(Int64(AMsgNum)) + ' (' + IMAP4FetchDataItem[fdFlags] + ')', {Do not Localize}
  4829. [IMAP4Commands[cmdFetch]]);
  4830. if LastCmdResult.Code = IMAP_OK then begin
  4831. if (LastCmdResult.Text.Count > 0) and
  4832. ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch], [IMAP4FetchDataItem[fdFlags]]) then
  4833. begin
  4834. if mfSeen in FLineStruct.Flags then begin
  4835. Result := True;
  4836. end;
  4837. end;
  4838. end;
  4839. end;
  4840. function TIdIMAP4.UIDCheckMsgSeen(const AMsgUID: String): Boolean;
  4841. begin
  4842. {Default to unseen, so if get no flags back (i.e. no \Seen flag)
  4843. we return False (i.e. we return it is unseen)
  4844. Some servers return nothing at all if no flags set (the better ones return an empty set).}
  4845. Result := False;
  4846. IsUIDValid(AMsgUID);
  4847. CheckConnectionState(csSelected);
  4848. SendCmd(NewCmdCounter,
  4849. IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdFetch] + ' ' + AMsgUID + ' (' + IMAP4FetchDataItem[fdFlags] + ')', {Do not Localize}
  4850. [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]]);
  4851. if LastCmdResult.Code = IMAP_OK then begin
  4852. if (LastCmdResult.Text.Count > 0) and
  4853. ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch], [IMAP4FetchDataItem[fdFlags]]) then
  4854. begin
  4855. if mfSeen in FLineStruct.Flags then begin
  4856. Result := True;
  4857. end;
  4858. end;
  4859. end;
  4860. end;
  4861. function TIdIMAP4.RetrieveFlags(const AMsgNum: UInt32; var AFlags: {Pointer}TIdMessageFlagsSet): Boolean;
  4862. begin
  4863. Result := False;
  4864. {CC: Empty set to avoid returning results from a previous call if call fails}
  4865. AFlags := [];
  4866. IsNumberValid(AMsgNum);
  4867. CheckConnectionState(csSelected);
  4868. SendCmd(NewCmdCounter,
  4869. IMAP4Commands[cmdFetch] + ' ' + IntToStr(Int64(AMsgNum)) + ' (' + IMAP4FetchDataItem[fdFlags] + ')', {Do not Localize}
  4870. [IMAP4Commands[cmdFetch]]);
  4871. if LastCmdResult.Code = IMAP_OK then begin
  4872. if (LastCmdResult.Text.Count > 0) and
  4873. ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch], [IMAP4FetchDataItem[fdFlags]]) then
  4874. begin
  4875. AFlags := FLineStruct.Flags;
  4876. Result := True;
  4877. end;
  4878. end;
  4879. end;
  4880. function TIdIMAP4.UIDRetrieveFlags(const AMsgUID: String; var AFlags: TIdMessageFlagsSet): Boolean;
  4881. begin
  4882. Result := False;
  4883. {BUG FIX: Empty set to avoid returning results from a previous call if call fails}
  4884. AFlags := [];
  4885. IsUIDValid(AMsgUID);
  4886. CheckConnectionState(csSelected);
  4887. SendCmd(NewCmdCounter,
  4888. IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdFetch] + ' ' + AMsgUID + ' (' + IMAP4FetchDataItem[fdFlags] + ')', {Do not Localize}
  4889. [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]]);
  4890. if LastCmdResult.Code = IMAP_OK then begin
  4891. if (LastCmdResult.Text.Count > 0) and
  4892. ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch], [IMAP4FetchDataItem[fdFlags]]) then
  4893. begin
  4894. AFlags := FLineStruct.Flags;
  4895. Result := True;
  4896. end;
  4897. end;
  4898. end;
  4899. function TIdIMAP4.RetrieveValue(const AMsgNum: UInt32; const AField: String; var AValue: String): Boolean;
  4900. begin
  4901. Result := False;
  4902. {CC: Empty string to avoid returning results from a previous call if call fails}
  4903. AValue := '';
  4904. IsNumberValid(AMsgNum);
  4905. CheckConnectionState(csSelected);
  4906. SendCmd(NewCmdCounter,
  4907. IMAP4Commands[cmdFetch] + ' ' + IntToStr(Int64(AMsgNum)) + ' (' + AField + ')', {Do not Localize}
  4908. [IMAP4Commands[cmdFetch]]);
  4909. if LastCmdResult.Code = IMAP_OK then begin
  4910. if (LastCmdResult.Text.Count > 0) and
  4911. ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch], [AField]) then
  4912. begin
  4913. case PosInStrArray(AField, ['UID', 'FLAGS', 'X-GM-MSGID', 'X-GM-THRID', 'X-GM-LABELS'], False) of {Do not Localize}
  4914. 0: AValue := FLineStruct.UID;
  4915. 1: AValue := FLineStruct.FlagsStr;
  4916. 2: AValue := FLineStruct.GmailMsgID;
  4917. 3: AValue := FLineStruct.GmailThreadID;
  4918. 4: AValue := FLineStruct.GmailLabels;
  4919. else
  4920. AValue := FLineStruct.IMAPValue;
  4921. end;
  4922. Result := True;
  4923. end;
  4924. end;
  4925. end;
  4926. function TIdIMAP4.UIDRetrieveValue(const AMsgUID: String; const AField: String; var AValue: String): Boolean;
  4927. begin
  4928. Result := False;
  4929. {CC: Empty string to avoid returning results from a previous call if call fails}
  4930. AValue := '';
  4931. IsUIDValid(AMsgUID);
  4932. CheckConnectionState(csSelected);
  4933. SendCmd(NewCmdCounter,
  4934. IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdFetch] + ' ' + AMsgUID + ' (' + AField + ')', {Do not Localize}
  4935. [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]]);
  4936. if LastCmdResult.Code = IMAP_OK then begin
  4937. if (LastCmdResult.Text.Count > 0) and
  4938. ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch], [AField]) then
  4939. begin
  4940. case PosInStrArray(AField, ['UID', 'FLAGS', 'X-GM-MSGID', 'X-GM-THRID', 'X-GM-LABELS'], False) of {Do not Localize}
  4941. 0: AValue := FLineStruct.UID;
  4942. 1: AValue := FLineStruct.FlagsStr;
  4943. 2: AValue := FLineStruct.GmailMsgID;
  4944. 3: AValue := FLineStruct.GmailThreadID;
  4945. 4: AValue := FLineStruct.GmailLabels;
  4946. else
  4947. AValue := FLineStruct.IMAPValue;
  4948. end;
  4949. Result := True;
  4950. end;
  4951. end;
  4952. end;
  4953. function TIdIMAP4.GetConnectionStateName: String;
  4954. begin
  4955. case FConnectionState of
  4956. csAny : Result := RSIMAP4ConnectionStateAny;
  4957. csNonAuthenticated : Result := RSIMAP4ConnectionStateNonAuthenticated;
  4958. csAuthenticated : Result := RSIMAP4ConnectionStateAuthenticated;
  4959. csSelected : Result := RSIMAP4ConnectionStateSelected;
  4960. csUnexpectedlyDisconnected : Result := RSIMAP4ConnectionStateUnexpectedlyDisconnected;
  4961. end;
  4962. end;
  4963. { TIdIMAP4 Commands }
  4964. { Parser Functions... }
  4965. {This recursively parses down. It gets either a line like:
  4966. "text" "plain" ("charset" "ISO-8859-1") NIL NIL "7bit" 40 1 NIL NIL NIL
  4967. which it parses into AThisImapPart, and we are done (at the end of the
  4968. recursive calls), or a line like:
  4969. ("text" "plain"...NIL)("text" "html"...NIL) "alternative" ("boundary" "----bdry") NIL NIL
  4970. when we need to add "alternative" and the boundary to this part, but recurse
  4971. down for the 1st two parts. }
  4972. procedure TIdIMAP4.ParseImapPart(ABodyStructure: string;
  4973. AImapParts: TIdImapMessageParts; AThisImapPart: TIdImapMessagePart; AParentImapPart: TIdImapMessagePart; //ImapPart version
  4974. APartNumber: integer);
  4975. var
  4976. LNextImapPart: TIdImapMessagePart;
  4977. LSubParts: TStringList;
  4978. LPartNumber: integer;
  4979. begin
  4980. ABodyStructure := Trim(ABodyStructure);
  4981. AThisImapPart.FUnparsedEntry := ABodyStructure;
  4982. if ABodyStructure[1] <> '(' then begin {Do not Localize}
  4983. //We are at the bottom. Parse the low-level '"text" "plain"...' into this part.
  4984. ParseBodyStructurePart(ABodyStructure, nil, AThisImapPart);
  4985. if AParentImapPart = nil then begin
  4986. //This is the top-level part, and it is "text" "plain" etc, so it is not MIME...
  4987. AThisImapPart.Encoding := mePlainText;
  4988. AThisImapPart.ImapPartNumber := '1'; {Do not Localize}
  4989. AThisImapPart.ParentPart := -1;
  4990. end else begin
  4991. AThisImapPart.Encoding := meMIME;
  4992. AThisImapPart.ImapPartNumber := AParentImapPart.ImapPartNumber+'.'+IntToStr(APartNumber); {Do not Localize}
  4993. //If we are the first level down in MIME, the parent part was '', so trim...
  4994. if AThisImapPart.ImapPartNumber[1] = '.' then begin {Do not Localize}
  4995. AThisImapPart.ImapPartNumber := Copy(AThisImapPart.ImapPartNumber, 2, MaxInt);
  4996. end;
  4997. AThisImapPart.ParentPart := AParentImapPart.Index;
  4998. end;
  4999. end else begin
  5000. AThisImapPart.Encoding := meMIME;
  5001. if AParentImapPart = nil then begin
  5002. AThisImapPart.ImapPartNumber := '';
  5003. AThisImapPart.ParentPart := -1;
  5004. end else begin
  5005. AThisImapPart.ImapPartNumber := AParentImapPart.ImapPartNumber+'.'+IntToStr(APartNumber); {Do not Localize}
  5006. //If we are the first level down in MIME, the parent part was '', so trim...
  5007. if AThisImapPart.ImapPartNumber[1] = '.' then begin {Do not Localize}
  5008. AThisImapPart.ImapPartNumber := Copy(AThisImapPart.ImapPartNumber, 2, MaxInt);
  5009. end;
  5010. AThisImapPart.ParentPart := AParentImapPart.Index;
  5011. end;
  5012. LSubParts := TStringList.Create;
  5013. try
  5014. ParseIntoBrackettedQuotedAndUnquotedParts(ABodyStructure, LSubParts, True);
  5015. LPartNumber := 1;
  5016. while (LSubParts.Count > 0) and (LSubParts[0] <> '') and (LSubParts[0][1] = '(') do begin {Do not Localize}
  5017. LNextImapPart := AImapParts.Add;
  5018. ParseImapPart(Copy(LSubParts[0], 2, Length(LSubParts[0])-2), AImapParts, LNextImapPart, AThisImapPart, LPartNumber);
  5019. LSubParts.Delete(0);
  5020. Inc(LPartNumber);
  5021. end;
  5022. if LSubParts.Count > 0 then begin
  5023. //LSubParts now (only) holds the params for this part...
  5024. AThisImapPart.FBodyType := LowerCase(GetNextQuotedParam(LSubParts[0], True)); //mixed, alternative
  5025. end else begin
  5026. AThisImapPart.FBodyType := '';
  5027. end;
  5028. finally
  5029. FreeAndNil(LSubParts);
  5030. end;
  5031. end;
  5032. end;
  5033. { WARNING: Not used by writer, may have bugs.
  5034. Version of ParseImapPart except using TIdMessageParts.
  5035. Added for compatibility with TIdMessage.MessageParts,
  5036. but does not have enough functionality for many IMAP functions. }
  5037. procedure TIdIMAP4.ParseMessagePart(ABodyStructure: string;
  5038. AMessageParts: TIdMessageParts; AThisMessagePart: TIdMessagePart; AParentMessagePart: TIdMessagePart; //MessageParts version
  5039. APartNumber: integer);
  5040. var
  5041. LNextMessagePart: TIdMessagePart;
  5042. LSubParts: TStringList;
  5043. LPartNumber: integer;
  5044. begin
  5045. ABodyStructure := Trim(ABodyStructure);
  5046. if ABodyStructure[1] <> '(' then begin {Do not Localize}
  5047. //We are at the bottom. Parse this into this part.
  5048. ParseBodyStructurePart(ABodyStructure, AThisMessagePart, nil);
  5049. if AParentMessagePart = nil then begin
  5050. //This is the top-level part, and it is "text" "plain" etc, so it is not MIME...
  5051. AThisMessagePart.ParentPart := -1;
  5052. end else begin
  5053. AThisMessagePart.ParentPart := AParentMessagePart.Index;
  5054. end;
  5055. end else begin
  5056. LSubParts := TStringList.Create;
  5057. try
  5058. ParseIntoBrackettedQuotedAndUnquotedParts(ABodyStructure, LSubParts, True);
  5059. LPartNumber := 1;
  5060. while (LSubParts.Count > 0) and (LSubParts[0] <> '') and (LSubParts[0][1] = '(') do begin {Do not Localize}
  5061. LNextMessagePart := TIdAttachmentMemory.Create(AMessageParts);
  5062. ParseMessagePart(Copy(LSubParts[0], 2, Length(LSubParts[0])-2), AMessageParts, LNextMessagePart, AThisMessagePart, LPartNumber);
  5063. LSubParts.Delete(0);
  5064. Inc(LPartNumber);
  5065. end;
  5066. //LSubParts now (only) holds the params for this part...
  5067. if AParentMessagePart = nil then begin
  5068. AThisMessagePart.ParentPart := -1;
  5069. end else begin
  5070. AThisMessagePart.ParentPart := AParentMessagePart.Index;
  5071. end;
  5072. finally
  5073. FreeAndNil(LSubParts);
  5074. end;
  5075. end;
  5076. end;
  5077. {CC2: Function added to support individual part retreival}
  5078. {
  5079. If it's a single-part message, it won't be enclosed in brackets - it will be:
  5080. "body type": "TEXT", "application", "image", "MESSAGE" (followed by subtype RFC822 for envelopes, ignore)
  5081. "body subtype": "PLAIN", "octet-stream", "tiff", "html"
  5082. "body parameter parenthesized list": bracketted list of pairs ("CHARSET" "US-ASCII" "NAME" "cc.tif" "format" "flowed"), ("charset" "ISO-8859-1")
  5083. "body id": NIL, [email protected]
  5084. "body description": NIL, "Compiler diff"
  5085. "body encoding": "7bit" "8bit" "binary" (NO encoding used with these), "quoted-printable" "base64" "ietf-token" "x-token"
  5086. "body size" 2279
  5087. "body lines" 48 (only present for some types, only those with "body type=text" and "body subtype=plain" that I found, if not present it WONT be a NIL, it just won't be there! However, it won't be needed)
  5088. <don't know> NIL
  5089. <don't know> ("inline" ("filename" "classbd.h")), ("attachment" ("filename" "DEGDAY.WB3"))
  5090. <don't know> NIL
  5091. Example:
  5092. * 4 FETCH (BODYSTRUCTURE ("text" "plain" ("charset" "ISO-8859-1") NIL NIL "7bit" 40 1 NIL NIL NIL))
  5093. ---------------------------------------------------------------------------
  5094. For most multi-part messages, each part will be bracketted:
  5095. ( (part 1 stuff) (part 2 stuff) "mixed" (boundary) NIL NIL )
  5096. Example:
  5097. * 1 FETCH (BODYSTRUCTURE (("text" "plain" ("charset" "us-ascii" "format" "flowed")
  5098. NIL NIL "7bit" 52 3 NIL NIL NIL)("text" "plain" ("name" "tnkin.txt") NIL NIL
  5099. "7bit" 28421 203 NIL ("inline" ("filename" "tnkin.txt")) NIL) "mixed"
  5100. ("boundary" "------------070105030104060407030601") NIL NIL))
  5101. ---------------------------------------------------------------------------
  5102. Some multiparts are bracketted again. This is the "alternative" encoding,
  5103. part 1 has two parts, a plain-text part and a html part:
  5104. ( ( (part 1a stuff) (part 1b stuff) "alternative" (boundary) NIL NIL ) (part 2 stuff) "mixed" (boundary) NIL NIL )
  5105. 1 2 2 1
  5106. Example:
  5107. * 50 FETCH (BODYSTRUCTURE ((("text" "plain" ("charset" "ISO-8859-1") NIL NIL
  5108. "quoted-printable" 415 12 NIL NIL NIL)("text" "html" ("charset" "ISO-8859-1")
  5109. NIL NIL "quoted-printable" 1034 25 NIL NIL NIL) "alternative" ("boundary"
  5110. "----=_NextPart_001_0027_01C33A37.33CFE220") NIL NIL)("application" "x-zip-compressed"
  5111. ("name" "IdIMAP4.zip") NIL NIL "base64" 20572 NIL ("attachment" ("filename"
  5112. "IdIMAP4.zip")) NIL) "mixed" ("boundary" "----=_NextPart_000_0026_01C33A37.33CFE220")
  5113. NIL NIL) UID 62)
  5114. }
  5115. procedure TIdIMAP4.ParseBodyStructureResult(ABodyStructure: string; ATheParts: TIdMessageParts; AImapParts: TIdImapMessageParts);
  5116. begin
  5117. {CC7: New code uses a different parsing method that allows for multisection parts.}
  5118. if AImapParts <> nil then begin //Just sort out the ImapParts version for now
  5119. ParseImapPart(ABodyStructure, AImapParts, AImapParts.Add, nil, -1);
  5120. end;
  5121. if ATheParts <> nil then begin
  5122. ParseMessagePart(ABodyStructure, ATheParts, TIdAttachmentMemory.Create(ATheParts), nil, -1);
  5123. end;
  5124. end;
  5125. procedure TIdIMAP4.ParseTheLine(ALine: string; APartsList: TStrings);
  5126. var
  5127. LTempList: TStringList;
  5128. LN: integer;
  5129. LStr, LWord: string;
  5130. begin
  5131. {Parse it and see what we get...}
  5132. LTempList := TStringList.Create;
  5133. try
  5134. ParseIntoParts(ALine, LTempList);
  5135. {Copy any parts from LTempList into the list of parts LPartsList...}
  5136. for LN := 0 to LTempList.Count-1 do begin
  5137. LStr := LTempList.Strings[LN];
  5138. LWord := LowerCase(GetNextWord(LStr));
  5139. if CharEquals(LStr, 1, '(') or (PosInStrArray(LWord, ['"text"', '"image"', '"application"'], False) <> -1) then begin {Do not Localize}
  5140. APartsList.Add(LStr);
  5141. end;
  5142. end;
  5143. finally
  5144. FreeAndNil(LTempList);
  5145. end;
  5146. end;
  5147. procedure TIdIMAP4.ParseBodyStructurePart(APartString: string; AThePart: TIdMessagePart;
  5148. AImapPart: TIdImapMessagePart);
  5149. {CC3: Function added to support individual part retreival}
  5150. var
  5151. LParams: TStringList;
  5152. // LContentDispositionStuff: string;
  5153. LCharSet: String;
  5154. LFilename: string;
  5155. LDescription: string;
  5156. LTemp: string;
  5157. LSize: Int64;
  5158. LPos: Integer;
  5159. begin
  5160. {Individual parameters may be strings like "text", NIL, a number, or bracketted pairs like
  5161. ("CHARSET" "US-ASCII" "NAME" "cc.tif" "format" "flowed")...}
  5162. {There are three common line formats, with differing numbers of parameters:
  5163. (a) "TEXT" "HTML" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 2879 69 NIL NIL NIL
  5164. (a) "TEXT" "HTML" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 2879 69 NIL NIL
  5165. (c) "TEXT" "HTML" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 2879 69
  5166. Note the last one only has 7 parameters, need to watch we don't index past the 7th!}
  5167. LParams := TStringList.Create;
  5168. try
  5169. ParseIntoParts(APartString, LParams);
  5170. {Build up strings into same format as used by message decoders...}
  5171. {Content Disposition: If present, may be at index 8 or 9...}
  5172. {CC8: Altered to allow for case where it may not be present at all (get "List
  5173. index out of bounds" error if try to access non-existent LParams[9])...}
  5174. // LContentDispositionStuff := ''; {Do not Localize}
  5175. // if LParams.Count > 9 then begin {Have an LParams[9]}
  5176. // if TextIsSame(LParams[9], 'NIL') then begin {Do not Localize}
  5177. {It's NIL at 9, must be at 8...}
  5178. // if TextIsSame(LParams[8], 'NIL') then begin {Do not Localize}
  5179. // LContentDispositionStuff := LParams[8];
  5180. // end;
  5181. // end else begin
  5182. {It's not NIL, must be valid...}
  5183. // LContentDispositionStuff := LParams[9];
  5184. // end;
  5185. // end else if LParams.Count > 8 then begin {Have an LParams[8]}
  5186. // if TextIsSame(LParams[8], 'NIL') then begin {Do not Localize}
  5187. // LContentDispositionStuff := LParams[8];
  5188. // end;
  5189. // end;
  5190. {Find and clean up the filename, if present...}
  5191. LFilename := ''; {Do not Localize}
  5192. LPos := IndyPos('"NAME"', UpperCase(APartString)); {Do not Localize}
  5193. if LPos > 0 then begin
  5194. LTemp := Copy(APartString, LPos+7, MaxInt);
  5195. LFilename := GetNextQuotedParam(LTemp, False);
  5196. end else
  5197. begin
  5198. LPos := IndyPos('"FILENAME"', UpperCase(APartString)); {Do not Localize}
  5199. if LPos > 0 then begin
  5200. LTemp := Copy(APartString, LPos+11, MaxInt);
  5201. LFilename := GetNextQuotedParam(LTemp, False);
  5202. end;
  5203. end;
  5204. {If the filename starts and ends with double-quotes, remove them...}
  5205. if Length(LFilename) > 1 then begin
  5206. if TextStartsWith(LFilename, '"') and TextEndsWith(LFilename, '"') then begin {Do not Localize}
  5207. LFilename := Copy(LFilename, 2, Length(LFilename)-2);
  5208. end;
  5209. end;
  5210. {CC7: The filename may be encoded, so decode it...}
  5211. if Length(LFilename) > 1 then begin
  5212. LFilename := DecodeHeader(LFilename);
  5213. end;
  5214. LCharSet := '';
  5215. if IndyPos('"CHARSET"', UpperCase(LParams[2])) > 0 then begin {Do not Localize}
  5216. LTemp := Copy(LParams[2], IndyPos('"CHARSET" ', UpperCase(LParams[2]))+10, MaxInt); {Do not Localize}
  5217. LCharSet := GetNextQuotedParam(LTemp, True);
  5218. end;
  5219. LSize := 0;
  5220. if (not TextIsSame(LParams[6], 'NIL')) and (Length(LParams[6]) <> 0) then begin
  5221. LSize := IndyStrToInt64(LParams[6]); {Do not Localize}
  5222. end;
  5223. LDescription := ''; {Do not Localize}
  5224. if (LParams.Count > 9) and (not TextIsSame(LParams[9], 'NIL')) then begin {Do not Localize}
  5225. LDescription := GetNextQuotedParam(LParams[9], False);
  5226. end else if (LParams.Count > 8) and (not TextIsSame(LParams[8], 'NIL')) then begin {Do not Localize}
  5227. LDescription := GetNextQuotedParam(LParams[8], False);
  5228. end;
  5229. if AThePart <> nil then begin
  5230. {Put into the same format as TIdMessage MessageParts...}
  5231. AThePart.ContentType := LParams[0]+'/'+LParams[1]+ParseBodyStructureSectionAsEquates(LParams[2]); {Do not Localize}
  5232. AThePart.ContentTransfer := LParams[5];
  5233. //Watch out for BinHex4.0, the encoding is inferred from the Content-Type...
  5234. if IsHeaderMediaType(AThePart.ContentType, 'application/mac-binhex40') then begin {do not localize}
  5235. AThePart.ContentTransfer := 'binhex40'; {do not localize}
  5236. end;
  5237. AThePart.DisplayName := LFilename;
  5238. end;
  5239. if AImapPart <> nil then begin
  5240. AImapPart.FBodyType := LParams[0];
  5241. AImapPart.FBodySubType := LParams[1];
  5242. AImapPart.FFileName := LFilename;
  5243. AImapPart.FDescription := LDescription;
  5244. AImapPart.FCharSet := LCharSet;
  5245. AImapPart.FContentTransferEncoding := LParams[5];
  5246. AImapPart.FSize := LSize;
  5247. //Watch out for BinHex4.0, the encoding is inferred from the Content-Type...
  5248. if ( (TextIsSame(AImapPart.FBodyType, 'application')) {do not localize}
  5249. and (TextIsSame(AImapPart.FBodySubType, 'mac-binhex40')) ) then begin {do not localize}
  5250. AImapPart.FContentTransferEncoding := 'binhex40'; {do not localize}
  5251. end;
  5252. end;
  5253. finally
  5254. FreeAndNil(LParams);
  5255. end;
  5256. end;
  5257. function ResolveQuotedSpecials(const AParam: string): string;
  5258. begin
  5259. // Handle quoted_specials, RFC1730
  5260. // \ with other chars than " or \ after, looks illegal in RFC1730, but leave them untouched
  5261. // TODO: use StringsReplace() instead
  5262. //Result := StringsReplace(AParam, ['\"', '\\'], ['"', '\']);
  5263. Result := ReplaceAll(AParam, '\"', '"');
  5264. Result := ReplaceAll(Result, '\\', '\');
  5265. end;
  5266. procedure TIdIMAP4.ParseIntoParts(APartString: string; AParams: TStrings);
  5267. var
  5268. LInPart: Integer;
  5269. LStartPos: Integer;
  5270. //don't rename this LParam. That's the same asa windows identifier
  5271. LParamater: string;
  5272. LBracketLevel: Integer;
  5273. Ln: Integer;
  5274. LInQuotesInsideBrackets: Boolean;
  5275. LInQuotedSpecial: Boolean;
  5276. begin
  5277. LStartPos := 0; {Stop compiler whining}
  5278. LBracketLevel := 0; {Stop compiler whining}
  5279. LInQuotesInsideBrackets := False; {Stop compiler whining}
  5280. LInQuotedSpecial := False; {Stop compiler whining}
  5281. LInPart := 0; {0 is not in a part, 1 is in a quote-delimited part, 2 is in a bracketted parameter-pair list}
  5282. for Ln := 1 to Length(APartString) do begin
  5283. if (LInPart = 1) or ((LInPart = 2) and LInQuotesInsideBrackets) then begin
  5284. if LInQuotedSpecial then begin
  5285. LInQuotedSpecial := False;
  5286. end
  5287. else if APartString[Ln] = '\' then begin {Do not Localize}
  5288. LInQuotedSpecial := True;
  5289. end
  5290. else if APartString[Ln] = '"' then begin {Do not Localize}
  5291. if LInPart = 1 then begin
  5292. LParamater := Copy(APartString, LStartPos+1, Ln-LStartPos-1);
  5293. AParams.Add(ResolveQuotedSpecials(LParamater));
  5294. LInPart := 0;
  5295. end else begin
  5296. LInQuotesInsideBrackets := False;
  5297. end;
  5298. end;
  5299. end else if LInPart = 2 then begin
  5300. //We have to watch out that we don't close this entry on a closing bracket within
  5301. //quotes, like ("Blah" "Blah)Blah"), so monitor if we are in quotes within brackets.
  5302. if APartString[Ln] = '"' then begin {Do not Localize}
  5303. LInQuotesInsideBrackets := True;
  5304. LInQuotedSpecial := False;
  5305. end
  5306. else if APartString[Ln] = '(' then begin {Do not Localize}
  5307. Inc(LBracketLevel);
  5308. end
  5309. else if APartString[Ln] = ')' then begin {Do not Localize}
  5310. Dec(LBracketLevel);
  5311. if LBracketLevel = 0 then begin
  5312. LParamater := Copy(APartString, LStartPos+1, Ln-LStartPos-1);
  5313. AParams.Add(ResolveQuotedSpecials(LParamater));
  5314. LInPart := 0;
  5315. end;
  5316. end;
  5317. end else if LInPart = 3 then begin
  5318. if APartString[Ln] = 'L' then begin {Do not Localize}
  5319. LParamater := Copy(APartString, LStartPos, Ln-LStartPos+1);
  5320. AParams.Add(LParamater);
  5321. LInPart := 0;
  5322. end;
  5323. end else if LInPart = 4 then begin
  5324. if not IsNumeric(APartString[Ln]) then begin
  5325. LParamater := Copy(APartString, LStartPos, Ln-LStartPos);
  5326. AParams.Add(LParamater);
  5327. LInPart := 0;
  5328. end;
  5329. end else if APartString[Ln] = '"' then begin {Do not Localize}
  5330. {Start of a quoted param like "text"}
  5331. LStartPos := Ln;
  5332. LInPart := 1;
  5333. LInQuotedSpecial := False;
  5334. end else if APartString[Ln] = '(' then begin {Do not Localize}
  5335. {Start of a set of paired parameter/value strings within brackets,
  5336. such as ("charset" "us-ascii"). Note these can be nested (bracket pairs
  5337. within bracket pairs) }
  5338. LStartPos := Ln;
  5339. LInPart := 2;
  5340. LBracketLevel := 1;
  5341. LInQuotesInsideBrackets := False;
  5342. end else if TextIsSame(APartString[Ln], 'N') then begin {Do not Localize}
  5343. {Start of a NIL entry}
  5344. LStartPos := Ln;
  5345. LInPart := 3;
  5346. end else if IsNumeric(APartString[Ln]) then begin
  5347. {Start of a numeric entry like 12345}
  5348. LStartPos := Ln;
  5349. LInPart := 4;
  5350. end;
  5351. end;
  5352. {We could be in a numeric entry when we hit the end of the line...}
  5353. if LInPart = 4 then begin
  5354. LParamater := Copy(APartString, LStartPos, MaxInt);
  5355. AParams.Add(LParamater);
  5356. end;
  5357. end;
  5358. procedure TIdIMAP4.ParseIntoBrackettedQuotedAndUnquotedParts(APartString: string; AParams: TStrings; AKeepBrackets: Boolean);
  5359. var
  5360. LInPart: Integer;
  5361. LStartPos: Integer;
  5362. //don't rename this back to LParam, that's a Windows identifier.
  5363. LParamater: string;
  5364. LBracketLevel: Integer;
  5365. Ln: Integer;
  5366. LInQuotesInsideBrackets: Boolean;
  5367. LInQuotedSpecial: Boolean;
  5368. begin
  5369. {Break:
  5370. * LIST (\UnMarked \AnotherFlag) "/" "Mailbox name"
  5371. into:
  5372. *
  5373. LIST
  5374. (\UnMarked \AnotherFlag)
  5375. "/"
  5376. "Mailbox name"
  5377. If AKeepBrackets is false, return '\UnMarked \AnotherFlag' instead of '(\UnMarked \AnotherFlag)'
  5378. }
  5379. AParams.BeginUpdate;
  5380. try
  5381. AParams.Clear;
  5382. LStartPos := 0; {Stop compiler whining}
  5383. LBracketLevel := 0; {Stop compiler whining}
  5384. LInQuotesInsideBrackets := False; {Stop compiler whining}
  5385. LInQuotedSpecial := False; {Stop compiler whining}
  5386. LInPart := 0; {0 is not in a part, 1 is in a quote-delimited part, 2 is in a bracketted part, 3 is a word}
  5387. APartString := Trim(APartString);
  5388. for Ln := 1 to Length(APartString) do begin
  5389. if (LInPart = 1) or ((LInPart = 2) and LInQuotesInsideBrackets) then begin
  5390. if LInQuotedSpecial then begin
  5391. LInQuotedSpecial := False;
  5392. end
  5393. else if APartString[Ln] = '\' then begin {Do not Localize}
  5394. LInQuotedSpecial := True;
  5395. end
  5396. else if APartString[Ln] = '"' then begin {Do not Localize}
  5397. if LInPart = 1 then begin
  5398. LParamater := Copy(APartString, LStartPos+1, Ln-LStartPos-1);
  5399. AParams.Add(ResolveQuotedSpecials(LParamater));
  5400. LInPart := 0;
  5401. end else begin
  5402. LInQuotesInsideBrackets := False;
  5403. end;
  5404. end;
  5405. end else if LInPart = 2 then begin
  5406. //We have to watch out that we don't close this entry on a closing bracket within
  5407. //quotes, like ("Blah" "Blah)Blah"), so monitor if we are in quotes within brackets.
  5408. if APartString[Ln] = '"' then begin {Do not Localize}
  5409. LInQuotesInsideBrackets := True;
  5410. LInQuotedSpecial := False;
  5411. end
  5412. else if APartString[Ln] = '(' then begin {Do not Localize}
  5413. Inc(LBracketLevel);
  5414. end
  5415. else if APartString[Ln] = ')' then begin {Do not Localize}
  5416. Dec(LBracketLevel);
  5417. if LBracketLevel = 0 then begin
  5418. if AKeepBrackets then begin
  5419. LParamater := Copy(APartString, LStartPos, Ln-LStartPos+1);
  5420. end else begin
  5421. LParamater := Copy(APartString, LStartPos+1, Ln-LStartPos-1);
  5422. end;
  5423. AParams.Add(ResolveQuotedSpecials(LParamater));
  5424. LInPart := 0;
  5425. end;
  5426. end;
  5427. end else if LInPart = 3 then begin
  5428. if APartString[Ln] = ' ' then begin {Do not Localize}
  5429. LParamater := Copy(APartString, LStartPos, Ln-LStartPos);
  5430. AParams.Add(LParamater);
  5431. LInPart := 0;
  5432. end;
  5433. end else if APartString[Ln] = '"' then begin {Do not Localize}
  5434. {Start of a quoted param like "text"}
  5435. LStartPos := Ln;
  5436. LInPart := 1;
  5437. LInQuotedSpecial := False;
  5438. end else if APartString[Ln] = '(' then begin {Do not Localize}
  5439. {Start of a set of paired parameter/value strings within brackets,
  5440. such as ("charset" "us-ascii"). Note these can be nested (bracket pairs
  5441. within bracket pairs) }
  5442. LStartPos := Ln;
  5443. LInPart := 2;
  5444. LBracketLevel := 1;
  5445. LInQuotesInsideBrackets := False;
  5446. end else if APartString[Ln] <> ' ' then begin {Do not Localize}
  5447. {Start of an entry like 12345}
  5448. LStartPos := Ln;
  5449. LInPart := 3;
  5450. end;
  5451. end;
  5452. {We could be in an entry when we hit the end of the line...}
  5453. if LInPart = 3 then begin
  5454. LParamater := Copy(APartString, LStartPos, MaxInt);
  5455. AParams.Add(LParamater);
  5456. end else if LInPart = 2 then begin
  5457. if AKeepBrackets then begin
  5458. LParamater := Copy(APartString, LStartPos, MaxInt);
  5459. end else begin
  5460. LParamater := Copy(APartString, LStartPos+1, MaxInt);
  5461. end;
  5462. if (not AKeepBrackets) and TextEndsWith(LParamater, ')') then begin {Do not Localize}
  5463. LParamater := Copy(LParamater, 1, Length(LParamater)-1);
  5464. end;
  5465. AParams.Add(ResolveQuotedSpecials(LParamater));
  5466. end else if LInPart = 1 then begin
  5467. LParamater := Copy(APartString, LStartPos+1, MaxInt);
  5468. if TextEndsWith(LParamater, '"') then begin {Do not Localize}
  5469. LParamater := Copy(LParamater, 1, Length(LParamater)-1);
  5470. end;
  5471. AParams.Add(ResolveQuotedSpecials(LParamater));
  5472. end;
  5473. finally
  5474. AParams.EndUpdate;
  5475. end;
  5476. end;
  5477. function TIdIMAP4.ParseBodyStructureSectionAsEquates(AParam: string): string;
  5478. {Convert:
  5479. "Name1" "Value1" "Name2" "Value2"
  5480. to:
  5481. ; Name1="Value1"; Name2="Value2"
  5482. }
  5483. var
  5484. LParse: TStringList;
  5485. LN: integer;
  5486. begin
  5487. Result := ''; {Do not Localize}
  5488. if (Length(AParam) = 0) or TextIsSame(AParam, 'NIL') then begin {Do not Localize}
  5489. Exit;
  5490. end;
  5491. LParse := TStringList.Create;
  5492. try
  5493. BreakApartParamsInQuotes(AParam, LParse);
  5494. if LParse.Count < 2 then begin
  5495. Exit;
  5496. end;
  5497. if ((LParse.Count mod 2) <> 0) then begin
  5498. Exit;
  5499. end;
  5500. for LN := 0 to ((LParse.Count div 2)-1) do begin
  5501. Result := Result + '; ' + Copy(LParse[LN*2], 2, Length(LParse[LN*2])-2) + '=' + LParse[(LN*2)+1]; {Do not Localize}
  5502. end;
  5503. finally
  5504. FreeAndNil(LParse);
  5505. end;
  5506. end;
  5507. function TIdIMAP4.ParseBodyStructureSectionAsEquates2(AParam: string): string;
  5508. {Convert:
  5509. "Name1" ("Name2" "Value2")
  5510. to:
  5511. Name1; Name2="Value2"
  5512. }
  5513. var
  5514. LParse: TStringList;
  5515. LParams: string;
  5516. begin
  5517. Result := ''; {Do not Localize}
  5518. if (Length(AParam) = 0) or TextIsSame(AParam, 'NIL') then begin {Do not Localize}
  5519. Exit;
  5520. end;
  5521. LParse := TStringList.Create;
  5522. try
  5523. BreakApart(AParam, ' ', LParse); {Do not Localize}
  5524. if LParse.Count < 3 then begin
  5525. Exit;
  5526. end;
  5527. LParams := Copy(AParam, Pos('(', AParam)+1, MaxInt); {Do not Localize}
  5528. LParams := Copy(LParams, 1, Length(LParams)-1);
  5529. LParams := ParseBodyStructureSectionAsEquates(LParams);
  5530. if Length(LParams) = 0 then begin {Do not Localize}
  5531. Result := Copy(LParse[0], 2, Length(LParse[0])-2) + LParams;
  5532. end;
  5533. finally
  5534. FreeAndNil(LParse);
  5535. end;
  5536. end;
  5537. function TIdIMAP4.GetNextWord(AParam: string): string;
  5538. var
  5539. LPos: integer;
  5540. begin
  5541. Result := ''; {Do not Localize}
  5542. AParam := Trim(AParam);
  5543. LPos := Pos(' ', AParam); {Do not Localize}
  5544. if LPos = 0 then begin
  5545. Exit;
  5546. end;
  5547. Result := Copy(AParam, 1, LPos-1);
  5548. end;
  5549. function TIdIMAP4.GetNextQuotedParam(AParam: string; ARemoveQuotes: Boolean): string;
  5550. {If AParam is:
  5551. "file name.ext" NIL NIL
  5552. then this returns:
  5553. "file name.ext"
  5554. Note it returns the quotes, UNLESS ARemoveQuotes is True.
  5555. Also note that if AParam does NOT start with a quote, it returns the next word.
  5556. }
  5557. var
  5558. LN: integer;
  5559. LPos: integer;
  5560. begin
  5561. Result := '';
  5562. {CCB: Modified code so it did not access past the end of the string if
  5563. AParam was not actually in quotes (e.g. the MIME boundary parameter
  5564. is only optionally in quotes).}
  5565. LN := 1;
  5566. {Skip any preceding spaces...}
  5567. //TODO: use TrimLeft(AParam) instead
  5568. while (LN <= Length(AParam)) and (AParam[LN] = ' ') do begin {Do not Localize}
  5569. LN := LN + 1;
  5570. end;
  5571. if LN > Length(AParam) then begin
  5572. Exit;
  5573. end;
  5574. if AParam[LN] <> '"' then begin {Do not Localize}
  5575. {Not actually enclosed in quotes. Must be a single word.}
  5576. // TODO: use Fetch(AParam) instead
  5577. AParam := Copy(AParam, LN, MaxInt);
  5578. LPos := Pos(' ', AParam); {Do not Localize}
  5579. if LPos > 0 then begin
  5580. {Strip off this word...}
  5581. Result := Copy(AParam, 1, LPos-1);
  5582. end else begin
  5583. {This is the last word on the line, return it all...}
  5584. Result := AParam;
  5585. end;
  5586. end else begin
  5587. {It starts with a quote...}
  5588. // TODO: use Fetch(AParam, '"') instead
  5589. // TODO: do we need to handle escaped characters?
  5590. AParam := Copy(AParam, LN, MaxInt);
  5591. LN := 2;
  5592. while (LN <= Length(AParam)) and (AParam[LN] <> '"') do begin {Do not Localize}
  5593. LN := LN + 1;
  5594. end;
  5595. Result := Copy(AParam, 1, LN);
  5596. if ARemoveQuotes then begin
  5597. Result := Copy(Result, 2, Length(Result)-2);
  5598. end;
  5599. end;
  5600. end;
  5601. procedure TIdIMAP4.BreakApartParamsInQuotes(const AParam: string; AParsedList: TStrings);
  5602. var
  5603. Ln : Integer;
  5604. LStartPos: Integer;
  5605. begin
  5606. LStartPos := -1;
  5607. AParsedList.BeginUpdate;
  5608. try
  5609. AParsedList.Clear;
  5610. for Ln := 1 to Length(AParam) do begin
  5611. if AParam[LN] = '"' then begin {Do not Localize}
  5612. if LStartPos > -1 then begin
  5613. {The end of a quoted parameter...}
  5614. AParsedList.Add(Copy(AParam, LStartPos, LN-LStartPos+1));
  5615. LStartPos := -1;
  5616. end else begin
  5617. {The start of a quoted parameter...}
  5618. LStartPos := Ln;
  5619. end;
  5620. end;
  5621. end;
  5622. finally
  5623. AParsedList.EndUpdate;
  5624. end;
  5625. end;
  5626. procedure TIdIMAP4.ParseExpungeResult(AMB: TIdMailBox; ACmdResultDetails: TStrings);
  5627. var
  5628. Ln, LCnt: Integer;
  5629. LSlExpunge : TStringList;
  5630. begin
  5631. SetLength(AMB.DeletedMsgs, 0);
  5632. if ACmdResultDetails.Count > 0 then begin
  5633. LSlExpunge := TStringList.Create;
  5634. try
  5635. // TODO: count the number of EXPUNGE entries and allocate the DeletedMsgs array one time...
  5636. LCnt := 0;
  5637. try
  5638. for Ln := 0 to ACmdResultDetails.Count - 1 do begin
  5639. // TODO: maybe use Fetch() instead and get rid of the TStringList altogether?
  5640. BreakApart(ACmdResultDetails[Ln], ' ', LSlExpunge); {Do not Localize}
  5641. if LSlExpunge.Count > 1 then begin
  5642. if TextIsSame(LSlExpunge[1], IMAP4Commands[cmdExpunge]) then begin
  5643. SetLength(AMB.DeletedMsgs, LCnt + 1);
  5644. AMB.DeletedMsgs[LCnt] := UInt32(IndyStrToInt64(LSlExpunge[0]));
  5645. Inc(LCnt);
  5646. end;
  5647. end;
  5648. LSlExpunge.Clear;
  5649. end;
  5650. finally
  5651. SetLength(AMB.DeletedMsgs, LCnt);
  5652. end;
  5653. finally
  5654. FreeAndNil(LSlExpunge);
  5655. end;
  5656. end;
  5657. end;
  5658. procedure TIdIMAP4.ParseMessageFlagString(AFlagsList: String; var AFlags: TIdMessageFlagsSet);
  5659. {CC5: Note this only supports the system flags defined in RFC 2060.}
  5660. var
  5661. LSlFlags : TStringList;
  5662. Ln, I : Integer;
  5663. begin
  5664. AFlags := [];
  5665. LSlFlags := TStringList.Create;
  5666. try
  5667. BreakApart(AFlagsList, ' ', LSlFlags); {Do not Localize}
  5668. for Ln := 0 to LSlFlags.Count-1 do begin
  5669. I := PosInStrArray(
  5670. LSlFlags[Ln],
  5671. [MessageFlags[mfAnswered], MessageFlags[mfFlagged], MessageFlags[mfDeleted], MessageFlags[mfDraft], MessageFlags[mfSeen], MessageFlags[mfRecent]],
  5672. False);
  5673. case I of
  5674. 0..5: Include(AFlags, TIdMessageFlags(I));
  5675. end;
  5676. end;
  5677. finally
  5678. FreeAndNil(LSlFlags);
  5679. end;
  5680. end;
  5681. procedure TIdIMAP4.ParseMailBoxAttributeString(AAttributesList: String; var AAttributes: TIdMailBoxAttributesSet);
  5682. var
  5683. LSlAttributes : TStringList;
  5684. Ln : Integer;
  5685. I: Integer;
  5686. begin
  5687. AAttributes := [];
  5688. LSlAttributes := TStringList.Create;
  5689. try
  5690. BreakApart(AAttributesList, ' ', LSlAttributes); {Do not Localize}
  5691. for Ln := 0 to LSlAttributes.Count - 1 do begin
  5692. I := PosInStrArray(
  5693. LSlAttributes[Ln],
  5694. [MailBoxAttributes[maNoinferiors], MailBoxAttributes[maNoselect], MailBoxAttributes[maMarked], MailBoxAttributes[maUnmarked]],
  5695. False);
  5696. case I of
  5697. 0..3: Include(AAttributes, TIdMailBoxAttributes(I));
  5698. end;
  5699. end;
  5700. finally
  5701. FreeAndNil(LSlAttributes);
  5702. end;
  5703. end;
  5704. procedure TIdIMAP4.ParseSearchResult(AMB: TIdMailBox; ACmdResultDetails: TStrings);
  5705. var
  5706. Ln, LCnt: Integer;
  5707. LSlSearch: TStringList;
  5708. begin
  5709. SetLength(AMB.SearchResult, 0);
  5710. if ACmdResultDetails.Count > 0 then begin
  5711. LSlSearch := TStringList.Create;
  5712. try
  5713. // TODO: maybe use a Fetch() loop instead and get rid of the TStringList altogether?
  5714. BreakApart(ACmdResultDetails[0], ' ', LSlSearch); {Do not Localize}
  5715. if LSlSearch.Count > 0 then begin
  5716. if TextIsSame(LSlSearch[0], IMAP4Commands[cmdSearch]) then begin
  5717. SetLength(AMB.SearchResult, LSlSearch.Count - 1);
  5718. LCnt := 0;
  5719. try
  5720. for Ln := 1 to LSlSearch.Count - 1 do
  5721. begin
  5722. // TODO: for a UID search, store LSlSearch[Ln] as-is without converting it to an Integer...
  5723. AMB.SearchResult[LCnt] := UInt32(IndyStrToInt64(LSlSearch[Ln]));
  5724. Inc(LCnt);
  5725. end;
  5726. finally
  5727. SetLength(AMB.SearchResult, LCnt);
  5728. end;
  5729. end;
  5730. end;
  5731. finally
  5732. FreeAndNil(LSlSearch);
  5733. end;
  5734. end;
  5735. end;
  5736. procedure TIdIMAP4.ParseStatusResult(AMB: TIdMailBox; ACmdResultDetails: TStrings);
  5737. var
  5738. Ln: Integer;
  5739. LRespStr : String;
  5740. LStatStr: String;
  5741. LStatPos: Integer;
  5742. LSlStatus : TStringList;
  5743. begin
  5744. LSlStatus := TStringList.Create;
  5745. try
  5746. if ACmdResultDetails.Count > 0 then
  5747. begin
  5748. // TODO: convert server response to uppercase?
  5749. LRespStr := Trim(ACmdResultDetails[0]);
  5750. LStatPos := Pos(IMAP4Commands[cmdStatus], LRespStr);
  5751. if (LStatPos > 0) then
  5752. begin
  5753. LStatStr := Trim(Copy(LRespStr,
  5754. LStatPos+Length(IMAP4Commands[cmdStatus]), Length(LRespStr)));
  5755. AMB.Name := Trim(Fetch(LStatStr, '(', True)); {do not localize}
  5756. if TextEndsWith(LStatStr, ')') then begin {do not localize}
  5757. IdDelete(LStatStr, Length(LStatStr), 1);
  5758. end;
  5759. BreakApart(LStatStr, ' ', LSlStatus); {do not localize}
  5760. // find status data items by name, values are on following line
  5761. Ln := LSlStatus.IndexOf(IMAP4StatusDataItem[mdMessages]);
  5762. if Ln <> -1 then begin
  5763. AMB.TotalMsgs := IndyStrToInt(LSlStatus[Ln + 1]);
  5764. end;
  5765. Ln := LSlStatus.IndexOf(IMAP4StatusDataItem[mdRecent]);
  5766. if Ln <> -1 then begin
  5767. AMB.RecentMsgs := IndyStrToInt(LSlStatus[Ln + 1]);
  5768. end;
  5769. Ln := LSlStatus.IndexOf(IMAP4StatusDataItem[mdUnseen]);
  5770. if Ln <> -1 then begin
  5771. AMB.UnseenMsgs := IndyStrToInt(LSlStatus[Ln + 1]);
  5772. end;
  5773. Ln := LSlStatus.IndexOf(IMAP4StatusDataItem[mdUIDNext]);
  5774. if Ln <> -1 then begin
  5775. AMB.UIDNext := LSlStatus[Ln + 1];
  5776. end;
  5777. Ln := LSlStatus.IndexOf(IMAP4StatusDataItem[mdUIDValidity]);
  5778. if Ln <> -1 then begin
  5779. AMB.UIDValidity := LSlStatus[Ln + 1];
  5780. end;
  5781. end;
  5782. end;
  5783. finally
  5784. FreeAndNil(LSlStatus);
  5785. end;
  5786. end;
  5787. procedure TIdIMAP4.ParseSelectResult(AMB : TIdMailBox; ACmdResultDetails: TStrings);
  5788. var
  5789. Ln : Integer;
  5790. LStr : String;
  5791. LFlags: TIdMessageFlagsSet;
  5792. LLine: String;
  5793. LPos: Integer;
  5794. begin
  5795. AMB.Clear;
  5796. for Ln := 0 to ACmdResultDetails.Count - 1 do begin
  5797. LLine := ACmdResultDetails[Ln];
  5798. LPos := Pos(' EXISTS', LLine); {Do not Localize}
  5799. if LPos > 0 then begin
  5800. AMB.TotalMsgs := IndyStrToInt(Copy(LLine, 1, LPos - 1));
  5801. Continue;
  5802. end;
  5803. LPos := Pos(' RECENT', LLine); {Do not Localize}
  5804. if LPos > 0 then begin
  5805. AMB.RecentMsgs := IndyStrToInt(Copy(LLine, 1, LPos - 1)); {Do not Localize}
  5806. Continue;
  5807. end;
  5808. LPos := Pos('[UIDVALIDITY ', LLine); {Do not Localize}
  5809. if LPos > 0 then begin
  5810. Inc(LPos, 13);
  5811. AMB.UIDValidity := Trim(Copy(LLine, LPos, (Integer(PosIdx(']', LLine, LPos)) - LPos))); {Do not Localize}
  5812. Continue;
  5813. end;
  5814. LPos := Pos('[UIDNEXT ', LLine); {Do not Localize}
  5815. if LPos > 0 then begin
  5816. Inc(LPos, 9);
  5817. AMB.UIDNext := Trim(Copy(LLine, LPos, (Integer(PosIdx(']', LLine, LPos)) - LPos))); {Do not Localize}
  5818. Continue;
  5819. end;
  5820. LPos := Pos('[PERMANENTFLAGS ', LLine); {Do not Localize}
  5821. if LPos > 0 then begin {Do not Localize}
  5822. LPos := PosIdx('(', LLine, LPos + 16) + 1; {Do not Localize}
  5823. ParseMessageFlagString(Copy(LLine, LPos, Integer(PosIdx(')', LLine, LPos)) - LPos), LFlags); {Do not Localize}
  5824. AMB.ChangeableFlags := LFlags;
  5825. Continue;
  5826. end;
  5827. LPos := Pos('FLAGS ', LLine); {Do not Localize}
  5828. if LPos > 0 then begin
  5829. LPos := PosIdx('(', LLine, LPos + 6) + 1; {Do not Localize}
  5830. ParseMessageFlagString(Copy(LLine, LPos, (Integer(PosIdx(')', LLine, LPos)) - LPos)), LFlags); {Do not Localize}
  5831. AMB.Flags := LFlags;
  5832. Continue;
  5833. end;
  5834. LPos := Pos('[UNSEEN ', LLine); {Do not Localize}
  5835. if LPos> 0 then begin
  5836. Inc(LPos, 8);
  5837. AMB.FirstUnseenMsg := UInt32(IndyStrToInt64(Copy(LLine, LPos, (Integer(PosIdx(']', LLine, LPos)) - LPos)))); {Do not Localize}
  5838. Continue;
  5839. end;
  5840. LPos := Pos('[READ-', LLine); {Do not Localize}
  5841. if LPos > 0 then begin
  5842. Inc(LPos, 6);
  5843. LStr := Trim(Copy(LLine, LPos, Integer(PosIdx(']', LLine, LPos)) - LPos)); {Do not Localize}
  5844. {CCB: AMB.State ambiguous unless coded response received - default to msReadOnly...}
  5845. if TextIsSame(LStr, 'WRITE') then begin {Do not Localize}
  5846. AMB.State := msReadWrite;
  5847. end else {if TextIsSame(LStr, 'ONLY') then} begin {Do not Localize}
  5848. AMB.State := msReadOnly;
  5849. end;
  5850. Continue;
  5851. end;
  5852. LPos := Pos('[ALERT]', LLine); {Do not Localize}
  5853. if LPos > 0 then begin
  5854. LStr := Trim(Copy(LLine, LPos + 7, MaxInt));
  5855. if Length(LStr) <> 0 then begin
  5856. DoAlert(LStr);
  5857. end;
  5858. Continue;
  5859. end;
  5860. end;
  5861. end;
  5862. procedure TIdIMAP4.ParseListResult(AMBList: TStrings; ACmdResultDetails: TStrings);
  5863. begin
  5864. InternalParseListResult(IMAP4Commands[cmdList], AMBList, ACmdResultDetails);
  5865. end;
  5866. procedure TIdIMAP4.InternalParseListResult(ACmd: string; AMBList: TStrings; ACmdResultDetails: TStrings);
  5867. var Ln : Integer;
  5868. LSlRetrieve : TStringList;
  5869. LStr : String;
  5870. LWord: string;
  5871. begin
  5872. AMBList.BeginUpdate;
  5873. try
  5874. AMBList.Clear;
  5875. LSlRetrieve := TStringList.Create;
  5876. try
  5877. for Ln := 0 to ACmdResultDetails.Count - 1 do begin
  5878. LStr := ACmdResultDetails[Ln];
  5879. //Todo: Get mail box attributes here
  5880. {CC2: Could put mailbox attributes in AMBList's Objects property?}
  5881. {The line is of the form:
  5882. * LIST (\UnMarked \AnotherFlag) "/" "Mailbox name"
  5883. }
  5884. {CCA: code modified because some servers return NIL as the mailbox
  5885. separator, i.e.:
  5886. * LIST (\UnMarked \AnotherFlag) NIL "Mailbox name"
  5887. }
  5888. ParseIntoBrackettedQuotedAndUnquotedParts(LStr, LSlRetrieve, False);
  5889. if LSlRetrieve.Count > 3 then begin
  5890. //Make sure 1st word is LIST (may be an unsolicited response)...
  5891. if TextIsSame(LSlRetrieve[0], {IMAP4Commands[cmdList]} ACmd) then begin
  5892. {Get the mailbox separator...}
  5893. LWord := Trim(LSlRetrieve[LSlRetrieve.Count-2]);
  5894. if TextIsSame(LWord, 'NIL') or (LWord = '') then begin {Do not Localize}
  5895. FMailBoxSeparator := #0;
  5896. end else begin
  5897. FMailBoxSeparator := LWord[1];
  5898. end;
  5899. {Now get the mailbox name...}
  5900. LWord := Trim(LSlRetrieve[LSlRetrieve.Count-1]);
  5901. AMBList.Add(DoMUTFDecode(LWord));
  5902. end;
  5903. end;
  5904. end;
  5905. finally
  5906. FreeAndNil(LSlRetrieve);
  5907. end;
  5908. finally
  5909. AMBList.EndUpdate;
  5910. end;
  5911. end;
  5912. procedure TIdIMAP4.ParseLSubResult(AMBList: TStrings; ACmdResultDetails: TStrings);
  5913. begin
  5914. InternalParseListResult(IMAP4Commands[cmdLSub], AMBList, ACmdResultDetails);
  5915. end;
  5916. procedure TIdIMAP4.ParseEnvelopeResult(AMsg: TIdMessage; ACmdResultStr: String);
  5917. procedure DecodeEnvelopeAddress(const AAddressStr: String; AEmailAddressItem: TIdEmailAddressItem); overload;
  5918. var
  5919. LStr, LTemp: String;
  5920. I: Integer;
  5921. {$IFNDEF DOTNET}
  5922. LPChar: PChar;
  5923. {$ENDIF}
  5924. begin
  5925. if TextStartsWith(AAddressStr, '(') and TextEndsWith(AAddressStr, ')') and {Do not Localize}
  5926. Assigned(AEmailAddressItem) then begin
  5927. LStr := Copy(AAddressStr, 2, Length (AAddressStr) - 2);
  5928. //Gets the name part
  5929. if TextStartsWith(LStr, 'NIL ') then begin {Do not Localize}
  5930. LStr := Copy(LStr, 5, MaxInt); {Do not Localize}
  5931. end
  5932. else if TextStartsWith(LStr, '{') then begin {Do not Localize}
  5933. LStr := Copy(LStr, Pos('}', LStr) + 1, MaxInt); {Do not Localize}
  5934. I := Pos('" ', LStr);
  5935. AEmailAddressItem.Name := Copy(LStr, 1, I-1); {Do not Localize}
  5936. LStr := Copy(LStr, I+2, MaxInt); {Do not Localize}
  5937. end else begin
  5938. I := Pos('" ', LStr);
  5939. LTemp := Copy(LStr, 1, I);
  5940. {$IFDEF DOTNET}
  5941. AEmailAddressItem.Name := Copy(LTemp, 2, Length(LTemp)-2); {ExtractQuotedStr ( LTemp, '"' ); {Do not Localize}
  5942. {$ELSE}
  5943. LPChar := PChar(LTemp);
  5944. AEmailAddressItem.Name := AnsiExtractQuotedStr(LPChar, '"'); {Do not Localize}
  5945. {$ENDIF}
  5946. LStr := Copy(LStr, I+2, MaxInt); {Do not Localize}
  5947. end;
  5948. //Gets the source root part
  5949. if TextStartsWith(LStr, 'NIL ') then begin {Do not Localize}
  5950. LStr := Copy(LStr, 5, MaxInt); {Do not Localize}
  5951. end else begin
  5952. I := Pos('" ', LStr);
  5953. LTemp := Copy(LStr, 1, I);
  5954. {$IFDEF DOTNET}
  5955. AEmailAddressItem.Name := Copy(LTemp, 2, Length(LTemp)-2); {AnsiExtractQuotedStr ( LTemp, '"' ); {Do not Localize}
  5956. {$ELSE}
  5957. LPChar := PChar(LTemp);
  5958. AEmailAddressItem.Name := AnsiExtractQuotedStr(LPChar, '"'); {Do not Localize}
  5959. {$ENDIF}
  5960. LStr := Copy(LStr, I+2, MaxInt); {Do not Localize}
  5961. end;
  5962. //Gets the mailbox name part
  5963. if TextStartsWith(LStr, 'NIL ') then begin {Do not Localize}
  5964. LStr := Copy(LStr, 5, MaxInt); {Do not Localize}
  5965. end else begin
  5966. I := Pos('" ', LStr);
  5967. LTemp := Copy(LStr, 1, I); {Do not Localize}
  5968. {$IFDEF DOTNET}
  5969. AEmailAddressItem.Address := Copy(LTemp, 2, Length(LTemp)-2); {AnsiExtractQuotedStr ( LTemp, '"' ); {Do not Localize}
  5970. {$ELSE}
  5971. LPChar := PChar(LTemp);
  5972. AEmailAddressItem.Address := AnsiExtractQuotedStr(LPChar, '"'); {Do not Localize}
  5973. {$ENDIF}
  5974. LStr := Copy(LStr, I+2, MaxInt); {Do not Localize}
  5975. end;
  5976. //Gets the host name part
  5977. if not TextIsSame(LStr, 'NIL') then begin {Do not Localize}
  5978. LTemp := Copy(LStr, 1, MaxInt);
  5979. {$IFDEF DOTNET}
  5980. AEmailAddressItem.Address := AEmailAddressItem.Address + '@' + {Do not Localize}
  5981. Copy(LTemp, 2, Length(LTemp)-2); {AnsiExtractQuotedStr ( LTemp, '"' ); {Do not Localize}
  5982. {$ELSE}
  5983. LPChar := PChar(LTemp);
  5984. AEmailAddressItem.Address := AEmailAddressItem.Address + '@' + {Do not Localize}
  5985. AnsiExtractQuotedStr(LPChar, '"'); {Do not Localize}
  5986. {$ENDIF}
  5987. end;
  5988. end;
  5989. end;
  5990. procedure DecodeEnvelopeAddress(const AAddressStr: String; AEmailAddressList: TIdEmailAddressList); overload;
  5991. var
  5992. LStr: String;
  5993. I: Integer;
  5994. begin
  5995. if TextStartsWith(AAddressStr, '(') and TextEndsWith(AAddressStr, ')') and {Do not Localize}
  5996. Assigned(AEmailAddressList) then begin
  5997. LStr := Copy(AAddressStr, 2, Length (AAddressStr) - 2);
  5998. repeat
  5999. I := Pos(')', LStr);
  6000. if I = 0 then begin
  6001. Break;
  6002. end;
  6003. DecodeEnvelopeAddress(Copy(LStr, 1, I), AEmailAddressList.Add); {Do not Localize}
  6004. LStr := Trim(Copy(LStr, I+1, MaxInt)); {Do not Localize}
  6005. until False;
  6006. end;
  6007. end;
  6008. var
  6009. LStr, LTemp: String;
  6010. I: Integer;
  6011. {$IFNDEF DOTNET}
  6012. LPChar: PChar;
  6013. {$ENDIF}
  6014. begin
  6015. //The fields of the envelope structure are in the
  6016. //following order: date, subject, from, sender,
  6017. //reply-to, to, cc, bcc, in-reply-to, and message-id.
  6018. //The date, subject, in-reply-to, and message-id
  6019. //fields are strings. The from, sender, reply-to,
  6020. //to, cc, and bcc fields are parenthesized lists of
  6021. //address structures.
  6022. //An address structure is a parenthesized list that
  6023. //describes an electronic mail address. The fields
  6024. //of an address structure are in the following order:
  6025. //personal name, [SMTP] at-domain-list (source
  6026. //route), mailbox name, and host name.
  6027. //* 4 FETCH (ENVELOPE ("Sun, 15 Jul 2001 02:56:45 -0700 (PDT)" "Your Borland Commu
  6028. //nity Account Activation Code" (("Borland Community" NIL "mailbot" "borland.com")
  6029. //) NIL NIL (("" NIL "name" "company.com")) NIL NIL NIL "<200107150956.CAA1
  6030. //[email protected]>"))
  6031. {CC5: Cleared out any existing fields to avoid mangling new entries with old/stale ones.}
  6032. //Extract envelope date field
  6033. AMsg.Date := 0;
  6034. if TextStartsWith(ACmdResultStr, 'NIL ') then begin {Do not Localize}
  6035. ACmdResultStr := Copy(ACmdResultStr, 5, MaxInt);
  6036. end else begin
  6037. I := Pos('" ', ACmdResultStr); {Do not Localize}
  6038. LTemp := Copy(ACmdResultStr, 1, I);
  6039. {$IFDEF DOTNET}
  6040. LStr := Copy(LTemp, 2, Length(LTemp)-2);
  6041. {$ELSE}
  6042. LPChar := PChar(LTemp);
  6043. LStr := AnsiExtractQuotedStr(LPChar, '"'); {Do not Localize}
  6044. {$ENDIF}
  6045. AMsg.Date := GMTToLocalDateTime(LStr);
  6046. ACmdResultStr := Copy(ACmdResultStr, I+2, MaxInt);
  6047. end;
  6048. //Extract envelope subject field
  6049. AMsg.Subject := ''; {Do not Localize}
  6050. if TextStartsWith(ACmdResultStr, 'NIL ') then begin {Do not Localize}
  6051. ACmdResultStr := Copy(ACmdResultStr, 5, MaxInt);
  6052. end else begin
  6053. if TextStartsWith(ACmdResultStr, '{') then begin {Do not Localize}
  6054. ACmdResultStr := Copy(ACmdResultStr, Pos('}', ACmdResultStr) + 1, MaxInt); {Do not Localize}
  6055. I := Pos(' ', ACmdResultStr); {Do not Localize}
  6056. LStr := Copy(ACmdResultStr, 1, I-1);
  6057. AMsg.Subject := LStr;
  6058. ACmdResultStr := Copy(ACmdResultStr, I+1, MaxInt); {Do not Localize}
  6059. end else begin
  6060. I := Pos('" ', ACmdResultStr); {Do not Localize}
  6061. LTemp := Copy(ACmdResultStr, 1, I);
  6062. {$IFDEF DOTNET}
  6063. LStr := Copy(LTemp, 2, Length(LTemp)-2);
  6064. {$ELSE}
  6065. LPChar := PChar(LTemp);
  6066. LStr := AnsiExtractQuotedStr(LPChar, '"'); {Do not Localize}
  6067. {$ENDIF}
  6068. AMsg.Subject := LStr;
  6069. ACmdResultStr := Copy(ACmdResultStr, I+2, MaxInt); {Do not Localize}
  6070. end;
  6071. end;
  6072. //Extract envelope from field
  6073. AMsg.FromList.Clear;
  6074. if TextStartsWith(ACmdResultStr, 'NIL ') then begin {Do not Localize}
  6075. ACmdResultStr := Copy(ACmdResultStr, 5, MaxInt);
  6076. end else begin
  6077. I := Pos(')) ', ACmdResultStr); {Do not Localize}
  6078. LStr := Copy(ACmdResultStr, 1, I+1);
  6079. DecodeEnvelopeAddress(LStr, AMsg.FromList);
  6080. ACmdResultStr := Copy(ACmdResultStr, I+3, MaxInt);
  6081. end;
  6082. //Extract envelope sender field
  6083. AMsg.Sender.Name := ''; {Do not Localize}
  6084. AMsg.Sender.Address := ''; {Do not Localize}
  6085. if TextStartsWith(ACmdResultStr, 'NIL ') then begin {Do not Localize}
  6086. ACmdResultStr := Copy(ACmdResultStr, 5, MaxInt);
  6087. end else begin
  6088. {CC5: Fix parsing of sender...}
  6089. I := Pos(')) ', ACmdResultStr);
  6090. LStr := Copy(ACmdResultStr, 2, I-1);
  6091. DecodeEnvelopeAddress(LStr, AMsg.Sender);
  6092. ACmdResultStr := Copy(ACmdResultStr, I+3, MaxInt);
  6093. end;
  6094. //Extract envelope reply-to field
  6095. AMsg.ReplyTo.Clear;
  6096. if TextStartsWith(ACmdResultStr, 'NIL ') then begin {Do not Localize}
  6097. ACmdResultStr := Copy(ACmdResultStr, 5, MaxInt);
  6098. end else begin
  6099. I := Pos(')) ', ACmdResultStr); {Do not Localize}
  6100. LStr := Copy(ACmdResultStr, 1, I+1);
  6101. DecodeEnvelopeAddress(LStr, AMsg.ReplyTo);
  6102. ACmdResultStr := Copy(ACmdResultStr, I+3, MaxInt);
  6103. end;
  6104. //Extract envelope to field
  6105. AMsg.Recipients.Clear;
  6106. if TextStartsWith(ACmdResultStr, 'NIL ') then begin {Do not Localize}
  6107. ACmdResultStr := Copy(ACmdResultStr, 5, MaxInt);
  6108. end else begin
  6109. I := Pos(')) ', ACmdResultStr); {Do not Localize}
  6110. LStr := Copy(ACmdResultStr, 1, I+1);
  6111. DecodeEnvelopeAddress(LStr, AMsg.Recipients);
  6112. ACmdResultStr := Copy(ACmdResultStr, I+3, MaxInt);
  6113. end;
  6114. //Extract envelope cc field
  6115. AMsg.CCList.Clear;
  6116. if TextStartsWith(ACmdResultStr, 'NIL ') then begin {Do not Localize}
  6117. ACmdResultStr := Copy(ACmdResultStr, 5, MaxInt);
  6118. end else begin
  6119. I := Pos(')) ', ACmdResultStr); {Do not Localize}
  6120. LStr := Copy(ACmdResultStr, 1, I+1);
  6121. DecodeEnvelopeAddress(LStr, AMsg.CCList);
  6122. ACmdResultStr := Copy(ACmdResultStr, I+3, MaxInt);
  6123. end;
  6124. //Extract envelope bcc field
  6125. AMsg.BccList.Clear;
  6126. if TextStartsWith(ACmdResultStr, 'NIL ') then begin {Do not Localize}
  6127. ACmdResultStr := Copy(ACmdResultStr, 5, MaxInt);
  6128. end else begin
  6129. I := Pos(')) ', ACmdResultStr); {Do not Localize}
  6130. LStr := Copy(ACmdResultStr, 1, I+1);
  6131. DecodeEnvelopeAddress(LStr, AMsg.BccList);
  6132. ACmdResultStr := Copy(ACmdResultStr, I+3, MaxInt);
  6133. end;
  6134. //Extract envelope in-reply-to field
  6135. if TextStartsWith(ACmdResultStr, 'NIL ') then begin {Do not Localize}
  6136. ACmdResultStr := Copy(ACmdResultStr, 5, MaxInt);
  6137. end else begin
  6138. I := Pos('" ', ACmdResultStr); {Do not Localize}
  6139. LTemp := Copy(ACmdResultStr, 1, I);
  6140. {$IFDEF DOTNET}
  6141. LStr := Copy(LTemp, 2, Length(LTemp)-2);
  6142. {$ELSE}
  6143. LPChar := PChar(LTemp);
  6144. LStr := AnsiExtractQuotedStr(LPChar, '"'); {Do not Localize}
  6145. {$ENDIF}
  6146. AMsg.InReplyTo := LStr;
  6147. ACmdResultStr := Copy(ACmdResultStr, I+2, MaxInt);
  6148. end;
  6149. //Extract envelope message-id field
  6150. AMsg.MsgId := ''; {Do not Localize}
  6151. if TextStartsWith(ACmdResultStr, 'NIL ') then begin {Do not Localize}
  6152. ACmdResultStr := Copy(ACmdResultStr, 5, MaxInt);
  6153. end else begin
  6154. {$IFDEF DOTNET}
  6155. LStr := Copy(ACmdResultStr, 2, Length(ACmdResultStr)-2);
  6156. {$ELSE}
  6157. LPChar := PChar(ACmdResultStr);
  6158. LStr := AnsiExtractQuotedStr(LPChar, '"'); {Do not Localize}
  6159. {$ENDIF}
  6160. AMsg.MsgId := Trim(LStr);
  6161. end;
  6162. end;
  6163. function TIdIMAP4.ParseLastCmdResult(ALine: string; AExpectedCommand: string; AExpectedIMAPFunction: array of string): Boolean;
  6164. var
  6165. LPos: integer;
  6166. LWord: string;
  6167. LWords: TStringList;
  6168. LN: Integer;
  6169. LWordInExpectedIMAPFunction: Boolean;
  6170. begin
  6171. Result := False;
  6172. LWordInExpectedIMAPFunction := False;
  6173. FLineStruct.HasStar := False;
  6174. FLineStruct.MessageNumber := '';
  6175. FLineStruct.Command := '';
  6176. FLineStruct.UID := '';
  6177. FLineStruct.Flags := [];
  6178. FLineStruct.FlagsStr := '';
  6179. FLineStruct.Complete := True;
  6180. FLineStruct.IMAPFunction := '';
  6181. FLineStruct.IMAPValue := '';
  6182. FLineStruct.ByteCount := -1;
  6183. FLineStruct.GmailMsgID := '';
  6184. FLineStruct.GmailThreadID := '';
  6185. FLineStruct.GmailLabels := '';
  6186. ALine := Trim(ALine); //Can get garbage like a spurious CR at start
  6187. //Look for (optional) * at start...
  6188. LPos := Pos(' ', ALine); {Do not Localize}
  6189. if LPos < 1 then begin
  6190. Exit; //Nothing on this line
  6191. end;
  6192. LWord := Copy(ALine, 1, LPos-1);
  6193. if LWord = '*' then begin {Do not Localize}
  6194. FLineStruct.HasStar := True;
  6195. ALine := Copy(ALine, LPos+1, MaxInt);
  6196. LPos := Pos(' ', ALine); {Do not Localize}
  6197. if LPos < 1 then begin
  6198. Exit; //Line ONLY had a *
  6199. end;
  6200. LWord := Copy(ALine, 1, LPos-1);
  6201. end;
  6202. //Look for (optional) message number next...
  6203. if IsNumeric(LWord) then begin
  6204. FLineStruct.MessageNumber := LWord;
  6205. ALine := Copy(ALine, LPos+1, MaxInt);
  6206. LPos := Pos(' ', ALine); {Do not Localize}
  6207. if LPos < 1 then begin
  6208. Exit; //Line ONLY had a * 67
  6209. end;
  6210. LWord := Copy(ALine, 1, LPos-1);
  6211. end;
  6212. //We should have a valid IMAP command word now, like FETCH, LIST or SEARCH...
  6213. if PosInStrArray(LWord, IMAP4Commands) = -1 then begin
  6214. Exit; //Should have been a command, give up.
  6215. end;
  6216. FLineStruct.Command := LWord;
  6217. if ((AExpectedCommand = '') or (FLineStruct.Command = AExpectedCommand)) then begin
  6218. Result := True;
  6219. end;
  6220. ALine := Copy(ALine, Length(LWord)+2, MaxInt);
  6221. if ALine[1] <> '(' then begin {Do not Localize}
  6222. //This is a line like '* SEARCH 34 56', the '34 56' is the value (result)...
  6223. FLineStruct.IMAPValue := ALine;
  6224. Exit;
  6225. end;
  6226. //This is a line like '* 9 FETCH (UID 47 RFC822.SIZE 3456)', i.e. with a bracketted response.
  6227. //See is it complete (has a closing bracket) or does it continue on other lines...
  6228. ALine := Copy(ALine, 2, MaxInt);
  6229. if TextEndsWith(ALine, ')') then begin {Do not Localize}
  6230. ALine := Copy(ALine, 1, Length(ALine) - 1); //Strip trailing bracket
  6231. FLineStruct.Complete := True;
  6232. end else begin
  6233. FLineStruct.Complete := False;
  6234. end;
  6235. //These words left may occur in different order. Find & delete those we know.
  6236. LWords := TStringList.Create;
  6237. try
  6238. ParseIntoBrackettedQuotedAndUnquotedParts(ALine, LWords, False);
  6239. if LWords.Count > 0 then begin
  6240. //See does it have a trailing byte count...
  6241. LWord := LWords[LWords.Count-1];
  6242. if TextStartsWith(LWord, '{') and TextEndsWith(LWord, '}') then begin
  6243. //It ends in a byte count...
  6244. LWord := Copy(LWord, 2, Length(LWord)-2);
  6245. if TextIsSame(LWord, 'NIL') then begin {do not localize}
  6246. FLineStruct.ByteCount := 0;
  6247. end else begin
  6248. FLineStruct.ByteCount := IndyStrToInt(LWord);
  6249. end;
  6250. LWords.Delete(LWords.Count-1);
  6251. end;
  6252. end;
  6253. if not FLineStruct.Complete then begin
  6254. //The command in this case should be the last word...
  6255. if LWords.Count > 0 then begin
  6256. FLineStruct.IMAPFunction := LWords[LWords.Count-1];
  6257. LWords.Delete(LWords.Count-1);
  6258. end;
  6259. end;
  6260. //See is the UID present...
  6261. LPos := LWords.IndexOf(IMAP4FetchDataItem[fdUID]); {Do not Localize}
  6262. if LPos <> -1 then begin
  6263. //The UID is the word after 'UID'...
  6264. if LPos < LWords.Count-1 then begin
  6265. FLineStruct.UID := LWords[LPos+1];
  6266. LWords.Delete(LPos+1);
  6267. LWords.Delete(LPos);
  6268. end;
  6269. if PosInStrArray(IMAP4FetchDataItem[fdUID], AExpectedIMAPFunction) > -1 then begin
  6270. LWordInExpectedIMAPFunction := True;
  6271. end;
  6272. end;
  6273. //See are the FLAGS present...
  6274. LPos := LWords.IndexOf(IMAP4FetchDataItem[fdFlags]); {Do not Localize}
  6275. if LPos <> -1 then begin
  6276. //The FLAGS are in the "word" (really a string) after 'FLAGS'...
  6277. if LPos < LWords.Count-1 then begin
  6278. FLineStruct.FlagsStr := LWords[LPos+1];
  6279. ParseMessageFlagString(FLineStruct.FlagsStr, FLineStruct.Flags);
  6280. LWords.Delete(LPos+1);
  6281. LWords.Delete(LPos);
  6282. end;
  6283. if PosInStrArray(IMAP4FetchDataItem[fdFlags], AExpectedIMAPFunction) > -1 then begin
  6284. LWordInExpectedIMAPFunction := True;
  6285. end;
  6286. end;
  6287. //See is the X-GM-MSGID present...
  6288. LPos := LWords.IndexOf(IMAP4FetchDataItem[fdGmailMsgID]); {Do not Localize}
  6289. if LPos <> -1 then begin
  6290. //The MSGID is in the "word" (really a string) after 'X-GM-MSGID'...
  6291. if LPos < LWords.Count-1 then begin
  6292. FLineStruct.GmailMsgID := LWords[LPos+1];
  6293. LWords.Delete(LPos+1);
  6294. LWords.Delete(LPos);
  6295. end;
  6296. if PosInStrArray(IMAP4FetchDataItem[fdGmailMsgID], AExpectedIMAPFunction) > -1 then begin
  6297. LWordInExpectedIMAPFunction := True;
  6298. end;
  6299. end;
  6300. //See is the X-GM-THRID present...
  6301. LPos := LWords.IndexOf(IMAP4FetchDataItem[fdGmailThreadID]); {Do not Localize}
  6302. if LPos <> -1 then begin
  6303. //The THREADID is in the "word" (really a string) after 'X-GM-THRID'...
  6304. if LPos < LWords.Count-1 then begin
  6305. FLineStruct.GmailThreadID := LWords[LPos+1];
  6306. LWords.Delete(LPos+1);
  6307. LWords.Delete(LPos);
  6308. end;
  6309. if PosInStrArray(IMAP4FetchDataItem[fdGmailThreadID], AExpectedIMAPFunction) > -1 then begin
  6310. LWordInExpectedIMAPFunction := True;
  6311. end;
  6312. end;
  6313. //See is the X-GM-LABELS present...
  6314. LPos := LWords.IndexOf(IMAP4FetchDataItem[fdGmailLabels]); {Do not Localize}
  6315. if LPos <> -1 then begin
  6316. //The LABELS is in the "word" (really a string) after 'X-GM-LABELS'...
  6317. if LPos < LWords.Count-1 then begin
  6318. FLineStruct.GmailLabels := DoMUTFDecode(LWords[LPos+1]);
  6319. LWords.Delete(LPos+1);
  6320. LWords.Delete(LPos);
  6321. end;
  6322. if PosInStrArray(IMAP4FetchDataItem[fdGmailLabels], AExpectedIMAPFunction) > -1 then begin
  6323. LWordInExpectedIMAPFunction := True;
  6324. end;
  6325. end;
  6326. if Length(AExpectedIMAPFunction) > 0 then begin
  6327. //See is what we want present.
  6328. for LN := 0 to Length(AExpectedIMAPFunction)-1 do begin
  6329. //First check if we got it already in IMAPFunction...
  6330. if TextIsSame(FLineStruct.IMAPFunction, AExpectedIMAPFunction[LN]) then begin
  6331. LWordInExpectedIMAPFunction := True;
  6332. Break;
  6333. end;
  6334. //Now check if it is in any remaining words...
  6335. LPos := LWords.IndexOf(AExpectedIMAPFunction[LN]); {Do not Localize}
  6336. if LPos <> -1 then begin
  6337. FLineStruct.IMAPFunction := LWords[LPos];
  6338. LWordInExpectedIMAPFunction := True;
  6339. if LPos < LWords.Count-1 then begin
  6340. //There is a parameter after our function...
  6341. FLineStruct.IMAPValue := LWords[LPos+1];
  6342. end;
  6343. Break;
  6344. end;
  6345. end;
  6346. end else begin
  6347. //See is there function/value items left. There may not be, such as
  6348. //'* 9 FETCH (UID 45)' in response to a GetUID request.
  6349. if FLineStruct.Complete then begin
  6350. if LWords.Count > 1 then begin
  6351. FLineStruct.IMAPFunction := LWords[LWords.Count-2];
  6352. FLineStruct.IMAPValue := LWords[LWords.Count-1];
  6353. end;
  6354. end;
  6355. end;
  6356. Result := False;
  6357. if (AExpectedCommand = '') or (FLineStruct.Command = AExpectedCommand) then begin
  6358. //The AExpectedCommand is correct, now need to check the AExpectedIMAPFunction...
  6359. if (Length(AExpectedIMAPFunction) = 0) or LWordInExpectedIMAPFunction then begin
  6360. Result := True;
  6361. end;
  6362. end;
  6363. finally
  6364. FreeAndNil(LWords);
  6365. end;
  6366. end;
  6367. {This ADDS any parseable info from ALine to FLineStruct (set up from a previous ParseLastCmdResult call)}
  6368. procedure TIdIMAP4.ParseLastCmdResultButAppendInfo(ALine: string);
  6369. var
  6370. LPos: integer;
  6371. LWords: TStringList;
  6372. begin
  6373. ALine := Trim(ALine); //Can get garbage like a spurious CR at start
  6374. {We may have an initial or ending bracket, like ") UID 5" or "UID 5)"}
  6375. if TextStartsWith(ALine, ')') then begin {Do not Localize}
  6376. ALine := Trim(Copy(ALine, 2, MaxInt));
  6377. end;
  6378. if TextEndsWith(ALine, ')') then begin {Do not Localize}
  6379. ALine := Trim(Copy(ALine, 1, Length(ALine)-1));
  6380. end;
  6381. //These words left may occur in different order. Find & delete those we know.
  6382. LWords := TStringList.Create;
  6383. try
  6384. ParseIntoBrackettedQuotedAndUnquotedParts(ALine, LWords, False);
  6385. //See is the UID present...
  6386. LPos := LWords.IndexOf('UID'); {Do not Localize}
  6387. if LPos <> -1 then begin
  6388. //The UID is the word after 'UID'...
  6389. FLineStruct.UID := LWords[LPos+1];
  6390. LWords.Delete(LPos+1);
  6391. LWords.Delete(LPos);
  6392. end;
  6393. //See are the FLAGS present...
  6394. LPos := LWords.IndexOf('FLAGS'); {Do not Localize}
  6395. if LPos <> -1 then begin
  6396. //The FLAGS are in the "word" (really a string) after 'FLAGS'...
  6397. FLineStruct.FlagsStr := LWords[LPos+1];
  6398. ParseMessageFlagString(FLineStruct.FlagsStr, FLineStruct.Flags);
  6399. LWords.Delete(LPos+1);
  6400. LWords.Delete(LPos);
  6401. end;
  6402. finally
  6403. FreeAndNil(LWords);
  6404. end;
  6405. end;
  6406. { ...Parser Functions }
  6407. function TIdIMAP4.ArrayToNumberStr(const AMsgNumList: array of UInt32): String;
  6408. var
  6409. Ln : Integer;
  6410. begin
  6411. for Ln := 0 to Length(AMsgNumList) - 1 do begin
  6412. Result := Result + IntToStr(Int64(AMsgNumList[Ln])) + ','; {Do not Localize}
  6413. end;
  6414. SetLength(Result, (Length(Result) - 1 ));
  6415. end;
  6416. function TIdIMAP4.MessageFlagSetToStr(const AFlags: TIdMessageFlagsSet): String;
  6417. begin
  6418. Result := '';
  6419. if AFlags = [] then begin
  6420. Exit;
  6421. end;
  6422. if mfAnswered in AFlags then begin
  6423. Result := Result + MessageFlags[mfAnswered] + ' '; {Do not Localize}
  6424. end;
  6425. if mfFlagged in AFlags then begin
  6426. Result := Result + MessageFlags[mfFlagged] + ' '; {Do not Localize}
  6427. end;
  6428. if mfDeleted in AFlags then begin
  6429. Result := Result + MessageFlags[mfDeleted] + ' '; {Do not Localize}
  6430. end;
  6431. if mfDraft in AFlags then begin
  6432. Result := Result + MessageFlags[mfDraft] + ' '; {Do not Localize}
  6433. end;
  6434. if mfSeen in AFlags then begin
  6435. Result := Result + MessageFlags[mfSeen] + ' '; {Do not Localize}
  6436. end;
  6437. Result := Trim(Result);
  6438. end;
  6439. procedure TIdIMAP4.StripCRLFs(ASourceStream, ADestStream: TStream);
  6440. var
  6441. LByte: TIdBytes;
  6442. LNumSourceBytes: TIdStreamSize;
  6443. LBytesRead: Int64;
  6444. begin
  6445. SetLength(LByte, 1);
  6446. ASourceStream.Position := 0;
  6447. ADestStream.Size := 0;
  6448. LNumSourceBytes := ASourceStream.Size;
  6449. LBytesRead := 0;
  6450. while LBytesRead < LNumSourceBytes do begin
  6451. TIdStreamHelper.ReadBytes(ASourceStream, LByte, 1);
  6452. if not ByteIsInEOL(LByte, 0) then begin
  6453. TIdStreamHelper.Write(ADestStream, LByte, 1);
  6454. end;
  6455. Inc(LBytesRead);
  6456. end;
  6457. end;
  6458. procedure TIdIMAP4.StripCRLFs(var AText: string);
  6459. var
  6460. LPos: integer;
  6461. LLen: integer;
  6462. LTemp: string;
  6463. LDestPos: integer;
  6464. begin
  6465. //Optimised with the help of Guus Creuwels.
  6466. LPos := 1;
  6467. LLen := Length(AText);
  6468. SetLength(LTemp, LLen);
  6469. LDestPos := 1;
  6470. while LPos <= LLen do begin
  6471. if AText[LPos] = #13 then begin
  6472. //Don't GPF if this is the last char in the string...
  6473. if LPos < LLen then begin
  6474. if AText[LPos+1] = #10 then begin
  6475. Inc(LPos, 2);
  6476. end else begin
  6477. LTemp[LDestPos] := AText[LPos];
  6478. Inc(LPos);
  6479. Inc(LDestPos);
  6480. end;
  6481. end else begin
  6482. LTemp[LDestPos] := AText[LPos];
  6483. Inc(LPos);
  6484. Inc(LDestPos);
  6485. end;
  6486. end else begin
  6487. LTemp[LDestPos] := AText[LPos];
  6488. Inc(LPos);
  6489. Inc(LDestPos);
  6490. end;
  6491. end;
  6492. SetLength(LTemp, LDestPos - 1);
  6493. AText := LTemp;
  6494. end;
  6495. procedure TIdIMAP4.ReceiveBody(AMsg: TIdMessage; const ADelim: string = '.'); {Do not Localize}
  6496. var
  6497. LMsgEnd: Boolean;
  6498. LActiveDecoder: TIdMessageDecoder;
  6499. LLine: string;
  6500. LCheckForOptionalImapFlags: Boolean;
  6501. LDelim: string;
  6502. {CC7: The following define SContentType is from IdMessageClient. It is defined here also
  6503. (with only local scope) because the one in IdMessageClient is defined locally
  6504. there also, so we cannot get at it.}
  6505. const
  6506. SContentType = 'Content-Type'; {do not localize}
  6507. // TODO - move this procedure into TIdIOHandler as a new Capture method?
  6508. procedure CaptureAndDecodeCharset;
  6509. var
  6510. LMStream: TMemoryStream;
  6511. begin
  6512. LMStream := TMemoryStream.Create;
  6513. try
  6514. IOHandler.Capture(LMStream, LDelim, True, IndyTextEncoding_8Bit{$IFDEF STRING_IS_ANSI}, IndyTextEncoding_8Bit{$ENDIF});
  6515. LMStream.Position := 0;
  6516. // TODO: when String is AnsiString, TIdMessageClient uses AMsg.CharSet as
  6517. // the destination encoding, should this be doing the same? Otherwise, we
  6518. // could just use AMsg.Body.LoadFromStream() instead...
  6519. ReadStringsAsCharSet(LMStream, AMsg.Body, AMsg.CharSet{$IFDEF STRING_IS_ANSI}, IndyTextEncoding_8Bit{$ENDIF});
  6520. finally
  6521. LMStream.Free;
  6522. end;
  6523. end;
  6524. function IsContentTypeHtml(const AContentType: String) : Boolean;
  6525. begin
  6526. Result := IsHeaderMediaTypes(AContentType, ['text/html', 'text/html-sandboxed','application/xhtml+xml']); {do not localize}
  6527. end;
  6528. procedure ProcessTextPart(var VDecoder: TIdMessageDecoder);
  6529. var
  6530. LDestStream: TMemoryStream;
  6531. Li: integer;
  6532. LTxt: TIdText;
  6533. LNewDecoder: TIdMessageDecoder;
  6534. {$IFDEF STRING_IS_ANSI}
  6535. LAnsiEncoding: IIdTextEncoding;
  6536. {$ENDIF}
  6537. LContentType, LCharSet: string;
  6538. begin
  6539. LDestStream := TMemoryStream.Create;
  6540. try
  6541. LNewDecoder := VDecoder.ReadBody(LDestStream, LMsgEnd);
  6542. try
  6543. LDestStream.Position := 0;
  6544. LTxt := TIdText.Create(AMsg.MessageParts);
  6545. try
  6546. // if the Content-Type is HTML and does not specify a charset, parse
  6547. // the HTML looking for a <meta> tag that specifies a charset...
  6548. // TODO: if the media type is not a 'text/...' based XML type, ignore
  6549. // the charset from the headers, if present, and parse the XML itself...
  6550. LContentType := VDecoder.Headers.Values[SContentType];
  6551. {
  6552. if IsContentTypeAppXml(LContentType) then begin
  6553. LCharSet := DetectXmlCharset(LDestStream);
  6554. LDestStream.Position := 0;
  6555. end else
  6556. begin
  6557. }
  6558. LCharSet := LTxt.GetCharSet(LContentType);
  6559. if (LCharSet = '') and IsContentTypeHtml(LContentType) then begin
  6560. ParseMetaHTTPEquiv(LDestStream, nil, LCharSet);
  6561. LDestStream.Position := 0;
  6562. end;
  6563. //end;
  6564. LTxt.ContentType := LContentType;
  6565. LTxt.CharSet := LCharSet;
  6566. LTxt.ContentID := VDecoder.Headers.Values['Content-ID']; {Do not Localize}
  6567. LTxt.ContentLocation := VDecoder.Headers.Values['Content-Location']; {Do not Localize}
  6568. LTxt.ContentDescription := VDecoder.Headers.Values['Content-Description']; {Do not Localize}
  6569. LTxt.ContentDisposition := VDecoder.Headers.Values['Content-Disposition']; {Do not Localize}
  6570. LTxt.ContentTransfer := VDecoder.Headers.Values['Content-Transfer-Encoding']; {Do not Localize}
  6571. for Li := 0 to VDecoder.Headers.Count-1 do begin
  6572. if LTxt.Headers.IndexOfName(VDecoder.Headers.Names[Li]) < 0 then begin
  6573. LTxt.ExtraHeaders.AddValue(
  6574. VDecoder.Headers.Names[Li],
  6575. IndyValueFromIndex(VDecoder.Headers, Li)
  6576. );
  6577. end;
  6578. end;
  6579. {$IFDEF STRING_IS_ANSI}
  6580. LAnsiEncoding := CharsetToEncoding(LCharSet);
  6581. {$ENDIF}
  6582. ReadStringsAsCharset(LDestStream, LTxt.Body, LCharSet{$IFDEF STRING_IS_ANSI}, LAnsiEncoding{$ENDIF});
  6583. except
  6584. //this should also remove the Item from the TCollection.
  6585. //Note that Delete does not exist in the TCollection.
  6586. LTxt.Free;
  6587. raise;
  6588. end;
  6589. except
  6590. LNewDecoder.Free;
  6591. raise;
  6592. end;
  6593. VDecoder.Free;
  6594. VDecoder := LNewDecoder;
  6595. finally
  6596. FreeAndNil(LDestStream);
  6597. end;
  6598. end;
  6599. procedure ProcessAttachment(var VDecoder: TIdMessageDecoder);
  6600. var
  6601. LDestStream: TStream;
  6602. Li: integer;
  6603. LAttachment: TIdAttachment;
  6604. LNewDecoder: TIdMessageDecoder;
  6605. begin
  6606. AMsg.DoCreateAttachment(VDecoder.Headers, LAttachment);
  6607. Assert(Assigned(LAttachment), 'Attachment must not be unassigned here!'); {Do not Localize}
  6608. try
  6609. LNewDecoder := nil;
  6610. try
  6611. LDestStream := LAttachment.PrepareTempStream;
  6612. try
  6613. LNewDecoder := VDecoder.ReadBody(LDestStream, LMsgEnd);
  6614. finally
  6615. LAttachment.FinishTempStream;
  6616. end;
  6617. LAttachment.ContentType := VDecoder.Headers.Values[SContentType];
  6618. LAttachment.ContentTransfer := VDecoder.Headers.Values['Content-Transfer-Encoding']; {Do not Localize}
  6619. LAttachment.ContentDisposition := VDecoder.Headers.Values['Content-Disposition']; {Do not Localize}
  6620. LAttachment.ContentID := VDecoder.Headers.Values['Content-ID']; {Do not Localize}
  6621. LAttachment.ContentLocation := VDecoder.Headers.Values['Content-Location']; {Do not Localize}
  6622. LAttachment.ContentDescription := VDecoder.Headers.Values['Content-Description']; {Do not Localize}
  6623. LAttachment.Filename := VDecoder.Filename;
  6624. for Li := 0 to VDecoder.Headers.Count-1 do begin
  6625. if LAttachment.Headers.IndexOfName(VDecoder.Headers.Names[Li]) < 0 then begin
  6626. LAttachment.ExtraHeaders.AddValue(
  6627. VDecoder.Headers.Names[Li],
  6628. IndyValueFromIndex(VDecoder.Headers, Li)
  6629. );
  6630. end;
  6631. end;
  6632. except
  6633. LNewDecoder.Free;
  6634. raise;
  6635. end;
  6636. except
  6637. //this should also remove the Item from the TCollection.
  6638. //Note that Delete does not exist in the TCollection.
  6639. LAttachment.Free;
  6640. raise;
  6641. end;
  6642. VDecoder.Free;
  6643. VDecoder := LNewDecoder;
  6644. end;
  6645. Begin
  6646. {CC3: If IMAP calls this ReceiveBody, it prepends IMAP to delim, e.g. 'IMAP)',
  6647. to flag that this routine should expect IMAP FLAGS entries.}
  6648. LCheckForOptionalImapFlags := False; {CC3: IMAP hack inserted lines start here...}
  6649. LDelim := ADelim;
  6650. if TextStartsWith(ADelim, 'IMAP') then begin {do not localize}
  6651. LCheckForOptionalImapFlags := True;
  6652. LDelim := Copy(ADelim, 5, MaxInt);
  6653. end; {CC3: ...IMAP hack inserted lines end here}
  6654. LMsgEnd := False;
  6655. if AMsg.NoDecode then begin
  6656. CaptureAndDecodeCharSet;
  6657. end else begin
  6658. BeginWork(wmRead);
  6659. try
  6660. LActiveDecoder := nil;
  6661. try
  6662. repeat
  6663. LLine := IOHandler.ReadLn;
  6664. {CC3: Check for optional flags before delimiter in the case of IMAP...}
  6665. if LLine = LDelim then begin {CC3: IMAP hack ADelim -> LDelim}
  6666. Break;
  6667. end; {CC3: IMAP hack inserted lines start here...}
  6668. if LCheckForOptionalImapFlags and TextStartsWith(LLine, ' FLAGS (\') {do not localize}
  6669. and TextEndsWith(LLine, LDelim) then begin
  6670. Break;
  6671. end;
  6672. if LActiveDecoder = nil then begin
  6673. LActiveDecoder := TIdMessageDecoderList.CheckForStart(AMsg, LLine);
  6674. end;
  6675. if LActiveDecoder = nil then begin
  6676. {CC9: Per RFC821, the sender is required to add a prefixed '.' to any
  6677. line in an email that starts with '.' and the receiver is
  6678. required to strip it off. This ensures that the end-of-message
  6679. line '.' cannot appear in the message body.}
  6680. if TextStartsWith(LLine, '..') then begin {Do not Localize}
  6681. Delete(LLine,1,1);
  6682. end;
  6683. AMsg.Body.Add(LLine);
  6684. end else begin
  6685. while LActiveDecoder <> nil do begin
  6686. LActiveDecoder.SourceStream := TIdTCPStream.Create(Self);
  6687. LActiveDecoder.ReadHeader;
  6688. case LActiveDecoder.PartType of
  6689. mcptText: ProcessTextPart(LActiveDecoder);
  6690. mcptAttachment: ProcessAttachment(LActiveDecoder);
  6691. mcptIgnore: FreeAndNil(LActiveDecoder);
  6692. mcptEOF: begin FreeAndNil(LActiveDecoder); LMsgEnd := True; end;
  6693. end;
  6694. end;
  6695. end;
  6696. until LMsgEnd;
  6697. finally
  6698. FreeAndNil(LActiveDecoder);
  6699. end;
  6700. finally
  6701. EndWork(wmRead);
  6702. end;
  6703. end;
  6704. end;
  6705. {########### Following only used by CONNECT? ###############}
  6706. function TIdIMAP4.GetResponse: string;
  6707. {CC: The purpose of this is to keep reading & accumulating lines until we hit
  6708. a line that has a valid response (that terminates the reading). We call
  6709. "FLastCmdResult.FormattedReply := LResponse;" to parse out the response we
  6710. received.
  6711. The response sequences we need to deal with are:
  6712. 1) Many commands just give a simple result to the command issued:
  6713. C41 OK Completed
  6714. 2) Some commands give you data first, then the result:
  6715. * LIST (\UnMarked) "/" INBOX
  6716. * LIST (\UnMarked) "/" Junk
  6717. * LIST (\UnMarked) "/" Junk/Subbox1
  6718. C42 OK Completed
  6719. 3) Some responses have a result but * instead of a command number (like C42):
  6720. * OK CommuniGate Pro IMAP Server 3.5.7 ready
  6721. 4) Some have neither a * nor command number, but start with a result:
  6722. + Send the additional command text
  6723. or:
  6724. BAD Bad parameter
  6725. Because you may get data first, which you need to skip, you need to
  6726. accept all the above possibilities.
  6727. We MUST stop when we find a valid response code, like OK.
  6728. }
  6729. var
  6730. LLine: String;
  6731. LResponse: TStringList;
  6732. LWord: string;
  6733. LPos: integer;
  6734. LBuf: string;
  6735. begin
  6736. Result := ''; {Do not Localize}
  6737. LResponse := TStringList.Create;
  6738. try
  6739. repeat
  6740. LLine := IOHandler.ReadLnWait;
  6741. if LLine <> '' then begin {Do not Localize}
  6742. {It is not an empty line, add it to our list of stuff received (it is
  6743. not our job to interpret it)}
  6744. LResponse.Add(LLine);
  6745. {See if the last LLine contained a response code like OK or BAD.}
  6746. LPos := Pos(' ', LLine); {Do not Localize}
  6747. if LPos <> 0 then begin
  6748. {There are at least two words on this line...}
  6749. LWord := Trim(Copy(LLine, 1, LPos-1));
  6750. LBuf := Trim(Copy(LLine, LPos+1, MaxInt)); {The rest of the line, without the 1st word}
  6751. end else begin
  6752. {No space, so this line is a single word. A bit weird, but it
  6753. could be just an OK...}
  6754. LWord := LLine; {A bit pedantic, but emphasises we have a word, not a line}
  6755. LBuf := ''; {Do not Localize}
  6756. end;
  6757. LPos := PosInStrArray(LWord, VALID_TAGGEDREPLIES); {Do not Localize}
  6758. if LPos > -1 then begin
  6759. {We got a valid response code as the first word...}
  6760. Result := LWord;
  6761. FLastCmdResult.FormattedReply := LResponse;
  6762. Exit;
  6763. end;
  6764. if Length(LBuf) = 0 then begin {Do not Localize}
  6765. Continue; {We hit a line with just one word which is not a valid IMAP response}
  6766. end;
  6767. {In all other cases, any valid response should be the second word...}
  6768. LPos := Pos(' ', LBuf); {Do not Localize}
  6769. if LPos <> 0 then begin
  6770. {There are at least three words on this line...}
  6771. LWord := Trim(Copy(LBuf, 1, LPos-1));
  6772. LBuf := Trim(Copy(LBuf, LPos+1, MaxInt)); {The rest of the line, without the 1st word}
  6773. end else begin
  6774. {No space, so this line is two single words.}
  6775. LWord := LLine; {A bit pedantic, but emphasises we have a word, not a line}
  6776. LBuf := ''; {Do not Localize}
  6777. end;
  6778. LPos := PosInStrArray(LWord, VALID_TAGGEDREPLIES); {Do not Localize}
  6779. if LPos > -1 then begin
  6780. {We got a valid response code as the second word...}
  6781. Result := LWord;
  6782. FLastCmdResult.FormattedReply := LResponse;
  6783. Exit;
  6784. end;
  6785. end;
  6786. until False;
  6787. finally
  6788. FreeAndNil(LResponse);
  6789. end;
  6790. end;
  6791. end.