CD-Laufwerke öffnen und schließen

CD-Laufwerke öffnen und schließen: mciSendString, mciExecute, GetDriveType
Private Declare Function mciSendString Lib "winmm.dll" _ Mit diesem Programm kann nur eine CD-Tür geöffnet werden.
Alias "mciSendStringA" (ByVal lpstrCommand As String, _
ByVal lpstrReturnString As String, ByVal uReturnLength _
As Long, ByVal hwndCallback As Long) As Long
Private Sub cmdClose_Click()
cmdClose.Visible = False Button "Close" ist nicht sichtbar.
cmdOpen.Visible = True
mciSendString "Set CDAudio Door Closed Wait", 0&, 0&, 0& CD-Tür wird geschlossen.
End Sub
Private Sub cmdOpen_Click()
cmdClose.Visible = True
cmdOpen.Visible = False Button "Open" ist nicht sichtbar.
mciSendString "Set CDAudio Door Open Wait", 0&, 0&, 0& CD-Tür wird geöffnet.
End Sub
Private Sub Form_Click()
mciSendString "Set CDAudio Door Closed Wait", 0&, 0&, 0& Bei Klick auf das Formular wird die CD-Tür geschlossen
Unload Me und das Programm beendet.
End Sub
Private Sub Form_Load()
With Form1
.Width = 1440 Breite des Formulars.
.CurrentX = 100 Position für Textausgabe auf Formular.
.CurrentY = 90
End With
Form1.Print "x" Textausgabe des "x".
Me.Move (Screen.Width - Me.Width) / Me.Width, _ Position des Formulars am Monitor (links oben).
(Screen.Height - Me.Height) / Me.Height
cmdClose.Visible = True
cmdOpen.Visible = False
mciSendString "Set CDAudio Door Open Wait", 0&, 0&, 0& Bei Programmstart wird die CD-Tür geöffnet.
End Sub
   
Private Declare Function mciExecute Lib "winmm.dll" _ Mit diesem Programm kann eine bestimmte CD-Tür geöffnet
(ByVal lpstrCommand As String) As Long sowie alle offenen Türen geschlossen werden.
Private Declare Function GetDriveType Lib "kernel32" _
Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Dim i%, n%, typ$, nDrive$, nExec$, nAlias$, nResult As Long
Dim index%, Drive$, OpenClose As Boolean, OpenCloseCD As Boolean
Const DRIVE_CDROM = 5 Laufwerkstyp für CD-Laufwerke ist 5.
Private Sub Form_Load()
For i = 0 To 25
typ = GetDriveType(Chr(i + 65) + ":\") CD-Laufwerke ermitteln und in eine Listbox stellen.
If typ = DRIVE_CDROM Then
List1.AddItem Chr(i + 65) + ":\"
End If
Next i
With Form1
.CurrentX = 100 Position für Textausgabe auf Formular.
.CurrentY = 240
End With
Form1.Print "x" Textausgabe des "x".
Me.Move (Screen.Width - Me.Width) / Me.Width, _ Position des Formulars am Monitor (links oben).
(Screen.Height - Me.Height) / Me.Height
End Sub
Private Sub List1_Click() Eine bestimmte Tür öffnen.
nDrive = List1.List(List1.ListIndex) Das in der Listbox angeklickte Laufwerk wird geöffnet.
OpenClose = True
Call Close_Open(nDrive, OpenClose) Aufruf eines Sub-Programmes mit Übergabe von Variablen.
End Sub
Private Sub List1_DblClick() Eine bestimmte Tür schließen.
nDrive = List1.List(List1.ListIndex) Das in der Listbox angeklickte Laufwerk wird geschlossen.
OpenClose = False
Call Close_Open(nDrive, OpenClose) Aufruf eines Sub-Programmes mit Übergabe von Variablen.
End Sub
Private Sub Form_Click() Alle Türen schließen.
n = List1.ListCount Wie viele Laufwerke stehen in der ListBox?
Do While n Schleifenverarbeitung, um alle Laufwerke zu schließen.
n = n - 1
nDrive = List1.List(n)
OpenClose = False
Call Close_Open(nDrive, OpenClose) Aufruf eines Sub-Programmes mit Übergabe von Variablen.
Loop
Unload Me Programm beenden.
End Sub
Private Sub Close_Open(nDrive, OpenClose)
nAlias = "CDDrive" & nDrive Strings zur Weiterverarbeitung im Rechner werden benötigt.
nExec = "Open " & nDrive & ": Type CDAudio Alias " & nAlias
nResult = mciExecute(nExec)
If nResult Then Ermitteln, ob Tür offen oder geschlossen ist.
If OpenClose Then
nExec = "Set " & nAlias & " Door Open" String erzeugen: Tür öffnen.
Else
nExec = "Set " & nAlias & " Door Closed" String erzeugen: Tür schließen.
End If
nResult = mciExecute(nExec) Ausführen von Tür öffnen oder schließen.
If nResult Then
nExec = "Close " & nAlias Zurücksetzen der internen Rechnervariablen.
nResult = mciExecute(nExec)
OpenCloseCD = True
End If
End If
End Sub

Mehr Tipps: User-Passwort prüfen

Sponsoren und Investoren

Sponsoren und Investoren sind jederzeit herzlich willkommen!
Wenn Sie die Information(en) auf dieser Seite interessant fanden, freuen wir uns über eine kleine Spende. Empfehlen Sie uns bitte auch in Ihren Netzwerken (z. B. Twitter, Facebook oder Google+). Herzlichen Dank!

Nach oben Sitemap
Impressum & Kontakt