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 LongEnd TypePrivate Type GET_MEDIA_TYPES   DeviceType As Long   MediaInfoCount As Long   MediaInfo(0) As DEVICE_MEDIA_INFOEnd TypeConst IOCTL_STORAGE_GET_MEDIA_TYPES_EX As Long = &H2D0C04Const GENERIC_READ As Long = &H80000000Const GENERIC_WRITE As Long = &H40000000Const FILE_SHARE_READ As Long = &H1Const FILE_SHARE_WRITE As Long = &H2Const OPEN_EXISTING As Long = 3Const INVALID_HANDLE_VALUE As Long = -1Const ERROR_ACCESS_DENIED As Long = 5&Const ERROR_NOT_READY As Long = 21&Const FILE_ATTRIBUTE_NORMAL As Long = &H80Const FILE_FLAG_NO_BUFFERING As Long = &H20000000Const FILE_DEVICE_CD_ROM As Long = &H2Const FILE_DEVICE_DVD As Long = &H33Private Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" _    (ByVal nDrive As String) As LongPrivate Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _    (lbVersionInfirmation As OSVERSIONINFO) As LongPrivate Type OSVERSIONINFO    dwOSVersionInfoSize As Long    dwMajorVersion As Long    dwMinorVersion As Long    dwBuildNumber As Long    dwPlatformId As Long    szCSDVersion As String * 128End TypePrivate 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_2End EnumPrivate Enum DriveType    UNKNOWN = 0    NO_ROOT_DIR '1    REMOVABLE   '2    FIXED       '3    REMOTE      '4    DVDORCDROM  '5    RAMDISK     '6    DVD         '7    CDROM       '8End EnumConst DRIVE_CDROM = 5Const DRIVE_FIXED = 3Const DRIVE_RAMDISK = 6Const DRIVE_REMOTE = 4Const DRIVE_REMOVABLE = 2Const DRIVE_NO_ROOT_DIR = 1Const DRIVE_UNKNOWN = 0Private 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 LongPrivate 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 LongPrivate 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 IfEnd Function' return a string that identifies the OS versionFunction 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 IfEnd Function