VB下如何通过API函数获取本机光盘的盘符？

Question

最好附有源码。谢谢！

Answer 1

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Sub Form_Load()
Dim i As Integer, ALLDISK As String
For i = 65 To 80
  If GetDriveType(Chr(i) & ":\") = 5 Then ALLDISK = ALLDISK & vbCrLf & Chr(i)
Next
MsgBox ALLDISK, 64, "ALL CDROM"
End Sub

Answer 2

Option ExplicitPrivate Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long'在form中添加一个listbox，然后输入代码：Private Sub Form_Load()
    Dim nType As Long, S As String, sDrive As String
    Dim pos As Integer    S = String(256, Chr(0))
    GetLogicalDriveStrings Len(S), S    Do
        pos = InStr(S, Chr(0))
        sDrive = Left(S, pos - 1)
        If Len(sDrive) = 0 Then Exit Do
        S = Mid(S, pos + 1)        nType = GetDriveType(sDrive)
        List1.AddItem Left(sDrive, 2) & " = " & GetDriveName(nType)
    Loop Until pos <= 0End SubFunction GetDriveName(ByVal nType As Long)
    Select Case nType
        Case 1
            GetDriveName = "目录不存在"
        Case DRIVE_REMOVABLE
            GetDriveName = "抽取式磁盘"
        Case DRIVE_FIXED
            GetDriveName = "硬盘"
        Case DRIVE_REMOTE
            GetDriveName = "远程(网络)储存装置"
        Case DRIVE_CDROM
            GetDriveName = "光盘驱动器"
        Case DRIVE_RAMDISK
            GetDriveName = "RAM Disk"
        Case Else
            GetDriveName = "无从判断"
    End Select
End Function

Answer 3

'首先引用"Microsoft Scripting runtime"Private Sub Command1_Click()
 SysCDdisc
End Sub
Public Sub SysCDdisc()
On Error GoTo acd
Command1.Enabled = False
Dim FSO As FileSystemObject
Dim aDrive As Drive
Set FSO = New FileSystemObject
For Each aDrive In FSO.Drives
    If aDrive.DriveType = 4 Then
        Debug.Print "光盘盘符是:" & aDrive.DriveLetter
    End If
Next
Set FSO = Nothing
Command1.Enabled = True
Exit Sub
acd:
End Sub

Answer 4

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As LongPrivate Sub Form_Load()
Dim dl As DriveListBox, i As Long
Set dl = Controls.Add("VB.DriveListBox", "dl", Me)
For i = 0 To dl.ListCount
If GetDriveType(dl.List(i)) = 5 Then MsgBox dl.List(i)
Next i
End Sub

Answer 5

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
Const DRIVE_CDROM = 5Private Sub Command1_Click()
mciSendString "open " & list1.List(list1.ListIndex) & " type cdaudio alias cdaudio ", vbNullString, 0, 0
mciSendString "set cdaudio door closed", vbNullString, 0, 0
mciSendString "close cdaudio", vbNullString, 0, 0End SubPrivate Sub Form_Load()Dim k As Long
For k = Asc("A") To Asc("Z")
If GetDriveType(Chr(k) & ":") = DRIVE_CDROM Then
list1.AddItem Chr$(k) & ":"
End If
Next
End SubPrivate Sub list1_dblclick()
mciSendString "open " & list1.List(list1.ListIndex) & " type cdaudio alias cdaudio ", vbNullString, 0, 0
mciSendString "set cdaudio door open", vbNullString, 0, 0
mciSendString "close cdaudio", vbNullString, 0, 0
End Sub