残るは列挙体と DirectoryAccess クラスです。どちらも ADネタ及びプライマリ グループの取得のところに一部実装を書いてますのでそれ以外の部分を書きます。
列挙体
Public Enum DomainGroupType 'ドメインのグループタイプ
SecBuiltInLocal = -2147483643 'セキュリティ グループ - ビルトイン ローカルグループ
SecDomainLocal = -2147483644 'セキュリティ グループ - ドメイン ローカルグループ
SecGlobal = -2147483646 'セキュリティ グループ - グローバルグループ
SecUniversal = -2147483640 'セキュリティ グループ - ユニバーサルグループ
DistDomainLocal = 4 '配布グループ - ドメイン ローカルグループ
DistGlobal = 2 '配布グループ - グローバルグループ
DistUniversal = 8 '配布グループ - ユニバーサルグループ
End Enum
クラス
Public NotInheritable Class DirectoryAccess 'Directory にアクセスするための静的メソッド・プロパティを提供するクラス
'プライベートフィールド
Private Shared _categoryNames As ReadOnlyCollection(Of String) 'ディレクトリ オブジェクトの種類の名前リスト
'プライベートコンストラクタ
Private Sub New()
End Sub
'パブリックプロパティ
Public Shared ReadOnly Property CategoryNames As ReadOnlyCollection(Of String) 'ディレクトリ オブジェクトの種類の名前リストを取得
Get
If _categoryNames Is Nothing Then
_categoryNames = New ReadOnlyCollection(Of String)(
New String() {"ユーザ", "グループ", "コンピュータ", "組織単位", "プリンタ", "共有フォルダ"})
End If
Return _categoryNames
End Get
End Property
'パブリックメソッド
Public Shared Sub DisposeItems(items As IEnumerable(Of IDirectory)) '指定した Directory オブジェクトのリストの使用されているリソースを解放
If items Is Nothing Then
Throw New ArgumentNullException("items")
End If
For Each item In items
item.Dispose()
Next
End Sub
Public Overloads Shared Function GetBelongPath(entry As DirectoryEntry) As String '指定した DirectoryEntry" の所属パスを取得
If entry Is Nothing Then
Throw New ArgumentNullException("entry")
End If
Return GetBelongPath(entry.Path)
End Function
Public Overloads Shared Function GetBelongPath(adsiObject As IADs) As String '指定した ADSI オブジェクトの所属パスを取得
If adsiObject Is Nothing Then
Throw New ArgumentNullException("adsiObject")
End If
Return GetBelongPath(adsiObject.ADsPath)
End Function
Public Overloads Shared Function GetBelongPath(ldapPath As String) As String '指定した LDAP パスの所属パスを取得
If ldapPath Is Nothing Then
Return String.Empty
End If
Dim path() As String
Dim spos = ldapPath.IndexOf("OU=")
If spos < 0 Then 'OUがない時
If BelongContainer(ldapPath) Then 'コンテナに所属している時
spos = ldapPath.LastIndexOf("CN=")
Else 'ドメイン直下の時
Return String.Empty
End If
End If
Dim epos = ldapPath.IndexOf(",DC=")
Dim cpos = ldapPath.IndexOf(","c)
path = ldapPath.Substring(spos, epos - spos).Split(","c)
Array.Reverse(path)
If spos < cpos Then '所属している時(OU= の位置がコンマの位置より手前にある時・・・LDAP://OU=○○,～)
If path.Length = 1 Then 'ルートOUの時
Return String.Empty
Else '子OUの時
ReDim Preserve path(path.Length - 2)
End If
End If
Dim sb As New Text.StringBuilder()
For Each ou In path
sb.AppendFormat("{0}/", ou.Substring(3))
Next
sb.Length -= 1
Return sb.ToString()
End Function
Public Shared Function GetComputers() As IList(Of Computer) 'コンピュータのリストを取得
Dim computers As New Collection(Of Computer)()
If IsLogonDomain Then 'ドメインにログオンしている時
Try
Using root As New DirectoryEntry(LdapRootPath)
Dim filter = String.Format("(objectCategory={0})", CategoryType.Computer)
Using searcher As New DirectorySearcher(root, filter)
Using results = searcher.FindAll()
For Each res As SearchResult In results
computers.Add(DirectCast(CreateInstance(res.GetDirectoryEntry()), Computer))
Next
End Using
End Using
End Using
Catch
computers.Clear()
End Try
End If
Return computers
End Function
Public Shared Function GetGroupScopeName(domainGroup As IADsGroup) As String '指定したグループのスコープを取得
If domainGroup Is Nothing Then
Throw New ArgumentNullException("domainGroup")
End If
Select Case DirectCast(domainGroup.Get("groupType"), DomainGroupType)
Case DomainGroupType.SecBuiltInLocal
Return "ビルトイン ローカル"
Case DomainGroupType.SecDomainLocal, DomainGroupType.DistDomainLocal
Return "ドメイン ローカル"
Case DomainGroupType.SecGlobal, DomainGroupType.DistGlobal
Return "グローバル"
Case Else
Return "ユニバーサル"
End Select
End Function
Public Shared Function GetGroupTypeName(domainGroup As IADsGroup) As String '指定したグループの種類を取得
If domainGroup Is Nothing Then
Throw New ArgumentNullException("domainGroup")
End If
Select Case DirectCast(domainGroup.Get("groupType"), DomainGroupType)
Case DomainGroupType.SecBuiltInLocal,
DomainGroupType.SecDomainLocal, DomainGroupType.SecGlobal, DomainGroupType.SecUniversal
Return "セキュリティ"
Case Else
Return "配布"
End Select
End Function
Public Shared Function GetOrganizationalUnits() As IList(Of OrganizationalUnit) '組織単位（OU）のリストを取得
Dim ous As New Collection(Of OrganizationalUnit)()
If IsLogonDomain Then 'ドメインにログオンしている時
Try
Using root As New DirectoryEntry(LdapRootPath)
Dim filter = String.Format("(objectCategory={0})", CategoryType.OrganizationalUnit)
Using searcher As New DirectorySearcher(root, filter)
Using results = searcher.FindAll()
For Each res As SearchResult In results
ous.Add(DirectCast(CreateInstance(res.GetDirectoryEntry()), OrganizationalUnit))
Next
End Using
End Using
End Using
Catch
ous.Clear()
End Try
End If
Return ous
End Function
'指定した PrimaryGroupToken を持つドメイングループをプライマリグループとしているメンバの DirectoryEntry のリストを取得
Public Shared Function GetPrimaryGroupMemberEntries(primaryGroupToken As Integer) As IList(Of DirectoryEntry)
If IsLogonDomain = False Then 'ドメインにログオンしていない時
Return New Collection(Of DirectoryEntry)()
End If
Try
Dim entries As New Collection(Of DirectoryEntry)()
Using root As New DirectoryEntry(LdapRootPath)
Dim filter = String.Format(
"(&(|(objectCategory=User)(objectCategory=Computer))(primaryGroupID={0}))", primaryGroupToken)
Using searcher As New DirectorySearcher(root, filter)
Using results = searcher.FindAll()
For Each res As SearchResult In results
entries.Add(res.GetDirectoryEntry())
Next
End Using
End Using
End Using
Return entries
Catch
Return New Collection(Of DirectoryEntry)()
End Try
End Function
Public Shared Function GetPrintQueues() As IList(Of PrintQueue) 'プリンタのリストを取得
Dim printers As New Collection(Of PrintQueue)()
If IsLogonDomain Then 'ドメインにログオンしている時
Try
Using root As New DirectoryEntry(LdapRootPath)
Dim filter = String.Format("(objectCategory={0})", CategoryType.PrintQueue)
Using searcher As New DirectorySearcher(root, filter)
Using results = searcher.FindAll()
For Each res As SearchResult In results
printers.Add(DirectCast(CreateInstance(res.GetDirectoryEntry()), PrintQueue))
Next
End Using
End Using
End Using
Catch
printers.Clear()
End Try
End If
Return printers
End Function
'指定した組織単位直下のオブジェクトのリストを取得
Public Shared Function GetStoredDomainObjects(ou As OrganizationalUnit) As IList(Of IDomain)
If ou Is Nothing Then
Throw New ArgumentNullException("ou")
End If
Dim objects As New Collection(Of IDomain)()
If IsLogonDomain Then 'ドメインにログオンしている時
Try
Using searcher As New DirectorySearcher(ou.Entry)
searcher.SearchScope = SearchScope.OneLevel
Using results = searcher.FindAll()
For Each res As SearchResult In results
objects.Add(DirectCast(CreateInstance(res.GetDirectoryEntry()), IDomain))
Next
End Using
End Using
Catch
objects.Clear()
End Try
End If
Return objects
End Function
Public Shared Function GetUsers() As IList(Of IUser) 'ユーザのリストを取得
Dim users As New Collection(Of IUser)()
Try
Using root As New DirectoryEntry(LdapRootPath)
If IsLogonDomain Then 'ドメインにログオンしている時
Dim filter = String.Format("(objectCategory={0})", CategoryType.User)
Using searcher As New DirectorySearcher(root, filter)
Using results = searcher.FindAll()
For Each res As SearchResult In results
users.Add(DirectCast(CreateInstance(res.GetDirectoryEntry()), IUser))
Next
End Using
End Using
Else 'ドメインにログオンしていない時
For Each entry As DirectoryEntry In root.Children
If entry.SchemaClassName.Equals(CategoryType.User.ToString()) Then
users.Add(DirectCast(CreateInstance(entry), IUser))
End If
Next
End If
End Using
Catch
users.Clear()
End Try
Return users
End Function
Public Shared Function GetVolumes() As IList(Of Volume) '共有フォルダのリストを取得
Dim folders As New Collection(Of Volume)()
If IsLogonDomain Then 'ドメインにログオンしている時
Try
Using root As New DirectoryEntry(LdapRootPath)
Dim filter = String.Format("(objectCategory={0})", CategoryType.Volume)
Using searcher As New DirectorySearcher(root, filter)
Using results = searcher.FindAll()
For Each res As SearchResult In results
folders.Add(DirectCast(CreateInstance(res.GetDirectoryEntry()), Volume))
Next
End Using
End Using
End Using
Catch
folders.Clear()
End Try
End If
Return folders
End Function
'フレンドメソッド
'指定した名前を持ち、指定した種類の DirectoryEntry を検索
Friend Shared Function FindDirectoryEntry(name As String, objectCategory As CategoryType) As DirectoryEntry
If name Is Nothing Then
Throw New ArgumentNullException("name")
End If
Try
Using root As New DirectoryEntry(LdapRootPath)
If IsLogonDomain Then 'ドメインにログオンしている時
Dim filter As String
Select Case objectCategory
Case CategoryType.User
filter = String.Format("(&(objectCategory={0})(sAMAccountName={1}))", objectCategory, name)
Case CategoryType.PrintQueue
filter = String.Format("(&(objectCategory={0})(printerName={1}))", objectCategory, name)
Case Else
filter = String.Format("(&(objectCategory={0})(name={1}))", objectCategory, name)
End Select
Using searcher As New DirectorySearcher(root, filter)
Dim result = searcher.FindOne()
Return If(result Is Nothing, Nothing, result.GetDirectoryEntry())
End Using
Else 'ドメインにログオンしていない時
Return root.Children.Find(name, objectCategory.ToString())
End If
End Using
Catch
Return Nothing
End Try
End Function
'プライベートメソッド
Private Shared Function BelongContainer(ldapPath As String) As Boolean 'LDAP パスがコンテナに所属しているかどうかを返す
With ldapPath
Return .Contains(",CN=Builtin") OrElse .Contains(",CN=Users") OrElse .Contains(",CN=Computers") OrElse
.Contains(",CN=ForeignSecurityPrincipals") OrElse .Contains(",CN=LostAndFound") OrElse
.Contains(",CN=NTDS Quotas") OrElse .Contains(",CN=Program Data") OrElse .Contains(",CN=System")
End With
End Function
End Class
おまけ
Excel で 現在のセルの境界線部分をダブルクリックすると、その方向にある空白セルの手前のセルに移動できます。