|
![]() |
名片设计 CorelDRAW Illustrator AuotoCAD Painter 其他软件 Photoshop Fireworks Flash |
|
以下是创建一个虚拟主机的代码: config.xml(配置信息) <Root_Element> <admin>Administrator</admin> <adminpass>xxxxxx</adminpass> <readuser>IUSR_MACHINE</readuser> <domain>fcxx.net</domain> <dnsadmin>dnsadmin</dnsadmin> <dnsadminpass>yyyyy</dnsadminpass> <dnsip>10.1.143.227</dnsip> <group>tryit</group> <webdir>http://www.fcxx.net</webdir> </Root_Element> global.asa(配置文件) <SCRIPT LANGUAGE=vbscript RUNAT=Server> Sub Application_OnStart set ff=server.createobject("microsoft.xmldom") ff.async=false ff.load server.mappath("config.xml") set rootElem = ff.documentElement for e1=0 to rootElem.childNodes.length-1 application(trim(rootElem.childNodes.item(e1).nodeName))=trim(rootElem.childNodes.item(e1).text) next End Sub </script> index.asp(申请页面) <% user=trim(request("user")) pass=trim(request("pass")) email=trim(request("email")) if user<>"" then if pass="" or instr(email,"@")<2 then response.write "<font color=\\\'red\\\'>填写错误</font>" else SET GG=SERVER.CREATEOBJECT("QWEB.USER") gg.logon application("admin") & "@" & application("domain"),application("adminpass") SET RR=GG.CREATE(user,application("group")) if gg.iserr then response.write "<font color=\\\'red\\\'>不能创建用户:" & gg.errstring & "</font>" else gg.value("pwdLastSet",rr)=-1 gg.changepassword "", pass,rr response.write gg.errstring gg.value("accountdisabled",rr)=TRUE gg.value("accountexpirationdate",rr)=now()+2 gg.value("description",rr)=session.SessionID SET FF=CreateObject("QWEB.dns") domainn=right(email,len(email)-instr(email,"@")) SET cc=CREATEOBJECT("qmail.newmail") cc.sender="AA网络<anyone@anyone.net>" cc.receiver=email cc.sendashtml=true cc.subject="注册确认" cc.body="<a href=\\\'" & application("webdir") & "/active.asp?user=" & user & "&id=" & session.SessionID & "&pass=" & pass & "\\\'>谢谢您的注册,请在24小时内(" & (now()+1) & ")激活您的帐户。</a>" vv=ff.mxrecord(application("dnsip"),domainn) HH=SPLIT(VV," ") FOR G=0 TO UBOUND(HH) cc.smtpsvr=hh(g) cc.send if cc.errcode=true then exit for next if cc.errcode=false then gg.delete rr response.write "<font color=\\\'red\\\'>无法发送注册信息</font>" else response.write "<font color=\\\'red\\\'>注册成功,请24小时内查看邮件,激活帐户.</font>" response.end end if set cc=nothing set ff=nothing end if set gg=nothing end if end if %> <h1 align="center">免费空间申请</h1> <form name="form1" method="post" action="<% =request.ServerVariables("SCRIPT_NAME") %>"> <p>用户名: <input type="text" name="user"> </p> <p>密 码: <input type="password" name="pass"> </p> <p>电子邮件: <input type="text" name="email"> </p> <p> <input type="submit" name="Submit" value="现在申请"> </p> </form> <p align="center"> </p> active.asp(确认页面,建立站点、开通FTP、EMAIL、配置DNS纪录) <% user=request("user") id=request("id") SET UU=SERVER.CREATEOBJECT("QWEB.MEMBER") SET GG=SERVER.CREATEOBJECT("QWEB.USER") SET z1=SERVER.CreateObject("QWEB.DIR") set bb=server.createobject("MDUsercom.MDUser") Set mUserInfo =server.createobject("MDUsercom.MDUserInfo") set ff=createobject("qweb.dns") UU.LOGON application("admin") & "@" & application("domain"),application("adminpass") gg.logon application("admin") & "@" & application("domain"),application("adminpass") SET RR=GG.user(user,application("group")) if gg.iserr then msg1= "获取用户资料时发生错误:" & gg.errstring else if gg.value("description",rr)<>id or (gg.value("accountdisabled",rr)=false) then msg1= "激活失败,请您从邮箱内提示的地址连接,或帐户在此之前已经被激活" else mpath=session.sessionid z1.CREATE SERVER.MapPath("free/" & mpath),user,application("readuser") if z1.iserr then msg1="在创建用户目录时发生错误:" & z1.errstring else z1.CREATE SERVER.MapPath("free/" & mpath & "/mail"),user,application("readuser") if z1.iserr then msg1="在创建用户邮件目录时发生错误:" & z1.errstring z1.delete SERVER.MapPath("free/" & mpath) else SET SS=z1.CREATESITE(user & "." & application("domain"),SERVER.MapPath("free/" & mpath)) if z1.iserr then msg1="在创建站点时发生错误:" & z1.errstring z1.delete SERVER.MapPath("free/" & mpath & "/mail") z1.delete SERVER.MapPath("free/" & mpath) else z1.createftpdir user,SERVER.MapPath("free/" & mpath) if z1.iserr then msg1="在创建FTP目录时发生错误:" & z1.errstring z1.delete SERVER.MapPath("free/" & mpath & "/mail") z1.delete SERVER.MapPath("free/" & mpath) set site1=z1.getsite(user & "." & application("domain")) z1.deletesite site1 else ff.logon application("domain"),application("dnsip"),application("dnsadmin"),application("dnsadminpass") ff.arecord(user & "." & application("domain"))=application("dnsip") if ff.iserr then msg1="在写入DNS记录时发生错误:" & ff.errstring z1.delete SERVER.MapPath("free/" & mpath & "/mail") z1.delete SERVER.MapPath("free/" & mpath) set site1=z1.getsite(user & "." & application("domain")) z1.deletesite site1 z1.deleteftpdir user else bb.LoadUserDll bb.inituserinfo muserinfo muserinfo.fullname=user muserinfo.mailbox=user muserinfo.domain=application("domain") muserinfo.MailDir=SERVER.MapPath("free/" & mpath & "/mail") muserinfo.password=request("pass") muserinfo.MaxDiskSpace=25000000 muserinfo.ApplyQuotas=true kk=bb.adduser(muserinfo) if kk<>"0" then msg1="在创建用户邮箱时发生错误:" & kk z1.delete SERVER.MapPath("free/" & mpath & "/mail") z1.delete SERVER.MapPath("free/" & mpath) set site1=z1.getsite(user & "." & application("domain")) z1.deletesite site1 z1.deleteftpdir user ff.arecord(user & "." & application("domain"))="" else gg.value("accountexpirationdate",rr)=gg.value("accountexpirationdate",rr)+366 gg.value("accountdisabled",rr)=false gg.value("EmailAddress",rr)=user & "@" & application("domain") gg.value("HomeDirectory",rr)=SERVER.MapPath("free/" & mpath) if gg.iserr then msg1="在设置用户属性时发生错误:" & gg.errstring z1.delete SERVER.MapPath("free/" & mpath & "/mail") z1.delete SERVER.MapPath("free/" & mpath) set site1=z1.getsite(user & "." & application("domain")) z1.deletesite site1 z1.deleteftpdir user ff.arecord(user & "." & application("domain"))="" bb.DeleteUser user & "@" & application("domain"),511 bb.FreeUserDll else bb.FreeUserDll session("isok")="true" msg1="激活成功,您站点的域名是http://" & user & "." & application("domain") & "<br>" msg1=msg1 & "FTP地址:ftp://" & user & "." & application("domain") & "<br>" msg1=msg1 & "用户名: " & user & "<br>" msg1=msg1 & "邮箱:" & user & "@" & application("domain") & "<br>" msg1=msg1 & "密码:是您注册时填写的密码。<br><a href=\\\'logon.asp\\\'>登录</a><br>" end if end if end if end if end if end if end if end if end if UU.logoff set gg=nothing SET UU=nothing SET z1=nothing set bb=nothing Set mUserInfo =nothing set ff=nothing response.write msg1 %> logon.asp(域名重指向) <% user=trim(request("user")) pass=trim(request("pass")) IP=trim(request("IP")) if user<>"" then SET GG=SERVER.CREATEOBJECT("QWEB.USER") gg.logon application("admin") & "@" & application("domain"),application("adminpass") SET RR=GG.USER(user,application("group")) if gg.iserr then response.write "<font color=\\\'red\\\'>用户不存在!</font>" else gg.changepassword pass,"mypass",rr if gg.iserr then response.write "<font color=\\\'red\\\'>密码错误!</font>" else gg.changepassword "mypass",pass,rr set ff=createobject("qweb.dns") ff.logon application("domain"),application("dnsip"),application("dnsadmin"),application("dnsadminpass") if ip="" then ff.arecord(user & "." & application("domain"))=application("dnsip") else ff.arecord(user & "." & application("domain"))=ip end if if ff.iserr then response.write "设置失败,请重试!" else response.write "更新成功!" end if set ff=nothing end if end if set gg=nothing end if %> <h1 align="center">管 理</h1> <form name="form1" method="post" action="<% =request.ServerVariables("SCRIPT_NAME") %>"> <p>用户名: <input type="text" name="user"> </p> <p>密 码: <input type="password" name="pass"> </p> <p>把我的域名指向以下IP地址,假如为空则指向您的虚拟目录:</p> <p> <input type="text" name="IP"> </p> <p> <input type="submit" name="Submit" value="更改"> </p> </form> <p align="center"> </p> 返回类别: 教程 上一教程: 不用组件实现上载功能(1) 下一教程: ASP要害字函数运算符 您可以阅读与"如何用ASP代码实现虚拟主机"相关的教程: · 用纯ASP代码实现图片上传并存入数据库中(一) · 用ASP实现自动建站.实现虚拟二级目录 · 用纯ASP代码实现图片上传并存入数据库中(二) · MS IIS虚拟主机ASP源码泄露 (MS,缺陷) · 用纯ASP代码实现图片上传 |
![]() ![]() |
快精灵印艺坊 版权所有 |
首页![]() ![]() ![]() ![]() ![]() ![]() ![]() |