Версия для печати
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум на Исходниках.RU > Работа с аппаратурой > Открыть/закрыть CD-Rom одной кнопкой


Автор: Pr0[)!9Y 08.07.05, 19:37
<{CODE_COLLAPSE_OFF}><{CODE_WRAP_OFF}>
    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 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()
    Dim t As Long
    t = Timer
    OpenCloseDoor "f:\", True
    If Timer - t < 1 Then OpenCloseDoor "f:\", False
    End Sub

Автор: SCINER 08.07.05, 19:48
Вариант Spawn™Production®
Расположите на форме 1 кнопку.
<{CODE_COLLAPSE_OFF}><{CODE_WRAP_OFF}>
    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


Вариант maxim84_
<{CODE_COLLAPSE_OFF}><{CODE_WRAP_OFF}>
    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

Powered by Invision Power Board (https://www.invisionboard.com)
© Invision Power Services (https://www.invisionpower.com)