VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)
首页 - 经验之谈 - 请问VB5如何取得CDROM的盘符
发表评论(0)作者:, 平台:, 阅读:9211, 日期:2000-05-11
主题: 请问VB5如何取得CDROM的盘符?

--


在BAS的Module中,宣告以下api:


Public Declare Function GetLogicalDriveStrings Lib "kernel32" Alias

"GetLogicalDriveStringsA" _

(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long


Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _

(ByVal nDrive As String) As Long

Public Const DRIVE_CDROM = 5


Declare Function GetVolumeInformation Lib "kernel32" Alias

"GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal

lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long,

lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long,

lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal

nFileSystemNameSize As Long) As Long


在表单上,插入一个名为cmdCheck的CommandButton,以及lblCDInfo的Label控制项,按下

cmdCheck时,让CD-ROM代码显示在lblCDInfo中:


Private Sub cmdCheck_Click()


'取得所有磁碟机的代码

Dim lngRetVal As Long

Dim lngDriveType As Long

Dim strAllDrivers As String

Dim strJustOneDrive As String

Dim strCDLabel As String

Dim intPos As Integer

Dim CDfound As Boolean

'将strAllDrivers的字串变数以Space字元填满

strAllDrivers = Space(64)

'以GetLogicalDriveStrings API函数取得所有磁碟代码的资讯

lngRetVal = GetLogicalDriveStrings(Len(strAllDrivers), strAllDrivers)

'将strAllDrivers中所有空白去除

strAllDrivers = Left(strAllDrivers, lngRetVal)

Do

'由于字串以chr(0)区隔,所以我们用chr(0)来找出不同的磁碟代码

intPos = InStr(strAllDrivers, Chr(0))

'如果找到了...

If intPos Then

strJustOneDrive = Left(strAllDrivers, intPos - 1)

strAllDrivers = Mid(strAllDrivers, intPos + 1,

Len(strAllDrivers))

lngDriveType = GetDriveType(strJustOneDrive)

'检查是否为CD-ROM

If lngDriveType& = DRIVE_CDROM Then

CDfound = True

strCDLabel = rgbGetVolumeLabel(strJustOneDrive)

Exit Do

End If

End If

Loop Until strAllDrivers = "" Or lngDriveType& = DRIVE_CDROM

'显示相关资讯

If CDfound Then

lblCDInfo = "您的CD-ROM磁碟代码为: " & UCase(strJustOneDrive) &

vbCrLf

lblCDInfo = lblCDInfo & "其volume label 是" & strCDLabel

Else

lblCDInfo = "No CD ROM drives were detected on your system."

End If

End Sub


'用来取得VolumeLabel的副程式

Private Function rgbGetVolumeLabel(CDPath) As String


Dim lngRetVal As Long

Dim DrvVolumeName As String

Dim intPos As Integer

Dim UnusedVal1 As Long

Dim UnusedVal2 As Long

Dim UnusedVal3 As Long

Dim UnusedStr As String


DrvVolumeName = Space(14)

UnusedStr = Space(32)

lngRetVal = GetVolumeInformation(CDPath, _

DrvVolumeName, _

Len(DrvVolumeName), _

UnusedVal1&, UnusedVal2&, _

UnusedVal3&, _

UnusedStr, Len(UnusedStr))


If lngRetVal = 0 Then Exit Function

intPos = InStr(DrvVolumeName, Chr(0))

If intPos Then DrvVolumeName = Left(DrvVolumeName, intPos - 1)

If Len(Trim(DrvVolumeName)) = 0 Then DrvVolumeName = "(no label)"

rgbGetVolumeLabel = DrvVolumeName

End Function