Mam's 3D建築CG住宅CGパース
 
 
 

SMTP Client コンポーネントを作る(1)
Delphi 2009 2010 XE XE2 XE3で使えるSMTPコンポーネントを作る


はじめに
 
Delphiには SMTP クライアント コンポーネントとして、IndyのSMTP Clientがありますが、自力でSMTPクライアントを作ってみましょう。
何故作るのか?・・・なんとなく作ってみたくなったからです・・・理由はありません。
 
注意点
  • 各種認証(SMTP Auth等)には対応しません。
  • メールに関する文字エンコード(表題、本文、From、CC、BCC、添付ファイル名)はUTF-8のみに対応することとします。
    (いろいろなエンコードに対応するのは面倒なので)
  • 本コンポーネントの使用にあたっては、自己責任でお願いします。使用にあたって作者は何らの責務を負わないものとします。
  • 説明等が間違っていたらすいません。
 
SMTPクライアントの仕組みについて
 
SMTPは以下の順序でTCP/IP ポート25番を使ってデータを送信します。
  • @TCP/IPポート25でサーバーに接続⇒サーバーからレスポンスを受信
  • A挨拶「HELO *******」をサーバーに送信⇒サーバーからレスポンスを受信する。
  • BFROMメールアドレス「MAIL FROM:***@***.**.**」をサーバーへ送る⇒サーバーからレスポンスを受信する。
  • C送り先メールアドレス「RCPT TO:***@***.**.**」をサーバーへ送る⇒サーバーからレスポンスを受信する。
  • D全ての送り先(To、Cc、Bcc)に対してCを繰り返す
  • E「DATA」コマンドをサーバーへ送る。ここからメール送信先へ送られるデータをサーバーへ送っていく。
    • (1)ヘッダーを送る。例えば「User-Agent:*******」「MIME-Version:*****」「From:**@**.**.*+」
       「To:**@*.*.*」「Cc:*@**.***.*」「Subject:********」「Content-Type:******」など。Bccはヘッダーに含まない。
    • (2)改行を送る
    • (3)添付ファイルが無い場合は本文を送る。添付ファイルがある場合はboundaryで本文と添付ファイルを仕切りながらデータを送る。
  • FDATAの終わりとして、改行2回と「.」をサーバーに送る。⇒サーバーからレスポンスを受信する。
  • G「QUIT」をサーバーに送る。⇒サーバーからレスポンスを受信する。
  • Hサーバーと切断。
※Bで指定するMAIL From:メールアドレスのドメイン(@より右側)が存在するか調べて存在しないとエラーを返してくるSMTPサーバーがあります。
※難しいのはE-(3)です。それ以外は簡単です。

 
まずはTCP/IPクライアントのクラスを作成しましょう。
 
メール送信はTCP/IPを使います。TCP/IPクライアントのクラスを作らないと話になりません。
TCPクライアントはWinsockを使いますが、その手順は以下となります。 
  • @Winsockの初期化
      var WSAData:TWSAData;
      Winsock.WSAStartup($0101, WSAData);
  • Aソケットの作成
      var FSocket:TSocket;
      FSocke:=Winsock.socket(PF_INET,SOCK_STREAM,0);
  • Bサーバーへ接続
      WinSock.connect(FSocket,sockaddr,sizeof(sockaddr));
  • C送信と受信
      WinSock.send(FSocket,データ,データの長さ,0);//送信
      WinSock.recv(FSocket, バッファ, バッファの長さ, 0);//受信
  • Dサーバーの切断
      winsock.closesocket(FSocket)//切断
  • EWinsockの終了処理
      Winsock.WSACleanup;
interface
uses
  SysUtils, Classes, Windows, WinSock,StrUtils,StdCtrls
  ,dialogs,DateUtils;

type
  TMamErrorEvent = procedure(Sender: TObject;SendMessage:string) of object;

  //TCPクライアント
  TMamTcpClient=class(TComponent)
    private
      FPort:Word;           //ポート番号 通常は25
      FHost:AnsiString;     //ホスト名
      FConnecting:Boolean;  //接続中かどうか
      FErrCode:Integer;     //エラーコード
      FErrMsg:String;       //エラーメッセージ
      FErrEvent:TMamErrorEvent;
      FSocket:TSocket;      //ソケット
      FBufSize: Integer;
    public
      constructor Create(AOwner:TComponent);override;//コンストラクタ
      destructor Destroy;override;          //デストラクタ
      function Open():boolean;              //接続
      function Close():boolean;             //切断
      procedure Send(st:AnsiString);        //AnsiStringでデータ送信
      procedure SendUTF8(st:UTF8String);
      function RecvStr():AnsiString;        //AnsiStringでデータ受信
      function RecvStrDelCRLF():AnsiString; //AnsiStringでデータを受信して受信データの最後がCR+LFの場合はCR+LFを削除して受信する
      procedure RecvStringList(RecvStrings:TStrings;Enc:TEncoding);  //エンコーディングEncのデータを受信してRecvStringsへ
      procedure Recvstream(strm:TStream);                            //ストリームstrmにテータを受信
      procedure SendLn(st: AnsiString; EOL: AnsiString = #13#10);    //stにCR+LFを付けてデータを送信
      property Port:Word read FPort write FPort;
      property Host:AnsiString read FHost write FHost;
      property Connecting:Boolean read FConnecting;
      property ErrCode:Integer read FErrCode;
      property ErrMsg:String read FErrMsg;
      property OnErrEvent:TMamErrorEvent read FErrEvent write FErrEvent;
    end;

// ホスト名からHostEnt情報を取得
function GetPHostEnt(HostName:AnsiString):PHostEnt;
// WinSockのエラー番号からエラー文字列に変換
function GetSocketErrorMessage(errno:integer):String;

var
  WSAData: TWSAData;

//--------------------------------------------------------------------------
implementation

function GetPHostEnt(HostName:AnsiString):PHostEnt;
//ホスト名からIPアドレスをPHostEnt型で取り出す
var addr: Integer;
    phe: PHostEnt;
begin
  phe := gethostbyname(PansiChar(HostName));
  if phe = nil then
  begin
    // IPアドレスでの指定の場合
    addr := inet_addr(PansiChar(HostName));
    phe  := gethostbyaddr(@addr, 4, AF_INET);
  end;
  Result := phe;
end;

function GetSocketErrorMessage(ErrNo:integer):String;
//Socketのエラーメッセージを出力
var st:string;
begin
  st:='error'+IntToStr(ErrNo)+':';
  case ErrNo of
    WSABASEERR:          Result :='No Error';
    WSAEINTR:            Result := st+'Interrupted system call';
    WSAEBADF:            Result := st+'Bad file number';
    WSAEACCES:           Result := st+'Permission denied';
    WSAEFAULT:           Result := st+'Bad address';
    WSAEINVAL:           Result := st+'Invalid argument';
    WSAEMFILE:           Result := st+'Too many open files';
    WSAEWOULDBLOCK:      Result := st+'Operation would block';
    WSAEINPROGRESS:      Result := st+'Operation now in progress';
    WSAEALREADY:         Result := st+'Operation already in progress ';
    WSAENOTSOCK:         Result := st+'Socket operation on non-socket';
    WSAEDESTADDRREQ:     Result := st+'Destination address required';
    WSAEMSGSIZE:         Result := st+'Message too long';
    WSAEPROTOTYPE:       Result := st+'Protocol wrong type for socket';
    WSAENOPROTOOPT:      Result := st+'Bad protocol option';
    WSAEPROTONOSUPPORT:  Result := st+'Protocol not supported';
    WSAESOCKTNOSUPPORT:  Result := st+'Socket type not supported';
    WSAEOPNOTSUPP:       Result := st+'Operation not supported on socket';
    WSAEPFNOSUPPORT:     Result := st+'Protocol family not supported';
    WSAEAFNOSUPPORT:     Result := st+'Address family not supported by protocol family';
    WSAEADDRINUSE:       Result := st+'Address already in use';
    WSAEADDRNOTAVAIL:    Result := st+'Can''t assign requested address';
    WSAENETDOWN:         Result := st+'Network is down';
    WSAENETUNREACH:      Result := st+'Network is unreachable';
    WSAENETRESET:        Result := st+'Net dropped connection or reset';
    WSAECONNABORTED:     Result := st+'Software caused connection abort';
    WSAECONNRESET:       Result := st+'Connection reset by peer';
    WSAENOBUFS:          Result := st+'No buffer space available';
    WSAEISCONN:          Result := st+'Socket is already connected';
    WSAENOTCONN:         Result := st+'Socket is not connected';
    WSAESHUTDOWN:        Result := st+'Can''t send after socket shutdown';
    WSAETOOMANYREFS:     Result := st+'Too many referencescan''t splice';
    WSAETIMEDOUT:        Result := st+'Connection timed out';
    WSAECONNREFUSED:     Result := st+'Connection refused';
    WSAELOOP:            Result := st+'Too many levels of symbolic links';
    WSAENAMETOOLONG:     Result := st+'File name too long';
    WSAEHOSTDOWN:        Result := st+'Host is down';
    WSAEHOSTUNREACH:     Result := st+'No Route to Host';
    WSAENOTEMPTY:        Result := st+'Directory not empty';
    WSAEPROCLIM:         Result := st+'Too many processes';
    WSAEUSERS:           Result := st+'Too many users';
    WSAEDQUOT:           Result := st+'Disc Quota Exceeded';
    WSAESTALE:           Result := st+'Stale NFS file handle';
    WSAEREMOTE:          Result := st+'Too many levels of remote in path';
    WSASYSNOTREADY:      Result := st+'Network SubSystem is unavailable';
    WSAVERNOTSUPPORTED:  Result := st+'WINSOCK DLL Version out of range';
    WSANOTINITIALISED:   Result := st+'Successful WSASTARTUP not yet performed';
    WSAHOST_NOT_FOUND:   Result := st+'Host not found';
    WSATRY_AGAIN:        Result := st+'Non-Authoritative Host not found';
    WSANO_RECOVERY:      Result := st+'Non-Recoverable errors: FORMER RREFUSED NOTIMP';
    WSANO_DATA:          Result := st+'Valid name no data record of requested type';
    else                 Result := st+'Other Error';
  end;
end;

{ TMamTcpClient }

function TMamTcpClient.Close: boolean;
begin
  result:=True;
  if FSocket <> INVALID_SOCKET then
  begin
    //ソケットの送受信を無効にする(SD_SEND、SD_RECEIVE、SD_BOTHのいずれかを指定)
    if winsock.shutdown(FSocket,SD_BOTH)=SOCKET_ERROR then
    begin
      FErrCode := WSAGetLastError;
      FErrMsg:=GetSocketErrorMessage(FErrCode);
      if Assigned(FErrEvent) then
        FErrEvent(Self,FErrMsg)
      else
        raise Exception.Create(FErrMsg);
    end;
    //ソケットを閉じる
    if winsock.closesocket(FSocket)=SOCKET_ERROR then
    begin
      result:=false;
      FErrCode := WSAGetLastError;
      FErrMsg:=GetSocketErrorMessage(FErrCode);
      if Assigned(FErrEvent) then
        FErrEvent(Self,FErrMsg)
      else
        raise Exception.Create(FErrMsg);
    end;
    FConnecting := False;
  end;
end;

constructor TMamTcpClient.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPort:=80;
  FHost:='';
  FConnecting:=false;
  FErrCode:=0;
  FErrMsg:='';
  FErrEvent:=nil;
  FSocket:=INVALID_SOCKET;
  //バッファサイズはこの程度で十分
  FBufSize := 1 * 1024;
end;

destructor TMamTcpClient.Destroy;
begin
  if FConnecting then Close;
  inherited;
end;

function TMamTcpClient.Open: boolean;
//サーバーへ接続する
var phe:PHostEnt;
    sockaddr:sockaddr_in;
    ret:integer;
begin
  result:=false;
  if FConnecting then
  begin
    if Assigned(FErrEvent) then
      FErrEvent(Self,'既に接続しています')
    else
      raise Exception.Create('既に接続しています');
    Exit;
  end;

  //ホスト名からIPアドレスをPHostEnt型で取り出す
  phe:=GetPHostEnt(FHost);
  if phe=nil then
  begin
    if Assigned(FErrEvent) then
      FErrEvent(Self,'指定したサーバー('+String(FHost)+')が見つかりません')
    else
      raise Exception.Create('指定したサーバー('+String(FHost)+')が見つかりません。');
    exit;
  end;

  //TCPソケットの作成
  FSocket:=socket(PF_INET,SOCK_STREAM,0);//SOCK_STREAM=TCP、SOCK_DGRAM=UDP
  if FSocket=INVALID_SOCKET then
  begin
    if Assigned(FErrEvent) then
      FErrEvent(Self,'ソケットを作成することができませんでした')
    else
      raise Exception.Create('ソケットを作成することができませんでした');
    exit;
  end;

  ZeroMemory(@sockaddr,sizeof(sockaddr));
  sockaddr.sin_family:=AF_INET;
  //ポート番号をリトルエンディアンからビッグエンディアンへ変換して指定する
  sockaddr.sin_port:=htons(FPort);
  sockaddr.sin_addr:=PInAddr(phe.h_addr_list^)^;//接続先アドレスの指定
  //サーバーへ接続する
  if WinSock.connect(FSocket,sockaddr,sizeof(sockaddr))<>0 then
  begin
    FErrCode:=WSAGetLastError;
    FErrMsg:=GetSocketErrorMessage(FErrCode);
    if Assigned(FErrEvent) then
      FErrEvent(Self,FErrMsg)
    else
      raise Exception.Create(FErrMsg);
    exit;
  end;

  FConnecting:=True;
  result:=true;
end;

function TMamTcpClient.RecvStr: AnsiString;
//データを受信してAnsiStringで返す
var
  buf: AnsiString;
  ret: Integer;
begin
  Result := '';

  // 受信(無限ループ)
  while true do
  begin
    // 受信バッファを確保
    SetLength(buf, FBufSize);
    ZeroMemory(@buf[1], sizeof(buf));

    // 受信  受信データ数:=recv(Socket,Buffer,Bufferサイズ,0);
    ret := WinSock.recv(FSocket, buf[1], Length(buf)-1, 0);
    // 受信エラーチェック
    if ret = SOCKET_ERROR then
    begin
      FErrCode := WSAGetLastError;
      FErrMsg:=GetSocketErrorMessage(FErrCode);
      if assigned(FErrEvent) then
        FErrEvent(self,FErrMsg)
      else
        raise Exception.Create(FErrMsg);
    end;
    //受信したデータ数が0なら受信データがもう無いので抜ける
    if ret = 0 then Break;
    sleep(1);
    SetLength(buf, ret);
    Result := Result + buf;
    //受信したデータ量がバッファサイズ未満なら受信データがもう無いので抜ける
    if FBufSize > ret then Break;
  end;
end;


function TMamTcpClient.RecvStrDelCRLF: AnsiString;
//データを受信してAnsiStringで返すが受信データの最後がCR+LFの場合は削除する
var st:AnsiString;
begin
  st:=self.RecvStr;
  if RightStr(st,2)=#13#10 then
    result:=LeftStr(st,Length(st)-2)
  else
    result:=st;
end;


procedure TMamTcpClient.Recvstream(strm: TStream);
//データをTStreamに受信
var
  buf: TBytes;
  ret: Integer;
begin
  strm.Position:=0;
  strm.Size:=0;

  SetLength(buf, FBufSize);
  while True do
  begin
    // 受信バッファを初期化
    ZeroMemory(@buf[0], FBufSize);
    // 受信処理
    ret := WinSock.recv(FSocket, buf[0], FBufSize, 0);
    //受信エラーチェック
    if ret = SOCKET_ERROR then
    begin
      FErrCode := WSAGetLastError;
      FErrMsg:=GetSocketErrorMessage(FErrCode);
      if assigned(FErrEvent) then
        FErrEvent(self,FErrMsg)
      else
        raise Exception.Create(ErrMsg);
    end;
    //受信したデータ数が0なら受信データがもう無いので抜ける
    if ret = 0 then Break;
    sleep(1);
    // ストリームに保存
    strm.Write(buf[0],ret);
    //受信したデータ量がバッファサイズ未満なら受信データがもう無いので抜ける
    if FBufSize > ret then Break;
  end;
end;


procedure TMamTcpClient.RecvStringList(RecvStrings: TStrings;Enc:TEncoding);
//データをTStringsに受信、Encにエンコードを指定する
var
  strm:TMemoryStream;
begin
  //Streamで読み込んでからTStringsに読み込み
  strm:=TMemoryStream.Create;
  try
    Recvstream(strm);
    strm.Position:=0;
    RecvStrings.LoadFromStream(strm,Enc);
//    RecvStrings.LoadFromStream(strm,TEncoding.GetEncoding(20932));
  finally
    strm.Free;
  end;
end;

procedure TMamTcpClient.SendUTF8(st: UTF8String);
//UTF8文字列データを送信する
begin
  if st = '' then Exit;
  // 文字列の送信
  if WinSock.send(FSocket,st[1],Length(st),0)=-1 then
  begin
    FErrCode := WSAGetLastError;
    FErrMsg:=GetSocketErrorMessage(FErrCode);
    if Assigned(FErrEvent) then
      FErrEvent(Self,FErrMsg)
    else
      raise Exception.Create(ErrMsg);
  end;
end;


procedure TMamTcpClient.Send(st: AnsiString);
//AnsiString文字列データを送信する
begin
  if st = '' then Exit;
  // 文字列の送信
  if WinSock.send(FSocket,st[1],Length(st),0)=-1 then
  begin
    FErrCode := WSAGetLastError;
    FErrMsg:=GetSocketErrorMessage(FErrCode);
    if Assigned(FErrEvent) then
      FErrEvent(Self,FErrMsg)
    else
      raise Exception.Create(ErrMsg);
  end;
end;

procedure TMamTcpClient.SendLn(st: AnsiString;
  EOL: AnsiString = #13#10);
//AnsiString文字列データをCR+LF付きで送信する
begin
  self.send(st + EOL);
end;

initialization
// WinSock 初期化
  WSAStartup($0101, WSAData);

finalization
// WinSock 終了処理
  WSACleanup;
                

 
SMTP Client 次ページへ
 

 
  Copyright (C) 2009-2013 Mam