vbAccelerator - Contents of code file: cDiscRecorder.cls

This file is part of the download VB6 IMAPI Library Source, which is described in the article Image Mastering API (IMAPI) Library for VB.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cDiscRecorder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Private Const IID_RedbookDiscMaster As String =
 "E3BC42CD-4E5C-11D3-9144-00104BA11C5E"
Private Const IID_JolietDiscMaster As String =
 "E3BC42CE-4E5C-11D3-9144-00104BA11C5E"

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As
 Any, lpvSource As Any, ByVal cbCopy As Long)

Private m_cRecorder As IVBDiscRecorder
Private m_cDiscMaster As IVBDiscMaster
Private m_bSupportsJoliet As Boolean
Private m_bSupportsRedbook As Boolean

Friend Sub fMarkDead()
   ClearUp
End Sub

Friend Sub fInit(cDM As IVBDiscMaster, cDR As IVBDiscRecorder)
   
   Set m_cDiscMaster = cDM
   Set m_cRecorder = cDR
   
   ' TODO: Here I'm assuming that this recorder is set as active
   Dim activeFormatIID As UUID
   m_cDiscMaster.GetActiveDiscMasterFormat activeFormatIID
   'Debug.Print UUIDAsString(activeFormatIID)

   Dim formatEnum As IVBEnumDiscMasterFormats
   m_cDiscMaster.EnumDiscMasterFormats formatEnum
   formatEnum.AddRef

   Dim hR As Long
   Dim enumFormatIID As UUID
   Dim fetched As Long
   Do
      hR = formatEnum.Next(1, enumFormatIID, fetched)
      If Not FAILED(hR) And (fetched > 0) Then
         If (UUIDAsString(enumFormatIID) = IID_RedbookDiscMaster) Then
            m_bSupportsJoliet = True
         ElseIf (UUIDAsString(enumFormatIID) = IID_JolietDiscMaster) Then
            m_bSupportsRedbook = True
         End If
      End If
   Loop While (fetched > 0) And Not FAILED(hR)
   formatEnum.Release
   CopyMemory formatEnum, 0&, 4
   
   
End Sub

Public Property Get VendorId() As String
Attribute VendorId.VB_Description = "Gets the vendor id for this recorder."
Dim sVendorId As String
   getDisplayNames sVendorId
   VendorId = sVendorId
End Property
Public Property Get ProductId() As String
Attribute ProductId.VB_Description = "Gets the product identifier for this
 recorder."
Dim sProductId As String
   getDisplayNames , sProductId
   ProductId = sProductId
End Property
Public Property Get RevisionId() As String
Attribute RevisionId.VB_Description = "Gets the revision id of this recorder."
Dim sRevisionId As String
   getDisplayNames , , sRevisionId
   RevisionId = sRevisionId
End Property
Public Property Get RecorderType() As RECORDER_TYPES
Attribute RecorderType.VB_Description = "Gets the type (CDR or CDRW) of this
 recorder."
Dim eType As RECORDER_TYPES
   RecorderType = -1
   If Not (m_cRecorder Is Nothing) Then
      m_cRecorder.GetRecorderType eType
   End If
   RecorderType = eType
End Property
Public Property Get Path() As String
Attribute Path.VB_Description = "Gets the system path for this drive (typically
 a SCSI type path)."
Dim sPath As String
   If Not (m_cRecorder Is Nothing) Then
      m_cRecorder.GetPath sPath
      Path = sPath
      Exit Property
   End If
End Property
Public Property Get PnPID() As String
Attribute PnPID.VB_Description = "Gets the Plug and Play ID of this drive."
Dim sPnpId As String
   If Not (m_cRecorder Is Nothing) Then
      m_cRecorder.GetBasePnPID sPnpId
      PnPID = sPnpId
      Exit Property
   End If
End Property
Public Property Get RecorderState() As RECORDER_STATE
Attribute RecorderState.VB_Description = "Gets the state of this recorder."
Dim eState As RECORDER_STATE
   RecorderState = -1
   If Not (m_cRecorder Is Nothing) Then
      m_cRecorder.GetRecorderState eState
      RecorderState = eState
      Exit Property
   End If
   '
   
End Property

Public Sub EraseCDRW(ByVal bFullErase As Boolean)
Attribute EraseCDRW.VB_Description = "Erases a CDRW disc on this recorder."
   If Not (m_cRecorder Is Nothing) Then
      m_cRecorder.Erase Abs(CLng(bFullErase))
   End If
End Sub
Public Sub Eject()
Attribute Eject.VB_Description = "Ejects the CD tray for this recorder."
   If Not (m_cRecorder Is Nothing) Then
      m_cRecorder.Eject
   End If
End Sub
Public Sub OpenExclusive()
Attribute OpenExclusive.VB_Description = "Opens the drive for exclusive access.
  This is needed to query the media within the drive.  Whilst a drive is
 exclusively open data cannot be burnt to it."
   If Not (m_cRecorder Is Nothing) Then
      m_cRecorder.OpenExclusive
   End If
End Sub
   

Public Property Get IsActive() As Boolean
Attribute IsActive.VB_Description = "Gets whether this disc is active. See also
 SetAsActive."
   
   If Not (m_cDiscMaster Is Nothing) Then
      If Not (m_cRecorder Is Nothing) Then
         Dim cRecorder As IVBDiscRecorder
         m_cDiscMaster.GetActiveDiscRecorder cRecorder
         cRecorder.AddRef
         IsActive = (cRecorder Is m_cRecorder)
         cRecorder.Release
         CopyMemory cRecorder, 0&, 4
         Exit Property
      End If
   End If
   
End Property

Public Sub SetAsActive()
Attribute SetAsActive.VB_Description = "Sets this recorder as the active
 recorder on the system."
   
   If Not (m_cDiscMaster Is Nothing) Then
      If Not (m_cRecorder Is Nothing) Then
         m_cDiscMaster.SetActiveDiscRecorder m_cRecorder
         Exit Sub
      End If
   End If
   
End Sub

Public Sub CloseExclusive()
Attribute CloseExclusive.VB_Description = "Closes the recorder if it was
 previously opened with OpenExclusive."
   If Not (m_cRecorder Is Nothing) Then
      m_cRecorder.Close
      Exit Sub
   End If
End Sub

Public Property Get MediaInfo() As cMediaInfo
Attribute MediaInfo.VB_Description = "Gets information about the media in the
 drive (if any).  The disc must be opened using OpenExclusive to call this
 method."
   If Not (m_cRecorder Is Nothing) Then
      Dim cM As New cMediaInfo
      cM.fInit m_cRecorder
      Set MediaInfo = cM
   End If
End Property

Public Property Get Properties() As cDiscRecorderProperties
Attribute Properties.VB_Description = "Gets properties associated with this
 recorder.  The properties will vary depending on which media is present in the
 drive."
   If Not (m_cRecorder Is Nothing) Then
      Dim cP As New cDiscRecorderProperties
      cP.fInit m_cRecorder
      Set Properties = cP
   End If
End Property

Public Sub SetProperties(cProps As cDiscRecorderProperties)
   If Not (m_cRecorder Is Nothing) Then
      Dim cP As cPropertyStorage
      Set cP = cProps.fPropertyStore
      cP.fUpdate
      m_cRecorder.SetRecorderProperties cP.PropertyStorage
   Else
   End If
End Sub


Public Property Get SupportsRedbook() As Boolean
Attribute SupportsRedbook.VB_Description = "Gets whether this recorder supports
 Redbook (audio) recording."
   SupportsRedbook = m_bSupportsRedbook
End Property

Public Property Get SupportsJoliet() As Boolean
Attribute SupportsJoliet.VB_Description = "Gets whether this recorder supports
 Joliet (data) recording."
   SupportsJoliet = m_bSupportsJoliet
End Property


Private Sub getDisplayNames( _
   Optional ByRef sVendorId As String, _
   Optional ByRef sProductId As String, _
   Optional ByRef sRevisionId As String _
   )
   If Not (m_cRecorder Is Nothing) Then
      m_cRecorder.getDisplayNames sVendorId, sProductId, sRevisionId
   Else
      '
   End If
End Sub

Private Sub ClearUp()
   If Not m_cRecorder Is Nothing Then
      On Error Resume Next
      m_cRecorder.Close
      On Error GoTo 0
      Set m_cRecorder = Nothing
   End If
   If Not m_cDiscMaster Is Nothing Then
      Set m_cDiscMaster = Nothing
   End If
End Sub

Private Sub Class_Terminate()
   ClearUp
End Sub