Imports System.Reflection
Imports System.ComponentModel
Imports System.Management.Automation
Imports System.Management.Automation.Provider
Imports System.Linq
<RunInstaller(True)> _
Public Class AppDomainSnapIn : Inherits PSSnapIn
Public Overrides ReadOnly Property Description() As String
Get
Return "AppDomain内のクラス情報を提供します"
End Get
End Property
Public Overrides ReadOnly Property Name() As String
Get
Return "AppDomainSnapIn"
End Get
End Property
Public Overrides ReadOnly Property Vendor() As String
Get
Return "嗣永モモコーラ"
End Get
End Property
End Class
<CmdletProvider("AppDomain", ProviderCapabilities.None)> _
Public Class AppDomainProvider : Inherits NavigationCmdletProvider
Protected Overrides Function NewDrive(ByVal di As PSDriveInfo) As PSDriveInfo
Return New AppDomainDriveInfo(di)
End Function
Protected Overrides Function ItemExists(ByVal path As String) As Boolean
Select Case CheckPath(path)
Case PathType.TNameSpace, PathType.TType, PathType.TMember
Return True
End Select
Return False
End Function
Protected Overrides Sub GetItem(ByVal path As String)
Select Case CheckPath(path)
Case PathType.TNameSpace
WriteItemObject(GetNamespace(path), path, True)
Case PathType.TType
WriteItemObject(GetClass(path), path, True)
Case PathType.TMember
WriteItemObject(GetMember(path), path, True)
End Select
End Sub
Private Function GetNamespace(ByVal path As String) As NameSpaceInfo
Return New NameSpaceInfo(DT(path))
End Function
Private Function GetClass(ByVal path As String) As Type
Dim DriveInfo As AppDomainDriveInfo = Me.PSDriveInfo
Dim q = From t In DriveInfo.Types Where t.FullName = DT(path) Select t
If q.Any Then Return q.First
Return Nothing
End Function
Private Function GetMember(ByVal path As String) As MemberInfo()
Dim dp = DT(path)
Dim parent = dp.Substring(0, dp.LastIndexOf("."))
Dim name = dp.Substring(dp.LastIndexOf(".") + 1)
Dim DriveInfo As AppDomainDriveInfo = Me.PSDriveInfo
Dim ts = From t In DriveInfo.Types Where t.FullName = parent Select t
If ts.Any Then Return ts.First.GetMember(name)
Return Nothing
End Function
Protected Overrides Sub GetChildItems(ByVal path As String, ByVal recurse As Boolean)
Select Case CheckPath(path)
Case PathType.TNameSpace
GetNamespaceChildItems(path, recurse)
Case PathType.TType
GetTypeChildItems(path, recurse)
End Select
End Sub
Private Sub GetNamespaceChildItems(ByVal path As String, ByVal recurse As Boolean)
Dim DriveInfo As AppDomainDriveInfo = Me.PSDriveInfo
Dim dp = DT(path)
Dim p_path = path
Dim ns_list As New List(Of NameSpaceInfo)
If path = "" Then
p_path = "Root"
For Each n In DriveInfo.NameSpaces
If n.Name = n.FullName And n.Name <> "" Then ns_list.Add(n)
Next
Else
Dim ns = From n In DriveInfo.NameSpaces _
Where n.FullName.StartsWith(dp) AndAlso _
n.FullName <> dp AndAlso _
Not n.FullName.Replace(dp, "").Substring(1).Contains(".") _
Order By n Select n
For Each n In ns
ns_list.Add(n)
Next
End If
For Each n In ns_list
WriteItemObject(n, p_path, True)
Next
Dim ts = From t In DriveInfo.Types Where t.Namespace = dp Order By t.Name Select t
For Each t In ts
WriteItemObject(t, p_path, True)
Next
If recurse Then
For Each t In ts
GetTypeChildItems(t.FullName, recurse)
Next
For Each e In ns_list
GetNamespaceChildItems(e.FullName, recurse)
Next
End If
End Sub
Private Sub GetTypeChildItems(ByVal path As String, ByVal recurse As Boolean)
Dim DriveInfo As AppDomainDriveInfo = Me.PSDriveInfo
Dim ts = From t In DriveInfo.Types Where t.FullName = DT(path) Select t
Dim members = From m In ts.First.GetMembers() Order By m.MemberType, m.Name Select m
For Each member In members
WriteItemObject(member, path, False)
Next
End Sub
Protected Overrides Function IsValidPath(ByVal path As String) As Boolean
Return True
End Function
Protected Overrides Function MakePath(ByVal parent As String, ByVal child As String) As String
If Not String.IsNullOrEmpty(parent) Then parent += "\"
Return parent + child
End Function
Protected Overrides Function IsItemContainer(ByVal path As String) As Boolean
Select Case CheckPath(path)
Case PathType.TNameSpace, PathType.TType
Return True
End Select
Return False
End Function
Private Function DT(ByVal path As String) As String
Return path.Replace("\", ".")
End Function
Private Function CheckPath(ByVal path As String) As PathType
Dim DriveInfo As AppDomainDriveInfo = Me.PSDriveInfo
Dim dot_path = DT(path)
If DriveInfo.NameSpaces.Contains(New NameSpaceInfo(dot_path)) Then Return PathType.TNameSpace
Dim ts = From t In DriveInfo.Types Where t.FullName = dot_path Select t
If ts.Any Then Return PathType.TType
Dim parent = ""
If dot_path.LastIndexOf(".") >= 0 Then
parent = dot_path.Substring(0, dot_path.LastIndexOf("."))
End If
ts = From t In DriveInfo.Types Where t.FullName = parent Select t
If ts.Any Then Return PathType.TMember
Return PathType.TError
End Function
Private Enum PathType
TNameSpace
TType
TMember
TError
End Enum
End Class
Public Class AppDomainDriveInfo : Inherits PSDriveInfo
Public Assemblies As New List(Of Assembly)
Public NameSpaces As New List(Of NameSpaceInfo)
Public Types As New List(Of Type)
Public Sub New(ByVal drive_info As PSDriveInfo)
MyBase.New(drive_info)
NameSpaces.Add(New NameSpaceInfo(""))
For Each a In AppDomain.CurrentDomain.GetAssemblies()
Assemblies.Add(a)
For Each t In a.GetTypes
If t.Namespace + "." + t.Name <> t.FullName Then Continue For
Dim ns As New NameSpaceInfo(t.Namespace)
If t.Namespace IsNot Nothing And Not NameSpaces.Contains(ns) Then NameSpaces.Add(ns)
While ns.ParentFullName IsNot Nothing
ns = New NameSpaceInfo(ns.ParentFullName)
If Not NameSpaces.Contains(ns) Then NameSpaces.Add(ns)
End While
Types.Add(t)
Next
Next
End Sub
End Class
Public Class NameSpaceInfo : Implements IComparable(Of NameSpaceInfo)
Public FullName As String
Public Name As String
Public Sub New(ByVal full_name As String)
FullName = full_name
If Not String.IsNullOrEmpty(FullName) Then
If FullName.LastIndexOf(".") >= 0 Then
Name = FullName.Substring(FullName.LastIndexOf(".") + 1)
Else
Name = FullName
End If
End If
End Sub
Public Function ParentFullName() As String
If Not String.IsNullOrEmpty(FullName) AndAlso FullName.IndexOf(".") > 0 Then
Return FullName.Substring(0, FullName.LastIndexOf("."))
End If
Return Nothing
End Function
Public Overrides Function Equals(ByVal obj As Object) As Boolean
If Not Me.GetType() Is obj.GetType() Then Return False
If CType(obj, NameSpaceInfo).FullName = Me.FullName Then Return True
Return False
End Function
Public Function CompareTo(ByVal other As NameSpaceInfo) As Integer Implements IComparable(Of NameSpaceInfo).CompareTo
If Me.FullName > other.FullName Then Return 1
If Me.FullName < other.FullName Then Return -1
Return 0
End Function
End Class
