Gamerz Online

Para el envío de correo electrónico disponemos de herramientas y componentes muy buenos, pero hacen que nuestro código dependa de ellos y de la VCL.

Para enviar un email por código, sin el uso de componentes y con el protocolo SMTP no extendido, podemos usar un código similar al que propongo.

Aclarar que no todos los servidores nos van a servir pues casi todos nos piden una clave. En el caso de que tengamos cuenta de Yahoo, nos va a funcionar perfectamente.

El nombre de usuario y password tenemos que enviarlos codificados en BASE64, el resto va en texto llano.

El código está bastante comentado para comprender bien el protocolo, que incluso nos puede permitir camuflar el remitente. 

const
  CRYPT_STRING_BASE64 = 1;
 
function CryptBinaryToString(pbBinary: PByte; cbBinary: DWORD; dwFlags: DWORD;
  pszString: PChar; var pcchString: DWORD): BOOL; stdcall;
  external 'Crypt32.dll' name 'CryptBinaryToStringA';
 
function CryptStringToBinary(pszString: PChar; cchString: DWORD; dwFlags: DWORD;
  pbBinary: PByte; var pcbBinary: DWORD; pdwSkip: PDWORD;
  pdwFlags: PDWORD): BOOL; stdcall;
  external 'Crypt32.dll' name 'CryptStringToBinaryA';
 
function Base64Encode(S: String): String;
var
  Size: DWORD;
begin
  if CryptBinaryToString(@S[1], Length(S), CRYPT_STRING_BASE64 ,nil, Size) then
  begin
    SetLength(Result, Size-1);
    if not CryptBinaryToString(@S[1], Length(S), CRYPT_STRING_BASE64, PChar(Result), Size) then
      Result:= EmptyStr;
  end;
end;
 
function SendMail(_From, _To, _SMTP, User, Password, _Subject, _Message: String): boolean;
var
  WSA:           TWSADATA;
  iProtocolPort: integer;
  sBuffer:       ShortString;
  hServer:       TSOCKET;
  lpHostEntry:   PHOSTENT;
  lpServEntry:   PSERVENT ;
  SockAddr:      SOCKADDR_IN ;
begin
  Result:= false;
  iProtocolPort := 0;
  if(WSAStartup(MakeWord(1,1), WSA) <> 0) then exit;
 
  // Obtenemos la dirección del servidor SMTP
  lpHostEntry:= gethostbyname(PCHAR(_SMTP));
  if(lpHostEntry <> nil) then
  begin
    // Creamos el socket TCP/IP
    hServer:= socket(PF_INET, SOCK_STREAM, 0);
    if(hServer <> INVALID_SOCKET) then
    begin
      // Obtenemos el puerto del servicio de correo:
      lpServEntry:= getservbyname('mail', 0);
      // si no está especificado usamos el puerto por defecto
      if lpServEntry = nil then
        iProtocolPort:= htons(IPPORT_SMTP)
      else
        iProtocolPort:= lpServEntry.s_port;
 
      // Configuramos la estructura Socket Address para conectar
      SockAddr.sin_family:= AF_INET;
      SockAddr.sin_port:= iProtocolPort;
      SockAddr.sin_addr:= (PInAddr(lpHostEntry.h_addr_list^))^;
      // Y conectamos el Socket
      if connect(hServer, SockAddr, sizeof(SockAddr))= 0 then
      begin
        // Recibimos la respuesta de inicio desde el SMTP
        recv(hServer, sBuffer[1], sizeof(sBuffer), 0);
        if Pos('220', sBuffer) = 1 then  // Ok al conectar
        begin
          // Enviamos HELO
          sBuffer:= 'HELO ' + _SMTP + #13 + #10;
          send(hServer, sBuffer[1], Length(sBuffer), 0);
          recv(hServer, sBuffer[1], sizeof(sBuffer), 0);
 
          // Enviamos "rset"
          sBuffer:= 'rset'+#13+#10;
          send(hServer, sBuffer[1], Length(sBuffer), 0);
          recv(hServer, sBuffer[1], sizeof(sBuffer), 0);
 
          // Loging
          sBuffer:= 'auth LOGIN'+#13+#10;
          send(hServer, sBuffer[1], Length(sBuffer), 0);
          recv(hServer, sBuffer[1], sizeof(sBuffer), 0);
          if Pos('334', sBuffer) = 1 then  //No error en comando auth LOGIN
          begin
            sBuffer:= Base64Encode(User);
            send(hServer, sBuffer[1], Length(sBuffer), 0);
            recv(hServer, sBuffer[1], sizeof(sBuffer), 0);
            if Pos('334', sBuffer) = 1 then // Ok LOGIN USER
            begin
              sBuffer:= Base64Encode(Password);
              send(hServer, sBuffer[1], Length(sBuffer), 0);
              recv(hServer, sBuffer[1], sizeof(sBuffer), 0);
              if Pos('235', sBuffer) = 1 then  // Ok LOGIN PASSWORD
              begin
                // Enviamos origen: MAIL FROM:
                sBuffer:= 'MAIL FROM:<'+_From+'>' +#13+#10;
                send(hServer, sBuffer[1], Length(sBuffer), 0);
                recv(hServer, sBuffer[1], sizeof(sBuffer), 0);
 
                // Enviamos destino RCPT TO:
                // podemos repetir para mas destinos
                sBuffer:= 'RCPT TO:<'+_To+'>' +#13+#10;
                send(hServer, sBuffer[1], Length(sBuffer), 0);
                recv(hServer, sBuffer[1], sizeof(sBuffer), 0);
 
                // Enviamos DATA
                sBuffer:= 'DATA'+#13+#10;
                send(hServer, sBuffer[1], Length(sBuffer), 0);
                recv(hServer, sBuffer[1], sizeof(sBuffer), 0);
                if pos('354', sBuffer) = 1 then // Ok en comando DATA
 
                // Enviamos la cabecera del mensaje
                sBuffer:= 'Subject: '+ _Subject +#13+#10;
                send(hServer, sBuffer[1], Length(sBuffer), 0);
                sBuffer:= 'To: '+_To +#13+#10;
                send(hServer, sBuffer[1], Length(sBuffer), 0);
                sBuffer:= 'From: '+_From +#13+#10;
                send(hServer, sBuffer[1], Length(sBuffer), 0);
 
                // Enviamos el cuerpo del mensaje
                send(hServer, _Message[1], Length(_Message), 0);
 
                // Enviamos fin de trasmisión
                sBuffer:= #13+#10+'.'+#13+#10;
                send(hServer, sBuffer[1], Length(sBuffer), 0);
                recv(hServer, sBuffer[1], sizeof(sBuffer), 0);
                if Pos('250', sBuffer) = 1 then // Ok en el envío del Mensaje
                begin
                  // Enviamos QUIT
                  sBuffer:= 'QUIT'+#13+#10;
                  send(hServer, sBuffer[1], Length(sBuffer), 0);
                  recv(hServer, sBuffer[1], sizeof(sBuffer), 0);
                  if Pos('221', sBuffer) = 1 then // Ok en QUIT
                    Result:= true;
                end;
              end;
            end;
          end;
        end;
      end;
      // Cerramos el Socket
      closesocket(hServer);
    end;
  end;
  WSACleanup();
end;
 

Un ejemplo de uso:

 SendMail('MiCuenta@yahoo.es', 'Destino@gmail.com', 'smtp.correo.yahoo.es',
           'Usuario', 'Password',
           'Prueba', '¿Hola como estás?, ¡¡esto funciona correctamente!!');
 
 

Es un código experimental pero que puede servir de base de desarollo.

Espero que sea de utilidad.

Saludos.