用ASP.NET（VB）創(chuàng)建的WEB站點(diǎn)，我們的調(diào)用方式非常簡單：
Dim test As New Class1()
test.CreateWebSit(webname,port, "D:\VB", "localhost")

下面是Class1的代碼，該代碼做的工作就是建立站點(diǎn)，如果有此站點(diǎn)的名稱則自動覆蓋（注意：本類需要引用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服務(wù)
WWWService = GetObject("IIS://" & ComputerName & "/W3SVC")
i = 1
HandleSameCase = True
On Error GoTo ErrWouldDo
'在IIS中查找每一個WEB站點(diǎn)
For Each WWWServer In WWWService
WWWServer = Nothing
WWWServer = GetObject("IIS://" & ComputerName & "/W3SVC/" & i)
'Debug.Print WWWServer.ServerComment
'如果在安裝時系統(tǒng)中已經(jīng)有了要加的站點(diǎn)，則要先刪除干凈
If UCase(WWWServer.ServerComment) = UCase(WWWSiteName) Then
WWWService.Delete("IISWebServer", i) '再刪除
Exit For
End If
ReDim TCPPort(1)
TCPPort(0) = ""
TCPPort = WWWServer.Serverbindings
'如果端口已經(jīng)有了則也要先刪除
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) '創(chuàng)建新站點(diǎn)
WWWServer.ServerComment = WWWSiteName '設(shè)置站點(diǎn)名
WWWServer.Serverbindings = ":" & WWWTCPPort & ":" '設(shè)置端口號
WWWServer.DefaultDoc = "default.asp,index.asp,default.htm,index.htm" '設(shè)置默認(rèn)啟動文件
WWWServer.AccessScript = True '設(shè)置權(quán)限
WWWServer.AccessRead = True
WWWServer.SetInfo()

'創(chuàng)建設(shè)置主目錄
WWWServer = GetObject("IIS://" & ComputerName & "/W3SVC/" & i)
WWWVdir = WWWServer.Create("IISWebVirtualDir", "root")
WWWVdir.Path = WWWFilesPath '主目錄的實(shí)際磁盤路徑
WWWVdir.SetInfo()
WWWVdir.AppCreate(True)
WWWServer.Start() '啟動新站點(diǎn)

'建立虛擬目錄
'Set WWWVdirRes = WWWVdir.Create("IISWebVirtualDir", "Resource") '創(chuàng)建虛擬目錄
'WWWVdirRes.Path = WWWFilesPath + "\Resource"
'WWWVdirRes.AccessRead = True
'WWWVdirRes.AccessWrite = True
'WWWVdirRes.SetInfo

'下面為自定義IIS Web Server的錯誤信息，等發(fā)生404錯誤時候指定調(diào)用網(wǎng)站主目錄下的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 服務(wù)器名（可以為localhost）
'DirName 要建立的虛擬目錄名
'LinkAddr 該虛擬目錄的真實(shí)路徑
'WWWSiteName 站點(diǎn)名稱
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服務(wù)
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 檢查是否該站點(diǎn)中已有該虛擬目錄
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 如果是因?yàn)闆]有找到該虛擬目錄出錯的話則進(jìn)行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