如何得到全部的光驱盘符

[cdc2533802]

如何得到全部的光驱盘符

[yinweihong]

Private Sub Form_Load()
Show
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set drivers = fso.drives
For Each driver In drivers
If driver.drivetype = 4 Then
Print "光驱" & driver.driveletter & vbCrLf
End If
Next
End Sub

[lihonggen0]

Private Const DRIVE_CDROM = 5
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Private Sub Form_Load()

Dim DriveNum As Integer
Dim DriveType
Dim CDRom As Integer
Dim DriveLetter As String
Dim i As Byte
DriveNum = 1
Do
DriveNum = DriveNum + 1
DriveLetter = Chr(DriveNum + 65) + ":\"
DriveType = GetDriveType(DriveLetter)
If GetDriveType(DriveLetter) = DRIVE_CDROM Then MsgBox DriveLetter 'DRIVE_CDROM=5
Loop Until DriveType = 1 '返回值为1,已无可用驱动器
End Sub

[lihonggen0]

Option Explicit

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 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 <= 0

End Sub

Function 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

[kmzs]

从a-z一个一个测试，用一条API。。。

[zhangzumiao]

这个也好玩了，不要写程序也可以。
装虚拟光区8。0的安装向导中有全部的光盘

[northwolves]

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