|
Registriert seit: 22. Jun 2018 2.175 Beiträge |
#2
Versuch mal damit
![]() OpenSSL gibt es hier ![]() 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. Geändert von DieDolly ( 6. Apr 2019 um 19:40 Uhr) |
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |