CDRip DLL Source (87K)
CDRip DLL (84K)
VB5 CD Ripper (103K)
VB6 CD Ripper (99K)
6 May 2004
First Posted
CD Track Listing Using freedb.org
vbAccelerator - Contents of code file: frmVBCDRip.frm
This file is part of the download VB5 CD Ripper, which is described in the article CD Ripping in VB Part 1.
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmVBCDRip
Caption = "VB CD Ripper"
ClientHeight = 5865
ClientLeft = 2820
ClientTop = 1785
ClientWidth = 6705
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmVBCDRip.frx":0000
LinkTopic = "Form1"
ScaleHeight = 5865
ScaleWidth = 6705
Begin VB.PictureBox pnlMain
Align = 1 'Align Top
BorderStyle = 0 'None
Height = 4935
Left = 0
ScaleHeight = 4935
ScaleWidth = 6705
TabIndex = 4
Top = 0
Width = 6705
Begin VB.ComboBox cboDrives
Height = 315
Left = 1140
Style = 2 'Dropdown List
TabIndex = 8
Top = 60
Width = 4095
End
Begin VB.TextBox txtCDDBQuery
Height = 315
Left = 1200
TabIndex = 6
Top = 4560
Width = 5295
End
Begin VB.CommandButton cmdRefresh
Caption = "&Refresh"
Height = 315
Left = 5280
TabIndex = 5
Top = 60
Width = 1155
End
Begin ComctlLib.ListView lvwTracks
Height = 4035
Left = 60
TabIndex = 7
Top = 480
Width = 6435
_ExtentX = 11351
_ExtentY = 7117
View = 3
LabelEdit = 1
MultiSelect = -1 'True
LabelWrap = -1 'True
HideSelection = 0 'False
_Version = 327682
ForeColor = -2147483640
BackColor = -2147483643
Appearance = 1
NumItems = 0
End
Begin VB.Label lblDrives
Caption = "Drives:"
Height = 255
Left = 60
TabIndex = 10
Top = 120
Width = 1035
End
Begin VB.Label lblCDDBQuery
Caption = "CDDB &Query:"
Height = 255
Left = 120
TabIndex = 9
Top = 4620
Width = 1095
End
End
Begin VB.PictureBox pnlCommands
Align = 2 'Align Bottom
BorderStyle = 0 'None
Height = 495
Left = 0
ScaleHeight = 495
ScaleWidth = 6705
TabIndex = 0
Top = 5370
Width = 6705
Begin VB.CommandButton cmdRip
Caption = "&Rip..."
Enabled = 0 'False
Height = 435
Left = 3420
TabIndex = 3
Top = 0
Width = 1275
End
Begin VB.CommandButton cmdConfigure
Caption = "&Configure..."
Height = 435
Left = 2040
TabIndex = 2
Top = 0
Width = 1275
End
Begin VB.CommandButton cmdAbout
Caption = "&About..."
Height = 435
Left = 5220
TabIndex = 1
Top = 0
Width = 1275
End
End
End
Attribute VB_Name = "frmVBCDRip"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function SendMessageByLong Lib "user32" Alias "SendMessageA"
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As
Long) As Long
Private Const LVM_FIRST = &H1000 '// ListView messages
Private Const LVM_GETEXTENDEDLISTVIEWSTYLE = (LVM_FIRST + 55)
Private Const LVM_SETEXTENDEDLISTVIEWSTYLE = (LVM_FIRST + 54) '// optional
wParam == mask
Private Const LVS_EX_FULLROWSELECT = &H20 '// applies to report mode
only
Private m_cRip As cCDRip
Private m_cToc As cToc
Private Sub ConfigureListView()
With lvwTracks
.View = lvwReport
.ColumnHeaders.Add , "Name", "Name"
.ColumnHeaders.Add , "Track", "Track", 48 * Screen.TwipsPerPixelX,
lvwColumnRight
.ColumnHeaders.Add , "StartTime", "Start Time", 64 *
Screen.TwipsPerPixelX, lvwColumnRight
.ColumnHeaders.Add , "Length", "Length", 64 * Screen.TwipsPerPixelX,
lvwColumnRight
.ColumnHeaders.Add , "Size", "Size (Mb)", 64 * Screen.TwipsPerPixelX,
lvwColumnRight
Dim lStyle As Long
lStyle = SendMessageByLong(.hWnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0)
lStyle = lStyle Or LVS_EX_FULLROWSELECT
SendMessageByLong .hWnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0, lStyle
End With
End Sub
Private Sub ShowDrives()
Dim i As Long
Set m_cRip = New cCDRip
m_cRip.Create App.Path & "\cdrip.ini" ' this INI file isn't used currently
For i = 1 To m_cRip.CDDriveCount
cboDrives.AddItem m_cRip.CDDrive(i).Name
Next i
If (cboDrives.ListCount > 0) Then
cboDrives.ListIndex = 0
Else
ShowTracks
End If
End Sub
Private Sub ShowTracks()
Dim lIndex As Long
lvwTracks.ListItems.Clear
lvwTracks.Enabled = False
txtCDDBQuery.Text = ""
cmdRip.Enabled = False
Set m_cToc = Nothing
lIndex = cboDrives.ListIndex + 1
If (lIndex > 0) Then
Dim cD As cDrive
Set cD = m_cRip.CDDrive(lIndex)
If (cD.IsUnitReady) Then
Set m_cToc = cD.TOC
txtCDDBQuery.Text = m_cToc.CDDBQuery
Dim itm As ListItem
Dim i As Long
For i = 1 To m_cToc.Count
With m_cToc.Entry(i)
Set itm = lvwTracks.ListItems.Add(, "T" & i, "Track " &
Format(.TrackNumber, "00"))
itm.SubItems(1) = .TrackNumber
itm.SubItems(2) = .FormattedStartTime
itm.SubItems(3) = .FormattedLength
itm.SubItems(4) = Format(.SizeBytes / (1024& * 1024&), "##0.00")
& "MB"
itm.Selected = True
End With
Next i
lvwTracks.Enabled = (m_cToc.Count > 0)
cmdRip.Enabled = (m_cToc.Count > 0)
Else
lvwTracks.ListItems.Add , , "No CD In Drive"
End If
Else
lvwTracks.ListItems.Add , , "No CD Selected"
End If
End Sub
Private Sub cboDrives_Click()
ShowTracks
End Sub
Private Sub cmdAbout_Click()
Dim fA As New frmAbout
Dim sAck As String
sAck = "This sample uses components from CDEx, Copyright 1999 Albert L.
Faber and Monty (xiphmont@mit.edu). "
sAck = sAck & "CDEx is released under the GNU General Public License and the
source code is available from "
sAck = sAck & "http://cdexos.sourceforge.net."
fA.Acknowledgements = sAck
fA.Show vbModal, Me
End Sub
Private Sub cmdConfigure_Click()
Dim fO As New frmOptions
fO.CRRip = m_cRip
fO.Show vbModal, Me
If (cboDrives.ListCount > 0) Then
' Reset active CD ROM
cboDrives_Click
End If
End Sub
Private Sub cmdRefresh_Click()
ShowTracks
End Sub
Private Sub cmdRip_Click()
Dim lIndex As Long
lIndex = cboDrives.ListIndex + 1
If (lIndex > 0) Then
Dim cD As cDrive
Set cD = m_cRip.CDDrive(lIndex)
If (cD.IsUnitReady) Then
Dim fRip As New frmRipDialog
fRip.OutputDir = App.Path
fRip.RipTOC = m_cToc
Dim itm As ListItem
For Each itm In lvwTracks.ListItems
If (itm.Selected) Then
fRip.RipTrack(CLng(Mid(itm.Key, 2))) = True
End If
Next
fRip.Icon = Me.Icon
pnlMain.Enabled = False
pnlCommands.Enabled = False
fRip.Show , Me
Me.Refresh
DoEvents
On Error Resume Next
fRip.RipSelected
Dim lErr As Long, sErr As String
lErr = Err.Number
sErr = Err.Description
If Not (Err.Number = 0) Then
Unload fRip
On Error GoTo 0
MsgBox "An error occurred during ripping: " & sErr, vbExclamation
End If
pnlMain.Enabled = True
pnlCommands.Enabled = True
End If
End If
End Sub
Private Sub Form_Load()
ConfigureListView
Me.Show
Me.Refresh
ShowDrives
End Sub
Private Sub Form_Resize()
On Error Resume Next
pnlMain.Height = Me.ScaleHeight - pnlCommands.Height
End Sub
Private Sub lvwTracks_Click()
Dim itm As ListItem
Dim bSelection As Boolean
For Each itm In lvwTracks.ListItems
If (itm.Selected) Then
bSelection = True
End If
Next
cmdRip.Enabled = bSelection
End Sub
Private Sub pnlCommands_Resize()
'
cmdAbout.left = pnlCommands.ScaleWidth - cmdAbout.Width - 4 *
Screen.TwipsPerPixelX
cmdRip.left = cmdAbout.left - cmdRip.Width - 24 * Screen.TwipsPerPixelX
cmdConfigure.left = cmdRip.left - cmdConfigure.Width - 4 *
Screen.TwipsPerPixelX
'
End Sub
Private Sub pnlMain_Resize()
'
On Error Resume Next
Dim lHeight As Long
lHeight = pnlMain.ScaleHeight - lvwTracks.top * 2
lvwTracks.Move lvwTracks.left, lvwTracks.top, pnlMain.ScaleWidth -
lvwTracks.left * 2, lHeight
cboDrives.Width = pnlMain.ScaleWidth - cboDrives.left - cmdRefresh.Width - 2
* Screen.TwipsPerPixelX - lvwTracks.left
cmdRefresh.left = cboDrives.left + cboDrives.Width + 2 *
Screen.TwipsPerPixelX
lblCDDBQuery.top = lvwTracks.top + lvwTracks.Height + 2 *
Screen.TwipsPerPixelY
txtCDDBQuery.Move txtCDDBQuery.left, lblCDDBQuery.top, pnlMain.ScaleWidth -
txtCDDBQuery.left - lvwTracks.left
'
End Sub
 |