asp.net|server|window|建立|網站 用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()
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
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
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
