Получить информацию об аудио-файле из плейлиста/с CD/DVD, изменить текущую позицию

' opredeliaem svoistva MP3 file
' delaem vidimimi LABELs
lblStatus.Visible = True
lblTitleHL.Visible = True
lblArtistHL.Visible = True
lblAlbumHL.Visible = True
lblYearHL.Visible = True
lblCommentHL.Visible = True
' vse peremenie localnie
Dim fNum As Integer
    Dim sTagIdent As String * 3
    Dim sTitle As String * 30
    Dim sArtist As String * 30
    Dim sAlbum As String * 30
    Dim sYear As String * 4
    Dim sComment As String * 30
    fNum = FreeFile
    ' esli iz file, to 4itaem tak
    If urlfile = True Then
    Open CDlg1.FileName For Binary As fNum
    Seek #fNum, LOF(fNum) - 127
    Get #fNum, , sTagIdent
    If sTagIdent = "TAG" Then
    Get #fNum, , sTitle
    Get #fNum, , sArtist
    Get #fNum, , sAlbum
    Get #fNum, , sYear
    Get #fNum, , sComment
    End If
    Close #fNum
    ' vivod
    lblTitleHL.Caption = "Title: " & sTitle
    lblArtistHL.Caption = "Artist: " & sArtist
    lblAlbumHL.Caption = "Album: " & sAlbum
    lblYearHL.Caption = "Year: " & sYear
    lblCommentHL.Caption = "Comment: " & sComment
    End If

' нажатие кнопки мыши на слайдер
Private Sub Position_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
' esli nazhatie na SLIDER - menyaem position
tmrUpdate.Enabled = False
Player.Controls.currentPosition = Position.Value
End Sub
 
' отпускание кнопки мыши со слайдера
Private Sub Position_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
' esli nazhatie na SLIDER - menyaem position
tmrUpdate.Enabled = True
Player.Controls.currentPosition = Position.Value
End Sub
 
' обновляется каждую миллисекунду и выводит текущее время записи
Private Sub tmrUpdate_Timer()
' position maximalnoe
If urlfile = True Then
' вызов функции Pos
Pos
' dvigat ego na SLIDER
Position.Value = Player.Controls.currentPosition
End If
End Sub
 
' позволяет получить время записи в секундах, используется функция из модуля
Public Function Pos()
' 2 znaka sleva - minuti
aPos = Left(MP3HeaderInfo.FPlayTime, 2) * 60
' pribavlyaem k secyndam
bPos = Right(MP3HeaderInfo.FPlayTime, 2) + aPos
' vivodim ograni4enye SLIDERa
Position.Max = bPos
End Function

Option Explicit
Public sGenreMatrix
 
Type Info
    sTitle As String * 30
    sArtist As String * 30
    sAlbum As String * 30
    sComment As String * 30
    sYear As String * 4
    sGenre As String * 21 ' NEW
End Type
 
Type HeaderInfo
    Layer As String
    Frequency As String
    Bitrate As String
    Mode As String
    MpegVersion As String
    Emphasis As String
    FPlayTime As String 'Formatted playing time - 04:32
    mFileSize As String
End Type
 
Public MP3Info As Info
Public MP3HeaderInfo As HeaderInfo
 
''''''Read MP3 Header BEGIN''''''
Public Function ReadMP3Header(sPassFileName As String)
Dim z, i
Dim BinaryString As String
Dim byteArray(4) As Byte    'array that store first four bytes
Dim bin As String           'string that store binary number converted from readed bytes
Dim BinString As String     'containing binary string
Dim DecString As Integer  'containing decimal extracted from BinString
'''''''''''''''end of declarations'''''''
On Error GoTo ende
Open sPassFileName For Binary Access Read As #1  'open file #1 for read
   For z = 1 To 4                           'step through four bytes
   Get #1, z, byteArray(z)                  'store every(z)byte  in array position z
   Next z                                   'back for next byte
 Close #1                                   'close file
 bin = ""                                   'reset and build the desired binary number in this string
   For z = 1 To 4                           'convert all bytes to binary
     For i = 0 To 7 Step 1                  'Here comes the decimal=>binary conversion
         If byteArray(z) And (2 ^ i) Then   'Use the logical "AND" operator.
            bin = bin + "1"
            Else
            bin = bin + "0"
         End If
         Next i                             'End of binary conversion
Next z
BinaryString = bin
'''''''''check MP3HeaderInfo.Frequency''''
DecString = 0
BinString = Mid(bin, 19, 2)         'take 19 to 21
For i = 1 To Len(BinString)         'convert to decimal
If Mid(BinString, i, 1) = 1 Then
DecString = DecString + 2 ^ (Len(BinString) - i)
End If
Next i
Select Case DecString
Case 0
MP3HeaderInfo.Frequency = 44100
Case 1
MP3HeaderInfo.Frequency = 32000
Case 2
MP3HeaderInfo.Frequency = 48000
Case 3
End Select
'''''check MP3HeaderInfo.Layer''''
DecString = 0
BinString = Mid(bin, 10, 2)
For i = 1 To Len(BinString)
If Mid(BinString, i, 1) = 1 Then
DecString = DecString + 2 ^ (Len(BinString) - i)
End If
Next i
Select Case DecString
Case 0
MP3HeaderInfo.Layer = ""
Case 1
MP3HeaderInfo.Layer = 2
Case 2
MP3HeaderInfo.Layer = 3
Case 3
MP3HeaderInfo.Layer = 1
End Select
''''check MP3HeaderInfo.Mode''''
DecString = 0
BinString = Mid(bin, 31, 2)
For i = 1 To Len(BinString)
If Mid(BinString, i, 1) = 1 Then
DecString = DecString + 2 ^ (Len(BinString) - i)
End If
Next i
Select Case DecString
Case 0
MP3HeaderInfo.Mode = "Stereo"
Case 1
MP3HeaderInfo.Mode = "Dual Channel"
Case 2
MP3HeaderInfo.Mode = "Joint stereo"
Case 3
MP3HeaderInfo.Mode = "Mono"
End Select
''''check MP3HeaderInfo.MpegVersion
If Mid(bin, 12, 1) = 0 Then
MP3HeaderInfo.MpegVersion = 2
Else
MP3HeaderInfo.MpegVersion = 1
End If
'''''check MP3HeaderInfo.Bitrate''''
DecString = 0
BinString = Mid(bin, 21, 4)
For i = 1 To Len(BinString)
If Mid(BinString, i, 1) = 1 Then
DecString = DecString + 2 ^ (Len(BinString) - i)
End If
Next i
Select Case DecString
Case 0
MP3HeaderInfo.Bitrate = 0
Case 1
MP3HeaderInfo.Bitrate = 112
Case 2
MP3HeaderInfo.Bitrate = 56
Case 3
MP3HeaderInfo.Bitrate = 224
Case 4
MP3HeaderInfo.Bitrate = 40
Case 5
MP3HeaderInfo.Bitrate = 160
Case 6
MP3HeaderInfo.Bitrate = 80
Case 7
MP3HeaderInfo.Bitrate = 320
Case 8
MP3HeaderInfo.Bitrate = 32
Case 9
MP3HeaderInfo.Bitrate = 128
Case 10
MP3HeaderInfo.Bitrate = 64
Case 11
MP3HeaderInfo.Bitrate = 256
Case 12
MP3HeaderInfo.Bitrate = 128 '48
Case 13
MP3HeaderInfo.Bitrate = 192
Case 14
MP3HeaderInfo.Bitrate = 96
Case 15
MP3HeaderInfo.Bitrate = 0
If MP3HeaderInfo.Layer = 1 Then
    Select Case DecString
    Case 0
MP3HeaderInfo.Bitrate = 0
    Case 1
  MP3HeaderInfo.Bitrate = 128
    Case 2
   MP3HeaderInfo.Bitrate = 64
    Case 3
MP3HeaderInfo.Bitrate = 256
    Case 4
MP3HeaderInfo.Bitrate = 48
    Case 5
MP3HeaderInfo.Bitrate = 192
    Case 6
MP3HeaderInfo.Bitrate = 96
    Case 7
    MP3HeaderInfo.Bitrate = 384
    Case 8
MP3HeaderInfo.Bitrate = 32
    Case 9
MP3HeaderInfo.Bitrate = 160
    Case 10
    MP3HeaderInfo.Bitrate = 80
    Case 11
MP3HeaderInfo.Bitrate = 320
    Case 12
MP3HeaderInfo.Bitrate = 56
    Case 13
MP3HeaderInfo.Bitrate = 224
    Case 14
  MP3HeaderInfo.Bitrate = 112
    Case 15
MP3HeaderInfo.Bitrate = 0
End Select
End If
End Select
'''''MP3HeaderInfo.Emphasis''''
DecString = 0
BinString = Mid(bin, 25, 2)
For i = 1 To Len(BinString)        'go from first
If Mid(BinString, i, 1) = 1 Then
DecString = DecString + 2 ^ (Len(BinString) - i)
End If
Next i
Select Case DecString
Case 0
MP3HeaderInfo.Emphasis = "No"
Case 1
MP3HeaderInfo.Emphasis = "-?-"
Case 2
MP3HeaderInfo.Emphasis = "50/15"
Case 3
MP3HeaderInfo.Emphasis = "CITT j. 17"
End Select
 
With MP3HeaderInfo
    Dim min, sec
    .Bitrate = Int(.Bitrate)
    .mFileSize = FileSizeMP3(sPassFileName)
    .FPlayTime = ((.mFileSize * 8) / (.Bitrate * 1000))
    min = .FPlayTime \ 60         'minutes
    sec = .FPlayTime - (min * 60) 'seconds
    .FPlayTime = Format(min, "#0#") & ":" & Format(sec, "0#") 'format time to 00:00
End With
ende:
End Function
''''''Read MP3 Header END''''''

Position.Max = Fix(Player.currentMedia.duration)

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Dim lTotalTime As Long
Dim strFileToPlay As String
 
Private Sub TotalTime()
    Dim TotalTime As String * 128
    mciSendString "open " & strFileToPlay & " type MPEGVideo", 0, 0, 0
    mciSendString "set " & strFileToPlay & " time format ms", TotalTime, 128, 0&
    mciSendString "status " & strFileToPlay & " length", TotalTime, 128, 0&
    lTotalTime = Val(TotalTime)
    
End Sub
 
Private Sub Command1_Click()
mciSendString "close all", 0, 0, 0
strFileToPlay = Chr(34) & "C:\E. Vaenga - Kurju.mp3" & Chr(34)
TotalTime
MsgBox lTotalTime / 1000 & "сек."
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
mciSendString "close all", 0, 0, 0
End Sub

Public Function Pos()
mciSendString "close all", 0, 0, 0
strFileToPlay = Chr(34) & Player.URL & Chr(34)
TotalTime
Position.Max = Fix(lTotalTime / 1000)
End Function

mciSendString "close all", 0, 0, 0