gferrell
asked on
Is it a DVD?
How can I differentiate a DVD from a CDROM drive? GetDriveType does not give that much information.
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
Thanks,
Anthony
There is no way that you can distinguish between a CD and DVD drive, unfortunately.
ASKER
There is, and I have a working VB solution. I need to clean it up a bit and will post tonight or Monday.
ASKER
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_TY PES_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$(DriveLe tter) & ":")
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_TY PES_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
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_TY
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
If Len(Trim$(DriveLetter)) > 1 Then
MsgBox "Please enter just the drive letter."
Else
Dim theType As DriveType
theType = GetDriveType(Trim$(DriveLe
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_TY
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
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
ASKER
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
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
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
Jeet
ASKER
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.
ASKER
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_TY PES_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.dwOSVersionInfoS ize = 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$(DriveLe tter) & ":")
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_TY PES_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
__________________________
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_TY
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.dwOSVersionInfoS
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
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$(DriveLe
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_TY
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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_TY PES_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.dwOSVersionInfoS ize = 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$(DriveLe tter))
'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_TY PES_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
-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_TY
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.dwOSVersionInfoS
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
Dim OS As String
OS = GetOsVersion()
'validate input parameter
If Len(Trim$(DriveLetter)) <> 2 And Right$(Trim$(DriveLetter),
MsgBox "Please enter the drive letter and a colon."
Else
GetDriveTypeEx = GetDriveType(Trim$(DriveLe
'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_TY
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
Booting to WinXP Date: 10/29/2001 01:38PM PST
https://www.experts-exchange.com/questions/20218574/Booting-to-WinXP.html
Thanks,
Anthony