VB编写手机bin格式的音乐试听器
编程爱好者
现在很多手机都可以刷机来替换内置的铃声， 使自己的手机铃声更有个性。很多网站提供的刷机铃声格式都是 bin格式的， 而且有单曲 组曲 之分。 例如三星的手机大部分都是这种格式， 要想听听效果只能刷到手机里听。 这样做很不方便， 也有很大风险。 那么能不能自己做个这种格式的播放器呢？ 当然可以！
首先讲一下原理： 其实手机 bin格式的音乐刷机文件， 就是把mmf格式的音乐文件封装起来的文件格式。 对于单曲来说， 其实把.bin的扩展名改为.mmf就能用普通的mmf播放器听了。
但组曲就不能这样做了， 因为它内部封装了多个mmf 我们必须把它们分解成一首一首的 才能播放。
下面我们就以三星的x199手机的组曲文件来分析一下组曲bin格式的结构。
用16进制编辑器 先打开一个bin格式的组曲文件：
图1中， 第一个框部分就是mmf格式的文件头， 第二部分是代表mmf文件的大小：00 00 17 49 这是用16进制表示， 转换成10进制再加上代表文件头的8个字节就可计算出文件大小。 因为组曲bin是把mmf文件按顺序 一首首的组合在一起的，所以我们知道了文件头和文件大小就可以编写程序来提取mmf文件了。
具体如下：
先下载 yamaha 的mmf文件播放器。 目前是5.6.0版。
网址： http://www.hi-fans.com/showdown.asp?soft_id=48
新建一vb工程 player，新建一窗体 命名为form1。
在窗体中 放置如下控件 yamaha播放控件 midradioconctr1.0(从部件中添加) 命名为mdc1。
一个drivelistbox 命名为drive1
一个 dirlistbox 命名为dir1
一个filelistbox 命名为file1
两个label 分别命名为label1 label2
四个command 分别命名为 command1 command2 command3 command4，如图2。
然后进入代码编辑窗口 填写代码
'初始化控件
Private Sub Form_Load()
On Error Resume Next
'设置文件列表框允许显示的文件类型
File1.pattern="*.mmf;*.bin"
初始化按钮
Command1.caption="增大音量"
Command2.caption="减少音量"
Command3.caption="停止播放"
Command4.caption="退出系统"
把mdc1 控件设置为不可见
mdc1.Visible = False
初始化音量
mdc1.Volume = 50
创建文件夹temp 用来存放 提取出来的mmf文件
MkDir (App.Path + "\temp")
Label2.Caption = vbCrLf + vbCrLf + "当前音量：" + Str(mdc1.Volume) +
vbCrLf
End Sub
'音量增大调节
Private Sub Command1_Click()
If Mdc1.Volume < 100 Then
Mdc1.Volume = Mdc1.Volume + 10
Label2.Caption = vbCrLf + vbCrLf + "当前音量：" + Str(Mdc1.Volume) +
vbCrLf
End If
End Sub
音量减少调节
Private Sub Command2_Click()
If Mdc1.Volume > 0 Then
Mdc1.Volume = Mdc1.Volume - 10
Label2.Caption = vbCrLf + vbCrLf + "当前音量：" + Str(Mdc1.Volume) +
vbCrLf
End If
End Sub
'播放状态转换
Private Sub Command3_Click()
If Command3.Caption = "停止播放" Then
Mdc1.Stop
Command3.Caption = "开始播放"
Else
Mdc1.Play
Command3.Caption = "停止播放"
End If
End Sub
'退出系统
Private Sub Command4_Click()
Mdc1.Stop
On Error Resume Next
Kill App.Path + "\temp\960bin\*.mmf"
RmDir (App.Path + "\temp\960bin")
Kill (App.Path + "\temp\*.mmf")
RmDir (App.Path + "\temp")
End
End Sub
'路径 文件选择
Private Sub Drive1_Change()
Dir1.Path = Drive1
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1
On Error Resume Next
'当目录改变时 停止文件播放 并把 提取出的 mmf 文件删除 减少磁盘空间的占
用
Mdc1.Stop
Kill App.Path + "\temp\960bin\*.mmf"
End Sub
'点击文件列表中的文件 执行分解播放 事件
Private Sub File1_Click()
On Error Resume Next
'判断路径后面是否有"\" 若没有则加上
If Right$(File1.Path, 1) <> "\" Then
fimax = File1.Path + "\"
Else
fimax = File1.Path
End If
'计算选中的文件大小 判断 并用 byte kb mb 表示
wmz = FileLen(File1.Path + "\" + File1.FileName)
If wmz < 1024 Then
filesize = Str(wmz) + "字节"
ElseIf wmz >= 1024 And wmz <= 1048576 Then
filesize = Str(Round((wmz / 1024), 2)) + "KB"
ElseIf wmz > 1048576 Then
filesize = Str(Round((wmz / 1048576), 2)) + "MB"
End If
'判断文件类型 如果是 bin 则执行分解
If LCase(Right$(File1.FileName, 3)) = "bin" Then
'创建一个组曲bin 提取出来的mmf 文件的存放目录 temp\960bin
MkDir (App.Path + "\temp\960bin")
'下面代码 是以二进制方式 打开文件 进行 mmf 文件的 查找 和提取 操作 这
也是本程序的核心代码
Dim FileBuffer() As Byte
Dim FileNumberS As Long
Dim FileNumberT As Long
Dim ddddd() As Byte
Dim yyyyy() As Byte
Dim xc
xc = 0
Dim hj As String
FileNumberS = FreeFile
'以二进制方式打开文件
Open File1.Path + "\" + File1.FileName For Binary Access Read As
#FileNumberS
Dim lFileLen As Long
lFileLen = FileLen(File1.Path + "\" + File1.FileName)
ReDim FileBuffer(1 To lFileLen) As Byte
Get #FileNumberS, , FileBuffer
'查找mmf文件头
For i = 1 To lFileLen
zi = Chr(FileBuffer(i))
ok = 0
hjj = 0
If zi = "M" Then
If i + 1 <= lFileLen Then
zi = Chr(FileBuffer(i + 1))
If zi = "M" Then
If i + 2 <= lFileLen Then
zi = Chr(FileBuffer(i + 2))
If zi = "M" Then
If i + 3 <= lFileLen Then
zi = Chr(FileBuffer(i + 3))
If zi = "D" Then
ok = 1
End If
End If
End If
End If
End If
End If
End If
'查找代码结束
'判断 如果ok=1 则表示找到了mmf文件 提取出来保存到\temp\960bin\ 目录下
If ok = 1 Then
hj = ""
'下面代码是查找 文件头后面的4个字节 读出文件大小
ReDim ddddd(1 To 5)
Get #FileNumberS, i + 4, ddddd
For ii = 1 To 4
hj = hj & Right$("00" & Hex$(ddddd(ii)), 2)
Next ii
'把代表文件大小的16进制数 转换成10进制
hjj = Hex2Dec(hj)
FileNumberT = FreeFile
'如过文件大小不为0 则执行提取 否则忽略
If hjj <> 0 Then
'以二进制方式 保存提取出来的 mmf文件
Open App.Path + "\temp\960bin\" & "HI-FANS" & Format(xc, "000") &
".mmf" For Binary Access Write As #FileNumberT
ReDim yyyyy(1 To hjj + 8)
Get #FileNumberS, i, yyyyy
Put #FileNumberT, , yyyyy
Close #FileNumberT
' 总 mmf文件个数加1
xc = xc + 1
End If
End If
Next i
Close #FileNumberS
'如果是单曲bin 则执行改扩展名操作 并播放
If xc = 1 Then
On Error Resume Next
Kill App.Path + "\temp\960bin\*.mmf"
RmDir (App.Path + "\temp\960bin")
FileCopy File1.Path + "\" + File1.FileName, App.Path + "\temp\" + Left
＄(File1.FileName, Len(File1.FileName) - 3) + "mmf"
Mdc1.Src = App.Path + "\temp\" + Left$(File1.FileName, Len
(File1.FileName) - 3) + "mmf"
Mdc1.Play
Command3.Caption = "停止播放"
Label2.Caption = "当前文件：" + fimax + File1.FileName + vbCrLf +
vbCrLf + "文件大小：" + filesize
Else
'下面代码是播放提取完毕的mmf文件的操作
File1.Path = App.Path + "\temp\960bin\"
File1.Refresh
End If
Else
On Error Resume Next
Mdc1.Src = File1.Path + "\" + File1.FileName
Mdc1.Play
Command3.Caption = "停止播放"
Label2.Caption = "当前文件：" + fimax + File1.FileName + vbCrLf +
vbCrLf + "文件大小：" + filesize
End If
End Sub
'16进制转10进制代码
Public Function Hex2Dec(InputData As String) As Double
Dim I As Integer
Dim DecOut As Double
Dim Lenhex As Integer
Dim HexStep As Double
DecOut = 0
InputData = UCase(InputData)
Lenhex = Len(InputData)
For I = 1 To Lenhex
If IsNumeric(Mid(InputData, I, 1)) Then
GoTo NumOk
ElseIf Mid(InputData, I, 1) = "A" Then
GoTo NumOk
ElseIf Mid(InputData, I, 1) = "B" Then
GoTo NumOk
ElseIf Mid(InputData, I, 1) = "C" Then
GoTo NumOk
ElseIf Mid(InputData, I, 1) = "D" Then
GoTo NumOk
ElseIf Mid(InputData, I, 1) = "E" Then
GoTo NumOk
ElseIf Mid(InputData, I, 1) = "F" Then
GoTo NumOk
Else
Exit Function
End If
NumOk:
Next I
HexStep = 0
For I = Lenhex To 1 Step -1
HexStep = HexStep * 16
If HexStep = 0 Then
HexStep = 1
End If
If Mid(InputData, I, 1) = "0" Then
DecOut = DecOut + (0 * HexStep)
ElseIf Mid(InputData, I, 1) = "1" Then
DecOut = DecOut + (1 * HexStep)
ElseIf Mid(InputData, I, 1) = "2" Then
DecOut = DecOut + (2 * HexStep)
ElseIf Mid(InputData, I, 1) = "3" Then
DecOut = DecOut + (3 * HexStep)
ElseIf Mid(InputData, I, 1) = "4" Then
DecOut = DecOut + (4 * HexStep)
ElseIf Mid(InputData, I, 1) = "5" Then
DecOut = DecOut + (5 * HexStep)
ElseIf Mid(InputData, I, 1) = "6" Then
DecOut = DecOut + (6 * HexStep)
ElseIf Mid(InputData, I, 1) = "7" Then
DecOut = DecOut + (7 * HexStep)
ElseIf Mid(InputData, I, 1) = "8" Then
DecOut = DecOut + (8 * HexStep)
ElseIf Mid(InputData, I, 1) = "9" Then
DecOut = DecOut + (9 * HexStep)
ElseIf Mid(InputData, I, 1) = "A" Then
DecOut = DecOut + (10 * HexStep)
ElseIf Mid(InputData, I, 1) = "B" Then
DecOut = DecOut + (11 * HexStep)
ElseIf Mid(InputData, I, 1) = "C" Then
DecOut = DecOut + (12 * HexStep)
ElseIf Mid(InputData, I, 1) = "D" Then
DecOut = DecOut + (13 * HexStep)
ElseIf Mid(InputData, I, 1) = "E" Then
DecOut = DecOut + (14 * HexStep)
ElseIf Mid(InputData, I, 1) = "F" Then
DecOut = DecOut + (15 * HexStep)
Else
End If
Next I
Hex2Dec = DecOut
eds:
End Function
Private Sub Form_Unload(Cancel As Integer)
Mdc1.Stop
On Error Resume Next
Kill App.Path + "\temp\960bin\*.mmf"
RmDir (App.Path + "\temp\960bin")
Kill (App.Path + "\temp\*.mmf")
RmDir (App.Path + "\temp")
End Sub
好了 快按下F5 看看自己的杰作吧…
此程序在 Windows2000 +vb6.0 环境下调试通过。