白執事の徒然なる日々

'************************************************************************
' PaSoRiが抜き差しされたタイミングで詳細情報を取得します。
'------------------------------------------------------------------------
' (1) WndProc() でUSBデバイスの抜き差しを検知します。
'     --> Windowsメッセージが WM_DEVICECHANGE の場合に処理
' (2) 別スレッドでPaSoRiの情報を取得します。
'     --> WMI(Windows Management Instrumentation)を使用
'         WMIの情報取得に多少時間がかかるため、別スレッドで実行します。
' (3) 別スレッドから画面のコントロールを操作します。
'     --> Delegateを宣言、Invokeで呼び出す
'------------------------------------------------------------------------
' VB.NETのマルチスレッドに関しては下記URLに具体的なサンプルがございます。
' http://codezine.jp/article/detail/135?p=1
'
' WMIに関しては下記URLを参考にしました。
' http://www.wmifun.net/library/win32_pnpentity.html
'************************************************************************

Imports System.Threading
Imports System.Management

Public Class Form1

    '================
    ' Win32 API 定数
    '================
    Private Const WM_DEVICECHANGE As Integer = &H219  'USBに抜き差しを検知

    '================
    ' フォームロード
    '================
    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        '-------------------------------------
        ' PaSoRi が接続済みの場合は情報を取得
        '-------------------------------------
        thread_GetWMI()
    End Sub

    '================================================
    ' 別スレッドから関数を呼び出すためのDelegate宣言
    '================================================
    Delegate Sub txtWMI_Clear_Delegate()
    Delegate Sub txtWMI_Show_Delegate(ByVal msg As String)

    '===================================================
    '【関数名】txtWMI_Clear
    '【引  数】なし
    '【戻り値】なし
    '---------------------------------------------------
    ' txtWMI.Text に表示されているメッセージを消去する。
    '===================================================
    Private Sub txtWMI_Clear()
        txtWMI.Text = ""
    End Sub

    '===========================================
    '【関数名】txtWMI_Show
    '【引  数】[in] String  表示するメッセージ
    '【戻り値】なし
    '-------------------------------------------
    ' txtWMI.Text に指定のメッセージを表示する。
    '===========================================
    Private Sub txtWMI_Show(ByVal msg As String)
        txtWMI.Text = msg
    End Sub

    '========================================================================
    '【関数名】WndProc
    '【引  数】System.Windows.Forms.Message  OSから送られたWindowsメッセージ
    '【戻り値】なし
    '------------------------------------------------------------------------
    ' Windowsメッセージを処理します。
    '========================================================================
    Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
        '--------------------
        ' デバイス変更の検知
        '--------------------
        If m.Msg = WM_DEVICECHANGE Then
            '時間のかかる処理を別スレッドで実行
            Dim th As New Thread(New ThreadStart(AddressOf thread_GetWMI))
            th.Start()
            Return
        End If

        '----------------------------------------
        ' 上記以外の場合はメッセージを処理しない
        '----------------------------------------
        MyBase.WndProc(m)
    End Sub

    '===============================================================================
    '【関数名】thread_GetWMI
    '【引  数】なし
    '【戻り値】なし
    '-------------------------------------------------------------------------------
    ' WMIの情報を取得して、txtWMI.Textに表示する。
    ' デバイス名に PaSoRi が含まれていて、正常に動作しているものだけを抜き出します。
    '===============================================================================
    Private Sub thread_GetWMI()
        Try
            '--------------------------------
            ' Delegate宣言した関数の使用準備
            '--------------------------------
            Dim txtWMIClear As New txtWMI_Clear_Delegate(AddressOf txtWMI_Clear)
            Dim txtWMIShow As New txtWMI_Show_Delegate(AddressOf txtWMI_Show)

            '--------------------------------
            ' テキストボックスの情報をクリア
            '--------------------------------
            Invoke(txtWMIClear)

            '--------------------
            ' デバイス情報を取得
            '--------------------
            Dim oms As New ManagementObjectSearcher
            Dim omc As ManagementObjectCollection

            'デバイス名に PaSoRi が含まれていて、正常に動作しているものを検索する
            oms.Query.QueryString = "select * from Win32_PnPEntity " & _
                                    "where Name like '%PaSoRi%' and ConfigManagerErrorCode = 0"
            omc = oms.Get()

            Dim msg As String = ""

            For Each mo As ManagementObject In omc

                Dim list_CompatibleID As String()
                Dim list_HardwareID As String()
                Dim dt As New DateTime

                'Availability
                Select Case mo.Item("Availability")
                    Case 3
                        msg &= "Availability：[3] 電力 - 通常"
                    Case 4
                        msg &= "Availability：[4] 電力 - 警告"
                    Case 5
                        msg &= "Availability：[5] 電力 - テスト中"
                    Case 10
                        msg &= "Availability：[10] 電力 - 低下"
                    Case 13
                        msg &= "Availability：[13] 省電力 - 不明"
                    Case 14
                        msg &= "Availability：[14] 省電力 - 低電力モード"
                    Case 15
                        msg &= "Availability：[15] 省電力 - スタンバイ"
                    Case 17
                        msg &= "Availability：[17] 省電力 - 警告"
                    Case Else
                        msg &= "Availability："
                End Select
                msg &= vbNewLine

                'Caption
                msg &= "Caption：" & mo.Item("Caption") & vbNewLine

                'ClassGuid
                msg &= "ClassGuid：" & mo.Item("ClassGuid") & vbNewLine

                'CompatibleID
                msg &= "CompatibleID："
                If mo.Item("CompatibleID") IsNot Nothing Then
                    list_CompatibleID = mo.Item("CompatibleID")
                    For I As Integer = 0 To list_CompatibleID.Length() - 1
                        msg &= list_CompatibleID(I)

                        If I <> list_CompatibleID.Length() - 1 Then
                            msg &= ", "
                        End If
                    Next
                End If
                msg &= vbNewLine

                'ConfigManagerErrorCode
                Select Case mo.Item("ConfigManagerErrorCode")
                    Case 0
                        msg &= "ConfigManagerErrorCode：[0] " & _
                               "このデバイスは正常に動作しています。"
                    Case 1
                        msg &= "ConfigManagerErrorCode：[1] " & _
                               "このデバイスは正しく構成されていません。"
                    Case 2
                        msg &= "ConfigManagerErrorCode：[2] " & _
                               "このデバイスのドライバーを読み込めません。"
                    Case 3
                        msg &= "ConfigManagerErrorCode：[3] " & _
                               "このデバイスのドライバーは壊れているか、" & _
                               "あるいはメモリまたは他のリソースが不足している状態で" & _
                               "システムが実行されている可能性があります。"
                    Case 4
                        msg &= "ConfigManagerErrorCode：[4] " & _
                               "このデバイスは正常に動作していません。" & _
                               "ドライバーまたはレジストリが壊れている可能性があります。"
                    Case 5
                        msg &= "ConfigManagerErrorCode：[5] " & _
                               "このデバイスのドライバーには Windows が管理できないリソースが必要です。"
                    Case 6
                        msg &= "ConfigManagerErrorCode：[6] " & _
                               "このデバイスのブート構成が他のデバイスと競合しています。"
                    Case 7
                        msg &= "ConfigManagerErrorCode：[7] " & _
                               "フィルター処理できません。"
                    Case 8
                        msg &= "ConfigManagerErrorCode：[8] " & _
                               "デバイスのドライバー ローダーが見つかりません。"
                    Case 9
                        msg &= "ConfigManagerErrorCode：[9] " & _
                               "このデバイスを制御するファームウェアからリソースが正しく報告されないため、" & _
                               "このデバイスは正常に動作していません。"
                    Case 10
                        msg &= "ConfigManagerErrorCode：[10] " & _
                               "このデバイスを開始できません。"
                    Case 11
                        msg &= "ConfigManagerErrorCode：[11] " & _
                               "このデバイスはエラーで停止しました。"
                    Case 12
                        msg &= "ConfigManagerErrorCode：[12] " & _
                               "このデバイスで使用できる十分な空きリソースが見つかりません。"
                    Case 13
                        msg &= "ConfigManagerErrorCode：[13] " & _
                               "このデバイスのリソースを確認できません。"
                    Case 14
                        msg &= "ConfigManagerErrorCode：[14] " & _
                               "コンピューターを再起動するまでこのデバイスは正常に動作しません。"
                    Case 15
                        msg &= "ConfigManagerErrorCode：[15] " & _
                               "このデバイスは、再列挙に問題が発生している可能性があり、" & _
                               "正常に動作していません。"
                    Case 16
                        msg &= "ConfigManagerErrorCode：[16] " & _
                               "このデバイスで使用される一部のリソースを認識できません。"
                    Case 17
                        msg &= "ConfigManagerErrorCode：[17] " & _
                               "このデバイスは不明なリソースの種類を要求しています。"
                    Case 18
                        msg &= "ConfigManagerErrorCode：[18] " & _
                               "このデバイスのドライバーを再インストールしてください。"
                    Case 19
                        msg &= "ConfigManagerErrorCode：[19] " & _
                               "レジストリが壊れている可能性があります。"
                    Case 20
                        msg &= "ConfigManagerErrorCode：[20] " & _
                               "VxD ローダーの使用に失敗しました。"
                    Case 21
                        msg &= "ConfigManagerErrorCode：[21] " & _
                               "システム エラー: このデバイスのドライバーを変更してみてください。" & _
                               "うまくいかない場合はハードウェアのマニュアルを参照してください。" & _
                               "このデバイスは削除されます。"
                    Case 22
                        msg &= "ConfigManagerErrorCode：[22] " & _
                               "このデバイスは無効になっています。"
                    Case 23
                        msg &= "ConfigManagerErrorCode：[23] " & _
                               "システム障害: このデバイスのドライバーを変更してみてください。" & _
                               "うまくいかない場合はハードウェアのマニュアルを参照してください。"
                    Case 24
                        msg &= "ConfigManagerErrorCode：[24] " & _
                               "このデバイスは存在しないか、正常に動作していないか、" & _
                               "または一部のドライバーがインストールされていません。"
                    Case 25
                        msg &= "ConfigManagerErrorCode：[25] " & _
                               "このデバイスはまだセットアップ処理中です。"
                    Case 26
                        msg &= "ConfigManagerErrorCode：[26] " & _
                               "このデバイスはまだセットアップ処理中です。"
                    Case 27
                        msg &= "ConfigManagerErrorCode：[27] " & _
                               "このデバイスに有効なログ構成がありません。"
                    Case 28
                        msg &= "ConfigManagerErrorCode：[28] " & _
                               "このデバイスのドライバーはインストールされていません。"
                    Case 29
                        msg &= "ConfigManagerErrorCode：[29] " & _
                               "このデバイスは、必要なリソースがデバイスのファームウェアから" & _
                               "提供されなかったため無効になっています。"
                    Case 30
                        msg &= "ConfigManagerErrorCode：[30] " & _
                               "このデバイスは、他のデバイスが使用している" & _
                               "割り込み要求 (IRQ) リソースを使用しています。"
                    Case 31
                        msg &= "ConfigManagerErrorCode：[31] " & _
                               "このデバイスは、このデバイスに必要なドライバーを" & _
                               "読み込めないため正常に動作していません。"
                    Case Else
                        msg &= "ConfigManagerErrorCode："
                End Select
                msg &= vbNewLine

                'ConfigManagerUserConfig
                If mo.Item("ConfigManagerUserConfig") Then
                    msg &= "ConfigManagerUserConfig：[TRUE] " & _
                           "デバイスがユーザー定義の構成を使用しています。"
                Else
                    msg &= "ConfigManagerUserConfig：[FALSE] " & _
                           "デバイスがユーザー定義の構成を使用していません。"
                End If
                msg &= vbNewLine

                'CreationClassName
                msg &= "CreationClassName：" & mo.Item("CreationClassName") & vbNewLine

                'Description
                msg &= "Description：" & mo.Item("Description") & vbNewLine

                'DeviceID
                msg &= "DeviceID：" & mo.Item("DeviceID") & vbNewLine

                'ErrorCleared
                If mo.Item("ErrorCleared") Then
                    msg &= "ErrorCleared：[TRUE] " & _
                           "LastErrorCode プロパティで報告されたエラーが現在解決されています。"
                Else
                    msg &= "ErrorCleared：[FALSE] " & _
                           "LastErrorCode プロパティで報告されたエラーが現在解決されていません。"
                End If
                msg &= vbNewLine

                'ErrorDescription
                msg &= "ErrorDescription：" & mo.Item("ErrorDescription") & vbNewLine

                'HardwareID
                msg &= "HardwareID："
                If mo.Item("HardwareID") IsNot Nothing Then
                    list_HardwareID = mo.Item("HardwareID")
                    For I As Integer = 0 To list_HardwareID.Length() - 1
                        msg &= list_HardwareID(I)

                        If I <> list_HardwareID.Length() - 1 Then
                            msg &= ", "
                        End If
                    Next
                End If
                msg &= vbNewLine

                'InstallDate
                If mo.Item("InstallDate") Is Nothing Then
                    msg &= "InstallDate："
                Else
                    dt = mo.Item("InstallDate")
                    msg &= "InstallDate：" & _
                           String.Format("{0:0000}/{1:00}/{2:00} {3:00}:{4:00}:{5:00}", _
                                         dt.Year, dt.Month, dt.Day, dt.Hour, dt.Minute, dt.Second)
                End If
                msg &= vbNewLine

                'LastErrorCode
                msg &= "LastErrorCode：" & CStr(mo.Item("LastErrorCode")) & vbNewLine

                'Manufacturer
                msg &= "Manufacturer：" & mo.Item("Manufacturer") & vbNewLine

                'Name
                msg &= "Name：" & mo.Item("Name") & vbNewLine

                'PNPDeviceID
                msg &= "PNPDeviceID：" & mo.Item("PNPDeviceID") & vbNewLine

                'PowerManagementCapabilities
                Select Case mo.Item("PowerManagementCapabilities")
                    Case 0
                        msg &= "PowerManagementCapabilities：[0] 不明"
                    Case 1
                        msg &= "PowerManagementCapabilities：[1] サポートされていません"
                    Case 2
                        msg &= "PowerManagementCapabilities：[2] 無効"
                    Case 3
                        msg &= "PowerManagementCapabilities：[3] 有効"
                    Case 4
                        msg &= "PowerManagementCapabilities：[4] 自動省電力モード"
                    Case 5
                        msg &= "PowerManagementCapabilities：[5] 電源の状態設定可能"
                    Case 6
                        msg &= "PowerManagementCapabilities：[6] 電源サイクル サポート"
                    Case 7
                        msg &= "PowerManagementCapabilities：[7] 時刻指定電源オン サポート"
                    Case Else
                        msg &= "PowerManagementCapabilities："
                End Select
                msg &= vbNewLine

                'PowerManagementSupported
                If mo.Item("PowerManagementSupported") Then
                    msg &= "PowerManagementSupported：[TRUE] " & _
                           "デバイスの電源管理が可能。"
                Else
                    msg &= "PowerManagementSupported：[FALSE] " & _
                           "デバイスの電源管理がサポートされていません。"
                End If
                msg &= vbNewLine

                'Service
                msg &= "Service：" & mo.Item("Service") & vbNewLine

                'Status
                msg &= "Status：" & mo.Item("Status") & vbNewLine

                'StatusInfo
                Select Case mo.Item("StatusInfo")
                    Case 1
                        msg &= "StatusInfo：[1]その他の状態"
                    Case 2
                        msg &= "StatusInfo：[2]不明な状態"
                    Case 3
                        msg &= "StatusInfo：[3]論理デバイスが有効"
                    Case 4
                        msg &= "StatusInfo：[4]無効"
                    Case 5
                        msg &= "StatusInfo：[5]該当なし"
                    Case Else
                        msg &= "StatusInfo："
                End Select
                msg &= vbNewLine

                'SystemCreationClassName
                msg &= "SystemCreationClassName：" & mo.Item("SystemCreationClassName") & vbNewLine

                'SystemName
                msg &= "SystemName：" & mo.Item("SystemName") & vbNewLine
                msg &= vbNewLine
            Next

            '------------------
            ' 画面に情報を表示
            '------------------
            Invoke(txtWMIShow, New Object() {msg})
        Catch ex As Exception
            MessageBox.Show(ex.Message, Me.Text, MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
        End Try
    End Sub
End Class