{ 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. |
Delphi Basics - Free Delphi Source Code - Ultimate Programming Resource > Delphi Basics Snippets >