下面是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

〖责任编辑：〗 发表评论 告诉好友