Browse Source

New unit Quick.SMTP

Unknown 7 years ago
parent
commit
666101020c
2 changed files with 240 additions and 2 deletions
  1. 238 0
      Quick.SMTP.pas
  2. 2 2
      README.md

+ 238 - 0
Quick.SMTP.pas

@@ -0,0 +1,238 @@
+{ ***************************************************************************
+
+  Copyright (c) 2016-2017 Kike Pérez
+
+  Unit        : Quick.SMTP
+  Description : Send Emails
+  Author      : Kike Pérez
+  Version     : 1.1
+  Created     : 12/10/2017
+  Modified    : 11/11/2017
+
+  This file is part of QuickLib: https://github.com/exilon/QuickLib
+
+ ***************************************************************************
+
+  Licensed under the Apache License, Version 2.0 (the "License");
+  you may not use this file except in compliance with the License.
+  You may obtain a copy of the License at
+
+  http://www.apache.org/licenses/LICENSE-2.0
+
+  Unless required by applicable law or agreed to in writing, software
+  distributed under the License is distributed on an "AS IS" BASIS,
+  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+  See the License for the specific language governing permissions and
+  limitations under the License.
+
+ *************************************************************************** }
+
+unit Quick.SMTP;
+
+interface
+
+uses
+  Classes,
+  System.SysUtils,
+  IdGlobal,
+  IdSMTP,
+  IdMessage,
+  IdReplySMTP,
+  IdSSLOpenSSL,
+  IdText,
+  IdAttachment,
+  IdAttachmentFile,
+  IdExplicitTLSClientServerBase,
+  IdHTTP;
+
+type
+
+  TMailMessage = class
+  private
+    fSenderName : string;
+    fFrom : string;
+    fRecipient : string;
+    fSubject : string;
+    fBody : string;
+    fCC : string;
+    fBCC : string;
+    fBodyFromFile : Boolean;
+    fAttachments : TStringList;
+    procedure SetBody(aValue : string);
+  public
+    constructor Create;
+    destructor Destroy; override;
+    property SenderName : string read fSenderName write fSenderName;
+    property From : string read fFrom write fFrom;
+    property Recipient : string read fRecipient write fRecipient;
+    property Subject : string read fSubject write fSubject;
+    property Body : string read fBody write SetBody;
+    property CC : string read fCC write fCC;
+    property BCC : string read fBCC write fBCC;
+    property Attachments : TStringList read fAttachments write fAttachments;
+    procedure AddBodyFromFile(const cFileName : string);
+  end;
+
+  TSMTP = class(TIdSMTP)
+  private
+    fServerAuth : Boolean;
+    fUseSSL : Boolean;
+    fMail : TMailMessage;
+  public
+    constructor Create; overload;
+    constructor Create(const cHost : string; cPort : Integer; cUseSSL : Boolean = False); overload;
+    destructor Destroy; override;
+    property ServerAuth : Boolean read fServerAuth write fServerAuth;
+    property UseSSL: Boolean read fUseSSL write fUseSSL;
+    property Mail : TMailMessage read fMail write fMail;
+    function SendMail: Boolean; overload;
+    function SendEmail(const cFrom,cSubject,cTo,cBody : string) : Boolean; overload;
+  end;
+
+implementation
+
+
+{ TMailMessage }
+
+constructor TMailMessage.Create;
+begin
+  fCC := '';
+  fBCC := '';
+  fBody := '';
+  fAttachments := TStringList.Create;
+end;
+
+destructor TMailMessage.Destroy;
+begin
+  if Assigned(fAttachments) then fAttachments.Free;
+  inherited;
+end;
+
+procedure TMailMessage.AddBodyFromFile(const cFileName: string);
+begin
+  fBodyFromFile := True;
+  fBody := cFileName;
+end;
+
+procedure TMailMessage.SetBody(aValue: string);
+begin
+  fBodyFromFile := False;
+  fBody := aValue;
+end;
+
+{ TSMTP }
+
+constructor TSMTP.Create;
+begin
+  inherited;
+  fMail := TMailMessage.Create;
+  Port := 25;
+  UseTLS := TIdUseTLS.utNoTLSSupport;
+  fUseSSL := False;
+end;
+
+constructor TSMTP.Create(const cHost : string; cPort : Integer; cUseSSL : Boolean = False);
+begin
+  inherited Create;
+  Host := cHost;
+  Port := cPort;
+  fUseSSL := cUseSSL;
+end;
+
+destructor TSMTP.Destroy;
+begin
+  if Assigned(fMail) then fMail.Free;
+  inherited;
+end;
+
+function TSMTP.SendEmail(const cFrom,cSubject,cTo,cBody : string) : Boolean;
+begin
+  fMail.From := cFrom;
+  fMail.Subject := cSubject;
+  fMail.Body := cBody;
+  fMail.Recipient := cTo;
+  fMail.CC := '';
+  fMail.BCC := '';
+  Result := Self.SendMail;
+end;
+
+function TSMTP.SendMail: Boolean;
+var
+  msg : TIdMessage;
+  SSLHandler : TIdSSLIOHandlerSocketOpenSSL;
+  email : string;
+  filename : string;
+  mBody : TIdText;
+begin
+  Result := False;
+  SSLHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
+  try
+    msg := TIdMessage.Create(nil);
+    try
+      //create mail msg
+      msg.From.Address := fMail.From;
+      if fMail.SenderName <> '' then msg.From.Name := fMail.SenderName;
+      msg.Subject := fMail.Subject;
+      for email in fMail.Recipient.Split([',']) do msg.Recipients.Add.Address := email;
+      for email in fMail.CC.Split([',']) do msg.CCList.Add.Address := email;
+      for email in fMail.BCC.Split([',']) do msg.BCCList.Add.Address := email;
+      if fMail.fBodyFromFile then
+      begin
+        msg.Body.LoadFromFile(fMail.Body);
+      end
+      else
+      begin
+        mBody := TIdText.Create(msg.MessageParts);
+        mBody.ContentType := 'text/html';
+        mBody.Body.Add(fMail.Body);
+      end;
+      //add attachements if exists
+      if fMail.Attachments.Count > 0 then
+      begin
+        for filename in fMail.Attachments do
+        begin
+          TIdAttachmentFile.Create(msg.MessageParts,filename);
+        end;
+      end;
+
+      //configure smtp SSL
+      try
+        if fUseSSL then
+        begin
+          Self.IOHandler := SSLHandler;
+          SSLHandler.MaxLineAction := maException;
+          SSLHandler.SSLOptions.Method := sslvTLSv1_2;
+          SSLHandler.SSLOptions.Mode := sslmUnassigned;
+          SSLHandler.SSLOptions.VerifyMode := [];
+          SSLHandler.SSLOptions.VerifyDepth := 0;
+          //Self.UseTLS := utUseExplicitTLS;
+        end;
+        //server auth
+        if ServerAuth then Self.AuthType := TIdSMTPAuthenticationType.satDefault;
+        Self.Port := fPort;
+      except
+        on E : Exception do raise Exception.Create(Format('[%s] : %s',[Self.ClassName,e.Message]));
+      end;
+
+      //send email
+      try
+        Self.Connect;
+        if Self.Connected then
+        begin
+          Self.Send(msg);
+          Self.Disconnect(False);
+          Result := True;
+        end;
+      except
+        on E : Exception do raise Exception.Create(Format('[%s] : %s',[Self.ClassName,e.Message]));
+      end;
+    finally
+      msg.Free;
+    end;
+  finally
+    if Assigned(SSLHandler) then SSLHandler.Free;
+  end;
+end;
+
+
+end.

+ 2 - 2
README.md

@@ -133,9 +133,9 @@ Small delphi library containing interesting and quick to implement functions, cr
       MyConfig.Name := 'John';
       MyConfig.Name := 'John';
       MyConfig.Surname := 'Smith';
       MyConfig.Surname := 'Smith';
 	  //load
 	  //load
-      AppConfigJson.Load(Config);
+      AppConfigJson.Load(MyConfig);
 	  //save
 	  //save
-	  AppConfigJson.Save(Config);
+	  AppConfigJson.Save(MyConfig);
 	  
 	  
 	  //create your config to Windows Registry
 	  //create your config to Windows Registry
 	  //Add Quick.Config.Registry to your uses
 	  //Add Quick.Config.Registry to your uses