Mega Code Archive
How to retrieve and use easily in your application all Email Account Definitions
<![CDATA[
Title: How to retrieve and use easily in your application all Email Account Definitions ?
Question: I've written this code today to help me in my Email List Manager Project. The most unit is published below and show you my EmailAccountManager Object. I've joined with this article, a sample project to show you how you could implement it in your code. I hope that it will be usefull.
The main restriction is my TcxEmailManager works only for the Microsoft Email Clients. I've tested this unit under Outlook Express, Outlook XP.
I would like to retrieve too, the email account definition for Netscape, Eudora, Opera... But what I've found today and after to install them on my computer is, these emails clients has stopped to store in the Windows Registry... So, to be continue...
Answer:
Usage:
in your unit form...
...
implementation
uses cxEmailAccountManager;
// How to load email accounts
// ------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
with EmailManager do
begin
CopyEmailListTo(ComboBox1.Items);
if Assigned(ActiveEmail) then
with ActiveEmail do
begin
ComboBox1.Text := GetFullDisplayName;
ComboBox1.ItemIndex := EmailID;
DisplayEmailAccount(EmailID);
end;
end;
end;
// How to use email account definition
// ------------------------------------------
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
DisplayEmailAccount(ComboBox1.ItemIndex);
end;
procedure TForm1.DisplayEmailAccount(AIndex: Integer);
begin
with Memo1 do
begin
Clear;
Lines.Add('Default Email Software : ' + GetEmailSoftwareStr );
Lines.Add('------------------------------------------------');
with EmailManager do
if (AIndex -1) and (AIndex with Items[AIndex] do
begin
if ActiveEmail.EmailID = EmailID then
Lines.Add('*** This is the default Email Account ***' + #13#10);
Lines.Add('EmailID := ' + IntToStr(EmailID));
Lines.Add('GetFullDisplayName := ' + GetFullDisplayName);
Lines.Add('AccountName := ' + AccountName);
Lines.Add('SMTPDisplayName := ' + SMTPDisplayName);
Lines.Add('SMTPEMail := ' + SMTPEMail);
Lines.Add('SMTPOrganization := ' + SMTPOrganization);
Lines.Add('SMTPReplyTo := ' + SMTPReplyTo);
Lines.Add('SMTPServer := ' + SMTPServer);
end;
end;
end;
//--------------------------------------------------------------
//--------------------------------------------------------------
unit cxEmailAccountManager;
interface
uses Classes;
type
TcxEmailSoftware = (esUnknown, esOutlookExpress, esOutlook98, esOutlook); // esNetscape, esEudora, esOpera, esHotmail
TcxEmailManager = class;
TcxEmailAccount = class
private
FOwner: TcxEmailManager;
FEmailID: Integer;
FAccountName: String;
FSMTPDisplayName: String;
FSMTPEMail: String;
FSMTPOrganization: String;
FSMTPReplyTo: String;
FSMTPServer: String;
public
constructor Create(AOwner: TcxEmailManager);
destructor Destroy; override;
function GetFullDisplayName: String;
property EmailID: Integer read FEmailID;
property AccountName: String read FAccountName ; // write SetAccountName;
property SMTPDisplayName: String read FSMTPDisplayName ; // write SetSMTPDisplayName;
property SMTPEMail: String read FSMTPEMail ; // write SetSMTPEMail;
property SMTPOrganization: String read FSMTPOrganization ; // write SetSMTPOrganization;
property SMTPReplyTo: String read FSMTPReplyTo ; // write SetSMTPReplyTo;
property SMTPServer: String read FSMTPServer ; // write SetSMTPServer;
end;
TcxEmailManager = class
private
FEmailSoftware: TcxEmailSoftware;
FEmailAccounts: TList;
FActiveEmail: TcxEmailAccount;
procedure Clear;
function GetCount: Integer;
function GetEmailSoftware: TcxEmailSoftware;
function GetItem(AIndex: Integer): TcxEmailAccount;
procedure Init;
procedure LoadEmailAccounts;
public
constructor Create;
destructor Destroy; override;
procedure CopyEmailListTo(AList: TStrings);
property ActiveEmail: TcxEmailAccount read FActiveEmail; // Return the Default Email account
property Count: Integer read GetCount; // Return the number of Email Account defined
property EmailSoftware: tcxEmailSoftware read FEmailSoftware; // Return the Default Email Software
property Items[Index: Integer]: TcxEmailAccount read GetItem; default;
end;
function EmailManager: TcxEmailManager;
implementation
uses Windows, SysUtils, Registry;
const
CREG_EMAIL_SOFTWARE = 'SOFTWARE\Clients\Mail';
CREG_OE = '\Software\Microsoft\Internet Account Manager';
CREG_OUTLOOK = '\Software\Microsoft\Office\Outlook\OMI Account Manager';
CREG_OUTLOOK98 = '\Software\Microsoft\Office\8.0\Outlook\OMI Account Manager';
CEMAIL_SIG_OE = 'Outlook Express';
CEMAIL_SIG_OUTLOOK = 'Microsoft Outlook';
//CEMAIL_SIG_NETSCAPE = 'Netscape';
//CEMAIL_SIG_EUDORA = 'Eudora';
//CEMAIL_SIG_OPERA = 'Opera';
//CEMAIL_SIG_HOTMAIL = 'Hotmail';
var
FEmailManager: TcxEmailManager = nil;
function EmailManager: TcxEmailManager;
begin
if FEmailManager = nil then
FEmailManager := TcxEmailManager.Create;
Result := FEmailManager;
end;
// -------------------------------------------------------------------------------------------------
// TcxEmailManager
// -------------------------------------------------------------------------------------------------
constructor TcxEmailManager.Create;
begin
FEmailAccounts := TList.Create;
Init;
end;
destructor TcxEmailManager.Destroy;
begin
Clear;
FEMailAccounts.Free;
inherited;
end;
procedure TcxEmailManager.Init;
begin
Clear;
FEmailSoftware := GetEmailSoftware;
LoadEmailAccounts;
end;
procedure TcxEmailManager.Clear;
begin
while FEmailAccounts.Count 0 do
TcxEmailAccount(FEmailAccounts.Last).Free;
end;
function TcxEmailManager.GetCount: Integer;
begin
Result := FEmailAccounts.Count;
end;
function TcxEmailManager.GetEmailSoftware: TcxEmailSoftware;
// Find the Default Email software signature
// -----------------------------------------
function GetESoftwareSig: String;
var
ARegistry: TRegistry;
begin
ARegistry := TRegistry.Create;
try
ARegistry.RootKey := HKEY_LOCAL_MACHINE;
if ARegistry.OpenKeyReadOnly(CREG_EMAIL_SOFTWARE) then
Result := ARegistry.ReadString('');
finally
ARegistry.Free;
end;
end;
// Find the right Microsoft Outlook version installed
// --------------------------------------------------
function GetMSOutlookVersion: TcxEmailSoftware;
var
ARegistry: TRegistry;
begin
ARegistry := TRegistry.Create;
try
ARegistry.RootKey := HKEY_CURRENT_USER;
if ARegistry.OpenKeyReadOnly(CREG_OUTLOOK98) then
Result := esOutlook98
else if ARegistry.OpenKeyReadOnly(CREG_OUTLOOK) then
Result := esOutlook
else
Result := esUnknown;
finally
ARegistry.Free;
end;
end;
var
sESoftwareSig: String;
begin
sESoftwareSig := GetESoftwareSig;
if sESoftwareSig = CEMAIL_SIG_OE then
Result := esOutlookExpress
else if sESoftwareSig = CEMAIL_SIG_OUTLOOK then
Result := GetMSOutlookVersion
else
Result := esUnknown;
end;
procedure TcxEmailManager.LoadEmailAccounts;
// Loading Email Accounts depending on MSOutlook version
// ------------------------------------------------------------------------
function GetEmailsFromMSReg(AMSEmailClient: TcxEmailSoftware): TcxEmailAccount;
const
CREG_SUBKEY = '\Accounts';
CKEY_DEFAULT_MAIL = 'Default Mail Account';
CKEY_ACCOUNT_NAME = 'Account Name';
CKEY_SMTP_DISPLAY_NAME = 'SMTP Display Name';
CKEY_SMTP_EMAIL_ADDRESS = 'SMTP Email Address';
CKEY_SMTP_ORGANIZATION_NAME = 'SMTP Organization Name';
CKEY_SMTP_REPLY_TO = 'SMTP Reply To Email Address';
CKEY_SMTP_SERVER = 'SMTP Server';
var
ARegistry: TRegistry;
AKeys: TStrings;
I: Integer;
sMSKey, sDefaultEMail: String;
ANewEmail: TcxEmailAccount;
begin
Result := nil;
// Initialize the right main registry key depending on MS Outlook version
// ----------------------------------------------------------------------
case AMSEmailClient of
esOutlookExpress: sMSKey := CREG_OE;
esOutlook98: sMSKey := CREG_OUTLOOK98;
esOutlook: sMSKey := CREG_OUTLOOK;
else
sMSKey := '';
end;
if sMSKey '' then
begin
ARegistry := TRegistry.Create;
AKeys := TStringList.Create;
try
ARegistry.RootKey := HKEY_CURRENT_USER;
// Remember the default email account
//-----------------------------------
if ARegistry.OpenKeyReadOnly(sMSKey) then
sDefaultEmail := ARegistry.ReadString(CKEY_DEFAULT_MAIL)
else
sDefaultEmail := '';
if ARegistry.OpenKeyReadOnly(sMSKey + CREG_SUBKEY) then
begin
ARegistry.GetKeyNames(AKeys);
for I := 0 to Pred(AKeys.Count) do
if ARegistry.OpenKeyReadOnly(sMSKey + CREG_SUBKEY + '\' + AKeys[I]) then
// Just take the email account definitions (not News, LDAP account...)
//---------------------------------------------------------------
if Length(ARegistry.ReadString(CKEY_SMTP_SERVER)) 0 then
begin
ANewEmail := TcxEmailAccount.Create(Self);
try
with ANewEmail do
begin
FEmailID := FEmailAccounts.Add(ANewEmail);
FAccountName := ARegistry.ReadString(CKEY_ACCOUNT_NAME);
FSMTPDisplayName := ARegistry.ReadString(CKEY_SMTP_DISPLAY_NAME);
FSMTPEMail := ARegistry.ReadString(CKEY_SMTP_EMAIL_ADDRESS);
FSMTPOrganization := ARegistry.ReadString(CKEY_SMTP_ORGANIZATION_NAME);
FSMTPReplyTo := ARegistry.ReadString(CKEY_SMTP_REPLY_TO);
FSMTPServer := ARegistry.ReadString(CKEY_SMTP_SERVER);
// Is it the default email account ?
//----------------------------------
if sDefaultEmail = AKeys[I] then
Result := ANewEmail;
end;
except
FreeAndNil(ANewEmail);
end;
end;
end;
finally
AKeys.Free;
ARegistry.Free;
end;
end;
end;
begin
if EmailSoftware in [esOutlookExpress, esOutlook98, esOutlook] then
FActiveEmail := GetEmailsFromMSReg(EmailSoftware)
else
FActiveEmail := TcxEmailAccount.Create(Self);;
end;
function TcxEmailManager.GetItem(AIndex: Integer): TcxEmailAccount;
begin
Result := TcxEmailAccount(FEmailAccounts[AIndex]);
end;
procedure TcxEmailManager.CopyEmailListTo(AList: TStrings);
var
I: Integer;
begin
with AList do
begin
Clear;
if Self.Count 0 then
for I := 0 to Pred(Self.Count) do
AddObject(Self.Items[I].GetFullDisplayName, Self.Items[I]);
end;
end;
// -------------------------------------------------------------------------------------------------
// TcxEmailAccount
// -------------------------------------------------------------------------------------------------
constructor TcxEmailAccount.Create(AOwner: TcxEmailManager);
begin
inherited Create;
FOwner := AOwner;
FEmailID := -1;
end;
destructor TcxEmailAccount.Destroy;
begin
// Auto delete in source list
// --------------------------
if (FEmailID -1) and (FOwner nil) then
FOwner.FEmailAccounts.Delete(FEmailID);
inherited;
end;
function TcxEmailAccount.GetFullDisplayName: String;
begin
if (AccountName SMTPDisplayName) and (Length(SMTPDisplayName) 0) then
Result := Format('%s (%s)', [AccountName, SMTPDisplayName])
else if Length(AccountName) 0 then
Result := AccountName
else if Length(SMTPDisplayName) 0 then
Result := SMTPDisplayName
else
Result := '';
end;
initialization
finalization
FEmailManager.Free;
FEmailManager := nil;
end.
]]>