aksdb
/
restemplate
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
restemplate/indy/Protocols/IdMessageClient.pas

1586 lines
60 KiB
Plaintext
Raw Permalink Normal View History

* Replaced fphttpclient with indy10. * Added compression support
2015-10-04 14:14:55 +02:00
{
$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.