每段都是一个文件，代码如下：
Imports System
Imports System.DirectoryServices
Imports System.Collections
Namespace OPS.Component
' IISWebServer的状态
Public Enum IISServerState
Starting = 1
Started = 2
Stopping = 3
Stopped = 4
Pausing = 5
Paused = 6
Continuing = 7
End Enum
End Namespace
Imports System
Imports System.Collections
Imports System.Collections.Generic
Imports System.Text
Imports System.DirectoryServices
Namespace OPS.Component
'IISWebServer
Public Class IISWebServer
Friend index As Integer = -1
Public WebVirtualDirs As IISWebVirtualDirCollection
''' <summary>
''' 网站说明
''' </summary>
Public ServerComment As String = "Way"
''' <summary>
''' 脚本支持
''' </summary>
Public AccessScript As Boolean = True
''' <summary>
''' 读取
''' </summary>
Public AccessRead As Boolean = True
''' <summary>
''' 物理路径
''' </summary>
Public Path As String = "c:\"
''' <summary>
''' 端口
''' </summary>
Public Port As Integer = 80
''' <summary>
''' 目录浏览
''' </summary>
Public EnableDirBrowsing As Boolean = False
''' <summary>
''' 默认文档
''' </summary>
Public DefaultDoc As String = "index.aspx"
''' <summary>
''' 使用默认文档
''' </summary>
Public EnableDefaultDoc As Boolean = True
''' <summary>
''' IISWebServer的状态
''' </summary>
Public ReadOnly Property ServerState() As IISServerState
Get
Dim server As DirectoryEntry = IISManagement.returnIISWebserver(Me.index)
If server Is Nothing Then
Throw (New Exception("找不到此IISWebServer"))
End If
Select Case server.Properties("ServerState")(0).ToString()
Case "2"
Return IISServerState.Started
Case "4"
Return IISServerState.Stopped
Case "6"
Return IISServerState.Paused
End Select
Return IISServerState.Stopped
End Get
End Property
''' <summary>
''' 停止IISWebServer
''' </summary>
Public Sub [Stop]()
Dim Server As DirectoryEntry
If index = -1 Then
Throw (New Exception("在IIS找不到此IISWebServer!"))
End If
Try
Server = New DirectoryEntry("IIS://" + IISManagement.Machinename + "/W3SVC/" + index)
If Server IsNot Nothing Then
Server.Invoke("stop", New Object(-1) {})
Else
Throw (New Exception("在IIS找不到此IISWebServer!"))
End If
Catch
Throw (New Exception("在IIS找不到此IISWebServer!"))
End Try
End Sub
''' <summary>
''' 把基本信息的更改更新到IIS
''' </summary>
Public Sub CommitChanges()
IISManagement.EditIISWebServer(Me)
End Sub
''' <summary>
''' 启动IISWebServer
''' </summary>
Public Sub Start()
If index = -1 Then
Throw (New Exception("在IIS找不到此IISWebServer!"))
End If
Dim Service As New DirectoryEntry("IIS://" + IISManagement.Machinename + "/W3SVC")
Dim Server As DirectoryEntry
Dim ie As IEnumerator = Service.Children.GetEnumerator()
While ie.MoveNext()
Server = DirectCast(ie.Current, DirectoryEntry)
If Server.SchemaClassName = "IIsWebServer" Then
If Server.Properties("Serverbindings")(0).ToString() = ":" + Me.Port + ":" Then
Server.Invoke("stop", New Object(-1) {})
End If
End If
End While
Try
Server = New DirectoryEntry("IIS://" + IISManagement.Machinename + "/W3SVC/" + index)
If Server IsNot Nothing Then
Server.Invoke("start", New Object(-1) {})
Else
Throw (New Exception("在IIS找不到此IISWebServer!"))
End If
Catch
Throw (New Exception("在IIS找不到此IISWebServer!"))
End Try
End Sub
Public Sub New()
WebVirtualDirs = New IISWebVirtualDirCollection(Me)
End Sub
End Class
End Namespace
Imports System
Imports System.Collections
Imports System.Collections.Generic
Imports System.Text
Namespace OPS.Component
''' <summary>
''' IISWebServerCollection
''' </summary>
Public Class IISWebServerCollection
Inherits CollectionBase
Default Public ReadOnly Property Item(ByVal Index As Integer) As IISWebServer
Get
Return DirectCast(Me.List(Index), IISWebServer)
End Get
End Property
Default Public ReadOnly Property Item(ByVal ServerComment As String) As IISWebServer
Get
ServerComment = ServerComment.ToLower().Trim()
Dim list As IISWebServer
For i As Integer = 0 To Me.List.Count - 1
list = DirectCast(Me.List(i), IISWebServer)
If list.ServerComment.ToLower().Trim() = ServerComment Then
Return list
End If
Next
Return Nothing
End Get
End Property
Friend Sub Add_(ByVal WebServer As IISWebServer)
Me.List.Add(WebServer)
End Sub
Public Sub Add(ByVal WebServer As IISWebServer)
Try
Me.List.Add(WebServer)
IISManagement.CreateIISWebServer(WebServer)
Catch
Throw (New Exception("发生意外错误，可能是某节点将该节点的上级节点作为它自己的子级插入"))
End Try
End Sub
''' <summary>
''' 是否包含指定的网站
''' </summary>
''' <param name="ServerComment"></param>
''' <returns></returns>
Public Function Contains(ByVal ServerComment As String) As Boolean
ServerComment = ServerComment.ToLower().Trim()
For i As Integer = 0 To Me.List.Count - 1
Dim server As IISWebServer = Me(i)
If server.ServerComment.ToLower().Trim() = ServerComment Then
Return True
End If
Next
Return False
End Function
''' <summary>
''' 是否包含指定的网站
''' </summary>
''' <param name="index"></param>
''' <returns></returns>
Public Function Contains(ByVal index As Integer) As Boolean
For i As Integer = 0 To Me.List.Count - 1
Dim server As IISWebServer = Me(i)
If server.index = index Then
Return True
End If
Next
Return False
End Function
Public Sub AddRange(ByVal WebServers As IISWebServer())
For i As Integer = 0 To WebServers.GetUpperBound(0)
Add(WebServers(i))
Next
End Sub
Public Sub Remove(ByVal WebServer As IISWebServer)
For i As Integer = 0 To Me.List.Count - 1
If DirectCast(Me.List(i), IISWebServer) = WebServer Then
Me.List.RemoveAt(i)
Return
End If
Next
IISManagement.RemoveIISWebServer(WebServer.index)
End Sub
End Class
End Namespace
Imports System
Imports System.Collections.Generic
Imports System.Text
Namespace OPS.Component
''' <summary>
''' IISWebVirtualDir
''' </summary>
Public Class IISWebVirtualDir
Public Parent As IISWebServer = Nothing
''' <summary>
''' 虚拟目录名称
''' </summary>
Public Name As String = "Way"
''' <summary>
''' 读取
''' </summary>
Public AccessRead As Boolean = True
''' <summary>
''' 脚本支持
''' </summary>
Public AccessScript As Boolean = True
''' <summary>
''' 物理路径
''' </summary>
Public Path As String = "c:\"
''' <summary>
''' 默认文档
''' </summary>
Public DefaultDoc As String = "index.aspx"
''' <summary>
''' 使用默认文档
''' </summary>
Public EnableDefaultDoc As Boolean = True
''' <summary>
''' 所属的网站的网站说明
''' </summary>
Public WebServer As String = ""
Public Sub New(ByVal WebServerName As String)
If WebServerName.ToString() = "" Then
Throw (New Exception("WebServerName不能为空!"))
End If
Me.WebServer = WebServerName
End Sub
Public Sub New()
End Sub
End Class
End Namespace
Imports System
Imports System.Collections
Imports System.Collections.Generic
Imports System.Text
Namespace OPS.Component
''' <summary>
''' IISWebVirtualDirCollection
''' </summary>
Public Class IISWebVirtualDirCollection
Inherits CollectionBase
Public Parent As IISWebServer = Nothing
Default Public ReadOnly Property Item(ByVal Index As Integer) As IISWebVirtualDir
Get
Return DirectCast(Me.List(Index), IISWebVirtualDir)
End Get
End Property
Default Public ReadOnly Property Item(ByVal Name As String) As IISWebVirtualDir
Get
Name = Name.ToLower()
Dim list As IISWebVirtualDir
For i As Integer = 0 To Me.List.Count - 1
list = DirectCast(Me.List(i), IISWebVirtualDir)
If list.Name.ToLower() = Name Then
Return list
End If
Next
Return Nothing
End Get
End Property
Friend Sub Add_(ByVal WebVirtualDir As IISWebVirtualDir)
Try
Me.List.Add(WebVirtualDir)
Catch
Throw (New Exception("发生意外错误，可能是某节点将该节点的上级节点作为它自己的子级插入"))
End Try
End Sub
Public Sub Add(ByVal WebVirtualDir As IISWebVirtualDir)
WebVirtualDir.Parent = Me.Parent
Try
Me.List.Add(WebVirtualDir)
Catch
Throw (New Exception("发生意外错误，可能是某节点将该节点的上级节点作为它自己的子级插入"))
End Try
IISManagement.CreateIISWebVirtualDir(WebVirtualDir, True)
End Sub
Public Sub AddRange(ByVal WebVirtualDirs As IISWebVirtualDir())
For i As Integer = 0 To WebVirtualDirs.GetUpperBound(0)
Add(WebVirtualDirs(i))
Next
End Sub
Public Sub Remove(ByVal WebVirtualDir As IISWebVirtualDir)
For i As Integer = 0 To Me.List.Count - 1
If DirectCast(Me.List(i), IISWebVirtualDir) = WebVirtualDir Then
Me.List.RemoveAt(i)
IISManagement.RemoveIISWebVirtualDir(WebVirtualDir)
Return
End If
Next
End Sub
Public Sub New(ByVal Parent As IISWebServer)
Me.Parent = Parent
End Sub
End Class
End Namespace
Imports System
Imports System.Collections
Imports System.Collections.Generic
Imports System.Text
Imports System.DirectoryServices
Namespace OPS.Component
''' <summary>
''' IISManagement 的摘要说明。
''' </summary>
Public Class IISManagement
Public WebServers As New IISWebServerCollection()
Friend Shared Machinename As String = "localhost"
Public Sub New()
start()
End Sub
''' <param name="MachineName">机器名,默认值为localhost</param>
Public Sub New(ByVal MachineName__1 As String)
If MachineName__1.ToString() <> "" Then
Machinename = MachineName__1
End If
start()
End Sub
Private Sub start()
Dim Service As New DirectoryEntry("IIS://" + Machinename + "/W3SVC")
Dim Server As DirectoryEntry
Dim Root As DirectoryEntry = Nothing
Dim VirDir As DirectoryEntry
Dim ie As IEnumerator = Service.Children.GetEnumerator()
Dim ieRoot As IEnumerator
Dim item As IISWebServer
Dim item_virdir As IISWebVirtualDir
Dim finded As Boolean = False
While ie.MoveNext()
Server = DirectCast(ie.Current, DirectoryEntry)
If Server.SchemaClassName = "IIsWebServer" Then
item = New IISWebServer()
item.index = Convert.ToInt32(Server.Name)
item.ServerComment = DirectCast(Server.Properties("ServerComment")(0), String)
item.AccessRead = CBool(Server.Properties("AccessRead")(0))
item.AccessScript = CBool(Server.Properties("AccessScript")(0))
item.DefaultDoc = DirectCast(Server.Properties("DefaultDoc")(0), String)
item.EnableDefaultDoc = CBool(Server.Properties("EnableDefaultDoc")(0))
item.EnableDirBrowsing = CBool(Server.Properties("EnableDirBrowsing")(0))
ieRoot = Server.Children.GetEnumerator()
While ieRoot.MoveNext()
Root = DirectCast(ieRoot.Current, DirectoryEntry)
If Root.SchemaClassName = "IIsWebVirtualDir" Then
finded = True
Exit While
End If
End While
If finded Then
item.Path = Root.Properties("path")(0).ToString()
End If
item.Port = Convert.ToInt32(DirectCast(Server.Properties("Serverbindings")(0), String).Substring(1, (DirectCast(Server.Properties("Serverbindings")(0), String)).Length - 2))
Me.WebServers.Add_(item)
ieRoot = Root.Children.GetEnumerator()
While ieRoot.MoveNext()
VirDir = DirectCast(ieRoot.Current, DirectoryEntry)
If VirDir.SchemaClassName <> "IIsWebVirtualDir" AndAlso VirDir.SchemaClassName <> "IIsWebDirectory" Then
Continue While
End If
item_virdir = New IISWebVirtualDir(item.ServerComment)
item_virdir.Name = VirDir.Name
item_virdir.AccessRead = CBool(VirDir.Properties("AccessRead")(0))
item_virdir.AccessScript = CBool(VirDir.Properties("AccessScript")(0))
item_virdir.DefaultDoc = DirectCast(VirDir.Properties("DefaultDoc")(0), String)
item_virdir.EnableDefaultDoc = CBool(VirDir.Properties("EnableDefaultDoc")(0))
If VirDir.SchemaClassName = "IIsWebVirtualDir" Then
item_virdir.Path = DirectCast(VirDir.Properties("Path")(0), String)
ElseIf VirDir.SchemaClassName = "IIsWebDirectory" Then
item_virdir.Path = Root.Properties("Path")(0) + "\" + VirDir.Name
End If
item.WebVirtualDirs.Add_(item_virdir)
End While
End If
End While
End Sub
''' <summary>
''' 创建站点
''' </summary>
''' <param name="iisServer"></param>
Public Shared Sub CreateIISWebServer(ByVal iisServer As IISWebServer)
If iisServer.ServerComment.ToString() = "" Then
Throw (New Exception("IISWebServer的ServerComment不能为空!"))
End If
Dim Service As New DirectoryEntry("IIS://" + IISManagement.Machinename + "/W3SVC")
Dim Server As DirectoryEntry
Dim i As Integer = 0
Dim ie As IEnumerator = Service.Children.GetEnumerator()
While ie.MoveNext()
Server = DirectCast(ie.Current, DirectoryEntry)
If Server.SchemaClassName = "IIsWebServer" Then
If Convert.ToInt32(Server.Name) > i Then
i = Convert.ToInt32(Server.Name)
End If
End If
End While
i += 1
Try
iisServer.index = i
Server = Service.Children.Add(i.ToString(), "IIsWebServer")
Server.Properties("ServerComment")(0) = iisServer.ServerComment
Server.Properties("Serverbindings").Add(":" + iisServer.Port + ":")
Server.Properties("AccessScript")(0) = iisServer.AccessScript
Server.Properties("AccessRead")(0) = iisServer.AccessRead
Server.Properties("EnableDirBrowsing")(0) = iisServer.EnableDirBrowsing
Server.Properties("DefaultDoc")(0) = iisServer.DefaultDoc
Server.Properties("EnableDefaultDoc")(0) = iisServer.EnableDefaultDoc
Dim root As DirectoryEntry = Server.Children.Add("Root", "IIsWebVirtualDir")
root.Properties("path")(0) = iisServer.Path
Service.CommitChanges()
Server.CommitChanges()
root.CommitChanges()
root.Invoke("AppCreate2", New Object(0) {2})
'Server.Invoke("start",new object[0]);
Catch es As Exception
Throw (es)
End Try
End Sub
''' <summary>
''' 删除IISWebServer
''' </summary>
Public Shared Sub RemoveIISWebServer(ByVal ServerComment As String)
Dim Service As New DirectoryEntry("IIS://" + IISManagement.Machinename + "/W3SVC")
Dim Server As DirectoryEntry
Dim ie As IEnumerator = Service.Children.GetEnumerator()
ServerComment = ServerComment.ToLower()
While ie.MoveNext()
Server = DirectCast(ie.Current, DirectoryEntry)
If Server.SchemaClassName = "IIsWebServer" Then
If Server.Properties("ServerComment")(0).ToString().ToLower() = ServerComment Then
Service.Children.Remove(Server)
Service.CommitChanges()
Return
End If
End If
End While
End Sub
''' <summary>
''' 删除IISWebServer
''' </summary>
Public Shared Sub RemoveIISWebServer(ByVal index As Integer)
Dim Service As New DirectoryEntry("IIS://" + IISManagement.Machinename + "/W3SVC")
Try
Dim Server As New DirectoryEntry("IIS://" + IISManagement.Machinename + "/W3SVC/" + index)
If Server IsNot Nothing Then
Service.Children.Remove(Server)
Service.CommitChanges()
Else
Throw (New Exception("找不到此IISWebServer"))
End If
Catch
Throw (New Exception("找不到此IISWebServer"))
End Try
End Sub
''' <summary>
''' 检查是否存在IISWebServer
''' </summary>
''' <param name="ServerComment">网站说明</param>
''' <returns></returns>
Public Shared Function ExistsIISWebServer(ByVal ServerComment As String) As Boolean
ServerComment = ServerComment.Trim()
Dim Service As New DirectoryEntry("IIS://" + IISManagement.Machinename + "/W3SVC")
Dim Server As DirectoryEntry = Nothing
Dim ie As IEnumerator = Service.Children.GetEnumerator()
Dim comment As String
While ie.MoveNext()
Server = DirectCast(ie.Current, DirectoryEntry)
If Server.SchemaClassName = "IIsWebServer" Then
comment = Server.Properties("ServerComment")(0).ToString().ToLower().Trim()
If comment = ServerComment.ToLower() Then
Return True
End If
End If
End While
Return False
End Function
''' <summary>
''' 返回指定的IISWebServer
''' </summary>
''' <param name="ServerComment"></param>
''' <returns></returns>
Friend Shared Function returnIISWebserver(ByVal ServerComment As String) As DirectoryEntry
ServerComment = ServerComment.Trim()
Dim Service As New DirectoryEntry("IIS://" + IISManagement.Machinename + "/W3SVC")
Dim Server As DirectoryEntry = Nothing
Dim ie As IEnumerator = Service.Children.GetEnumerator()
Dim comment As String
While ie.MoveNext()
Server = DirectCast(ie.Current, DirectoryEntry)
If Server.SchemaClassName = "IIsWebServer" Then
comment = Server.Properties("ServerComment")(0).ToString().ToLower().Trim()
If comment = ServerComment.ToLower() Then
Return Server
End If
End If
End While
Return Nothing
End Function
''' <summary>
''' 返回指定的IISWebServer
''' </summary>
''' <param name="index"></param>
''' <returns></returns>
Friend Shared Function returnIISWebserver(ByVal index As Integer) As DirectoryEntry
Dim Server As New DirectoryEntry("IIS://" + IISManagement.Machinename + "/W3SVC/" + index)
Try
Dim ie As IEnumerator = Server.Children.GetEnumerator()
Return Server
Catch
Return Nothing
End Try
End Function
Private Shared Function getRoot(ByVal Server As DirectoryEntry) As DirectoryEntry
For Each child As DirectoryEntry In Server.Children
Dim name As String = child.Name.ToLower()
If name = "iiswebvirtualdir" OrElse name = "root" Then
Return child
End If
Next
Return Nothing
End Function
''' <summary>
''' 修改与给定的IISWebServer具有相同网站说明的站点配置
''' </summary>
''' <param name="iisServer">给定的IISWebServer</param>
Public Shared Sub EditIISWebServer(ByVal iisServer As IISWebServer)
If iisServer.index = -1 Then
Throw (New Exception("找不到给定的站点!"))
End If
Dim Service As New DirectoryEntry("IIS://" + IISManagement.Machinename + "/W3SVC")
Dim Server As DirectoryEntry
Dim ie As IEnumerator = Service.Children.GetEnumerator()
While ie.MoveNext()
Server = DirectCast(ie.Current, DirectoryEntry)
If Server.SchemaClassName = "IIsWebServer" Then
If Server.Properties("Serverbindings")(0).ToString() = ":" + iisServer.Port + ":" Then
Server.Invoke("stop", New Object(-1) {})
End If
End If
End While
Server = returnIISWebserver(iisServer.index)
If Server Is Nothing Then
Throw (New Exception("找不到给定的站点!"))
End If
Try
Server.Properties("ServerComment")(0) = iisServer.ServerComment
Server.Properties("Serverbindings")(0) = ":" + iisServer.Port + ":"
Server.Properties("AccessScript")(0) = iisServer.AccessScript
Server.Properties("AccessRead")(0) = iisServer.AccessRead
Server.Properties("EnableDirBrowsing")(0) = iisServer.EnableDirBrowsing
Server.Properties("DefaultDoc")(0) = iisServer.DefaultDoc
Server.Properties("EnableDefaultDoc")(0) = iisServer.EnableDefaultDoc
Dim root As DirectoryEntry = getRoot(Server)
Server.CommitChanges()
If root IsNot Nothing Then
root.Properties("path")(0) = iisServer.Path
root.CommitChanges()
End If
Server.Invoke("start", New Object(-1) {})
Catch es As Exception
Throw (es)
End Try
End Sub
''' <summary>
''' 返回所有站点的网站说明
''' </summary>
''' <returns></returns>
Public Shared Function returnIISServerComment() As ArrayList
Dim Service As New DirectoryEntry("IIS://" + IISManagement.Machinename + "/W3SVC")
Dim Server As DirectoryEntry
Dim list As New ArrayList()
Dim ie As IEnumerator = Service.Children.GetEnumerator()
While ie.MoveNext()
Server = DirectCast(ie.Current, DirectoryEntry)
If Server.SchemaClassName = "IIsWebServer" Then
list.Add(Server.Properties("ServerComment")(0))
End If
End While
Return list
End Function
''' <summary>
''' 创建虚拟目录
''' </summary>
''' <param name="iisVir"></param>
''' <param name="deleteIfExist"></param>
Public Shared Sub CreateIISWebVirtualDir(ByVal iisVir As IISWebVirtualDir, ByVal deleteIfExist As Boolean)
If iisVir.Parent Is Nothing Then
Throw (New Exception("IISWebVirtualDir没有所属的IISWebServer!"))
End If
Dim Service As New DirectoryEntry("IIS://" + IISManagement.Machinename + "/W3SVC")
Dim Server As DirectoryEntry = returnIISWebserver(iisVir.Parent.index)
If Server Is Nothing Then
Throw (New Exception("找不到给定的站点!"))
End If
Server = getRoot(Server)
If deleteIfExist Then
For Each VirDir As DirectoryEntry In Server.Children
If VirDir.Name.ToLower().Trim() = iisVir.Name.ToLower() Then
Server.Children.Remove(VirDir)
Server.CommitChanges()
Exit For
End If
Next
End If
Try
Dim vir As DirectoryEntry
vir = Server.Children.Add(iisVir.Name, "IIsWebVirtualDir")
vir.Properties("Path")(0) = iisVir.Path
vir.Properties("DefaultDoc")(0) = iisVir.DefaultDoc
vir.Properties("EnableDefaultDoc")(0) = iisVir.EnableDefaultDoc
vir.Properties("AccessScript")(0) = iisVir.AccessScript
vir.Properties("AccessRead")(0) = iisVir.AccessRead
vir.Invoke("AppCreate2", New Object(0) {2})
Server.CommitChanges()
vir.CommitChanges()
Catch es As Exception
Throw (es)
End Try
End Sub
''' <summary>
''' 删除虚拟目录
''' </summary>
''' <param name="WebServerComment">站点说明</param>
''' <param name="VirtualDir">虚拟目录名称</param>
Public Shared Sub RemoveIISWebVirtualDir(ByVal WebServerComment As String, ByVal VirtualDir As String)
VirtualDir = VirtualDir.ToLower()
Dim Service As New DirectoryEntry("IIS://" + IISManagement.Machinename + "/W3SVC")
Dim Server As DirectoryEntry = returnIISWebserver(WebServerComment)
If Server Is Nothing Then
Throw (New Exception("找不到给定的站点!"))
End If
Server = getRoot(Server)
For Each VirDir As DirectoryEntry In Server.Children
If VirDir.Name.ToLower().Trim() = VirtualDir Then
Server.Children.Remove(VirDir)
Server.CommitChanges()
Return
End If
Next
Throw (New Exception("找不到给定的虚拟目录!"))
End Sub
''' 删除虚拟目录
Public Shared Sub RemoveIISWebVirtualDir(ByVal iisVir As IISWebVirtualDir)
Dim Service As New DirectoryEntry("IIS://" + IISManagement.Machinename + "/W3SVC")
Dim Server As DirectoryEntry = returnIISWebserver(iisVir.Parent.index)
If Server Is Nothing Then
Throw (New Exception("找不到给定的站点!"))
End If
Server = getRoot(Server)
For Each VirDir As DirectoryEntry In Server.Children
If VirDir.Name.ToLower().Trim() = iisVir.Name.ToLower() Then
Server.Children.Remove(VirDir)
Server.CommitChanges()
Return
End If
Next
Throw (New Exception("找不到给定的虚拟目录!"))
End Sub
End Class
End Namespace
PS：参考版为C#，来源已无法考证。