Tipp 0190 DVD/CD-Schubladen öffnen und schließen (WMI)
Autor/Einsender:
Datum:
  Michael Werner
20.04.2009
Entwicklungsumgebung:   VB.Net 2008
Framework:   2.0
Mit WMI (Verweis auf und Import von System.Management) lassen sich alle CD und DVD-Laufwerke ermitteln, und deren Laufwerksschubladen können mit der API mciSendString der winmm.dll geöffnet und geschlossen werden.
 
Imports System.Management

Private Declare Function mciSendString Lib "winmm.dll" Alias _
    "mciSendStringA" (ByVal lpstrCommand As String, ByVal _
    lpstrReturnString As String, ByVal uReturnLength As Long, _
    ByVal hwndCallback As Long) As Long

   'Alle CD/DVD/CDR-Laufwerke auslesen
  Public Function GetAllDrivesOfType(ByVal type As String) _
      As Boolean
    Dim mosSearchDisks As Management.ManagementObjectSearcher
    Dim mocDisks As Management.ManagementObjectCollection
    Dim disc As Management.ManagementObject
    Dim drive As String = String.Empty

    mosSearchDisks = New Management.ManagementObjectSearcher( _
       "SELECT * FROM Win32_LogicalDisk")
    mocDisks = mosSearchDisks.Get()
    ComboBox1.Items.Clear()

    For Each disc In mocDisks
      If disc.Properties("Description").Value.ToString() = _
         type Then
        ComboBox1.Items.Add((disc("Name").ToString))
      End If
    Next

    If mocDisks.Count > 0 Then
      Return True
    Else
      Return False
    End If

    mocDisks.Dispose()
    mosSearchDisks.Dispose()
  End Function

    'Laufwerksschublade schließen
  Private Sub CloseDoor(ByVal Laufwerk As String)
    Dim Lw As String = "Laufwerk" & Laufwerk
    mciSendString("Open " & Laufwerk & ": Alias " & Lw _
        & " Type CDAudio", "", 0, 0)
    mciSendString("Set " & Lw & " Door Closed", "", 0, 0)
  End Sub

   'Laufwerksschublade öffnen
  Private Sub OpenDoor(ByVal Laufwerk As String)
    Dim Lw As String = "Laufwerk" & Laufwerk
    mciSendString("Open " & Laufwerk & ": Alias " & Lw _
       & " Type CDAudio", "", 0, 0)
    mciSendString("Set " & Lw & " Door Open", "", 0, 0)
  End Sub
 

Windows-Version
98/SE
ME
NT
2000
XP
Vista
Win 7


Download  (38 kB) Downloads bisher: [ 362 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Tipps | Projekte | Tutorials | Bücherecke | VB-/VBA-Tipps | API-Referenz | Komponenten | VB.Net-Forum | VB/VBA-Forum | DirectX-Forum | Foren-Archiv | DirectX | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Montag, 23. Januar 2012