Самый простой способ автоматической настройки профиля почты в вашем приложении Delphi

Старенький пост из черновиков. Решил опубликовать, немного  обновив информацию, т.к. с момента выхода Delphi XE2 (когда начинал писать этот пост) времени прошло довольно много и часть информации устарела. На самом деле способов автоматической настройки профиля почты как в Delphi, так и где угодно не так уж и много и кратко я расскажу о них, а самый, на мой взгляд, простой — рассмотрю по-подробнее. Вполне возможно, что вы его реализуете в своих приложениях.

Практически каждый серьезный почтовый клиент имеет в своем составе полезную функцию автоматической настройки профиля почты. Эта функция очень сильно упрощает жизнь рядовым пользователям, которых в дрожь бросает от подсказок типа «Введите номер порта» или «Укажите сервер исходящей почты (SMTP)». С автоматической настройкой все гораздо проще — задал адрес почтового ящика, нажал одну кнопку и всё — все настройки определит программа. Другое дело, что автоматический поиск настроек может не дать результатов и придётся всё-таки пугать пользователя, но это уже другой момент.

Как это работает у других?

В самых общих чертах автоматический поиск настроек аккаунта почты у популярных почтовиков, типа ThunderBird, Outlook, The Bat и т.д. работает следующим образом:

1. Поиск настроек в файлах конфигурации на жестком диске. Довольно часто почтовики «таскают» с собой файлы с описанием настроек большинства популярных почтовых серверов. Например, тот же ThunderBird хранит настройки в файлах в директории tb-install-dir/isp/
2. Если настройки не найдены, то почтовый клиент начинает проверять MX-записи в DNS. Если записи найдены, то клиент пробует использовать их для настройки аккаунта, используя для этого два способа:
   1. «Вырезает» из записи типа «mx1.mail.hoster.com» домен «hoster.com» и снова ищет настройки в конфигурационных файлах как в п.1. или же использует открытые базы данных по настройкам почтовых аккаунтов в Сети.
   2. «Угадывает» номера портов SMTP, POP3, IMAP для хоста, найденного в DNS. Например, вместо pop3.mail.ru может выдаться mxs.mail.ru и такая настройка тоже будет работать.
3. Чистое «гадание»:
   1. Из адреса почты вырезается домен, например «example.com»
   2. Берутся самые распространенные названия почтовых серверов, например «mail.», «pop3.», «smtp.», «imap.» и т.д.
   3. Берутся возможные стандартные номера портов: 465, 995, 993, 25, 110, 143, 587, 585
   4. и начинается «гадание на кофейной гуще» — пробуем соединиться с mail.example.com по порту 465. Если соединились, то значит сервер использует для SMTP SSL, если не удалось соединиться, то берем следующий порт, снова пробуем соединиться и т.д. до тех пор пока не будут найдены настройки или же список адресов и портов не закончится.
4. Еще один способ автоматического поиска настроек почтового аккаунта — использование протокола AutoDiscover для Microsoft Exchange, но это отдельная тема отдельного поста про Microsoft’овские протоколы и их работу. В частности, этот способ активно использует Outlook.

Это в самых общих чертах о том, как почтовыми клиентами ищутся настройки почтовых аккаунтов. Естественно, что каждый почтовый клиент имеет свои какие-то фичи в этом вопросе, но общий алгоритм у всех один — сначала пробуем найти настройки «культурно» через DNS, файлы конфигурации и т.д. и только после этого начинаем угадывать, перебирать варианты хостов и т.д.

Если вам не требуется реализовывать в своем приложении Delphi навороченные алгоритмы автоматического поиска настроек почты, то самым простым и лёгким в исполнении способом будет, конечно же либо использование своих файлов конфигурации, или же, не на много сложнее — использование открытых баз данных по настройкам для различных серверов. И именно о такой базе и работе с ней пойдёт речь далее.

Использование ISPDB в Delphi

Что такое ISPDB?

ISPDB — это центральная база данных, которая в настоящий момент принадлежит Mozilla Messaging, но может быть использована любым клиентом. Эта база содержит настройки самых популярных (и не очень) почтовых серверов. Настройки каждого сервера находятся в отдельном xml-файле, что позволяет довольно быстро получать необходимую информацию из БД с минимальными затратами интернет-трафика.

ISPBD расположена по адресу: https://autoconfig.thunderbird.net/v1.1/

Чтобы воспользоваться ISPDB нам достаточно выполнить такие простые шаги:

1. подставить в URL базы имя домена, например, так https://autoconfig.thunderbird.net/v1.1/example.com
2. отправить GET-запрос на полученный URL (для этого можно воспользоваться, например, Indy или Synapse)
3. если в ответ получили код 404, то поиск в базе результатов не дал. Если же код ответа 200, то в теле ответа будет содержаться простой XML-файл, содержащий все настройки сервера. Например, для mail.ru этот файл выглядит вот так. Всё, что нам нужно — это правильно распарсить этот XML и выдать полученные настройки пользователю.

Реализуем этот простой алгоритм в Delphi. Во избежания всяческих недоразумений, касаемо компиляции исходного кода, представленного ниже в статье, обращу ваше внимание на следующие моменты:

Выглядеть наше приложение будет вот так:

Работать оно будет следующим образом:

1. Пользователь задает адрес почты и жмет «Найти настройки»
2. Программа отправляет запрос в ISPDB
3. Если код ответа будет 200, то программа разбирает полученный ответ и сохраняет настройки почты в своем списке
4. Если код ответа равен 404, то программа запрашивает MX-записи для домена
5. Если MX-записи получены, то берется первая из них и определяется домен так же, как это делает тот же ThunderBird, т.е. из адреса mx1.anyhost.example.com вырезаем только example.com
6. Для полученного в п.5 домена пробуем повторить операцию запроса, т.е. повторяем п.п. 2 и 3.
7. Если и после этого настройки не будут найдены, то считаем, что в ISPDB нет необходимых настроек.

О том как разобрать XML-файл любой сложности в Delphi я рассказывать здесь уже не буду, так как примеров в блоге более, чем достаточно. Скажу только, что для разбора XML я буду использовать только то, что есть в самой Delphi «из коробки».  Для хранения в программе настроек почтового сервера я буду использовать следующий класс:

TServerType = (stIMAP, stPOP, stSMTP);
TSocketType = (sSSL, sSTARTTLS, sPlain);
TUserName = (unAddress, unLocalPart, unDomain);
TPassType = (ptClearText, ptCRAMMD5, ptOther);
 
TServerOptions = class
  private
    FServerType: TServerType;
    FSocketType: TSocketType;
    FPort: cardinal;
    FHostName: string;
    FUserName: TUserName;
    FAuthentication: TPassType;
  public
    constructor Create(AServerType: TServerType; ASocketType: TSocketType;
      APort: cardinal; AHostName: string; AUserName: TUserName;
      AAuthentication: TPassType);
    destructor Destroy; override;
    property ServerType: TServerType read FServerType;
    property SocketType: TSocketType read FSocketType;
    property Port: cardinal read FPort;
    property HostName: string read FHostName;
    property UserName: TUserName read FUserName;
    property Authentication: TPassType read FAuthentication;
  end;

Все поля класса соответствуют узлам XML-документа о содержимом которого Вы можете почитать вот на этой странице wiki ThunderBird. На этой страничке расписан формат конфигурационного файла, но он на 100% соответствует содержимому в ISPDB.

Класс для работы с ISPDB будет выглядеть следующим образом:

uses Classes, SysUtils, Generics.Collections, httpsend, dnssend, ssl_openssl, Xml.XMLDoc, Xml.XMLIntf;
 
TISPDB = class
  private
    FServers: TObjectList;
    function GET(const URL: string; AResponse: TStringStream): integer;
    function MX(const AEmail: string; AResponse: TStringList):boolean;
    procedure Parse(AXMLResponse: TStringStream);
  public
    constructor Create;
    destructor Destroy; override;
    function GetDomain(const AEmail: string): string;
    function FindOptions(const AEmail: string): boolean;
    function FindServer(AServerType: TServerType; ASocketType: TSocketType):TServerOptions;
    property Servers: TObjectList read FServers;
  end;

Функция GET отправляет HTTP-запрос в базу и получает в результат код ответа сервера:

function TISPDB.GET(const URL: string; AResponse: TStringStream): integer;
var
  HTTP: THTTPSend;
begin
  HTTP := THTTPSend.Create;
  try
    if HTTP.HTTPMethod('GET', URL) then
      AResponse.LoadFromStream(HTTP.Document);
    Result := HTTP.ResultCode;
  finally
    HTTP.Free;
  end;
end;

Функция MX получает MX-записи из DNS:

const
  cDefaultDNS = '8.8.8.8';
 
function TISPDB.MX(const AEmail: string; AResponse: TStringList): boolean;
begin
  Result:=GetMailServers(cDefaultDNS,GetDomain(AEmail),AResponse);
end;

Процедура Parse разбирает XML-документ и помещает сведения о настройках серверов в список:

procedure TISPDB.Parse(AXMLResponse: TStringStream);
const
  cServerNodes: array [0 .. 4] of string = ('hostname', 'port', 'socketType',
    'username', 'authentication');
var
  XMLDoc: IXMLDocument;
  Node, ServerNode: IXMLNode;
  ServerStr: string;
  ServerType: TServerType;
  SocketType: TSocketType;
  Port: cardinal;
  HostName: string;
  UserName: TUserName;
  Authentication: TPassType;
begin
  if not Assigned(AXMLResponse) then
    raise Exception.Create(rsEmptyXML);
 
  XMLDoc := TXMLDocument.Create(nil);
  try
    XMLDoc.LoadFromStream(AXMLResponse);
    Node := XMLDoc.DocumentElement.ChildNodes.FindNode('emailProvider');
    if Assigned(Node) then
      Node := Node.ChildNodes.First;
    while Assigned(Node) do
    begin
      if SameText(Node.NodeName, 'incomingServer') or
        SameText(Node.NodeName, 'outgoingServer') then
      begin
        ServerStr := Node.Attributes['type'];
        // определяем тип сервера
        if SameText(ServerStr, 'imap') then
          ServerType := TServerType.stIMAP
        else if SameText(ServerStr, 'pop3') then
          ServerType := TServerType.stPOP
        else
          ServerType := TServerType.stSMTP;
        // читаем настройки сервера
        ServerNode := Node.ChildNodes.First;
        while Assigned(ServerNode) do
        begin
          case AnsiIndexStr(ServerNode.NodeName, cServerNodes) of
            0: HostName := ServerNode.Text; // hostname
            1: Port := StrToInt(ServerNode.Text); // port
            2: begin // socketType
                if SameText(ServerNode.Text, 'SSL') then
                  SocketType := TSocketType.sSSL
                else if SameText(ServerNode.Text, 'STARTTLS') then
                  SocketType := TSocketType.sSTARTTLS
                else
                  SocketType := TSocketType.sPlain;
              end;
            3:begin // username
                if SameText(ServerNode.Text, '%EMAILADDRESS%') then
                  UserName := unAddress
                else
                  UserName := unLocalPart;
              end;
            4:begin // authentication
                if SameText(ServerNode.Text, 'password-cleartext') then
                  Authentication:=ptClearText
                else
                  if SameText(ServerNode.Text, 'password-encrypted') then
                    Authentication:=ptCRAMMD5
                  else
                    Authentication:=ptOther;
              end;
          end;
          ServerNode := ServerNode.NextSibling;
        end;
        FServers.Add(TServerOptions.Create(ServerType,SocketType,Port,HostName,UserName,Authentication));
      end;
      Node := Node.NextSibling;
    end;
  finally
    XMLDoc := nil;
  end;
end;

Основным методом класса является функция FindOptions, которая работает так как было описано выше в алгоритме, т.е. вначале пробуем получить настройки из ISPDB по домену из адреса почты, а затем — из MX-записи:

function TISPDB.FindOptions(const AEmail: string): boolean;
var AStream: TStringStream;
    AMX: TStringList;
    HTTPResult: integer;
    Str: TStringDynArray;
    Domain: string;
begin
  FServers.Clear;
 
  Domain:=GetDomain(AEmail);
  if Domain.IsEmpty then
    raise Exception.Create(rsWrongEmailAddress);
 
  AStream:=TStringStream.Create;
  try
    HTTPResult:=GET(cBaseURL+Domain,AStream);
    Result:=HTTPResult=200;
    if Result then
      Parse(AStream)
    else
      begin
        AMX:=TStringList.Create;
        try
          if MX(AEmail, AMX) then
            begin
              Str:=SplitString(AMX[0],'.');
              AStream.Clear;
              HTTPResult:=GET(cBaseURL+LowerCase(Str[High(Str)-1]+'.'+Str[High(Str)]),AStream);
              Result:=HTTPResult=200;
              if Result then
                Parse(AStream)
            end;
        finally
          AMX.Free;
        end;
       end;
  finally
    AStream.Free
  end;
end;

Это ключевые методы класса, которые Вы, как я уже написал выше, можете переделывать как угодно под использование собственных библиотек для работы с XML и сетевыми протоколами.
Теперь, чтобы воспользоваться разработанным классом, достаточно выполнить всего несколько действий:

procedure TForm1.FormCreate(Sender: TObject);
begin
 ISPDB:=TISPDB.Create;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  ISPDB.Free;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  if ISPDB.FindOptions(edMail.Text) then
    begin
      StatusBar1.Panels[1].Text:=ISPDB.Servers.Count.ToString;
      ShowMessage('Найдены настройки почтового аккаунта'#13#10'Выберите желаемый протокол и тип соединения в списках ниже');
    end
  else
    begin
      StatusBar1.Panels[1].Text:='0';
      ShowMessage('Настроек почтового аккаунта не найдено в ISPDB');
    end;
end;

Результат работы приложения на скрине ниже:

Книжная полка

	Автор: Дмитрий Осипов Название: Delphi. Программирование для Windows, OS X, iOS и Android Описание Подробно рассматривается библиотека FM, позволяющая создавать полнофункциональное программное обеспечение для операционных систем Windows и OS X, а также для смартфонов и планшетных компьютеров, работающих под управлением Android и iOS
	Автор: Андрей Шкрыль Название: Разработка клиент-серверных приложений в Delphi Описание: Рассмотрены практические вопросы по разработке клиент-серверных приложений в среде Delphi 7 и Delphi 2005 с использованием СУБД MS SQL Server 2000, InterBase и Firebird. Приведена информация о теории построения реляционных баз данных и языке SQL. Освещены вопросы эксплуатации и администрирования СУБД.
	Автор: Антон Григорьев Название: О чем не пишут в книгах по Delphi Описание: Рассмотрены малоосвещенные вопросы программирования в Delphi. Описаны методы интеграции VCL и API. Показаны внутренние механизмы VCL и приведены примеры вмешательства в эти механизмы. Рассмотрено использование сокетов в Delphi: различные режимы их работы, особенности для протоколов TCP и UDP и др.