用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
