Sfoglia il codice sorgente

[smtp] new methods to add attachment from file and stream

Exilon 3 anni fa
parent
commit
849b22c198
1 ha cambiato i file con 70 aggiunte e 4 eliminazioni
  1. 70 4
      Quick.SMTP.pas

+ 70 - 4
Quick.SMTP.pas

@@ -5,9 +5,9 @@
   Unit        : Quick.SMTP
   Description : Send Emails
   Author      : Kike P�rez
-  Version     : 1.4
+  Version     : 1.5
   Created     : 12/10/2017
-  Modified    : 11/05/2021
+  Modified    : 08/09/2021
 
   This file is part of QuickLib: https://github.com/exilon/QuickLib
 
@@ -35,6 +35,7 @@ interface
 
 uses
   Classes,
+  Generics.Collections,
   SysUtils,
   IdGlobal,
   IdSMTP,
@@ -44,10 +45,21 @@ uses
   IdText,
   IdAttachment,
   IdAttachmentFile,
+  IdAttachmentMemory,
   IdExplicitTLSClientServerBase,
   IdHTTP;
 
 type
+  TAttachment = class
+  private
+    fFilename : string;
+    fContent : TStream;
+  public
+    constructor Create(const aFilename : string; const aContent : TStream);
+    destructor Destroy; override;
+    property Filename : string read fFilename;
+    property Content : TStream read fContent;
+  end;
 
   TMailMessage = class
   private
@@ -61,7 +73,9 @@ type
     fReplyTo : string;
     fBodyFromFile : Boolean;
     fAttachments : TStringList;
+    fAttachmentFiles : TObjectList<TAttachment>;
     procedure SetBody(aValue : string);
+    procedure SetAttachments(const Value: TStringList);
   public
     constructor Create;
     destructor Destroy; override;
@@ -73,7 +87,10 @@ type
     property CC : string read fCC write fCC;
     property BCC : string read fBCC write fBCC;
     property ReplyTo : string read fReplyTo write fReplyTo;
-    property Attachments : TStringList read fAttachments write fAttachments;
+    property Attachments : TStringList read fAttachments write SetAttachments;
+    property AttachmentFiles : TObjectList<TAttachment> read fAttachmentFiles;
+    procedure AddAttachment(const aFilename : string; aStream : TStream); overload;
+    procedure AddAttachment(const aFilename, aFilePath : string); overload;
     procedure AddBodyFromFile(const cFileName : string);
   end;
 
@@ -107,20 +124,43 @@ begin
   fBCC := '';
   fBody := '';
   fAttachments := TStringList.Create;
+  fAttachmentFiles := TObjectList<TAttachment>.Create(True);
 end;
 
 destructor TMailMessage.Destroy;
 begin
   if Assigned(fAttachments) then fAttachments.Free;
+  if Assigned(fAttachmentFiles) then fAttachmentFiles.Free;
   inherited;
 end;
 
+procedure TMailMessage.AddAttachment(const aFilename, aFilePath : string);
+var
+  fs : TFileStream;
+begin
+  if not FileExists(aFilePath) then raise Exception.CreateFmt('MailMessage: file "%s" not found!',[aFilename]);
+  fs := TFileStream.Create(aFilePath,fmOpenRead);
+  fAttachmentFiles.Add(TAttachment.Create(aFilename,fs));
+end;
+
+procedure TMailMessage.AddAttachment(const aFilename : string; aStream : TStream);
+begin
+  fAttachmentFiles.Add(TAttachment.Create(aFilename,aStream));
+end;
+
 procedure TMailMessage.AddBodyFromFile(const cFileName: string);
 begin
   fBodyFromFile := True;
   fBody := cFileName;
 end;
 
+procedure TMailMessage.SetAttachments(const Value: TStringList);
+begin
+  if Assigned(fAttachments) then fAttachments.Free;
+
+  fAttachments := Value;
+end;
+
 procedure TMailMessage.SetBody(aValue: string);
 begin
   fBodyFromFile := False;
@@ -198,7 +238,8 @@ var
   email : string;
   filename : string;
   mBody : TIdText;
-  idattach : TIdAttachmentFile;
+  idattach : TIdAttachment;
+  attach : TAttachment;
 begin
   Result := False;
   SSLHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
@@ -234,6 +275,17 @@ begin
           idattach := TIdAttachmentFile.Create(msg.MessageParts,filename);
         end;
       end;
+      //add stream attachments if exists
+      if aMail.AttachmentFiles.Count > 0 then
+      begin
+        //mBody.ContentType := 'multipart/mixed';
+        //msg.ContentType := 'multipart/mixed';
+        for attach in aMail.AttachmentFiles do
+        begin
+          idattach := TIdAttachmentMemory.Create(msg.MessageParts,attach.Content);
+          idattach.Filename := attach.Filename;
+        end;
+      end;
 
       //configure smtp SSL
       try
@@ -278,4 +330,18 @@ begin
 end;
 
 
+{ TAttachment }
+
+constructor TAttachment.Create(const aFilename: string; const aContent: TStream);
+begin
+  fFilename := aFilename;
+  fContent := aContent;
+end;
+
+destructor TAttachment.Destroy;
+begin
+  if Assigned(fContent) then fContent.Free;
+  inherited;
+end;
+
 end.