На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
Модераторы: SCINER, B.V.
  
    > Открыть/закрыть CD-Rom одной кнопкой
      ExpandedWrap disabled
        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
        Вариант Spawn™Production®
        Расположите на форме 1 кнопку.
        ExpandedWrap disabled
          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_
        ExpandedWrap disabled
          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
        0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
        0 пользователей:


        Рейтинг@Mail.ru
        [ Script execution time: 0,0179 ]   [ 17 queries used ]   [ Generated: 28.03.24, 14:05 GMT ]