VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsDrives"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' -------------------------------------------------------------------------------
'
'   AVStoDVD - by MrC
'   File: clsDrives.cls
'   Purpose: Class that identify CD-ROM and DVD-ROM and their burning capability
'
' -------------------------------------------------------------------------------


Option Explicit
Option Compare Binary
Option Base 0


' Single drive's properties
Private Type driveProperties
    driveLetter As String
    deviceName As String
    readCD As Boolean
    writeCD As Boolean
    readDVD As Boolean
    writeDVD As Boolean
    locked As Boolean
End Type


' SCSI pass through struct
Private Type SCSI_PASS_THROUGH
    Length As Integer
    scsiStatus As Byte
    pathId As Byte
    targetId As Byte
    Lun As Byte
    cdbLength As Byte
    senseInfoLength As Byte
    dataIn As Byte
    dataTransferLength As Long
    timeOutValue As Long
    dataBufferOffset As Long
    senseInfoOffset As Long
    Cdb(15) As Byte
End Type


' SCSI buffered pass through struct
Private Type SCSI_PASS_THROUGH_WITH_BUFFERS
    SPT As SCSI_PASS_THROUGH
    Filler As Long
    senseBuf(31) As Byte
    dataBuf(511) As Byte
End Type


' DriveType constants
Private Const DRIVE_UNKNOWN As Long = 0
Private Const DRIVE_NO_ROOT_DIR As Long = 1
Private Const DRIVE_REMOVABLE As Long = 2
Private Const DRIVE_FIXED As Long = 3
Private Const DRIVE_REMOTE As Long = 4
Private Const DRIVE_CDROM As Long = 5
Private Const DRIVE_RAMDISK  As Long = 6

' CreateFile constants
Private Const GENERIC_READ As Long = &H80000000
Private Const GENERIC_WRITE As Long = &H40000000
Private Const FILE_SHARE_READ As Long = &H1
Private Const FILE_SHARE_WRITE As Long = &H2
Private Const OPEN_EXISTING As Long = 3
Private Const INVALID_HANDLE_VALUE As Long = -1

' DeviceIoControl SCSI commands
Private Const CDB6GENERIC_LENGTH As Long = 6
Private Const IOCTL_SCSI_PASS_THROUGH  As Long = &H4D004
Private Const MODE_PAGE_CAPABILITIES As Long = &H2A
Private Const SCSI_IOCTL_DATA_IN As Long = 1
Private Const SCSIOP_INQUIRY As Long = &H12
Private Const SCSIOP_MODE_SENSE As Long = &H1A


' Enumerated drives
Private Drives() As driveProperties
Private nDrives As Long


Private Declare Function GetDriveType Lib "KERNEL32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "KERNEL32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function CreateFile Lib "KERNEL32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal 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
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, ByVal lpOverlapped As Long) As Long


' Properties
Public Property Get driveCount() As Long

    driveCount = nDrives

End Property

Public Property Get driveDeviceName(ByVal Index As Long) As String

    driveDeviceName = Drives(Index).deviceName

End Property

Public Property Get driveLetter(ByVal Index As Long) As String

    driveLetter = Drives(Index).driveLetter

End Property

Public Property Get driveReadCD(ByVal Index As Long) As Boolean

    driveReadCD = Drives(Index).readCD

End Property

Public Property Get driveWriteCD(ByVal Index As Long) As Boolean

    driveWriteCD = Drives(Index).writeCD

End Property

Public Property Get driveReadDVD(ByVal Index As Long) As Boolean

    driveReadDVD = Drives(Index).readDVD

End Property

Public Property Get driveWriteDVD(ByVal Index As Long) As Boolean

    driveWriteDVD = Drives(Index).writeDVD

End Property

Public Property Get driveLocked(ByVal Index As Long) As Boolean

    driveLocked = Drives(Index).locked

End Property


' Enumerate all the devices when class is instantiated
' Note that this only occurs when the object is late-bound!
Private Sub Class_Initialize()

    Dim A As Long
    Dim driveString As String
    Dim drivePaths() As String
    Dim Result As Long
    
    Dim driveType As Long
    Dim cDrive As Long
    Dim hDrive As Long
    Dim driveCaps() As Boolean
    

    ' Call to setup buffer
    Result = GetLogicalDriveStrings(0, driveString)
    driveString = String(Result, 0)
    
    ' Call to retrieve drive strings
    Result = GetLogicalDriveStrings(Result, driveString)
    If Result = 0 Then Exit Sub
    driveString = Left(driveString, Len(driveString) - 2)
    
    
    ' Determine basic type of each drive
    drivePaths = Split(driveString, Chr(0))
    For A = 0 To UBound(drivePaths)
        
        driveType = GetDriveType(drivePaths(A))
        
        ' Only examine CDROM types more closely
        If driveType = DRIVE_CDROM Then
        
            ReDim Preserve Drives(nDrives)
            nDrives = nDrives + 1
            cDrive = nDrives - 1
            Drives(cDrive).driveLetter = Left(drivePaths(A), 1)

            ' Create handle to device
            hDrive = CreateFile("\\.\" & Left(drivePaths(A), 2), GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
            If hDrive = INVALID_HANDLE_VALUE Then
                Drives(cDrive).locked = True
                Exit Sub
            End If
            
            ' Get properties
            Drives(cDrive).deviceName = getSCSIDeviceName(hDrive)
            driveCaps = getSCSIDeviceCaps(hDrive)
            
            ' Interpret capabilities
            If driveCaps(7) Or driveCaps(8) Then Drives(cDrive).writeDVD = True
            If driveCaps(6) Or driveCaps(5) Or driveCaps(4) Then Drives(cDrive).readDVD = True
            If driveCaps(3) Or driveCaps(2) Then Drives(cDrive).writeCD = True
            If driveCaps(1) Or driveCaps(0) Then Drives(cDrive).readCD = True
            
            CloseHandle hDrive
            
        End If
        
    Next A

End Sub


' Return the device name (Product Vendor + Product Id + Product Revision)
Private Function getSCSIDeviceName(ByVal Handle As Long) As String

    Dim Buf As SCSI_PASS_THROUGH_WITH_BUFFERS
    Dim Length As Long
    Dim returnedBytes As Long
    Dim Status As Long
    Dim sData As String
    
    
    ' SCSI call to get device product name
    With Buf.SPT
        .dataTransferLength = 192
        .Length = LenB(Buf.SPT)
        .pathId = 0
        .targetId = 1
        .Lun = 0
        .cdbLength = CDB6GENERIC_LENGTH
        .senseInfoLength = 24
        .dataIn = SCSI_IOCTL_DATA_IN
        .timeOutValue = 2
        .senseInfoOffset = LenB(Buf.SPT) + 4
        .dataBufferOffset = LenB(Buf.SPT) + 36
        .Cdb(0) = SCSIOP_INQUIRY
        .Cdb(4) = 192
        Length = .dataBufferOffset + .dataTransferLength
    End With
    
    Status = DeviceIoControl(Handle, IOCTL_SCSI_PASS_THROUGH, Buf, LenB(Buf.SPT), Buf, Length, returnedBytes, 0)
    
    ' Parse vendor, ID and revision from recieved data
    sData = StrConv(Buf.dataBuf, vbUnicode)
    getSCSIDeviceName = RTrim(Mid(sData, 9, 8)) & " " & RTrim(Mid(sData, 17, 16)) & " " & RTrim(Mid(sData, 33, 4))

End Function


' Return a device's mode sense capabilities (read\write CD\DVD)
' Only works if the device supports SCSI3
'
' 0 Read CD-R
' 1 Read CD-RW
' 2 Write CD-R
' 3 Write CD-RW
' 4 Read DVD-ROM
' 5 Read DVD-R
' 6 Read DVD-RAM
' 7 Write DVD-R
' 8 Write DVD-RAM
'
Private Function getSCSIDeviceCaps(ByVal Handle As Long) As Boolean()

    Dim Buf As SCSI_PASS_THROUGH_WITH_BUFFERS
    Dim Length As Long
    Dim returnedBytes As Long
    Dim Status As Long
    Dim Caps() As Boolean
    
    
    ' SCSI call to get device mode sense page
    With Buf.SPT
        .dataTransferLength = 192
        .Length = LenB(Buf.SPT)
        .pathId = 0
        .targetId = 1
        .Lun = 0
        .cdbLength = CDB6GENERIC_LENGTH
        .senseInfoLength = 24
        .dataIn = SCSI_IOCTL_DATA_IN
        .timeOutValue = 2
        .senseInfoOffset = LenB(Buf.SPT) + 4
        .dataBufferOffset = LenB(Buf.SPT) + 36
        .Cdb(0) = SCSIOP_MODE_SENSE
        .Cdb(1) = &H8
        .Cdb(2) = MODE_PAGE_CAPABILITIES
        .Cdb(4) = 192
        Length = .dataBufferOffset + .dataTransferLength
    End With
    
    Status = DeviceIoControl(Handle, IOCTL_SCSI_PASS_THROUGH, Buf, LenB(Buf.SPT), Buf, Length, returnedBytes, 0)
    
    ' Parse caps from recieved data
    ReDim Caps(8)
    If (Buf.dataBuf(6) And &H1) Then Caps(0) = True
    If (Buf.dataBuf(6) And &H2) Then Caps(1) = True
    If (Buf.dataBuf(7) And &H1) Then Caps(2) = True
    If (Buf.dataBuf(7) And &H2) Then Caps(3) = True
    If (Buf.dataBuf(6) And &H8) Then Caps(4) = True
    If (Buf.dataBuf(6) And &H10) Then Caps(5) = True
    If (Buf.dataBuf(6) And &H20) Then Caps(6) = True
    If (Buf.dataBuf(7) And &H10) Then Caps(7) = True
    If (Buf.dataBuf(7) And &H20) Then Caps(8) = True
    
    getSCSIDeviceCaps = Caps
    
End Function
