Tipp 0142 DirectX enumerieren
Autor/Einsender:
Datum:		   Jack Hoxley
18.10.2001
Entwicklungsumgebung:
DirectX-Version:		   VB 6
DirectX 7
Mit diesem Tipp ist es möglich, alle installierten DirectX-Komponenten mit den entsprechend installierten Treibern auszulesen.
  
Option Explicit

Dim Dx As New DirectX7

Dim D3D As Direct3D7
Dim D3DDesc As D3DDEVICEDESC7
Dim D3DEnum As Direct3DEnumDevices

Dim DD As DirectDraw7
Dim DDEnum As DirectDrawEnum

Dim Ds As DirectSound
Dim DsEnum As DirectSoundEnum

Dim Di As DirectInput
Dim DiEnum As DirectInputEnumDevices

Dim Dp As DirectPlay4
Dim DpEnum As DirectPlayEnumConnections

Private Sub Form_Load()
  Me.Show

  Me.Width = Screen.Width
  Me.Left = 0
  List.Width = Me.ScaleWidth
  List.Top = 32
  List.Height = Me.ScaleHeight - 48
  Label2.Top = List.Top + List.Height
  Label2.Width = Me.ScaleWidth

  Dim colX As ColumnHeader
  Dim intX As Integer

  Set colX = List.ColumnHeaders.Add()
  colX.Text = "Component"
  colX.Width = List.Width / 3.1
  colX.Key = "components"

  Set colX = List.ColumnHeaders.Add()
  colX.Text = "Device Driver"
  colX.Width = List.Width / 3
  colX.Key = "devices"

  Set colX = List.ColumnHeaders.Add()
  colX.Text = "GUID"
  colX.Width = List.Width / 3
  colX.Key = "guids"

  pBar.Left = Label1.Left + Label1.Width
  pBar.Top = 0
  pBar.Height = 16
  pBar.Width = Me.ScaleWidth - pBar.Left

  pBar2.Left = Label1.Left + Label1.Width
  pBar2.Top = 16
  pBar2.Height = 16
  pBar2.Width = Me.ScaleWidth - pBar2.Left

  DoEvents

  GetDirectDrawDevices
  DoEvents
  GetDirect3DDevices
  DoEvents
  GetDirectSoundDevices
  DoEvents
  GetDirectSoundRecordDevices
  DoEvents
  GetDirectInputDevicesKBoard
  DoEvents
  GetDirectInputDevicesJStick
  DoEvents
  GetDirectInputDevicesMouse
  DoEvents
  GetDirectPlayDevices
  DoEvents

  Label1.Caption = "Collected All Data"
  pBar.Value = 0
  pBar.Visible = False
  pBar2.Value = 0
  pBar2.Visible = False
  List.GridLines = True
End Sub

Sub GetDirectDrawDevices()
  Label1.Caption = "Getting DirectDraw Devices"

  Dim itmX As ListItem, I As Integer, s As String

  Set itmX = List.ListItems.Add()
  itmX.Text = "DirectDraw"

  Set DDEnum = Dx.GetDDEnum()
  pBar2.Value = 0
  pBar2.Max = DDEnum.GetCount

  itmX.ListSubItems.Add , , DDEnum.GetDescription(1)
  s = DDEnum.GetGuid(1)

  If s = "" Then _
     s = " [DD returns a null string for the default device]"
  itmX.ListSubItems.Add , , s
  pBar2.Value = pBar2.Value + 1
  DoEvents

  For I = 2 To DDEnum.GetCount()
    Set itmX = List.ListItems.Add()
    itmX.Text = ""
    itmX.ListSubItems.Add , , DDEnum.GetDescription(I)
    s = DDEnum.GetGuid(I)
    If s = "" Then _
       s = " [DD returns a null string for the default device]"
    itmX.ListSubItems.Add , , s
    pBar2.Value = pBar2.Value + 1
    DoEvents
  Next I

  pBar.Value = pBar.Value + 1
End Sub

Sub GetDirect3DDevices()
  Label1.Caption = "Getting Direct3D Devices"

  Set DD = Dx.DirectDrawCreate("")
  Set D3D = DD.GetDirect3D()

  Set D3DEnum = D3D.GetDevicesEnum()
  pBar2.Value = 0
  pBar2.Max = D3DEnum.GetCount

  Dim itmX As ListItem, I As Integer

  Set itmX = List.ListItems.Add()
  itmX.Text = "Direct3D"

  itmX.ListSubItems.Add , , D3DEnum.GetDescription(1)
  itmX.ListSubItems.Add , , D3DEnum.GetGuid(1)
  pBar2.Value = pBar2.Value + 1
  DoEvents

  For I = 2 To D3DEnum.GetCount()
    Set itmX = List.ListItems.Add()
    itmX.Text = ""
    itmX.ListSubItems.Add , , D3DEnum.GetDescription(I)
    itmX.ListSubItems.Add , , D3DEnum.GetGuid(I)
    pBar2.Value = pBar2.Value + 1
    DoEvents
  Next I

  pBar.Value = pBar.Value + 1
End Sub

Sub GetDirectInputDevicesJStick()
  Label1.Caption = "Getting DirectInput [Joystick] Devices"

  Dim itmX As ListItem, I As Integer

  Set itmX = List.ListItems.Add()
  itmX.Text = "DirectInput [Joystick Devices]"

  Set Di = Dx.DirectInputCreate
  Set DiEnum = Di.GetDIEnumDevices _
      (DIDEVTYPE_JOYSTICK, DIEDFL_ALLDEVICES)

  pBar2.Value = 0
  I = DiEnum.GetCount
  If I = 0 Then
    itmX.ListSubItems.Add , , "NO DEVICES"
    itmX.ListSubItems.Add , , "NO DEVICES"
    Exit Sub
  End If
  pBar2.Max = DiEnum.GetCount

  itmX.ListSubItems.Add , , DiEnum.GetItem(1).GetInstanceName
  itmX.ListSubItems.Add , , DiEnum.GetItem(1).GetGuidInstance
  pBar2.Value = pBar2.Value + 1
  DoEvents

  For I = 2 To DiEnum.GetCount()
    Set itmX = List.ListItems.Add()
    itmX.Text = ""
    itmX.ListSubItems.Add , , DiEnum.GetItem(I).GetInstanceName
    itmX.ListSubItems.Add , , DiEnum.GetItem(I).GetGuidInstance
    pBar2.Value = pBar2.Value + 1
    DoEvents
  Next I

  pBar.Value = pBar.Value + 1
End Sub

Sub GetDirectInputDevicesKBoard()
  Label1.Caption = "Getting DirectInput [Keyboard] Devices"

  Dim itmX As ListItem, I As Integer

  Set itmX = List.ListItems.Add()
  itmX.Text = "DirectInput [Keyboard Devices]"

  Set Di = Dx.DirectInputCreate
  Set DiEnum = Di.GetDIEnumDevices _
        (DIDEVTYPE_KEYBOARD, DIEDFL_ALLDEVICES)

  pBar2.Value = 0
  I = DiEnum.GetCount
  If I = 0 Then
    itmX.ListSubItems.Add , , "NO DEVICES"
    itmX.ListSubItems.Add , , "NO DEVICES"
    Exit Sub
  End If
  pBar2.Max = DiEnum.GetCount

  itmX.ListSubItems.Add , , DiEnum.GetItem(1).GetInstanceName
  itmX.ListSubItems.Add , , DiEnum.GetItem(1).GetGuidInstance
  pBar2.Value = pBar2.Value + 1
  DoEvents

  For I = 2 To DiEnum.GetCount()
    Set itmX = List.ListItems.Add()
    itmX.Text = ""
    itmX.ListSubItems.Add , , DiEnum.GetItem(I).GetInstanceName
    itmX.ListSubItems.Add , , DiEnum.GetItem(I).GetGuidInstance
    pBar2.Value = pBar2.Value + 1
    DoEvents
  Next I

  pBar.Value = pBar.Value + 1
End Sub

Sub GetDirectInputDevicesMouse()
  Label1.Caption = "Getting DirectInput [Mouse] Devices"

  Dim itmX As ListItem, I As Integer

  Set itmX = List.ListItems.Add()
  itmX.Text = "DirectInput [Mouse Devices]"

  Set Di = Dx.DirectInputCreate
  Set DiEnum = Di.GetDIEnumDevices _
      (DIDEVTYPE_MOUSE, DIEDFL_ALLDEVICES)

  pBar2.Value = 0
  I = DiEnum.GetCount
  If I = 0 Then
    itmX.ListSubItems.Add , , "NO DEVICES"
    itmX.ListSubItems.Add , , "NO DEVICES"
    Exit Sub
  End If
  pBar2.Max = DiEnum.GetCount

  itmX.ListSubItems.Add , , DiEnum.GetItem(1).GetInstanceName
  itmX.ListSubItems.Add , , DiEnum.GetItem(1).GetGuidInstance
  pBar2.Value = pBar2.Value + 1
  DoEvents

  For I = 2 To DiEnum.GetCount()
    Set itmX = List.ListItems.Add()
    itmX.Text = ""
    itmX.ListSubItems.Add , , DiEnum.GetItem(I).GetInstanceName
    itmX.ListSubItems.Add , , DiEnum.GetItem(I).GetGuidInstance
    pBar2.Value = pBar2.Value + 1
    DoEvents
  Next I

  pBar.Value = pBar.Value + 1
End Sub

Sub GetDirectPlayDevices()
  Label1.Caption = "Getting DirectPlay Devices"

  Dim itmX As ListItem, I As Integer

  Set itmX = List.ListItems.Add()
  itmX.Text = "DirectPlay"

  Set Dp = Dx.DirectPlayCreate("")
  Set DpEnum = Dp.GetDPEnumConnections("", DPCONNECTION_DIRECTPLAY)

  pBar2.Value = 0
  I = DpEnum.GetCount
  If I = 0 Then Exit Sub
  pBar2.Max = DpEnum.GetCount

  itmX.ListSubItems.Add , , DpEnum.GetName(1)
  itmX.ListSubItems.Add , , DpEnum.GetGuid(1)
  pBar2.Value = pBar2.Value + 1
  DoEvents

  For I = 2 To DDEnum.GetCount()
    Set itmX = List.ListItems.Add()
    itmX.Text = ""
    itmX.ListSubItems.Add , , DpEnum.GetName(I)
    itmX.ListSubItems.Add , , DpEnum.GetGuid(I)
    pBar2.Value = pBar2.Value + 1
    DoEvents
  Next I

  pBar.Value = pBar.Value + 1
End Sub

Sub GetDirectSoundDevices()
  Label1.Caption = "Getting DirectSound Devices"

  Dim itmX As ListItem, I As Integer

  Set itmX = List.ListItems.Add()
  itmX.Text = "DirectSound"

  Set Ds = Dx.DirectSoundCreate("")
  Set DsEnum = Dx.GetDSEnum

  pBar2.Value = 0
  pBar2.Max = DsEnum.GetCount

  itmX.ListSubItems.Add , , DsEnum.GetDescription(1)
  itmX.ListSubItems.Add , , DsEnum.GetGuid(1)
  pBar2.Value = pBar2.Value + 1
  DoEvents

  For I = 2 To DsEnum.GetCount
    Set itmX = List.ListItems.Add()
    itmX.Text = ""
    itmX.ListSubItems.Add , , DsEnum.GetDescription(I)
    itmX.ListSubItems.Add , , DsEnum.GetGuid(I)
    pBar2.Value = pBar2.Value + 1
    DoEvents
  Next I

  pBar.Value = pBar.Value + 1
End Sub

Sub GetDirectSoundRecordDevices()
  Label1.Caption = "Getting DirectSound Recording Devices"

  Dim itmX As ListItem, I As Integer

  Set itmX = List.ListItems.Add()
  itmX.Text = "DirectSound [Record]"

  Set Ds = Dx.DirectSoundCreate("")
  Set DsEnum = Dx.GetDSCaptureEnum

  pBar2.Value = 0
  pBar2.Max = DsEnum.GetCount

  itmX.ListSubItems.Add , , DsEnum.GetDescription(1)
  itmX.ListSubItems.Add , , DsEnum.GetGuid(1)
  pBar2.Value = pBar2.Value + 1
  DoEvents

  For I = 2 To DsEnum.GetCount
    Set itmX = List.ListItems.Add()
    itmX.Text = ""
    itmX.ListSubItems.Add , , DsEnum.GetDescription(I)
    itmX.ListSubItems.Add , , DsEnum.GetGuid(I)
    pBar2.Value = pBar2.Value + 1
    DoEvents
  Next I

  pBar.Value = pBar.Value + 1
End Sub
  
Hinweis
Um dieses Beispiel ausführen zu können, wird die DirectX 7 for Visual Basic Type Library benötigt (siehe dazu die Erläuterungen in der DirectX-Rubrik).

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (5,4 kB) Downloads bisher: [ 987 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum
Seite empfehlen Bug-Report
Letzte Aktualisierung: Montag, 3. Oktober 2011