Indy: Googlemail smtp Einstellungen

[Sir Rufo]

Da ich ja - bekanntermassen faul bin - sieht so ein Mailversand bei mir so aus:

Delphi-Quellcode:

unit Forms.MainForm;

interface

uses
  SendMail,

  System.Generics.Collections,
  Winapi.Windows, Winapi.Messages,
  System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TMainForm = class( TForm )
    Button1: TButton;
    procedure Button1Click( Sender: TObject );
  private
    FMailer        : ISendMail;
    FConfigurations: TObjectList<TSendMailConfiguration>;
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

uses
  SendMail.Impl.IndySendMail;

procedure TMainForm.AfterConstruction;
begin
  inherited;
  FMailer         := TIndySendMail.Create;
  FConfigurations := TObjectList<TSendMailConfiguration>.Create( True );
  FConfigurations.Add( TSendMailConfiguration.Create );

  FConfigurations[ 0 ].name        := 'gmail';
  FConfigurations[ 0 ].Host        := 'smtp.gmail.com';
  FConfigurations[ 0 ].UseSSL      := True;
  FConfigurations[ 0 ].UseStartTLS := True;
  FConfigurations[ 0 ].AuthType    := TSmtpAuthType.Password;
  FConfigurations[ 0 ].Username    := 'username';
  FConfigurations[ 0 ].Password    := 'password';
end;

procedure TMainForm.BeforeDestruction;
begin
  FConfigurations.Free;
  inherited;
end;

procedure TMainForm.Button1Click( Sender: TObject );
var
  LMail: TMailContainer;
begin
  LMail := TMailContainer.Create;
  try
    LMail.Receiver := '[e-mail]';
    LMail.Subject  := 'Test Mail';
    LMail.Body     := 'moin moin';

    LMail.Sender := '[e-mail]';
    FMailer.Send( FConfigurations[ 0 ], LMail );
  finally
    LMail.Free;
  end;
end;

end.

Und den Rest kann man immer ganz hübsch wieder verwenden und/oder bei Bedarf erweitern:

• Basis
  
  Delphi-Quellcode:

  unit SendMail;
  
  interface
  
  {$SCOPEDENUMS ON}
  
  type
    TSmtpAuthType  = ( None, Extern, KerberosV5, NTLM, MD5CR, SHA1CR, Password );
    TSmtpAuthTypes = set of TSmtpAuthType;
  
    TSendMailConfiguration = class
    private const
      DefaultPort            = 25;
      DefaultImplicitTLSPort = 465;
      DefaultExplicitTLSPort = 587;
    private
      FName           : string;
      FHost           : string;
      FPort           : Word;
      FUseSSL         : Boolean;
      FAuthType       : TSmtpAuthType;
      FUsername       : string;
      FPassword       : string;
      FTLSCertifcateId: string;
      FDomain         : string;
      FUseStartTLS    : Boolean;
      procedure SetUseSSL( const Value: Boolean );
      procedure SetDefaultPort;
      procedure SetUseStartTLS( const Value: Boolean );
    public
      constructor Create;
      property name: string read FName write FName;
      property TLSCertifcateId: string read FTLSCertifcateId write FTLSCertifcateId;
      property Host: string read FHost write FHost;
      property Port: Word read FPort write FPort;
      property UseSSL: Boolean read FUseSSL write SetUseSSL;
      property UseStartTLS: Boolean read FUseStartTLS write SetUseStartTLS;
      property AuthType: TSmtpAuthType read FAuthType write FAuthType;
      property Domain: string read FDomain write FDomain;
      property Username: string read FUsername write FUsername;
      property Password: string read FPassword write FPassword;
    end;
  
    TMailContainer = class
    private
      FSender  : string;
      FReceiver: string;
      FSubject : string;
      FBody    : string;
    public
      property Sender  : string read FSender write FSender;
      property Receiver: string read FReceiver write FReceiver;
      property Subject : string read FSubject write FSubject;
      property Body    : string read FBody write FBody;
    end;
  
  type
    ISendMail = interface
      [ '{9F6A6EC3-86B5-4E9C-A7B1-42FE1DC35B24}' ]
      procedure Send( Configuration: TSendMailConfiguration; Mail: TMailContainer );
  
      function GetSupportedAuthTypes: TSmtpAuthTypes;
      property SupportedAuthTypes: TSmtpAuthTypes read GetSupportedAuthTypes;
    end;
  
  implementation
  
  { TSendMailConfiguration }
  
  constructor TSendMailConfiguration.Create;
  begin
    inherited Create;
    SetDefaultPort;
  end;
  
  procedure TSendMailConfiguration.SetDefaultPort;
  begin
    if FUseSSL
    then
      begin
        if FUseStartTLS
        then
          FPort := DefaultExplicitTLSPort
        else
          FPort := DefaultImplicitTLSPort
      end
    else
      FPort := DefaultPort;
  end;
  
  procedure TSendMailConfiguration.SetUseSSL( const Value: Boolean );
  begin
    if FUseSSL <> Value
    then
      begin
        FUseSSL := Value;
        SetDefaultPort;
      end;
  end;
  
  procedure TSendMailConfiguration.SetUseStartTLS( const Value: Boolean );
  begin
    if FUseStartTLS <> Value
    then
      begin
        FUseStartTLS := Value;
        SetDefaultPort;
      end;
  end;
  
  end.

• Indy-Implementierung
  
  Delphi-Quellcode:

  unit SendMail.Impl.IndySendMail;
  
  interface
  
  uses
    SendMail,
  
    System.Classes,
    System.Generics.Collections,
    System.SysUtils,
  
    IdBaseComponent,
    IdComponent,
  
    IdIOHandler,
    IdIOHandlerSocket,
    IdIOHandlerStack,
  
    IdSSL,
    IdSSLOpenSSL,
    IdExplicitTLSClientServerBase,
  
    IdUserPassProvider,
  
    IdSASL,
    IdSASL_CRAMBase,
    IdSASL_CRAM_MD5,
    IdSASL_CRAM_SHA1,
    IdSASLAnonymous,
    IdSASLDigest,
    IdSASLExternal,
    IdSASLLogin,
    IdSASLOTP,
    IdSASLPlain,
    IdSASLSKey,
    IdSASLUserPass,
  
    IdSMTP,
    IdSMTPBase,
  
    IdTCPConnection,
    IdTCPClient,
    IdMessageClient,
    IdMessage;
  
  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: TMailContainer );
    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 );
  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: TMailContainer );
  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.Body.Text           := Mail.Body;
  
      FSMTP.Connect;
      try
        FSMTP.Send( FMessage );
      finally
        FSMTP.Disconnect( True );
      end;
  
    finally
      TMonitor.Exit( FSync );
    end;
  end;
  
  end.