Option Explicit '************************************** ' Name: GetCDROMDrives ' Description:Detect the CDROM drives return drive letter(s) ' Author: Joe Johnston storm@the-forest.net ' Returns: CD rom drives "DEF" = D:\ & E:\ & F:\~~ "E" = E:\ ' how many drives can be solved len(GetCDROMDrives) ' '************************************** Const DRIVE_CDROM = 5 Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Public Function GetCDROMDrives() As String Dim intTmp As Integer, tmpStr As String, strDrives As String ', intCD As Integer Dim strDriveLetters As String, ret& GetCDROMDrives = "0" '(zero) is the default in case there are no CDROM drives strDrives = Space(255) 'init strDrives to 255 spaces 'get drives, strDrives var will look like 'A:\, C:\, D:\, E:\, ..:\ ret& = GetLogicalDriveStrings(Len(strDrives), strDrives) 'ret& is the new length of strDrives For intTmp = 1 To ret& Step 4 ' We want to step over the ":\," tmpStr = Mid(strDrives, intTmp, 3) 'get a drive root directory (like "C:\") If GetDriveType(tmpStr) = DRIVE_CDROM Then 'if drive is a CD 'intCD = intCD + 1 'If intCD > 1 Then ' If there are more than one CDs lets delimit the output ' strDriveLetters = strDriveLetters & "," 'End If strDriveLetters = strDriveLetters & Left(tmpStr, 1) End If Next intTmp 'Output the CD rom drives "DEF" = D:\ & E:\ & F:\~~ "E" = E:\ ' how many drives can be solved len(GetCDROMDrives) GetCDROMDrives = UCase(strDriveLetters) End Function
"If ye love wealth better than liberty, the tranquility of servitude better than the animated contest of freedom, go home from us in peace. We ask not your counsel or arms. Crouch down and lick the hands which feed you. May your chains set lightly upon you, and may posterity forget that ye were our countrymen."
~Samuel Adams