SMTP

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,
              'gena@mail.ru',
              PChar(Mail), PChar(Data)) then
               WriteLn('Mail sended') else WriteLn('Error on sending mail');
  ReadLn;
  WSACleanup();
end.