📄 mail2000.pas
字号:
(*
Component name...................: Mail2000 (Mail2000.pas)
Classes implemented..............: TPOP2000, TSMTP2000, TMailMessage2000
Version..........................: 1.10.1
Status...........................: Beta
Last update......................: 2001-09-04
Author...........................: Marcello 'Panda' Tavares
Homepage.........................: http://groups.yahoo.com/group/tmail2000
Comments, bugs, suggestions to...: tmail2000@yahoogroups.com
Language.........................: English
Platform (tested)................: Windows 95/98/98SE/2000
Requires.........................: Borland Delphi 5 Professional or better
Features
--------
1. Retrieve and delete messages from POP3 servers;
2. Send messages through SMTP servers;
3. Parse MIME or UUCODE messages in header, body, alternative texts and
attachments;
4. Create or modify MIME messages on-the-fly;
5. HTML and embedded graphics support;
6. Save or retrieve messages or attachments from files or streams;
7. Ideal for automated e-mail processing.
Know limitations
----------------
1. Does not build UUCODE messages;
2. Some problems when running on Windows NT/2000/ME (worth a try);
3. Strange behaviours when netlink not present;
4. Some troubles when handling very big messages;
5. Some bugs and memory leaks.
How to install
--------------
Create a directory;
Extract archive contents on it;
Open Delphi;
Click File/Close All;
Click Component/Install Component;
In "Unit File Name" select mail2000.pas;
Click Ok;
Select Yes to rebuild package;
Wait for the message saying that the component is installed;
Click File/Close All;
Select Yes to save the package;
Now try to run the demo.
How to use
----------
The better way to learn is playing with the demo application.
I'm not planning to type a help file.
Fell free to mail your questions to me, expect aswer for 1-2 weeks.
See 'Discussion Group' section below.
Good luck!
License stuff
-------------
Mail2000 Copyleft 1999-2001
This software is provided as-is, without any express or implied
warranty. In no event will the author be held liable for any damages
arising from the use of this software.
As a freeware, the author reserve your rights to not provide support,
requested changes in the code, specific versions, improvements of any
kind and bug fixes. The main purpose is to help a little the programmers
community over the world as a whole, not just one person or organization.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented, you must not
claim that you wrote the original software. If you use this software
in a product, an acknowledgment in the product documentation would be
appreciated.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being an original software.
3. If you make changes to this software, you must send me the modified
integral version.
Please, consider my hard work.
Thanks to
---------
Mariano D. Podesta (marianopodesta@usa.net) - The author of wlPop3
component, from where I copied some decoding routines;
Sergio Kessler (sergio@perio.unlp.edu.ar) - The author of SakEmail
component, from where I based my encoding and smtp algorithms;
Delphi Super Page (http://delphi.icm.edu.pl) - For providing
the best way to find great programs and to join the Delphi community;
Yunarso Anang (yasx@hotmail.com) - For providing some functions for
correct threatment of oriental charsets;
Christian Bormann (chris@xynx.de) - For giving a lot of suggestions
and hard testing of this component;
Tommy Andersen (sorry, I lost his address) - For warning about some
bugs in code;
Kunikazu Okada (kunikazu@okada.cc) - For detailed and careful suggestions
to help mail composition;
Anderson (andermuller@conex.com.br) - Advices;
Rene de Jong (rmdejong@ism.nl) - Extensive bugfixes;
Hou Yg (yghou@yahoo.com) - Improvements;
Peter Baars (peter.baars@elburg.nl) - Bugfixes;
Giuseppe Mingolla (gmingolla@criptanet.it) - AttachStream method;
Milkopb (milkopb@yahoo.com) - Bugfixes;
David P. Schwartz (davids@desertigloo.com) - Suggestions and bugfixes;
John GBA (john@gbasolutions.co.uk) - Testing;
Anyone interested in helping me to improve this component, including you,
just by downloading it.
What's new in 1.1 version
-------------------------
1. Fixed the threatment of encoded fields in header;
2. Fixed some fake attachments found in message;
3. Included a string property "LastMessage" containing the source of
last message retrieved;
4. Now decoding file names;
5. Fixed way to identify kind of host address;
6. Added support for some tunnel proxy servers (eg via telnet port);
7. Socket changed to non-blocking to improve communication;
8. Fixed crashes when decoding encoded labels;
9. Fixed header decoding with ansi charsets;
10. Fixed crashes when there are deleted messages on server;
11. Now recognizing text/??? file attachments;
12. Added Content-ID label at attachment header, now you can reference
attached files on HTML code as <img src=cid:file.ext>;
13. Improved a lot the speed when decoding messages;
14. Thousands of minor bug fixes.
What's new in 1.2 version
-------------------------
1. Added HELO command when talking to SMTP server;
2. Changed CCO: fields (in portuguese) to BCC:
3. It doesn't remove BCC: field after SMTP send anymore;
4. Some random bugs fixed.
What's new in 1.3 version
-------------------------
1. POP and SMTP routines discontinued, but they will remain in the code;
2. Some suggestions added.
What's new in 1.4 version
-------------------------
1. Improved UUCODE decoding;
2. Range overflow bugs fixed;
3. Changed MailMessage to MailMessage2000 to avoid class name conflicts.
What's new in 1.5 version
-------------------------
1. I decided to improve POP and SMTP, but still aren't reliable;
2. Another sort of bug fixes;
3. TPOP2000.RetrieveHeader procedure added;
4. TPOP2000.DeleteAfterRetrieve property added;
5. Improved threatment of messages with no text parts;
6. Proxy support will remain, but has been discontinued;
7. TMailMessage2000.LoadFromFile procedure added;
8. TMailMessage2000.SaveToFile procedure added.
What's new in 1.6 version
-------------------------
1. Fixed expecting '+OK ' instead of '+OK' from SMTP;
2. Stopped using TClientSocket.ReceiveLength, which is innacurate.
What's new in 1.7 version
-------------------------
1. Handling of 'Received' (hop) headers. Now it is possible to trace the
path e-mail went on;
2. Again, bug fixes;
3. Added properties to read (and just to read) 'To:' information and 'Cc:'
information using TStringList;
4. Added procedures to set destinations in comma-delimited format;
5. Removed text/rtf handling.
What's new in 1.8 version
-------------------------
1. Guess what? Bug fixes;
2. Some memory leaks identified and fixed;
3. Improved SMTP processing;
4. Exception fixed in function 'Fill';
5. Added 'AttachStream' method.
What's new in 1.9 version
-------------------------
1. Improved date handling;
2. Improved 'Received' header handling;
3. Added 'Mime-Version' field;
4. Added 'Content-Length' field;
5. Fixed bug when there is comma on sender/recipient name;
6. Several compatibility improvements;
7. Several redundancies removed;
8. Added 'Embedded' option for attachments;
9. Improved mail bulding structure and algorithm;
10. Added 'FindParts' to identify texts and attachments of foreing messages;
11. Removed 'GetAttachList' (now obsolete);
12. Added 'Normalize' to reformat foreing messages on Mail2000 standards;
13. Changed 'SetTextPlain' and 'SetTextHTML' to work with String type;
14. Added 'LoadFromStream' and 'SaveToStream';
15. Added 'MessageSource' read/write String property;
16. Added 'GetUIDL' method to POP component;
17. Added 'DetachFile' method;
18. Added 'Abort' method to POP and SMTP components;
19. Better handling of recipient fields (TMailRecipients);
20. Added 'AttachString' method;
21. Added 'AddHop' method;
22. Added 'SendMessageTo' method to SMTP component;
23. Added 'SendStringTo' method to SMTP component;
24. POP and SMTP components hard-tested;
25. POP and SMTP doesn't require MailMessage to work anymore;
26. Removed proxy support (but still working with ordinary proxy redirection);
27. Fixed one dot line causing SMTP to truncate the message;
28. Long lines on header now being wrapped;
29. Added 'TextEncoding' published property;
30. SendMessage will abort on first recipient rejected;
31. Treatment of dates without seconds;
32. Fixed progress events behavior.
What's new in 1.10.x version
----------------------------
1. Now mail will be multipart only when needed;
2. Fixed empty attachments issues;
3. Fixed exceptions when handing text parts;
4. Fixed exceptions when message has empty body;
5. Now 'Normalize' is only needed when modifying a foreing message.
Author data
-----------
Marcello Roberto Tavares Pereira
mycelo@yahoo.com
http://mpanda.8m.com
ICQ 5831833
Sorocaba/SP - BRAZIL
Spoken languages: Portuguese, English, Spanish
Discussion Group
----------------
Please join TMail2000 group, exchange information about mailing
application development with another power programmers, and receive
suggestions, advices, bugfixes and updates about this component.
http://groups.yahoo.com/group/tmail2000
tmail2000-subscribe@yahoogroups.com
This site stores all previous messages, you can find valuable
information about this component there. If you have a question,
please search this site before asking me, I will not post the
same answer twice.
*)
unit Mail2000;
{Please don't remove the following line}
{$BOOLEVAL OFF}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
WinSock, ScktComp, Math, Registry, ExtCtrls;
type
TMailPartList = class;
TMailMessage2000 = class;
TSocketTalk = class;
TMessageSize = array of Integer;
TSessionState = (stNone, stConnect, stUser, stPass, stStat, stList, stRetr, stDele, stUIDL, stHelo, stMail, stRcpt, stData, stSendData, stQuit);
TTalkError = (teGeneral, teSend, teReceive, teConnect, teDisconnect, teAccept, teTimeout, teNoError);
TEncodingType = (etBase64, etQuotedPrintable, etNoEncoding, et7Bit);
TNormalizer = (nrFirst, nrForce, nrAddText, nrAddAttach, nrAddEmbedded);
TProgressEvent = procedure(Sender: TObject; Total, Current: Integer) of object;
TEndOfDataEvent = procedure(Sender: TObject; SessionState: TSessionState; Data: String; var ServerResult: Boolean) of object;
TSocketTalkErrorEvent = procedure(Sender: TObject; SessionState: TSessionState; TalkError: TTalkError) of object;
TReceiveDataEvent = procedure(Sender: TObject; Sessionstate: TSessionState; Data: String; var ServerResult: Boolean) of object;
TReceivedField = (reFrom, reBy, reFor, reDate, reNone);
TReceived = record
From: String;
By: String;
Address: String;
Date: TDateTime;
end;
{ TMailPart - A recursive class to handle parts, subparts, and the mail by itself }
TMailPart = class(TComponent)
private
FHeader: TStringList {TMailText};
FBody: TMemoryStream;
FDecoded: TMemoryStream;
FParentBoundary: String;
FOwnerMessage: TMailMessage2000;
FSubPartList: TMailPartList;
FOwnerPart: TMailPart;
FIsDecoded: Boolean;
FEmbedded: Boolean;
function GetAttachInfo: String;
function GetFileName: String;
function GetBoundary: String;
function GetSource: String;
procedure Fill(Data: PChar; HasHeader: Boolean);
procedure SetSource(Text: String);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetLabelValue(const cLabel: String): String; // Get the value of a label. e.g. Label: value
function GetLabelParamValue(const cLabel, Param: String): String; // Get the value of a label parameter. e.g. Label: xxx; param=value
function LabelExists(const cLabel: String): Boolean; // Determine if a label exists
function LabelParamExists(const cLabel, Param: String): Boolean; // Determine if a label parameter exists
function Decode: Boolean; // Decode Body stream into Decoded stream and result true if successful
procedure Encode(const ET: TEncodingType);
procedure EncodeText; // Encode Decoded stream into Body stream using quoted-printable
procedure EncodeBinary; // Encode Decoded stream into Body stream using Base64
procedure SetLabelValue(const cLabel, cValue: String); // Set the value of a label
procedure SetLabelParamValue(const cLabel, cParam, cValue: String); // Set the value of a label parameter
procedure Remove; // Delete this mailpart from message
procedure LoadFromFile(FileName: String); // Load the data from a file
procedure SaveToFile(FileName: String); // Save the data to a file
procedure LoadFromStream(Stream: TStream); // Load the data from a stream
procedure SaveToStream(Stream: TStream); // Save the data to a stream
property PartSource: String read GetSource write SetSource;
property Header: TStringList read FHeader; // The header text
property Body: TMemoryStream read FBody; // The original body
property Decoded: TMemoryStream read FDecoded; // Stream with the body decoded
property SubPartList: TMailPartList read FSubPartList; // List of subparts of this mail part
property FileName: String read GetFileName; // Name of file when this mail part is an attached file
property AttachInfo: String read GetAttachInfo; // E.g. application/octet-stream
property OwnerMessage: TMailMessage2000 read FOwnerMessage; // Main message that owns this mail part
property OwnerPart: TMailPart read FOwnerPart; // Father part of this part (can be the main message too)
property IsDecoded: Boolean read FIsDecoded; // If this part is decoded
property Embedded: Boolean read FEmbedded write FEmbedded; // E.g. if is a picture inside HTML text
end;
{ TMailPartList - Just a collection of TMailPart's }
TMailPartList = class(TList)
private
function Get(const Index: Integer): TMailPart;
public
destructor Destroy; override;
property Items[const Index: Integer]: TMailPart read Get; default;
end;
{ TMailRecipients - Handling of recipient fields }
TMailRecipients = class(TObject)
private
FMessage: TMailMessage2000;
FField: String;
FNames: TStringList;
FAddresses: TStringList;
FCheck: Integer;
function GetName(const Index: Integer): String;
function GetAddress(const Index: Integer): String;
function GetCount: Integer;
procedure SetName(const Index: Integer; const Name: String);
procedure SetAddress(const Index: Integer; const Address: String);
function FindName(const Name: String): Integer;
function FindAddress(const Address: String): Integer;
function GetAllNames: String;
function GetAllAddresses: String;
procedure HeaderToStrings;
procedure StringsToHeader;
public
constructor Create(MailMessage: TMailMessage2000; Field: String); //override;
destructor Destroy; override;
procedure Add(const Name, Address: String);
procedure Replace(const Index: Integer; const Name, Address: String);
procedure Delete(const Index: Integer);
procedure SetAll(const Names, Addresses: String);
procedure AddNamesTo(const Str: TStrings);
procedure AddAddressesTo(const Str: TStrings);
procedure Clear;
property Count: Integer read GetCount;
property Name[const Index: Integer]: String read GetName write SetName;
property Address[const Index: Integer]: String read GetAddress write SetAddress;
property ByName[const Name: String]: Integer read FindName;
property ByAddress[const Name: String]: Integer read FindAddress;
property AllNames: String read GetAllNames;
property AllAddresses: String read GetAllAddresses;
end;
{ TMailMessage2000 - A descendant of TMailPart with some tools to handle the mail }
TMailMessage2000 = class(TMailPart)
private
FAttachList: TMailPartList;
FTextPlain: TStringList;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -