Option Explicit
'************************************************************************
'*                        SeekDisc.dll                                                           *
'*   搜索CD、VCD、DVD的完整类模块；支持多光驱。           *
'*   功能：1、搜索所有光驱；                                                        *
'*               2、返回所有光驱驱动器号；                                        *
'*               3、返回光驱所在媒体路径；                                        *
'*   作者：ChenJL1031  QQ:644625998                                      *
'*   特别声明：转载请标明出处                                                      *
'************************************************************************
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Const DRIVE_CDROM = 5
Private Const DRIVE_FIXED = 3
Private Const DRIVE_RAMDISK = 6
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_REMOVABLE = 2

Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type
Private Const INVALID_HANDLE_VALUE = -1
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * 260
        cAlternate As String * 14
End Type
       
Dim MyDrive(23) As String, MyCD_ROM(23) As String
Dim i As Integer, j As Integer, information As Integer
Dim MyDir As String
Dim WWW As WIN32_FIND_DATA
Dim cSearchResult As Long

'寻找音乐CD光盘的函数
Public Function SeekMusicCD(FindCD As Boolean, chenjl1031 As String) As String
      
       '返回参数FindCD为TRUE表示找到CD光盘 , 返回参数chenjl1031为找到的所有光盘驱动器字母之和
       On Error Resume Next
                               
        For i = 0 To 22
             MyDrive(i) = Chr(i+100) & ":"  : MyCD_ROM(i) = ""
        Next i
       
        j = 0
       
        For i = 0 To 22
            information = GetDriveType(MyDrive(i))
            If information = DRIVE_CDROM Then
               MyCD_ROM(j) = MyDrive(i)
               chenjl1031 = chenjl1031 & "[" & MyCD_ROM(j) & "]"
               j = j + 1   '光驱个数累计
            End If
        Next i
        
        For i = 0 To j - 1 'Step 1
            FindCD = False '未找到音乐CD
            MyDir = MyCD_ROM(i) & "\Track*.cda"
            cSearchResult = FindFirstFile(MyDir, WWW)
            If cSearchResult <> INVALID_HANDLE_VALUE Then
               Call FindClose(cSearchResult)
               FindCD = True '找到音乐CD
               SeekMusicCD = MyCD_ROM(i) & "\" '返回音乐CD光盘的路径
               Exit For
            End If
        Next i
End Function

'寻找VCD或DVD影碟的函数
Public Function SeekVCD_DVD(FindVCD_DVD As Boolean, chenjl1031 As String) As String
       
        '返回参数FindVCD_DVD为TRUE表示找到VCD或DVD影碟 , 返回参数chenjl1031为找到的所有光盘驱动器字母之和
        On Error Resume Next
                                
        For i = 0 To 22
           MyDrive(i) = Chr(i+100) & ":"  : MyCD_ROM(i) = ""
        Next i
       
        j = 0
      
        For i = 0 To 22
            information = GetDriveType(MyDrive(i))
            If information = DRIVE_CDROM Then
               MyCD_ROM(j) = MyDrive(i)
               chenjl1031 = chenjl1031 & "[" & MyCD_ROM(j) & "]"
               j = j + 1   '光驱个数累计
            End If
        Next i
       
        For i = 0 To j - 1 'Step 1 '寻找VCD影碟
            FindVCD_DVD = False '未找到VCD影碟
            MyDir = MyCD_ROM(i) & "\mpegav\*.dat"
            cSearchResult = FindFirstFile(MyDir, WWW)
            If cSearchResult <> INVALID_HANDLE_VALUE Then
               Call FindClose(cSearchResult)
               FindVCD_DVD = True '找到VCD影碟
               SeekVCD_DVD = MyCD_ROM(i) & "\mpegav" '返回VCD影碟所在路径
               Exit Function
            End If
        Next i
       
        For i = 0 To j - 1 'Step 1 '寻找DVD影碟
            FindVCD_DVD = False '未找到DVD影碟
            MyDir = MyCD_ROM(i) & "\VIDEO_TS\*.vob"
            cSearchResult = FindFirstFile(MyDir, WWW)
            If cSearchResult <> INVALID_HANDLE_VALUE Then
               Call FindClose(cSearchResult)
               FindVCD_DVD = True '找到DVD影碟
               SeekVCD_DVD = MyCD_ROM(i) & "\VIDEO_TS" '返回DVD影碟所在路径
               Exit Function
            End If
        Next i
End Function