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