用ASP.NET（VB版）创建WINDOWS 2000 SERVER站点

用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.Aclearcase/" target="_blank" >ccessScript = 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

原文转自：http://www.ltesting.net