CD ROM检测

大家好，

我已经编写了用于检测CD ROM的程序。

您只需要添加一个命令按钮。

Option Explicit 
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 
Const DRIVE_CDROM& = 5 
Public Function GetDriveStrings() As String
    ' Wrapper for calling the GetLogicalDriveStrings api 
    Dim result As Long          ' Result of our API calls
    Dim strDrives As String     ' String to pass to API call
    Dim lenStrDrives As Long    ' Length of the above string 
    ' Call GetLogicalDriveStrings with a buffer size of zero to
    ' find out how large our stringbuffer needs to be
    result = GetLogicalDriveStrings(0, strDrives) 
    strDrives = String(result, 0)
    lenStrDrives = result 
    ' Call again with our new buffer
    result = GetLogicalDriveStrings(lenStrDrives, strDrives) 
    If result = 0 Then
        ' There was some error calling the API
        ' Pass back an empty string
        ' NOTE - TODO: Implement proper error handling here
        GetDriveStrings = ""
    Else
        GetDriveStrings = strDrives
    End If
End Function 
Private Sub Command1_Click()
    Dim strDrives As String 
    ' Find out what drives we have on this machine
    strDrives = GetDriveStrings() 
    If strDrives = "" Then
        ' No drives were found
        MsgBox "No Drives were found!", vbCritical
    Else
        ' Walk through the string and check the type of each drive
        ' displaying any cd-rom drives we find
        Dim pos As Long
        Dim drive As String
        Dim drivetype As Long 
        pos = 1 
        Do While Not Mid$(strDrives, pos, 1) = Chr(0)
            drive = Mid$(strDrives, pos, 3)
            pos = pos + 4
            drivetype = GetDriveType(drive)
            If drivetype = DRIVE_CDROM Then
                MsgBox "CD-ROM found at drive " & UCase(drive)
            End If
        Loop
    End If
End Sub

问候

>> ALI <<

From: https://bytes.com/topic/visual-basic/insights/774980-cd-rom-detection