ASP 读取MP3文件帧的信息比特率，采样频率，播放时间

核心提示：VB读取MP3文件帧的信息比特率，采样频率，播放时间

Private Sub Command1_Click()
On Error GoTo E
Label1.Caption = "比特率：？？？"
Label2.Caption = "采样频率：？？？"
Label3.Caption = "帧长：？？？"
Label4.Caption = "帧头：？？？"
Dim ZhenTou(3) As Byte    '用来存储MP3文件的帧头
Dim Tou(9) As Byte    '用来存储文件的前10字节
Dim TouSSS As String '用来存储文件前10字节的字符串
Dim HexTou As String '帧头的十六进制信息
Dim BinTou As String '帧头的二进制信息
Dim S As String    '便于计算的变量
Dim ID3V2 As Long 'ID3V2的长度
Dim Size(3) As String 'ID3V2长度的标识
Dim Bit As String '比特率
Dim Hz As String   '采样频率
Dim r As Long    '便于计算的变量
Clg.ShowOpen
Open Clg.FileName For Binary As #1
Get #1, , Tou '读取文件前10字节
Close #1
TouSSS = StrConv(Tou, vbUnicode) '转换为字符串
For i = 1 To Len(TouSSS) '取字符串中每一个字符的ASCII
S = Mid(TouSSS, i, 1)    '码，并转换为16进制
S = Hex(Asc(S))
If Len(S) = 1 Then '加一个“0”以占位
S = "0" & S
ElseIf Len(S) = 4 Then
S = Mid(S, 1, 2) & " " & Mid(S, 3, 2) '将长字符串分开
End If
S = S & " "
HexTou = HexTou & S
Next
If Mid(HexTou, 1, 2) = "FF" Then '如果文件的前10字节
HexTou = Mid(HexTou, 1, 11)      '中包含帧头......
Else
HexTou = Mid(HexTou, 19, 11) '如果不包含帧头
Size(0) = Mid(HexTou, 1, 2)
Size(1) = Mid(HexTou, 4, 2)
Size(2) = Mid(HexTou, 7, 2)
Size(3) = Mid(HexTou, 10, 2)
HexTou = ""
ID3V2 = CLng("&H" & Size(0)) * 2 ^ 21 + CLng("&H" & Size(1)) * 2 ^ 14 + _
CLng("&H" & Size(2)) * 2 ^ 7 + CLng("&H" & Size(3)) * 2 ^ 0 + 10
'计算ID3V2的长度
Open Clg.FileName For Binary As #1 '打开Mp3文件
Seek #1, ID3V2 + 1 '定位指针
Get #1, , ZhenTou   '获得帧头
Close #1
TouSSS = StrConv(ZhenTou, vbUnicode)
For i = 1 To Len(TouSSS)
S = Mid(TouSSS, i, 1)
S = Hex(Asc(S))
If Len(S) = 1 Then
S = "0" & S
ElseIf Len(S) = 4 Then
S = Mid(S, 1, 2) & " " & Mid(S, 3, 2)
End If
S = S & " "
HexTou = HexTou & S
Next
End If
Label4.Caption = "帧头：" & HexTou
BinTou = HEX_to_BIN(HexTou) '把十六进制的帧头信息
r = Val(Mid(BinTou, 17, 4)) '转换为二进制
Select Case r
Case 0: Bit = "free"
Case 1: Bit = "32"
Case 10: Bit = "40"
Case 11: Bit = "48"
Case 100: Bit = "56"
Case 101: Bit = "64"
Case 110: Bit = "80"
Case 111: Bit = "96"
Case 1000: Bit = "112"
Case 1001: Bit = "128"
Case 1010: Bit = "160"
Case 1011: Bit = "192"
Case 1100: Bit = "224"
Case 1101: Bit = "256"
Case 1110: Bit = "320"
Case 1111: Bit = "bad"
End Select
Label1.Caption = "比特率：" & Bit & "千比特/秒"
r = Val(Mid(BinTou, 21, 2))
Select Case r
Case 0: Hz = "44.1"
Case 1: Hz = "48"
Case 10: Hz = "32"
Case 11: Hz = "未定义"
End Select
Label2.Caption = "采样频率：" & Hz & "千赫兹"
If Bit = "free" Or Bit = "bad" Then
MsgBox& "不能计算帧长！！！"
Exit Sub
End If
If Hz = "未定义" Then
MsgBox& "不能计算帧长！！！"
Exit Sub
End If
If Mid(BinTou, 23, 1) = "0" Then
Label3.Caption = "帧长：" & Int((144 * Val(Bit) * 1000) / (Val(Hz) * 1000)) & "字节"
Else
Label3.Caption = "帧长：" & Int((144 * Val(Bit) * 1000) / (Val(Hz) * 1000)) + 1 & "字节"
End If
Exit Sub
E:
MsgBox& "发生错误！！！"
End Sub
'十六进制转换二进制的函数
Function HEX_to_BIN(ByVal Hex As String) As String
Dim i As Long
Dim b As String
Hex = UCase(Hex)
For i = 1 To Len(Hex)
Select Case Mid(Hex, i, 1)
            Case "0": b = b & "0000"
            Case "1": b = b & "0001"
            Case "2": b = b & "0010"
            Case "3": b = b & "0011"
            Case "4": b = b & "0100"
            Case "5": b = b & "0101"
            Case "6": b = b & "0110"
            Case "7": b = b & "0111"
            Case "8": b = b & "1000"
            Case "9": b = b & "1001"
            Case "A": b = b & "1010"
            Case "B": b = b & "1011"
            Case "C": b = b & "1100"
            Case "D": b = b & "1101"
            Case "E": b = b & "1110"
            Case "F": b = b & "1111"
End Select
Next i
While Left(b, 1) = "0"
        b = Right(b, Len(b) - 1)
Wend
HEX_to_BIN = b
End Function