Active Directory上からコンピュータオブジェクトを取得し、オンラインだった場合に起動時間を取得するスクリプト

Active Directory上からコンピュータオブジェクトを取得し、オンラインだった場合に起動時間を取得します。
オンラインかどうかの判定はPINGで行っているので、PING応答しないコンピュータはオフラインとみなされます。

動作させる場合には、以下の部分を利用しているドメイン名に変更してください。

DomainName = "dc=pnpk,dc=local"

クエリ内容をクライアントOSだけに絞りこめば、コンピュータを再起動しないで帰宅するアンチ省エネな社員を見つける事が出来るかもしれません。

'Active Directory上のコンピュータオブジェクトを参照し、コンピュータがオンラインだった場合に起動時間を取得します。
Option Explicit

Const ADS_SCOPE_SUBTREE = 2
Dim DomainName
'利用ドメインに合わせて以下の文字列を変更します。
DomainName = "dc=pnpk,dc=local"

Call Main()

Sub Main()
	Dim Query
	Query = "SELECT distinguishedName FROM 'LDAP://" & _
			 DomainName & "' WHERE objectCategory='computer'"
	Call QueryADSI(Query)
End Sub

'SQLクエリでActive Directory内を検索します。
Function QueryADSI(SQL)
	On Error Resume Next
	
	Dim objConnection
	Dim objCommand

	Set objConnection =_
	 CreateObject("ADODB.Connection")
	Set objCommand =_
	 CreateObject("ADODB.Command")
	objConnection.Provider = "ADsDSOObject"
	objConnection.Open "Active Directory Provider"
	Set objCommand.ActiveConnection = objConnection

	objCommand.Properties("Page Size") = 1000
	objCommand.Properties("Searchscope") =_
	 ADS_SCOPE_SUBTREE

	objCommand.CommandText = SQL

	Dim objRecordSet
	Dim strOBJ

	Set objRecordSet = objCommand.Execute

	objRecordSet.MoveFirst

	Do Until objRecordSet.EOF
		
		strOBJ = ShowStatus(objRecordSet.Fields("distinguishedName").Value)
		
		'ShowStatusの呼び出し
		If PingResult(strOBJ) Then
			'Function BootUpTime呼び出し
			Wscript.Echo BootUpTime(strOBJ)
		Else
			Wscript.Echo strOBJ & "は起動していません。"
		End If
		objRecordSet.MoveNext
	Loop
End Function

'DNからその他の情報を取得
Function ShowStatus(DN)
	Dim objDN
	Set objDN = GetObject("LDAP://" & DN )
	ShowStatus = Mid(objDN.Name,4)
	Set objDN = Nothing
End Function

'strComputerにpingを行って成功したらPingResultにTrueを返す
Function PingResult(strComputer) 
	Dim objWMIService
	Dim colItems
	Dim objItem

	Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
	Set colItems = objWMIService.ExecQuery _
	    ("Select * from Win32_PingStatus " & _
			"Where Address = '" & strComputer & "'")
	For Each objItem in colItems
	    If objItem.StatusCode = 0 Then
	        PingResult = True
	    Else
	    	PingResult = False
	    End If
	Next

	Set objWMIService = Nothing
	Set colItems = Nothing
End Function

'コンピュータの起動時間を文字列で返します。
Function BootUpTime(strComputer)
	Dim objWMIService
	Dim colOperatingSystems
	Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
	Set colOperatingSystems = objWMIService.ExecQuery _
	    ("Select * from Win32_OperatingSystem")
	
	Dim objOS
	Dim dtmBootup
	Dim dtmLastBootupTime
	Dim dtmSystemUptime
	
	For Each objOS in colOperatingSystems
	    dtmBootup = objOS.LastBootUpTime

	    dtmLastBootupTime = WMIDateStringToDate(dtmBootup)
	    dtmSystemUptime = DateDiff("s", dtmLastBootUpTime, Now)
	    BootUpTime = strComputer & "の起動時間は" & Second2Time(dtmSystemUptime,1) & "です。"
	Next
End Function

'UTC時間を時刻に変換 ※BootUpTimeとセットです。
Function WMIDateStringToDate(dtmBootup)
    WMIDateStringToDate = CDate(Mid(dtmBootup, 5, 2) & "/" & _
        Mid(dtmBootup, 7, 2) & "/" & Left(dtmBootup, 4) _
            & " " & Mid (dtmBootup, 9, 2) & ":" & _
                Mid(dtmBootup, 11, 2) & ":" & Mid(dtmBootup,13, 2))
End Function

'秒を時分秒に変換 ※BootUpTimeとセットです。
Function Second2Time(intSec,int)
	Dim Day
	Dim Hour
	Dim Minute
	Dim Second
	
	Day    = intSec \ 86400
	Hour   = (intSec - Day * 86400) \ 3600
	Minute = (intSec - Day * 86400 - Hour * 3600) \ 60
	Second = intSec - Day * 86400 - Hour * 3600 - Minute * 60

	Select Case int
		Case 0
			Second2Time = Day & ":" & LeadingZero(Hour) & ":" & LeadingZero(Minute) & ":" & LeadingZero(Second)
		Case 1
			Second2Time = Day & "日" & LeadingZero(Hour) & "時間" & LeadingZero(Minute) & "分" & LeadingZero(Second) & "秒"
		Case Else
			Second2Time = ""
	End Select
End Function

'数値の整形 ※Second2Timeとセットです。
Function LeadingZero(intNumber)
	If intNumber < 10 Then
		LeadingZero = "0" & intNumber
	Else
		LeadingZero = intNumber
	End If
End Function