ActiveDirectoryのユーザー情報を取得するVBScript

ActiveDirectoryのユーザー情報を取得するVBScript

興味のある方は少ないと思いますが、ActiveDirectoryからユーザー情報を抽出するVBScriptを作成したので、備忘録として記事にしておきます。

Scriptを実行する事により、以下の情報を取得する事ができます。
取得後、EXCELシートに情報を格納します。

  1. ログオン名
  2. アカウント表示名
  3. アカウントの有効/無効状態
  4. アカウントのロック状態
  5. 最終ログオン日時
  6. 最終パスワード変更日時
  7. パスワード無期限かどうか
  8. アカウントの説明
  9. 所属グループ

以下が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

プログラムカテゴリの最新記事