vbAccelerator - Contents of code file: cSimpleDiscRecorder.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 = "cSimpleDiscRecorder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal
 lpString As String) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
   (ByVal hWndOwner As Long, _
    ByVal nFolder As Long, _
    pidl As Long) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias
 "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHGetMalloc Lib "shell32.dll" (ppMalloc As IVBMalloc)
 As Long
Private Const CSIDL_CDBURN_AREA  As Long = &H3B&        '// USERPROFILE\Local
 Settings\Application Data\Microsoft\CD Burning
Private Const MAX_PATH As Long = 260&

Private m_alloc As IVBMalloc
Private m_cdBurn As ICDBurn
Private m_hWndOwner As Long

Private Const ERR_BASE As Long = 47600

Friend Sub fInit(ByVal cCDBurn As ICDBurn)
   Set m_cdBurn = cCDBurn
End Sub

Public Sub Initialise(ByVal hWndOwner As Long)
Attribute Initialise.VB_Description = "Initialises the simple CD burner for
 use."
   m_hWndOwner = hWndOwner
End Sub

Public Property Get BurnStagingAreaFolder() As String
Attribute BurnStagingAreaFolder.VB_Description = "Gets the folder which holds
 the staging files to be burnt to disc."
Dim pidl As Long
On Error Resume Next
   ' Get pidl of special folder:
   SHGetSpecialFolderLocation m_hWndOwner, CSIDL_CDBURN_AREA, pidl
   If err = 0 Then
      ' Convert it to a path:
      BurnStagingAreaFolder = PathFromPidl(pidl)
      ' Free the pidl:
      Allocator.Free ByVal pidl
      pidl = 0
   End If
End Property

Private Property Get Allocator() As IVBMalloc
    If m_alloc Is Nothing Then SHGetMalloc m_alloc
    Set Allocator = m_alloc
End Property

Private Function PathFromPidl(ByVal pidl As Long) As String
Dim sPath As String
Dim lR As Long
   sPath = String$(MAX_PATH, 0)
   lR = SHGetPathFromIDList(pidl, sPath)
   If lR <> 0 Then
      PathFromPidl = Left$(sPath, lstrlen(sPath))
   End If
End Function

Public Property Get HasRecordableDrive() As Boolean
Attribute HasRecordableDrive.VB_Description = "Gets whether the system has a
 recordable drive attached."
Dim lHasRecorder As Long
   m_cdBurn.HasRecordableDrive lHasRecorder
   HasRecordableDrive = Not (lHasRecorder = 0)
End Property

Public Property Get RecorderDriveLetter() As String
Attribute RecorderDriveLetter.VB_Description = "Gets the drive letter of the
 recorder which this interface writes to."
   Dim sDrive As String
   sDrive = String(10, 0)
   m_cdBurn.GetRecorderDriveLetter sDrive, Len(sDrive)
   Dim iPos As Long
   iPos = InStr(sDrive, vbNullChar)
   If (iPos > 1) Then
      sDrive = Left(sDrive, iPos - 1)
   End If
   RecorderDriveLetter = sDrive
End Property

Public Sub Burn()
Attribute Burn.VB_Description = "Burns the files in the Staging Area onto the
 CD."
   m_cdBurn.Burn m_hWndOwner
End Sub

Private Sub Class_Terminate()
   Set m_cdBurn = Nothing
End Sub