Send Email with pure Winsock

unit SendMailUnit;

interface

uses windows, winsock;

function DNASendEMail(PSmtp,PUser,PPass,PGetMail,PTOMail,Subject,MailText:string):boolean;

implementation

var

   SendBody:string;

const

CRLF=#13#10;

BaseTable:string='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';

function StrLen(const Str: PChar): Cardinal; assembler;

asm

       MOV     EDX,EDI

       MOV     EDI,EAX

       MOV     ECX,0FFFFFFFFH

       XOR     AL,AL

       REPNE   SCASB

       MOV     EAX,0FFFFFFFEH

       SUB     EAX,ECX

       MOV     EDI,EDX

end;

function StrCopy(Dest: PChar; const Source: PChar): PChar; assembler;

asm

       PUSH    EDI

       PUSH    ESI

       MOV     ESI,EAX

       MOV     EDI,EDX

       MOV     ECX,0FFFFFFFFH

       XOR     AL,AL

       REPNE   SCASB

       NOT     ECX

       MOV     EDI,ESI

       MOV     ESI,EDX

       MOV     EDX,ECX

       MOV     EAX,EDI

       SHR     ECX,2

       REP     MOVSD

       MOV     ECX,EDX

       AND     ECX,3

       REP     MOVSB

       POP     ESI

       POP     EDI

end;

function StrPas(const Str: PChar): string;

begin

Result := Str;

end;

function FindInTable(CSource:char):integer;

begin

result:=Pos(string(CSource),BaseTable)-1;

end;

function EncodeBase64(Source:string):string;

var

Times,LenSrc,i:integer;

x1,x2,x3,x4:char;

xt:byte;

begin

result:='';

LenSrc:=length(Source);

if LenSrc mod 3 =0 then Times:=LenSrc div 3

else Times:=LenSrc div 3 + 1;

for i:=0 to times-1 do

begin

   if LenSrc >= (3+i*3) then

   begin

     x1:=BaseTable[(ord(Source[1+i*3]) shr 2)+1];

     xt:=(ord(Source[1+i*3]) shl 4) and 48;

     xt:=xt or (ord(Source[2+i*3]) shr 4);

     x2:=BaseTable[xt+1];

     xt:=(Ord(Source[2+i*3]) shl 2) and 60;

     xt:=xt or (ord(Source[3+i*3]) shr 6);

     x3:=BaseTable[xt+1];

     xt:=(ord(Source[3+i*3]) and 63);

     x4:=BaseTable[xt+1];

   end

   else if LenSrc>=(2+i*3) then

   begin

     x1:=BaseTable[(ord(Source[1+i*3]) shr 2)+1];

     xt:=(ord(Source[1+i*3]) shl 4) and 48;

     xt:=xt or (ord(Source[2+i*3]) shr 4);

     x2:=BaseTable[xt+1];

     xt:=(ord(Source[2+i*3]) shl 2) and 60;

     x3:=BaseTable[xt+1];

     x4:='=';

   end else

   begin

     x1:=BaseTable[(ord(Source[1+i*3]) shr 2)+1];

     xt:=(ord(Source[1+i*3]) shl 4) and 48;

     x2:=BaseTable[xt+1];

     x3:='=';

     x4:='=';

   end;

   result:=result+x1+x2+x3+x4;

end;

end;

function LookupName(const Name: string): TInAddr;

var

HostEnt: PHostEnt;

InAddr: TInAddr;

begin

HostEnt := gethostbyname(PChar(Name));

FillChar(InAddr, SizeOf(InAddr), 0);

if HostEnt <> nil then

begin

   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;

end;

Result := InAddr;

end;

function StartNet(host:string;port:integer;var sock:integer):Boolean;

var

wsadata:twsadata;

FSocket:integer;

SockAddrIn:TSockAddrIn;

err:integer;

begin

err:=WSAStartup($0101,WSAData);

FSocket:=socket(PF_INET,SOCK_STREAM,IPPROTO_IP);

if FSocket=invalid_socket then begin

   Result:=False;

   Exit;

end;

SockAddrIn.sin_addr:=LookupName(host);

SockAddrIn.sin_family := PF_INET;

SockAddrIn.sin_port :=htons(port);

err:=connect(FSocket,SockAddrIn, SizeOf(SockAddrIn));

if err=0 then begin

sock:=FSocket;

Result:=True;

end

else

begin

Result:=False;

end;

end;

procedure StopNet(Fsocket:integer);

var

err:integer;

begin

err:=closesocket(FSocket);

err:=WSACleanup;

end;

function SendData(FSocket:integer;SendStr:string):integer;

var

DataBuf:array[0..4096] of char;

err:integer;

begin

strcopy(DataBuf,pchar(SendStr));

err:=send(FSocket,DataBuf,strlen(DataBuf),MSG_DONTROUTE);

Result:=err;

end;

function GetData(FSocket:integer):String;

const

MaxSize=1024;

var

DataBuf:array[0..MaxSize] of char;

err:integer;

begin

err:=recv(FSocket,DataBuf,MaxSize,0);

Result:=Strpas(DataBuf);

end;

function DNASendEMail(psmtp,puser,ppass,pgetmail,PTOMail,subject,mailtext:string):boolean;

var

FSocket,res:integer;

begin

Result:=false;

sendbody:='SendEmail Unit By Anskya ';

if StartNet(PSmtp, 25, FSocket) then

begin

   SendData(FSocket, 'HELO ' +Puser+ CRLF);

   getdata(FSocket);

   SendData(FSocket, 'AUTH LOGIN' + CRLF);

   getdata(FSocket);

   SendData(FSocket, EncodeBase64(Puser) + CRLF);

   getdata(FSocket);

   SendData(FSocket, EncodeBase64(PPass) + CRLF);

   getdata(FSocket);

   SendData(FSocket, 'MAIL FROM: <' + PGetMail + '>' + CRLF);

   getdata(FSocket);

   SendData(FSocket, 'RCPT TO: <' + PTOMail + '>' + CRLF);

   getdata(FSocket);

   SendData(FSocket, 'DATA' + CRLF);

   getdata(FSocket);

   SendBody := 'From:信息 <' + PGetMail + '>' + CRLF

     + 'To: <' + PGetMail + '>' + CRLF

     + 'Subject: ' + Subject + CRLF

     + CRLF

     + MailText + CRLF

     + '.' + CRLF;     

   res := SendData(FSocket, SendBody);

   getdata(FSocket);

   SendData(FSocket, 'QUIT' + CRLF);

   getdata(FSocket);

   StopNet(Fsocket);

   if res <> SOCKET_ERROR then

   begin

    Result:=true;

   end;

end;

end;

end.