GetDriveTypeEx - Detect drive type, including CD or DVD driver

Private Type DEVICE_MEDIA_INFO
    Cylinders As Double
    MediaType As STORAGE_MEDIA_TYPE
    TracksPerCylinder As Long
    SectorsPerTrack As Long
    BytesPerSector As Long
    NumberMediaSides As Long
    MediaCharacteristics As Long
End Type
Private Type GET_MEDIA_TYPES
   DeviceType As Long
   MediaInfoCount As Long
   MediaInfo(0) As DEVICE_MEDIA_INFO
End Type

Const IOCTL_STORAGE_GET_MEDIA_TYPES_EX As Long = &H2D0C04
Const GENERIC_READ As Long = &H80000000
Const GENERIC_WRITE As Long = &H40000000
Const FILE_SHARE_READ As Long = &H1
Const FILE_SHARE_WRITE As Long = &H2
Const OPEN_EXISTING As Long = 3
Const INVALID_HANDLE_VALUE As Long = -1
Const ERROR_ACCESS_DENIED As Long = 5&
Const ERROR_NOT_READY As Long = 21&
Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Const FILE_FLAG_NO_BUFFERING As Long = &H20000000

Const FILE_DEVICE_CD_ROM As Long = &H2
Const FILE_DEVICE_DVD As Long = &H33

Private Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" _
    (ByVal nDrive As String) As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
    (lbVersionInfirmation As OSVERSIONINFO) As Long

Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Private Enum STORAGE_MEDIA_TYPE
    DDS_4mm = &H20           '// Tape - DAT DDS1,2,... (all vendors)
    MiniQic                   '// Tape - miniQIC Tape
    Travan                    '// Tape - Travan TR-1,2,3,...
    QIC                       '// Tape - QIC
    MP_8mm                    '// Tape - 8mm Exabyte Metal Particle
    AME_8mm                   '// Tape - 8mm Exabyte Advanced Metal Evap
    AIT1_8mm                  '// Tape - 8mm Sony AIT
    DLT '                       // Tape - DLT Compact IIIxt, IV
    NCTP '                      // Tape - Philips NCTP
    IBM_3480 '                  // Tape - IBM 3480
    IBM_3490E '                 // Tape - IBM 3490E
    IBM_Magstar_3590 '          // Tape - IBM Magstar 3590
    IBM_Magstar_MP '            // Tape - IBM Magstar MP
    STK_DATA_D3 '               // Tape - STK Data D3
    SONY_DTF '                  // Tape - Sony DTF
    DV_6mm '                    // Tape - 6mm Digital Video
    DMI '                       // Tape - Exabyte DMI and compatibles
    SONY_D2 '                   // Tape - Sony D2S and D2L
    CLEANER_CARTRIDGE '         // Cleaner - All Drive types that support Drive 
                      ' Cleaners
    CD_ROM '                    // Opt_Disk - CD
    CD_R '                      // Opt_Disk - CD-Recordable (Write Once)
    CD_RW '                     // Opt_Disk - CD-Rewriteable
    DVD_ROM '                   // Opt_Disk - DVD-ROM
    DVD_R '                     // Opt_Disk - DVD-Recordable (Write Once)
    DVD_RW '                    // Opt_Disk - DVD-Rewriteable
    MO_3_RW '                   // Opt_Disk - 3.5" Rewriteable MO Disk
    MO_5_WO '                   // Opt_Disk - MO 5.25" Write Once
    MO_5_RW '                   // Opt_Disk - MO 5.25" Rewriteable (not LIMDOW)
    MO_5_LIMDOW '               // Opt_Disk - MO 5.25" Rewriteable (LIMDOW)
    PC_5_WO '                   // Opt_Disk - Phase Change 5.25" Write Once 
            ' Optical
    PC_5_RW '                   // Opt_Disk - Phase Change 5.25" Rewriteable
    PD_5_RW '                   // Opt_Disk - PhaseChange Dual Rewriteable
    ABL_5_WO '                  // Opt_Disk - Ablative 5.25" Write Once Optical
    PINNACLE_APEX_5_RW '        // Opt_Disk - Pinnacle Apex 4.6GB Rewriteable 
                       ' Optical
    SONY_12_WO '                // Opt_Disk - Sony 12" Write Once
    PHILIPS_12_WO '             // Opt_Disk - Philips/LMS 12" Write Once
    HITACHI_12_WO '             // Opt_Disk - Hitachi 12" Write Once
    CYGNET_12_WO '              // Opt_Disk - Cygnet/ATG 12" Write Once
    KODAK_14_WO '               // Opt_Disk - Kodak 14" Write Once
    MO_NFR_525 '                // Opt_Disk - Near Field Recording (Terastor)
    NIKON_12_RW '               // Opt_Disk - Nikon 12" Rewriteable
    IOMEGA_ZIP '                // Mag_Disk - Iomega Zip
    IOMEGA_JAZ '                // Mag_Disk - Iomega Jaz
    SYQUEST_EZ135 '             // Mag_Disk - Syquest EZ135
    SYQUEST_EZFLYER '           // Mag_Disk - Syquest EzFlyer
    SYQUEST_SYJET '             // Mag_Disk - Syquest SyJet
    AVATAR_F2 '                 // Mag_Disk - 2.5" Floppy
    MP2_8mm '                   // Tape - 8mm Hitachi
    DST_S '                     // Ampex DST Small Tapes
    DST_M '                     // Ampex DST Medium Tapes
    DST_L '                     // Ampex DST Large Tapes
    VXATape_1 '                 // Ecrix 8mm Tape
    VXATape_2 '                 // Ecrix 8mm Tape
    STK_9840 '                  // STK 9840
    LTO_Ultrium '               // IBM, HP, Seagate LTO Ultrium
    LTO_Accelis '               // IBM, HP, Seagate LTO Accelis
    DVD_RAM '                   // Opt_Disk - DVD-RAM
    AIT_8mm '                   // AIT2 or higher
    ADR_1 '                     // OnStream ADR Mediatypes
    ADR_2
End Enum

Private Enum DriveType
    UNKNOWN = 0
    NO_ROOT_DIR '1
    REMOVABLE   '2
    FIXED       '3
    REMOTE      '4
    DVDORCDROM  '5
    RAMDISK     '6
    DVD         '7
    CDROM       '8
End Enum

Const DRIVE_CDROM = 5
Const DRIVE_FIXED = 3
Const DRIVE_RAMDISK = 6
Const DRIVE_REMOTE = 4
Const DRIVE_REMOVABLE = 2
Const DRIVE_NO_ROOT_DIR = 1
Const DRIVE_UNKNOWN = 0

Private Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, _
    ByVal dwIoControlCode As Long, lpInBuffer As Any, _
    ByVal nInBufferSize As Long, lpOutBuffer As Any, _
    ByVal nOutBufferSize As Long, lpBytesReturned As Long, _
    lpOverlapped As Any) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal _
    lpFileName As String, ByVal dwDesiredAccess As Long, _
    ByVal dwShareMode As Long, lpSecurityAttributes As Long, _
    ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As _
    Long

' take a drive letter and display a MsgBox with the type of the medium in the 
' drive
' (you can delete the msgbox to achieve a silent function)

Private Function GetDriveTypeEx(DriveLetter As String) As DriveType
    Dim OS As String
    OS = GetOsVersion()
    'validate input parameter
    If Len(Trim$(DriveLetter)) <> 2 And Right$(Trim$(DriveLetter), _
        1) <> ":" Then
        MsgBox "Please enter the drive letter and a colon."
    Else
        GetDriveTypeEx = GetDriveType(Trim$(DriveLetter))
        'only works in WinXP and 2K
        'use default get drive type result if not xp or 2K
        If GetDriveTypeEx = DVDORCDROM And (OS = "Win2K" Or OS = "WinXP") Then
            Dim mediaTypes As GET_MEDIA_TYPES
            Dim status As Long
            Dim returned As Long
            Dim hDevice As Long
            Dim mynull As Long
            '//
            '// Get the Media type.
            '//
            'get a handle to the device
         hDevice = CreateFile("\\.\" & UCase$(Trim$(DriveLetter)), _
             GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, _
             mynull, OPEN_EXISTING, 0, mynull)
         'get the media types IO call
        If hDevice <> INVALID_HANDLE_VALUE Then
                status = DeviceIoControl(hDevice, _
                    IOCTL_STORAGE_GET_MEDIA_TYPES_EX, mynull, 0, mediaTypes, _
                    2048, returned, ByVal 0)
                If status = 0 Then
                    MsgBox "DRIVER ERROR"
                    GetDriveTypeEx = UNKNOWN
                    Exit Function
                 Else
                     If mediaTypes.DeviceType = FILE_DEVICE_CD_ROM Then
                         MsgBox "CDROM"
                         GetDriveTypeEx = CDROM
                     ElseIf mediaTypes.DeviceType = FILE_DEVICE_DVD Then
                         MsgBox "DVD"
                         GetDriveTypeEx = DVD
                     Else
                        MsgBox "Unknown optical drive type"
                     End If
                End If
                CloseHandle hDevice
            Else
                MsgBox "FILE ERROR"
            End If
        Else
            'process other drive types
            'remove if message box is not desired
            Select Case GetDriveTypeEx
            Case DVDORCDROM
                MsgBox "DVD or CDROM"
            Case FIXED
                MsgBox "FIXED"
            Case RAMDISK
                MsgBox "RAMDISK"
            Case REMOTE
                MsgBox "REMOTE"
            Case REMOVABLE
                MsgBox "REMOVABLE"
            Case NO_ROOT_DIR
                MsgBox "INVALID ROOT DIR"
            Case UNKNOWN
                MsgBox "UNKNOWN"
            End Select
        End If
    End If
End Function


' return a string that identifies the OS version

Function GetOsVersion() As String
    ' Return name of operating system
    Dim lret As Long
    Dim osverinfo As OSVERSIONINFO

    osverinfo.dwOSVersionInfoSize = Len(osverinfo)

    lret = GetVersionEx(osverinfo)

    If lret = 0 Then
        GetOsVersion = "unknown"
    Else
        Select Case osverinfo.dwPlatformId & "/" & osverinfo.dwMajorVersion & _
            "/" & osverinfo.dwMinorVersion
            Case "1/4/0"
                GetOsVersion = "Win95"
            Case "1/4/10"
                GetOsVersion = "Win98"
            Case "1/4/90"
                GetOsVersion = "WinME"
            Case "2/3/51"
                GetOsVersion = "WinNT351"
            Case "2/4/0"
                GetOsVersion = "WinNT4"
            Case "2/5/0"
                GetOsVersion = "Win2K"
            Case "2/5/1"
                GetOsVersion = "WinXP"
            Case Else
                GetOsVersion = "Unsupported Version"
        End Select
    End If
End Function