１６番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル
"SMTPユニット"
みなさん、こんにちわ。 かとちんです。(^-^)／
WebModule や Service などの、画面を使わないようなプロジェクトだと、
TNMSMTPコンポがタコ過ぎてちゃんと動いてくれなくて作成しました。
TClientSocket辺りから派生できないかも検討してみたんですが、ローカル
ポートを別で持っちゃうようだしイマイチ（本当はうまいやり方があったのか
もしれませんが）なので、結局１つのルーチンにすることで解決しました。
添付ファイルなども工夫すればイケルと思います。なにせこのサンプルも、
jconvert.pas(12番を漁ってGET!! 熊木さんパッチ要) の恩恵を得てますか
ら。(^^;
http://www.forest.impress.co.jp/article/2000/06/16/recipe7.html
の、Ｃのサンプルを参考にして Delphiらしくしたものです。
切羽詰まっていたので元ソースがあって本当に助かりました。
前述したようにシーケンシャルに動作するプログラムなどで御利用いただける
と良いと思います。
１つだけ疑問が残ったのが、TNMSMTP にある、UserIDプロパティの扱いです。
RFC871の仕様（http://www.brl.ntt.co.jp/people/akihiro/rfc/rfc821.html
邦訳感謝。）を見ても分からなかったし、私が対象とするサーバーや、
いくつかのSMTPサーバで試したんですが、ログインを求めてこないので、
UserID をどう使えば良いか分からなくて...
TNMSMTPのヘルプを見ると「多くのサーバーで必要」とあるんですけどね...
----------------------------------------------------------------------
unit SMTP;
interface
uses
Windows, SysUtils, WinSock, Classes, jconvert;
{=====================================================================
メール送信関数 --- 添付ファイルには未対応
ToAddress には、カンマ区切りで複数宛先に送信できる。
複数宛先の場合に、相手から他の相手を知ることはできないようになってい
る。
=====================================================================}
procedure SMTPSend(Host: string; Port: Integer; FromName, FromAddress,
ToAddress, Subject, Body: string);
implementation
const
BUFSIZE = 256;
RECVSIZE = 4096;
SMTP_ERRORSTATUS = 400;
var
WinSockInitError: Boolean;
function SMTPRecv(Soc: Integer; Buf: PChar; Len: Integer): Boolean;
var
RecvLen: Integer;
P: PChar;
begin
FillChar(Buf^, Len, 0);
P := Buf;
while Pos(#13#10, StrPas(Buf)) = 0 do
begin
RecvLen := recv(Soc, P^, Len-1, 0);
Inc(P, RecvLen);
Dec(Len, RecvLen);
if Len <= 1 then
begin
Result := False;
Exit;
end;
end;
Result := True;
end;
procedure SMTPRes(soc: Integer);
var
RecvBuf: array[0..RECVSIZE-1] of Char; // 受信バッファ
Code: Integer;
begin
if not SMTPRecv(soc, @RecvBuf, RECVSIZE) then
raise Exception.Create('Error: サーバからの受信失敗');
// 受信内容の先頭コードに着目
Code := StrToIntDef(Copy(RecvBuf, 1, 3), -1);
if (Code <= 0) or (Code >= SMTP_ERRORSTATUS) then
raise Exception.Create('Error: ' + RecvBuf);
end;
procedure DoSend(Soc: Integer; S: string);
begin
S := S + #13#10;
if send(Soc, PChar(S)^, Length(S), 0) = SOCKET_ERROR then
raise Exception.Create('Error: サーバへの送信失敗');
end;
procedure DoConnectServer(Soc: Integer; Host: string; Port: Integer);
var
Addr: DWORD; // サーバのIPアドレス
HostEnt: PHostEnt; // サーバの情報を指すポインタ
sockaddr: TSockAddrIn; // サーバのアドレス
begin
// svNameにドットで区切った10進数のIPアドレスが入っている場合、
// addrに32bit整数のIPアドレスが返ります
Addr := inet_addr(PChar(Host));
if Addr = $FFFFFFFF then
begin
//Trace('ホスト情報を取得中');
// サーバ名(Host)からサーバの情報を取得します
HostEnt := gethostbyname(PChar(Host));
if HostEnt = nil then
raise Exception.Create('Error: ホストアドレス取得失敗');
// サーバの情報からIPアドレスをaddrにコピーします
Addr := DWORD(HostEnt^.h_addr_list);
end;
//Trace('サーバへ接続中');
// サーバのアドレスの構造体にサーバのIPアドレスとポート番号を設定
sockaddr.sin_family := AF_INET; // インターネットの場合
sockaddr.sin_addr.s_addr := Addr; // サーバのIPアドレス
sockaddr.sin_port := htons(WORD(Port)); // ポート番号
FillChar(sockaddr.sin_zero, sizeof(sockaddr.sin_zero), 0);
// サーバへ接続します
if connect(Soc, sockaddr, sizeof(sockaddr)) = SOCKET_ERROR then
raise Exception.Create('Error: サーバへの接続失敗');
end;
procedure SMTPSend(Host: string; Port: Integer; FromName, FromAddress,
ToAddress, Subject, Body: string);
var
Soc: Integer; // ソケット（Soket Descriptor
SList: TStringList;
Tos: TStringList;
Index: Integer;
begin
if WinSockInitError then
raise Exception.Create('WinSockの初期化エラー');
// socにソケットを作成します
Soc := socket(PF_INET, SOCK_STREAM, 0);
if Soc = INVALID_SOCKET then
raise Exception.Create('Error: Socket作成失敗');
try
DoConnectServer(Soc, Host, Port);
try
SMTPRes(Soc);
DoSend(Soc, 'HELO '+Host);
SMTPRes(Soc);
DoSend(Soc, 'MAIL FROM:<'+FromAddress+'>');
SMTPRes(Soc);
Tos := TStringList.Create;
try
Tos.CommaText := ToAddress;
for Index := 0 to Tos.Count-1 do
begin
DoSend(Soc, 'RCPT TO:<'+Tos[Index]+'>');
SMTPRes(Soc);
end;
DoSend(Soc, 'DATA');
SMTPRes(Soc);
// 本文の作成
// 差出人は半角スペースが削除されるので全角スペースに置換
FromName := StringReplace(FromName, ' ', ' ',
[rfReplaceAll]);
DoSend(Soc, 'From: '+ CreateHeaderString(FromName) +
' <'+FromAddress+'>');
if Tos.Count = 1 then
DoSend(Soc, 'To: '+ToAddress)
else
DoSend(Soc, 'To: '+FromAddress);
DoSend(Soc, 'Subject: '+CreateHeaderString(Subject)+#13#10);
SList := TStringList.Create;
try
SList.Text := Body;
repeat
Index := SList.IndexOf('.');
if Index >= 0 then
SList[Index] := '. ';
until Index = -1;
for Index := 0 to SList.Count-1 do
DoSend(Soc, SList[Index]);
finally
SList.Free;
end;
DoSend(Soc, '.');
SMTPRes(Soc);
finally
end;
DoSend(Soc, 'QUIT');
SMTPRes(Soc);
finally
// 送受信を無効にする
shutdown(Soc,2);
end;
finally
// ソケットを破棄する
closesocket(Soc);
end;
end;
procedure WinSockInit;
var
wVersionRequested: WORD;
wsaDat: WSAData;
nErrorStatus: Integer; // WinSockの初期化結果
begin
// WinSockの初期化を行う
wVersionRequested := MAKEWORD(1, 1); // バージョン 1.1
を要求する
nErrorStatus := WSAStartup(wVersionRequested, wsaDat);
WinSockInitError := (nErrorStatus <> 0);
end;
initialization
WinSockInit;
finalization
WSACleanup;
end.
----------------------------------------------------------------------
▲● 2001/03/18 20:52 JDX06162(とんちんかんちんかとちん)
■ Borland Delphi ... The Great Development Kit
uses D2Desktop, D3CSS, D4CSS, D5ENT, JB4PRO; GO FDELPHI
Original document by かとちん 氏 ID:(JDX06162)
ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。