直接用WinSock API 发E-mail.

unit SMTP_Connections;

//------------------------------------------

//定义单元

//---------------------------------------------

interface

uses

Classes, StdCtrls;

const

WinSock = 'wsock32.dll';

Internet = 2;

Stream = 1;

fIoNbRead = $4004667F;

WinSMTP = $0001;

LinuxSMTP = $0002;

type

TWSAData = packed record

wVersion: Word;

wHighVersion: Word;

szDescription: array[0..256] of Char;

szSystemStatus: array[0..128] of Char;

iMaxSockets: Word;

iMaxUdpDg: Word;

lpVendorInfo: PChar;

end;

PHost = ^THost;

THost = packed record

Name: PChar;

aliases: ^PChar;

addrtype: Smallint;

Length: Smallint;

addr: ^Pointer;

end;

TSockAddr = packed record

Family: Word;

Port: Word;

Addr: Longint;

Zeros: array[0..7] of Byte;

end;

function WSAStartup(Version:word; Var Data:TwsaData):integer; stdcall; far; external winsock;

function socket(Family,Kind,Protocol:integer):integer; stdcall; far; external winsock;

function shutdown(Socket,How:Integer):integer; stdcall; far; external winsock;

function closesocket(socket:Integer):integer; stdcall; far; external winsock;

function WSACleanup:integer; stdcall; far; external winsock;

function bind(Socket:Integer; Var SockAddr:TSockAddr; AddrLen:integer):integer; stdcall; far; external winsock;

function listen(socket,flags:Integer):integer; stdcall; far; external winsock;

function connect(socket:Integer; Var SockAddr:TSockAddr; AddrLen:integer):integer; stdcall; far; external winsock;

function accept(socket:Integer; Var SockAddr:TSockAddr; Var AddrLen:Integer):integer; stdcall; far; external winsock;

function WSAGetLastError:integer; stdcall; far; external winsock;

function recv(socket:integer; data:pchar; datalen,flags:integer):integer; stdcall; far; external winsock;

function send(socket:integer; var data; datalen,flags:integer):integer; stdcall; far; external winsock;

function gethostbyname(HostName:PChar):PHost; stdcall; far; external winsock;

function WSAIsBlocking:boolean; stdcall; far; external winsock;

function WSACancelBlockingCall:integer; stdcall; far; external winsock;

function ioctlsocket(socket:integer; cmd: Longint; var arg: longint): Integer; stdcall; far; external winsock;

function gethostname(name:pchar; size:integer):integer; stdcall; far; external winsock;

procedure _authSendMail(MailServer,uname,upass,mFrom,mFromName,mToName,Subject:string;mto,mbody:TStringList);

function ConnectServer(mhost:string;mport:integer):integer;

function ConnectServerwin(mhost:string;mport:integer):integer;

function DisConnectServer:integer;

function Stat: string;

function SendCommand(Command: String): string;

function SendData(Command: String): string;

function SendCommandWin(Command: String): string;

function ReadCommand: string;

function encryptB64(s:string):string;

var

mconnHandle: Integer;

mFin, mFOut: Textfile;

EofSock: Boolean;

mactive: Boolean;

mSMTPErrCode: Integer;

mSMTPErrText: string;

mMemo: TMemo;

implementation

uses

SysUtils, Sockets, IdBaseComponent,

IdCoder, IdCoder3to4, IdCoderMIME, IniFiles,Unit1;

var

mClient: TTcpClient;

procedure _authSendMail(MailServer, uname, upass, mFrom, mFromName,

mToName, Subject: string; mto, mbody: TStringList);

var

tmpstr: string;

cnt: Integer;

mstrlist: TStrings;

RecipientCount: Integer;

begin

if ConnectServerWin(Mailserver, 25) = 250 then

begin

Sendcommandwin('AUTH LOGIN ');

SendcommandWin(encryptB64(uname));

SendcommandWin(encryptB64(upass));

SendcommandWin('MAIL FROM: ' + mfrom);

for cnt := 0 to mto.Count - 1 do

SendcommandWin('RCPT TO: ' + mto[cnt]);

Sendcommandwin('DATA');

SendData('Subject: ' + Subject);

SendData('From: "' + mFromName + '" <' + mfrom + '>');

SendData('To: ' + mToName);

SendData('Mime-Version: 1.0');

SendData('Content-Type: multipart/related; boundary="Esales-Order";');

SendData(' type="text/html"');

SendData('');

SendData('--Esales-Order');

SendData('Content-Type: text/html;');

SendData(' charset="iso-8859-9"');

SendData('Content-Transfer-Encoding: QUOTED-PRINTABLE');

SendData('');

for cnt := 0 to mbody.Count - 1 do

SendData(mbody[cnt]);

Senddata('');

SendData('--Esales-Order--');

Senddata(' ');

mSMTPErrText := SendCommand(crlf + '.' + crlf);

try

mSMTPErrCode := StrToInt(Copy(mSMTPErrText, 1, 3));

except

end;

SendData('QUIT');

DisConnectServer;

end;

function Stat: string;

var

s: string;

begin

s := ReadCommand;

Result := s;

end;

function EchoCommand(Command: string): string;

begin

SendCommand(Command);

Result := ReadCommand;

end;

function ReadCommand: string;

var

tmp: string;

begin

repeat

ReadLn(mfin, tmp);

if Assigned(mmemo) then

mmemo.Lines.Add(tmp);

until (Length(tmp) < 4) or (tmp[4] <> '-');

Result := tmp

end;

function SendData(Command: string): string;

begin

Writeln(mfout, Command);

end;

function SendCommand(Command: string): string;

begin

Writeln(mfout, Command);

Result := stat;

end;

function SendCommandWin(Command: string): string;

begin

Writeln(mfout, Command + #13);

Result := stat;

end;

function FillBlank(Source: string; number: Integer): string;

var

a: Integer;

begin

Result := '';

for a := Length(trim(Source)) to number do

Result := Result + ' ';

end;

function IpToLong(ip: string): Longint;

var

x, i: Byte;

ipx: array[0..3] of Byte;

v: Integer;

begin

Result := 0;

Longint(ipx) := 0;

i := 0;

for x := 1 to Length(ip) do

if ip[x] = '.' then

begin

Inc(i);

if i = 4 then Exit;

end

else

begin

if not (ip[x] in ['0'..'9']) then Exit;

v := ipx[i] * 10 + Ord(ip[x]) - Ord('0');

if v > 255 then Exit;

ipx[i] := v;

end;

Result := Longint(ipx);

end;

function HostToLong(AHost: string): Longint;

var

Host: PHost;

begin

Result := IpToLong(AHost);

if Result = 0 then

begin

Host := GetHostByName(PChar(AHost));

if Host <> nil then Result := Longint(Host^.Addr^^);

end;

function LongToIp(Long: Longint): string;

var

ipx: array[0..3] of Byte;

i: Byte;

begin

Longint(ipx) := long;

Result := '';

for i := 0 to 3 do Result := Result + IntToStr(ipx[i]) + '.';

SetLength(Result, Length(Result) - 1);

end;

procedure Disconnect(Socket: Integer);

begin

ShutDown(Socket, 1);

CloseSocket(Socket);

end;

function CallServer(Server: string; Port: Word): Integer;

var

SockAddr: TSockAddr;

begin

Result := socket(Internet, Stream, 0);

if Result = -1 then Exit;

FillChar(SockAddr, SizeOf(SockAddr), 0);

SockAddr.Family := Internet;

SockAddr.Port := swap(Port);

SockAddr.Addr := HostToLong(Server);

if Connect(Result, SockAddr, SizeOf(SockAddr)) <> 0 then

begin

Disconnect(Result);

Result := -1;

end;

function OutputSock(var F: TTextRec): Integer; far;

begin

if F.BufPos <> 0 then

begin

Send(F.Handle, F.BufPtr^, F.BufPos, 0);

F.BufPos := 0;

end;

Result := 0;

end;

function InputSock(var F: TTextRec): Integer; far;

var

Size: Longint;

begin

F.BufEnd := 0;

F.BufPos := 0;

Result := 0;

repeat

if (IoctlSocket(F.Handle, fIoNbRead, Size) < 0) then

begin

EofSock := True;

Exit;

end;

until (Size >= 0);

F.BufEnd := Recv(F.Handle, F.BufPtr, F.BufSize, 0);

EofSock := (F.Bufend = 0);

end;

function CloseSock(var F: TTextRec): Integer; far;

begin

Disconnect(F.Handle);

F.Handle := -1;

Result := 0;

end;

function OpenSock(var F: TTextRec): Integer; far;

begin

if F.Mode = fmInput then

begin

EofSock := False;

F.BufPos := 0;

F.BufEnd := 0;

F.InOutFunc := @InputSock;

F.FlushFunc := nil;

end

else

begin

F.Mode := fmOutput;

F.InOutFunc := @OutputSock;

F.FlushFunc := @OutputSock;

end;

F.CloseFunc := @CloseSock;

Result := 0;

end;

procedure AssignCrtSock(Socket:integer; Var Input,Output:TextFile);

begin

with TTextRec(Input) do

begin

Handle := Socket;

Mode := fmClosed;

BufSize := SizeOf(Buffer);

BufPtr := @Buffer;

OpenFunc := @OpenSock;

end;

with TTextRec(Output) do

begin

Handle := Socket;

Mode := fmClosed;

BufSize := SizeOf(Buffer);

BufPtr := @Buffer;

OpenFunc := @OpenSock;

end;

Reset(Input);

Rewrite(Output);

end;

function ConnectServer(mhost: string; mport: Integer): Integer;

var

tmp: string;

begin

mClient := TTcpClient.Create(nil);

mClient.RemoteHost := mhost;

mClient.RemotePort := IntToStr(mport);

mClient.Connect;

mconnhandle := callserver(mhost, mport);

if (mconnHandle<>-1) then

begin

AssignCrtSock(mconnHandle, mFin, MFout);

tmp := stat;

tmp := SendCommand('HELO bellona.com.tr');

if Copy(tmp, 1, 3) = '250' then

begin

Result := StrToInt(Copy(tmp, 1, 3));

end;

function ConnectServerWin(mhost: string; mport: Integer): Integer;

var

tmp: string;

begin

mClient := TTcpClient.Create(nil);

mClient.RemoteHost := mhost;

mClient.RemotePort := IntToStr(mport);

mClient.Connect;

mconnhandle := callserver(mhost, mport);

if (mconnHandle<>-1) then

begin

AssignCrtSock(mconnHandle, mFin, MFout);

tmp := stat;

tmp := SendCommandWin('HELO bellona.com.tr');

if Copy(tmp, 1, 3) = '250' then

begin

Result := StrToInt(Copy(tmp, 1, 3));

end;

function DisConnectServer: Integer;

begin

closesocket(mconnhandle);

mClient.Disconnect;

mclient.Free;

end;

function encryptB64(s: string): string;

var

hash1: TIdEncoderMIME;

p: string;

begin

if s <> '' then

begin

hash1 := TIdEncoderMIME.Create(nil);

p := hash1.Encode(s);

hash1.Free;

end;

Result := p;

end;

end.

//------------------------------------------

// 怎么使用定义好得相关单元

//---------------------------------------------

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

Memo1: TMemo;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

uses

SMTP_Connections;

procedure TForm1.Button1Click(Sender: TObject);

var

mto, mbody: TStringList;

MailServer, uname, upass, mFrom, mFromName,

mToName, Subject: string;

begin

mMemo := Memo1; // 定义相关发送服务器

//..........................

MailServer := 'mail.163.com';

uname := 'username';

upass := 'password';

mFrom := 'laolij@163.com;

mFromName := 'forename surname';

mToName := '';

Subject := 'Your Subject';

//..........................

mto := TStringList.Create;

mbody := TStringList.Create;

try

mto.Add('anybody@xyz.net');

mbody.Add('测试邮件');

//发送.................

_authSendMail(MailServer, uname, upass, mFrom, mFromName, mToName, Subject, mto, mbody);

//..........................

finally

mto.Free;

mbody.Free;

end;

end.