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()

        '创建设置主目录
        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