vbAccelerator - Contents of code file: cDiscMaster.cls

This file is part of the download VB5 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 = "cDiscMaster"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Private Const CLSID_MSDiscMasterObj As String =
 "520CCA63-51A5-11D3-9144-00104BA11C5E"
Private Const IID_IDiscMaster As String = "520CCA62-51A5-11D3-9144-00104BA11C5E"
Private Const IID_IRedbookDiscMaster As String =
 "E3BC42CD-4E5C-11D3-9144-00104BA11C5E"
Private Const IID_IJolietDiscMaster 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 Const ERR_BASE As Long = 47700

Private m_cDiscMaster As IVBDiscMaster
Private m_cdBurn As ICDBurn
Private m_cSimpleRecorder As cSimpleDiscRecorder
Private m_cDiscRecorders As cDiscRecorders
Private WithEvents m_cProgress As cDiscMasterProgressEvents
Attribute m_cProgress.VB_VarHelpID = -1
Private m_lProgressCookie As Long

Public Event AddProgress(ByVal nCompleted As Long, ByVal nTotal As Long)
Attribute AddProgress.VB_Description = "Raised as items are added to the stash."
Public Event BlockProgress(ByVal nCurrentBlock As Long, ByVal nTotalBlocks As
 Long)
Attribute BlockProgress.VB_Description = "Raised as blocks are burnt to the CD."
Public Event ClosingDisc(ByVal nEstimatedSeconds As Long)
Attribute ClosingDisc.VB_Description = "Raised when the disc is about to be
 closed."
Public Event EraseComplete(ByVal status As Long)
Attribute EraseComplete.VB_Description = "Raised when an erase operation on a
 CDRW disc has completed."
Public Event BurnComplete(ByVal status As Long)
Attribute BurnComplete.VB_Description = "Raised when a CD Burn operation has
 completed."
Public Event PnPActivity()
Attribute PnPActivity.VB_Description = "Raised when a Plug and Play activity
 has occurred which has changed the list of drives on the machine."
Public Event PreparingBurn(ByVal nEstimatedSeconds As Long)
Attribute PreparingBurn.VB_Description = "Raised when a burn is being prepared."
Public Event TrackProgress(ByVal nCurrentTrack As Long, ByVal nTotalTracks As
 Long)
Attribute TrackProgress.VB_Description = "Raised as tracks are completed when
 buring an audio CD."
Public Event QueryCancel(ByRef bCancel As Boolean)
Attribute QueryCancel.VB_Description = "Raised during a burn process to request
 whether the burn should be cancelled."

Public Sub Initialise()
Attribute Initialise.VB_Description = "Initialises the disc master library for
 use.  Must be called before any other method can be used."
Dim clsidMsDiscMaster As UUID
Dim iidIDiscMaster As UUID
Dim hR As Long
Dim l As Long
Dim cDiscMaster As IVBDiscMaster

   If (InitialiseCDBurn()) Then

      With clsidMsDiscMaster
         .Data1 = &H520CCA63
         .Data2 = &H51A5&
         .Data3 = &H11D3&
         .Data4(0) = &H91
         .Data4(1) = &H44
         .Data4(2) = &H0
         .Data4(3) = &H10
         .Data4(4) = &H4B
         .Data4(5) = &HA1
         .Data4(6) = &H1C
         .Data4(7) = &H5E
      End With
   
      With iidIDiscMaster
         .Data1 = &H520CCA62
         .Data2 = &H51A5&
         .Data3 = &H11D3&
         .Data4(0) = &H91
         .Data4(1) = &H44
         .Data4(2) = &H0
         .Data4(3) = &H10
         .Data4(4) = &H4B
         .Data4(5) = &HA1
         .Data4(6) = &H1C
         .Data4(7) = &H5E
      End With
            
      hR = CoCreateInstance(clsidMsDiscMaster, _
         Nothing, _
         CLSCTX_INPROC_SERVER Or CLSCTX_LOCAL_SERVER, _
         iidIDiscMaster, _
         cDiscMaster)
      If (FAILED(hR)) Then
         err.Raise ERR_BASE + 1, App.EXEName & ".cDiscMaster", "Failed to
          instantiate IDiscMaster implementation"
      Else
         Set m_cDiscMaster = cDiscMaster
         cDiscMaster.Release
         CopyMemory cDiscMaster, 0&, 4
         
         m_cDiscMaster.Open
            
         Set m_cProgress = New cDiscMasterProgressEvents
         m_cDiscMaster.ProgressAdvise m_cProgress, m_lProgressCookie
                           
      End If
   End If
   
End Sub

Public Property Get SimpleRecorder() As cSimpleDiscRecorder
   Set SimpleRecorder = m_cSimpleRecorder
End Property

Public Property Get Recorders() As cDiscRecorders
Attribute Recorders.VB_Description = "Gets a collection of Recorders attached
 to the system."
   If Not (m_cDiscMaster Is Nothing) Then
      If (m_cDiscRecorders Is Nothing) Then
         Set m_cDiscRecorders = New cDiscRecorders
         m_cDiscRecorders.fInit m_cDiscMaster
      End If
      Set Recorders = m_cDiscRecorders
   End If
End Property

Public Sub RefreshRecorders()
   If Not (m_cDiscRecorders Is Nothing) Then
      m_cDiscRecorders.fRefresh
   End If
End Sub

Public Sub ClearFormatContent()
Attribute ClearFormatContent.VB_Description = "Clears any content added to the
 stash."
   m_cDiscMaster.ClearFormatContent
End Sub

Public Property Get RedbookDiscMaster() As cRedbookDiscMaster
Attribute RedbookDiscMaster.VB_Description = "Gets a Redbook (Audio) disc
 master object which can be used to write Audio CDs."
   '
   Set m_cDiscRecorders = Nothing
   
   Dim redbook As IVBRedbookDiscMaster
   Dim iid As UUID
   iid.Data1 = &HE3BC42CD
   iid.Data2 = &H4E5C
   iid.Data3 = &H11D3
   iid.Data4(0) = &H91
   iid.Data4(1) = &H44
   iid.Data4(2) = &H0
   iid.Data4(3) = &H10
   iid.Data4(4) = &H4B
   iid.Data4(5) = &HA1
   iid.Data4(6) = &H1C
   iid.Data4(7) = &H5E
   m_cDiscMaster.SetActiveDiscMasterFormat iid, redbook
   redbook.AddRef
   
   Dim cRedbook As cRedbookDiscMaster
   Set cRedbook = New cRedbookDiscMaster
   cRedbook.fInit redbook
   redbook.Release
   CopyMemory redbook, 0&, 4
   
   Recorders.Recorder(1).SetAsActive
   
   Set RedbookDiscMaster = cRedbook
   '
End Property

Public Property Get JolietDiscMaster() As cJolietDiscMaster
Attribute JolietDiscMaster.VB_Description = "Gets a Joliet (Data) Disc Master
 object which can be used to write files using an IStorage interface."
   '
   Set m_cDiscRecorders = Nothing
   
   Dim joliet As IVBJolietDiscMaster
   Dim iid As UUID
   iid.Data1 = &HE3BC42CE
   iid.Data2 = &H4E5C
   iid.Data3 = &H11D3
   iid.Data4(0) = &H91
   iid.Data4(1) = &H44
   iid.Data4(2) = &H0
   iid.Data4(3) = &H10
   iid.Data4(4) = &H4B
   iid.Data4(5) = &HA1
   iid.Data4(6) = &H1C
   iid.Data4(7) = &H5E
   m_cDiscMaster.SetActiveDiscMasterFormat iid, joliet
   joliet.AddRef
   
   Dim cJoliet As cJolietDiscMaster
   Set cJoliet = New cJolietDiscMaster
   cJoliet.fInit joliet
   joliet.Release
   CopyMemory joliet, 0&, 4
   
   Recorders.Recorder(1).SetAsActive
   
   Set JolietDiscMaster = cJoliet
   '
End Property

Public Sub RecordDisc(ByVal bSimulate As Boolean, ByVal bEjectAfterBurn As
 Boolean)
Attribute RecordDisc.VB_Description = "Burns or simulates a burn to disc of the
 contents stashed from either a JolietDiscMaster or RedbookDiscMaster instance."
   m_cDiscMaster.RecordDisc Abs(CLng(bSimulate)), Abs(CLng(bEjectAfterBurn))
End Sub

Private Function InitialiseCDBurn() As Boolean
Dim clsidCDBurn As UUID
Dim cdBurn As ICDBurn

   With clsidCDBurn
      .Data1 = &HFBEB8A05
      .Data2 = &HBEEE
      .Data3 = &H4442
      .Data4(0) = &H80
      .Data4(1) = &H4E
      .Data4(2) = &H40
      .Data4(3) = &H9D
      .Data4(4) = &H6C
      .Data4(5) = &H45
      .Data4(6) = &H15
      .Data4(7) = &HE9
   End With
Dim iidCDBurn As UUID
   With iidCDBurn
      .Data1 = &H3D73A659
      .Data2 = &HE5D0
      .Data3 = &H4D42
      .Data4(0) = &HAF
      .Data4(1) = &HC0
      .Data4(2) = &H51
      .Data4(3) = &H21
      .Data4(4) = &HBA
      .Data4(5) = &H42
      .Data4(6) = &H5C
      .Data4(7) = &H8D
   End With
   
   Dim hR As Long
   hR = CoCreateInstance( _
      clsidCDBurn, _
      Nothing, _
      CLSCTX_INPROC_SERVER, _
      iidCDBurn, _
      cdBurn)
   If (FAILED(hR)) Then
      err.Raise ERR_BASE + 1, App.EXEName & ".cSimpleCDBurner", "Failed to
       instantiate CDBurn implementation"
   Else
      Set m_cdBurn = cdBurn
      cdBurn.Release
      CopyMemory cdBurn, 0&, 4
      
      Set m_cSimpleRecorder = New cSimpleDiscRecorder
      m_cSimpleRecorder.fInit m_cdBurn
      InitialiseCDBurn = True
   End If
   
End Function

Public Sub ClearUp()
Attribute ClearUp.VB_Description = "Clears up resources associated with the
 library.  It is recommended you call this before your application terminates."
   
   If Not (m_cSimpleRecorder Is Nothing) Then
      Set m_cSimpleRecorder = Nothing
   End If
   
   If Not (m_cDiscRecorders Is Nothing) Then
      Set m_cDiscRecorders = Nothing
   End If
   
   If Not (m_cDiscMaster Is Nothing) Then
      m_cDiscMaster.ProgressUnadvise m_lProgressCookie
      m_cDiscMaster.Close
      Set m_cProgress = Nothing
      
      m_cDiscMaster.Release
      Set m_cDiscMaster = Nothing
   End If
   
   If Not (m_cdBurn Is Nothing) Then
      m_cdBurn.Release
      Set m_cdBurn = Nothing
   End If
   
End Sub

Private Sub Class_Terminate()
   '
   ClearUp
   '
End Sub

Private Sub m_cProgress_Add(ByVal nCompleted As Long, ByVal nTotal As Long)
   RaiseEvent AddProgress(nCompleted, nTotal)
End Sub

Private Sub m_cProgress_BlockProgress(ByVal nCurrentBlock As Long, ByVal
 nTotalBlocks As Long)
   RaiseEvent BlockProgress(nCurrentBlock, nTotalBlocks)
End Sub

Private Sub m_cProgress_BurnComplete(ByVal status As Long)
   RaiseEvent BurnComplete(status)
End Sub

Private Sub m_cProgress_ClosingDisc(ByVal nEstimatedSeconds As Long)
   RaiseEvent ClosingDisc(nEstimatedSeconds)
End Sub

Private Sub m_cProgress_EraseComplete(ByVal status As Long)
   RaiseEvent EraseComplete(status)
End Sub

Private Sub m_cProgress_PnPActivity()
   RaiseEvent PnPActivity
End Sub

Private Sub m_cProgress_PreparingBurn(ByVal nEstimatedSeconds As Long)
   RaiseEvent PreparingBurn(nEstimatedSeconds)
End Sub

Private Sub m_cProgress_QueryCancel(bCancel As Boolean)
   RaiseEvent QueryCancel(bCancel)
End Sub

Private Sub m_cProgress_TrackProgress(ByVal nCurrentTrack As Long, ByVal
 nTotalTracks As Long)
   RaiseEvent TrackProgress(nCurrentTrack, nTotalTracks)
End Sub