{ $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, IdTCPClient; 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, IdStreamNET, {$ELSE} IdStreamVCL, {$ENDIF} //TODO: Remove these references and make it completely pluggable. Check other spots in Indy as well IdMessageCoderBinHex4, IdMessageCoderQuotedPrintable, IdMessageCoderMIME, IdMessageCoderUUE, IdMessageCoderXXE, // IdGlobalProtocols, IdCoder, IdCoder3to4, IdCoderBinHex4, IdCoderHeader, IdHeaderCoderBase, IdMessageCoder, IdComponent, IdException, IdResourceStringsProtocols, IdTCPConnection, IdTCPStream, IdIOHandler, IdAttachmentFile, IdText, IdAttachment, 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... 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, but 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 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 PosInStrArray(LTxt.ContentTransfer, ['7bit', '8bit', 'binary'], False) = -1 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 PosInStrArray(LAttachment.ContentTransfer, ['7bit', '8bit', 'binary'], False) = -1 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 := 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) 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 (PosInStrArray(AMsg.ContentTransferEncoding, ['base64', 'quoted-printable'], False) = -1)) {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 PosInStrArray(ATextPart.ContentTransfer, ['7bit', '8bit', 'binary'], False) = -1 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 (PosInStrArray(ATextPart.ContentTransfer, ['quoted-printable', 'base64'], False) = -1) {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); if TextIsSame(ATextPart.ContentTransfer, 'quoted-printable') then begin {do not localize} EncodeStrings(ATextPart.Body, TIdMessageEncoderQuotedPrintable, LEncoding{$IFDEF STRING_IS_ANSI}, LEncoding{$ENDIF}); end else if TextIsSame(ATextPart.ContentTransfer, 'base64') then begin {do not localize} EncodeStrings(ATextPart.Body, TIdMessageEncoderMIME, LEncoding{$IFDEF STRING_IS_ANSI}, LEncoding{$ENDIF}); end else begin 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: String; LTextPart: TIdText; LAddedTextPart: Boolean; LLastPart: Integer; LEncoding: IIdTextEncoding; LAttachStream: TStream; begin LBoundary := ''; AMsg.InitializeISO(HeaderEncoding, ISOCharSet); BeginWork(wmWrite); try if (not AMsg.IsMsgSinglePartMime) and (PosInStrArray(AMsg.ContentTransferEncoding, ['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); end; IOHandler.WriteLn; //This is the blank line after the headers DoStatus(hsStatusText, [RSMsgClientEncodingText]); LEncoding := CharsetToEncoding(AMsg.CharSet); //CC2: Now output AMsg.Body in the chosen encoding... if TextIsSame(AMsg.ContentTransferEncoding, '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 DoStatus(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} DoStatus(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]); DoStatus(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(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} DoStatus(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 DoStatus(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]); DoStatus(hsStatusText, [RSMsgClientEncodingAttachment]); if LAttachment.ContentTransfer = '' then begin LAttachment.ContentTransfer := 'base64'; {do not localize} end; if LAttachment.ContentDisposition = '' then begin LAttachment.ContentDisposition := 'attachment'; {do not localize} end; if LAttachment.ContentType = '' then begin if TextIsSame(LAttachment.ContentTransfer, '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(LAttachment.ContentTransfer, '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(LAttachment.ContentTransfer, ['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; 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.