'API-Deklarationen
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
 
 
Private Declare Function GetDriveType Lib "kernel32" _
Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Private Const DRIVE_CDROM = 5
 
 
Private Sub Button1_Click(ByVal sender As System.Object, ByVal
e As System.EventArgs) Handles Button1.Click
  Open_Device()
End Sub
 
 
Private Sub Button2_Click(ByVal sender As System.Object, ByVal
e As System.EventArgs) Handles Button2.Click
  Close_Device()
End Sub
 
 
'CD-ROM Laufwerk öffnen
Public Sub Open_Device(Optional ByVal CDDrive As String = "")
  Dim Buffer As String
  Dim DriveType As Long
 
 'Wenn Laufwerksbuchstabe angegeben, dann prüfen, ob CD-Laufwerk
  If CDDrive <> "" Then
    DriveType = GetDriveType(CDDrive)
 
  If DriveType <> DRIVE_CDROM Then
    MsgBox("Laufwerk " & CDDrive & " ist kein " & _
    "CD-Laufwerk", 16) Exit Sub
  End If
 
 
  'CD-Laufwerk öffnen
  mciSendString("Open " & CDDrive & _
  " Type cdaudio Alias cd", Buffer, 255, 0) mciSendString("set
  cd door open", 0&, 0, 0) mciSendString("close cd", 0&, 0, 0)
 
 
  'keine Laufwerksangabe -> Standard CDROM-Laufwerk öffnen
  Else
    mciSendString("set cdaudio door open", 0&, 0, 0)
  End If
End Sub
 
 
 
 
'CD-ROM Laufwerk schliessen
Public Sub Close_Device(Optional ByVal CDDrive As String = "")
  Dim Buffer As String
  Dim DriveType As Long
 
 
  'Wenn Laufwerksbuchstabe angegeben, dann prüfen, ob CD-Laufwerk
  If CDDrive <> "" Then
    DriveType = GetDriveType(CDDrive)
 
  If DriveType <> DRIVE_CDROM Then
    MsgBox("Laufwerk " & CDDrive & " ist kein " & _ 
    "CD-Laufwerk", 16) Exit Sub
  End If
 
 
  'CD-Laufwerk schliessen
  mciSendString("Open " & CDDrive & _
  " Type cdaudio Alias cd", Buffer, 255, 0) mciSendString("set
  cd door closed", 0&, 0, 0) mciSendString("close cd", 0&, 0, 0)
 
 
  'keine Laufwerksangabe -> Standard CDROM-Laufwerk schließen
  Else
    mciSendString("set cdaudio door closed", 0&, 0, 0)
  End If
End Sub