Binaryworld - GetDriveTypeEx - Detect drive type, including CD or DVD driver ... [ VB -> Files & Folder ]

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