如何用ASP代碼實現虛擬主機

  以下是創建一個虛擬主機的代碼：

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網絡<[email protected]>"
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>