function SendMail(SmtpServer:string;SmtpPort:integer;IsAuth:boolean;
POP3Server:string;POP3Port:integer;POP3Login:string;POP3Password:string;
FromAddr:string;ToAddr:string;MessageText:string):boolean;
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;

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 exit
else begin
TempStr:=RecvBuff;
Result:=Copy(TempStr,1,Pos(#13,TempStr));
end;
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 exit;
CopyMemory(@SendBuff,PChar(SendStr),Length(SendStr));
iSend:=send(S,SendBuff,Length(SendStr),0);
if iSend=SOCKET_ERROR then exit;
Result:=true;
end;

function POP3Auth(Server:string;Port:integer;Login,Pass:string):TSocket;
var
saServerPop3:SockAddr_In;
RecvPop3Text,SendPop3Text:string;
begin
Result:=socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
if Result=INVALID_SOCKET then exit;
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
Result:=-1;
exit;
end;
RecvPop3Text:=RecvText(Result);
if Pos('+OK',RecvPop3Text)=0 then begin
CloseSocket(Result);
Result:=-1;
exit;
end;
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;
end;

procedure POP3Quit(S:TSocket);
begin
if not SendText(S,'QUIT') then begin
CloseSocket(S);
exit;
end;
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 exit;
sMailSocket:=socket(PF_INET,SOCK_STREAM,IPPROTO_IP);
if sMailSocket=INVALID_SOCKET then exit;
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 exit;
RecvMailText:=RecvText(sMailSocket);
if Pos('220',RecvMailText)=0 then begin
CloseSocket(sMailSocket);
exit;
end;
SendMailText:='HELO antichat.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;
if IsAuth then POP3Quit(sPOP3Socket);
CloseSocket(sMailSocket);
Result:=true;
end;

begin
SendMail('smtp.mail.ru',25,false,'',110,'','','FROM@mail.ru','TO@mail.ru','Text here');
end.

function Rus(mes: string):string;
var
i: integer;
begin
for i:=1 to length(mes) do
case mes[i] of
  'А'..'п' : mes[i] := Chr(Ord(mes[i]) - 64);
  'р'..'я' : mes[i] := Chr(Ord(mes[i]) - 16);
end;
rus := mes;
end;

function SendMail(Smtp: PChar; Port: dword; From, Dest, Data: PChar): boolean;
var
FSocket:Integer;
HostEnt: PHostEnt;
SockAddrIn: TSockAddrIn;
dBuff: PChar;
dSize: dword;
Str: array [0..255] of Char;
(**************************************************************************)
function Success(): boolean;
var
  Bytes: dword;
  RBuff: array [0..255] of Char;
begin
  Result := false;
  Bytes := recv(FSocket, RBuff, 255, 0);
  if (Bytes = 0) or (Bytes = SOCKET_ERROR) then Exit;
  Write(Rus('[вход. сообщ.] '),RBuff);
  RBuff[3] := #0;
  if RBuff='221' then
  WriteLn(Rus('[вход. сообщ.] Ответ о состоянии системы или помощь')+#10)else
  if RBuff='214' then
  WriteLn(Rus('[вход. сообщ.] Сообщение-подсказка (помощь)')+#10)else
  if RBuff='220' then
  WriteLn(Rus('[вход. сообщ.] '),SMTP,Rus(' служба готова к работе')+#10)else
  if RBuff='221' then
  WriteLn(Rus('[вход. сообщ.] '),SMTP,Rus(' служба закрывает канал связи')+#10)else
  if RBuff='250' then
  WriteLn(Rus('[вход. сообщ.] Запрошенное действие почтовой транзакции успешно завершилось')+#10)else
  if RBuff='251' then
  WriteLn(Rus('[вход. сообщ.] Данный адресат не является местным; сообщение будет передано по маршруту <forward-path>')+#10)else
  if RBuff='354' then
  WriteLn(Rus('[вход. сообщ.] Начинай передачу сообщения. Сообщение заканчивается комбинацией CRLF-точка-CRLF')+#10)else
  if RBuff='421' then
  WriteLn(Rus('[вход. сообщ.] '),SMTP,Rus(' служба недоступна; соединение закрывается')+#10)else
  if RBuff='450' then
  WriteLn(Rus('[вход. сообщ.] Запрошенная команда почтовой транзакции не выполнена, так как почтовый ящик недоступен')+#10)else
  if RBuff='451' then
  WriteLn(Rus('[вход. сообщ.] Запрошенная команда не выполнена; произошла локальная ошибка при обработке сообщения')+#10)else
  if RBuff='452' then
  WriteLn(Rus('[вход. сообщ.] Запрошенная команда не выполнена; системе не хватило ресурсов')+#10)else
  if RBuff='500' then
  WriteLn(Rus('[вход. сообщ.] Синтаксическая ошибка в тексте команды; команда не опознана')+#10)else
  if RBuff='501' then
  WriteLn(Rus('[вход. сообщ.] Синтаксическая ошибка в аргументах или параметрах команды')+#10)else
  if RBuff='502' then
  WriteLn(Rus('[вход. сообщ.] Данная команда не реализована')+#10)else
  if RBuff='503' then
  WriteLn(Rus('[вход. сообщ.] Неверная последовательность команд')+#10)else
  if RBuff='504' then
  WriteLn(Rus('[вход. сообщ.] У данной команды не может быть аргументов')+#10)else
  if RBuff='551' then
  WriteLn(Rus('[вход. сообщ.] Данный адресат не является местным; попробуйте передать сообщение по маршруту <forward-path>')+#10)else
  if RBuff='552' then
  WriteLn(Rus('[вход. сообщ.] Запрошенная команда почтовой транзакции прервана; дисковое пространство, доступное системе, переполнилось')+#10)else
  if RBuff='553' then
  WriteLn(Rus('[вход. сообщ.] Запрошенная команда не выполнена; указано недопустимое имя почтового ящика')+#10)else
  if RBuff='554' then
  WriteLn(Rus('[вход. сообщ.] Транзакция не выполнена')+#10)else
  WriteLn(Rus('[вход. сообщ.] '),RBuff,Rus(': Неопознанный код команды с SMTP сервера')+#10);
  if lstrcmp(RBuff, '220') = 0 then Result := true else
  if lstrcmp(RBuff, '250') = 0 then Result := true else
  if lstrcmp(RBuff, '354') = 0 then Result := true;
end;
(**************************************************************************)

begin
Result := false;
FSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
SockAddrIn.sin_family := AF_INET;
SockAddrIn.sin_port := htons(Port);
SockAddrIn.sin_addr.s_addr := inet_addr(Smtp);
if SockAddrIn.sin_addr.s_addr = INADDR_NONE then
begin
  HostEnt := gethostbyname(Smtp);
  if HostEnt = nil then
  begin
    closesocket(FSocket);
    Exit;
  end;
SockAddrIn.sin_addr.s_addr := PLongint(HostEnt^.h_addr_list^)^;
end;
if Connect(FSocket, SockAddrIn, SizeOf(SockAddrIn)) <> -1 then
  begin
  if Success then
  begin
    lstrcpy(Str, PChar('HELO ' + Smtp + #13#10#0));
    //WriteLn(Rus('[исх. сообщ:] '),FSocket, Str, lstrlen(Str), 0);
    WriteLn(Rus('[исх. сообщ:] HELLO...'));
    send(FSocket, Str, lstrlen(Str), 0);
    if Success then
    begin
      lstrcpy(Str, PChar('MAIL FROM: ' + From + #13#10#0));
      //WriteLn(Rus('[исх. сообщ:] '),FSocket, Str, lstrlen(Str), 0);
      WriteLn(Rus('[исх. сообщ:] MAIL FROM...')+#10);
      send(FSocket, Str, lstrlen(Str), 0);
      if Success then
      begin
        lstrcpy(Str, PChar('RCPT TO: ' + Dest + #13#10#0));
        //WriteLn(Rus('[исх. сообщ:] '),FSocket, Str, lstrlen(Str), 0);
        WriteLn(Rus('[исх. сообщ:] RCPT TO...')+#10);
        send(FSocket, Str, lstrlen(Str), 0);
        if Success then
        begin
          lstrcpy(Str, 'DATA'#13#10#0);
          //WriteLn(Rus('[исх. сообщ:] '),FSocket, Str, lstrlen(Str), 0);.
          WriteLn(Rus('[исх. сообщ:] DATA...')+#10);
          send(FSocket, Str, lstrlen(Str), 0);
          if Success then
          begin
            dSize := lstrlen(Data);
            GetMem(dBuff, dSize + 6);
            lstrcpy(dBuff, Data);
            lstrcat(dBuff, #13#10'.'#13#10#0);
            //WriteLn(Rus('[исх. сообщ:] '),FSocket, dBuff^, dSize + 6, 0);
            WriteLn(Rus('[исх. сообщ:] Buf^ Sending...')+#10);
            send(FSocket, dBuff^, dSize + 6, 0);
            FreeMem(dBuff);
            if Success then
            begin
              lstrcpy(Str, 'QUIT'#13#10#0);
              //WriteLn(Rus('[исх. сообщ:] '),FSocket, Str, lstrlen(Str), 0);
              WriteLn(Rus('[исх. сообщ:] QUIT')+#10);
              send(FSocket, Str, lstrlen(Str), 0);
              Result := true;
            end;
          end;
        end;
      end;
    end;
  end;
end;
closesocket(FSocket);
end;

function SendMail(Smtp: PChar;
                  Port: DWORD;
                  From,
                  Dest,
                  Data: PChar): Boolean;
var
  FSocket     : integer;
  HostEnt     : PHostEnt;
  SockAddrIn  : TSockAddrIn;
  WSAData     : TWSAData;
  dBuff       : PChar;
  dSize       : DWORD;
  Str         : Array [0..255] of Char;

  function Success(): Boolean;
  var
    Bytes: dword;
    RBuff: array [0..255] of Char;
  begin
    Result := false;
    Bytes := recv(FSocket, RBuff, 255, 0);
    if (Bytes = 0) or (Bytes = SOCKET_ERROR) then Exit;
    RBuff[3] := #0;
    if lstrcmp(RBuff, '220') = 0 then Result := true else
    if lstrcmp(RBuff, '250') = 0 then Result := true else
    if lstrcmp(RBuff, '354') = 0 then Result := true;
  end;

begin
  WSAStartup(257, WSAData);
  Result := false;
  FSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
  SockAddrIn.sin_family := AF_INET;
  SockAddrIn.sin_port := htons(Port);
  SockAddrIn.sin_addr.s_addr := inet_addr(Smtp);
  if SockAddrIn.sin_addr.s_addr = INADDR_NONE then
    begin
      HostEnt := gethostbyname(Smtp);
        if HostEnt = nil then
          begin
            CloseSocket(FSocket);
            Exit;
          end;
      SockAddrIn.sin_addr.s_addr := PLongint(HostEnt^.h_addr_list^)^;
    end;
  if Connect(FSocket, SockAddrIn, SizeOf(SockAddrIn)) <> -1 then
    begin
      if Success then
        begin
          lstrcpy(Str, PChar('HELO ' + Smtp + #13#10#0));
          send(FSocket, Str, lstrlen(Str), 0);
          if Success then
            begin
              lstrcpy(Str, PChar('MAIL FROM: ' + From + #13#10#0));
              send(FSocket, Str, lstrlen(Str), 0);
              if Success then
                begin
                  lstrcpy(Str, PChar('RCPT TO: ' + Dest + #13#10#0));
                  send(FSocket, Str, lstrlen(Str), 0);
                  if Success then
                    begin
                      lstrcpy(Str, 'DATA'#13#10#0);
                      send(FSocket, Str, lstrlen(Str), 0);
                      if Success then
                        begin
                          dSize := lstrlen(Data);
                          GetMem(dBuff, dSize + 6);
                          lstrcpy(dBuff, Data);
                          lstrcat(dBuff, #13#10'.'#13#10#0);
                          send(FSocket, dBuff^, dSize + 6, 0);
                          FreeMem(dBuff);
                          if Success then
                            begin
                              lstrcpy(Str, 'QUIT'#13#10#0);
                              send(FSocket, Str, lstrlen(Str), 0);
                              Result := true;
                           end;
                        end;
                    end;
                end;
            end;
        end;
    end;
  CloseSocket(FSocket);
  WSACleanup();
end;