Форум программистов [Powered by Invision Power Board]

Код

{
Эта функция отправляет пписьмо на указанный адрес электронной почты
Аргументы:
SmtpServer, SmtpPort - сервер, с которого отправляется сообщение, и его соответствующий порт
IsAuth - требует ли Smtp-сервер аутентификации перед отправкой сообщения
Следующие 4 пункта имеют смысл только если сервер требует аутентификации
1. POP3Server - сервер для аутентификации
2. POP3Port - соответствующий порт
3. POP3Login - логин на POP3-сервере
4. POP3Password - пароль на POP3 сервере
FromAddr - адрес отправителя, должен соответствовать адресу при аутентификации на сервере POP3, если такая требуется
ToAddr - адрес получателя, должен принадлежать Smtp-серверу, через который идёт соединение
MessageText - Текст сообщения. Не должен содержать последовательности #13#10.#13#10(#13 и #10 - символы перехода и конца строки
MemoLog - компонент TMemo, которыый будет выступать в качестве лога операций. Можно изменить процедуру mmLogPrint и вообще убрать этот аргумент
Пример использования
SendMail('smtp.mail.ru', 25, true, true, 'pop3.mail.ru', 110, 'user', 'password', 'user@mail.ru', 'addres@mail.ru', 'Testing Message', mmLog);
Когда функция вернёт true на ящик addres@mail.ru будет отправлено сообщение 'Test Message' от user@mail.ru
}
function SendMail(SmtpServer: string; SmtpPort: integer; IsAuth: boolean; POP3Server: string; POP3Port: integer; POP3Login: string; POP3Password: string; FromAddr: string; ToAddr: string; MessageText: string; MemoLog: TMemo):boolean;
  {Определение IP-адреса по доменному имени }
  function LookupName(name:String): TInAddr;
  var
    HostEnt: PHostEnt;
    InAddr: TInAddr;
  begin
    if name[4]='.' then
      InAddr.s_addr := inet_addr(PChar(name))
    else
    begin
      HostEnt := gethostbyname(PChar(name));
      FillChar(InAddr, SizeOf(InAddr), 0);
      if HostEnt <> nil then
      begin
        with InAddr, HostEnt^ do
        begin
          S_un_b.s_b1 := h_addr^[0];
          S_un_b.s_b2 := h_addr^[1];
          S_un_b.s_b3 := h_addr^[2];
          S_un_b.s_b4 := h_addr^[3];
        end;
      end
    end;
    Result := InAddr;
  end;
  {Печать в лог}
  procedure mmLogPrint(LogStr: string);
  begin
    MemoLog.Lines.Add(LogStr);
  end;
  {Чтение текста из сокета}
  function RecvText(S: TSocket): string;
  const
    MAX_BUFF_SIZE = 1024;
  var
    Recvbuff: array[0..MAX_BUFF_SIZE-1] of char;
    iRecv: integer;
    TempStr: string;
  begin
    Result := '';
    ZeroMemory(@Recvbuff, sizeof(RecvBuff));
    iRecv := recv(S, RecvBuff, MAX_BUFF_SIZE, 0);
    if (iRecv = 0) then
      exit
    else
      if (iRecv = Socket_Error) then
      begin
        mmLogPrint('Ошибка получения данных с сервера');
        exit;
      end
      else
      begin
        TempStr := RecvBuff;
        Result := Copy(TempStr, 1, Pos(#13, TempStr));
      end;
    If not (Result='') then
      mmLogPrint('RECV ' + Result)
    else
      mmLogPrint('Ничего не воcстановлено');
  end;
  {Запись текста в сокет или посылка текста серверу}
  function SendText(S: TSocket; Text: String): boolean;
  const
    MAX_SEND_SIZE = 1024;
  var
    SendBuff: array[0..MAX_SEND_SIZE] of char;
    iSend: integer;
    SendStr: string;
  begin
    Result := false;
    SendStr := Text + #13#10;
    If Length(SendStr)>MAX_SEND_SIZE then
    begin
      mmLogPrint('Слишком большая строка для отправки');
      exit;
    end;
    CopyMemory(@SendBuff, PChar(SendStr), Length(SendStr));
    iSend := send(S, SendBuff, Length(SendStr), 0);
    if (iSend = SOCKET_ERROR) then
    begin
      mmLogPrint('Ошибка передачи данных');
      exit;
    end;
    mmLogPrint('SEND ' + Text);
    Result := true;
  end;
  {Аутентификация на POP3-сервере }
  function POP3Auth(Server: string; Port: integer; Login, Pass: string): TSocket;
  var
    iSock: integer;
    saServerPop3: SockAddr_In;
    RecvPop3Text, SendPop3Text: string;
  begin
    Result := -1;
    mmLogPrint('Включена авторизация');
    Result := socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
    if Result = INVALID_SOCKET then
    begin
      mmLogPrint('Ошибка создания сокета');
      exit;
    end;
    mmLogPrint('Сокет создан');
    saServerPop3.sin_addr.s_addr := htonl(INADDR_ANY);
    saServerPop3.sin_family := AF_INET;
    saServerPop3.sin_port := htons(Port);
    saServerPop3.sin_addr := LookupName(Server);
    if (connect(Result, saServerPop3, sizeof(saServerPop3)) = SOCKET_ERROR) then
    begin
      mmLogPrint('Ошибка соединения с сервером POP3');
      Result := -1;
      exit;
    end;
    mmLogPrint('Соединение с сервером POP3 удачно');
    RecvPop3Text := RecvText(Result);
    If Pos('+OK', RecvPop3Text)=0 then
    begin
      CloseSocket(Result);
      Result := -1;
      exit;
    end;
    mmLogPrint('Принято приветствие от POP3 сервера');
    SendPop3Text := 'USER ' + Login;
    If not SendText(Result, SendPop3Text) then
    begin
      CloseSocket(Result);
      Result := -1;
      exit;
    end;
    RecvPop3Text := RecvText(Result);
    If Pos('+OK', RecvPop3Text)=0 then
    begin
      CloseSocket(Result);
      Result := -1;
      exit;
    end;
    SendPop3Text := 'PASS ' + Pass;
    If not SendText(Result, SendPop3Text) then
    begin
      CloseSocket(Result);
      Result := -1;
      exit;
    end;
    RecvPop3Text := RecvText(Result);
    If Pos('+OK', RecvPop3Text)=0 then
    begin
      CloseSocket(Result);
      Result := -1;
      exit;
    end;
    mmLogPrint('Авторизация на POP3 сервере успешно пройдена');
    {Вообщем-то всё написано в записи в логи к операциям, можно лишь пояснить, что результатом функции является сокет, по которому происходит
      взаимодействие с сервером POP3 при отработке функции сокет не закрывается, а остаётся рабочий и закрывается лишь после отправки письма}
  end;
  {Завершение работы с POP3 сервером}
  procedure POP3Quit(S: TSocket);
  var
    SendPop3Text: string;
  begin
    SendPop3Text := 'QUIT';
    If not SendText(S, SendPop3Text) then
    begin
      CloseSocket(S);
      exit;
    end;
    mmLogPrint('Работа с POP3 сервером завершена');
    CloseSocket(S);
  end;

var
  WData: WSADATA;
  sMailSocket, sPOP3Socket: TSocket;
  saServerMail: SockAddr_In;
  RecvMailText, SendMailText: string;
begin
  Result := false;
  if WSAStartup(MAKEWORD(1,1), WData) <> 0 then
    begin
   mmLogPrint('Ошибка при загрузке WinSock');
   exit;
    end;
  mmLogPrint('WinSock загружен');
  sMailSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
  if sMailSocket = INVALID_SOCKET then
  begin
    mmLogPrint('Ошибка создания сокета');
    exit;
  end;
  mmLogPrint('Сокет создан');
  saServerMail.sin_addr.s_addr := htonl(INADDR_ANY);
  saServerMail.sin_family := AF_INET;
  saServerMail.sin_port := htons(SmtpPort);
  saServerMail.sin_addr := LookupName(SmtpServer);
  if (connect(sMailSocket, saServerMail, sizeof(saServerMail)) = SOCKET_ERROR) then
  begin
   mmLogPrint('Ошибка соединения с сервером');
   exit;
  end;
  mmLogPrint('Соединение с сервером SMTP удачно');
  RecvMailText := RecvText(sMailSocket);
  If Pos('220', RecvMailText)=0 then
  begin
    CloseSocket(sMailSocket);
    exit;
  end;
  mmLogPrint('Приветствие получено');
  SendMailText := 'HELO vingrad.ru';
  If not SendText(sMailSocket, SendMailText) then
  begin
    CloseSocket(sMailSocket);
    exit;
  end;
  RecvMailText := RecvText(sMailSocket);
  If Pos('250', RecvMailText)=0 then
  begin
    CloseSocket(sMailSocket);
    exit;
  end;
  If IsAuth then
  begin
    sPOP3Socket := POP3Auth(POP3Server, POP3Port, POP3Login, POP3Password);
    if sPOP3Socket=-1 then
    begin
      CloseSocket(sMailSocket);
      exit;
    end;
  end;
  SendMailText := 'MAIL FROM:' + FromAddr;
  If not SendText(sMailSocket, SendMailText) then
  begin
    CloseSocket(sMailSocket);
    If IsAuth then
      CloseSocket(sPOP3Socket);
    exit;
  end;
  RecvMailText := RecvText(sMailSocket);
  If Pos('250', RecvMailText)=0 then
  begin
    CloseSocket(sMailSocket);
    If IsAuth then
      CloseSocket(sPOP3Socket);
    exit;
  end;
  SendMailText := 'RCPT TO:' + ToAddr;
  If not SendText(sMailSocket, SendMailText) then
  begin
    CloseSocket(sMailSocket);
    If IsAuth then
      CloseSocket(sPOP3Socket);
    exit;
  end;
  RecvMailText := RecvText(sMailSocket);
  If Pos('250', RecvMailText)=0 then
  begin
    CloseSocket(sMailSocket);
    If IsAuth then
      CloseSocket(sPOP3Socket);
    exit;
  end;
  SendMailText := 'DATA';
  If not SendText(sMailSocket, SendMailText) then
  begin
    CloseSocket(sMailSocket);
    If IsAuth then
      CloseSocket(sPOP3Socket);
    exit;
  end;
  RecvMailText := RecvText(sMailSocket);
  If Pos('354', RecvMailText)=0 then
  begin
    CloseSocket(sMailSocket);
    If IsAuth then
      CloseSocket(sPOP3Socket);
    exit;
  end;
  SendMailText := MessageText;
  If not SendText(sMailSocket, SendMailText) then
  begin
    CloseSocket(sMailSocket);
    If IsAuth then
      CloseSocket(sPOP3Socket);
    exit;
  end;
  SendMailText := #13#10 + '.';
  If not SendText(sMailSocket, SendMailText) then
  begin
    CloseSocket(sMailSocket);
    If IsAuth then
      CloseSocket(sPOP3Socket);
    exit;
  end;
  RecvMailText := RecvText(sMailSocket);
  If Pos('250', RecvMailText)=0 then
  begin
    CloseSocket(sMailSocket);
    If IsAuth then
      CloseSocket(sPOP3Socket);
    exit;
  end;
  SendMailText := 'QUIT';
  If not SendText(sMailSocket, SendMailText) then
  begin
    CloseSocket(sMailSocket);
    If IsAuth then
      CloseSocket(sPOP3Socket);
    exit;
  end;
  If Pos('221', RecvText(sMailSocket))=0 then
  begin
    CloseSocket(sMailSocket);
    If IsAuth then
      CloseSocket(sPOP3Socket);
    exit;
  end;
  mmLogPrint('Завершение работы с сервером');
  If IsAuth then
    POP3Quit(sPOP3Socket);
  CloseSocket(sMailSocket);
  Result := true;
end;