home *** CD-ROM | disk | FTP | other *** search
VERSION 5.00 Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX" Object = "{B826C06B-C37C-4A6C-BEB8-53B5CEF374C9}#1.0#0"; "CDRProX.tlb" Begin VB.Form frmMain BorderStyle = 1 'Fixed Single Caption = "CDWriterPro Sample2" ClientHeight = 5655 ClientLeft = 150 ClientTop = 435 ClientWidth = 6015 Icon = "frmMain.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 5655 ScaleWidth = 6015 StartUpPosition = 1 'CenterOwner Begin VB.Frame fraOptions Caption = "Write Options" Height = 1470 Left = 3375 TabIndex = 13 Top = 3825 Width = 2520 Begin VB.CheckBox chkCacheFiles Caption = "Cach files locally" Height = 240 Left = 165 TabIndex = 16 Top = 405 Value = 1 'Checked Width = 2295 End Begin VB.CheckBox chkTestWrite Caption = "Test Mode " Height = 240 Left = 165 TabIndex = 15 Top = 712 Width = 2025 End Begin VB.CheckBox chkUseBurnProof Caption = "Use Buffer Protection" Height = 240 Left = 165 TabIndex = 14 Top = 1020 Width = 2025 End End Begin VB.CommandButton cmdCancel Caption = "&Cancel" Height = 375 Left = 105 TabIndex = 12 Top = 4920 Width = 1575 End Begin VB.CommandButton cmdWriteDisc Caption = "&Write Disc" Height = 375 Left = 1680 TabIndex = 11 Top = 4920 Width = 1575 End Begin MSComctlLib.StatusBar sbrStatus Align = 2 'Align Bottom Height = 300 Left = 0 TabIndex = 10 Top = 5355 Width = 6015 _ExtentX = 10610 _ExtentY = 529 Style = 1 SimpleText = "Add Audio Files" _Version = 393216 BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} NumPanels = 1 BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} EndProperty EndProperty End Begin VB.ComboBox cboDevices Height = 315 Left = 585 Style = 2 'Dropdown List TabIndex = 4 Top = 75 Width = 2835 End Begin VB.ComboBox cboWriteSpeed Height = 315 Left = 4845 Style = 2 'Dropdown List TabIndex = 2 Top = 75 Width = 1095 End Begin MSComctlLib.ListView lvwAudioTracks Height = 2820 Left = 60 TabIndex = 0 Top = 780 Width = 5895 _ExtentX = 10398 _ExtentY = 4974 View = 3 LabelEdit = 1 LabelWrap = -1 'True HideSelection = 0 'False OLEDragMode = 1 OLEDropMode = 1 FullRowSelect = -1 'True _Version = 393217 ForeColor = -2147483640 BackColor = -2147483643 BorderStyle = 1 Appearance = 1 OLEDragMode = 1 OLEDropMode = 1 NumItems = 4 BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} Text = "Track" Object.Width = 1764 EndProperty BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} SubItemIndex = 1 Text = "File Name" Object.Width = 4939 EndProperty BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} Alignment = 2 SubItemIndex = 2 Text = "Type" Object.Width = 1764 EndProperty BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628} Alignment = 2 SubItemIndex = 3 Text = "Time" Object.Width = 1940 EndProperty End Begin MSComctlLib.ProgressBar prgTrackProgress Height = 300 Left = 75 TabIndex = 6 Top = 3945 Width = 3225 _ExtentX = 5689 _ExtentY = 529 _Version = 393216 Appearance = 1 Scrolling = 1 End Begin MSComctlLib.ProgressBar prgTotalProgress Height = 300 Left = 75 TabIndex = 7 Top = 4545 Width = 3225 _ExtentX = 5689 _ExtentY = 529 _Version = 393216 Appearance = 1 Scrolling = 1 End Begin CDRPROXLibCtl.CDWriterPro CDWriterPro1 Left = 3390 OleObjectBlob = "frmMain.frx":0442 Top = -30 End Begin VB.Label lblTrackWritten Caption = "Track Written" Height = 285 Left = 75 TabIndex = 9 Top = 3675 Width = 1005 End Begin VB.Label lblTotalWritten Caption = "Total Written" Height = 285 Left = 75 TabIndex = 8 Top = 4305 Width = 1065 End Begin VB.Label lblRecorder Alignment = 1 'Right Justify Caption = "Drive:" Height = 225 Left = -165 TabIndex = 5 Top = 120 Width = 720 End Begin VB.Label lblWriteSpeed Alignment = 1 'Right Justify Caption = "Write Speed" Height = 255 Left = 3780 TabIndex = 3 Top = 120 Width = 975 End Begin VB.Label lblImageFileTitle BorderStyle = 1 'Fixed Single Caption = "Audio Tracks - Drag and Drop .wav Files" Height = 270 Left = 105 TabIndex = 1 Top = 495 Width = 5835 End Begin VB.Menu mnuFile Caption = "&File" Begin VB.Menu mnuFileClear Caption = "Clear All Items" Shortcut = ^C End Begin VB.Menu mnuFileRemove Caption = "Remove Track" End Begin VB.Menu mnuFileSep2 Caption = "-" End Begin VB.Menu mnuFileExit Caption = "Exit" Shortcut = ^X End End Begin VB.Menu mnuCDRecorder Caption = "&CD-Recorder" Begin VB.Menu mnuCDRecorderEject Caption = "Eject" Shortcut = ^J End Begin VB.Menu mnuCDRecorderCloseTray Caption = "Close Tray" Shortcut = ^T End End Begin VB.Menu mnuHelp Caption = "&Help" Begin VB.Menu mnuHelpAbout Caption = "About" End End Attribute VB_Name = "frmMain" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private mlngCurrentDrive As Long Private mintTracksToWrite As Integer Private mblnUnloadOk As Boolean Private mintCurrentTrackCaching As Integer '**************************************************************** '**************************************************************** 'COPYRIGHT 2003 NUMEDIA SOFT, INC 'This is a sample of how you could use the CDWriterPro control to 'record audio CDs from .wav files. There are improvements which could 'be made rather easily. Feel free to modify it as you see fit. '**************************************************************** '**************************************************************** Private Sub CDWriterPro1_CachingStatus(ByVal nPercentComplete As Integer) sbrStatus.SimpleText = "Caching" & " - %" & Format(nPercentComplete, "0#") End Sub Private Sub CDWriterPro1_ClosingDisc() sbrStatus.SimpleText = "Closing Disc...." End Sub Private Sub CDWriterPro1_ClosingTrack(ByVal lTrackNumber As Long) sbrStatus.SimpleText = "Closing Track....#" & Format(lTrackNumber, "0#") End Sub Private Sub CDWriterPro1_EnumAudioTrack(ByVal sFileName As String, ByVal lTotalSizeBlocks As Long, ByVal lTotalSizeBytes As Long, ByVal lTrackNumber As Long) Dim lstItem As ListItem 'Add to the list view Set lstItem = lvwAudioTracks.ListItems.Add(, , Format(lTrackNumber, "0#")) lstItem.SubItems(1) = sFileName lstItem.SubItems(2) = "WAV" lstItem.SubItems(3) = CDWriterPro1.ConvertBlocksToMSFString(lTotalSizeBlocks) End Sub Private Sub CDWriterPro1_PreparingToWrite() sbrStatus.SimpleText = "Preparing to Write Disc...." prgTotalProgress.Value = 0 prgTrackProgress.Value = 0 'Disable buttons as we start to write Call EnableForm(False) End Sub Private Sub CDWriterPro1_ReadingTrackFile(ByVal sFileName As String, ByVal lFileIndex As Long, ByVal lTrackNumber As Long) mintCurrentTrackCaching = lTrackNumber sbrStatus.Panels(1).Text = "Track: " & Format(lTrackNumber, "0#") & " - Reading..." & CStr(lFileIndex) & " - " & sFileName End Sub Private Sub CDWriterPro1_TrackWriteStatus(ByVal lTrackNumber As Long, ByVal lBlocksWritten As Long, ByVal lBlocksToWrite As Long) Dim intPercentTrackWritten As Integer Dim intPercentTotalTracksWritten As Integer On Error Resume Next 'Calc Percent of Current track done intPercentTrackWritten = ((lBlocksWritten / lBlocksToWrite) * 100) 'Audio Files 'Calc the percentage of the current track into the Total intPercentTotalTracksWritten = (((lTrackNumber - 1 + (intPercentTrackWritten / 100)) / mintTracksToWrite) * 100) 'Set Progress Bars prgTrackProgress.Value = intPercentTrackWritten prgTotalProgress.Value = intPercentTotalTracksWritten sbrStatus.SimpleText = "Writing Track #" & Format(lTrackNumber, "0#") & "... " End Sub Private Sub CDWriterPro1_WriteCancelled() sbrStatus.SimpleText = "Writing Cancelled......" Call EnableForm(True) End Sub Private Sub CDWriterPro1_WriteComplete() sbrStatus.SimpleText = "Writing Complete!" 'Enable the form Call EnableForm(True) 'Completed Message MsgBox "Writing is complete!", vbInformation + vbOKOnly, App.Title 'Eject if not in test mode If CDWriterPro1.TestWrite = False Then 'Eject disc Call CDWriterPro1.EjectLoad(False) End If End Sub Private Sub cmdCancel_Click() 'Cancel recording sbrStatus.SimpleText = "Aborting Write...Please Wait!" Call CDWriterPro1.CancelWrite End Sub Private Sub cmdWriteDisc_Click() 'Check for a valid Drive If mlngCurrentDrive = -1 Then MsgBox "A drive is not selected or does not exist.", vbInformation + vbOKOnly, App.Title Exit Sub End If 'Check to make sure we have a disc If CDWriterPro1.GetMediaType() = mtNotLoaded Then MsgBox "Please load an empty disc for recording.", vbInformation + vbOKOnly, App.Title Exit Sub End If 'Check to make sure we have a CD or CDRW only loaded...no DVD media types If Not ((CDWriterPro1.GetMediaType() = mtCD) Or (CDWriterPro1.GetMediaType() = mtCDRW)) Then MsgBox "Please load an empty CD or CDR/W Only...DVDs do not allow audio recording.", vbInformation + vbOKOnly, App.Title Exit Sub End If 'Check to make sure we have an empty disc If CDWriterPro1.GetDiscStatus() <> dsEmpty Then MsgBox "Please insert an empty disc for recording.", vbInformation + vbOKOnly, App.Title Exit Sub End If 'Set the caching property 'This set to true will cache audio files prior to writing each track 'It is highly recommended to use this setting for slower CPU's or machines 'with low amount of memory (under 128 MB)...otherwise a buffer underrun may occur. 'Also use this setting to write from files in a network location... CDWriterPro1.CacheImage = (chkCacheFiles.Value = vbChecked) 'Audio Disc type CDWriterPro1.WriteType = wtpCDDA 'Test write mode CDWriterPro1.TestWrite = (chkTestWrite.Value = vbChecked) CDWriterPro1.CloseDisc = True 'Audio discs should be closed CDWriterPro1.CloseSession = True 'Audio discs should have closed sessions 'Start the disc writing process..this should alway return True 'If there is an error, the Error event will fire... 'If this returns false, there is a system problem 'Use Burn Proof if possible to prevent buffer under-runs... 'the drive must support this feature Call CDWriterPro1.SetBufferProtection(chkUseBurnProof.Value = vbChecked) If CDWriterPro1.WriteDisc() = False Then MsgBox "Disc Write could not be started.", vbCritical, App.Title End If End Sub Private Sub CDWriterPro1_WriteError(ByVal WriteError As CDRPROXLibCtl.eWriteErrorType, ByVal DriveError As CDRPROXLibCtl.eCDError, ByVal sErrorInfo As String, ByVal sSenseInfo As String) Dim strError As String 'Get the error type and strError = "Writing Error: (" & CStr(WriteError) & ") " & sErrorInfo & vbCrLf 'If it is a drive error, add the drive error information 'to the displayed message If WriteError = errDriveError Then strError = strError & GetDriveErrorMessage(DriveError) & vbCrLf & " Error Sense Data: " & sSenseInfo End If 'Display Msg to user MsgBox strError, vbCritical + vbOKOnly Call EnableForm(True) End Sub Private Sub Form_Load() 'Display Version Me.Caption = "Sample2 CDWriterPro - Version " & CDWriterPro1.GetVersion() 'VERY IMPORTANT - Initialize the drives 'The control will not function properly without calling this function first 'Optiontally you can use ASPI for NT, but not recommended If CDWriterPro1.InitDrives(False) = False Then MsgBox "Drives Cannot be initialized...Contact support!" End If '*************** ENABLE LOGGING CODE ' 'Enable logging? ' If CDWriterPro1.SetLogging("C:\DVDTestlog.txt", True) = False Then ' MsgBox "Error enabling logging!" ' End If '*************** END LOGGING CODE 'Load the Drives LoadDriveCombo 'Make sure the form is enabled Call EnableForm(True) End Sub Private Sub Form_Unload(Cancel As Integer) 'Don't Unload if we are writing Cancel = Not mblnUnloadOk End Sub Private Sub lvwAudioTracks_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single) Dim strTempPath As String Dim varItem As Variant Dim intSelTrack As Integer 'Dont worry about error handling to much for this demo On Error Resume Next 'Lets insert a track if we have one selcted If Not (lvwAudioTracks.SelectedItem Is Nothing) Then intSelTrack = lvwAudioTracks.SelectedItem.Index Else intSelTrack = 1 End If If Data.GetFormat(vbCFFiles) = False Then Exit Sub 'Set Hourglass Me.MousePointer = vbHourglass 'Add the dropped data For Each varItem In Data.Files 'Set Temp Item strTempPath = CStr(varItem) 'More substantial validation can be done here..but 'were checking for .wav files only If (UCase(Right(strTempPath, 3)) <> "WAV") Then MsgBox "Only .wav files are allowed for an audio disc.", vbInformation, App.Title Else 'If is a Directory don't add ...only files If IsPathDirectory(strTempPath) = False Then 'Insert a track (1 based index) 'An insert index of zero will add track to end of track list If CDWriterPro1.InsertAudioTrack(strTempPath, intSelTrack) = False Then MsgBox "Invalid Audio Format...High quality .wav files only!", vbOKOnly + vbInformation End If 'Increment The selected track intSelTrack = intSelTrack + 1 End If End If Next 'Reload the track list by enumerating the list LoadTrackList 'Set back Mouse pointer Me.MousePointer = vbDefault End Sub Private Sub mnuCDRecorderCloseTray_Click() Call CDWriterPro1.EjectLoad(True) End Sub Private Sub mnuCDRecorderEject_Click() Call CDWriterPro1.EjectLoad(False) End Sub Private Sub mnuFileClear_Click() 'Clear the track Queue Call CDWriterPro1.ClearAudioTracks 'Clear Track List Call lvwAudioTracks.ListItems.Clear End Sub Private Sub mnuFileExit_Click() Unload Me End Sub Private Sub mnuFileRemove_Click() 'exit if n item is selected If lvwAudioTracks.SelectedItem Is Nothing Then Exit Sub 'Remove the track Call CDWriterPro1.RemoveAudioTrack(lvwAudioTracks.SelectedItem.Index) 'Load the list again Call LoadTrackList End Sub Private Sub mnuHelpAbout_Click() ' CDWriterXP1.AboutBox End Sub Private Sub LoadDriveCombo() Dim lngDrive As Integer 'Clear Drive Combo cboDevices.Clear 'Default to invalid drive mlngCurrentDrive = -1 'Get the ONLY recordable CD drives (NO DVD ONLY DRIVES) For lngDrive = 0 To CDWriterPro1.GetDriveCount() - 1 'Is recorder - all drives are reported not just writers 'so we need to save the index so we know which drive to open 'For this audio application, we must make sure that the drives loaded 'are specifically capable of CD or CDR/W recording..we want to ignore 'DVD only drives If (CDWriterPro1.IsDriveWriter(lngDrive) = True) Then cboDevices.AddItem CDWriterPro1.GetDriveLetter(lngDrive) & ": " & CDWriterPro1.GetDriveVendor(lngDrive) & " " & CDWriterPro1.GetDriveModel(lngDrive) cboDevices.ItemData(cboDevices.NewIndex) = lngDrive End If Next 'Set to first CDR If cboDevices.ListCount > 0 Then cboDevices.ListIndex = 0 Else MsgBox "There are no compatible CDR drives reported." & vbCrLf & _ "Some older CDR drives are not currently supported.", vbInformation + vbOKOnly, App.Title End If End Sub Private Sub cboDevices_Click() Dim lngDriveIndex As Long 'IMPOTANT: You muist load the index of only the drive indexes saved 'in the drive combo box 'Set Drive Index from the Item data which contains the index lngDriveIndex = cboDevices.ItemData(cboDevices.ListIndex) 'Open the Drive for use If CDWriterPro1.OpenDrive(lngDriveIndex) = False Then mlngCurrentDrive = -1 Else mlngCurrentDrive = lngDriveIndex End If 'Load speeds for this drive LoadWriteSpeedCombo 'Set Burn Proof enabled for checking 'The use of Burn Proof can lower writing performance speeds, 'but it will give you a reliable write every time. If CDWriterPro1.GetDriveCapabilityFlag(SupportsBurnProof) = True Then chkUseBurnProof.Enabled = True chkUseBurnProof.Value = vbChecked Else chkUseBurnProof.Enabled = False chkUseBurnProof.Value = vbUnchecked End If End Sub Private Sub cboWriteSpeed_Click() 'Check for speeds being available If cboWriteSpeed.Text <> "Default" Then 'Set Drive Speed CDWriterPro1.SetWriteSpeed cboWriteSpeed.ItemData(cboWriteSpeed.ListIndex) End If End Sub Private Sub LoadWriteSpeedCombo() Dim lngMaxWriteSpeedKBS As Long Dim lngSpeedKBS As Long Dim dblDisplaySpeed As Double Dim bUseDVDspeeds As Boolean Dim DiscType As eMediaType 'Get Max Write Speed in KB/S not as a multiplier. 'DVD and CD have different writing rates to calculate multipliers 'We must use the helper function to determine a multiplier easy for 'the user to understand 'What kind of speed multiplier do we need to show the user DiscType = CDWriterPro1.GetMediaType() If (DiscType = mtCD) Or (DiscType = mtCDRW) Or (DiscType = mtNotLoaded) Then 'This will be used to calc a multiplier based on KB/s bUseDVDspeeds = False Else bUseDVDspeeds = True End If 'Clear Combo cboWriteSpeed.Clear 'Get the MAX Write speed for the loaded media in kb/s lngMaxWriteSpeedKBS = CDWriterPro1.GetMaxWriteSpeed() 'If speed is not zero then If lngMaxWriteSpeedKBS > 0 Then 'Set our temp speed kbs to the max lngSpeedKBS = lngMaxWriteSpeedKBS 'DVD speeds or CD speeds for display If bUseDVDspeeds = True Then Do '1380 is the KB/S constant for DVD for 1X dblDisplaySpeed = CDbl(lngSpeedKBS) / 1380 'Calc a displayed Multiplier such as 2.4X for DVD cboWriteSpeed.AddItem Format(dblDisplaySpeed, "#.0") & "x" 'Save the Kb/s in the combo cboWriteSpeed.ItemData(cboWriteSpeed.NewIndex) = lngSpeedKBS 'For DVD we will increment in .5X levels (eg - 2.4X) lngSpeedKBS = lngSpeedKBS - 690 Loop While (lngSpeedKBS >= 1380) Else Do '176kbs is the KB/S constant for CD for 1X dblDisplaySpeed = CDbl(lngSpeedKBS) / 176 'Clean up displayed multiplier...some drives report speeds 'not in exact multiplies If (dblDisplaySpeed > 0) And (dblDisplaySpeed < 2) Then dblDisplaySpeed = 1 End If 'Calc a displayed Multiplier such as 16X for CD cboWriteSpeed.AddItem Format(dblDisplaySpeed, "#") & "x" 'Save the Kb/s in the combo cboWriteSpeed.ItemData(cboWriteSpeed.NewIndex) = lngSpeedKBS 'For CD we will decrement in 2X levels (eg - 8X) 'When we hit below 4x, then we decrement in 2X levels If lngSpeedKBS >= 1200 Then lngSpeedKBS = lngSpeedKBS - 704 Else lngSpeedKBS = lngSpeedKBS - 352 End If Loop While (lngSpeedKBS > 0) End If Else 'Some drives don't report speed cboWriteSpeed.AddItem "Default" End If 'Set to Max If cboWriteSpeed.ListCount > 0 Then cboWriteSpeed.ListIndex = 0 End If End Sub Private Function IsPathDirectory(strPath As String) As Boolean If (GetAttr(strPath) And vbDirectory) = vbDirectory Then IsPathDirectory = True Else IsPathDirectory = False End If End Function Private Sub LoadTrackList() Dim lngDiscFreeSpace As Long Dim lngTotalDiscLengthBlocks As Long 'Get the track count and free space on the disc mintTracksToWrite = CDWriterPro1.GetAudioTrackCount() 'Get the Free Space of the disk if a drive is selected If mlngCurrentDrive <> -1 Then lngDiscFreeSpace = CDWriterPro1.GetDiscFreeSpaceBlocks() End If 'Clear the List lvwAudioTracks.ListItems.Clear 'Enumerate Tracks - makes it easy to update your list Call CDWriterPro1.EnumerateAudioTracks 'Get the total Audio Volume Size lngTotalDiscLengthBlocks = CDWriterPro1.GetAudioVolumeSizeBlocks() 'Set the Total disc space used sbrStatus.SimpleText = CDWriterPro1.ConvertBlocksToMSFString(lngTotalDiscLengthBlocks) & " of " & CDWriterPro1.ConvertBlocksToMSFString(lngDiscFreeSpace) & " Used" 'Set number of tracks to write mintTracksToWrite = CDWriterPro1.GetAudioTrackCount() End Sub Private Sub EnableForm(blnEnable As Boolean) 'Disable buttons and track view when recording mnuFile.Enabled = blnEnable mnuCDRecorder.Enabled = blnEnable mnuHelp.Enabled = blnEnable cboDevices.Enabled = blnEnable cboWriteSpeed.Enabled = blnEnable lvwAudioTracks.Enabled = blnEnable cmdWriteDisc.Enabled = blnEnable chkCacheFiles.Enabled = blnEnable chkTestWrite.Enabled = blnEnable 'Enable the burn Proof checkbox If (CDWriterPro1.GetDriveCapabilityFlag(SupportsBurnProof) = True) And (blnEnable = True) Then chkUseBurnProof.Enabled = True Else chkUseBurnProof.Enabled = False End If 'Only enable when recording cmdCancel.Enabled = Not blnEnable mblnUnloadOk = blnEnable 'Set Pointer If blnEnable = True Then Me.MousePointer = vbDefault Else Me.MousePointer = vbHourglass End If End Sub 
(.txt)