unit xNet;

interface

uses
  Windows, WinSock;

const
  CRLF = #13#10;

  CSMTPCommands: array[0..20, 0..1] of String = (
    ('211', 'System status, or system help reply'),
    ('214', 'Help message'),
    ('220', 'Service ready'),
    ('221', 'Service closing transmission channel'),
    ('250', 'Requested mail action okay, completed'),
    ('251', 'User not local'),
    ('354', 'Start mail input'),
    ('421', 'Service not available, closing transmission channel'),
    ('450', 'Requested mail action not taken: mailbox unavailable'),
    ('451', 'Requested action aborted: local error in processing'),
    ('452', 'Requested action not taken: insufficient system storage'),
    ('500', 'Syntax error, command unrecognized'),
    ('501', 'Syntax error in parameters or arguments'),
    ('502', 'Command not implemented'),
    ('503', 'Bad sequence of commands'),
    ('504', 'Command parameter not implemented'),
    ('550', 'Requested action not taken: mailbox unavailable'),
    ('551', 'User not local'),
    ('552', 'Requested mail action aborted: exceeded storage allocation'),
    ('553', 'Requested action not taken: mailbox name not allowed'),
    ('554', 'Transaction failed')
  );

  {SMTP Error Codes}
  ERR_NOERROR = 0;
  ERR_SMTP_MALFORMED = 1;
  ERR_SMTP_UNK_COMMAND = 2;
  ERR_ONCMD_STR = 3;
  ERR_RECV = 4;
  ERR_SEND = 5;

type
  TTextSocket = class(TObject)
  private
    FSocket: TSocket;
  public
    function Connect(const Host: String; Port: Word): Boolean;
    procedure Disconnect;
    function ReceiveData(var Buffer: String): Boolean;
    function SendData(var Data; Len: Integer): Boolean;
  end;

  TTextProtocol = class(TTextSocket);  

  TSMTPProtocol = class(TTextProtocol)
  private
    FLastError: Integer;
    FLastErrorStr: String;
    procedure MakeStringError(const Command: String);
    
    {SEND}
    function MakeCommand(const Value: String): String;
    function MakeHello(const Host: String): String;
    function MakeMailFrom(const User: String): String;
    function MakeMailTo(const User: String): String;
    function MakeDataStart: String;
    function MakeData(const Data: String): String;
    function MakeQuit: String;
    function SendSMTPCommand(Command: String): Boolean;

    {RECV}
    function CheckIfValidCommand(const Value: String): Integer;
    function RecvSMTPCommand(var Command: String): Boolean;
  public
    function MakeSMTPSession(const Host, UserFrom, UserTo, Data: String): Boolean;
    property LastError: Integer read FLastError;
    property LastErrorStr: String read FLastErrorStr;
  end;

var
  WSAData: TWSAData;
  FWSAStarted: Boolean;

implementation

{SMTP}

function TSMTPProtocol.MakeCommand(const Value: String): String;
begin
  Result := Value + CRLF;
end;

function TSMTPProtocol.MakeHello(const Host: String): String;
begin
  Result := MakeCommand('EHLO ' + Host);
end;

function TSMTPProtocol.MakeMailFrom(const User: String): String;
begin
  Result := MakeCommand('MAIL FROM:' + User);
end;

function TSMTPProtocol.MakeMailTo(const User: String): String;
begin
  Result := MakeCommand('RCPT TO:' + User);
end;

function TSMTPProtocol.MakeDataStart: String;
begin
  Result := MakeCommand('DATA');
end;

function TSMTPProtocol.MakeData(const Data: String): String;
begin
  Result := MakeCommand('Subject: Test from ld-pinch' + CRLF + CRLF + Data + CRLF + '.');
end;

function TSMTPProtocol.MakeQuit: String;
begin
  Result := MakeCommand('QUIT');
end;

function TSMTPProtocol.CheckIfValidCommand(const Value: String): Integer;
var
  Command: String;
  i: Integer;
begin
  if Length(Value) < 4 then begin
    Result := ERR_SMTP_MALFORMED;
    Exit;
  end;
  Command := Copy(Value, 0, 3);
  for i := Low(CSMTPCommands) to High(CSMTPCommands) do
    if CSMTPCommands[i, 0] = Command then begin
      Result := ERR_NOERROR;
      Exit;
    end;
  Result := ERR_SMTP_UNK_COMMAND;
  FLastErrorStr := Command;
end;

function TSMTPProtocol.RecvSMTPCommand(var Command: String): Boolean;
var
  RcvData: String;
begin
  if not ReceiveData(RcvData) then begin
    FLastError := ERR_RECV;
    Result := False;
    Exit;
  end;
  FLastError := CheckIfValidCommand(RcvData);
  Result := FLastError = ERR_NOERROR;
  if Result then
    Command := Copy(RcvData, 0, 3)
end;

function TSMTPProtocol.SendSMTPCommand(Command: String): Boolean;
begin
  {SendData}
  Result := SendData(Command[1], Length(Command));
  if not Result then
    FLastError := ERR_SEND;
end;

procedure TSMTPProtocol.MakeStringError(const Command: String);
var
  i: Integer;
begin
  for i := Low(CSMTPCommands) to High(CSMTPCommands) do
    if CSMTPCommands[i, 0] = Command then begin
      FLastError := ERR_ONCMD_STR;
      FLastErrorStr := CSMTPCommands[i, 1];
    end;
end;

function TSMTPProtocol.MakeSMTPSession(const Host, UserFrom, UserTo, Data: String): Boolean;
var
  Command: String;
begin
  Result := False;
  FLastError := ERR_NOERROR;

  {Receive Server's Greeting}
  if not RecvSMTPCommand(Command) then Exit;
  if Command <> '220' then begin
     MakeStringError(Command);
     Exit;
  end;

  {HELO}
  if not SendSMTPCommand(MakeHello('localhost')) then Exit;
  if not RecvSMTPCommand(Command) then Exit;
  if Command <> '250' then begin
     MakeStringError(Command);
     Exit;
  end;

  {MAIL FROM: user@domain.com}
  if not SendSMTPCommand(MakeMailFrom(UserFrom)) then Exit;
  if not RecvSMTPCommand(Command) then Exit;
  if Command <> '250' then begin
     MakeStringError(Command);
     Exit;
  end;

  {RCPT TO: user@domain.com}
  if not SendSMTPCommand(MakeMailTo(UserTo)) then Exit;
  if not RecvSMTPCommand(Command) then Exit;
  if Command <> '250' then begin
     MakeStringError(Command);
     Exit;
  end;

  {DATA}
  if not SendSMTPCommand(MakeDataStart) then Exit;
  if not RecvSMTPCommand(Command) then Exit;
  if Command <> '354' then begin
     MakeStringError(Command);
     Exit;
  end;

  {Message Body}
  if not SendSMTPCommand(MakeData(Data)) then Exit;
  if not RecvSMTPCommand(Command) then Exit;
  if Command <> '250' then begin
     MakeStringError(Command);
     Exit;
  end;

  {QUIT}
  if not SendSMTPCommand(MakeQuit) then Exit;

  Result := True;
end;

{ TTextSocket }

function TTextSocket.Connect(const Host: String; Port: Word): Boolean;
var
  addr: Integer;
  sockaddr: sockaddr_in;
begin
  Result := False;

  if not FWSAStarted then Exit;

  FSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  if FSocket = INVALID_SOCKET then Exit;

  addr := inet_addr(PChar(Host));
  if addr = INADDR_NONE then Exit;

  sockaddr.sin_family := AF_INET;
  sockaddr.sin_port := htons(Port);
  sockaddr.sin_addr.S_addr := addr;

  Result := WinSock.connect(FSocket, sockaddr, sizeof(sockaddr)) <> SOCKET_ERROR;
end;

procedure TTextSocket.Disconnect;
begin
  if FSocket <> INVALID_SOCKET then begin
    closesocket(FSocket);
    FSocket := INVALID_SOCKET;
  end;
end;

function TTextSocket.ReceiveData(var Buffer: String): Boolean;
var
  LocBuf: array[0..1023] of Byte;
  RecvLen: Integer;

  function IsComplete: Boolean;
  begin
    Result := (Length(Buffer) > 1) and (Buffer[Length(Buffer)-1] = #13) and (Buffer[Length(Buffer)] = #10);
  end;
begin
  Buffer := '';
  Result := False;
  while True do begin
    RecvLen := recv(FSocket, LocBuf, SizeOf(LocBuf)-1, 0);
    if RecvLen = SOCKET_ERROR then
      Exit
    else if RecvLen = 0 then
      Break
    else begin
      LocBuf[RecvLen] := 0;
      Buffer := Buffer + Copy(PChar(@LocBuf), 0, RecvLen);
      if IsComplete then begin
        Result := True;
        Exit;
      end;
    end;
  end;
  Result := IsComplete;
end;

function TTextSocket.SendData(var Data; Len: Integer): Boolean;
begin
  Result := send(FSocket, Data, Len, 0) <> SOCKET_ERROR;
end;


initialization
  FWSAStarted := WSAStartup(MAKEWORD(1, 1), WSAData) = 0;

finalization
  if FWSAStarted then
    WSACleanup;

end.
