Question

Delphi 如何用API发EMAIL，求代码。

谢谢！ 只要纯洁API编程的代码。

Answer 1

unit eMail66;

interface

uses Windows;

function SendMail66(Smtp, User, Pass, GetMail, ToMail, Subject, MailText: string): Bool;

implementation

uses FunUnit, WinSock;

var
SendBody: string;

const
CRLF = #13#10;
BaseTable: string = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';

// 编码
function EncodeBase64(const Source: string): string;
var
Times, LenSrc, j: 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 j := 0 to Times - 1 do
begin
if LenSrc >= (3 + j * 3) then
begin
x1 := BaseTable[(Ord(Source[1 + j * 3]) shr 2)+1];
xt := (Ord(Source[1 + j * 3]) shl 4) and 48;
xt := xt or (Ord(Source[2 + j * 3]) shr 4);
x2 := BaseTable[xt + 1];
xt := (Ord(Source[2 + j * 3]) shl 2) and 60;
xt := xt or (ord(Source[3 + j * 3]) shr 6);
x3 := BaseTable[xt + 1];
xt := (Ord(Source[3 + j * 3]) and 63);
x4 := BaseTable[xt + 1];
end
else if LenSrc >= (2 + j * 3) then
begin
x1 := BaseTable[(Ord(Source[1 + j * 3]) shr 2) + 1];
xt := (Ord(Source[1 + j * 3]) shl 4) and 48;
xt := xt or (Ord(Source[2 + j * 3]) shr 4);
x2 := BaseTable[xt + 1];
xt := (Ord(Source[2 + j * 3]) shl 2) and 60;
x3 := BaseTable[xt + 1];
x4 := '=';
end else
begin
x1 := BaseTable[(Ord(Source[1 + j * 3]) shr 2) + 1];
xt := (Ord(Source[1 + j * 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): Bool;
var
WSAData: TWSAData;
FSocket: Integer;
SockAddrIn: TSockAddrIn;
Err: Integer;
begin
Result := False;

WSAStartup($0101, WSAData);
FSocket := Socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
if (FSocket = INVALID_SOCKET) then Exit;

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;
end;

procedure StopNet(Fsocket:integer);
begin
CloseSocket(FSocket);
WSACleanup();
end;

function SendData(FSocket: Integer; const SendStr: string): Integer;
var
DataBuf: PChar;
DataLen: Integer;
begin
DataBuf := PChar(SendStr);
DataLen := Length(SendStr);
Result := 0;

while (Result <> SOCKET_ERROR) and (DataLen > 0) do
begin
Result := Send(FSocket, DataBuf^, DataLen, 0);
Inc(DataBuf, Result);
Dec(DataLen, Result);
end;
end;

function GetData(FSocket: Integer): string;
const
MaxSize = 1024;
var
DataBuf: array[0..MaxSize] of Char;
begin
Recv(FSocket, DataBuf, MaxSize, 0);
Result := DataBuf;
end;

// 邮件发信
function SendMail66(Smtp, User, Pass, Getmail, ToMail, Subject, MailText: string): Bool;
var
FSocket, Res: Integer;
begin
Result := False;

if StartNet(Smtp, 25, FSocket) then
begin
GetData(FSocket);

SendData(FSocket, 'HELO ' + User + CRLF);
GetData(FSocket);

SendData(FSocket, 'AUTH LOGIN' + CRLF);
GetData(FSocket);

SendData(FSocket, EncodeBase64(User) + CRLF);
GetData(FSocket);

SendData(FSocket, EncodeBase64(Pass) + CRLF);
GetData(FSocket);

SendData(FSocket, 'MAIL FROM: <' + GetMail + '>' + CRLF);
GetData(FSocket);

SendData(FSocket, 'RCPT TO: <' + ToMail + '>' + CRLF);
Getdata(FSocket);

SendData(FSocket, 'DATA' + CRLF);
GetData(FSocket);

SendBody :=
'From: <' + GetMail + '>' + CRLF +
'To: <' + ToMail + '>' + CRLF +
'Subject: ' + Subject + CRLF +
CRLF + MailText + CRLF + '.' + CRLF;
Res := SendData(FSocket, SendBody);
GetData(FSocket);

SendData(FSocket, 'QUIT' + CRLF);
GetData(FSocket);

StopNet(Fsocket);

Result := (Res <> SOCKET_ERROR);
end;
end;

end.