分享
 
 
 

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

王朝asp·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

创建虚拟主机大体牵扯到用户、站点、目录、FTP、DNS等几项内容,此外,可能还有EMAIL。QWEB组件对此做了较全面的封装,需要的可以和qaymuic@163.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网络<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">&nbsp;</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">&nbsp;</p>

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有