- 2009-08-03 (月) 2:37
- Windows
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
関連する記事
- Newer : コマンドプロンプトでYを自動的に入力する方法
- Older : VBスクリプトでコンピュータの起動時間を表示させる方法
Comments:0
Trackbacks:0
- Trackback URL for this entry
- http://pnpk.net/cms/archives/2404/trackback
- Listed below are links to weblogs that reference
- Active Directory上からコンピュータオブジェクトを取得し、オンラインだった場合に起動時間を取得するスクリプト from http://pnpk.net