unit smtp;

interface

uses
Windows, SysUtils, Classes, WinSock2;


const
CL = #13#10;
CL2 = CL + CL;

function SendMail(Server: String; Port: Integer; const User, Pass,
From,SentTo,Tema,Body,Files: String): Boolean;

implementation

uses Encoders;

function StrToAddr(Server: String; var InAddr: TInAddr): Integer;
var
HostEnt: PHostEnt;
begin
Result:= -1;
HostEnt:= GetHostByName(PChar(Server));
FillChar(InAddr, SizeOf(InAddr), 0);
if (HostEnt = nil) then Exit;
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;
Result:= 0;
end;

function SendText(Sock: TSocket; S: String): Integer;
var
Buff: array[0..1023] of Char;
iSize, i: Integer;
begin
Result:=0;
S:= S + CL;
while (Length(S)>0) do
begin
iSize:= Length(S);
if ( iSize > SizeOf(Buff) ) then iSize:= SizeOf(Buff);
FillChar(Buff, SizeOf(Buff), 0);
CopyMemory(@Buff, PChar(S), iSize);
Delete(S, 1, iSize);
i:= Send(Sock, Buff, iSize, 0);
if i = SOCKET_ERROR then Break;
Result:= Result + i;
end;
end;

function RecvData(Sock: TSocket; accept: string): Boolean;
var
Buff: array[1..255] of Char;
begin
Result:= (recv(Sock, buff, SizeOf(buff), 0) = SOCKET_ERROR) or (Copy(Buff, 1, 3) = accept);
end;

procedure SendFile(SendFile: String; const Sock: TSocket);
const
Base64MaxLength = 72;
var
base64String:String;
hFile: Integer;
Buf: array[0..2] Of Byte;
Base64:TBase64;
begin
SendText(Sock, 'Content-Type: application/octet-stream; name="'+
ExtractFileName(SendFile)+'"');
SendText(Sock, 'Content-Transfer-Encoding: base64');
SendText(Sock, 'Content-Disposition: attachment; filename="'+
ExtractFileName(SendFile)+'"');
SendText(Sock, 'Content-Description: attachment');
SendText(Sock, '');
base64String:='';
hFile:= FileOpen(SendFile,fmOpenRead);
FillChar(Buf,SizeOf(Buf),#0);
Yield;
repeat
Base64.ByteCount:= FileRead(hFile,Buf,SizeOf(Buf));
Move(Buf,Base64.ByteArr,SizeOf(Buf));
base64String:= base64String + CodeBase64(Base64);
if Length(base64String) = Base64MaxLength then
begin
SendText(Sock,base64String);
base64String:= '';
end;
until Base64.ByteCount < 3;
// Отправляем последние байты
SendText(Sock,base64String);
// закрываем файл
FileClose(hFile);
SendText(Sock, '');
end;

function GenerateBoundary: String;
var
N, X, StrLen: integer;
const
StrTable: string = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890';
begin
SetLength(result, 14);
StrLen := Length(StrTable);
N := 0;
while N < 14 do begin
X:= Random(StrLen) + 1;
if (pos(StrTable[X], result) = 0) then begin
inc(N);
Result[N]:= StrTable[X];
end;
end;
end;

function GetLocalHost: string;
var
_buff : array [0..255] of char;
begin
if gethostname(_buff, 255) = 0 then
Result:= StrPas(_buff)
else
Result:= '';
end;

function SendMail(Server: String; Port: Integer; const User, Pass,
From,SentTo,Tema,Body,Files: String): Boolean;
var
Boundary: String;
wData: TWSAData;
SockSMTP: TSocket;
SockAddr: TSockAddrIn;
begin
Result:= False;
if (WSAStartup(MakeWord(2, 2), wData)<>0) then Exit;
try
//===========================================================
// Connect to SMTP server and send message\file
//============================
SockAddr.sin_family:= AF_INET;
if (StrToAddr(Server, SockAddr.sin_addr)=0) then begin
SockAddr.sin_port:= HToNS(Port);
FillChar(SockAddr.sin_zero, SizeOf(SockAddr.sin_zero), 0);
SockSMTP:= Socket(AF_INET, SOCK_STREAM, IPPROTO_IP);
if SockSMTP <> INVALID_SOCKET then begin
if (Connect(SockSMTP, @SockAddr, Sizeof(SockAddr))=0) then begin
if RecvData(SockSMTP,'220') then begin
SendText(SockSMTP,'EHLO ' + GetLocalHost); { HELO }
if RecvData(SockSMTP,'250') then begin
SendText(SockSMTP,'AUTH PLAIN ' + Base64Encode(User+#0+User+#0+Pass));
if RecvData(SockSMTP,'235') then begin
SendText(SockSMTP,'MAIL FROM:' + From);
if RecvData(SockSMTP,'250') then begin
SendText(SockSMTP,'RCPT TO:' + SentTo);
if RecvData(SockSMTP,'250') then begin
SendText(SockSMTP,'DATA');
if RecvData(SockSMTP,'354') then begin
SendText(SockSMTP,'From: ' + From);
SendText(SockSMTP,'To: ' + SentTo);
SendText(SockSMTP,'Subject: ' + Tema);
SendText(SockSMTP,'Mime-Version: 1.0');
SendText(SockSMTP,'Content-Type: multipart/mixed;');
SendText(SockSMTP,'boundary="----------' + Boundary + '"');
SendText(SockSMTP,'');
SendText(SockSMTP,'This is a multipart MIME-coded message');
SendText(SockSMTP,'');
SendText(SockSMTP,'------------' + Boundary);
SendText(SockSMTP,'Content-Type: text/plain; charset=Windows-1251');
SendText(SockSMTP,'Content-Transfer-Encoding: 8bit');
SendText(SockSMTP,'');
SendText(SockSMTP,Body);
if Files<>'' then begin
SendText(SockSMTP,'------------' + Boundary);
SendFile(Files,SockSMTP);
SendText(SockSMTP,'------------' + Boundary + '--');
SendText(SockSMTP,'');
end;

SendText(SockSMTP, CL + '.' + CL);
SendText(SockSMTP, 'QUIT');
Result:= True;
end;
end;
end;
end;
end;
end;
end;
CloseSocket(SockSMTP);
end;
end;
finally
WSACleanup;
end;
end;

end.