当前页面位置: » 丰搜网 » 文档中心 » 详细内容
用asp.net（vb版）创建windows 2000 server站点
用asp.net（vb）创建的web站点，我们的调用方式非常简单：
dim test as new class1()
test.createwebsit(webname,port, "d:\vb", "localhost")
下面是class1的代码，该代码做的工作就是建立站点，如果有此站点的名称则自动覆盖（注意：本类需要引用actice ds type library）
public class class1
用localhost
'===========================
function createwebsit(byval wwwsitename as string, _
byval wwwtcpport as string, _
byval wwwfilespath as string, _
byval computername as string) as boolean
createwebsit = true
dim tcpport() as object
'建立活动桌面'（iads）对象。首先要在 vb 中的 'prject'菜单中的'references'中引'用 active ds 'type 'library 组件
dim wwwserver as activeds.iads
dim wwwservice
dim wwwvdir, wwwvdir2, wwwvdirres as activeds.iads
dim i as integer
dim handlesamecase as boolean
'取得w3svc服务
wwwservice = getobject("iis://" & computername & "/w3svc")
i = 1
handlesamecase = true
on error goto errwoulddo
'在iis中查找每一个web站点
for each wwwserver in wwwservice
wwwserver = nothing
wwwserver = getobject("iis://" & computername & "/w3svc/" & i)
'debug.print wwwserver.servercomment
'如果在安装时系统中已经有了要加的站点，则要先删除干净
if ucase(wwwserver.servercomment) = ucase(wwwsitename) then
wwwservice.delete("iiswebserver", i) '再删除
exit for
end if
redim tcpport(1)
tcpport(0) = ""
tcpport = wwwserver.serverbindings
'如果端口已经有了则也要先删除
if tcpport(0) = ":" & wwwtcpport & ":" then
wwwservice.delete("iiswebserver", i) '删除
else
i = i + 1
end if
next
handlesamecase = false
createsite:
'msgbox i
wwwserver = wwwservice.create("iiswebserver", i) '创建新站点
wwwserver.servercomment = wwwsitename '设置站点名
wwwserver.serverbindings = ":" & wwwtcpport & ":" '设置端口号
wwwserver.defaultdoc = "default.asp,index.asp,default.htm,index.htm" '设置默认启动文件
wwwserver.accessscript = true '设置权限
wwwserver.accessread = true
wwwserver.setinfo()
'创建设置主目录
wwwserver = getobject("iis://" & computername & "/w3svc/" & i)
wwwvdir = wwwserver.create("iiswebvirtualdir", "root")
wwwvdir.path = wwwfilespath '主目录的实际磁盘路径
wwwvdir.setinfo()
wwwvdir.appcreate(true)
wwwserver.start() '启动新站点
'建立虚拟目录
'set wwwvdirres = wwwvdir.create("iiswebvirtualdir", "resource") '创建虚拟目录
'wwwvdirres.path = wwwfilespath + "\resource"
'wwwvdirres.accessread = true
'wwwvdirres.accesswrite = true
'wwwvdirres.setinfo
'下面为自定义iis web server的错误信息，等发生404错误时候指定调用网站主目录下的404.htm页面显示
wwwserver.httperrors = "404,0,file," + wwwfilespath + "\404.htm"
wwwserver.setinfo()
createwebsit = true
exit function
errwoulddo:
'msgbox err.description
if (handlesamecase = true) then
goto createsite
else
msgbox(err.description)
createwebsit = false
exit function
end if
end function
rem 建立虚拟目录程序
'computername 服务器名（可以为localhost）
'dirname 要建立的虚拟目录名
'linkaddr 该虚拟目录的真实路径
'wwwsitename 站点名称
function createvirtualdir(byval computername as string, _
byval dirname as string, byval linkaddr as string, _
byval wwwsitename as string) as boolean
dim i as integer
createvirtualdir = true
'取得w3svc服务
dim wwwserver as activeds.iads
dim wwwservice
wwwservice = getobject("iis://" & computername & "/w3svc")
i = 1
dim handlesamecase as boolean
handlesamecase = true
dim temp as boolean
temp = false
for each wwwserver in wwwservice
wwwserver = nothing
wwwserver = getobject("iis://" & computername & "/w3svc/" & i)
if ucase(wwwserver.servercomment) = ucase(wwwsitename) then
temp = true
exit for
end if
i = i + 1
next
if not temp then
createvirtualdir = false
exit function
end if
dim wwwvirtualdir, wwwif as activeds.iads
wwwserver = getobject("iis://" & computername & "/w3svc/" & i & "/root")
rem 检查是否该站点中已有该虚拟目录
on error goto errhandle
wwwif = getobject("iis://" & computername & "/w3svc/" & i & "/root/" & dirname)
rem 如果有，则返回false
if wwwif.name <> "" then
createvirtualdir = false
exit function
end if
errhandle:
'debug.print err.number
if err.number = -2147024893 then
err.clear()
rem 如果是因为没有找到该虚拟目录出错的话则进行createvirtualdir建立虚拟目录
goto returncreate
else
createvirtualdir = false
exit function
end if
rem 建立虚拟目录
returncreate:
wwwvirtualdir = wwwserver.create("iiswebvirtualdir", dirname)
wwwvirtualdir.path = linkaddr
wwwvirtualdir.accessread = true
wwwvirtualdir.accessscript = true
wwwvirtualdir.appcreate(true)
wwwvirtualdir.setinfo()
createvirtualdir = true
end function
function getdbconnstr(byval dbname as string) as string
select case dbname
case "friend"
getdbconnstr = cstr(getsetting("hosttask", "dbini", "connstr"))
case "wuye"
getdbconnstr = replace$(cstr(getsetting("hosttask", "dbini", "connstr")), "friend", "wuye")
case else
getdbconnstr = cstr(getsetting("hosttask", "dbini", "connstr"))
end select
end function
end class
