直近の起動・終了日時を取得するFunction

Windowsの起動・終了時刻を返すFunction

※改良版はコチラ

直近の起動・終了時刻を返す

前回の

akashi-keirin.hatenablog.com

リスト1に手を加えて、

  1. 直近のシャットダウン日時
  2. 今回の起動日時

を取得する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

f:id:akashi_keirin:20171105085124j:plain

f:id:akashi_keirin:20171105085132j:plain

あれれ??? なんかおかしいぞ……。

どうやら、Windows10では、「シャットダウンしたつもりだけれど実はシャットダウンしていない」ということがあるらしい……orz

おわりに

ともあれ、イベントコードを渡せば、直近の当該イベントについてWindowsのログを引っ張ってくることができるようなので、いろいろと応用ができそうですなあ。

@akashi_keirin on Twitter

コチラもどうぞ

akashi-keirin.hatenablog.com

akashi-keirin.hatenablog.com