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

Узнай цену своей работы

Формулировка задачи:

В моем аудио-плеере есть всего заметных невооруженным глазом бага: не выходит получить информацию об аудио-файле из плейлиста [формат M3U] и также из CD/DVD диска (то есть название, альбом, год, если они записаны в тегах). И ещё нельзя перемотать на нужное место запись из плейлиста и диска. Вот фрагменты кода, которые работают с обычными аудио-файлами и совершенно не работают с плейлистами и дисками. Получить данные из тегов файла:
Листинг программы 
  1. ' opredeliaem svoistva MP3 file
  2. ' delaem vidimimi LABELs
  3. lblStatus.Visible = True
  4. lblTitleHL.Visible = True
  5. lblArtistHL.Visible = True
  6. lblAlbumHL.Visible = True
  7. lblYearHL.Visible = True
  8. lblCommentHL.Visible = True
  9. ' vse peremenie localnie
  10. Dim fNum As Integer
  11.     Dim sTagIdent As String * 3
  12.     Dim sTitle As String * 30
  13.     Dim sArtist As String * 30
  14.     Dim sAlbum As String * 30
  15.     Dim sYear As String * 4
  16.     Dim sComment As String * 30
  17.     fNum = FreeFile
  18.     ' esli iz file, to 4itaem tak
  19.     If urlfile = True Then
  20.     Open CDlg1.FileName For Binary As fNum
  21.     Seek #fNum, LOF(fNum) - 127
  22.     Get #fNum, , sTagIdent
  23.     If sTagIdent = "TAG" Then
  24.     Get #fNum, , sTitle
  25.     Get #fNum, , sArtist
  26.     Get #fNum, , sAlbum
  27.     Get #fNum, , sYear
  28.     Get #fNum, , sComment
  29.     End If
  30.     Close #fNum
  31.     ' vivod
  32.     lblTitleHL.Caption = "Title: " & sTitle
  33.     lblArtistHL.Caption = "Artist: " & sArtist
  34.     lblAlbumHL.Caption = "Album: " & sAlbum
  35.     lblYearHL.Caption = "Year: " & sYear
  36.     lblCommentHL.Caption = "Comment: " & sComment
  37.     End If
Перемотать запись на нужное место [Position - это объект Slider]:
Листинг программы 
  1. ' нажатие кнопки мыши на слайдер
  2. Private Sub Position_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  3. ' esli nazhatie na SLIDER - menyaem position
  4. tmrUpdate.Enabled = False
  5. Player.Controls.currentPosition = Position.Value
  6. End Sub
  7.  
  8. ' отпускание кнопки мыши со слайдера
  9. Private Sub Position_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  10. ' esli nazhatie na SLIDER - menyaem position
  11. tmrUpdate.Enabled = True
  12. Player.Controls.currentPosition = Position.Value
  13. End Sub
  14.  
  15. ' обновляется каждую миллисекунду и выводит текущее время записи
  16. Private Sub tmrUpdate_Timer()
  17. ' position maximalnoe
  18. If urlfile = True Then
  19. ' вызов функции Pos
  20. Pos
  21. ' dvigat ego na SLIDER
  22. Position.Value = Player.Controls.currentPosition
  23. End If
  24. End Sub
  25.  
  26. ' позволяет получить время записи в секундах, используется функция из модуля
  27. Public Function Pos()
  28. ' 2 znaka sleva - minuti
  29. aPos = Left(MP3HeaderInfo.FPlayTime, 2) * 60
  30. ' pribavlyaem k secyndam
  31. bPos = Right(MP3HeaderInfo.FPlayTime, 2) + aPos
  32. ' vivodim ograni4enye SLIDERa
  33. Position.Max = bPos
  34. End Function
Из модуля:
Листинг программы 
  1. Option Explicit
  2. Public sGenreMatrix
  3.  
  4. Type Info
  5.     sTitle As String * 30
  6.     sArtist As String * 30
  7.     sAlbum As String * 30
  8.     sComment As String * 30
  9.     sYear As String * 4
  10.     sGenre As String * 21 ' NEW
  11. End Type
  12.  
  13. Type HeaderInfo
  14.     Layer As String
  15.     Frequency As String
  16.     Bitrate As String
  17.     Mode As String
  18.     MpegVersion As String
  19.     Emphasis As String
  20.     FPlayTime As String 'Formatted playing time - 04:32
  21.     mFileSize As String
  22. End Type
  23.  
  24. Public MP3Info As Info
  25. Public MP3HeaderInfo As HeaderInfo
  26.  
  27. ''''''Read MP3 Header BEGIN''''''
  28. Public Function ReadMP3Header(sPassFileName As String)
  29. Dim z, i
  30. Dim BinaryString As String
  31. Dim byteArray(4) As Byte    'array that store first four bytes
  32. Dim bin As String           'string that store binary number converted from readed bytes
  33. Dim BinString As String     'containing binary string
  34. Dim DecString As Integer  'containing decimal extracted from BinString
  35. '''''''''''''''end of declarations'''''''
  36. On Error GoTo ende
  37. Open sPassFileName For Binary Access Read As #1  'open file #1 for read
  38.    For z = 1 To 4                           'step through four bytes
  39.    Get #1, z, byteArray(z)                  'store every(z)byte  in array position z
  40.    Next z                                   'back for next byte
  41.  Close #1                                   'close file
  42.  bin = ""                                   'reset and build the desired binary number in this string
  43.    For z = 1 To 4                           'convert all bytes to binary
  44.      For i = 0 To 7 Step 1                  'Here comes the decimal=>binary conversion
  45.          If byteArray(z) And (2 ^ i) Then   'Use the logical "AND" operator.
  46.             bin = bin + "1"
  47.             Else
  48.             bin = bin + "0"
  49.          End If
  50.          Next i                             'End of binary conversion
  51. Next z
  52. BinaryString = bin
  53. '''''''''check MP3HeaderInfo.Frequency''''
  54. DecString = 0
  55. BinString = Mid(bin, 19, 2)         'take 19 to 21
  56. For i = 1 To Len(BinString)         'convert to decimal
  57. If Mid(BinString, i, 1) = 1 Then
  58. DecString = DecString + 2 ^ (Len(BinString) - i)
  59. End If
  60. Next i
  61. Select Case DecString
  62. Case 0
  63. MP3HeaderInfo.Frequency = 44100
  64. Case 1
  65. MP3HeaderInfo.Frequency = 32000
  66. Case 2
  67. MP3HeaderInfo.Frequency = 48000
  68. Case 3
  69. End Select
  70. '''''check MP3HeaderInfo.Layer''''
  71. DecString = 0
  72. BinString = Mid(bin, 10, 2)
  73. For i = 1 To Len(BinString)
  74. If Mid(BinString, i, 1) = 1 Then
  75. DecString = DecString + 2 ^ (Len(BinString) - i)
  76. End If
  77. Next i
  78. Select Case DecString
  79. Case 0
  80. MP3HeaderInfo.Layer = ""
  81. Case 1
  82. MP3HeaderInfo.Layer = 2
  83. Case 2
  84. MP3HeaderInfo.Layer = 3
  85. Case 3
  86. MP3HeaderInfo.Layer = 1
  87. End Select
  88. ''''check MP3HeaderInfo.Mode''''
  89. DecString = 0
  90. BinString = Mid(bin, 31, 2)
  91. For i = 1 To Len(BinString)
  92. If Mid(BinString, i, 1) = 1 Then
  93. DecString = DecString + 2 ^ (Len(BinString) - i)
  94. End If
  95. Next i
  96. Select Case DecString
  97. Case 0
  98. MP3HeaderInfo.Mode = "Stereo"
  99. Case 1
  100. MP3HeaderInfo.Mode = "Dual Channel"
  101. Case 2
  102. MP3HeaderInfo.Mode = "Joint stereo"
  103. Case 3
  104. MP3HeaderInfo.Mode = "Mono"
  105. End Select
  106. ''''check MP3HeaderInfo.MpegVersion
  107. If Mid(bin, 12, 1) = 0 Then
  108. MP3HeaderInfo.MpegVersion = 2
  109. Else
  110. MP3HeaderInfo.MpegVersion = 1
  111. End If
  112. '''''check MP3HeaderInfo.Bitrate''''
  113. DecString = 0
  114. BinString = Mid(bin, 21, 4)
  115. For i = 1 To Len(BinString)
  116. If Mid(BinString, i, 1) = 1 Then
  117. DecString = DecString + 2 ^ (Len(BinString) - i)
  118. End If
  119. Next i
  120. Select Case DecString
  121. Case 0
  122. MP3HeaderInfo.Bitrate = 0
  123. Case 1
  124. MP3HeaderInfo.Bitrate = 112
  125. Case 2
  126. MP3HeaderInfo.Bitrate = 56
  127. Case 3
  128. MP3HeaderInfo.Bitrate = 224
  129. Case 4
  130. MP3HeaderInfo.Bitrate = 40
  131. Case 5
  132. MP3HeaderInfo.Bitrate = 160
  133. Case 6
  134. MP3HeaderInfo.Bitrate = 80
  135. Case 7
  136. MP3HeaderInfo.Bitrate = 320
  137. Case 8
  138. MP3HeaderInfo.Bitrate = 32
  139. Case 9
  140. MP3HeaderInfo.Bitrate = 128
  141. Case 10
  142. MP3HeaderInfo.Bitrate = 64
  143. Case 11
  144. MP3HeaderInfo.Bitrate = 256
  145. Case 12
  146. MP3HeaderInfo.Bitrate = 128 '48
  147. Case 13
  148. MP3HeaderInfo.Bitrate = 192
  149. Case 14
  150. MP3HeaderInfo.Bitrate = 96
  151. Case 15
  152. MP3HeaderInfo.Bitrate = 0
  153. If MP3HeaderInfo.Layer = 1 Then
  154.     Select Case DecString
  155.     Case 0
  156. MP3HeaderInfo.Bitrate = 0
  157.     Case 1
  158.   MP3HeaderInfo.Bitrate = 128
  159.     Case 2
  160.    MP3HeaderInfo.Bitrate = 64
  161.     Case 3
  162. MP3HeaderInfo.Bitrate = 256
  163.     Case 4
  164. MP3HeaderInfo.Bitrate = 48
  165.     Case 5
  166. MP3HeaderInfo.Bitrate = 192
  167.     Case 6
  168. MP3HeaderInfo.Bitrate = 96
  169.     Case 7
  170.     MP3HeaderInfo.Bitrate = 384
  171.     Case 8
  172. MP3HeaderInfo.Bitrate = 32
  173.     Case 9
  174. MP3HeaderInfo.Bitrate = 160
  175.     Case 10
  176.     MP3HeaderInfo.Bitrate = 80
  177.     Case 11
  178. MP3HeaderInfo.Bitrate = 320
  179.     Case 12
  180. MP3HeaderInfo.Bitrate = 56
  181.     Case 13
  182. MP3HeaderInfo.Bitrate = 224
  183.     Case 14
  184.   MP3HeaderInfo.Bitrate = 112
  185.     Case 15
  186. MP3HeaderInfo.Bitrate = 0
  187. End Select
  188. End If
  189. End Select
  190. '''''MP3HeaderInfo.Emphasis''''
  191. DecString = 0
  192. BinString = Mid(bin, 25, 2)
  193. For i = 1 To Len(BinString)        'go from first
  194. If Mid(BinString, i, 1) = 1 Then
  195. DecString = DecString + 2 ^ (Len(BinString) - i)
  196. End If
  197. Next i
  198. Select Case DecString
  199. Case 0
  200. MP3HeaderInfo.Emphasis = "No"
  201. Case 1
  202. MP3HeaderInfo.Emphasis = "-?-"
  203. Case 2
  204. MP3HeaderInfo.Emphasis = "50/15"
  205. Case 3
  206. MP3HeaderInfo.Emphasis = "CITT j. 17"
  207. End Select
  208.  
  209. With MP3HeaderInfo
  210.     Dim min, sec
  211.     .Bitrate = Int(.Bitrate)
  212.     .mFileSize = FileSizeMP3(sPassFileName)
  213.     .FPlayTime = ((.mFileSize * 8) / (.Bitrate * 1000))
  214.     min = .FPlayTime \ 60         'minutes
  215.     sec = .FPlayTime - (min * 60) 'seconds
  216.     .FPlayTime = Format(min, "#0#") & ":" & Format(sec, "0#") 'format time to 00:00
  217. End With
  218. ende:
  219. End Function
  220. ''''''Read MP3 Header END''''''

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

textual
Листинг программы 
  1. 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
  2. Dim lTotalTime As Long
  3. Dim strFileToPlay As String
  4.  
  5. Private Sub TotalTime()
  6.     Dim TotalTime As String * 128
  7.     mciSendString "open " & strFileToPlay & " type MPEGVideo", 0, 0, 0
  8.     mciSendString "set " & strFileToPlay & " time format ms", TotalTime, 128, 0&
  9.     mciSendString "status " & strFileToPlay & " length", TotalTime, 128, 0&
  10.     lTotalTime = Val(TotalTime)
  11.     
  12. End Sub
  13.  
  14. Private Sub Command1_Click()
  15. mciSendString "close all", 0, 0, 0
  16. strFileToPlay = Chr(34) & "C:\E. Vaenga - Kurju.mp3" & Chr(34)
  17. TotalTime
  18. MsgBox lTotalTime / 1000 & "сек."
  19. End Sub
  20.  
  21. Private Sub Form_Unload(Cancel As Integer)
  22. mciSendString "close all", 0, 0, 0
  23. End Sub

ИИ поможет Вам:

  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

13   голосов , оценка 4.154 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы