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 Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub OpenCloseDoor(strDriveLetter As String, blnDoOpen As Boolean)

Dim AliasName$, strOpenClose$

strOpenClose = IIf(blnDoOpen, "Open", "Closed")

AliasName = "Laufwerk" & strDriveLetter

mciSendString "Open " & strDriveLetter & ": Alias " & AliasName & " Type CDAudio", 0, 0, 0

mciSendString "Set " & AliasName & " Door " & strOpenClose, 0, 0, 0

End Sub

 

Private Sub d_Click()

Dim t As Long

t = Timer

OpenCloseDoor "f:\", True

Sleep 100

Debug.Print Timer - t

If Timer - t < 1 Then

OpenCloseDoor "f:\", False

Else

OpenCloseDoor "f:\", True

End If

End Sub

 

Private Sub Command1_Click()

d_Click

End Sub

Option Explicit

 

Const SHGFI_ICONLOCATION = &H1000

Const MB_ICONASTERISK = &H40&

Const MB_ICONEXCLAMATION = &H30&

Const MAX_PATH = 260

 

Private Declare Function GetLogicalDrives Lib "kernel32" () As Long

Private Declare Function GetCommandLine Lib "kernel32" Alias "GetCommandLineA" () As Long

Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

 

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 Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Const EndPath = ":\"

Dim Key As Long

 

Private Sub OpenCloseDoor(strDriveLetter As String, blnDoOpen As Boolean)

  Dim AliasName$, strOpenClose$

  strOpenClose = IIf(blnDoOpen, "Open", "Closed")

  AliasName = "Laufwerk" & strDriveLetter

  mciSendString "Open " & strDriveLetter & ": Alias " & AliasName & " Type CDAudio", 0, 0, 0

  mciSendString "Set " & AliasName & " Door " & strOpenClose, 0, 0, 0

End Sub

 

Private Sub Command1_Click()

 d_Click

End Sub

Private Sub d_Click()

 Dim t As Long

  t = Timer

  OpenCloseDoor Combo1.List(Combo1.ListIndex) & EndPath, True

  Sleep 100

  If Timer - t < 1 Then

   OpenCloseDoor Combo1.List(Combo1.ListIndex) & EndPath, False

  Else

   OpenCloseDoor Combo1.List(Combo1.ListIndex) & EndPath, True

  End If

End Sub

 

Private Sub Form_Load()

    Dim LDs As Long, Cnt As Long, sDrives As String

    LDs = GetLogicalDrives

    For Cnt = 0 To 25

        If (LDs And 2 ^ Cnt) <> 0 Then

            If GetDriveType(Trim$(sDrives & Chr$(65 + Cnt) & EndPath)) = 5 Then

             Combo1.AddItem sDrives & Chr$(65 + Cnt)

            End If

        End If

    Next Cnt

    Combo1.ListIndex = 0

End Sub