使用VB进行IIS的简单管理

'建立活动桌面'（IADS）对象,首先要引用 Active DS Type library 组件
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