?? idmessageclient.pas
字號:
LLine := ReadLn;
if LLine = ADelim then
begin
Break;
end;
if LActiveDecoder = nil then
begin
LActiveDecoder := TIdMessageDecoderList.CheckForStart(AMsg, LLine);
end;
if LActiveDecoder = nil then begin
if PWord(PChar(LLine))^= wDoublePoint then begin
Delete(LLine,1,1);
end;//if '..'
AMsg.Body.Add(LLine);
end else begin
while LActiveDecoder <> nil do begin
LActiveDecoder.SourceStream := TIdTCPStream.Create(Self);
LActiveDecoder.ReadHeader;
case LActiveDecoder.PartType of
mcptUnknown:
begin
raise EIdException.Create(RSMsgClientUnkownMessagePartType);
end;
mcptText:
begin
LActiveDecoder := ProcessTextPart(LActiveDecoder);
end;
mcptAttachment:
begin
LActiveDecoder := ProcessAttachment(LActiveDecoder);
end;
end;
end;
end;
until LMsgEnd;
finally
EndWork(wmRead);
end;
end;
end;
procedure TIdMessageClient.SendHeader(AMsg: TIdMessage);
var
LHeaders: TIdHeaderList;
begin
LHeaders := AMsg.GenerateHeader;
try
WriteStrings(LHeaders);
finally
FreeAndNil(LHeaders);
end;
end;
procedure TIdMessageClient.SendBody(AMsg: TIdMEssage);
var
i: Integer;
LAttachment: TIdAttachment;
LBoundary: string;
LDestStream: TIdTCPStream;
LMIMEAttachments: boolean;
ISOCharset: string;
HeaderEncoding: Char; { B | Q }
TransferEncoding: TTransfer;
procedure WriteTextPart(ATextPart: TIdText);
var
Data: string;
i: Integer;
begin
if Length(ATextPart.ContentType) = 0 then
ATextPart.ContentType := 'text/plain'; {do not localize}
if Length(ATextPart.ContentTransfer) = 0 then
ATextPart.ContentTransfer := 'quoted-printable'; {do not localize}
WriteLn('Content-Type: ' + ATextPart.ContentType); {do not localize}
WriteLn('Content-Transfer-Encoding: ' + ATextPart.ContentTransfer); {do not localize}
if Length(ATextPart.ContentID) <> 0 then
begin
WriteLn('Content-Id: ' + ATextPart.ContentID);
end;
WriteStrings(ATextPart.ExtraHeaders);
WriteLn('');
// TODO: Provide B64 encoding later
// if AnsiSameText(ATextPart.ContentTransfer, 'base64') then begin
// LEncoder := TIdEncoder3to4.Create(nil);
if AnsiSameText(ATextPart.ContentTransfer, 'quoted-printable') then
begin
for i := 0 to ATextPart.Body.Count - 1 do
begin
if Copy(ATextPart.Body[i], 1, 1) = '.' then
begin
ATextPart.Body[i] := '.' + ATextPart.Body[i];
end;
Data := TIdEncoderQuotedPrintable.EncodeString(ATextPart.Body[i] + EOL);
if TransferEncoding = iso2022jp then
Write(Encode2022JP(Data))
else
Write(Data);
end;
end
else begin
WriteStrings(ATextPart.Body);
end;
WriteLn('');
end;
begin
LMIMEAttachments := AMsg.Encoding = meMIME;
LBoundary := '';
InitializeISO(TransferEncoding, HeaderEncoding, ISOCharSet);
BeginWork(wmWrite);
try
if AMsg.MessageParts.AttachmentCount > 0 then
begin
if LMIMEAttachments then
begin
WriteLn('This is a multi-part message in MIME format'); {do not localize}
WriteLn('');
if AMsg.MessageParts.RelatedPartCount > 0 then
begin
LBoundary := IndyMultiPartRelatedBoundary;
end
else begin
LBoundary := IndyMIMEBoundary;
end;
WriteLn('--' + LBoundary);
end
else begin
// It's UU, write the body
WriteBodyText(AMsg);
WriteLn('');
end;
if AMsg.MessageParts.TextPartCount > 1 then
begin
WriteLn('Content-Type: multipart/alternative; '); {do not localize}
WriteLn(' boundary="' + IndyMultiPartAlternativeBoundary + '"'); {do not localize}
WriteLn('');
for i := 0 to AMsg.MessageParts.Count - 1 do
begin
if AMsg.MessageParts.Items[i] is TIdText then
begin
WriteLn('--' + IndyMultiPartAlternativeBoundary);
DoStatus(hsStatusText, [RSMsgClientEncodingText]);
WriteTextPart(AMsg.MessageParts.Items[i] as TIdText);
WriteLn('');
end;
end;
WriteLn('--' + IndyMultiPartAlternativeBoundary + '--');
end
else begin
if LMIMEAttachments then
begin
WriteLn('Content-Type: text/plain'); {do not localize}
WriteLn('Content-Transfer-Encoding: 7bit'); {do not localize}
WriteLn('');
WriteBodyText(AMsg);
end;
end;
// Send the attachments
for i := 0 to AMsg.MessageParts.Count - 1 do
begin
if AMsg.MessageParts[i] is TIdAttachment then
begin
LAttachment := TIdAttachment(AMsg.MessageParts[i]);
DoStatus(hsStatusText, [RSMsgClientEncodingAttachment]);
if LMIMEAttachments then
begin
WriteLn('');
WriteLn('--' + LBoundary);
if Length(LAttachment.ContentTransfer) = 0 then
begin
LAttachment.ContentTransfer := 'base64'; {do not localize}
end;
if Length(LAttachment.ContentDisposition) = 0 then
begin
LAttachment.ContentDisposition := 'attachment'; {do not localize}
end;
if (LAttachment.ContentTransfer = 'base64') {do not localize}
and (Length(LAttachment.ContentType) = 0) then
begin
LAttachment.ContentType := 'application/octet-stream'; {do not localize}
end;
WriteLn('Content-Type: ' + LAttachment.ContentType + ';'); {do not localize}
WriteLn(' name="' + ExtractFileName(LAttachment.FileName) + '"'); {do not localize}
WriteLn('Content-Transfer-Encoding: ' + LAttachment.ContentTransfer); {do not localize}
WriteLn('Content-Disposition: ' + LAttachment.ContentDisposition +';'); {do not localize}
WriteLn(' filename="' + ExtractFileName(LAttachment.FileName) + '"'); {do not localize}
if Length(LAttachment.ContentID) <> 0 then
begin
WriteLn('Content-Id: ' + LAttachment.ContentID);
end;
WriteStrings(LAttachment.ExtraHeaders);
WriteLn('');
end;
LDestStream := TIdTCPStream.Create(Self);
try
TIdAttachment(AMsg.MessageParts[i]).Encode(LDestStream);
finally
FreeAndNil(LDestStream);
end;
WriteLn('');
end;
end;
if LMIMEAttachments then
begin
WriteLn('--' + LBoundary + '--');
end;
end
// S.G. 21/2/2003: If the user added a single texpart message without filling the body
// S.G. 21/2/2003: we still need to send that out
else
if (AMsg.MessageParts.TextPartCount > 1) or
((AMsg.MessageParts.TextPartCount = 1) and (AMsg.Body.Count = 0)) then
begin
WriteLn('This is a multi-part message in MIME format'); {do not localize}
WriteLn('');
for i := 0 to AMsg.MessageParts.Count - 1 do
begin
if AMsg.MessageParts.Items[i] is TIdText then
begin
WriteLn('--' + IndyMIMEBoundary);
DoStatus(hsStatusText, [RSMsgClientEncodingText]);
WriteTextPart(AMsg.MessageParts.Items[i] as TIdText);
end;
end;
WriteLn('--' + IndyMIMEBoundary + '--');
end
else begin
DoStatus(hsStatusText, [RSMsgClientEncodingText]);
// Write out Body
//TODO: Why just iso2022jp? Why not someting generic for all MBCS? Or is iso2022jp special?
if TransferEncoding = iso2022jp then
begin
for i := 0 to AMsg.Body.Count - 1 do
begin
if Copy(AMsg.Body[i], 1, 1) = '.' then
begin
WriteLn('.' + Encode2022JP(AMsg.Body[i]));
end
else begin
WriteLn(Encode2022JP(AMsg.Body[i]));
end;
end;
end
else begin
WriteBodyText(AMsg);
end;
end;
finally
EndWork(wmWrite);
end;
end;
{ 2001-Oct-29 Don Siders
procedure TIdMessageClient.SendMsg(AMsg: TIdMessage);
begin
SendHeader(AMsg);
WriteLn('');
SendBody(AMsg);
end; }
// 2001-Oct-29 Don Siders Added AHeadersOnly parameter
// TODO: Override TIdMessageClient.SendMsg to provide socket, stream, and file
// versions like TIdMessageClient.ProcessMessage?
procedure TIdMessageClient.SendMsg(AMsg: TIdMessage; const AHeadersOnly: Boolean = False);
begin
if AMsg.NoEncode then begin
WriteStringS(AMsg.Headers);
WriteLn('');
if not AHeadersOnly then begin
WriteStrings(AMsg.Body);
end;
end else begin
SendHeader(AMsg);
WriteLn('');
if (not AHeadersOnly) then SendBody(AMsg);
end;
end;
function TIdMessageClient.ReceiveHeader(AMsg: TIdMessage; const AAltTerm: string = ''): string;
begin
BeginWork(wmRead); try
repeat
Result := ReadLn;
// 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 (Result = '.')) or
({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
if Length(ReceiveHeader(AMsg)) = 0 then begin
// Only retreive the body if we do not already have a full RFC
if (not AHeaderOnly) then begin
ReceiveBody(AMsg);
end;
end;
end;
end;
procedure TIdMessageClient.ProcessMessage(AMsg: TIdMessage; const AStream: TStream; AHeaderOnly: Boolean = False);
var
LIOHSM: TIdIOHandlerStreamMsg;
begin
LIOHSM := TIdIOHandlerStreamMsg.Create(nil); try
LIOHSM.InputStream := AStream;
LIOHSM.FreeStreams := False;
IOHandler := LIOHSM; try
Connect; try
ProcessMessage(AMsg, AHeaderOnly);
finally Disconnect; end;
finally IOHandler := nil; end;
finally FreeAndNil(LIOHSM); end;
end;
procedure TIdMessageClient.ProcessMessage(AMsg: TIdMessage; const AFilename: string; AHeaderOnly: Boolean = False);
var
LStream: TFileStream;
begin
LStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
try
ProcessMessage(AMsg, LStream, AHeaderOnly);
finally
FreeAndNil(LStream);
end;
end;
procedure TIdMessageClient.WriteBodyText(AMsg: TIdMessage);
var
i: integer;
begin
for i := 0 to AMsg.Body.Count - 1 do
begin
if Copy(AMsg.Body[i], 1, 1) = '.' then
begin
WriteLn('.' + AMsg.Body[i]);
end
else begin
WriteLn(AMsg.Body[i]);
end;
end;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -