Einzelnen Beitrag anzeigen

Ykcim

Registriert seit: 29. Dez 2006
Ort: NRW
824 Beiträge
 
Delphi 10.4 Sydney
 
#5

AW: Email mit SSL Verschlüsselung versenden (Windows, Android, iOS)

  Alt 4. Jun 2024, 18:30
Hallo Zusammen,

dieses Thema ist zwar schon sehr alt, hat mir aber trotzdem sehr geholfen. Ich habe die Unit um HTML und Anhänge erweitert und die Zugangsdaten in eine *.ini Datei gepackt. Daher poste ich die Unit hier trotzdem noch einmal...

Delphi-Quellcode:
unit TSendMail;

interface

uses
   IdMessage, Classes;

type
   TSSLEmail = class(TObject)
   private
      FedBody: TStrings;
      FedAttachments: TStrings;
      procedure SetBody(const Value: TStrings);
      procedure SetedAttachments(const Value: TStrings);
   public
      edSMTPServer: string;
      edSMTPPort: integer;
      edUserName: string;
      edPassword: string;
      edSSLConnection: boolean;
      edSenderEmail: string;
      edSenderName: string;
      edToEmail: string;
      edCCEmail: string;
      edBCCEmail: string;
      edSubject: string;
      edPriority: TIdMessagePriority;
      edIsBodyHTML: boolean;

      constructor Create;
      destructor Destroy; override;

      procedure Init;
      procedure SendEmail;

      property edBody: TStrings read FedBody write SetBody;
      property edAttachments: TStrings read FedAttachments write SetedAttachments;
end;

implementation

uses
   IdComponent, IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase,
   IdMessageClient, IdSMTPBase, IdSMTP, IdBaseComponent, IdIOHandler,
   IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdSASLLogin,
   IdSASL_CRAM_SHA1, IdSASL, IdSASLUserPass, IdSASL_CRAMBase, IdSASL_CRAM_MD5,
   IdSASLSKey, IdSASLPlain, IdSASLOTP, IdSASLExternal, IdSASLDigest, IniFiles,
   IdSASLAnonymous, IdUserPassProvider, IdSSLOpenSSLHeaders_Static,
   IdAttachment, IdAttachmentFile, System.SysUtils, IdMessageBuilder;

constructor TSSLEmail.Create;
begin
   inherited;
   FedBody := TStringList.Create;
   FedAttachments := TStringList.Create;
end;

destructor TSSLEmail.Destroy;
begin
   edBody.Free;
   edAttachments.Free;
   inherited;
end;

procedure TSSLEmail.SetBody(const Value: TStrings);
begin
   FedBody.Assign(Value);
end;

procedure TSSLEmail.SetedAttachments(const Value: TStrings);
begin
   FedAttachments.Assign(Value);
end;

procedure TSSLEmail.Init;
begin
   edSMTPServer := '';
   edSMTPPort := 0;
   edUserName := '';
   edPassword := '';
   edSSLConnection := True;
   edSenderEmail := '';
   edSenderName := '';
   edToEmail := '';
   edCCEmail := '';
   edBCCEmail := '';
   edSubject := '';
   edIsBodyHTML:= true;
   edPriority := TIdMessagePriority.mpNormal;
   edBody.Clear;
   edAttachments.Clear;
end;

procedure TSSLEmail.SendEmail;
var IdMessage: TIdMessage; // enthält Eigenschaften der Email
      SMTP: TIdSMTP; // enthält Eigenschaften des SMTP Servers
      SSLHandler: TIdSSLIOHandlerSocketOpenSSL; // alles weitere ist für die SSL Verschlüsselung
      IdUserPassProvider: TIdUserPassProvider;
      IdSASLCRAMMD5: TIdSASLCRAMMD5;
      IdSASLCRAMSHA1: TIdSASLCRAMSHA1;
      IdSASLPlain: TIdSASLPlain;
      IdSASLLogin: TIdSASLLogin;
      IdSASLSKey: TIdSASLSKey;
      IdSASLOTP: TIdSASLOTP;
      IdSASLAnonymous: TIdSASLAnonymous;
      IdSASLExternal: TIdSASLExternal;
      INI: TIniFile;
      INI_FileName: string;
      edAttachmentPath: string;
      IdBuilder: TIdMessageBuilderHtml;
begin
   INI_FileName:= ExtractFilePath(ParamStr(0)) + 'Res\MailProps.ini';
   INI:= TIniFile.Create(INI_FileName);
   IdMessage := TIdMessage.Create;
   IdBuilder := TIdMessageBuilderHtml.Create;
   try
      // Eigenschaften der email setzen
      IdMessage.ContentType := INI.ReadString('IdMessageProps','MessageContentType','');
      IdMessage.Charset := INI.ReadString('IdMessageProps','Charset','');
      IdMessage.Sender.Text := edSenderEMail;
      IdMessage.From.Name := edSenderName;
      IdMessage.From.Address := edSenderEMail;
      IdMessage.ReplyTo.EMailAddresses := edSenderEmail;
      IdMessage.Recipients.EMailAddresses := edToEmail;
      IdMessage.Subject := edSubject;
      IdMessage.Priority := edPriority;
      IdMessage.CCList.EMailAddresses := edCCEMail;
      IdMessage.ReceiptRecipient.Text := '';
      IdMessage.BccList.EMailAddresses := edBCCEMail;
      //Hinzugefügt
      edSMTPServer:= INI.ReadString('SSLConnection','SMTPServer','');
      edSMTPPort:= INI.ReadInteger('SSLConnection','SMTPPort',0);
      edSSLConnection:= INI.ReadBool('SSLConnection','SSL',true);
      edUserName:= INI.ReadString('SSLConnection','User','');
      edPassword:= INI.ReadString('SSLConnection','Password','');

      if edIsBodyHTML then begin
         IdBuilder.Html.Text := edBody.Text;
         IdBuilder.HtmlCharSet := INI.ReadString('IdMessageProps','Charset','');
         IdBuilder.HtmlContentTransfer := INI.ReadString('IdMessageProps','ContentTransfer','');
      end else begin
         IdBuilder.PlainText.Text := edBody.Text;
         IdBuilder.PlainTextCharSet := INI.ReadString('IdMessageProps','Charset','');
         IdBuilder.PlainTextContentTransfer := INI.ReadString('IdMessageProps','ContentTransfer','');
      end;

      if edAttachments <> nil then begin
         for edAttachmentPath in edAttachments do begin
            if FileExists(edAttachmentPath) then begin
               IdBuilder.Attachments.Add(edAttachmentPath);
            end;
         end;
      end;

      IdBuilder.FillMessage(IdMessage);
      SMTP := TIdSMTP.Create;
      try
         if edSSLConnection then begin
            SSLHandler := TIdSSLIOHandlerSocketOpenSSL.Create(SMTP);
            SSLHandler.SSLOptions.Method := sslvSSLv23; // SSL/TLS handshake determines the highest available SSL/TLS version dynamically
            SSLHandler.SSLOptions.Mode := sslmClient;
            SSLHandler.SSLOptions.VerifyMode := [];
            SSLHandler.SSLOptions.VerifyDepth := 0;
            SMTP.IOHandler := SSLHandler;
            if edSMTPPort = 587 then begin
               SMTP.UseTLS := utUseExplicitTLS
            end
            else begin
               SMTP.UseTLS := utUseImplicitTLS; // ImplicitTLS insbesondere auch bei Port 465
            end;
         end;

         if (edUserName<>'') or (edPassword<>'') then begin
            SMTP.AuthType := satSASL;

            // Username und Passwort verschlüsselt bereitstellen
            IdUserPassProvider := TIdUserPassProvider.Create(SMTP);
            IdUserPassProvider.Username := edUserName;
            IdUserPassProvider.Password:= edPassword;

            // SASL-Komponenten für SSL Verschlüsselung
            IdSASLCRAMSHA1 := TIdSASLCRAMSHA1.Create(SMTP);
            IdSASLCRAMSHA1.UserPassProvider := IdUserPassProvider;
            IdSASLCRAMMD5 := TIdSASLCRAMMD5.Create(SMTP);
            IdSASLCRAMMD5.UserPassProvider := IdUserPassProvider;
            IdSASLSKey := TIdSASLSKey.Create(SMTP);
            IdSASLSKey.UserPassProvider := IdUserPassProvider;
            IdSASLOTP := TIdSASLOTP.Create(SMTP);
            IdSASLOTP.UserPassProvider := IdUserPassProvider;
            IdSASLAnonymous := TIdSASLAnonymous.Create(SMTP);
            IdSASLExternal := TIdSASLExternal.Create(SMTP);
            IdSASLLogin := TIdSASLLogin.Create(SMTP);
            IdSASLLogin.UserPassProvider := IdUserPassProvider;
            IdSASLPlain := TIdSASLPlain.Create(SMTP);
            IdSASLPlain.UserPassProvider := IdUserPassProvider;

            SMTP.SASLMechanisms.Add.SASL := IdSASLCRAMSHA1;
            SMTP.SASLMechanisms.Add.SASL := IdSASLCRAMMD5;
            SMTP.SASLMechanisms.Add.SASL := IdSASLSKey;
            SMTP.SASLMechanisms.Add.SASL := IdSASLOTP;
            SMTP.SASLMechanisms.Add.SASL := IdSASLAnonymous;
            SMTP.SASLMechanisms.Add.SASL := IdSASLExternal;
            SMTP.SASLMechanisms.Add.SASL := IdSASLLogin;
            SMTP.SASLMechanisms.Add.SASL := IdSASLPlain;
         end else begin
            SMTP.AuthType := satNone;
         end;

         SMTP.Host := edSMTPServer;
         SMTP.Port := edSMTPPort;
         SMTP.ConnectTimeout := 30000;
         SMTP.UseEHLO := True;
         SMTP.Connect;
         try
            SMTP.Send(IdMessage);
         finally
            SMTP.Disconnect;
         end;
      finally
         SMTP.Free;
      end;
   finally
      IdMessage.Free;
      INI.Free;
      IdBuilder.Free;
   end;
end;

end.
Ich habe eine Mini-*.ini Datei erstellt:
Code:
[IdMessageProps]
TextContentType=text/html
MessageContentType=multipart/mixed
Charset=UTF-8
ContentTransfer=8bit
[SSLConnection]
SMTPServer=xxx.xxx.xxx.xxx
SMTPPort=587
SSL=true
User=xxx@xxxxxx.de
Password=*******
Der Aufruf sieht dann abgekürzt so aus:
Delphi-Quellcode:
procedure TForm_Main.CreateSendReport;
var AttachPfad, AttachFile: string;
      BodyPfad, BodyFile: string;
      Absender, MailAn, MailCC, MailBCC, Betreff: string;
      Sig_Mail, Sig_DWahl, Sig_APartner, Anrede: string;
      vDate, bDate: TDate;
      KdNr, ReportTitel: string;
      SG: TAdvStringGrid;
      Body : TStringList;
      KW: string;
      SendMail: TSSLEmail;
begin
   //Variablen mit Werten füllen
   SendMail:= TSSLEmail.Create;
   Try
      //Hier werden Daten in das StringGrid SG geladen
      Export_Grid(SG, ReportTitel, AttachPfad + AttachFile, false, false, false);
      Body := //HTML-Body erstellen
      
      With SendMail do begin
         Init; //Alles auf Anfang setzen
         edSenderName := Sig_APartner; // Name, der als Absender erscheint
         edSenderEmail := Absender; // Meine Emailadresse, von der ich sende;
         edToEmail := MailAn;
         edCCEmail := MailCC;
         edBCCEmail := MailBCC;
         edSubject := Betreff;
         edBody := Body;
         edAttachments.Add(AttachPfad + AttachFile);
         SendEmail;
      end;
   Finally
      SG.Free;
      Body.Free;
      SendMail.Free
   End;
end;
So funktioniert das bei mir wunderbar. Eine Sache stört mich noch, nämlich dass ich im Outlook in der Mailliste statt der ersten Zeile des Mailtestes die Info bekomme: Zum Anzeigen der Meldung ist ein HTML-Viewer erforderlich <Ende>

Ich habe mal zwei Screenshots hochgeladen, die es zeigen. Hat jemand eine Idee, wie man das noch wegbekommen könnte?

Vielen Dank
Patrick
Miniaturansicht angehängter Grafiken
mailoverviews_wrong.jpg   mailoverviews_right.jpg  
Patrick
  Mit Zitat antworten Zitat