直近の起動・終了日時を取得するFunction
Windowsの起動・終了時刻を返すFunction
※改良版はコチラ。
直近の起動・終了時刻を返す
前回の
のリスト1に手を加えて、
- 直近のシャットダウン日時
- 今回の起動日時
を取得するFunctionを作ってみる。
今回作成したコード
とりあえず全体を載っけておく。
リスト1 標準モジュール
'///リスト1-1' '///直近のWindows起動時刻を返す' Public Function getLastStartUpDateTime() As Date On Error GoTo errorHandler Dim strComputer As String Dim objWMIService As Object Dim colLoggedEvents As Object Dim objEvent As Object Dim retTimeWritten As Date strComputer = "." Set objWMIService = GetObject("winmgmts:" & _ "{impersonationLevel=impersonate}!\\" & _ strComputer & _ "\root\cimv2") Set colLoggedEvents = _ objWMIService.ExecQuery("SELECT * FROM Win32_NTLogEvent " & _ "WHERE Logfile = 'System' AND EventCode = '6005'") If Not colLoggedEvents Is Nothing Then For Each objEvent In colLoggedEvents retTimeWritten = convUTCtoJST(parseTimeWritten(objEvent.timeWritten)) getLastStartUpDateTime = retTimeWritten Exit For Next End If errorHandler: Set objWMIService = Nothing Set colLoggedEvents = Nothing Set objEvent = Nothing End Function '///リスト1-2' '///直近のWindowsシャットダウン時刻を返す' Public Function getLastShutDownDateTime() As Date On Error GoTo errorHandler Dim strComputer As String Dim objWMIService As Object Dim colLoggedEvents As Object Dim objEvent As Object Dim retTimeWritten As Date strComputer = "." Set objWMIService = GetObject("winmgmts:" & _ "{impersonationLevel=impersonate}!\\" & _ strComputer & _ "\root\cimv2") Set colLoggedEvents = _ objWMIService.ExecQuery("SELECT * FROM Win32_NTLogEvent " & _ "WHERE Logfile = 'System' AND EventCode = '6006'") If Not colLoggedEvents Is Nothing Then For Each objEvent In colLoggedEvents retTimeWritten = convUTCtoJST(parseTimeWritten(objEvent.timeWritten)) getLastShutDownDateTime = retTimeWritten Exit For Next End If errorHandler: Set objWMIService = Nothing Set colLoggedEvents = Nothing Set objEvent = Nothing End Function '///リスト1-3' Private Function parseTimeWritten(ByVal receiveData As Variant) As Date parseTimeWritten = _ CDate(Mid(receiveData, 1, 4) & "/" & _ Mid(receiveData, 5, 2) & "/" & _ Mid(receiveData, 7, 2) & _ " " & _ Mid(receiveData, 9, 2) & ":" & _ Mid(receiveData, 11, 2) & ":" & _ Mid(receiveData, 13, 2)) End Function '///リスト1-4' Private Function convUTCtoJST(ByVal timeData As Date) As Date convUTCtoJST = DateAdd("h", 9, timeData) End Function
リスト1-1、1-2がメインの処理をするFunction、リスト1-3、1-4は日付時刻データの整形及び変換に使うFunction。
リスト1-3と1-4については、引数の名前を変えて、インデントを整えただけ。前回から基本的には何も変わっていない。
リスト1-1 直近のWindows起動時刻を返す
Public Function getLastStartUpDateTime() As Date On Error GoTo errorHandler Dim strComputer As String Dim objWMIService As Object Dim colLoggedEvents As Object Dim objEvent As Object Dim retTimeWritten As Date strComputer = "." Set objWMIService = GetObject("winmgmts:" & _ "{impersonationLevel=impersonate}!\\" & _ strComputer & _ "\root\cimv2") '……(1)' Set colLoggedEvents = _ objWMIService.ExecQuery("SELECT * FROM Win32_NTLogEvent " & _ "WHERE Logfile = 'System' AND EventCode = '6005'") '……(2)' If Not colLoggedEvents Is Nothing Then '……(3)' For Each objEvent In colLoggedEvents '……(4)' retTimeWritten = convUTCtoJSC(parseTimeWritten(objEvent.timeWritten)) getLastStartUpDateTime = retTimeWritten Exit For '……(5)' Next End If errorHandler: '……(6)' Set objWMIService = Nothing Set colLoggedEvents = Nothing Set objEvent = Nothing End Function
(1)の
Set objWMIService = GetObject("winmgmts:" & _ "{impersonationLevel=impersonate}!\\" & _ strComputer & _ "\root\cimv2")
は、WMIサービスのインスタンスをobjWMIServiceというオブジェクト変数にぶち込んでいるだけ。GetObject関数の引数を少しでも読みやすくするために改行を入れてみた。
(2)も
Set colLoggedEvents = _ objWMIService.ExecQuery("SELECT * FROM Win32_NTLogEvent " & _ "WHERE Logfile = 'System' AND EventCode = '6005'")
前回のコードと同じだが、クエリの部分を大文字にしてそれっぽくしてみたw
大きく変えたのはここから。
元のコードでは、ここの条件判定を
If colLoggedEvents.Count > 0 Then
こうしていた。最初はこのままにしていたんだが、全体の処理に異様に時間がかかる。
で、ステップ実行で見ているとここの処理で異様に時間がかかっていた。
Countプロパティの値を参照するためには、イベントログコレクションを全て取得しなくてはならず、そのために時間がかかっているのだと考えた。そこで、上掲(3)の通り、
If Not colLoggedEvents Is Nothing Then
とした。
とにかくcolLoggedEventsコレクションに何かセットされていたらよし、としたわけ。
Object型変数の初期値は「Nothing」だとどこかで見たことがあるので(←裏取れよ)、とりあえずこうした。今のところ、爆速になっている。
で、(4)では
For Each objEvent In colLoggedEvents
の形でcolLoggedEventsコレクションの要素をFor Eachで回すことにしている。
前回の実行結果でもお分かりの通り、イベントログは現在→過去の順に取得しているっぽいので、たとえば、
Set objEvent = colLoggedEvents.Item(1)
とかで行けると思ったが、こうするとエラーになった。
だもんで、ブサイクなのは承知の上で、For Eachのループの中に条件判定も何もなしで(5)のように
Exit For
と書くというマヌケなことに……。
ここは少し改良の余地があるな。
(6)の
errorHandler: Set objWMIService = Nothing Set colLoggedEvents = Nothing Set objEvent = Nothing
は、おなじみのエラーキャッチブロックなんだが、普通だとラベルの直前に書くべき
Exit Function
を書いていない。
Object型という得体の知れない型の変数を用いているので、オブジェクト変数の解放はやるべきだと思ったが、どの道解放するなら処理を2回書かなくても済むと思ったので……。これで問題あるようなら誰か教えてくだされ。
リスト1-2 直近のWindowsシャットダウン時刻を返す
Public Function getLastShutDownDateTime() As Date On Error GoTo errorHandler Dim strComputer As String Dim objWMIService As Object Dim colLoggedEvents As Object Dim objEvent As Object Dim retTimeWritten As Date strComputer = "." Set objWMIService = GetObject("winmgmts:" & _ "{impersonationLevel=impersonate}!\\" & _ strComputer & _ "\root\cimv2") Set colLoggedEvents = _ objWMIService.ExecQuery("SELECT * FROM Win32_NTLogEvent " & _ "WHERE Logfile = 'System' AND EventCode = '6006'") If Not colLoggedEvents Is Nothing Then For Each objEvent In colLoggedEvents retTimeWritten = convUTCtoJSC(parseTimeWritten(objEvent.timeWritten)) getLastShutDownDateTime = retTimeWritten Exit For Next End If errorHandler: Set objWMIService = Nothing Set colLoggedEvents = Nothing Set objEvent = Nothing End Function
中身はほとんど同じなので、説明は省略。っていうか、違いはイベントコードの「6005」と「6006」だけなんだから、イベントコードを引数にして一つのFunctionにまとめりゃいいじゃねーか、ということですよね。ははは。
ついでに、日付時刻文字列を整形・変換するコードも分けて載せておく。
リスト1-3 日付時刻文字列を標準の日付時刻形式に変換する
Private Function parseTimeWritten(ByVal receiveData As Variant) As Date parseTimeWritten = _ CDate(Mid(receiveData, 1, 4) & "/" & _ Mid(receiveData, 5, 2) & "/" & _ Mid(receiveData, 7, 2) & _ " " & _ Mid(receiveData, 9, 2) & ":" & _ Mid(receiveData, 11, 2) & ":" & _ Mid(receiveData, 13, 2)) End Function
リスト1-4 USCをJSTに変換する
Private Function convUTCtoJST(ByVal timeData As Date) As Date convUTCtoJST = DateAdd("h", 9, timeData) End Function
実行結果
次のコードで実行する。
リスト2 標準モジュール
Public Sub testGetWindowsLog() MsgBox "前回シャットダウン日時" & vbCrLf & getLastShutDownDateTime MsgBox "今回起動日時" & vbCrLf & getLastStartUpDateTime End Sub
あれれ??? なんかおかしいぞ……。
どうやら、Windows10では、「シャットダウンしたつもりだけれど実はシャットダウンしていない」ということがあるらしい……orz
おわりに
ともあれ、イベントコードを渡せば、直近の当該イベントについてWindowsのログを引っ張ってくることができるようなので、いろいろと応用ができそうですなあ。