SMTP协议

不想用Delphi的Indy控件.  实在是BUG太多, 而且引用后,你的程序容量将大量增加
在考虑之后决定使用纯winsock来写一个发邮件的类, 并且支持发送附件.
在网上找到smtp协议介绍.,并且自己用foxmail发送一封带附件的邮件
抓包分析后 写了一个发送邮件的类.  可能有些BUG 请大家指出
调用方法

uses uMail;
var
 Mail : TMail;
begin
  Mail := TMail.Create;
  try
    Mail.Host := 'alin.vicp.cc';
    Mail.FromAddr := 
'test@alin.vicp.cc'
;
    Mail.Password := '111111';
    Mail.ToAddr := 
'test@alin.vicp.cc'
;
    Mail.Subject := '测试发送的邮件!';
    Mail.Body := '这是一封测试的邮件!';
    Mail.Attaches.Add('c:\test.rar');
    Mail.Attaches.Add('c:\test1.rar');
    if Mail.Send then
       ShowMessage('Send Ok')
    else
       ShowMessage('Send Failed' + #13 + Mail.ErrMsg);
  finally
    Mail.Free;
  end;
end;

源码下载

unit uMail;
interface
uses WinSock, Windows, SysUtils, Classes, Math;
const
 CRLF :string = #13 + #10;
type
  TMail = class
    private
      FFromAddr : string;
      FToAddr : string;
      FSubject : string;
      FBody : string;
      FErrMsg : string;
      FHost : string;
      FAttaches : TStrings;
      FSendData : TStrings;
      FPassword : string;
      function chunklenSplit(Value : string): string;
    function GetSendData: string;
    protected
      procedure InitSendData;
    public
      constructor Create;
      destructor Destory;
      property Host : string read FHost write FHost; //主机名
      property FromAddr : string read FFromAddr write FFromAddr; //来自
      property ToAddr : string read FToAddr write FToAddr;//发送到
      property Subject : string read FSubject write FSubject;//标题
      property Body : string read FBody write FBody;//内容
      property Attaches : TStrings read FAttaches write FAttaches;//附件
      property ErrMsg : string read FErrMsg;//错误信息
      property SendData : string read GetSendData;//邮件发送的详细内容
      property Password : string read FPassword write FPassword;//密码
      function Send : boolean;         
  end;
implementation
uses Base64;
{ TMail }
function TMail.chunklenSplit(Value: string): string;
var
  I,len : integer;
begin
  Result := '';
  for i := 0 to floor(Length(Value) / 76) do
  begin
    if i * 76 + 77 > Length(Value) then
       len := Length(Value) - (i-1) * 76 + 1
    else
       len := 76;
    Result := Result + Copy(Value,i * 76 + 1,len) + CRLF;
  end; 
end;
constructor TMail.Create;
var
  WSData: TWSAData;
begin
  WSAstartup(1, WSData);
  FAttaches := TStringList.Create;
  FSendData := TStringList.Create;
end;
destructor TMail.Destory;
begin
  FAttaches.Free;
  FSendData.Free;
  WSACleanup;
end;
function TMail.GetSendData: string;
begin
  Result := FSendData.Text;
end;
procedure TMail.InitSendData;
var
  guid : TGUID;
  fs : TFileStream;
  fbuf : array of byte;
  boundary,fn,sbuf : string;
  i : integer;
begin
  FSendData.Clear;
  CreateGUID(guid);
  boundary := Copy(GuidToString(Guid),2,Length(GuidToString(Guid))-2);
  
  FSendData.Add('From: "'+FFromAddr+'" <'+FFromAddr+'>');
  FSendData.Add('To: "'+FToAddr+'"');
  FSendData.Add('Subject: '+ FSubject);
  FSendData.Add('MIME-Version: 1.0');
  FSendData.Add('Content-Type: multipart/mixed;');
  FSendData.Add(#9 + 'boundary="=='+boundary+'"' + CRLF);
  FSendData.Add('This is a MIME encoded message.' + CRLF);
  FSendData.Add('--=='+boundary);
  FSendData.Add('Content-Type: text/plain;');
  FSendData.Add(#9+'charset="gb2312"');
  FSendData.Add('Content-Transfer-Encoding: base64'+ CRLF);
  FSendData.Add(Base64EncodeStr(FBody) + CRLF);
  for i := 0 to FAttaches.Count - 1 do
  begin
   if FileExists(FAttaches[i]) then
   begin
     fn := ExtractFileName(FAttaches[i]);
     FSendData.Add('--==' + boundary);
     FSendData.Add('Content-Type: application/octet-stream;');
     FSendData.Add(#9 + 'name="'+fn+'"');
     FSendData.Add('Content-Transfer-Encoding: base64');
     FSendData.Add('Content-Disposition: attachment;');
     FSendData.Add(#9+'filename="'+fn+'"' + CRLF);
     fs := TFileStream.Create(FAttaches[i], fmShareDenyNone);
      try 
        SetLength(fbuf,fs.Size);
        SetLength(sbuf, ((fs.Size+2) div 3)*4); 
        fs.ReadBuffer(fbuf[0], fs.Size);
        Base64Encode(fbuf,@sbuf[1],fs.Size);
        sbuf := chunklenSplit(sbuf);
        FSendData.Add(sbuf);
      finally
        fs.Free;
      end;
   end;
  end;
  FSendData.Add('--=='+boundary+'--' + CRLF + CRLF + '.');
end;
function TMail.Send: boolean;
var
  sock : TSocket;
  mhost : PHostEnt;
  maddr : TSockAddrIn;
  rbuf : array[0..255] of char;
  sbuf : string;
begin
  Result := true;
  sock := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  try
    if sock = INVALID_SOCKET then
    begin
      Result := false;
      FErrMsg := '创建Socket失败！';
      Exit;
    end;
    mhost := gethostbyname(pchar(FHost));
    if mhost = nil then
    begin
      Result := false;
      FErrMsg := '获取主机地址失败！';
      Exit;
    end;
    maddr.sin_family := AF_INET;
    maddr.sin_port := htons(25);
    maddr.sin_addr.S_addr := Longint(PLongint(mhost^.h_addr_list^)^);;
    if connect(sock,maddr, sizeof(maddr)) < 0 then
    begin
      Result := false;
      FErrMsg := '链接主机失败！';
      Exit;
    end;
    recv(sock, rbuf, sizeof(rbuf),0);
    //链接成功
    if rbuf[0] <> '2' then
    begin
      Result := false;
      FErrMsg := rbuf;
      Exit;
    end;
      //服务器标识
    sbuf := 'EHLO '+ IntToStr(GetCurrentThreadID) + CRLF;
    winsock.send(sock, sbuf[1], Length(sbuf),0);
    recv(sock, rbuf, sizeof(rbuf),0);
    if rbuf[0] <> '2' then
    begin
      Result := false;
      FErrMsg := rbuf;
      Exit;
    end;
    //请求验证
    sbuf := 'AUTH LOGIN'+ CRLF;
    winsock.send(sock, sbuf[1], Length(sbuf),0);
    recv(sock, rbuf, sizeof(rbuf),0);
    if rbuf[0] <> '3' then
    begin
      Result := false;
      FErrMsg := rbuf;
      Exit;
    end;
      //发送用户名
    sbuf := Base64EncodeStr(FFromAddr)+ CRLF;
    winsock.send(sock, sbuf[1], Length(sbuf),0);
    recv(sock, rbuf, sizeof(rbuf),0);
    if rbuf[0] <> '3' then
    begin
      Result := false;
      FErrMsg := rbuf;
      Exit;
    end;
      //发送密码 
    sbuf := Base64EncodeStr(FPassword)+ CRLF;
    winsock.send(sock, sbuf[1], Length(sbuf),0);
    recv(sock, rbuf, sizeof(rbuf),0);
    if rbuf[0] <> '2' then
    begin
      Result := false;
      FErrMsg := rbuf;
      Exit;
    end;
      
      //来自
    sbuf := 'MAIL FROM: <'+ FFromAddr +'>'+ CRLF;
    winsock.send(sock, sbuf[1], Length(sbuf),0);
    recv(sock, rbuf, sizeof(rbuf),0);
    if rbuf[0] <> '2' then
    begin
      Result := false;
      FErrMsg := rbuf;
      Exit;
    end;
      //发送到  
    sbuf := 'RCPT TO: <'+ FToAddr +'>'+ CRLF;
    winsock.send(sock, sbuf[1], Length(sbuf),0);
    recv(sock, rbuf, sizeof(rbuf),0);
    if rbuf[0] <> '2' then
    begin
      Result := false;
      FErrMsg := rbuf;
      Exit;
    end;
    //准备发送数据
    sbuf := 'DATA'+ CRLF;
    winsock.send(sock, sbuf[1], Length(sbuf),0);
    recv(sock, rbuf, sizeof(rbuf),0);
    if (rbuf[0] <> '3') or (rbuf[1] <> '5') then
    begin
      Result := false;
      FErrMsg := rbuf;
      Exit;
    end;
    //初始化需要发送的数据
    InitSendData;
    sbuf := FSendData.Text;
    winsock.send(sock, sbuf[1], Length(sbuf),0);
    recv(sock, rbuf, sizeof(rbuf),0);
    if rbuf[0] <> '2' then
    begin
      Result := false;
      FErrMsg := rbuf;
      Exit;
    end; 
    sbuf := 'QUIT' + CRLF ;
    winsock.send(sock, sbuf[1], Length(sbuf),0);
    recv(sock, rbuf, sizeof(rbuf),0);
  finally
    CloseSocket(sock);
  end;
end;
end.

——————————————————————————–
【版权声明】: 本文原创于http://2Lin.net, 转载请注明作者并保持文章的完整, 谢谢!