DirectoryAccess クラスに追加したグループ関連のメソッドのVBのコードです。
前回追加したコードはこちら。
'指定した ADSI オブジェクトの所属パスを取得します。
Public Shared Function GetBelongPath(native As IADs) As String 'オーバーロードを追加
If native Is Nothing Then
Throw New ArgumentNullException("native", "native が Nothing です。")
End If
Return GetBelongPath(native.ADsPath)
End Function
'グループを取得を取得します。GroupTokens プロパティが設定されます。
Public Shared Function GetGroups(Of T As {DirectoryObject, IGroup})() As IList(Of T)
Dim groups As New List(Of T)()
Using root = GetRootEntry() 'ルートのDirectoryEntryを取得
If CanConnectDomain Then 'ドメインに接続できる時
Dim filter = String.Format("(objectCategory={0})", CategoryType.Group)
GroupTokens.Clear()
Using searcher As New DirectorySearcher(root, filter)
Using results = searcher.FindAll()
For Each res As SearchResult In results
Dim entry = res.GetDirectoryEntry()
groups.Add(DirectCast(CreateInstance(entry), T))
AddGroupToken(entry) 'PrimaryGroupTokenを追加
Next
End Using
End Using
Else 'ドメインに接続できない時 <-- こっちはローカル
root.Children.SchemaFilter.Add(CategoryType.Group.ToString())
For Each entry As DirectoryEntry In root.Children
groups.Add(DirectCast(CreateInstance(entry), T))
Next
End If
End Using
Return groups
End Function
'指定した PrimaryGroupToken を持つドメイングループをプライマリグループとしているメンバの DirectoryEntry のコレクションを取得します。
Public Shared Function GetPrimaryGroupMemberEntries(primaryGroupToken As Integer) As IList(Of DirectoryEntry)
If CanConnectDomain = False Then 'ドメインに接続できない時
Return New List(Of DirectoryEntry)()
End If
Dim entries As New List(Of DirectoryEntry)()
Using root = GetRootEntry() 'ルートのDirectoryEntryを取得
Dim filter = String.Format("(&(|(objectCategory={0})(objectCategory={1}))(primaryGroupID={2}))",
CategoryType.User, CategoryType.Computer, primaryGroupToken)
Using results = searcher.FindAll()
For Each res As SearchResult In results
entries.Add(res.GetDirectoryEntry())
Next
End Using
End Using
Return entries
End Function
'指定した LDAP パスの名前(オブジェクト名)を取得します。
Public Shared Function PathToCn(ldapPath As String) As String
If ldapPath Is Nothing Then
Throw New ArgumentNullException("ldapPath", "ldapPath が Nothing です。")
End If
Dim spos = ldapPath.IndexOf("="c) + 1
If spos = 0 Then
Return ldapPath
End If
Dim epos = ldapPath.IndexOf(","c)
If epos > 0 Then
Return ldapPath.Substring(spos, epos - spos)
Else
Return ldapPath.Substring(spos)
End If
End Function
'PrimaryGroupToken を追加します。
Private Shared Sub AddGroupToken(entry As DirectoryEntry)
entry.Invoke("GetInfoEx", New Object() {"primaryGroupToken"}, 0)
Dim token = Convert.ToInt32(entry.Properties.Item("primaryGroupToken").Value)
GroupTokens.Add(token, entry.Properties.Item("cn").Value.ToString())
End Sub
DirectoryObject のインスタンスを作成する CreateInstance メソッドにグループ部分のコード（太字の部分）を追加しました。
Private Shared Function CreateInstance(entry As DirectoryEntry) As DirectoryObject
Dim category As CategoryType
If [Enum].TryParse(Of CategoryType)(entry.SchemaClassName, True, category) = False Then
Throw New ArgumentException("entry の種類が CategoryType に該当しません。", "entry")
End If
Select Case category
Case CategoryType.User
If CanConnectDomain Then 'ドメインに接続できる時
Return New DomainUser(entry)
Else 'ドメインに接続できない時
Return New LocalUser(entry)
End If
Case CategoryType.Group
If CanConnectDomain Then 'ドメインに接続できる時
Return New DomainGroup(entry)
Else 'ドメインに接続できない時
Return New LocalGroup(entry)
End If
Case Else
Throw New NotImplementedException()
End Select
End Function