Active Directoryのユーザ管理 (2)

Active Directoryのユーザ管理 (1) で作成したクラスを使って実際のユーザー管理をしてゆく。

実際のユーザー管理

ドメインユーザを追加するとともに，ホームディレクトリを作り，そのホームディレクトリをH:ドライブに割り当てるようにする。という仕様でやってみる。ドメインなどの仕様は次の通りとする。

ドメイン名	hogedom.local
ドメインコントローラ	domainserver
ファイルサーバ	hogeserver
home共有	\\hogeserver\home以下に置く
home共有のサーバ上の位置	D:\home

次のような感じのExcelの表があり，その表の中のデータを登録する手続を記述する。

部署	職員番号	ID	姓	名	グループ	グループ	PW
内野	F008	mac	金子	誠	fighters	naiya	abcd1234
外野	F001	hichori	森本	稀哲	fighters	gaiya	efgh5678
投手	F021	hisashi	武田	久	fighters	pitcher	vwxy9876

ユーザーの追加

Sub cmdAddUsers_Click()
    Dim vID As String
    Dim iCol As Integer
    Dim iRow As Integer
    Dim ADSI As CADSI
    Dim User As TADUser
    Dim vGroup
    
    Set ADSI = New CADSI
    ADSI.OpenDomain _
        "hogeserver.hogedom.local", "dc=hogedom,dc=local", "hogedom\administrator", "password"
    iRow = 2
    vID = Cells(iRow, 3)
    Do While Len(vID) > 0
        'Debug.Print vID
        User.UserID = vID
        User.LastName = Cells(iRow, 4)
        User.FirstName = Cells(iRow, 5)
        User.DisplayName = User.LastName + "　" + User.FirstName
        User.Description = User.DisplayName
        User.PasswordMustChange = False
        User.ScriptPath = "logon.vbs"
        User.UserPrincipalName = vID & "@hogedom.local"
        User.Password = Cells(iRow, 8)
        ADSI.AddUser User, "ou=Persons"
        For iCol = 6 To 7
            vGroup = Cells(iRow, iCol)
            If Len(vGroup) > 0 Then
                ADSI.AddToGroup "ou=Persons", vID, "ou=Groups", Cells(iRow, iCol)
            End If
        Next iCol
        ADSI.SetHomeFolder vID, "ou=Persons", "H:", "\\hogeserver\home\%username%"
        MakeFolder vID
        iRow = iRow + 1
        vID = Cells(iRow, 3)
    Loop
    Set ADSI = Nothing
End Sub

CADSIのSetHomeFolderメソッドを使って，ホームディレクトリを設定している。ドメインコントローラ上の「Active Directoryユーザとコンピュータ」にてユーザ設定をする際に，このコードのように //hogeserver/home/%username% のように指定すると自動的にフォルダが作成されるがADSIを使ってコードで設定した場合には自動作成されないようだ。

ホームフォルダの作成

ADSIを利用したユーザー管理プログラムでアカウントを作成するのであれば，ホームフォルダの作成機能は必須となる。ここでは，//hogeserver/home という共有フォルダの下に各個人のホームディレクトリを作成し，そのアカウントに対してのみフルコントロールのアクセス権を付与する仕様を目指した。

上記のコード中で呼び出されているMakeFolder手続で，ホームディレクトリを作成している。

Sub MakeFolder(AID As String)
    Dim FSO As FileSystemObject
    
    Set FSO = New FileSystemObject
    FSO.CreateFolder "\\hogeserver\home\" & AID
    SetSecurityHomeDirectory "domainserver", "hogeserver", AID, "D:\home\" & AID
    Set FSO = Nothing
End Sub

FileSystemObjectオブジェクトでフォルダをサーバ上に作成し，SetSecurityHomeDirectoryで権限を設定して いる。NTFSの権限を設定するにはコマンドラインではcaclsというツールがあったり，xcacls.vbsというツールをMicrosoftが提供 してくれていたりするが，なんとかExcelのVBA上でやりたかった。WMIを使って権限を設定するのは可能だが，とっても難しく面倒くさい。いくつか のサイトを覗いたが，このSetSecurityHomeDirectoryは，中の技術日誌ブログに あった同名の手続を改造して作った。用途がもろに僕のやりたいこと「ユーザのホームディレクトリの設定」と一致していたためだ。この手続では，指定した ユーザのフルコントロールのアクセス権をフォルダに与える。以下のコードはまんまパクリです。中さんのコードですのでそこのとこはよろしくです。

Function SetSecurityHomeDirectory(strDomainControler, strComputer, strUser, HomePath)
    Dim objWMIService
    Dim wmiAccounts
    Dim wmiAccount
    Dim wmiTrustee
    Dim wmiTrusteeClass
    Dim wmiSID
    Dim wmiACE
    Dim wmiACEClass
    Dim wmiFileSecSetting
    Dim wmiSecurityDescriptor
    Dim DictACE
    Dim obj
    Dim RetVal
    Dim i
    
    Set objWMIService = GetObject( _
        "winmgmts:{impersonationLevel=impersonate}!\\" & strDomainControler & "\root\cimv2")
    SetSecurityHomeDirectory = False
    'アカウント取得
    Set wmiAccounts = _
        objWMIService.ExecQuery("select * from Win32_Account where Name='" & strUser & "'")
    For Each obj In wmiAccounts
      Set wmiAccount = obj
      Exit For
    Next
    
    'Trusteeに変換する
    Set wmiTrusteeClass = objWMIService.Get("Win32_Trustee")
    Set wmiTrustee = wmiTrusteeClass.spawnInstance_()
    Set wmiSID = objWMIService.Get("Win32_SID.SID='" & wmiAccount.sid & "'")
    wmiTrustee.DOMAIN = wmiSID.ReferencedDomainName
    wmiTrustee.Name = wmiSID.AccountName
    wmiTrustee.sid = wmiSID.BinaryRepresentation
    wmiTrustee.sidLength = wmiSID.sidLength
    wmiTrustee.sidString = wmiSID.sid
    'ACEオブジェクトを作成する
    Set wmiACEClass = objWMIService.Get("Win32_ACE")
    Set wmiACE = wmiACEClass.spawnInstance_()
    wmiACE.AccessMask = 1 + 2 + 4 + 8 + 16 + 32 + 64 + 128 + 256 + 65536 _
        + 131072 + 262144 + 524288 + 1048576 ' 2032127
    wmiACE.Trustee = wmiTrustee
    wmiACE.AceType = 0
    wmiACE.AceFlags = 3
    
    '対象フォルダのセキュリティデスクリプタを取得する
    'Set wmiFileSecSetting = GetObject( _
        "winmgmts:Win32_LogicalFileSecuritySetting.path='" & HomePath & "'")
    Set wmiFileSecSetting = GetObject( _
        "winmgmts:\\" & strComputer & "\root\cimv2:Win32_LogicalFileSecuritySetting='" & _
        HomePath & "'")
    RetVal = wmiFileSecSetting.GetSecurityDescriptor(wmiSecurityDescriptor)
    If (RetVal <> 0) Then
        MsgBox "GetSecurityDescriptorに失敗しました:" & RetVal
        Exit Function
    End If
    
    'ディクショナリにDACLを転記する
    Set DictACE = CreateObject("Scripting.Dictionary")
    For i = LBound(wmiSecurityDescriptor.DACL) To UBound(wmiSecurityDescriptor.DACL)
        If (Not wmiSecurityDescriptor.DACL(i).AceFlags And 16) Then
            Call DictACE.Add(i, wmiSecurityDescriptor.DACL(i))
        End If
    Next
    
    '設定する新しいACEオブジェクトを最後に足す
    Call DictACE.Add("NewUser", wmiACE)
    
    'DACLに書き戻す
    wmiSecurityDescriptor.DACL = DictACE.Items
    
    '対象フォルダのセキュリティデスクリプタを設定する
    RetVal = wmiFileSecSetting.SetSecurityDescriptor(wmiSecurityDescriptor)
    If (RetVal <> 0) Then
      MsgBox "SetSecurityDescriptorに失敗しました:" & RetVal
      Exit Function
    End If
    SetSecurityHomeDirectory = True
End Function

最初の引数は，ドメインコントローラのサーバ名を指定する，2つめの引数はhomeフォルダが存在するサーバ名，3つめの引数はユーザID，4つめの引数はhomeフォルダのサーバ上での絶対パスを指定する。

オリジナルではサーバ名は一つ渡せばよい構造だったが，当方の場合ではドメインコントローラとファイルサーバが別物だったので引数が増えた。改造したのはその部分のみ。

セキュリティディスクリプタを取得する時には，UNCではうまく動作しなかったので，サーバ上でのローカルパス名を渡さなければならない。

ユーザの削除

削除の方は登録よりも簡単。

Sub cmdDelUsers_Click()
    Dim vID As String
    Dim iRow As Integer
    Dim ADSI As CADSI
    
    Set ADSI = New CADSI
    
    ADSI.OpenDomain "hogeserver.hogedom.local", "dc=hogedom,dc=local", "hogedom\administrator", "password"
    iRow = 2
    vID = Cells(iRow, 3)
    Do While Len(vID) > 0
        'Debug.Print vID
        ADSI.DeleteUser vID, "ou=Persons"
        RemoveFolder vID
        iRow = iRow + 1
        vID = Cells(iRow, 3)
    Loop
    Set ADSI = Nothing
End Sub

Sub RemoveFolder(AID As String)
    Dim FSO As FileSystemObject
    
    Set FSO = New FileSystemObject
    FSO.DeleteFolder "\\hogeserver\home\" & AID, True
    Set FSO = Nothing
End Sub

ユーザをドメインから削除した後に，ホームディレクトリを削除しているだけ。