如何用ASP代码实现虚拟主机

80酷酷网    80kuku.com

  虚拟主机
创建虚拟主机大体牵扯到用户、站点、目录、FTP、DNS等几项内容,此外,可能还有EMAIL。QWEB组件对此做了较全面的封装,需要的可以和qaymuic163.com联系。

以下是创建一个虚拟主机的代码:

config.xml(配置信息)

<Root_Element>
<admin>Administrator</admin>
<adminpass>xxxxxx</adminpass>
<readuser>IUSR_MACHINE</readuser>
<domain>cocoo.net</domain>
<dnsadmin>dnsadmin</dnsadmin>
<dnsadminpass>yyyyy</dnsadminpass>
<dnsip>10.1.143.227</dnsip>
<group>tryit</group>
<webdir>http://hanhong.cocoo.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网络<anyoneanyone.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&q

分享到
  • 微信分享
  • 新浪微博
  • QQ好友
  • QQ空间
点击: