mp3封面图片的嵌入与显示的代码

主题：mp3封面图片的嵌入与显示的代码

一江秋水 [专家分：9680] 发布于 2014-09-26 06:32:07

mp3封面图片的嵌入与显示的代码

现在的智能手机播放器大多可以显示mp3中的封面图片，我们自编的播放器也应与时俱进，跟上潮
流，能嵌能显，所以笔者研究了一下这个问题，写出代码，现贴出来与大家共享，对mp3数据结构不熟
悉的请先参阅笔者的旧贴《MP3文件的数据结构以及为mp3内嵌歌词的代码》一文。
先看一下嵌入了封面图片的mp3的部分数据：
--------------------------------------------------------------------------
0000: 49 44 33 03 00 00 00 40 01 7A 41 50 49 43 00 01 ID3....@.zAPIC..
0010: 00 12 00 00 00 69 6D 61 67 65 2F 6A 70 65 67 00 .....image/jpeg.
0020: 03 00 FF D8 FF E0 00 10 4A 46 49 46 00 01 01 00 ...?...JFIF....
---------------------------------------------------------------------------
可以看到，封面图片的数据是保存在 ID3V2的“APIC”标签帧下的，在这首mp3中，从0022字节起，
就是图片的数据，只要把图片的全部数据原封不动地复制到这里就行了。这首mp3的封面图片格式是jpg，
其实可以是任何图片格式，只要你播放器上的图片框能显示就行。

一、显示封面图片的代码。

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal picLen As Long)

Private Sub 显示mp3封面图片()
Dim OpenName As String, SaveName As String
Dim ID3v As String * 3, L1 As Byte, L2 As Byte, L3 As Byte
Dim ID3V2Info() As Byte, tem() As Byte
Dim picLen As Long, ID3Len As Long, Place As Long, p As Long, annex As String

OpenName = "(全路径mp3文件名)"

Open OpenName For Binary As #1
Get #1, , ID3v
If ID3v <> "ID3" Then Close #1: Exit Sub
Get #1, 8, L1
Get #1, , L2
Get #1, , L3
ID3Len = L1
ID3Len = ID3Len * &H4000 + L2 * &H80 + L3
ReDim ID3V2Info(ID3Len - 1)
Get #1, , ID3V2Info
Close #1

tem = StrConv("APIC", vbFromUnicode)
p = InStrB(ID3V2Info, tem): If p = 0 Then Exit Sub '如果没有图片退出
picLen = CLng(ID3V2Info(p + 4)) * 65536 + CLng(ID3V2Info(p + 5)) * 256 + ID3V2Info(p + 6)
tem = StrConv("imag", vbFromUnicode)
p = InStrB(p, ID3V2Info, tem): If p = 0 Then Exit Sub
CopyMemory tem(0), ID3V2Info(p + 5), 4 '获取图片格式
annex = Replace(StrConv(tem, vbUnicode), Chr(0), "")
Place = p + IIf(Len(annex) = 4, 12, 11)
picLen = picLen - IIf(Len(annex) = 4, 14, 13)
ReDim tem(picLen - 1)
CopyMemory tem(0), ID3V2Info(Place), picLen '复制图片数据
SaveName = Environ("TEMP") & "\picTem." & annex '保存到临时文件夹
Open SaveName For Binary As #100
Put #100, , tem
Close #100
Image1.Picture = LoadPicture(SaveName) '装入图像框
Kill SaveName
End Sub

二、嵌入图片的代码
被嵌入mp3的图片，可以是任何VB图片框能显示的格式。图片尺寸以200—500像素为宜。

Private Type ID3Header 'mp3的ID3头结构
ID As String * 3
Version As Integer '版本
flag As Byte '标志
Size(3) As Byte '大小
End Type

Private Sub 嵌入封面图片()
On Error GoTo 100
Dim audioData() As Byte '音频文件数据
Dim ImageData() As Byte '图片数据
Dim Size(3) As Byte '帧内容长度
Dim flags As Integer '标志
Dim picLen As Long '图片长度
Dim ID3V2 As ID3Header
Dim mp3Name As String, picName As String, ID3v As String * 3, annex As String
Dim L1 As Byte, L2 As Byte, L3 As Byte, tem() As Byte
Dim mp3Len As Long, v2Len As Long, i As Integer, k As Integer, s As String

mp3Name = "(全路径mp3文件名)"
picName = "(全路径pic文件名)"
annex = Mid(picName, InStrRev(picName, ".") + 1)

Open picName For Binary As #1
picLen = LOF(1)
ReDim ImageData(picLen - 1)
Get #1, , ImageData
Close #1

Open mp3Name For Binary As #2
mp3Len = LOF(2)
Get #2, , ID3v
If ID3v = "ID3" Then '如果有ID3V2
Get #2, 8, L1
Get #2, , L2
Get #2, , L3
v2Len = L1
v2Len = v2Len * &H4000 + L2 * &H80 + L3 + 11
ReDim audioData(mp3Len - v2Len)
Get #2, v2Len, audioData
End If
Close #2

Select Case LCase(annex)
Case "jpg": k = 14: s = "00696D6167652F6A706567000300"
Case "gif": k = 13: s = "00696D6167652F676966000300"
Case "bmp": k = 13: s = "00696D6167652F626D70000300"
End Select

ReDim tem(k - 1)
For i = 0 To k - 1: tem(i) = Val("&H" & Mid(s, i * 2 + 1, 2)): Next
picLen = picLen + k 'k 是 tem 的数量
v2Len = picLen + 10 '标签内容长度，10是帧头长度
s = Right("00000" & Hex(picLen), 6)
Size(1) = Val("&H" & Left(s, 2))
Size(2) = Val("&H" & Mid(s, 3, 2))
Size(3) = Val("&H" & Mid(s, 5))

With ID3V2
.ID = "ID3"
.Version = 3
If v2Len > &H7F7F Then
.Size(1) = v2Len \ &H4000
.Size(2) = (v2Len Mod &H4000) \ 128
.Size(3) = v2Len Mod &H4000 Mod 128
Else
.Size(2) = v2Len \ 128
.Size(3) = v2Len Mod 128
End If
End With

mp3Name = "(全路径新mp3文件名)"

Open mp3Name For Binary As #3

Put #3, , ID3V2

Put #3, , "APIC"
Put #3, , Size
Put #3, , flags
Put #3, , tem
Put #3, , ImageData
Put #3, , audioData

100
Close
End Sub

以上的代码，能嵌入jpg、bmp、gif三种格式的图片，如果你想增加嵌入别的格式，请自行改动，
作为家庭作业第一题。
以上代码还有一个不足之处：把mp3原有的ID3V2信息删除了，如何既能保留原有的ID3V2信息，又

能嵌入封面图片，就作为家庭作业第二题吧，，如果确实做不出，到163信箱参阅同名邮件的附件。

163邮箱帐号：vb62013@163.com，密码：vb620132013。

2014.9.26

最后更新于：2014-10-01 20:43:30

本帖地址： http://bbs.pfan.cn/post/409678.html

回复列表（共9个回复）

沙发

孙瑞 [专家分：590] 发布于 2014-09-26 08:46:54

赞一个，看看明天我又没有时间，如果明天公司不培训的话，我就研究下数据结构

板凳

一江秋水 [专家分：9680] 发布于 2014-09-28 06:14:08

重要更正：

嵌入图片的代码中，原句

If v2Len > &H7F7F Then

应改为

If v2Len > &H3FFF Then

3 楼

孙瑞 [专家分：590] 发布于 2014-09-28 07:13:44

没有找到时间玩这个，不过我搭建了一个很简单的分享函数的网页

http://www.extencent.com/funcshare/

秋水老师可以放些函数上去

4 楼

一江秋水 [专家分：9680] 发布于 2014-09-28 10:25:19

好，有时间定去踩一踩。

不过，目前急需求助，我上面作了重要更正，但经过实验，还是不正确，问题是这样的：

读盘时，长度4个字节的计算公式是（从左至右）：

长度＝字节1的值×&H200000＋字节2的值×&H4000＋字节3的值×&H80＋字节4的值

现在的问题在于写盘，怎么把一个长度值转换为3个字节的值（字节1可以不考虑，因为不需要这么大的值），再写盘。我是黔驴技穷了，在此求助，先谢了。

5 楼

孙瑞 [专家分：590] 发布于 2014-09-29 21:05:46

我恰好有做过类似的工作

6 楼

一江秋水 [专家分：9680] 发布于 2014-10-01 20:56:08

下面Command1的代码是最符合要求、最保险的代码。

Command2的代码就是我在上面文章中所用的代码。

但它们计算出来的结果是相同的，又说明上面文章中所用的代码是正确的。呵呵，有趣啊。行了，就这样吧。

Private Sub Command1_Click()

Dim A As Long, B As Long, k As Integer, i As Integer, Dat As Long, t1 As String
Dim z() As String, size(3) As Byte
k = 0: t1 = "": Dat = &H4A443
Do
B = Dat \ 2: A = Dat Mod 2: Dat = B
t1 = CStr(A) & t1
k = k + 1: If Dat > 0 And (k Mod 7 = 0) Then t1 = "," & t1
Loop While Dat > 0

z = Split(t1, ","): k = 3
For i = UBound(z) To 0 Step -1: size(k) = change(z(i)): k = k - 1: Next
Text1 = t1
End Sub

Function change(Dat As String) As Byte
Dim A As Byte, B As Byte, i As Integer, L As Integer
L = Len(Dat)
For i = 0 To L - 1: A = Val(Mid(Dat, L - i, 1)): B = B + A * 2 ^ i: Next
change = B
End Function

Private Sub Command2_Click()
Dat = &H4A443
size(1) = Dat \ &H4000: Debug.Print Hex(size(1))
size(2) = (Dat Mod &H4000) \ 128: Debug.Print Hex(size(2))
size(3) = Dat Mod &H4000 Mod 128: Debug.Print Hex(size(3))
End Sub

7 楼

孙瑞 [专家分：590] 发布于 2014-10-07 14:10:11

秋水老师的命名习惯可以改良下哦

Command1之类的名字不好‘

可以改成

btnOK,btnSave等等有具体意义的名称

8 楼

一江秋水 [专家分：9680] 发布于 2014-10-12 20:46:01

自编的播放器上，图片框的尺寸有限（我的只有33像素，千千静听貌似也只有这么大），我想了一个办法，另增加一个窗体，专门用来显示mp3的封面图片。当鼠标移动到播放器的图片框上时，就调出这个窗体。代码如下：

Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not BJform7 Then BJform7 = True: Form7.Show
End Sub

新增加的窗体是form7（当然你的会不相同），BJform7是一个全局布尔型变量，在模块中声明。form7的BorderStyle属性设为0，ScaleMode属性设为1，宽、高均为250像素，上面只放了一个计时器。计时器的时间间隔属性设置为100毫秒。form7的代码如下：

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Type POINTAPI
X As Long
Y As Long
End Type

Dim PO As POINTAPI, L As Long, T As Long

Private Sub Form_Load()
Dim L1 As Long, T1 As Long, W1 As Long, H1 As Long
Me.Picture = LoadPicture(SaveName)
W1 = Me.Picture.Width / 26.45836
H1 = Me.Picture.Height / 26.45836
GetCursorPos PO
L = PO.X: L1 = IIf(L > W1, L - W1, L)
T = PO.Y: T1 = IIf(T > H1, T - H1, T)
Move L1 * 15, T1 * 15, W1 * 15, H1 * 15
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
GetCursorPos PO
If Abs(PO.X - L) > 35 Or Abs(PO.Y - T) > 35 Then Unload Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
BJform7 = False
End Sub

注意：

1. SaveName是保存在临时文件夹中的封面图片文件名，参看我的代码一。

2. 代码一最后把SaveName删除了，这里要显示，就不能删除了，所以要去掉那一句。

3. SaveName要在模块中声明。

这样一来，当鼠标移动到播放器图片框上时，会出现较大的图像，当鼠标离开图片框时，图像就消失，效果极好，我很满意。

9 楼

孙瑞 [专家分：590] 发布于 2014-10-12 23:11:07

26.45836

这个小数是从哪来的？

我来回复

您尚未登录，请登录后再回复。点此登录或注册

主题：mp3封面图片的嵌入与显示的代码

回复列表（共9个回复）

我来回复

程序员工具箱 new

代码片段

本版新帖

主题：mp3封面图片的嵌入与显示的代码

回复列表 （共9个回复）

我来回复

程序员工具箱 new

代码片段

本版新帖

回复列表（共9个回复）