Send Email with pure Winsock

posted 30 May 2010, 06:34 by Delphi Basics   [ updated 30 May 2010, 06:36 ]
{
  Send Email with pure Winsock
  By Anskya
}
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.
Comments