module1.bas

两个VB播放器 两个VB播放器 两个VB播放器 两个VB播放器

Attribute VB_Name = "Module1"
'Public Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
         '媒体API函数
'Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
      '媒体API函数
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
   '窗体永远再前
Public Declare Function SendMessage Lib "user32" Alias _
    "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
        ByVal wParam As Long, lParam As Long) As Long
 '//重做与撤消

Public Const WM_USER = &H400
Public Const LB_SETSEL = WM_USER + 6
Public Const EM_HIDESELECTION = WM_USER + 63

'///////////////////////////////////////////////////////////////////////////////////////
Global PlayT As Boolean

Global lngW As Long, lngH As Long
Global TipTrue As Boolean, CloseT As Boolean
Global MyFile(30) As String, i As Integer
'Declare Function SystemParametersInfo& Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long)
'Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Public Const SPI_SCREENSAVERRUNNING& = 97
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public 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
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Public Const DRIVE_CDROM = 5
Public Const MMSYSERR_NOERROR = 0
Public Const SND_ASYNC = &H1
Public Const SND_NODEFAULT = &H2
Public Const SND_PURGE = &H40
Public Const SND_FILENAME = &H20000
'Global MyVolume As clsVolume

Public Function FirstCDDrive() As String

 Const ASC_A = 65
 Const ASC_Z = ASC_A + 25                     '定义常量A——Z

 Dim i As Integer

    For i = ASC_A To ASC_Z                                    '从A-Z循环
        If GetDriveType(Chr$(i) & ":\") = DRIVE_CDROM Then          '循环变量的值是否与光驱盘符相同
            FirstCDDrive = Chr$(i)                               '若相同则函数FristCDDrive为循环变量的值
            Exit For
        End If
    Next i
 '将Drive_CDROM换成Drive_Flopy也可检测软驱
    
End Function

Public Sub OpenCDDoor()

  mciSendString "Set CDAudio Door Open Wait", 0&, 0&, 0&        '弹出光驱模块
    
End Sub

Public Sub CloseCDDoor()

  mciSendString "Set CDAudio Door Closed Wait", 0&, 0&, 0&    '关上光驱模块
  
End Sub