![]() |
AW: Indy & OpenSSL 1.1.1 & TLS 1.3
Kann man den neuen Code von diesem Link
![]() für dieses Beispiel hier unten verwenden?
Delphi-Quellcode:
unit uSendMail;
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); TSendMail = class private FLibeay32, FSSLeay32: string; FSmtp: TIdSMTP; FIdSSLIOHandler: TIdSSLIOHandlerSocketOpenSSL; FMsg: TIdMessage; FAttachmentList: TStringList; FiEMailSize: Integer; FUseSSL: Boolean; FTLSMode: 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 SetPassword(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 GetPassword: 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 GetPassword write SetPassword; 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(const 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 TSendMail.Create; begin FSmtp := TIdSMTP.Create(nil); FIdSSLIOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil); FMsg := TIdMessage.Create(nil); FAttachmentList := TStringList.Create; end; destructor TSendMail.Destroy; begin FreeAndNil(FSmtp); FreeAndNil(FIdSSLIOHandler); FreeAndNil(FMsg); FreeAndNil(FAttachmentList); inherited; end; function TSendMail.GetLoginType: TLoginType; begin if FSmtp.AuthType = satNone then Result := ltNone else Result := ltLogin; end; function TSendMail.GetHost: string; begin Result := FSmtp.Host; end; function TSendMail.GetPort: Word; begin Result := FSmtp.Port; end; function TSendMail.GetPassword: string; begin Result := FSmtp.Password; end; function TSendMail.GetUserName: string; begin Result := FSmtp.Username; end; procedure TSendMail.SetLoginType(const aValue: TLoginType); begin if aValue = ltNone then FSmtp.AuthType := satNone else FSmtp.AuthType := satDefault; end; procedure TSendMail.SetHost(const aValue: string); begin if aValue <> FSmtp.Host then FSmtp.Host := aValue; end; procedure TSendMail.SetPort(const aValue: Word); begin if aValue <> FSmtp.Port then FSmtp.Port := aValue; end; procedure TSendMail.SetPassword(const aValue: string); begin if aValue <> FSmtp.Password then FSmtp.Password := aValue; end; procedure TSendMail.SetUserName(const aValue: string); begin if aValue <> FSmtp.Username then FSmtp.Username := aValue; end; function TSendMail.GetMailAgent: string; begin Result := FSmtp.MailAgent; end; procedure TSendMail.SetMailAgent(const aValue: string); begin if aValue <> FSmtp.MailAgent then FSmtp.MailAgent := aValue; end; function TSendMail.GetBody: TStrings; begin Result := FMsg.Body; end; function TSendMail.GetUseSSL; begin Result := FUseSSL; end; function TSendMail.GetTLSMode; begin Result := FTLSMode; end; function TSendMail.GetPriority: TMailPriority; var iTmp: Byte; begin iTmp := Ord(FMsg.Priority); Result := TMailPriority(iTmp); end; function TSendMail.GetReceiver: string; begin Result := FMsg.Recipients.EMailAddresses; end; function TSendMail.GetReturnReciept: Boolean; begin Result := FMsg.ReceiptRecipient.Text <> ''; end; function TSendMail.GetSender: string; begin Result := FMsg.From.Text; end; function TSendMail.GetSSLeay32: string; begin Result := FSSLeay32; end; function TSendMail.GetLibeay32: string; begin Result := FLibeay32; end; function TSendMail.GetSubject: string; begin Result := FMsg.Subject; end; procedure TSendMail.SetBody(aValue: TStrings); begin FMsg.Body.Assign(aValue); end; procedure TSendMail.SetUseSSL(const aValue: Boolean); begin FUseSSL := aValue; end; procedure TSendMail.SetTLSMode(const aValue: Integer); begin FTLSMode := aValue; end; procedure TSendMail.SetPriority(const aValue: TMailPriority); var iTmp: Byte; begin iTmp := Ord(aValue); FMsg.Priority := TIdMessagePriority(iTmp); end; procedure TSendMail.SetReceiver(const aValue: string); begin FMsg.Recipients.EMailAddresses := aValue; end; procedure TSendMail.SetReturnReciept(const aValue: Boolean); begin if aValue then FMsg.ReceiptRecipient.Text := FMsg.From.Text else FMsg.ReceiptRecipient.Text := ''; end; procedure TSendMail.SetSender(const aValue: string); begin FMsg.From.Text := aValue; end; procedure TSendMail.SetSSLeay32(const aValue: string); begin FSSLeay32 := aValue; end; procedure TSendMail.SetLibeay32(const aValue: string); begin FLibeay32 := aValue; end; procedure TSendMail.SetSubject(const aValue: string); begin FMsg.Subject := aValue; end; procedure TSendMail.setEmailSize(iEMailSize: Integer); begin FiEMailSize := iEMailSize; end; function TSendMail.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 TFile.Exists(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 TFile.Exists(FLibeay32) and TFile.Exists(FSSLeay32) then begin FSmtp.IOHandler := FIdSSLIOHandler; // Not needed? // fIdSSLIOHandler.SSLOptions.Mode := sslmUnassigned; // fIdSSLIOHandler.SSLOptions.VerifyMode := []; // fIdSSLIOHandler.SSLOptions.VerifyDepth := 0; // // fIdSSLIOHandler.Destination := getHost + ':' + IntToStr(getPort); // fIdSSLIOHandler.Host := getHost; // fIdSSLIOHandler.Port := getPort; 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. |
Alle Zeitangaben in WEZ +1. Es ist jetzt 23:16 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz