| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590 |
- {
- $Project$
- $Workfile$
- $Revision$
- $DateUTC$
- $Id$
- This file is part of the Indy (Internet Direct) project, and is offered
- under the dual-licensing agreement described on the Indy website.
- (http://www.indyproject.org/)
- Copyright:
- (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
- }
- {
- $Log$
- }
- {
- Rev 1.85 1/6/05 4:38:30 PM RLebeau
- Bug fix for decoding Text part headers
- }
- {
- Rev 1.84 11/30/04 10:44:44 AM RLebeau
- Bug fix for previous checkin
- }
- {
- Rev 1.83 11/30/2004 12:10:40 PM JPMugaas
- Fix for compiler error.
- }
- {
- Rev 1.82 11/28/04 2:22:04 PM RLebeau
- Updated a few hard-coded strings to use resource strings instead
- }
- {
- Rev 1.81 28/11/2004 20:08:14 CCostelloe
- MessagePart.Boundary now (correctly) holds decoded MIME boundary
- }
- {
- Rev 1.80 11/27/2004 8:58:14 PM JPMugaas
- Compile errors.
- }
- {
- Rev 1.79 10/26/2004 10:25:46 PM JPMugaas
- Updated refs.
- }
- {
- Rev 1.78 24.09.2004 02:16:48 Andreas Hausladen
- Added ReadTIdBytesFromStream and ReadCharFromStream function to supress .NET
- warnings.
- }
- {
- Rev 1.77 27.08.2004 22:04:32 Andreas Hausladen
- speed optimization ("const" for string parameters)
- Fixed "blank line multiplication"
- }
- {
- Rev 1.76 27.08.2004 00:21:32 Andreas Hausladen
- Undo last changes (temporary)
- }
- {
- Rev 1.75 26.08.2004 22:14:16 Andreas Hausladen
- Fixed last line blank line read/write bug
- }
- {
- Rev 1.74 7/23/04 7:17:20 PM RLebeau
- TFileStream access right tweak for ProcessMessage()
- }
- {
- Rev 1.73 28/06/2004 23:58:12 CCostelloe
- Bug fix
- }
- {
- Rev 1.72 6/11/2004 9:38:08 AM DSiders
- Added "Do not Localize" comments.
- }
- {
- Rev 1.71 2004.06.06 4:53:04 PM czhower
- Undid 1.70. Not needed, just masked an existing bug and did not fix it.
- }
- {
- Rev 1.70 06/06/2004 01:23:54 CCostelloe
- OnWork fix
- }
- {
- Rev 1.69 6/4/04 12:41:56 PM RLebeau
- ContentTransferEncoding bug fix
- }
- {
- Rev 1.68 2004.05.20 1:39:08 PM czhower
- Last of the IdStream updates
- }
- {
- Rev 1.67 2004.05.20 11:36:52 AM czhower
- IdStreamVCL
- }
- {
- Rev 1.66 2004.05.20 11:12:56 AM czhower
- More IdStream conversions
- }
- {
- Rev 1.65 2004.05.19 3:06:34 PM czhower
- IdStream / .NET fix
- }
- {
- Rev 1.64 19/05/2004 00:54:30 CCostelloe
- Bug fix (though I claim in my defence that it is only a hint fix)
- }
- {
- Rev 1.63 16/05/2004 18:55:06 CCostelloe
- New TIdText/TIdAttachment processing
- }
- {
- Rev 1.62 2004.05.03 11:15:16 AM czhower
- Fixed compile error and added use of constants.
- }
- {
- Rev 1.61 5/2/04 8:02:12 PM RLebeau
- Updated TIdIOHandlerStreamMsg to keep track of the last character received
- from the stream so that extra CR LF characters are not added to the end of
- the message data unnecessarily.
- }
- {
- Rev 1.60 4/23/04 1:54:58 PM RLebeau
- One more tweak for TIdIOHandlerStreamMsg support
- }
- {
- Rev 1.59 4/23/04 1:21:16 PM RLebeau
- Minor tweaks for TIdIOHandlerStreamMsg support
- }
- {
- Rev 1.58 23/04/2004 20:48:10 CCostelloe
- Added TIdIOHandlerStreamMsg to stop looping if no terminating \r\n.\r\n and
- added support for emails that are attachments only
- }
- {
- Rev 1.57 2004.04.18 1:39:22 PM czhower
- Bug fix for .NET with attachments, and several other issues found along the
- way.
- }
- {
- Rev 1.56 2004.04.16 11:31:00 PM czhower
- Size fix to IdBuffer, optimizations, and memory leaks
- Rev 1.55 2004.03.07 10:36:08 AM czhower
- SendMsg now calls OnWork with NoEncode = True
- Rev 1.54 2004.03.04 1:02:58 AM czhower
- Const removed from arguemtns (1 not needed + 1 incorrect)
- Rev 1.53 2004.03.03 7:18:32 PM czhower
- Fixed AV bug with ProcessMessage
- Rev 1.52 2004.03.03 11:54:34 AM czhower
- IdStream change
- Rev 1.51 2/3/04 12:25:50 PM RLebeau
- Updated WriteTextPart() function inside of SendBody() to write the ContentID
- property is it is assigned.
- Rev 1.50 2004.02.03 5:44:02 PM czhower
- Name changes
- Rev 1.49 2004.02.03 2:12:16 PM czhower
- $I path change
- Rev 1.48 1/27/2004 4:04:06 PM SPerry
- StringStream ->IdStringStream
- Rev 1.47 2004.01.27 12:03:28 AM czhower
- Properly named a local variable to fix a .net conflict.
- Rev 1.46 1/25/2004 3:52:32 PM JPMugaas
- Fixes for abstract SSL interface to work in NET.
- Rev 1.45 24/01/2004 19:24:30 CCostelloe
- Cleaned up warnings
- Rev 1.44 1/21/2004 1:30:06 PM JPMugaas
- InitComponent
- Rev 1.43 16/01/2004 17:39:34 CCostelloe
- Added support for BinHex 4.0 encoding
- Rev 1.42 11/01/2004 19:53:40 CCostelloe
- Revisions for TIdMessage SaveToFile & LoadFromFile for D7 & D8
- Rev 1.40 08/01/2004 23:46:16 CCostelloe
- Changes to ProcessMessage to get TIdMessage.LoadFromFile working in D7
- Rev 1.39 08/01/2004 00:31:06 CCostelloe
- Start of reimplementing LoadFrom/SaveToFile
- Rev 1.38 22/12/2003 00:44:52 CCostelloe
- .NET fixes
- Rev 1.37 11/11/2003 12:06:26 AM BGooijen
- Did all todo's ( TStream to TIdStream mainly )
- Rev 1.36 2003.10.24 10:43:10 AM czhower
- TIdSTream to dos
- Rev 1.35 10/17/2003 12:37:36 AM DSiders
- Added localization comments.
- Added resource string for exception message.
- Rev 1.34 2003.10.14 9:57:12 PM czhower
- Compile todos
- Rev 1.33 10/12/2003 1:49:56 PM BGooijen
- Changed comment of last checkin
- Rev 1.32 10/12/2003 1:43:40 PM BGooijen
- Changed IdCompilerDefines.inc to Core\IdCompilerDefines.inc
- Rev 1.30 10/11/2003 4:21:14 PM BGooijen
- Compiles in D7 again
- Rev 1.29 10/10/2003 10:42:28 PM BGooijen
- DotNet
- Rev 1.28 9/10/2003 1:50:52 PM SGrobety
- DotNet
- Rev 1.27 10/8/2003 9:53:42 PM GGrieve
- Remove $IFDEFs
- Rev 1.26 05/10/2003 16:39:52 CCostelloe
- Set default ContentType
- Rev 1.25 03/10/2003 21:03:40 CCostelloe
- Bug fixes
- Rev 1.24 2003.10.02 9:27:52 PM czhower
- DotNet Excludes
- Rev 1.23 01/10/2003 17:58:56 HHariri
- More fixes for Multipart Messages and also fixes for incorrect transfer
- encoding settings
- Rev 1.20 01/10/2003 10:57:56 CCostelloe
- Fixed GenerateTextPartContentType (was ignoring ContentType)
- Rev 1.19 26/09/2003 01:03:48 CCostelloe
- Modified ProcessAttachment in ReceiveBody to update message's Encoding if
- attachment was XX-encoded. Added decoding of message bodies encoded as
- base64 or quoted-printable. Added support for nested MIME parts
- (ParentPart). Added support for TIdText in UU and XX encoding. Added
- missing base64 and QP support where needed. Rewrote/rearranged most of code.
- Rev 1.18 04/09/2003 20:44:56 CCostelloe
- In SendBody, removed blank line between boundaries and Text part header;
- recoded wDoublePoint
- Rev 1.17 30/08/2003 18:40:44 CCostelloe
- Updated to use IdMessageCoderMIME's new random boundaries
- Rev 1.16 8/8/2003 12:27:18 PM JPMugaas
- Should now compile.
- Rev 1.15 07/08/2003 00:39:06 CCostelloe
- Modified SendBody to deal with unencoded attachments (otherwise 7bit
- attachments had the attachment header written out as 7bit but was encoded as
- base64)
- Rev 1.14 11/07/2003 01:14:20 CCostelloe
- SendHeader changed to support new IdMessage.GenerateHeader putting generated
- headers in IdMessage.LastGeneratedHeaders.
- Rev 1.13 6/15/2003 01:13:10 PM JPMugaas
- Minor fixes and cleanups.
- Rev 1.12 5/18/2003 02:31:44 PM JPMugaas
- Reworked some things so IdSMTP and IdDirectSMTP can share code including
- stuff for pipelining.
- Rev 1.11 5/8/2003 03:18:06 PM JPMugaas
- Flattened ou the SASL authentication API, made a custom descendant of SASL
- enabled TIdMessageClient classes.
- Rev 1.10 5/8/2003 11:28:02 AM JPMugaas
- Moved feature negoation properties down to the ExplicitTLSClient level as
- feature negotiation goes hand in hand with explicit TLS support.
- Rev 1.9 5/8/2003 02:17:58 AM JPMugaas
- Fixed an AV in IdPOP3 with SASL list on forms. Made exceptions for SASL
- mechanisms missing more consistant, made IdPOP3 support feature feature
- negotiation, and consolidated some duplicate code.
- Rev 1.8 3/17/2003 02:16:06 PM JPMugaas
- Now descends from ExplicitTLS base class.
- Rev 1.7 2/24/2003 07:25:18 PM JPMugaas
- Now compiles with new code.
- Rev 1.6 12-8-2002 21:12:36 BGooijen
- Changed calls to Writeln to IOHandler.WriteLn, because the parent classes
- don't provide Writeln, System.Writeln was assumed by the compiler
- Rev 1.5 12-8-2002 21:08:58 BGooijen
- The TIdIOHandlerStream was not Opened before used, fixed that.
- Rev 1.4 12/6/2002 05:30:22 PM JPMugaas
- Now decend from TIdTCPClientCustom instead of TIdTCPClient.
- Rev 1.3 12/5/2002 02:54:06 PM JPMugaas
- Updated for new API definitions.
- Rev 1.2 11/23/2002 03:33:44 AM JPMugaas
- Reverted changes because they were problematic. Kudzu didn't explain why.
- Rev 1.1 11/19/2002 05:35:30 PM JPMugaas
- Fixed problem with a line starting with a ".". A double period should only
- be used if the line is really just one "." and no other cases.
- Rev 1.0 11/13/2002 07:56:58 AM JPMugaas
- }
- unit IdMessageClient;
- {
- 2003-10-04 Ciaran Costelloe (see comments starting CC4)
- If attachment not base64 encoded and has no ContentType, set to text/plain
- 2003-Sep-20 Ciaran Costelloe
- Modified ProcessAttachment in ReceiveBody to update message's Encoding
- if attachment was XX-encoded. Added decoding of message bodies
- encoded as base64 or quoted-printable. Added support for nested MIME parts
- (ParentPart). Added support for TIdText in UU and XX encoding. Added
- missing base64 and QP support where needed.
- Rewrote/rearranged most of code.
- 2001-Oct-29 Don Siders
- Modified TIdMessageClient.SendMsg to use AHeadersOnly argument.
- 2001-Dec-1 Don Siders
- Save ContentDisposition in TIdMessageClient.ProcessAttachment
- 2003-Sep-04 Ciaran Costelloe (CC comments)
- Commented-out IOHandler.WriteLn(''); in SendBody which used to insert a blank line
- between boundary and text attachment header, causing the attachment header to
- be parsed as part of the attachment text (the blank line is the delimiter for
- the end of the header).
- 2003-Sep-11 Ciaran Costelloe (CC2 comments)
- Added support in decoding for message body (as distinct from message parts) being
- encoded.
- Added support for generating encoded message body.
- }
- interface
- {$i IdCompilerDefines.inc}
- uses
- Classes,
- IdCoderMIME,
- IdExplicitTLSClientServerBase,
- IdGlobal,
- IdHeaderList,
- IdIOHandlerStream,
- IdBaseComponent,
- IdMessage;
- type
- TIdIOHandlerStreamMsg = class(TIdIOHandlerStream)
- protected
- FTerminatorWasRead: Boolean;
- FEscapeLines: Boolean;
- FUnescapeLines: Boolean;
- FLastByteRecv: Byte;
- function ReadDataFromSource(var VBuffer: TIdBytes): Integer; override;
- public
- constructor Create(
- AOwner: TComponent;
- AReceiveStream: TStream;
- ASendStream: TStream = nil
- ); override; //Should this be reintroduce instead of override?
- function Readable(AMSec: Integer = IdTimeoutDefault): Boolean; override;
- function ReadLn(ATerminator: string; ATimeout: Integer = IdTimeoutDefault;
- AMaxLineLength: Integer = -1; AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): string; override;
- procedure WriteLn(const AOut: string; AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- ); override;
- property EscapeLines: Boolean read FEscapeLines write FEscapeLines;
- property UnescapeLines: Boolean read FUnescapeLines write FUnescapeLines;
- published
- property MaxLineLength default MaxInt;
- end;
- TIdMessageClient = class(TIdExplicitTLSClient)
- protected
- // The length of the folded line
- FMsgLineLength: integer;
- // The string to be pre-pended to the next line
- FMsgLineFold: string;
- procedure ReceiveBody(AMsg: TIdMessage; const ADelim: string = '.'); virtual; {do not localize}
- function ReceiveHeader(AMsg: TIdMessage; const AAltTerm: string = ''): string; virtual;
- procedure SendBody(AMsg: TIdMessage); virtual;
- procedure SendHeader(AMsg: TIdMessage); virtual;
- procedure EncodeAndWriteText(const ABody: TStrings; AEncoding: IIdTextEncoding);
- procedure WriteFoldedLine(const ALine : string);
- procedure InitComponent; override;
- public
- {$IFDEF WORKAROUND_INLINE_CONSTRUCTORS}
- constructor Create(AOwner: TComponent); reintroduce; overload;
- {$ENDIF}
- destructor Destroy; override;
- procedure ProcessMessage(AMsg: TIdMessage; AHeaderOnly: Boolean = False); overload;
- procedure ProcessMessage(AMsg: TIdMessage; AStream: TStream; AHeaderOnly: Boolean = False); overload;
- procedure ProcessMessage(AMsg: TIdMessage; const AFilename: string; AHeaderOnly: Boolean = False); overload;
- procedure SendMsg(AMsg: TIdMessage; AHeadersOnly: Boolean = False); overload; virtual;
- //
- // property Capabilities;
- property MsgLineLength: integer read FMsgLineLength write FMsgLineLength;
- property MsgLineFold: string read FMsgLineFold write FMsgLineFold;
- end;
- implementation
- uses
- //facilitate inlining only.
- {$IFDEF DOTNET}
- System.IO,
- {$ENDIF}
- //TODO: Remove these references and make it completely pluggable. Check other spots in Indy as well
- IdMessageCoderBinHex4, IdMessageCoderQuotedPrintable, IdMessageCoderMIME,
- IdMessageCoderUUE, IdMessageCoderXXE,
- //
- IdGlobalProtocols,
- IdCoderBinHex4,
- IdCoderHeader, IdHeaderCoderBase, IdMessageCoder, IdComponent, IdException,
- IdResourceStringsProtocols, IdTCPConnection, IdTCPStream, IdIOHandler,
- IdAttachment, IdText,
- SysUtils;
- const
- SContentType = 'Content-Type'; {do not localize}
- SContentTransferEncoding = 'Content-Transfer-Encoding'; {do not localize}
- SThisIsMultiPartMessageInMIMEFormat = 'This is a multi-part message in MIME format'; {do not localize}
- function GetLongestLine(var ALine : String; const ADelim : String) : String;
- var
- i, fnd, delimLen : Integer;
- begin
- Result := '';
- fnd := 0;
- delimLen := Length(ADelim);
- for i := 1 to Length(ALine) do
- begin
- if ALine[i] = ADelim[1] then
- begin
- if Copy(ALine, i, delimLen) = ADelim then
- begin
- fnd := i;
- end;
- end;
- end;
- if fnd > 0 then
- begin
- Result := Copy(ALine, 1, fnd - 1);
- ALine := Copy(ALine, fnd + delimLen, MaxInt);
- end;
- end;
- procedure RemoveLastBlankLine(Body: TStrings);
- var
- Count: Integer;
- begin
- if Assigned(Body) then begin
- { Remove the last blank line. The last blank line is added again in
- TIdMessageClient.SendBody(). }
- Count := Body.Count;
- if (Count > 0) and (Body[Count - 1] = '') then begin
- Body.Delete(Count - 1);
- end;
- end;
- end;
- ////////////////////////
- // TIdIOHandlerStreamMsg
- ////////////////////////
- constructor TIdIOHandlerStreamMsg.Create(
- AOwner: TComponent;
- AReceiveStream: TStream;
- ASendStream: TStream = nil
- );
- begin
- inherited Create(AOwner, AReceiveStream, ASendStream);
- FTerminatorWasRead := False;
- FEscapeLines := False; // do not set this to True! This is for users to set manually...
- FUnescapeLines := False; // do not set this to True! This is for users to set manually...
- FLastByteRecv := 0;
- MaxLineLength := MaxInt;
- end;
- function TIdIOHandlerStreamMsg.Readable(AMSec: integer = IdTimeoutDefault): Boolean;
- begin
- if not FTerminatorWasRead then begin
- Result := inherited Readable(AMSec);
- if Result then begin
- Exit;
- end;
- end;
- Result := ReceiveStream <> nil;
- end;
- function TIdIOHandlerStreamMsg.ReadDataFromSource(var VBuffer: TIdBytes): Integer;
- var
- LTerminator: String;
- begin
- if not FTerminatorWasRead then
- begin
- Result := inherited ReadDataFromSource(VBuffer);
- if Result > 0 then begin
- FLastByteRecv := VBuffer[Result-1];
- Exit;
- end;
- // determine whether the stream ended with a line
- // break, adding an extra CR and/or LF if needed...
- if (FLastByteRecv = Ord(LF)) then begin
- // don't add an extra line break
- LTerminator := '.' + EOL;
- end else if (FLastByteRecv = Ord(CR)) then begin
- // add extra LF
- LTerminator := LF + '.' + EOL;
- end else begin
- // add extra CRLF
- LTerminator := EOL + '.' + EOL;
- end;
- FTerminatorWasRead := True;
- // in theory, CopyTIdString() will write the string
- // into the byte array using 1-byte characters even
- // under DotNet where strings are usually Unicode
- // instead of ASCII...
- CopyTIdString(LTerminator, VBuffer, 0);
- Result := Length(LTerminator);
- end else begin
- Result := 0;
- end;
- end;
- function TIdIOHandlerStreamMsg.ReadLn(ATerminator: string;
- ATimeout: Integer = IdTimeoutDefault; AMaxLineLength: Integer = -1;
- AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
- ): string;
- begin
- Result := inherited ReadLn(ATerminator, ATimeout, AMaxLineLength,
- AByteEncoding{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
- if FEscapeLines and TextStartsWith(Result, '.') and (not FTerminatorWasRead) then begin {Do not Localize}
- Result := '.' + Result; {Do not Localize}
- end;
- end;
- procedure TIdIOHandlerStreamMsg.WriteLn(const AOut: string; AByteEncoding: IIdTextEncoding = nil
- {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
- );
- var
- LOut: String;
- begin
- LOut := AOut;
- if FUnescapeLines and TextStartsWith(LOut, '..') then begin {Do not Localize}
- IdDelete(LOut, 1, 1);
- end;
- inherited WriteLn(LOut, AByteEncoding{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF});
- end;
- ///////////////////
- // TIdMessageClient
- ///////////////////
- {$IFDEF WORKAROUND_INLINE_CONSTRUCTORS}
- constructor TIdMessageClient.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- end;
- {$ENDIF}
- procedure TIdMessageClient.InitComponent;
- begin
- inherited InitComponent;
- FMsgLineLength := 79;
- FMsgLineFold := TAB;
- end;
- procedure TIdMessageClient.WriteFoldedLine(const ALine : string);
- var
- ins, s, line, spare : String;
- msgLen, insLen : Word;
- begin
- s := ALine;
- // To give an amount of thread-safety
- ins := FMsgLineFold;
- insLen := Length(ins);
- msgLen := FMsgLineLength;
- // Do first line
- if length(s) > FMsgLineLength then
- begin
- spare := Copy(s, 1, msgLen);
- line := GetLongestLine(spare, ' '); {do not localize}
- s := spare + Copy(s, msgLen + 1, length(s));
- IOHandler.WriteLn(line);
- // continue with the folded lines
- while length(s) > (msgLen - insLen) do
- begin
- spare := Copy(s, 1, (msgLen - insLen));
- line := GetLongestLine(spare, ' '); {do not localize}
- s := ins + spare + Copy(s, (msgLen - insLen) + 1, length(s));
- IOHandler.WriteLn(line);
- end;
- // complete the output with what's left
- if Trim(s) <> '' then
- begin
- IOHandler.WriteLn(ins + s);
- end;
- end
- else begin
- IOHandler.WriteLn(s);
- end;
- end;
- procedure TIdMessageClient.ReceiveBody(AMsg: TIdMessage; const ADelim: string = '.'); {do not localize}
- var
- LMsgEnd: Boolean;
- LActiveDecoder: TIdMessageDecoder;
- LLine: string;
- LParentPart: integer;
- LPreviousParentPart: integer;
- LEncoding, LCharsetEncoding: IIdTextEncoding;
- LContentTransferEncoding: string;
- LUnknownContentTransferEncoding: Boolean;
- // TODO - move this procedure into TIdIOHandler as a new Capture method?
- procedure CaptureAndDecodeCharset;
- var
- LMStream: TMemoryStream;
- begin
- LMStream := TMemoryStream.Create;
- try
- IOHandler.Capture(LMStream, ADelim, True, IndyTextEncoding_8Bit{$IFDEF STRING_IS_ANSI}, IndyTextEncoding_8Bit{$ENDIF});
- LMStream.Position := 0;
- // TODO: when String is AnsiString, TIdIMAP4 uses 8bit as the destination
- // encoding, should this be doing the same? Otherwise, we could just use
- // AMsg.Body.LoadFromStream() instead...
- // TODO: if the Content-Type is HTML, parse the HTML data looking for a charset
- // declaration, and if found then use that instead of the MIME charset...
- ReadStringsAsCharSet(LMStream, AMsg.Body, AMsg.CharSet{$IFDEF STRING_IS_ANSI}, CharsetToEncoding(AMsg.CharSet){$ENDIF});
- finally
- FreeAndNil(LMStream);
- end;
- end;
- // RLebeau 11/2/2013: TIdMessage.Headers is a TIdHeaderList, but
- // TIdMessageDecoder.Headers is a plain TStringList. Although TIdHeaderList
- // is a TStrings descendant, it reintroduces its own Values[] property
- // instead of implementing the TStrings.Values[] property, so we cannot
- // access TIdMessage.Headers using a TStrings pointer or else the wrong
- // property will be invoked and we won't get the right value when accessing
- // TIdMessage.Headers since TStrings and TIdHeaderList use different
- // NameValueSeparator implementations, so we have to access them separately...
- function GetHeaderValue(const AName: string): string;
- begin
- if AMsg.IsMsgSinglePartMime then begin
- Result := AMsg.Headers.Values[AName];
- end else begin
- Result := LActiveDecoder.Headers.Values[AName];
- end;
- end;
- {Only set AUseBodyAsTarget to True if you want the input stream stored in TIdMessage.Body
- instead of TIdText.Body: this happens with some single-part messages.}
- procedure ProcessTextPart(var VDecoder: TIdMessageDecoder; AUseBodyAsTarget: Boolean);
- var
- LMStream: TMemoryStream;
- i: integer;
- LTxt : TIdText;
- LNewDecoder: TIdMessageDecoder;
- {$IFDEF STRING_IS_ANSI}
- LAnsiEncoding: IIdTextEncoding;
- {$ENDIF}
- begin
- LMStream := TMemoryStream.Create;
- try
- LParentPart := AMsg.MIMEBoundary.ParentPart;
- LNewDecoder := VDecoder.ReadBody(LMStream, LMsgEnd);
- try
- LMStream.Position := 0;
- if AUseBodyAsTarget then begin
- // TODO: if the Content-Type is HTML, parse the HTML data looking for a charset
- // declaration, and if found then use that instead of the MIME charset...
- if AMsg.IsMsgSinglePartMime then begin
- {$IFDEF STRING_IS_ANSI}
- LAnsiEncoding := CharsetToEncoding(AMsg.CharSet);
- {$ENDIF}
- ReadStringsAsCharSet(LMStream, AMsg.Body, AMsg.CharSet{$IFDEF STRING_IS_ANSI}, LAnsiEncoding{$ENDIF});
- end else begin
- {$IFDEF STRING_IS_ANSI}
- LAnsiEncoding := ContentTypeToEncoding(VDecoder.Headers.Values[SContentType], QuoteMIME);
- {$ENDIF}
- ReadStringsAsContentType(LMStream, AMsg.Body, VDecoder.Headers.Values[SContentType], QuoteMIME{$IFDEF STRING_IS_ANSI}, LAnsiEncoding{$ENDIF});
- end;
- end else begin
- LTxt := TIdText.Create(AMsg.MessageParts);
- try
- {$IFDEF STRING_IS_ANSI}
- LAnsiEncoding := ContentTypeToEncoding(GetHeaderValue(SContentType), QuoteMIME);
- {$ENDIF}
- ReadStringsAsContentType(LMStream, LTxt.Body, GetHeaderValue(SContentType), QuoteMIME{$IFDEF STRING_IS_ANSI}, LAnsiEncoding{$ENDIF});
- RemoveLastBlankLine(LTxt.Body);
- LTxt.ContentType := LTxt.ResolveContentType(GetHeaderValue(SContentType));
- LTxt.CharSet := LTxt.GetCharSet(GetHeaderValue(SContentType)); {do not localize}
- LTxt.ContentTransfer := GetHeaderValue(SContentTransferEncoding); {do not localize}
- LTxt.ContentID := GetHeaderValue('Content-ID'); {do not localize}
- LTxt.ContentLocation := GetHeaderValue('Content-Location'); {do not localize}
- LTxt.ContentDescription := GetHeaderValue('Content-Description'); {do not localize}
- LTxt.ContentDisposition := GetHeaderValue('Content-Disposition'); {do not localize}
- if not AMsg.IsMsgSinglePartMime then begin
- for i := 0 to VDecoder.Headers.Count-1 do begin
- if LTxt.Headers.IndexOfName(VDecoder.Headers.Names[i]) < 0 then begin
- LTxt.ExtraHeaders.AddValue(
- VDecoder.Headers.Names[i],
- IndyValueFromIndex(VDecoder.Headers, i)
- );
- end;
- end;
- end;
- LTxt.Filename := VDecoder.Filename;
- if IsHeaderMediaType(LTxt.ContentType, 'multipart') then begin {do not localize}
- LTxt.ParentPart := LPreviousParentPart;
- // RLebeau 08/17/09 - According to RFC 2045 Section 6.4:
- // "If an entity is of type "multipart" the Content-Transfer-Encoding is not
- // permitted to have any value other than "7bit", "8bit" or "binary"."
- //
- // However, came across one message where the "Content-Type" was set to
- // "multipart/related" and the "Content-Transfer-Encoding" was set to
- // "quoted-printable". Outlook and Thunderbird were apparently able to parse
- // the message correctly, but Indy was not. So let's check for that scenario
- // and ignore illegal "Content-Transfer-Encoding" values if present...
- if LTxt.ContentTransfer <> '' then begin
- if not IsHeaderValue(LTxt.ContentTransfer, ['7bit', '8bit', 'binary']) then begin {do not localize}
- LTxt.ContentTransfer := '';
- end;
- end;
- end else begin
- LTxt.ParentPart := LParentPart;
- end;
- except
- LTxt.Free;
- raise;
- end;
- end;
- except
- LNewDecoder.Free;
- raise;
- end;
- VDecoder.Free;
- VDecoder := LNewDecoder;
- finally
- FreeAndNil(LMStream);
- end;
- end;
- procedure ProcessAttachment(var VDecoder: TIdMessageDecoder);
- var
- LDestStream: TStream;
- i: integer;
- LAttachment: TIdAttachment;
- LNewDecoder: TIdMessageDecoder;
- begin
- LParentPart := AMsg.MIMEBoundary.ParentPart;
- AMsg.DoCreateAttachment(VDecoder.Headers, LAttachment);
- Assert(Assigned(LAttachment), 'Attachment must not be unassigned here!'); {Do not localize}
- try
- LNewDecoder := nil;
- try
- LDestStream := LAttachment.PrepareTempStream;
- try
- LNewDecoder := VDecoder.ReadBody(LDestStream, LMsgEnd);
- finally
- LAttachment.FinishTempStream;
- end;
- LAttachment.ContentType := LAttachment.ResolveContentType(GetHeaderValue(SContentType));
- LAttachment.CharSet := LAttachment.GetCharSet(GetHeaderValue(SContentType));
- if VDecoder is TIdMessageDecoderUUE then begin
- LAttachment.ContentTransfer := TIdMessageDecoderUUE(VDecoder).CodingType; {do not localize}
- end else begin
- //Watch out for BinHex 4.0 encoding: no ContentTransfer is specified
- //in the header, but we need to set it to something meaningful for us...
- if IsHeaderMediaType(LAttachment.ContentType, 'application/mac-binhex40') then begin {do not localize}
- LAttachment.ContentTransfer := 'binhex40'; {do not localize}
- end else begin
- LAttachment.ContentTransfer := GetHeaderValue(SContentTransferEncoding);
- end;
- end;
- LAttachment.ContentDisposition := GetHeaderValue('Content-Disposition'); {do not localize}
- LAttachment.ContentID := GetHeaderValue('Content-ID'); {do not localize}
- LAttachment.ContentLocation := GetHeaderValue('Content-Location'); {do not localize}
- LAttachment.ContentDescription := GetHeaderValue('Content-Description'); {do not localize}
- if not AMsg.IsMsgSinglePartMime then begin
- for i := 0 to VDecoder.Headers.Count-1 do begin
- if LAttachment.Headers.IndexOfName(VDecoder.Headers.Names[i]) < 0 then begin
- LAttachment.ExtraHeaders.AddValue(
- VDecoder.Headers.Names[i],
- IndyValueFromIndex(VDecoder.Headers, i)
- );
- end;
- end;
- end;
- LAttachment.Filename := VDecoder.Filename;
- if IsHeaderMediaType(LAttachment.ContentType, 'multipart') then begin {do not localize}
- LAttachment.ParentPart := LPreviousParentPart;
- // RLebeau 08/17/09 - According to RFC 2045 Section 6.4:
- // "If an entity is of type "multipart" the Content-Transfer-Encoding is not
- // permitted to have any value other than "7bit", "8bit" or "binary"."
- //
- // However, came across one message where the "Content-Type" was set to
- // "multipart/related" and the "Content-Transfer-Encoding" was set to
- // "quoted-printable". Outlook and Thunderbird were apparently able to parse
- // the message correctly, but Indy was not. So let's check for that scenario
- // and ignore illegal "Content-Transfer-Encoding" values if present...
- if LAttachment.ContentTransfer <> '' then begin
- if not IsHeaderValue(LAttachment.ContentTransfer, ['7bit', '8bit', 'binary']) then begin {do not localize}
- LAttachment.ContentTransfer := '';
- end;
- end;
- end else begin
- LAttachment.ParentPart := LParentPart;
- end;
- except
- LNewDecoder.Free;
- raise;
- end;
- VDecoder.Free;
- VDecoder := LNewDecoder;
- except
- //This should also remove the Item from the TCollection.
- //Note that Delete does not exist in the TCollection.
- LAttachment.Free;
- raise;
- end;
- end;
- begin
- LMsgEnd := False;
- // RLebeau 08/09/09 - TIdNNTP.GetBody() calls TIdMessage.Clear() before then
- // calling ReceiveBody(), thus the TIdMessage.ContentTransferEncoding value
- // is not available for use below. What is the best way to detect that so
- // the user could be allowed to set up the IOHandler.DefStringEncoding
- // beforehand?
- LUnknownContentTransferEncoding := False;
- if AMsg.NoDecode then begin
- LEncoding := IndyTextEncoding_8Bit;
- end else
- begin
- LContentTransferEncoding := ExtractHeaderItem(AMsg.ContentTransferEncoding);
- if LContentTransferEncoding = '' then begin
- // RLebeau 04/08/2014: According to RFC 2045 Section 6.1:
- // "Content-Transfer-Encoding: 7BIT" is assumed if the
- // Content-Transfer-Encoding header field is not present."
- if IsHeaderMediaType(AMsg.ContentType, 'application/mac-binhex40') then begin {Do not Localize}
- LContentTransferEncoding := 'binhex40'; {do not localize}
- end
- else if (AMsg.Encoding = meMIME) and (AMsg.MIMEBoundary.Count > 0) and (not AMsg.NoDecode) then begin
- LContentTransferEncoding := '7bit'; {do not localize}
- end;
- end
- else if IsHeaderMediaType(AMsg.ContentType, 'multipart') then {do not localize}
- begin
- // RLebeau 08/17/09 - According to RFC 2045 Section 6.4:
- // "If an entity is of type "multipart" the Content-Transfer-Encoding is not
- // permitted to have any value other than "7bit", "8bit" or "binary"."
- //
- // However, came across one message where the "Content-Type" was set to
- // "multipart/related" and the "Content-Transfer-Encoding" was set to
- // "quoted-printable". Outlook and Thunderbird were apparently able to parse
- // the message correctly, but Indy was not. So let's check for that scenario
- // and ignore illegal "Content-Transfer-Encoding" values if present...
- if PosInStrArray(LContentTransferEncoding, ['7bit', '8bit', 'binary'], False) = -1 then begin {do not localize}
- LContentTransferEncoding := '';
- //LUnknownContentTransferEncoding := True;
- end;
- end;
- if LContentTransferEncoding <> '' then begin
- case PosInStrArray(LContentTransferEncoding, ['7bit', 'quoted-printable', 'base64', '8bit', 'binary'], False) of {do not localize}
- 0..2: LEncoding := IndyTextEncoding_ASCII;
- 3..4: LEncoding := IndyTextEncoding_8Bit;
- else
- // According to RFC 2045 Section 6.4:
- // "Any entity with an unrecognized Content-Transfer-Encoding must be
- // treated as if it has a Content-Type of "application/octet-stream",
- // regardless of what the Content-Type header field actually says."
- LEncoding := IndyTextEncoding_8Bit;
- LContentTransferEncoding := '';
- LUnknownContentTransferEncoding := True;
- end;
- end else begin
- LEncoding := IndyTextEncoding_8Bit;
- end;
- end;
- BeginWork(wmRead);
- try
- if AMsg.NoDecode then begin
- CaptureAndDecodeCharset;
- end else begin
- LActiveDecoder := nil;
- try
- if ((not LUnknownContentTransferEncoding) and
- ((AMsg.Encoding = meMIME) and (AMsg.MIMEBoundary.Count > 0)) or
- ((AMsg.Encoding = mePlainText) and (not IsHeaderValue(AMsg.ContentTransferEncoding, ['base64', 'quoted-printable']))) {do not localize}
- ) then begin
- {NOTE: You hit this code path with multipart MIME messages and with
- plain-text messages (which may have UUE or XXE attachments embedded).}
- LCharsetEncoding := CharsetToEncoding(AMsg.CharSet);
- repeat
- {CC: This code assumes the preamble text (before the first boundary)
- is plain text. I cannot imagine it not being, but if it arises, lines
- will have to be decoded.}
- // TODO: need to figure out a way to handle both transfer encoding
- // and charset encoding together! Need to read the raw bytes into
- // an intermediate buffer of some kind using the transfer encoding,
- // and then decode the characters using the charset afterwards...
- //
- // Need to do this anyway because ReadLnRFC() processes the LF and
- // ADelim values in terms of the charset specified, which is wrong.
- // EBCDIC-based charsets totally break that logic! For example, cp1026
- // converts #10 (LF) to $25 instead of $0A during encoding, and converts
- // $0A (LF) and $2E ('.') to #$83 and #6 during decoding, etc. And what
- // if the charset is UTF-16 instead? So we need to read raw bytes into
- // a buffer, checking it for handling of line breaks, dot-transparency,
- // and message termination, and THEN decode whatever is left using the
- // charset...
- LLine := IOHandler.ReadLnRFC(LMsgEnd, LF, ADelim, IndyTextEncoding_8Bit{$IFDEF STRING_IS_ANSI}, IndyTextEncoding_8Bit{$ENDIF});
- if LMsgEnd then begin
- Break;
- end;
- if LActiveDecoder = nil then begin
- LActiveDecoder := TIdMessageDecoderList.CheckForStart(AMsg, LLine);
- end;
- // Check again, the if above can set it.
- if LActiveDecoder = nil then begin
- LLine := LCharsetEncoding.GetString(ToBytes(LLine, IndyTextEncoding_8Bit{$IFDEF STRING_IS_ANSI}, IndyTextEncoding_8Bit{$ENDIF}));
- AMsg.Body.Add(LLine);
- end else begin
- RemoveLastBlankLine(AMsg.Body);
- while LActiveDecoder <> nil do begin
- LActiveDecoder.SourceStream := TIdTCPStream.Create(Self);
- LPreviousParentPart := AMsg.MIMEBoundary.ParentPart;
- LActiveDecoder.ReadHeader;
- case LActiveDecoder.PartType of
- mcptText: ProcessTextPart(LActiveDecoder, False);
- mcptAttachment: ProcessAttachment(LActiveDecoder);
- mcptIgnore: FreeAndNil(LActiveDecoder);
- mcptEOF: begin FreeAndNil(LActiveDecoder); LMsgEnd := True; end;
- end;
- end;
- end;
- until LMsgEnd;
- RemoveLastBlankLine(AMsg.Body);
- end else begin
- {These are single-part MIMEs, or else mePlainTexts with the body encoded QP/base64}
- AMsg.IsMsgSinglePartMime := True;
- LActiveDecoder := TIdMessageDecoderMime.Create(AMsg);
- LActiveDecoder.SourceStream := TIdTCPStream.Create(Self);
- // RLebeau: override what TIdMessageDecoderMime.InitComponent() assigns
- TIdMessageDecoderMime(LActiveDecoder).BodyEncoded := True;
- TIdMessageDecoderMime(LActiveDecoder).ReadHeader;
- case LActiveDecoder.PartType of
- mcptText: begin
- if LUnknownContentTransferEncoding then begin
- ProcessAttachment(LActiveDecoder);
- end else begin
- ProcessTextPart(LActiveDecoder, True); //Put the text into TIdMessage.Body
- end;
- end;
- mcptAttachment: ProcessAttachment(LActiveDecoder);
- mcptIgnore: FreeAndNil(LActiveDecoder);
- mcptEOF: FreeAndNil(LActiveDecoder);
- end;
- end;
- finally
- FreeAndNil(LActiveDecoder);
- end;
- end;
- finally
- EndWork(wmRead);
- end;
- end;
- procedure TIdMessageClient.SendHeader(AMsg: TIdMessage);
- begin
- AMsg.GenerateHeader;
- IOHandler.Write(AMsg.LastGeneratedHeaders);
- end;
- procedure TIdMessageClient.SendBody(AMsg: TIdMessage);
- var
- i: Integer;
- LAttachment: TIdAttachment;
- LBoundary: string;
- LDestStream: TStream;
- LStrStream: TStream;
- ISOCharset: string;
- HeaderEncoding: Char; { B | Q }
- LEncoder: TIdMessageEncoder;
- LLine: string;
- procedure EncodeStrings(AStrings: TStrings; AEncoderClass: TIdMessageEncoderClass; AByteEncoding: IIdTextEncoding
- {$IFDEF STRING_IS_ANSI}; AAnsiEncoding: IIdTextEncoding{$ENDIF});
- var
- LStrings: TStringList;
- begin
- {$IFDEF STRING_IS_ANSI}
- EnsureEncoding(AAnsiEncoding, encOSDefault);
- {$ENDIF}
- LStrings := TStringList.Create; try
- LEncoder := AEncoderClass.Create(Self); try
- LStrStream := TMemoryStream.Create; try
- // RLebeau 10/06/2010: not using TStrings.SaveToStream() in D2009+
- // anymore, as it may save a BOM which we do not want here...
- WriteStringToStream(LStrStream, AStrings.Text, AByteEncoding{$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF});
- LStrStream.Position := 0;
- LEncoder.Encode(LStrStream, LStrings);
- finally FreeAndNil(LStrStream); end;
- finally FreeAndNil(LEncoder); end;
- IOHandler.WriteRFCStrings(LStrings, False);
- finally FreeAndNil(LStrings); end;
- end;
- procedure EncodeAttachment(AAttachment: TIdAttachment; AEncoderClass: TIdMessageEncoderClass);
- var
- LAttachStream: TStream;
- begin
- LDestStream := TIdTCPStream.Create(Self, 8192); try
- LEncoder := AEncoderClass.Create(Self); try
- LEncoder.Filename := AAttachment.Filename;
- LAttachStream := AAttachment.OpenLoadStream; try
- LEncoder.Encode(LAttachStream, LDestStream);
- finally AAttachment.CloseLoadStream; end;
- finally FreeAndNil(LEncoder); end;
- finally FreeAndNil(LDestStream); end;
- end;
- procedure WriteTextPart(ATextPart: TIdText);
- var
- LEncoding: IIdTextEncoding;
- LFileName: String;
- begin
- if ATextPart.ContentType = '' then begin
- ATextPart.ContentType := 'text/plain'; {do not localize}
- end;
- // RLebeau 08/17/09 - According to RFC 2045 Section 6.4:
- // "If an entity is of type "multipart" the Content-Transfer-Encoding is not
- // permitted to have any value other than "7bit", "8bit" or "binary"."
- //
- // However, came across one message where the "Content-Type" was set to
- // "multipart/related" and the "Content-Transfer-Encoding" was set to
- // "quoted-printable". Outlook and Thunderbird were apparently able to parse
- // the message correctly, but Indy was not. So let's check for that scenario
- // and ignore illegal "Content-Transfer-Encoding" values if present...
- if IsHeaderMediaType(ATextPart.ContentType, 'multipart') then begin {do not localize}
- if ATextPart.ContentTransfer <> '' then begin
- if not IsHeaderValue(ATextPart.ContentTransfer, ['7bit', '8bit', 'binary']) then begin {do not localize}
- ATextPart.ContentTransfer := '';
- end;
- end;
- end
- else if ATextPart.ContentTransfer = '' then begin
- ATextPart.ContentTransfer := 'quoted-printable'; {do not localize}
- end
- else if (not IsHeaderValue(ATextPart.ContentTransfer, ['quoted-printable', 'base64'])) {do not localize}
- and ATextPart.IsBodyEncodingRequired then
- begin
- ATextPart.ContentTransfer := '8bit'; {do not localize}
- end;
- if ATextPart.ContentDisposition = '' then begin
- ATextPart.ContentDisposition := 'inline'; {do not localize}
- end;
- // TODO: when STRING_IS_ANSI is defined, provide a way for the user to specify the AnsiString encoding for header values...
- LFileName := EncodeHeader(ExtractFileName(ATextPart.FileName), '', HeaderEncoding, ISOCharSet); {do not localize}
- if ATextPart.ContentType <> '' then begin
- IOHandler.Write('Content-Type: ' + ATextPart.ContentType); {do not localize}
- if ATextPart.CharSet <> '' then begin
- IOHandler.Write('; charset="' + ATextPart.CharSet + '"'); {do not localize}
- end;
- if LFileName <> '' then begin
- IOHandler.WriteLn(';'); {do not localize}
- IOHandler.Write(TAB + 'name="' + LFileName + '"'); {do not localize}
- end;
- IOHandler.WriteLn;
- end;
- if ATextPart.ContentTransfer <> '' then begin
- IOHandler.WriteLn(SContentTransferEncoding + ': ' + ATextPart.ContentTransfer); {do not localize}
- end;
- IOHandler.Write('Content-Disposition: ' + ATextPart.ContentDisposition); {do not localize}
- if LFileName <> '' then begin
- IOHandler.WriteLn(';'); {do not localize}
- IOHandler.Write(TAB + 'filename="' + LFileName + '"'); {do not localize}
- end;
- IOHandler.WriteLn;
- if ATextPart.ContentID <> '' then begin
- IOHandler.WriteLn('Content-ID: ' + ATextPart.ContentID); {do not localize}
- end;
- if ATextPart.ContentDescription <> '' then begin
- IOHandler.WriteLn('Content-Description: ' + ATextPart.ContentDescription); {do not localize}
- end;
- IOHandler.Write(ATextPart.ExtraHeaders);
- IOHandler.WriteLn;
- LEncoding := CharsetToEncoding(ATextPart.CharSet);
- case PosInStrArray(ExtractHeaderItem(ATextPart.ContentTransfer), ['quoted-printable', 'base64'], False) of {do not localize}
- 0: EncodeStrings(ATextPart.Body, TIdMessageEncoderQuotedPrintable, LEncoding{$IFDEF STRING_IS_ANSI}, LEncoding{$ENDIF});
- 1: EncodeStrings(ATextPart.Body, TIdMessageEncoderMIME, LEncoding{$IFDEF STRING_IS_ANSI}, LEncoding{$ENDIF});
- else
- IOHandler.WriteRFCStrings(ATextPart.Body, False, LEncoding{$IFDEF STRING_IS_ANSI}, LEncoding{$ENDIF});
- { No test for last line break necessary because IOHandler.WriteRFCStrings() uses WriteLn(). }
- end;
- end;
- var
- LFileName, LContentTransferEncoding: String;
- LTextPart: TIdText;
- LAddedTextPart: Boolean;
- LLastPart: Integer;
- LEncoding: IIdTextEncoding;
- LAttachStream: TStream;
- begin
- LBoundary := '';
- AMsg.InitializeISO(HeaderEncoding, ISOCharSet);
- BeginWork(wmWrite);
- try
- LContentTransferEncoding := ExtractHeaderItem(AMsg.ContentTransferEncoding);
- if (not AMsg.IsMsgSinglePartMime) and
- (PosInStrArray(LContentTransferEncoding, ['base64', 'quoted-printable'], False) <> -1) then {do not localize}
- begin
- //CC2: The user wants the body encoded.
- if AMsg.MessageParts.Count > 0 then begin
- //CC2: We cannot deal with parts within a body encoding (user has to do
- //this manually, if the user really wants to). Note this should have been trapped in TIdMessage.GenerateHeader.
- raise EIdException.Create(RSMsgClientInvalidForTransferEncoding); // TODO: create a new Exception class for this
- end;
- IOHandler.WriteLn; //This is the blank line after the headers
- {$IFDEF OVERLOADED_OPENARRAY_BUG}DoStatusArr{$ELSE}DoStatus{$ENDIF}(hsStatusText, [RSMsgClientEncodingText]);
- LEncoding := CharsetToEncoding(AMsg.CharSet);
- //CC2: Now output AMsg.Body in the chosen encoding...
- if TextIsSame(LContentTransferEncoding, 'base64') then begin {do not localize}
- EncodeStrings(AMsg.Body, TIdMessageEncoderMIME, LEncoding{$IFDEF STRING_IS_ANSI}, LEncoding{$ENDIF});
- end else begin {'quoted-printable'}
- EncodeStrings(AMsg.Body, TIdMessageEncoderQuotedPrintable, LEncoding{$IFDEF STRING_IS_ANSI}, LEncoding{$ENDIF});
- end;
- end
- else if AMsg.Encoding = mePlainText then begin
- IOHandler.WriteLn; //This is the blank line after the headers
- //CC2: It is NOT Mime. It is a body followed by optional attachments
- {$IFDEF OVERLOADED_OPENARRAY_BUG}DoStatusArr{$ELSE}DoStatus{$ENDIF}(hsStatusText, [RSMsgClientEncodingText]);
- // Write out Body first
- LEncoding := CharsetToEncoding(AMsg.CharSet);
- EncodeAndWriteText(AMsg.Body, LEncoding);
- IOHandler.WriteLn;
- if AMsg.MessageParts.Count > 0 then begin
- //The message has attachments.
- for i := 0 to AMsg.MessageParts.Count - 1 do begin
- //CC: Added support for TIdText...
- if AMsg.MessageParts.Items[i] is TIdText then begin
- IOHandler.WriteLn;
- IOHandler.WriteLn('------- Start of text attachment -------'); {do not localize}
- {$IFDEF OVERLOADED_OPENARRAY_BUG}DoStatusArr{$ELSE}DoStatus{$ENDIF}(hsStatusText, [RSMsgClientEncodingText]);
- WriteTextPart(TIdText(AMsg.MessageParts.Items[i]));
- IOHandler.WriteLn('------- End of text attachment -------'); {do not localize}
- end
- else if AMsg.MessageParts.Items[i] is TIdAttachment then begin
- LAttachment := TIdAttachment(AMsg.MessageParts[i]);
- {$IFDEF OVERLOADED_OPENARRAY_BUG}DoStatusArr{$ELSE}DoStatus{$ENDIF}(hsStatusText, [RSMsgClientEncodingAttachment]);
- if LAttachment.ContentTransfer = '' then begin
- //The user has nothing specified: see has he set a preference in
- //TIdMessage.AttachmentEncoding (AttachmentEncoding is really an
- //old and somewhat deprecated property, but we can still support it)...
- if PosInStrArray(AMsg.AttachmentEncoding, ['UUE', 'XXE']) <> -1 then begin {do not localize}
- LAttachment.ContentTransfer := AMsg.AttachmentEncoding;
- end else begin
- //We default to UUE (rather than XXE)...
- LAttachment.ContentTransfer := 'UUE'; {do not localize}
- end;
- end;
- case PosInStrArray(ExtractHeaderItem(LAttachment.ContentTransfer), ['UUE', 'XXE'], False) of {do not localize}
- 0: EncodeAttachment(LAttachment, TIdMessageEncoderUUE);
- 1: EncodeAttachment(LAttachment, TIdMessageEncoderXXE);
- end;
- end;
- IOHandler.WriteLn;
- end;
- end;
- end
- else begin
- //CC2: It is MIME-encoding...
- LAddedTextPart := False;
- //######### OUTPUT THE PREAMBLE TEXT ########
- {For single-part MIME messages, we want the message part headers to be appended
- to the message headers. Otherwise, add the blank separator between header and
- body...}
- if not AMsg.IsMsgSinglePartMime then begin
- IOHandler.WriteLn; //This is the blank line after the headers
- //if AMsg.Body.Count > 0 then begin
- if not AMsg.IsBodyEmpty then begin
- //CC2: The message has a body text. There are now a few possibilities.
- //First up, if ConvertPreamble is False then the user explicitly does not want us
- //to convert the .Body since he had to change it from the default False.
- //Secondly, if AMsg.MessageParts.TextPartCount > 0, he may have put the
- //message text in the part, so don't convert the body.
- //Thirdly, if AMsg.MessageParts.Count = 0, then it has no other parts
- //anyway: in this case, output it without boundaries.
- //if (AMsg.ConvertPreamble and (AMsg.MessageParts.TextPartCount = 0)) then begin
- if AMsg.ConvertPreamble and (AMsg.MessageParts.TextPartCount = 0) and (AMsg.MessageParts.Count > 0) then begin
- //CC2: There is no text part, the user has not changed ConvertPreamble from
- //its default of True, so the user has probably put his message into
- //the body by mistake instead of putting it in a TIdText part.
- //Create a TIdText part from the .Body text...
- LTextPart := TIdText.Create(AMsg.MessageParts, AMsg.Body);
- LTextPart.CharSet := AMsg.CharSet;
- LTextPart.ContentType := 'text/plain'; {do not localize}
- LTextPart.ContentTransfer := 'quoted-printable'; {do not localize}
- //Have to remember that we added a text part, which is the last part
- //in the collection, because we need it to be outputted first...
- LAddedTextPart := True;
- //CC2: Insert our standard preamble text...
- IOHandler.WriteLn(SThisIsMultiPartMessageInMIMEFormat);
- end else begin
- //CC2: Hopefully the user has put suitable text in the preamble, or this
- //is an already-received message which already has a preamble text...
- LEncoding := CharsetToEncoding(AMsg.CharSet);
- EncodeAndWriteText(AMsg.Body, LEncoding);
- end;
- end
- else begin
- //CC2: The user has specified no body text: he presumably has the message in
- //a TIdText part, but it may have no text at all (a message consisting only
- //of headers, which is allowed under the RFC, which will have a parts count
- //of 0).
- if AMsg.MessageParts.Count <> 0 then begin
- //Add the "standard" MIME preamble text for non-html email clients...
- IOHandler.WriteLn(SThisIsMultiPartMessageInMIMEFormat);
- end;
- end;
- IOHandler.WriteLn;
- //######### SET UP THE BOUNDARY STACK ########
- LBoundary := AMsg.MIMEBoundary.Boundary;
- if LBoundary = '' then begin
- LBoundary := TIdMIMEBoundaryStrings.GenerateBoundary;
- AMsg.MIMEBoundary.Push(LBoundary, -1); //-1 is "top level"
- end;
- end;
- //######### OUTPUT THE PARTS ########
- //CC2: Write the text parts in their order, if you change the order you
- //can mess up mutipart sequences.
- //The exception is due to ConvertPreamble, which may have added a text
- //part at the end (the only place a TIdText part can be added), but it
- //needs to be outputted first...
- LLastPart := AMsg.MessageParts.Count - 1;
- if LAddedTextPart then begin
- IOHandler.WriteLn('--' + LBoundary); {do not localize}
- {$IFDEF OVERLOADED_OPENARRAY_BUG}DoStatusArr{$ELSE}DoStatus{$ENDIF}(hsStatusText, [RSMsgClientEncodingText]);
- WriteTextPart(AMsg.MessageParts.Items[LLastPart] as TIdText);
- IOHandler.WriteLn;
- Dec(LLastPart); //Don't output it again in the following "for" loop
- end;
- for i := 0 to LLastPart do begin
- LLine := AMsg.MessageParts.Items[i].ContentType;
- if IsHeaderMediaType(LLine, 'multipart') then begin {do not localize}
- //A multipart header. Write out the CURRENT boundary first...
- IOHandler.WriteLn('--' + LBoundary); {do not localize}
- //Make the current boundary and this part number active...
- //Now need to generate a new boundary...
- LBoundary := TIdMIMEBoundaryStrings.GenerateBoundary;
- AMsg.MIMEBoundary.Push(LBoundary, i);
- //Make sure the header does not already have a pre-existing
- //boundary since we just generated a new one...
- IOHandler.WriteLn('Content-Type: ' + RemoveHeaderEntry(LLine, 'boundary', QuoteMIME) + ';'); {do not localize}
- IOHandler.WriteLn(TAB + 'boundary="' + LBoundary + '"'); {do not localize}
- IOHandler.WriteLn;
- end
- else begin
- //Not a multipart header, see if it is a part change...
- if not AMsg.IsMsgSinglePartMime then begin
- while AMsg.MessageParts.Items[i].ParentPart <> AMsg.MIMEBoundary.ParentPart do begin
- IOHandler.WriteLn('--' + LBoundary + '--'); {do not localize}
- IOHandler.WriteLn;
- AMsg.MIMEBoundary.Pop; //This also pops AMsg.MIMEBoundary.ParentPart
- LBoundary := AMsg.MIMEBoundary.Boundary;
- end;
- IOHandler.WriteLn('--' + LBoundary); {do not localize}
- end;
- if AMsg.MessageParts.Items[i] is TIdText then begin
- {$IFDEF OVERLOADED_OPENARRAY_BUG}DoStatusArr{$ELSE}DoStatus{$ENDIF}(hsStatusText, [RSMsgClientEncodingText]);
- WriteTextPart(AMsg.MessageParts.Items[i] as TIdText);
- IOHandler.WriteLn;
- end
- else if AMsg.MessageParts.Items[i] is TIdAttachment then begin
- LAttachment := TIdAttachment(AMsg.MessageParts[i]);
- {$IFDEF OVERLOADED_OPENARRAY_BUG}DoStatusArr{$ELSE}DoStatus{$ENDIF}(hsStatusText, [RSMsgClientEncodingAttachment]);
- if LAttachment.ContentTransfer = '' then begin
- LContentTransferEncoding := 'base64'; {do not localize}
- LAttachment.ContentTransfer := LContentTransferEncoding;
- end else begin;
- LContentTransferEncoding := ExtractHeaderItem(LAttachment.ContentTransfer);
- end;
- if LAttachment.ContentDisposition = '' then begin
- LAttachment.ContentDisposition := 'attachment'; {do not localize}
- end;
- if LAttachment.ContentType = '' then begin
- if TextIsSame(LContentTransferEncoding, 'base64') then begin {do not localize}
- LAttachment.ContentType := 'application/octet-stream'; {do not localize}
- end else begin
- {CC4: Set default type if not base64 encoded...}
- LAttachment.ContentType := 'text/plain'; {do not localize}
- end;
- end;
- // TODO: when STRING_IS_ANSI is defined, provide a way for the user to specify the AnsiString encoding for header values...
- LFileName := EncodeHeader(ExtractFileName(LAttachment.FileName), '', HeaderEncoding, ISOCharSet); {do not localize}
- if TextIsSame(LContentTransferEncoding, 'binhex40') then begin {do not localize}
- //This is special - you do NOT write out any Content-Transfer-Encoding
- //header! We also have to write a Content-Type specified in RFC 1741
- //(overriding any ContentType present, if necessary).
- LAttachment.ContentType := 'application/mac-binhex40'; {do not localize}
- IOHandler.Write('Content-Type: ' + LAttachment.ContentType); {do not localize}
- if LAttachment.CharSet <> '' then begin
- IOHandler.Write('; charset="' + LAttachment.CharSet + '"'); {do not localize}
- end;
- if LFileName <> '' then begin
- IOHandler.WriteLn(';'); {do not localize}
- IOHandler.Write(TAB + 'name="' + LFileName + '"'); {do not localize}
- end;
- IOHandler.WriteLn;
- end
- else begin
- IOHandler.Write('Content-Type: ' + LAttachment.ContentType); {do not localize}
- if LAttachment.CharSet <> '' then begin
- IOHandler.Write('; charset="' + LAttachment.CharSet + '"'); {do not localize}
- end;
- if LFileName <> '' then begin
- IOHandler.WriteLn(';');
- IOHandler.Write(TAB + 'name="' + LFileName + '"'); {do not localize}
- end;
- IOHandler.WriteLn;
- IOHandler.WriteLn('Content-Transfer-Encoding: ' + LAttachment.ContentTransfer); {do not localize}
- IOHandler.Write('Content-Disposition: ' + LAttachment.ContentDisposition); {do not localize}
- if LFileName <> '' then begin
- IOHandler.WriteLn(';');
- IOHandler.Write(TAB + 'filename="' + LFileName + '"'); {do not localize}
- end;
- IOHandler.WriteLn;
- end;
- if LAttachment.ContentID <> '' then begin
- IOHandler.WriteLn('Content-ID: '+ LAttachment.ContentID); {Do not Localize}
- end;
- if LAttachment.ContentDescription <> '' then begin
- IOHandler.WriteLn('Content-Description: ' + LAttachment.ContentDescription); {Do not localize}
- end;
- IOHandler.Write(LAttachment.ExtraHeaders);
- IOHandler.WriteLn;
- case PosInStrArray(LContentTransferEncoding, ['base64', 'quoted-printable', 'binhex40'], False) of {do not localize}
- 0: EncodeAttachment(LAttachment, TIdMessageEncoderMIME);
- 1: EncodeAttachment(LAttachment, TIdMessageEncoderQuotedPrintable);
- 2: EncodeAttachment(LAttachment, TIdMessageEncoderBinHex4);
- else
- begin
- LEncoding := CharsetToEncoding(LAttachment.Charset);
- LAttachStream := LAttachment.OpenLoadStream;
- try
- while ReadLnFromStream(LAttachStream, LLine, -1, LEncoding) do begin
- IOHandler.WriteLnRFC(LLine, LEncoding);
- end;
- finally
- LAttachment.CloseLoadStream;
- end;
- end;
- end;
- IOHandler.WriteLn;
- end;
- end;
- end;
- if AMsg.MessageParts.Count > 0 then begin
- for i := 0 to AMsg.MIMEBoundary.Count - 1 do begin
- if not AMsg.IsMsgSinglePartMime then begin
- IOHandler.WriteLn('--' + AMsg.MIMEBoundary.Boundary + '--');
- IOHandler.WriteLn;
- end;
- AMsg.MIMEBoundary.Pop;
- end;
- end;
- end;
- finally
- EndWork(wmWrite);
- end;
- end;
- procedure TIdMessageClient.SendMsg(AMsg: TIdMessage; AHeadersOnly: Boolean = False);
- begin
- BeginWork(wmWrite);
- try
- if AMsg.NoEncode then begin
- IOHandler.Write(AMsg.Headers);
- IOHandler.WriteLn;
- if not AHeadersOnly then begin
- IOHandler.WriteRFCStrings(AMsg.Body, False);
- end;
- end else begin
- SendHeader(AMsg);
- if (not AHeadersOnly) then begin
- SendBody(AMsg);
- end;
- end;
- finally
- EndWork(wmWrite);
- end;
- end;
- function TIdMessageClient.ReceiveHeader(AMsg: TIdMessage; const AAltTerm: string = ''): string;
- var
- LMsgEnd: Boolean;
- begin
- BeginWork(wmRead);
- try
- repeat
- Result := IOHandler.ReadLnRFC(LMsgEnd);
- // Exchange Bug: Exchange sometimes returns . when getting a message instead of
- // '' then a . - That is there is no seperation between the header and the message for an
- // empty message.
- if ((Length(AAltTerm) = 0) and LMsgEnd) or {do not localize}
- ({APR: why? (Length(AAltTerm) > 0) and }(Result = AAltTerm)) then begin
- Break;
- end else if Result <> '' then begin
- AMsg.Headers.Append(Result);
- end;
- until False;
- AMsg.ProcessHeaders;
- finally
- EndWork(wmRead);
- end;
- end;
- procedure TIdMessageClient.ProcessMessage(AMsg: TIdMessage; AHeaderOnly: Boolean = False);
- begin
- if IOHandler <> nil then begin
- //Don't call ReceiveBody if the message ended at the end of the headers
- //(ReceiveHeader() would have returned '.' in that case)...
- BeginWork(wmRead);
- try
- if ReceiveHeader(AMsg) = '' then begin
- if not AHeaderOnly then begin
- ReceiveBody(AMsg);
- end;
- end;
- finally
- EndWork(wmRead);
- end;
- end;
- end;
- procedure TIdMessageClient.ProcessMessage(AMsg: TIdMessage; AStream: TStream; AHeaderOnly: Boolean = False);
- var
- LIOHandler: TIdIOHandlerStreamMsg;
- begin
- LIOHandler := TIdIOHandlerStreamMsg.Create(nil, AStream);
- try
- LIOHandler.FreeStreams := False;
- LIOHandler.MaxLineLength := MaxInt;
- IOHandler := LIOHandler;
- try
- IOHandler.Open;
- ProcessMessage(AMsg, AHeaderOnly);
- finally
- IOHandler := nil;
- end;
- finally
- LIOHandler.Free;
- end;
- end;
- procedure TIdMessageClient.ProcessMessage(AMsg: TIdMessage; const AFilename: string; AHeaderOnly: Boolean = False);
- var
- LStream: TStream;
- begin
- LStream := TIdReadFileExclusiveStream.Create(AFileName); try
- ProcessMessage(AMsg, LStream, AHeaderOnly);
- finally FreeAndNil(LStream); end;
- end;
- procedure TIdMessageClient.EncodeAndWriteText(const ABody: TStrings; AEncoding: IIdTextEncoding);
- begin
- Assert(ABody<>nil);
- Assert(IOHandler<>nil);
- // TODO: encode the text...
- IOHandler.WriteRFCStrings(ABody, False, AEncoding);
- end;
- destructor TIdMessageClient.Destroy;
- begin
- inherited Destroy;
- end;
- end.
|