J
jack011
Unregistered / Unconfirmed
GUEST, unregistred user!
我在网上找到现成的DEMO,只能发送文本格式邮件,网页的发出去收到的是乱码!
(我们经常收到很多广告(html格式),他们是如何实现的呢?
我知道indy控件可以实现,感觉效率低)
unit eMail;
interface
uses Windows, WinSock, SysUtils;
function SendMail1(Smtp, User, Pass, GetMail, ToMail, Subject, MailText: string): Bool;
implementation
var
SendBody: string;
const
CRLF = #13#10;
BaseTable: string = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';
// 查表
function FindInTable(CSource: Char): Integer;
begin
Result := Pos(string(CSource), BaseTable) - 1;
end;
// 编码
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 - 1do
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;
SendStr: string): Integer;
var
DataBuf: array[0..4096] of Char;
Err: Integer;
begin
StrCopy(DataBuf, PChar(SendStr));
Err := Send(FSocket, DataBuf, StrLen(DataBuf), MSG_DONTROUTE);
Result := Err;
end;
function GetData(FSocket: Integer): string;
const
MaxSize = 1024;
var
DataBuf: array[0..MaxSize] of Char;
begin
Recv(FSocket, DataBuf, MaxSize, 0);
Result := StrPas(DataBuf);
end;
function SendMail1(Smtp, User, Pass, Getmail, ToMail, Subject, MailText: string): Bool;
var
FSocket, Res: Integer;
begin
Result := False;
if StartNet(Smtp, 25, FSocket) then
begin
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.
//主界面
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TFormMain = class(TForm)
Open: TButton;
Send: TButton;
OpenDialog: TOpenDialog;
GroupBox2: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
sendmail: TEdit;
tomail: TEdit;
user: TEdit;
pasw: TEdit;
smtp: TEdit;
MailList: TRichEdit;
procedure OpenClick(Sender: TObject);
procedure SendClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FormMain: TFormMain;
implementation
uses eMail66, UrlPost, eMail;
{$R *.dfm}
//加在网页html
procedure TFormMain.OpenClick(Sender: TObject);
begin
if OpenDialog.Execute then
begin
MailList.Clear;
MailList.Lines.LoadFromFile(OpenDialog.FileName);
end;
end;
//发送邮件
procedure TFormMain.SendClick(Sender: TObject);
var
s: string;
begin
try
s := MailList.Lines.Text;
//PostURL(pchar(asp.text), 'num=' + HtmlEncode(pchar(s)));
SendMail1(trim(smtp.Text), trim(user.text), trim(Pasw.Text), trim(sendmail.text), trim(tomail.text), s, s);
messagebox(0, '测试完毕,请检查信箱或空间!', '测试', 0);
except
Application.ProcessMessages;
end;
end;
end.
(我们经常收到很多广告(html格式),他们是如何实现的呢?
我知道indy控件可以实现,感觉效率低)
unit eMail;
interface
uses Windows, WinSock, SysUtils;
function SendMail1(Smtp, User, Pass, GetMail, ToMail, Subject, MailText: string): Bool;
implementation
var
SendBody: string;
const
CRLF = #13#10;
BaseTable: string = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';
// 查表
function FindInTable(CSource: Char): Integer;
begin
Result := Pos(string(CSource), BaseTable) - 1;
end;
// 编码
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 - 1do
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;
SendStr: string): Integer;
var
DataBuf: array[0..4096] of Char;
Err: Integer;
begin
StrCopy(DataBuf, PChar(SendStr));
Err := Send(FSocket, DataBuf, StrLen(DataBuf), MSG_DONTROUTE);
Result := Err;
end;
function GetData(FSocket: Integer): string;
const
MaxSize = 1024;
var
DataBuf: array[0..MaxSize] of Char;
begin
Recv(FSocket, DataBuf, MaxSize, 0);
Result := StrPas(DataBuf);
end;
function SendMail1(Smtp, User, Pass, Getmail, ToMail, Subject, MailText: string): Bool;
var
FSocket, Res: Integer;
begin
Result := False;
if StartNet(Smtp, 25, FSocket) then
begin
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.
//主界面
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TFormMain = class(TForm)
Open: TButton;
Send: TButton;
OpenDialog: TOpenDialog;
GroupBox2: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
sendmail: TEdit;
tomail: TEdit;
user: TEdit;
pasw: TEdit;
smtp: TEdit;
MailList: TRichEdit;
procedure OpenClick(Sender: TObject);
procedure SendClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FormMain: TFormMain;
implementation
uses eMail66, UrlPost, eMail;
{$R *.dfm}
//加在网页html
procedure TFormMain.OpenClick(Sender: TObject);
begin
if OpenDialog.Execute then
begin
MailList.Clear;
MailList.Lines.LoadFromFile(OpenDialog.FileName);
end;
end;
//发送邮件
procedure TFormMain.SendClick(Sender: TObject);
var
s: string;
begin
try
s := MailList.Lines.Text;
//PostURL(pchar(asp.text), 'num=' + HtmlEncode(pchar(s)));
SendMail1(trim(smtp.Text), trim(user.text), trim(Pasw.Text), trim(sendmail.text), trim(tomail.text), s, s);
messagebox(0, '测试完毕,请检查信箱或空间!', '测试', 0);
except
Application.ProcessMessages;
end;
end;
end.