ADユーザー情報を取得するVBScript
興味のある方は少ないと思いますが、ActiveDirectoryからユーザー情報を取得するVBScriptを作成したので、備忘録として記事にしておきます。
Scriptを実行する事により、以下の情報を取得する事ができます。
取得後、EXCELシートに情報を格納します。
- ログオン名
- アカウント表示名
- アカウントの有効/無効状態
- アカウントのロック状態
- 最終ログオン日時
- 最終パスワード変更日時
- パスワード無期限かどうか
- アカウントの説明
- 所属グループ
以下がScriptの内容です。
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' PG : ActiveDirectoryの調査
' Author : 2018/04/09 www.adlink-kk.ne.jp
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 定数(ActiveDirectory)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const ADS_SCOPE_SUBTREE = 5
Const ADS_SCOPE_ONELEVEL = 1
Const ADS_UF_SCRIPT = 1
Const ADS_UF_ACCOUNTDISABLE = 2
Const ADS_UF_HOMEDIR_REQUIRED = 8
Const ADS_UF_LOCKOUT = 16
Const ADS_UF_PASSWD_NOTREQD = 32
Const ADS_UF_PASSWD_CANT_CHANGE = 64
Const ADS_UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED = 128
Const ADS_UF_TEMP_DUPLICATE_ACCOUNT = 256
Const ADS_UF_NORMAL_ACCOUNT = 512
Const ADS_UF_INTERDOMAIN_TRUST_ACCOUNT = 2048
Const ADS_UF_WORKSTATION_TRUST_ACCOUNT = 4096
Const ADS_UF_SERVER_TRUST_ACCOUNT = 8192
Const ADS_UF_DONT_EXPIRE_PASSWD = 65536
Const ADS_UF_MNS_LOGON_ACCOUNT = 131072
Const ADS_UF_SMARTCARD_REQUIRED = 262144
Const ADS_UF_TRUSTED_FOR_DELEGATION = 524288
Const ADS_UF_NOT_DELEGATED = 1048576
Const ADS_UF_USE_DES_KEY_ONLY = 2097152
Const ADS_UF_DONT_REQUIRE_PREAUTH = 4194304
Const ADS_UF_PASSWORD_EXPIRED = 8388608
Const ADS_UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION = 16777216
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
Const ONE_HUNDRED_NANOSECOND = 0.0000001
Const SECONDS_IN_DAY = 86400
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 定数
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const i = 11
Const EXCEL_TEMLATE_FILE = "userInfo.xls"
Const EXCEL_DRIVER = "Driver={Microsoft Excel Driver (*.xls)};DBQ=BookName;ReadOnly=False;"
Const ADS_PATH = "LDAP://DC=example,DC=com" '環境にあわせて変更
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 変数(ActiveDirectory)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private cnn 'ADODB.Connection（ActiveDirectory）
Private cmd 'ADODB.Command（ActiveDirectory）
Private rs 'ADODB.Recordset（ActiveDirectory）
Private con 'ADODB.Connection（ExcelBook）
Private maxPwdDays 'Password有効期限（PasswordPolisy）
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 変数(ユーザー情報)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private userInfo() 'ユーザー情報格納配列（○項目をExcelBookへ出力）
'userInfo(0) :Adspath
'userInfo(1) :アカウント名
'userInfo(2) :アカウント表示名 ○
'userInfo(3) :ログオン名
'userInfo(4) :ログオン名(Windows2000) ○
'userInfo(5) :アカウント有効/無効 ○
'userInfo(6) :アカウントロック ○
'userInfo(7) :最終ログオン日時 ○
'userInfo(8) :最終パスワード変更日時 ○
'userInfo(9) :パスワード無期限 ○
'userInfo(10) :説明 ○
'userInfo(11) :所属グループ ○
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 処理
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Init()
Main()
Term()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ActiveDirectoryに接続
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Init()
On Error Resume Next
Set cnn = CreateObject("ADODB.Connection")
cnn.Provider = "ADsDSOObject"
cnn.Open "Active Directory Provider"
'PasswordPolisyからPassword有効期限を取得
Set objDomain = GetObject("ADS_PATH")
Set objMaxPwdAge = objDomain.Get("maxPwdAge")
maxPwdNano = abs(objMaxPwdAge.HighPart * (2 ^ 32) + objMaxPwdAge.LowPart)
maxPwdSecs = maxPwdNano * ONE_HUNDRED_NANOSECOND
maxPwdDays = CInt(maxPwdSecs / SECONDS_IN_DAY)
If Err Then
Call Term()
WScript.Echo "ActiveDirectoryに接続できませんでした！"
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ユーザー情報を取得
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Main()
On Error Resume Next
'EXCELBOOKコピー＞接続
Set fso = CreateObject("Scripting.FileSystemObject")
Set book = fso.GetFile(fso.BuildPath(fso.GetParentFolderName(WScript.ScriptFullName), EXCEL_TEMLATE_FILE))
newbook = Replace(DateSerial(Year(Now),Month(Now),Day(Now)),"/","") & "_" & EXCEL_TEMLATE_FILE
newbook = fso.BuildPath(fso.GetParentFolderName(WScript.ScriptFullName), newbook)
book.Copy newbook
Set book = Nothing
Set fso = Nothing
Set con = CreateObject("ADODB.Connection")
con.Open Replace(EXCEL_DRIVER,"BookName",newbook)
'ユーザー情報抽出
Set cmd = CreateObject("ADODB.Command")
Set cmd.ActiveConnection = cnn
cmd.Properties("Page Size") = 1000
cmd.Properties("Timeout") = 30
cmd.Properties("Searchscope") = ADS_SCOPE_SUBTREE '5階層迄検索
cmd.Properties("Cache Results") = False
cmd.CommandText = "SELECT AdsPath FROM '" & ADS_PATH & "' WHERE objectCategory='user'"
Set rs = cmd.Execute
rs.MoveFirst
Do Until rs.EOF
Redim userInfo(i)
getUserInfo(GetObject(rs.Fields("AdsPath").Value))
setExcelBook()
rs.MoveNext
Loop
rs.Close
cnn.Close
con.Close
If Err Then
Call Term()
WScript.Echo "ADスキーマ取得に失敗しました！"
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ActiveDirectoryから切断
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Term()
Set rs = Nothing
Set cmd = Nothing
Set cnn = Nothing
Set con = Nothing
WScript.Quit
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ユーザー情報を配列に格納する
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub getUserInfo(ByRef objUser)
On Error Resume Next
userInfo(0) = objUser.AdsPath
userInfo(1) = objUser.Name
userInfo(2) = objUser.displayName
userInfo(3) = objUser.userPrincipalName
userInfo(4) = objUser.sAMAccountName
If objUser.AccountDisabled = True Then
userInfo(5) = "無効"
Else
userInfo(5) = "有効"
End If
If objUser.IsAccountLocked = True Then
userInfo(6) = "ロック有"
Else
userInfo(6) = "ロック無"
End If
Set objLastLogon = objUser.Get("lastLogon")
userInfo(7) = objLastLogon.HighPart * (2 ^ 32) + objLastLogon.LowPart
userInfo(7) = userInfo(7) / (60 * 10000000)
userInfo(7) = userInfo(7) / 1440
userInfo(7) = userInfo(7) + #1/1/1601#
userInfo(7) = userInfo(7) + #9:00:00 AM#
On Error Resume Next
userInfo(8) = objUser.passwordLastChanged
If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
userInfo(8) = "変更履歴なし"
Err.Clear
Else
passday = DateDiff("d",userInfo(8),Now()) 'パスワード変更後の経過日数
End If
On Error GoTo 0
If Not objUser.userAccountControl AND ADS_UF_DONT_EXPIRE_PASSWD Then
userInfo(9) = "期限あり"
Else
userInfo(9) = "期限なし"
End If
userInfo(10) = objUser.Description
On Error Resume Next
userInfo(11) = vbNullString
If Not IsNull(objUser.GetEx("memberOf")) Then
If Not Err Then
For Each groupAdsPath in objUser.GetEx("memberOf")
Set objGroup = GetObject("LDAP://" & groupAdsPath)
If userInfo(11) <> vbnullstring Then
userInfo(11) = userInfo(11) & "・" & objGroup.CN
Else
userInfo(11) = objGroup.CN
End If
Next
End If
End If
Err.Clear
On Error GoTo 0
If Err Then
Call Term()
WScript.Echo "ユーザー情報取得に失敗しました！"
Else
WScript.Echo userInfo(4) & " の情報を取得しました。"
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' EXCELにユーザー情報を挿入する
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub setExcelBook()
On Error Resume Next
sql = vbNullString
sql = sql & "INSERT INTO [userInfo$]("
sql = sql & "ログオン名,"
sql = sql & "アカウント表示名,"
sql = sql & "アカウント有効・無効,"
sql = sql & "アカウントロック,"
sql = sql & "最終ログオン日時,"
sql = sql & "最終パスワード変更日時,"
sql = sql & "パスワード無期限,"
sql = sql & "説明,"
sql = sql & "所属グループ) "
sql = sql & "VALUES('"
sql = sql & userInfo(4) & "','"
sql = sql & userInfo(2) & "','"
sql = sql & userInfo(5) & "','"
sql = sql & userInfo(6) & "','"
sql = sql & userInfo(7) & "','"
sql = sql & userInfo(8) & "','"
sql = sql & userInfo(9) & "','"
sql = sql & userInfo(10) & "','"
sql = sql & userInfo(11) & "')"
con.Execute sql
If Err Then
WScript.Echo userInfo(4) & " のEXCEL出力に失敗しました！"
End If
End Sub