Option Explicit Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _ (ByVal nDrive As String) As Long 注释:GetLogicalDriveStrings-->获取一个字串,其中包含了当前所有逻辑驱动器的根驱动器路径 Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" _ (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const DRIVE_REMOVABLE = 2 Private Const DRIVE_FIXED = 3 Private Const DRIVE_REMOTE = 4 Private Const DRIVE_CDROM = 5 Private Const DRIVE_RAMDISK = 6
Private Sub Command1_Click() Dim rtn As String Dim AllDrives As String Dim JustOneDrive As String AllDrives = Space$(64) 注释:设置缓冲 rtn = GetLogicalDriveStrings(Len(AllDrives), AllDrives) 注释:调用函数得到包含所有驱动器的字符串 AllDrives = Left(AllDrives, rtn) Do rtn = InStr(AllDrives, Chr(0)) If rtn Then 注释:若有的话 JustOneDrive = Left(AllDrives, rtn) AllDrives = Mid(AllDrives, rtn + 1, Len(AllDrives)) rtn = GetDriveType(JustOneDrive) 注释:检查驱动器类型 If rtn = DRIVE_CDROM Then 注释:是CD-ROM Label1.Caption = Left(UCase(JustOneDrive), 2) 注释:给label1 Exit Do End If End If Loop Until AllDrives = "" Or rtn = DRIVE_CDROM Command1.Enabled = False If Label1.Caption = "" Then Label1.Caption = "没有发现光驱!" End If End Sub |