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

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

config.xml(配置信息)

<Root_Element>
<admin>Administrator</admin>
<adminpass>xxxxxx</adminpass>
<readuser>IUSR_MACHINE</readuser>
<do>cocoo.net</do>
<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(配置文件)

<SCRIPTLANGUAGE=vbscriptRUNAT=Server>
SubApplication_OnStart
ff=server.createobject(\"microsoft.xmldom\")
ff.async=false
ff.loadserver.mappath(\"config.xml\")
rootElem=ff.document.lement
fore1=0torootElem.childNodes.length-1
application(trim(rootElem.childNodes.item(e1).nodeName))=trim(rootElem.childNodes.item(e1).text)
next
EndSub
</script>


index.asp(申请页面)

<%
user=trim(request(\"user\"))
pass=trim(request(\"pass\"))
email=trim(request(\"email\"))
user<>\"\"then
pass=\"\"orinstr(email,\"@\")<2then
response.write\"<fontcolor=\'red\'>填写</font>\"

SETGG=SERVER.CREATEOBJECT(\"QWEB.USER\")
gg.logonapplication(\"admin\")&\"@\"&application(\"do\"),application(\"adminpass\")
SETRR=GG.CREATE(user,application(\"group\"))
gg.iserrthen
response.write\"<fontcolor=\'red\'>不能创建用户:\"&gg.err&\"</font>\"

gg.value(\"pwdLastSet\",rr)=-1
gg.changepassword\"\",pass,rr
response.writegg.err
gg.value(\"accountdisabled\",rr)=TRUE
gg.value(\"accountexpirationdate\",rr)=now+2
gg.value(\"description\",rr)=session.SessionID
SETFF=CreateObject(\"QWEB.dns\")
don=right(email,len(email)-instr(email,\"@\"))
SETcc=CREATEOBJECT(\"qmail.mail\")
cc.sender=\"AA网络<[email protected]>\"
cc.receiver=email
cc.sendashtml=true
cc.subject=\"注册确认\"
cc.body=\"<ahref=\'\"&application(\"webdir\")&\"/active.asp?user=\"&user&\"&id=\"&session.SessionID&\"&pass=\"&pass&\"\'>谢谢您注册,请在24小时内(\"&(now+1)&\")激活您帐户</a>\"
vv=ff.mxrecord(application(\"dnsip\"),don)
HH=SPLIT(VV,\"\")
FORG=0TOUBOUND(HH)
cc.smtpsvr=hh(g)
cc.send
cc.errcode=truethenexitfor
next
cc.errcode=falhen
gg.deleterr
response.write\"<fontcolor=\'red\'>无法发送注册信息</font>\"

response.write\"<fontcolor=\'red\'>注册成功请24小时内查看邮件激活帐户.</font>\"
response.end
end
cc=nothing
ff=nothing
end
gg=nothing
end
end
%>
<h1align=\"center\">免费空间申请</h1>
<formname=\"form1\"method=\"post\"action=\"<%=request.ServerVariables(\"SCRIPT_NAME\")%>\">
<p>用户名:
<inputtype=\"text\"name=\"user\">
</p>
<p>密码:
<inputtype=\"password\"name=\"pass\">
</p>
<p>电子邮件:
<inputtype=\"text\"name=\"email\">
</p>
<p>
<inputtype=\"submit\"name=\"Submit\"value=\"现在申请\">


</p>
</form>
<palign=\"center\"></p>


active.asp(确认页面建立站点、开通FTP、EMAIL、配置DNS纪录)

<%
user=request(\"user\")
id=request(\"id\")
SETUU=SERVER.CREATEOBJECT(\"QWEB.MEMBER\")
SETGG=SERVER.CREATEOBJECT(\"QWEB.USER\")
SETz1=SERVER.CreateObject(\"QWEB.DIR\")
bb=server.createobject(\"MDUsercom.MDUser\")
SetmUserInfo=server.createobject(\"MDUsercom.MDUserInfo\")
ff=createobject(\"qweb.dns\")
UU.LOGONapplication(\"admin\")&\"@\"&application(\"do\"),application(\"adminpass\")
gg.logonapplication(\"admin\")&\"@\"&application(\"do\"),application(\"adminpass\")
SETRR=GG.user(user,application(\"group\"))
gg.iserrthen
msg1=\"获取用户资料时发生:\"&gg.err

gg.value(\"description\",rr)<>idor(gg.value(\"accountdisabled\",rr)=false)then
msg1=\"激活失败请您从邮箱内提示地址连接,或帐户在此的前已经被激活\"

mpath=session.sessionid
z1.CREATESERVER.MapPath(\"free/\"&mpath),user,application(\"readuser\")
z1.iserrthen
msg1=\"在创建用户目录时发生:\"&z1.err

z1.CREATESERVER.MapPath(\"free/\"&mpath&\"/mail\"),user,application(\"readuser\")
z1.iserrthen
msg1=\"在创建用户邮件目录时发生:\"&z1.err
z1.deleteSERVER.MapPath(\"free/\"&mpath)

SETSS=z1.CREATESITE(user&\".\"&application(\"do\"),SERVER.MapPath(\"free/\"&mpath))
z1.iserrthen
msg1=\"在创建站点时发生:\"&z1.err
z1.deleteSERVER.MapPath(\"free/\"&mpath&\"/mail\")
z1.deleteSERVER.MapPath(\"free/\"&mpath)

z1.createftpdiruser,SERVER.MapPath(\"free/\"&mpath)
z1.iserrthen
msg1=\"在创建FTP目录时发生:\"&z1.err
z1.deleteSERVER.MapPath(\"free/\"&mpath&\"/mail\")
z1.deleteSERVER.MapPath(\"free/\"&mpath)
site1=z1.getsite(user&\".\"&application(\"do\"))
z1.deletesitesite1

ff.logonapplication(\"do\"),application(\"dnsip\"),application(\"dnsadmin\"),application(\"dnsadminpass\")
ff.arecord(user&\".\"&application(\"do\"))=application(\"dnsip\")
ff.iserrthen
msg1=\"在写入DNS记录时发生:\"&ff.err
z1.deleteSERVER.MapPath(\"free/\"&mpath&\"/mail\")
z1.deleteSERVER.MapPath(\"free/\"&mpath)
site1=z1.getsite(user&\".\"&application(\"do\"))
z1.deletesitesite1
z1.deleteftpdiruser

bb.LoadUserDll
bb.inituserinfomuserinfo
muserinfo.fullname=user
muserinfo.mailbox=user
muserinfo.do=application(\"do\")
muserinfo.MailDir=SERVER.MapPath(\"free/\"&mpath&\"/mail\")
muserinfo.password=request(\"pass\")
muserinfo.MaxDiskSpace=25000000
muserinfo.ApplyQuotas=true
kk=bb.adduser(muserinfo)
kk<>\"0\"then
msg1=\"在创建用户邮箱时发生:\"&kk
z1.deleteSERVER.MapPath(\"free/\"&mpath&\"/mail\")
z1.deleteSERVER.MapPath(\"free/\"&mpath)
site1=z1.getsite(user&\".\"&application(\"do\"))
z1.deletesitesite1
z1.deleteftpdiruser
ff.arecord(user&\".\"&application(\"do\"))=\"\"

gg.value(\"accountexpirationdate\",rr)=gg.value(\"accountexpirationdate\",rr)+366
gg.value(\"accountdisabled\",rr)=false
gg.value(\"EmailAddress\",rr)=user&\"@\"&application(\"do\")
gg.value(\"HomeDirectory\",rr)=SERVER.MapPath(\"free/\"&mpath)
gg.iserrthen
msg1=\"在设置用户属性时发生:\"&gg.err
z1.deleteSERVER.MapPath(\"free/\"&mpath&\"/mail\")
z1.deleteSERVER.MapPath(\"free/\"&mpath)
site1=z1.getsite(user&\".\"&application(\"do\"))
z1.deletesitesite1
z1.deleteftpdiruser
ff.arecord(user&\".\"&application(\"do\"))=\"\"
bb.DeleteUseruser&\"@\"&application(\"do\"),511
bb.FreeUserDll

bb.FreeUserDll
session(\"isok\")=\"true\"
msg1=\"激活成功您站点域名是http://\"

;;&user&\".\"&application(\"do\")&\"<br>\"
msg1=msg1&\"FTP地址ftp://\";;&user&\".\"&application(\"do\")&\"<br>\"
msg1=msg1&\"用户名:\"&user&\"<br>\"
msg1=msg1&\"邮箱:\"&user&\"@\"&application(\"do\")&\"<br>\"
msg1=msg1&\"密码:是您注册时填写密码<br><ahref=\'logon.asp\'>登录</a><br>\"
end
end
end
end
end
end
end
end
end
UU.logoff
gg=nothing
SETUU=nothing
SETz1=nothing
bb=nothing
SetmUserInfo=nothing
ff=nothing
response.writemsg1
%>

logon.asp(域名重指向)

<%user=trim(request(\"user\"))
pass=trim(request(\"pass\"))
IP=trim(request(\"IP\"))
user<>\"\"then
SETGG=SERVER.CREATEOBJECT(\"QWEB.USER\")
gg.logonapplication(\"admin\")&\"@\"&application(\"do\"),application(\"adminpass\")
SETRR=GG.USER(user,application(\"group\"))
gg.iserrthen
response.write\"<fontcolor=\'red\'>用户不存在！</font>\"

gg.changepasswordpass,\"mypass\",rr
gg.iserrthen
response.write\"<fontcolor=\'red\'>密码！</font>\"

gg.changepassword\"mypass\",pass,rr
ff=createobject(\"qweb.dns\")
ff.logonapplication(\"do\"),application(\"dnsip\"),application(\"dnsadmin\"),application(\"dnsadminpass\")
ip=\"\"then
ff.arecord(user&\".\"&application(\"do\"))=application(\"dnsip\")

ff.arecord(user&\".\"&application(\"do\"))=ip
end
ff.iserrthen
response.write\"设置失败请重试！\"

response.write\"更新成功！\"
end
ff=nothing
end
end
gg=nothing
end
%>
<h1align=\"center\">管理</h1>
<formname=\"form1\"method=\"post\"action=\"<%=request.ServerVariables(\"SCRIPT_NAME\")%>\">
<p>用户名:
<inputtype=\"text\"name=\"user\">
</p>
<p>密码:
<inputtype=\"password\"name=\"pass\">
</p>
<p>把我域名指向以下IP地址如果为空则指向您虚拟目录:</p>
<p>
<inputtype=\"text\"name=\"IP\">
</p>
<p>
<inputtype=\"submit\"name=\"Submit\"value=\"更改\">
</p>
</form>
<palign=\"center\"></p>

延伸阅读