program MySendMail;
uses Winsock;
var
  wsadata: TWSADATA;
  Addr: TSockAddrIn;
  sock: TSocket;
  Buf_r: array[0..255] of char;
  f : TextFile;
const
  MailFrom ='[email protected]';
  MailTo = '[email protected]';
  CRLF = #13+#10;
  Title = 'Test Title';
  Body = 'Test Body';
  MySmtp = '194.67.23.111'; //ping -a smtp.mail.ru

procedure init;
begin
AssignFile(f,'History.txt');
Rewrite(f);
end;

procedure Sends(str : String);
var
i: integer;
begin
for i:=1 to Length(str) do if send(sock,str[i],1,0)=SOCKET_ERROR then exit;
end;

procedure CheckAnswer(str : String);
var
Answer : integer;
begin
Answer:=Recv(sock,Buf_r,sizeof(Buf_r),0);
if (Answer=SOCKET_ERROR) or (Answer=0) then
begin
WriteLn(f,str);
CloseFile(f);
Halt;
end else WriteLn(f,'Server:'+Buf_r);
end;

begin
init;
WSAStartUp($0101, wsadata);  
sock:=socket(AF_INET,SOCK_STREAM,IPPROTO_IP);

Addr.sin_family:=PF_Inet;
Addr.sin_port:=HtoNS(25);
Addr.sin_addr.S_addr:=Inet_Addr(PChar(MySmtp));
FillChar(Addr.sin_zero,SizeOf(Addr.sin_zero),0);

Connect(sock,Addr,sizeof(Addr));
CheckAnswer('Error: Connection!');

// Отправляем Привет Ярослав
Sends('HELO Yaroslaw'+CRLF);
CheckAnswer('Error: Hello!');

// От кого:
Sends('MAIL FROM:'+MailFrom+CRLF);
CheckAnswer('Error: Mail From!');

// RCPT TO:
Sends('RCPT TO:'+MailTo+CRLF);
CheckAnswer('Error: Mail To!');

// DATA
Sends('DATA'+CRLF);
CheckAnswer('Error: Data!');

// Send Body
Sends(Title+CRLF);
Sends(Body+CRLF);

// <CRLF>.<CRLF>  End of Body
Sends(CRLF+'.'+CRLF);
CheckAnswer('Error: End of Body!');

//Выход
Sends('QUIT'+#13+#10);
CheckAnswer('Error: Quit!');

Shutdown(sock, SD_Both);
CloseSocket(sock);
WSACleanup;
CloseFile(f);
end.

program MailSend;  

{$APPTYPE CONSOLE}  

uses
   windows,
   WinSock;

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;  
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  
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);  
end;  

var  
WSAData: TWSAData;  
Mail, Data: string;  

begin  
Write('Send Mail to: ');  
ReadLn(Mail);  
Write('Enter Mail Text: ');  
ReadLn(Data);  
WSAStartup(257, WSAData);  
if SendMail('smtp.mail.ru', 25,  
'[email protected]',
PChar(Mail), PChar(Data)) then  
WriteLn('Mail sended') else WriteLn('Error on sending mail');
ReadLn;
WSACleanup();
end.