モンスターカレンダー

« 2011年7月 »
12345678910111213141516171819202122232425262728293031

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

| Windows
このエントリーをはてなブックマークに追加

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



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

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


以下がScriptの内容です。


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' PG : ActiveDirectoryの調査
' Author : 2011/07/16 kibanteam
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 定数(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


userInfo.zip



この記事がお役に立てましたら応援をお願いします^^
このエントリーをはてなブックマークに追加

関連記事

  1. パソコンのキーボードをかえてみた
  2. ノートPC購入計画
  3. PCのサーマルシャットダウン
  4. 7年ぶりに外付けHDDを新調しました
  5. 明日で一部のインターネット利用でサポートが終了する
  6. WIndwsXPのサポート終了が近づいているが・・
  7. ローカルAdministratorsからグループ・ユーザーを削除するVBScript
  8. ローカルAdministratorsにグループを追加作成するVBScript
  9. IE9インストール後の不具合
  10. 共有フォルダへのアクセスを確認する方法
  11. Excel2007の表からHTMLテーブルタグを簡単生成する方法
  12. EXCELでメール送信
  13. IE9の速度を計測してみた
  14. IE9をインストールしてみた
  15. LAN内のWindowsPCのフォルダ・ファイルを操作する

コメントする






MT42BlogBetaInner

ブログ管理人:Tama


管理人のTamaです

メールフォーム
メールフォーム

おきてがみ


トップページーリンク

おすすめレンタルサーバー

★初期費用半額+最大2ケ月無料キャンペーン中!
おすすめレンタルサーバー! ミニバード

おすすめテンプレート

★MT・WP用SEOテンプレート!
クールでかっこいいMT&WordPressテーマ

ブログパーツ

MovableType(MT)テンプレート 無料(フリー)