Imports System.DirectoryServices
Imports System.Web

Public Class clsIIS
    Public Function AddVirDir(ByVal SiteUrl As String, ByVal SiteName As String, ByVal SitePort As String) As String
        Dim ScriptMaps As String = ".asp,C:\WINDOWS\system32\inetsrv\asp.dll,5,GET,HEAD,POST,TRACE" & vbCrLf & _
        ".cer,C:\WINDOWS\system32\inetsrv\asp.dll,5,GET,HEAD,POST,TRACE" & vbCrLf & _
        ".cdx,C:\WINDOWS\system32\inetsrv\asp.dll,5,GET,HEAD,POST,TRACE" & vbCrLf & _
        ".asa,C:\WINDOWS\system32\inetsrv\asp.dll,5,GET,HEAD,POST,TRACE" & vbCrLf & _
        ".idc,C:\WINDOWS\system32\inetsrv\httpodbc.dll,5,GET,POST" & vbCrLf & _
        ".shtm,C:\WINDOWS\system32\inetsrv\ssinc.dll,5,GET,POST" & vbCrLf & _
        ".shtml,C:\WINDOWS\system32\inetsrv\ssinc.dll,5,GET,POST" & vbCrLf & _
        ".stm,C:\WINDOWS\system32\inetsrv\ssinc.dll,5,GET,POST" & vbCrLf & _
        ".asax,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".ascx,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".ashx,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,1,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".asmx,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,1,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".aspx,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,1,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".axd,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,1,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".vsdisco,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,1,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".rem,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,1,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".soap,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,1,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".config,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".cs,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".csproj,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".vb,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".vbproj,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".webinfo,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".licx,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".resx,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".resources,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".xoml,C:\WINDOWS\Microsoft.NET\Framework\v2.0.50727\aspnet_isapi.dll,1,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".rules,C:\WINDOWS\Microsoft.NET\Framework\v2.0.50727\aspnet_isapi.dll,1,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".master,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".skin,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".compiled,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".browser,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".mdb,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".jsl,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".vjsproj,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".sitemap,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".msgx,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,1,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".ad,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".dd,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".ldd,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".sd,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".cd,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".adprototype,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".lddprototype,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".sdm,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".sdmDocument,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".ldb,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".svc,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,1,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".mdf,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".ldf,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".java,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".exclude,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        ".refresh,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,5,GET,HEAD,POST,DEBUG" & vbCrLf & _
        "*,c:\windows\microsoft.net\framework\v2.0.50727\aspnet_isapi.dll,0,全部"
        Dim mServerVirPath As String = "IIS://localhost/w3svc"
        Dim ScriptMapsList() As String = System.Text.RegularExpressions.Regex.Split(ScriptMaps, vbCrLf)
        Dim rootEntry As New System.DirectoryServices.DirectoryEntry(mServerVirPath)
        Dim strReturn As String = ""
        Dim siteID As Integer = 1
        '得到现有的站点标识
        For Each entry As DirectoryEntry In rootEntry.Children
            If entry.SchemaClassName = "IIsWebServer" Then
                Dim ID As Integer = Convert.ToInt32(entry.Name)
                If ID >= siteID Then
                    siteID = ID + 1
                End If
            End If
        Next
        Dim defaultEx() As String = BaseFunction.PublicMethod.GetApplication("URLRewrite").Split(",")
        Dim strDefaultPage As String = ""
        Dim root As DirectoryEntry = New DirectoryEntry("IIS://localhost/W3SVC")
        Dim site As DirectoryEntry = CType(root.Invoke("Create", "IIsWebServer", siteID), DirectoryEntry)
        Dim serverBindings As PropertyValueCollection = site.Properties("ServerBindings")
        Dim headerStr As String = String.Format("{0}:{1}:{2}", HttpContext.Current.Request.ServerVariables.Get("Local_Addr").ToString, SitePort, SiteUrl)
        If Not serverBindings.Contains(headerStr) Then
            serverBindings.Add(headerStr)
        End If
        If defaultEx IsNot Nothing Then
            strDefaultPage = "Default" & defaultEx(0)
        Else
            strDefaultPage = "Default.html"
        End If
        site.Invoke("Put", "ServerComment", SiteName)
        site.Invoke("Put", "KeyType", "IIsWebServer")
        site.Invoke("Put", "AccessRead", True)
        site.Invoke("Put", "ServerState", 2)
        site.Invoke("Put", "FrontPageWeb", 1)
        site.Invoke("Put", "DefaultDoc", strDefaultPage)
        site.Invoke("Put", "ServerAutoStart", 1)
        site.Invoke("Put", "ServerSize", 1)
        site.Invoke("SetInfo")

        Dim siteVDir As DirectoryEntry = site.Children.Add("Root", "IISWebVirtualDir")
        siteVDir.Properties("AppIsolated")(0) = 2
        siteVDir.Properties("Path")(0) = HttpContext.Current.Request.PhysicalApplicationPath
        siteVDir.Properties("AccessFlags")(0) = 513
        siteVDir.Properties("FrontPageWeb")(0) = 1
        siteVDir.Properties("AppRoot")(0) = "/LM/W3SVC/" & siteID.ToString & "/Root"
        siteVDir.Properties("AppFriendlyName")(0) = "Root"


        Dim appPools As New DirectoryEntry("IIS://localhost/w3svc/apppools")
        Dim newpool As DirectoryEntry
        Try
            newpool = appPools.Children.Add(SiteName, "IIsApplicationPool")
            newpool.CommitChanges()
            newpool = Nothing
            appPools = Nothing
        Catch ex As Exception
            strReturn = String.Format("创建应用程序池错误，错误信息： " & vbLf & "{0}", Replace(ex.Message, vbCrLf, ""))
        Finally
            newpool = Nothing
            appPools = Nothing
        End Try
        siteVDir.Properties("AppPoolId")(0) = SiteName
        siteVDir.Properties("AccessScript")(0) = True
        siteVDir.Properties("ScriptMaps").Value = ScriptMapsList
        siteVDir.CommitChanges()
        site.CommitChanges()
        Return strReturn
    End Function
    '2、更改虚拟目录属性
    Public Function ChangeVirDir(ByVal SiteName As String, ByVal IsOpen As Boolean, Optional ByVal SiteUrl As String = "", Optional ByVal NewName As String = "") As Boolean
        Dim FindSite As Boolean = False
        Dim ReturnValue As Boolean = True
        Dim mServerVirPath As String = "IIS://localhost/w3svc"
        Dim myDE As New DirectoryEntry(mServerVirPath)
        For Each Dirport As DirectoryEntry In myDE.Children
            If Dirport.SchemaClassName = "IIsWebServer" Then
                If Dirport.Properties("ServerComment")(0) = SiteName Then
                    FindSite = True
                    If NewName.Length > 0 Then
                        Dirport.Properties("ServerComment")(0) = NewName
                    End If
                    If SiteUrl.Length > 0 Then
                        Dim serverBindings As PropertyValueCollection = Dirport.Properties("ServerBindings")
                        Dim headerStr As String = String.Format("{0}:{1}:{2}", HttpContext.Current.Request.ServerVariables.Get("Local_Addr").ToString, "80", SiteUrl)
                        serverBindings.Clear()
                        serverBindings.Add(headerStr)
                    End If
                    If IsOpen Then
                        Dirport.Invoke("Start")
                    Else
                        Dirport.Invoke("Stop")
                    End If
                    Try
                        Dirport.CommitChanges()
                    Catch ex As Exception
                        ReturnValue = False
                    End Try
                End If
            End If
        Next
        Try
            myDE.CommitChanges()
        Catch ex As Exception
            ReturnValue = False
        End Try
        If ReturnValue And FindSite Then
            Return True
        Else
            Return False
        End If
    End Function
    '3、删除虚拟目录
    Public Sub DelVirDir(ByVal SiteName As String)
        Dim mServerVirPath As String = "IIS://localhost/w3svc"
        Dim myDE As New DirectoryEntry(mServerVirPath)
        For Each Dirport As DirectoryEntry In myDE.Children
            If Dirport.SchemaClassName = "IIsWebServer" Then
                If Dirport.Properties("ServerComment")(0) = SiteName Then
                    myDE.Children.Remove(Dirport)
                    Dim appPools As New DirectoryEntry("IIS://localhost/w3svc/apppools")
                    For Each AppPool As DirectoryEntry In appPools.Children
                        If SiteName.Equals(AppPool.Name, StringComparison.OrdinalIgnoreCase) Then
                            AppPool.DeleteTree()
                            Exit For
                        End If
                    Next
                    appPools = Nothing
                End If
            End If
        Next
        myDE.CommitChanges()
    End Sub
    '回收应用程序池
    Public Function RecycleAppPool(ByVal appPoolName As String) As Boolean
        Dim appPools As New DirectoryEntry("IIS://localhost/w3svc/apppools")
        Dim status As Boolean = False
        For Each AppPool As DirectoryEntry In appPools.Children
            If appPoolName.Equals(AppPool.Name, StringComparison.OrdinalIgnoreCase) Then
                AppPool.Invoke("Recycle", Nothing)
                status = True
                Exit For
            End If
        Next
        appPools = Nothing
        Return status
    End Function
    Public Function IISDefaultFile() As String
        Dim MrFileName() As String = Nothing
        Dim mServerVirPath As String = "IIS://localhost/w3svc"
        Dim myDE As New DirectoryEntry(mServerVirPath)
        Dim mWebName As String = BaseFunction.PublicMethod.GetApplication("WebName")
        Dim strRewriteEx() As String = BaseFunction.PublicMethod.GetApplication("URLRewrite").ToLower.Split(",")
        For Each Dirport As DirectoryEntry In myDE.Children
            If Dirport.SchemaClassName = "IIsWebServer" Then
                If Dirport.Properties("ServerComment")(0).ToString = mWebName Then
                    MrFileName = Split(Dirport.Properties("DefaultDoc")(0).ToString, ",")
                    Return (From f In MrFileName _
                           Where strRewriteEx.Contains(IO.Path.GetExtension(f).ToLower) _
                           Select f).FirstOrDefault
                End If
            End If
        Next
        Return ""
    End Function
End Class
