Delphi XE7 / TIdSMTP / Unicode

[Sir Rufo]

Indy codiert die Nachricht von alleine - wenn man korrekt mitteilt, was man haben möchte. Es sind also keine Verrenkungen nötig.

Hier mal die entsprechende Änderung für den Email-Sender. Wie man sieht, man muss eigentlich so gut wir gar nichts machen

Im Anhang befindet sich die EXE mit diesen Änderungen zum Ausprobieren

Delphi-Quellcode:

unit SendMail.Impl.IndySendMail;

interface

uses
  SendMail,

  System.Classes,
  System.Generics.Collections,
  System.SysUtils,

  IdBaseComponent,
  IdComponent,
  IdExplicitTLSClientServerBase,
  IdIOHandler,
  IdIOHandlerSocket,
  IdIOHandlerStack,
  IdMessage,
  IdMessageClient,
  IdSASL,
  IdSASL_CRAMBase,
  IdSASL_CRAM_MD5,
  IdSASL_CRAM_SHA1,
  IdSASLAnonymous,
  IdSASLDigest,
  IdSASLExternal,
  IdSASLLogin,
  IdSASLOTP,
  IdSASLPlain,
  IdSASLSKey,
  IdSASLUserPass,
  IdSMTP,
  IdSMTPBase,
  IdSSL,
  IdSSLOpenSSL,
  IdTCPConnection,
  IdTCPClient,
  IdUserPassProvider;

const { Ja, wir definieren Konstanten }
  ContentType_TEXT_PLAIN = 'text/plain';
  CharSet_UTF8           = 'UTF-8';

type
  TIndySendMail = class( TInterfacedObject, ISendMail )
  private
    FSMTP                     : TIdSMTP;
    FSASLAnonymous            : TIdSASLAnonymous;
    FSASLCRAMMD5              : TIdSASLCRAMMD5;
    FSASLCRAMSHA1             : TIdSASLCRAMSHA1;
    FSASLDigest               : TIdSASLDigest;
    FSASLExternal             : TIdSASLExternal;
    FSASLLogin                : TIdSASLLogin;
    FSASLOTP                  : TIdSASLOTP;
    FSASLPlain                : TIdSASLPlain;
    FSASLSKey                 : TIdSASLSKey;
    FUserPassProvider         : TIdUserPassProvider;
    FSSLIOHandlerSocketOpenSSL: TIdSSLIOHandlerSocketOpenSSL;
    FMessage                  : TIdMessage;
  private
    FSync: TObject;
    procedure Configure( Configuration: TSendMailConfiguration );
  private { ISendMail }
    function GetSupportedAuthTypes: TSmtpAuthTypes;
    procedure Send( Configuration: TSendMailConfiguration; Mail: TSendMailMessage );
  public
    constructor Create;
    destructor Destroy; override;
  end;

implementation

uses
  netAlike.Utils;

{ TIndySendMail }

procedure TIndySendMail.Configure( Configuration: TSendMailConfiguration );
begin
  if not( Configuration.AuthType in GetSupportedAuthTypes )
  then
    raise ENotSupportedException.Create( 'AuthType not supported' );

  FSMTP.SASLMechanisms.Clear;

  FSMTP.AuthType := satSASL;
  FSMTP.UseEhlo  := True;

  FUserPassProvider.Username := Configuration.Username;
  FUserPassProvider.Password := Configuration.Password;

  FSASLExternal.AuthorizationIdentity := Configuration.TLSCertifcateId;

  case Configuration.AuthType of
    TSmtpAuthType.None:
      FSMTP.SASLMechanisms.Add.SASL := FSASLAnonymous;
    TSmtpAuthType.Extern:
      FSMTP.SASLMechanisms.Add.SASL := FSASLExternal;
    TSmtpAuthType.MD5CR:
      FSMTP.SASLMechanisms.Add.SASL := FSASLCRAMMD5;
    TSmtpAuthType.SHA1CR:
      FSMTP.SASLMechanisms.Add.SASL := FSASLCRAMSHA1;
    TSmtpAuthType.Password:
      FSMTP.SASLMechanisms.Add.SASL := FSASLLogin;
  else
    if Configuration.AuthType in GetSupportedAuthTypes
    then
      raise ENotImplemented.Create( 'AuthType not implemented' );
  end;

  if Configuration.UseSSL
  then
    begin
      FSMTP.IOHandler := FSSLIOHandlerSocketOpenSSL;
      if Configuration.UseStartTLS
      then
        begin
          FSMTP.UseTLS := utUseExplicitTLS;
        end
      else
        begin
          FSMTP.UseTLS := utUseImplicitTLS;
        end;
    end
  else
    begin
      FSMTP.IOHandler := nil;
      FSMTP.UseTLS    := utNoTLSSupport;
    end;

  FSMTP.Host := Configuration.Host;
  FSMTP.Port := Configuration.Port;
end;

constructor TIndySendMail.Create;
begin
  FSync := TObject.Create;
  inherited;

  FSMTP                      := TIdSMTP.Create( nil );
  FSSLIOHandlerSocketOpenSSL := TIdSSLIOHandlerSocketOpenSSL.Create( FSMTP );
  FUserPassProvider          := TIdUserPassProvider.Create( FSMTP );
  FSASLExternal              := TIdSASLExternal.Create( FSMTP );
  FSASLCRAMMD5               := TIdSASLCRAMMD5.Create( FSMTP );
  FSASLCRAMSHA1              := TIdSASLCRAMSHA1.Create( FSMTP );
  FSASLDigest                := TIdSASLDigest.Create( FSMTP );
  FSASLOTP                   := TIdSASLOTP.Create( FSMTP );
  FSASLSKey                  := TIdSASLSKey.Create( FSMTP );
  FSASLLogin                 := TIdSASLLogin.Create( FSMTP );
  FSASLPlain                 := TIdSASLPlain.Create( FSMTP );
  FSASLAnonymous             := TIdSASLAnonymous.Create( FSMTP );
  FMessage                   := TIdMessage.Create( FSMTP );

  TEnumeratorUtil.ForEach<TIdSASLUserPass>( FSMTP,
    procedure( const c: TIdSASLUserPass )
    begin
      c.UserPassProvider := FUserPassProvider;
    end,
    function( const c: TIdSASLUserPass ): Boolean
    begin
      Result := ( c.UserPassProvider = nil );
    end, True );
end;

destructor TIndySendMail.Destroy;
begin
  FreeAndNil( FSMTP );
  inherited;
  FreeAndNil( FSync );
end;

function TIndySendMail.GetSupportedAuthTypes: TSmtpAuthTypes;
begin
  Result := [
  {} TSmtpAuthType.None,
  {} TSmtpAuthType.Extern,
  {} TSmtpAuthType.MD5CR,
  {} TSmtpAuthType.SHA1CR,
  {} TSmtpAuthType.Password ];
end;

procedure TIndySendMail.Send( Configuration: TSendMailConfiguration; Mail: TSendMailMessage );
begin
  TMonitor.Enter( FSync );
  try

    Configure( Configuration );

    FMessage.Clear;

    FMessage.From.Text           := Mail.Sender;
    FMessage.Recipients.Add.Text := Mail.Receiver;
    FMessage.Subject             := Mail.Subject;
    FMessage.ContentType         := ContentType_TEXT_PLAIN; // <- da
    FMessage.CharSet             := CharSet_UTF8; // <- da
    FMessage.Body.Text           := Mail.Body;

    FSMTP.Connect;
    try
      FSMTP.Send( FMessage );
    finally
      FSMTP.Disconnect( True );
    end;

  finally
    TMonitor.Exit( FSync );
  end;
end;

end.