Email versenden

[DieDolly]

Versuch mal damit
https://www.delphipraxis.net/112798-...dy-senden.html

OpenSSL gibt es hier
https://indy.fulgan.com/SSL/

Du brauchst aber einen SMTP-Server, soviel ist klar.

JFSendMail finde ich komischerweise nirgendwo. Deswegen, hier ist sie

Delphi-Quellcode:

unit JFSendMail;

interface

uses
 Vcl.ComCtrls, System.SysUtils, System.Classes, System.IOUtils, IdSmtp, IdMessage, IdAttachmentFile, IdText, IdExplicitTLSClientServerBase, IdSSLOpenSSL, IdBaseComponent, IdIOHandler,
 IdIOHandlerSocket, IdIOHandlerStack, IdSSL;

type
 TLoginType = (ltNone, ltLogin);

 TMailPriority = (pHighest, pHigh, pNormal, pLow, pLowest);

 TJFSendMail = class
 private
  fLibeay32, fSSLeay32: string;
  fSmtp: TIdSMTP;
  fIdSSLIOHandler: TIdSSLIOHandlerSocketOpenSSL;
  fMsg: TIdMessage;
  fAttachmentList: TStringList;
  fiEMailSize: Integer;
  bUseSSL: Boolean;
  iTLSMode: Integer;

  procedure SetLibeay32(const aValue: string);
  procedure SetSSLeay32(const aValue: string);

  procedure SetHost(const aValue: string);
  procedure SetPort(const aValue: Word);
  procedure SetUserName(const aValue: string);
  procedure SetPwd(const aValue: string);
  procedure SetLoginType(const aValue: TLoginType);
  procedure SetMailAgent(const aValue: string);
  procedure SetReceiver(const aValue: string);
  procedure SetSender(const aValue: string);
  procedure SetSubject(const aValue: string);
  procedure SetPriority(const aValue: TMailPriority);
  procedure SetReturnReciept(const aValue: Boolean);
  procedure SetBody(aValue: TStrings);
  procedure SetUseSSL(const aValue: Boolean);
  procedure SetTLSMode(const aValue: Integer);

  function getLibeay32: string;
  function getSSLeay32: string;

  function getHost: string;
  function getPort: Word;
  function getUserName: string;
  function getPwd: string;
  function getLoginType: TLoginType;
  function getMailAgent: string;
  function getReceiver: string;
  function getSender: string;
  function getSubject: string;
  function getPriority: TMailPriority;
  function getReturnReciept: Boolean;
  function getBody: TStrings;
  function getUseSSL: Boolean;
  function getTLSMode: Integer;

  procedure setEmailSize(iEMailSize: Integer);
 protected
 public
  constructor Create;
  destructor Destroy; override;

  property Libeay32: string read getLibeay32 write SetLibeay32;
  property SSLeay32: string read getSSLeay32 write SetSSLeay32;

  property Host: string read getHost write SetHost;
  property Port: Word read getPort write SetPort;
  property Username: string read getUserName write SetUserName;
  property Password: string read getPwd write SetPwd;
  property LoginType: TLoginType read getLoginType write SetLoginType;
  property MailAgent: string read getMailAgent write SetMailAgent;

  property Receiver: string read getReceiver write SetReceiver;
  property Sender: string read getSender write SetSender;
  property Subject: string read getSubject write SetSubject;
  property Priority: TMailPriority read getPriority write SetPriority;
  property ReturnReciept: Boolean read getReturnReciept write SetReturnReciept;
  property Body: TStrings read getBody write SetBody;
  property Attachments: TStringList read fAttachmentList;
  property UseSSL: Boolean read getUseSSL write SetUseSSL;
  property TLSMode: Integer read getTLSMode write SetTLSMode;

  function SendMail: Boolean;
 end;

implementation

function _MIMEConvert(s: string): string;
var
 i: Integer;
begin
 Result := '';
 for i := 1 to Length(s) do
  begin
   if s[i] = '€' then
    begin
     Result := Result + '?=ISO-8859-15?Q?=A4?='
    end
   else if Ord(s[i]) > $99 then
    Result := Result + '=?ISO-8859-1?Q?=' + Format('%x', [Ord(s[i])]) + '?='
   else
    Result := Result + s[i];
  end;
end;

constructor TJFSendMail.Create;
begin
 fSmtp := TIdSMTP.Create(nil);
 fIdSSLIOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
 fMsg := TIdMessage.Create(nil);
 fAttachmentList := TStringList.Create;
end;

destructor TJFSendMail.Destroy;
begin
 FreeAndNil(fSmtp);
 FreeAndNil(fIdSSLIOHandler);
 FreeAndNil(fMsg);
 FreeAndNil(fAttachmentList);
 inherited;
end;

function TJFSendMail.getLoginType: TLoginType;
begin
 if fSmtp.AuthType = satNone then
  Result := ltNone
 else
  Result := ltLogin;
end;

function TJFSendMail.getHost: string;
begin
 Result := fSmtp.Host;
end;

function TJFSendMail.getPort: Word;
begin
 Result := fSmtp.Port;
end;

function TJFSendMail.getPwd: string;
begin
 Result := fSmtp.Password;
end;

function TJFSendMail.getUserName: string;
begin
 Result := fSmtp.Username;
end;

procedure TJFSendMail.SetLoginType(const aValue: TLoginType);
begin
 if aValue = ltNone then
  fSmtp.AuthType := satNone
 else
  fSmtp.AuthType := satDefault;
end;

procedure TJFSendMail.SetHost(const aValue: string);
begin
 if aValue <> fSmtp.Host then
  fSmtp.Host := aValue;
end;

procedure TJFSendMail.SetPort(const aValue: Word);
begin
 if aValue <> fSmtp.Port then
  fSmtp.Port := aValue;
end;

procedure TJFSendMail.SetPwd(const aValue: string);
begin
 if aValue <> fSmtp.Password then
  fSmtp.Password := aValue;
end;

procedure TJFSendMail.SetUserName(const aValue: string);
begin
 if aValue <> fSmtp.Username then
  fSmtp.Username := aValue;
end;

function TJFSendMail.getMailAgent: string;
begin
 Result := fSmtp.MailAgent;
end;

procedure TJFSendMail.SetMailAgent(const aValue: string);
begin
 if aValue <> fSmtp.MailAgent then
  fSmtp.MailAgent := aValue;
end;

function TJFSendMail.getBody: TStrings;
begin
 Result := fMsg.Body;
end;

function TJFSendMail.getUseSSL;
begin
 Result := bUseSSL;
end;

function TJFSendMail.getTLSMode;
begin
 Result := iTLSMode;
end;

function TJFSendMail.getPriority: TMailPriority;
var
 iTmp: Byte;
begin
 iTmp := Ord(fMsg.Priority);
 Result := TMailPriority(iTmp);
end;

function TJFSendMail.getReceiver: string;
begin
 Result := fMsg.Recipients.EMailAddresses;
end;

function TJFSendMail.getReturnReciept: Boolean;
begin
 Result := fMsg.ReceiptRecipient.Text <> '';
end;

function TJFSendMail.getSender: string;
begin
 Result := fMsg.From.Text;
end;

function TJFSendMail.getSSLeay32: string;
begin
 Result := fSSLeay32;
end;

function TJFSendMail.getLibeay32: string;
begin
 Result := fLibeay32;
end;

function TJFSendMail.getSubject: string;
begin
 Result := fMsg.Subject;
end;

procedure TJFSendMail.SetBody(aValue: TStrings);
begin
 fMsg.Body.Assign(aValue);
end;

procedure TJFSendMail.SetUseSSL(const aValue: Boolean);
begin
 bUseSSL := aValue;
end;

procedure TJFSendMail.SetTLSMode(const aValue: Integer);
begin
 iTLSMode := aValue;
end;

procedure TJFSendMail.SetPriority(const aValue: TMailPriority);
var
 iTmp: Byte;
begin
 iTmp := Ord(aValue);
 fMsg.Priority := TIdMessagePriority(iTmp);
end;

procedure TJFSendMail.SetReceiver(const aValue: string);
begin
 fMsg.Recipients.EMailAddresses := aValue;
end;

procedure TJFSendMail.SetReturnReciept(const aValue: Boolean);
begin
 if aValue then
  fMsg.ReceiptRecipient.Text := fMsg.From.Text
 else
  fMsg.ReceiptRecipient.Text := '';
end;

procedure TJFSendMail.SetSender(const aValue: string);
begin
 fMsg.From.Text := aValue;
end;

procedure TJFSendMail.SetSSLeay32(const aValue: string);
begin
 fSSLeay32 := aValue;
end;

procedure TJFSendMail.SetLibeay32(const aValue: string);
begin
 fLibeay32 := aValue;
end;

procedure TJFSendMail.SetSubject(const aValue: string);
begin
 fMsg.Subject := aValue;
end;

procedure TJFSendMail.setEmailSize(iEMailSize: Integer);
begin
 fiEMailSize := iEMailSize;
end;

function TJFSendMail.SendMail: Boolean;
var
 i: Integer;
begin
 Result := False;

 try
  fMsg.Subject := _MIMEConvert(fMsg.Subject);

  if fAttachmentList.Count > 0 then
   begin
    for i := 0 to fAttachmentList.Count - 1 do
     begin
      if FileExists(fAttachmentList[i]) then
       begin
        TIdAttachmentFile.Create(fMsg.MessageParts, fAttachmentList[i]);

        TIdText.Create(fMsg.MessageParts).ContentType := 'text/html';
        TIdText.Create(fMsg.MessageParts).CharSet := 'ISO-8859-1';

        if i = 0 then
         TIdText.Create(fMsg.MessageParts).Body.Add(fMsg.Body.Text);
       end;
     end;
   end
  else
   begin
    fMsg.ContentType := 'text/html';
    fMsg.CharSet := 'ISO-8859-1';
   end;

  setEmailSize(Length(fMsg.Body.Text));
  fSmtp.ConnectTimeout := 10000;

  if getUseSSL and FileExists(fLibeay32) and FileExists(fSSLeay32) then
   begin
    fSmtp.IOHandler := fIdSSLIOHandler;
    fSmtp.UseTLS := TIdUseTLS(getTLSMode);
    {*
    0 utNoTLSSupport
    1 utUseImplicitTLS
    2 utUseRequireTLS
    3 utUseExplicitTLS
    *}
   end;

  try
   fSmtp.Connect;

   if fSmtp.Connected then
    begin
     try
      fSmtp.Send(fMsg);
      Result := True;
     finally
      fSmtp.Disconnect;
     end;
    end;
  except
   Result := False;
  end;
 except
  Result := False;
 end;
end;

end.