home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 November / Chip_2002-11_cd1.bin / zkuste / delphi / kompon / d567 / MMAILER.ZIP / mMailer.pas < prev    next >
Pascal/Delphi Source File  |  2002-08-29  |  7KB  |  225 lines
  1. {        
  2. ----------------------------------------------------------
  3. MAS-CompMaker was used to generate this code
  4. MAS-CompMaker, 2000-2002« Mats Asplund
  5. ----------------------------------------------------------
  6.  
  7. Component Name: TmMailer
  8.         Author: Mats Asplund
  9.       Creation: 2002-08-09
  10.        Version: 1.0
  11.    Description: A mailsender component
  12.         Credit: (place your credits here)
  13.         E-mail: masprod@telia.com
  14.           Site: http://go.to/mdp
  15.   Legal issues: All rights reserved 2002« by Mats Asplund
  16.  
  17. Usage:
  18.   This software is provided 'as-is', without any express or
  19.   implied warranty.  In no event will the author be held liable
  20.   for any  damages arising from the use of this software.
  21.  
  22.   Permission is granted to anyone to use this software for any
  23.   purpose, including commercial applications, and to alter it
  24.   and redistribute it freely, subject to the following
  25.   restrictions:
  26.  
  27.   1. The origin of this software must not be misrepresented,
  28.      you must not claim that you wrote the original software.
  29.      If you use this software in a product, an acknowledgment
  30.      in the product documentation would be appreciated but is
  31.      not required.
  32.  
  33.   2. Altered source versions must be plainly marked as such, and
  34.      must not be misrepresented as being the original software.
  35.  
  36.   3. This notice may not be removed or altered from any source
  37.      distribution.
  38.  
  39.   4. If you decide to use this software in any of your applications.
  40.      Send me an EMail and tell me about it.
  41.  
  42. Quick Reference:
  43.   TmMailer inherits from TComponent.
  44.  
  45.   Key-Properties:
  46.     Body: The Body-part of the EMAil-message.
  47.     Attachments
  48.       AtttachedFiles: Add the files you wan't to attache to this StringList,
  49.       FileName:       or just write filenames here.
  50.     Host: Your Internet provider.
  51.     UserId: Your UserId.
  52.     Password: Your Password.
  53.     Priority: Five levels of priority for the message.
  54.     From: The sender EMail-address.
  55.     Recipients: Add recipients to this list.
  56.     Subject: The messages subject.
  57.     HTML: If true the EMail is marked as HTML else as plain text.
  58.  
  59.   Key-Events:
  60.     OnSendError: Event fired if there is an exception while sending.
  61.  
  62.   Key-Methods:
  63.     Send: Sends the message.
  64.  
  65. --------------------------------------------------------------------------------
  66. }
  67. unit mMailer;
  68.  
  69. interface
  70.  
  71. uses
  72.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  73.   Forms, Dialogs, StdCtrls, ExtCtrls, IdBaseComponent, IdMessage, IdComponent,
  74.   IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP, IdEMailAddress;
  75.  
  76. type
  77.   TOnSendError = procedure(Sender: TObject; ErrorMsg: string) of object;
  78.  
  79.   TAttachement = class(TPersistent)
  80.   private
  81.     fFileName: TFileName;
  82.     fAttachedFiles: TStrings;
  83.     fOwner: TComponent;
  84.     procedure SetAttachedFiles(const Value: TStrings);
  85.     procedure SetFileName(const Value: TFileName);
  86.   public
  87.     constructor Create(Owner: TComponent);
  88.   published
  89.     property FileName: TFileName read fFileName write SetFileName;
  90.     property AttachedFiles: TStrings read fAttachedFiles write SetAttachedFiles;
  91.   end;
  92.  
  93.   TmMailer = class(TComponent)
  94.   private
  95.     fAbout: string;
  96.     fHost: string;
  97.     fUserId: string;
  98.     fFrom: TIdEMailAddressItem;
  99.     fRecipients: TIdEMailAddressList;
  100.     fBody: TStrings;
  101.     fSubject: string;
  102.     fMsg: TIdMessage;
  103.     fSMTP: TIdSMTP;
  104.     fPassword: string;
  105.     fHTML: Boolean;
  106.     fPriority: TIdMessagePriority;
  107.     fOnSendError: TOnSendError;
  108.     fAttachments: TAttachement;
  109.     procedure SetCop(Value: string);
  110.     procedure SetBody(const Value: TStrings);
  111.   public
  112.     constructor Create(AOwner: TComponent); override;
  113.     destructor Destroy; override;
  114.     procedure Send;
  115.   published
  116.     property Body: TStrings read fBody write SetBody;
  117.     property Attachments: TAttachement read fAttachments write fAttachments;
  118.     property Host: string read fHost write fHost;
  119.     property UserId: string read fUserId write fUserId;
  120.     property Password: string read fPassword write fPassword;
  121.     property Priority: TIdMessagePriority read fPriority write fPriority default
  122.       ID_MSG_PRIORITY;
  123.     property From: TIdEMailAddressItem read fFrom write fFrom;
  124.     property Recipients: TIdEMailAddressList read fRecipients write fRecipients;
  125.     property Subject: string read fSubject write fSubject;
  126.     property HTML: Boolean read fHTML write fHTML;
  127.     property OnSendError: TOnSendError read fOnSendError write fOnSendError;
  128.     property About: string read fAbout write SetCop;
  129.   end;
  130.  
  131. procedure Register;
  132.  
  133. implementation
  134.  
  135. procedure Register;
  136. begin
  137.   RegisterComponents('MAs Prod.', [TmMailer]);
  138. end;
  139.  
  140. constructor TmMailer.Create(AOwner: TComponent);
  141. begin
  142.   inherited Create(AOwner);
  143.   fAttachments:= TAttachement.Create(self);
  144.   fAttachments.fAttachedFiles:= TStringList.Create;
  145.   fBody:= TStringList.Create;
  146.   fRecipients:= TIdEMailAddressList.Create(Self);
  147.   fFrom:= TIdEMailAddressItem.Create(nil);
  148.   fMsg:= TIdMessage.Create(Self);
  149.   fSMTP:= TIdSMTP.Create(Self);
  150.   fHTML:= true;
  151.   fPriority:= mpNormal;
  152.   fAbout:= 'Version 1.0, 2002 « Mats Asplund, http://go.to/masdp';
  153. end;
  154.  
  155. destructor TmMailer.Destroy;
  156. begin
  157.   inherited Destroy;
  158. end;
  159.  
  160. procedure TmMailer.Send;
  161. var
  162.   n: integer;
  163. begin
  164.   try
  165.     for n:= 0 to fAttachments.AttachedFiles.Count -1 do
  166.       TIdAttachment.Create(fMsg.MessageParts, fAttachments.AttachedFiles[n]);
  167.     fMsg.SetBody(fBody);
  168.     fMsg.Recipients:= fRecipients;
  169.     fMsg.From:= fFrom;
  170.     fMsg.Subject:= fSubject;
  171.     if fHTML then
  172.       fMsg.ContentType:= 'text/HTML'
  173.     else
  174.       fMsg.ContentType:= 'text/plain';
  175.  
  176.     fSMTP.UserId:= fUserId;
  177.     fSMTP.Password:= fPassword;
  178.     fSMTP.Host:= fHost;
  179.     fSMTP.Connect;
  180.     fSMTP.Send(fMsg);
  181.     fSMTP.Disconnect;
  182.   except
  183.     on E: Exception do
  184.       if Assigned(fOnSendError) then
  185.         fOnSendError(Self, E.Message);
  186.   end;
  187. end;
  188.  
  189. procedure TmMailer.SetBody(const Value: TStrings);
  190. begin
  191.   fBody.Assign(Value);
  192. end;
  193.  
  194. procedure TmMailer.SetCop(Value: string);
  195. begin
  196.   Exit;
  197. end;
  198.  
  199. { TAttachement }
  200.  
  201. constructor TAttachement.Create(Owner: TComponent);
  202. begin
  203.   inherited Create;
  204.   fOwner:= Owner;
  205. end;
  206.  
  207. procedure TAttachement.SetAttachedFiles(const Value: TStrings);
  208. begin
  209.   fAttachedFiles.Assign(Value);
  210. end;
  211.  
  212. procedure TAttachement.SetFileName(const Value: TFileName);
  213. begin
  214.   fFileName:= Value;
  215.   if (fFileName <> '') and (fAttachedFiles.IndexOf(fFileName) = -1) then
  216.   begin
  217.     fAttachedFiles.Add(fFileName);
  218.     if csDesigning in fOwner.ComponentState then
  219.       Showmessage('Added: ' + fFileName + ' to AttachedFiles.');
  220.   end;
  221. end;
  222.  
  223. end.
  224.  
  225.