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
Function CDLetter()
Dim strDrives As String
' Find out what drives we have on this machine
strDrives = GetDriveStrings()
If strDrives = "" Then
' No drives were found
CDLetter = "No CD Drives were found!"
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
CDLetter = UCase(drive)
End If
Loop
End If
End Function
