Это вполне возможно. Что вам нужно, это автоматизация Outlook. Либо простой ванильный, либо тот, который использует обертки COM-сервера, которые поставляются с Delphi. Если вы используете одну из более новых версий Delphi, вам может потребоваться установить соответствующий пакет, чтобы найти их в палитре. См. Как получить TExcelWorksheet (64-разрядная версия) в XE2? для получения дополнительной информации.
Для получения дополнительной информации о том, как можно автоматизировать Outlook, перейдите непосредственно к источнику: MSDN для документации по объектной модели и API COM COM: http://msdn.microsoft.com/en-us/library/ms268893(v=vs.80).aspx
Другим источником является сайт Деборы Пейт о программировании COM. Возможно, он не обновлялся долгое время, но информация там все еще хороша и актуальна: http://www.djpate.freeserve.co.uk/Automation.htm
Пример кода
Блок содержит два класса для чтения писем в определенной папке. Он использует оболочку Outlook COM-сервера формы Delphi (очень старая версия), но вам не нужно иметь их на палитре, так как они создаются в коде. Разумеется, вам нужно иметь в своем поисковом модуле обертки COM.
Создание экземпляра класса TSiteMailList следующим образом:
FMailList := TSiteMailList.Create('MAPI', 'Folder1', 'Folder2');
MAPI - это пространство имен Outlook MAPI. Folder1 и Folder2 - это имена почтовых папок Outlook. «Входящие» могут использоваться здесь для почтового ящика по умолчанию.
Объявление класса TSiteMailList:
TSiteMailList = class(TObject)
private
FShowUnreadOnly: boolean;
FMails: TObjectList;
FOutlook: TOutlookApplication;
FNameSpace: NameSpace;
FNewMailsFolder: MAPIFolder;
FProcessedMailsFolder: MAPIFolder;
function FindFolder(FolderPath: string): MAPIFolder;
procedure LoadMails;
function GetSiteMail(idx: integer): TSiteMail;
function GetShowUnreadOnly: boolean;
procedure SetShowUnreadOnly(const Value: boolean);
protected
function GetCount: integer;
public
constructor Create(MAPINameSpace: string; NewMailsFolder, ProcessedMailsFolder:
string);
destructor Destroy; override;
procedure MarkAsProcessed(SiteMail: TSiteMail);
procedure Reload;
property ShowUnreadOnly: boolean read GetShowUnreadOnly write SetShowUnreadOnly;
property Count: integer read GetCount;
property SiteMail[idx: integer]: TSiteMail read GetSiteMail;
end;
Его конструктор и деструктор:
constructor TSiteMailList.Create(MAPINameSpace: string; NewMailsFolder,
ProcessedMailsFolder: string);
begin
FOutlook := TOutlookApplication.Create( nil );
FOutlook.ConnectKind := ckNewInstance;
FOutlook.Connect;
FNameSpace := FOutlook.GetNameSpace( MAPINameSpace );
FNameSpace.Logon( '', '', False, False );
FNewMailsFolder := FindFolder( NewMailsFolder );
FProcessedMailsFolder := FindFolder( ProcessedMailsFolder );
FShowUnreadOnly := false;
FMails := TObjectList.Create( true );
LoadMails;
end;
destructor TSiteMailList.Destroy;
begin
FMails.Free;
if FNameSpace <> nil then begin
FNameSpace.Logoff;
end;
FOutlook.Disconnect;
FOutlook.Free;
inherited;
end;
Папка Outlook может быть вложенной. Имена папок, передаваемые в конструктор, могут использовать «\» для разделения имен папок. Приведенный ниже код анализирует путь и находит соответствующую папку Outlook:
procedure ExtractFolderFromPath(var path, folder: string);
var
i: integer;
begin
folder := '';
if path[1] = '\' then begin
path := Copy( path, 2, Length( path ) - 1 );
end;
i := Pos( '\', path );
if i > 0 then begin
folder := Copy( path, 1, i - 1 );
path := Copy( path, i + 1, Length( path ) - i );
end else begin
folder := path;
path := '';
end;
end;
function TSiteMailList.FindFolder(FolderPath: string): MAPIFolder;
var
path: string;
foldername: string;
xFolder: MAPIFolder;
begin
path := FolderPath;
ExtractFolderFromPath( path, foldername );
if foldername <> '' then begin
xFolder := FNameSpace.Folders.Item( foldername );
end;
while path <> '' do begin
ExtractFolderFromPath( path, foldername );
xFolder := xFolder.Folders.Item( foldername );
end;
Result := xFolder;
end;
Геттеры и сеттеры довольно прямолинейны, поэтому я их пропустил. Метод LoadMails необходим вам для доступа к каждому элементу почты в папке:
procedure TSiteMailList.LoadMails;
var
i: integer;
GeneralItem: IDispatch;
MI: MailItem;
begin
FMails.Clear;
for i := 1 to FNewMailsFolder.Items.Count do begin
GeneralItem := FNewMailsFolder.Items.Item( i );
if Sysutils.Supports(GeneralItem, MailItem, MI) then begin
if not FShowUnreadOnly
or ( FShowUnreadOnly and ( MI.Unread = true ) )
then begin
FMails.Add( TSiteMail.Create( i, MI ) );
end;
end;
end;
end;
TSiteMailList использует класс TSiteMail для отслеживания информации о почтовых элементах Outlook в папке, указанной первым параметром папки его конструктора. Объявление класса TSiteMail:
TSiteMail = class(TObject)
private
FOutlookIdx: integer;
FMailItem: MailItem;
function GetIsRead: boolean;
procedure SetIsRead(const Value: boolean);
protected
function GetBody: string;
function GetFileCount: integer;
function GetFileName(idx: integer): string;
function GetReceived: TDateTime;
function GetSender: string;
function GetSubject: string;
public
constructor Create(idx: integer; MI: MailItem);
destructor Destroy; override;
function IndexOfFileName(Name: string): integer;
procedure MoveToFolder(Folder: MAPIFolder);
procedure SaveFile(idx: integer; FileName: string);
property Body: string read GetBody;
property FileCount: integer read GetFileCount;
property FileName[idx: integer]: string read GetFileName;
property IsRead: boolean read GetIsRead write SetIsRead;
property Received: TDateTime read GetReceived;
property Sender: string read GetSender;
property Subject: string read GetSubject;
end;
И его реализация:
constructor TSiteMail.Create(idx: integer; MI: MailItem);
begin
FOutlookIdx := idx;
FMailItem := MI;
end;
destructor TSiteMail.Destroy;
begin
FMailItem := nil; // Release interface
inherited;
end;
function TSiteMail.GetBody: string;
begin
Result := FMailItem.Body;
end;
function TSiteMail.GetFileCount: integer;
begin
Result := FMailItem.Attachments.Count;
end;
function TSiteMail.GetFileName(idx: integer): string;
begin
Result := FMailItem.Attachments.Item( idx + 1 ).FileName;
end;
function TSiteMail.GetIsRead: boolean;
begin
Result := not FMailItem.UnRead;
end;
function TSiteMail.GetReceived: TDateTime;
begin
Result := FMailItem.ReceivedTime;
end;
function TSiteMail.GetSender: string;
begin
Result := FMailItem.SenderName;
end;
function TSiteMail.GetSubject: string;
begin
Result := FMailItem.Subject;
end;
function TSiteMail.IndexOfFileName(Name: string): integer;
var
idx: integer;
begin
Result := -1;
for idx := 1 to FMailItem.Attachments.Count do begin
if CompareText( Name, FMailItem.Attachments.Item( idx ).FileName ) = 0 then begin
Result := idx - 1;
break;
end;
end;
end;
procedure TSiteMail.MoveToFolder(Folder: MAPIFolder);
begin
FMailItem.Move( Folder );
end;
procedure TSiteMail.SaveFile(idx: integer; FileName: string);
begin
FMailItem.Attachments.Item( idx + 1 ).SaveAsFile( FileName );
end;
procedure TSiteMail.SetIsRead(const Value: boolean);
begin
FMailItem.UnRead := not Value;
end;