Link to home
Start Free TrialLog in
Avatar of gferrell
gferrell

asked on

Is it a DVD?

How can I differentiate a DVD from a CDROM drive? GetDriveType does not give that much information.
Avatar of Anthony Perkins
Anthony Perkins
Flag of United States of America image

Please maintain this open question:

Booting to WinXP Date: 10/29/2001 01:38PM PST  
https://www.experts-exchange.com/questions/20218574/Booting-to-WinXP.html

Thanks,
Anthony
Avatar of gferrell
gferrell

ASKER

In what way?
Please re-read the EE Guidelines (https://www.experts-exchange.com/jsp/cmtyQuestAnswer.jsp) regarding maintaing your questions.  If you have any further questions feel free to contact Community Support (https://www.experts-exchange.com/commspt/)

Thanks,
Anthony
There is no way that you can distinguish between a CD and DVD drive, unfortunately.
There is, and I have a working VB solution.  I need to clean it up a bit and will post tonight or Monday.
After much searching, I came across this c code sample from Microsoft that detects CDROM capabilities including R/W.  I translated the function that detects DVD/CDROM to VB.  Perhaps I will translate the other function that detects R/W capability later.
 
http://support.microsoft.com/default.aspx?scid=KB;EN-US;Q305184&

This MS code talks to the drivers and probably only works on Win2k/XP. If you want to build the c version, you will need the DDK because the all header files don't come VC++.

Paste this into a Module, and use the GetDriveTypeEx() function instead of GetDriveType() API.  DVD returns a 7:
_____________________________________________________

Public 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
Public Type GET_MEDIA_TYPES

   DeviceType As Long
   MediaInfoCount As Long
   MediaInfo(0) As DEVICE_MEDIA_INFO
End Type
Public Const IOCTL_STORAGE_GET_MEDIA_TYPES_EX As Long = &H2D0C04
Public Const GENERIC_READ As Long = &H80000000
Public Const GENERIC_WRITE As Long = &H40000000
Public Const FILE_SHARE_READ As Long = &H1
Public Const FILE_SHARE_WRITE As Long = &H2
Public Const OPEN_EXISTING As Long = 3
Public Const INVALID_HANDLE_VALUE As Long = -1
Public Const ERROR_ACCESS_DENIED As Long = 5&
Public Const ERROR_NOT_READY As Long = 21&
Public Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Public Const FILE_FLAG_NO_BUFFERING As Long = &H20000000

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

Public Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Public 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

Public Enum DriveType

    UNKNOWN = 0
    NO_ROOT_DIR '1
    REMOVABLE   '2
    FIXED       '3
    REMOTE      '4
    CDROM       '5
    RAMDISK     '6
    DVD         '7
End Enum
Public Const DRIVE_CDROM = 5
Public Const DRIVE_FIXED = 3
Public Const DRIVE_RAMDISK = 6
Public Const DRIVE_REMOTE = 4
Public Const DRIVE_REMOVABLE = 2
Public Const DRIVE_NO_ROOT_DIR = 1
Public Const DRIVE_UNKNOWN = 0
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

Public Type SECURITY_ATTRIBUTES
       nLength As Long
       lpSecurityDescriptor As Long
       bInheritHandle As Long
End Type
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


Declare Function CloseHandle Lib "kernel32" ( _
          ByVal hObject As Long _
) As Long



Public Function GetDriveTypeEx(DriveLetter As String) As DriveType
    If Len(Trim$(DriveLetter)) > 1 Then
        MsgBox "Please enter just the drive letter."
    Else
        Dim theType As DriveType
        theType = GetDriveType(Trim$(DriveLetter) & ":")
        If theType = DRIVE_CDROM Then
            Dim mediaTypes As GET_MEDIA_TYPES
            Dim status As Long
            buffer = Space(2048)
            Dim DMI As DEVICE_MEDIA_INFO
            Dim returned As Long
            Dim hDevice As Long
            Dim mynull As Long
           '//
            '// Get the Media type.
            '//
         hDevice = CreateFile("\\.\" & UCase$(Trim$(DriveLetter)) & ":", _
                                GENERIC_READ Or GENERIC_WRITE, _
                                  FILE_SHARE_READ Or _
                                  FILE_SHARE_WRITE, _
                                  mynull, _
                                  OPEN_EXISTING, _
                                  0, _
                                  mynull _
                                  )
       
          If hdevece <> 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"
                    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 CDROM drive type"
                         GetDriveTypeEx = UNKNOWN
                     End If
                End If
            Else
                MsgBox "FILE ERROR"
            End If
        Else
           
            Select Case theType
            Case DRIVE_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
Interesting.

As an aside I recommend you use Option Explicit it avoids typos like the following:

     If hdevece <> INVALID_HANDLE_VALUE Then

Also, while not necessary it is best that you declare Buffer As String (or it will default to Variant)

Now in order to PAQ this question and get your points refunded, I would suggest you post a message in Community Support to this effect.

Thanks,
Anthony
Thanks for pointing that out, Anthony. I had Option Explicit initially, but took it out to to see if it was causing another error and forgot to add it back. Buffer is not needed in my version and the other typo doesn't keep it from working. I wonder if I can make corrections to my post.

I've already requested this question be refunded on the community forum.

Thanks,
gferrell
You can always re-post.  But if you are going to do that, I would also remove the following as they are not used:

Public Type SECURITY_ATTRIBUTES
      nLength As Long
      lpSecurityDescriptor As Long
      bInheritHandle As Long
End Type

Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Dim DMI As DEVICE_MEDIA_INFO

Anthony
hmmm...You learn something everyday...very nicely done. Thanks.

Jeet
Anthony, you are correct.  Except for the CloseHandle, those other two items are not needed.  I thought I needed them at one point, but I didn't. I was using the CloseHandle but I must have accidentaly overwritten that line.  I believe it needs to be added back to close the file.

Here is an updated version with the changes we discussed and a test for operating system so it only makes the driver calls on WinXP and Win2K.

_______________________________________
Option Explicit
Public 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
Public Type GET_MEDIA_TYPES
 
   DeviceType As Long
   MediaInfoCount As Long
   MediaInfo(0) As DEVICE_MEDIA_INFO
End Type
Public Const IOCTL_STORAGE_GET_MEDIA_TYPES_EX As Long = &H2D0C04
Public Const GENERIC_READ As Long = &H80000000
Public Const GENERIC_WRITE As Long = &H40000000
Public Const FILE_SHARE_READ As Long = &H1
Public Const FILE_SHARE_WRITE As Long = &H2
Public Const OPEN_EXISTING As Long = 3
Public Const INVALID_HANDLE_VALUE As Long = -1
Public Const ERROR_ACCESS_DENIED As Long = 5&
Public Const ERROR_NOT_READY As Long = 21&
Public Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Public Const FILE_FLAG_NO_BUFFERING As Long = &H20000000
 
Public Const FILE_DEVICE_CD_ROM As Long = &H2
Public Const FILE_DEVICE_DVD As Long = &H33
 
Public Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" ( _
    lbVersionInfirmation As OSVERSIONINFO _
    ) As Long
   
Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type
Public 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
 
Public Enum DriveType
 
    UNKNOWN = 0
    NO_ROOT_DIR '1
    REMOVABLE   '2
    FIXED       '3
    REMOTE      '4
    CDROM       '5
    RAMDISK     '6
    DVD         '7
End Enum
Public Const DRIVE_CDROM = 5
Public Const DRIVE_FIXED = 3
Public Const DRIVE_RAMDISK = 6
Public Const DRIVE_REMOTE = 4
Public Const DRIVE_REMOVABLE = 2
Public Const DRIVE_NO_ROOT_DIR = 1
Public Const DRIVE_UNKNOWN = 0
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
 
'Public Type SECURITY_ATTRIBUTES
'       nLength As Long
'       lpSecurityDescriptor As Long
'       bInheritHandle As Long
'End Type
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
 

Declare Function CloseHandle Lib "kernel32" ( _
          ByVal hObject As Long _
) As Long
 
Public 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
        'MsgBox osverinfo.dwPlatformId & "/" & osverinfo.dwMajorVersion & "/" & _
            osverinfo.dwMinorVersion
        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
Public Function GetDriveTypeEx(DriveLetter As String) As DriveType
    Dim OS As String
    OS = GetOsVersion()
   
    If Len(Trim$(DriveLetter)) > 1 Then
        MsgBox "Please enter just the drive letter."
    Else
        Dim theType As DriveType
        theType = GetDriveType(Trim$(DriveLetter) & ":")
        If theType = DRIVE_CDROM 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.
            '//
         hDevice = CreateFile("\\.\" & UCase$(Trim$(DriveLetter)) & ":", _
                                GENERIC_READ Or GENERIC_WRITE, _
                                  FILE_SHARE_READ Or _
                                  FILE_SHARE_WRITE, _
                                  mynull, _
                                  OPEN_EXISTING, _
                                  0, _
                                  mynull _
                                  )
       
          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"
                    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 CDROM drive type"
                         GetDriveTypeEx = UNKNOWN
                     End If
                End If
                CloseHandle hDevice
            Else
                MsgBox "FILE ERROR"
            End If
        Else
            Select Case theType
            Case CDROM
                MsgBox "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


ASKER CERTIFIED SOLUTION
Avatar of Mindphaser
Mindphaser

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Yet another update...

-Removed unnecessary defines and variables
-Close handle opened
-Fixed GetDriveTypeEx to return a value for other drive types
-Added comments
-Detect operating system and run appropriate detection
-Return DVD or CDROM if able to detect, or DVDORCDROM if not.
-Change GetDriveTypeEx drive letter parameter to take the same format as GetDriveType.

updated code:
______________________________________________________
Option Explicit
Public 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
Public Type GET_MEDIA_TYPES
 
   DeviceType As Long
   MediaInfoCount As Long
   MediaInfo(0) As DEVICE_MEDIA_INFO
End Type
Public Const IOCTL_STORAGE_GET_MEDIA_TYPES_EX As Long = &H2D0C04
Public Const GENERIC_READ As Long = &H80000000
Public Const GENERIC_WRITE As Long = &H40000000
Public Const FILE_SHARE_READ As Long = &H1
Public Const FILE_SHARE_WRITE As Long = &H2
Public Const OPEN_EXISTING As Long = 3
Public Const INVALID_HANDLE_VALUE As Long = -1
Public Const ERROR_ACCESS_DENIED As Long = 5&
Public Const ERROR_NOT_READY As Long = 21&
Public Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Public Const FILE_FLAG_NO_BUFFERING As Long = &H20000000
 
Public Const FILE_DEVICE_CD_ROM As Long = &H2
Public Const FILE_DEVICE_DVD As Long = &H33
 
Public Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" ( _
    lbVersionInfirmation As OSVERSIONINFO _
    ) As Long
   
Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Public 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
 
Public Enum DriveType
    UNKNOWN = 0
    NO_ROOT_DIR '1
    REMOVABLE   '2
    FIXED       '3
    REMOTE      '4
    DVDORCDROM  '5
    RAMDISK     '6
    DVD         '7
    CDROM       '8
End Enum
Public Const DRIVE_CDROM = 5
Public Const DRIVE_FIXED = 3
Public Const DRIVE_RAMDISK = 6
Public Const DRIVE_REMOTE = 4
Public Const DRIVE_REMOVABLE = 2
Public Const DRIVE_NO_ROOT_DIR = 1
Public Const DRIVE_UNKNOWN = 0
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
 
'Public Type SECURITY_ATTRIBUTES
'       nLength As Long
'       lpSecurityDescriptor As Long
'       bInheritHandle As Long
'End Type
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
 

Declare Function CloseHandle Lib "kernel32" ( _
          ByVal hObject As Long _
) As Long
 
Public 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
        'MsgBox osverinfo.dwPlatformId & "/" & osverinfo.dwMajorVersion & "/" & _
            osverinfo.dwMinorVersion
        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
Public 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"
                    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