www.pudn.com > AudioCDWriter.rar > Form1.frm
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form frmMain
BorderStyle = 1 'Fixed Single
Caption = "音频CD刻录"
ClientHeight = 6060
ClientLeft = 45
ClientTop = 330
ClientWidth = 7950
Icon = "Form1.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 404
ScaleMode = 3 'Pixel
ScaleWidth = 530
StartUpPosition = 2 '屏幕中心
Begin MSComDlg.CommonDialog dlgOpen
Left = 4500
Top = 3870
_ExtentX = 847
_ExtentY = 847
_Version = 393216
Filter = "WAV, MP3 (*.wav; *.mp3)|*.wav;*.mp3|WAVs (*.wav)|*.wav|MP3s (*.mp3)|*.mp3"
End
Begin VB.CommandButton cmdRem
Caption = "-"
Height = 285
Left = 540
TabIndex = 27
Top = 5460
Width = 375
End
Begin VB.CommandButton cmdAdd
Caption = "+"
Height = 285
Left = 75
TabIndex = 26
Top = 5460
Width = 375
End
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 285
Left = 0
TabIndex = 25
Top = 5775
Width = 7950
_ExtentX = 14023
_ExtentY = 503
Style = 1
SimpleText = "完毕"
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
EndProperty
End
Begin VB.Frame frmDrvInfo
Caption = "设备信息"
Height = 1290
Left = 2610
TabIndex = 22
Top = 1980
Width = 2445
Begin VB.ListBox lstLWNfo
Height = 1020
IntegralHeight = 0 'False
Left = 90
TabIndex = 23
Top = 180
Width = 2265
End
End
Begin VB.Frame frmCDInfo
Caption = "CD 信息"
Height = 1290
Left = 90
TabIndex = 20
Top = 1965
Width = 2445
Begin VB.ListBox lstCDNfo
Height = 1035
IntegralHeight = 0 'False
Left = 90
TabIndex = 21
Top = 180
Width = 2265
End
End
Begin VB.Frame frmWritespeed
Caption = "刻录速度"
Height = 1380
Left = 2610
TabIndex = 17
Top = 540
Width = 2445
Begin VB.PictureBox picXPWritespeed
BorderStyle = 0 'None
Height = 375
Left = 90
ScaleHeight = 375
ScaleWidth = 2265
TabIndex = 18
Top = 270
Width = 2265
Begin VB.ComboBox cboWritespeed
Height = 315
ItemData = "Form1.frx":038A
Left = 0
List = "Form1.frx":038C
Style = 2 'Dropdown List
TabIndex = 19
Top = 0
Width = 2175
End
End
End
Begin VB.Frame frmWritefeatures
Caption = "刻录支持"
Height = 1410
Left = 90
TabIndex = 15
Top = 540
Width = 2445
Begin VB.ListBox lstWriteFeatures
Height = 1125
IntegralHeight = 0 'False
Left = 90
TabIndex = 16
Top = 180
Width = 2265
End
End
Begin VB.CommandButton cmdCancel
Caption = "取消"
Enabled = 0 'False
Height = 240
Left = 5130
TabIndex = 14
Top = 3810
Width = 2625
End
Begin VB.CommandButton cmdStart
Caption = "开始刻录"
Height = 270
Left = 5130
TabIndex = 13
Top = 3450
Width = 2625
End
Begin MSComctlLib.ProgressBar prg
Height = 285
Left = 5130
TabIndex = 12
Top = 4440
Width = 2625
_ExtentX = 4630
_ExtentY = 503
_Version = 393216
Appearance = 1
Scrolling = 1
End
Begin VB.Frame frmWriteOptions
Caption = "刻录选项"
Height = 1725
Left = 5190
TabIndex = 5
Top = 1395
Width = 2625
Begin VB.CheckBox chkTestMode
Caption = "测试模式"
Height = 195
Left = 90
TabIndex = 29
Top = 1170
Width = 2265
End
Begin VB.PictureBox picXPWriteOptions
BorderStyle = 0 'None
Height = 915
Left = 90
ScaleHeight = 915
ScaleWidth = 2445
TabIndex = 6
Top = 180
Width = 2445
Begin VB.CheckBox chkDiscEject
Caption = "刻录完后自动弹出光驱"
Height = 195
Left = 0
TabIndex = 11
Top = 720
Value = 1 'Checked
Width = 2130
End
Begin VB.CheckBox chkCloseDisc
Caption = "允许多次刻录"
Height = 195
Left = 0
TabIndex = 10
Top = 450
Width = 2355
End
Begin VB.TextBox txtPregap
Height = 285
Left = 720
TabIndex = 8
Text = "2"
Top = 75
Width = 465
End
Begin VB.Label lblSeconds
AutoSize = -1 'True
Caption = "秒"
Height = 180
Left = 1260
TabIndex = 9
Top = 90
Width = 180
End
Begin VB.Label lblPregap
Caption = "间隙:"
Height = 195
Left = 0
TabIndex = 7
Top = 90
Width = 645
End
End
End
Begin MSComctlLib.ListView lvwTrks
Height = 2085
Left = 105
TabIndex = 4
Top = 3330
Width = 4965
_ExtentX = 8758
_ExtentY = 3678
View = 3
LabelEdit = 1
MultiSelect = -1 'True
LabelWrap = -1 'True
HideSelection = -1 'True
OLEDropMode = 1
FullRowSelect = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
OLEDropMode = 1
NumItems = 2
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "文件"
Object.Width = 4499
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "轨道长度"
Object.Width = 2381
EndProperty
End
Begin VB.CommandButton cmdLoad
Caption = "关闭光驱"
Height = 405
Left = 6735
TabIndex = 3
ToolTipText = "关上光驱"
Top = 675
Width = 960
End
Begin VB.CommandButton cmdEject
Caption = "弹开光驱"
Height = 420
Left = 5400
TabIndex = 2
ToolTipText = "弹开光驱"
Top = 690
Width = 1050
End
Begin VB.ComboBox cboDrives
BeginProperty Font
Name = "Courier New"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 990
Style = 2 'Dropdown List
TabIndex = 1
Top = 135
Width = 6900
End
Begin MSComctlLib.ProgressBar prg2
Height = 285
Left = 5130
TabIndex = 31
Top = 5070
Width = 2625
_ExtentX = 4630
_ExtentY = 503
_Version = 393216
Appearance = 1
Scrolling = 1
End
Begin VB.Label lblConvTrack
Alignment = 1 'Right Justify
AutoSize = -1 'True
Height = 195
Left = 7650
TabIndex = 34
Top = 3780
Width = 45
End
Begin VB.Label lblWriteTrack
Alignment = 1 'Right Justify
AutoSize = -1 'True
Height = 195
Left = 7650
TabIndex = 33
Top = 3150
Width = 45
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "转换进程:"
Height = 180
Left = 5130
TabIndex = 32
Top = 4800
Width = 810
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "刻录进程:"
Height = 180
Left = 5130
TabIndex = 30
Top = 4170
Width = 810
End
Begin VB.Line Line4
BorderColor = &H00FFFFFF&
X1 = 342
X2 = 516
Y1 = 295
Y2 = 295
End
Begin VB.Line Line3
BorderColor = &H00808080&
X1 = 342
X2 = 516
Y1 = 359
Y2 = 359
End
Begin VB.Line Line2
BorderColor = &H00FFFFFF&
X1 = 342
X2 = 516
Y1 = 222
Y2 = 222
End
Begin VB.Line Line1
BorderColor = &H00808080&
X1 = 342
X2 = 516
Y1 = 221
Y2 = 221
End
Begin VB.Label Label1
Caption = "axCDDAWriter by [rm_code] 2005"
Height = 195
Left = 5220
TabIndex = 28
Top = 5505
Width = 2535
End
Begin VB.Label lblDiscSize
AutoSize = -1 'True
Height = 180
Left = 1155
TabIndex = 24
Top = 5520
Width = 255
End
Begin VB.Label lblDrives
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "设备:"
Height = 180
Left = 255
TabIndex = 0
Top = 180
Width = 405
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：05/06/17
'描 述：音频CD刻录
'网 站：http://www.mndsoft.com/
'e-mail：mnd@mndsoft.com
'OICQ : 88382850
'****************************************************************************
Option Explicit
' CDDAWriter 类
Private WithEvents cdwrt As CDDAWriter
Attribute cdwrt.VB_VarHelpID = -1
' 取消标志
Private blnCancel As Boolean
'秒到分转换
Private Function FormatTime(ByVal lngSeconds As Long) As String
Dim lngMinutes As Long
lngMinutes = Fix(lngSeconds / 60)
lngSeconds = lngSeconds - lngMinutes * 60
FormatTime = Format$(CStr(lngMinutes), "00") & ":" & _
Format$(CStr(lngSeconds), "00")
End Function
Private Sub CalcDiscSpace()
On Error Resume Next
Dim lngTrackLen As Long
Dim lngSize As Long
Dim i As Integer
'计算全部文件合计大小
For i = 1 To lvwTrks.ListItems.Count
'AudioLengt()函数 返回音频文件的长度
lngTrackLen = cdwrt.AudioLength(lvwTrks.ListItems(i).Text)
'显示时间
lvwTrks.ListItems(i).SubItems(1) = FormatTime(lngTrackLen) & " min"
'1秒的CDDA音频等于176400字节
lngSize = lngSize + lngTrackLen * 176400
Next
'显示
lblDiscSize = "已用" & (lngSize \ 1024 ^ 2) & " 光盘容量: " & _
(cdwrt.CDCapacity \ 1024 ^ 2) & " MB"
End Sub
Private Sub cboDrives_Click()
'选择新的设备
cdwrt.SelectCDROM Left$(cboDrives.List(cboDrives.ListIndex), 1)
'显示 CD 信息
With lstCDNfo
.Clear
If Not cdwrt.DiscPresent Then
.AddItem "无磁盘"
Else
.AddItem "容量: " & (cdwrt.CDCapacity \ 1024 ^ 2) & " MB"
Select Case cdwrt.CDStatus
Case DS_COMPLETE: .AddItem "CD 状态: 完毕"
Case DS_EMPTY: .AddItem "CD 状态: 空"
Case DS_INCOMPLETE: .AddItem "CD 状态: unvollstdig"
Case DS_UNKNWN: .AddItem "CD 状态: unbekannt"
End Select
Select Case cdwrt.CDType
Case CD_CDR: .AddItem "CD 类型: CD-R"
Case CD_CDROM: .AddItem "CD 类型: CD-ROM"
Case CD_CDRW: .AddItem "CD 类型: CD-RW"
Case CD_DVD: .AddItem "CD 类型: DVD"
End Select
End If
End With
'刻录机信息
With lstLWNfo
.Clear
.AddItem "完毕: " & cdwrt.DriveReady
.AddItem "缓存大小: " & cdwrt.DriveBufferSize & " KB"
.AddItem "最大刻录速度: " & (cdwrt.DriveMaxWriteSpeed \ 176) & "x"
End With
'支持的盘片格式
With lstWriteFeatures
.Clear
.AddItem "CD-R: " & _
CBool(cdwrt.DriveWriteFeatures And WRT_CDR)
.AddItem "CD-RW: " & _
CBool(cdwrt.DriveWriteFeatures And WRT_CDRW)
.AddItem "Test Mode: " & _
CBool(cdwrt.DriveWriteFeatures And WRT_TESTMODE)
chkTestMode.Enabled = CBool(cdwrt.DriveWriteFeatures And WRT_TESTMODE)
End With
CalcDiscSpace
End Sub
Private Sub cboWritespeed_Click()
'新的刻录速度
cdwrt.WriteSpeed = cboWritespeed.ItemData(cboWritespeed.ListIndex)
End Sub
'转换进度
Private Sub cdwrt_ConvProgress(ByVal percent As Integer, ByVal track As Integer)
lblConvTrack = Format$(track, "00")
prg2.Value = percent
End Sub
'刻录进度
Private Sub cdwrt_WriteProgress(ByVal percent As Integer, ByVal track As Integer)
lblWriteTrack = Format$(track, "00")
prg.Value = percent
End Sub
Private Sub cmdAdd_Click()
Dim files() As String
Dim i As Integer
'不能超出99个轨道
If lvwTrks.ListItems.Count = 99 Then Exit Sub
'显示对话框
With dlgOpen
.FileName = vbNullString
.Flags = cdlOFNAllowMultiselect Or cdlOFNLongNames Or cdlOFNExplorer
.ShowOpen
If .FileName = vbNullString Then Exit Sub
End With
If InStr(dlgOpen.FileName, Chr$(0)) <= 0 Then
'添加
lvwTrks.ListItems.Add Text:=dlgOpen.FileName
'更多文件选择
Else
'Chr(0)
files = Split(dlgOpen.FileName, Chr$(0))
If Not Right$(files(0), 1) = "\" Then files(0) = files(0) & "\"
'添加文件
For i = 1 To UBound(files)
'不能超出99个轨道
If lvwTrks.ListItems.Count = 99 Then Exit Sub
lvwTrks.ListItems.Add Text:=files(0) & files(i)
Next
End If
CalcDiscSpace
End Sub
Private Sub cmdCancel_Click()
'cancel writing
blnCancel = True
End Sub
'弹出磁盘
Private Sub cmdEject_Click()
If Not cdwrt.DiscEject Then _
MsgBox "无法弹出磁盘!", vbExclamation, "错误"
End Sub
'载入磁盘
Private Sub cmdLoad_Click()
If Not cdwrt.DiscLoad Then _
MsgBox "无法载入磁盘!", vbExclamation, "错误"
End Sub
'删除轨道
Private Sub cmdRem_Click()
Dim i As Integer
Start:
For i = 1 To lvwTrks.ListItems.Count
If lvwTrks.ListItems(i).Selected Then
lvwTrks.ListItems.Remove i
GoTo Start
End If
Next
CalcDiscSpace
End Sub
Private Sub cmdStart_Click()
Dim files() As String
Dim i As Integer
'建立文件数组
With lvwTrks.ListItems
If .Count = 0 Then
MsgBox "没有文件!", vbExclamation, "错误"
Exit Sub
End If
ReDim files(.Count - 1) As String
For i = 1 To .Count
files(i - 1) = .Item(i).Text
Next
End With
cmdStart.Enabled = Not cmdStart.Enabled
cmdCancel.Enabled = Not cmdCancel.Enabled
'设置
cdwrt.DiscAllowMultiSession = chkCloseDisc
cdwrt.DiscEjectAfterWrite = chkDiscEject
cdwrt.PreGapLength = val(txtPregap)
cdwrt.TestMode = chkTestMode
'开始刻录
Select Case cdwrt.BurnDisc(files(), blnCancel)
Case ERR_CAPACITY: MsgBox "数据无法写入"
Case ERR_CLOSE_DISC: MsgBox "Couldn't close the session"
Case ERR_CLOSE_TRACK: MsgBox "无法关闭轨道"
Case ERR_DISC_MISSING: MsgBox "不是一个磁盘"
Case ERR_DISC_NOT_EMPTY: MsgBox "不是空白光盘"
Case ERR_DISC_NOT_SUPPORTED: MsgBox "光盘类型不支持"
Case ERR_TOO_MANY_TRACKS: MsgBox "最大只能允许99个轨道"
Case ERR_WRITE_CANCEL: MsgBox "刻录取消"
Case ERR_WRITE_ERROR: MsgBox "刻录错误"
Case ERR_NO_CDWRITER: MsgBox "当前设备不是刻录设备"
Case ERR_WRITESPEED: MsgBox "无法设置新的刻录速度"
Case ERR_NEXT_ADDR: MsgBox "无法读取下一个地址"
Case ERR_TESTMODE: MsgBox "测试模式不支持"
Case ERR_DRIVEID: MsgBox "没有设备编号"
Case ERR_WPP: MsgBox "无法设置新的刻录参数页"
Case ERR_OK: MsgBox "刻录完成"
End Select
cmdStart.Enabled = Not cmdStart.Enabled
cmdCancel.Enabled = Not cmdCancel.Enabled
End Sub
Private Sub Form_Load()
' 计数
Dim i As Integer
' 设备
Dim strDrv As String
' 新CDDAWriter类
Set cdwrt = New CDDAWriter
'获取驱动器
For i = 1 To 26
strDrv = Chr$(i + 64)
With cdwrt
'CD/DVD-ROM
If .IsCDROM(strDrv) Then
'选择当前设备
.SelectCDROM strDrv
'添加设备到列表
cboDrives.AddItem strDrv & ": (HA: " & _
.DriveHA & ", ID: " & _
.DriveTarget & ") " & _
.DriveName
End If
End With
Next
'默认第一个
cboDrives.ListIndex = 0
'刻录速度
AddWriteSpeed 4
AddWriteSpeed 8
AddWriteSpeed 10
AddWriteSpeed 12
AddWriteSpeed 16
AddWriteSpeed 20
'默认速度
cboWritespeed.ListIndex = 0
End Sub
Private Sub AddWriteSpeed(ByVal val As Integer)
cboWritespeed.AddItem val & "x", 0
cboWritespeed.ItemData(0) = val * 176
End Sub