Solved

Is it a DVD?

Posted on 2002-07-17
14
703 Views
Last Modified: 2007-11-27
How can I differentiate a DVD from a CDROM drive? GetDriveType does not give that much information.
0
Comment
Question by:gferrell
  • 7
  • 4
  • 2
  • +1
14 Comments
 
LVL 75

Expert Comment

by:Anthony Perkins
ID: 7160987
Please maintain this open question:

Booting to WinXP Date: 10/29/2001 01:38PM PST  
http://www.experts-exchange.com/win2k/Q_20218574.html

Thanks,
Anthony
0
 

Author Comment

by:gferrell
ID: 7161169
In what way?
0
 
LVL 75

Expert Comment

by:Anthony Perkins
ID: 7161204
Please re-read the EE Guidelines (http://www.experts-exchange.com/jsp/cmtyQuestAnswer.jsp) regarding maintaing your questions.  If you have any further questions feel free to contact Community Support (http://www.experts-exchange.com/commspt/)

Thanks,
Anthony
0
 
LVL 1

Expert Comment

by:jeet
ID: 7167465
There is no way that you can distinguish between a CD and DVD drive, unfortunately.
0
 

Author Comment

by:gferrell
ID: 7168062
There is, and I have a working VB solution.  I need to clean it up a bit and will post tonight or Monday.
0
 

Author Comment

by:gferrell
ID: 7168390
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
0
 
LVL 75

Expert Comment

by:Anthony Perkins
ID: 7168583
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
0
Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

 

Author Comment

by:gferrell
ID: 7168614
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
0
 
LVL 75

Expert Comment

by:Anthony Perkins
ID: 7168639
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
0
 
LVL 1

Expert Comment

by:jeet
ID: 7168741
hmmm...You learn something everyday...very nicely done. Thanks.

Jeet
0
 

Author Comment

by:gferrell
ID: 7169505
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.

0
 

Author Comment

by:gferrell
ID: 7169727
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


0
 
LVL 6

Accepted Solution

by:
Mindphaser earned 500 total points
ID: 7174371
Points refunded and moved to PAQ

** Mindphaser - Community Support Moderator **
0
 

Author Comment

by:gferrell
ID: 7180386
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
0

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

759 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now