Dim WWWServer As IADs, WWWService As IADs, WWWVDir, WWWVdirRes As IADs

Function CreateWebSite(ByVal WWWSiteName As String, _

     ByVal WWWSitePort As String, _

     ByVal WWWSitePath As String, _

     ByVal WWWHostName As String, _

     ByVal ComputerName As String) As Boolean

     '变量定义

    Dim SiteExist As Boolean

     Dim WebName

     '变量初始化

    SiteExist = False

     WebName = 1

     CreateWebSite = True

     On Error Resume Next

     Err.Clear

     '取得W3SVC服务

    Set WWWService = GetObject("IIS://" & ComputerName & "/W3SVC")

     Do While Err.Number <> 0

         Err.Clear

         Set WWWService = GetObject("IIS://" & ComputerName & "/W3SVC")

     Loop

     Err.Clear

     '出错处理

    '在IIS中查找每一个WEB站点

    For Each WWWServer In WWWService

         If UCase(Trim(WWWServer.ServerComment)) <> UCase(Trim(WWWSiteName)) Then

             If IsNumeric(WWWServer.Name) Then

                 If CInt(WWWServer.Name) >= WebName Then WebName = CInt(WWWServer.Name) + 1

             End If

         Else

             SiteExist = True

             Exit For

         End If

     Next

     If SiteExist Then

         MsgBox "该站点已经存在！", vbInformation + vbOKOnly, "系统信息"

         Exit Function

     End If

     '创建WebServer

     Set WWWServer = WWWService.Create("IISWebServer", WebName) '创建新站点

    WWWServer.ServerComment = WWWSiteName '设置站点名

    WWWServer.KeyType = "IISWebServer"

     WWWServer.ServerBindings = ":" & WWWSitePort & ":" & WWWHostName '设置端口号和主机头

    WWWServer.DefaultDoc = "Default.asp,Index.asp,Default.htm,Index.htm" '设置默认启动文件

    WWWServer.AccessScript = True '设置权限

    WWWServer.AccessRead = True

     WWWServer.FrontPageWeb = True

     WWWServer.EnableDefaultDoc = True

     WWWServer.DefaultDoc = "Default.htm, Default.asp, Index.htm, Index.asp"

     Set WWWVDir = WWWServer.Create("IISWebVirtualDir", "Root")

     WWWVDir.Path = WWWSitePath

     WWWVDir.AppCreate True

     WWWVDir.SetInfo

     WWWServer.SetInfo

     WWWServer.Start

     MsgBox "主机设置成功！", vbInformation + vbOKOnly, "系统信息"

     '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

     CreateWebSite = True

 End Function

Function DeleteWebSite(ByVal WWWSiteName As String, ByVal ComputerName As String) As Boolean

     '定义变量

    Dim Tmp As Integer

     Dim WebName

     Dim SiteExist As Boolean

     '变量初始化

    SiteExist = False

     DeleteWebSite = True

     '取得W3SVC服务

    On Error Resume Next

     Err.Clear

     Set WWWService = GetObject("IIS://" & ComputerName & "/W3SVC")

     Do While Err.Number <> 0

         Err.Clear

         Set WWWService = GetObject("IIS://" & ComputerName & "/W3SVC")

     Loop

     Err.Clear

     For Each WWWServer In WWWService

         If UCase(Trim(WWWServer.ServerComment)) <> UCase(Trim(WWWSiteName)) Then

             SiteExist = False

         Else

             If IsNumeric(WWWServer.Name) Then

                 WebName = WWWServer.Name

             End If

             SiteExist = True

             Exit For

         End If

     Next

     '删除站点

    WWWService.Delete "IISWebServer", WebName

     MsgBox "主机删除成功！", vbInformation + vbOKOnly, "系统信息"

End Function

Private Sub cmdCreateWebSite_Click()

     CreateWebSite txtSiteName.Text, txtSitePort.Text, txtSitePath.Text, txtHostName.Text, txtComputerName.Text

 End Sub

Private Sub cmdDeleteWebSite_Click()

     DeleteWebSite txtSiteName.Text, txtComputerName.Text

 End Sub