Option Explicit

Dim DX As New DirectX7
Dim DI As DirectInput
Dim DIED As DirectInputEnumDevices

Private Sub Form_Load()
  On Error GoTo ErrOut

  Set DI = DX.DirectInputCreate()

  GetIOListe True
  DisplayInfos lst_DID.ListIndex + 1

  Exit Sub
ErrOut:
  MsgBox "Zugriff auf DirectInput nicht möglich." & vbCr & _
      Err.Number & "/" & Err.Description, vbInformation
  End
End Sub

Private Sub GetIOListe(Alle As Boolean)
  Dim i As Single

  On Error GoTo ErrOut
  Set DIED = Nothing

  If Alle Then
    Set DIED = DI.GetDIEnumDevices(0, DIEDFL_INCLUDEPHANTOMS)
  Else
    Set DIED = DI.GetDIEnumDevices(0, DIEDFL_ATTACHEDONLY)
  End If

  With lst_DID
    .Clear
    For i = 1 To DIED.GetCount
      .AddItem DIED.GetItem(i).GetProductName
    Next
    .ListIndex = 0
  End With

  Exit Sub
ErrOut:
  MsgBox "Zugriff auf DirectInput-Auflistung nicht möglich." & _
      vbCr & Err.Number & "/" & Err.Description, vbInformation
  End
End Sub

Private Sub DisplayInfos(DeviceNummer As Single)
  On Error GoTo ErrOut

  txt_DeviceInfos.Text = _
      "ProductName: " & _
      DIED.GetItem(DeviceNummer).GetProductName & vbCrLf & _
      "InstanceName: " & _
      DIED.GetItem(DeviceNummer).GetInstanceName & vbCrLf & _
      "GuidInstance: " & _
      DIED.GetItem(DeviceNummer).GetGuidInstance & vbCrLf & _
      "GuidProduct: " & DIED.GetItem(DeviceNummer).GetGuidProduct

  Exit Sub
ErrOut:
  MsgBox "Zugriff auf DirectInput-Device-Infos nicht möglich." & _
      vbCr & Err.Number & "/" & Err.Description, vbInformation
End Sub

Private Sub lst_DID_Click()
  DisplayInfos lst_DID.ListIndex + 1
End Sub

Private Sub chk_attachedonly_Click()
  If chk_attachedonly.Value = 0 Then
    GetIOListe True
  Else
    GetIOListe False
  End If

  DisplayInfos lst_DID.ListIndex + 1
End Sub

Private Sub cmd_System_Click()
  DI.RunControlPanel Me.hWnd
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, _
      UnloadMode As Integer)
  cmd_Close_Click
End Sub

Private Sub cmd_Close_Click()
  Set DIED = Nothing
  Set DI = Nothing
  Set DX = Nothing

  Unload Me
  End
End Sub