Важная информация
RSS лента

The trick

Класс - MP3 проигрыватель из памяти.

Оценить эту запись
Всем привет. Я разработал класс для асинхронного воспроизведения MP3 файлов в памяти. Например это может пригодится для воспроизведения фоновой музыки из ресурсов или из сети минуя запись в файл. Воспроизводить можно несколько файлов одновременно, но некоторые параметры воспроизведения (громкость, панорама) для всех проигрывателей будут общими. Класс разработан так, что корректно обрабатывает ситуации остановки среды кнопками "стоп", "пауза" и выхода по End. Есть одно ограничение на порядок уничтожения объектов. Т.к. все объекты используют один общий ресурс окна и кучи, то уничтожение объектов должно быть в том порядке в котором они были созданы, иначе неизбежны вылеты. Для одного объекта никаких ограничений нет. По тегам, корректно обрабатываются только ID3v1 и ID3v2 теги, другие не распознаются и файл скорее всего не будет играться.
Методы:
  • Initialize - инициализирует проигрыватель, в качестве первого параметра передается указатель на данные MP3 файла. Второй параметр указывает на размер данных. Третий параметр определяет нужно ли копировать файл во внутренний буфер внутри объекта и воспроизводить файл оттуда;
  • Play - запускает воспроизведение, параметр looped при первом воспроизведении определяет будет ли файл зацикливаться;
  • Pause - приостанавливает воспроизведение, следующее воспроизведение начнется с текущей позиции;
  • StopPlaying - останавливает воспроизведение;
  • SetPositionMs - устанавливает текущую позицию воспроизведения (мс);
  • GetPositionMs - возвращает текущую позицию воспроизведения (мс);
  • GetDurationMs - возвращает длину файла в миллисекундах;
  • GetBitrate - возвращает битрейт на момент воспроизведения (кб/с);
  • IsPlaying - определяет играется ли файл;

Свойства:
  • Volume - задает/возвращает текущую громкость воспроизведения (0...1);
  • Pan - задает/возвращает текущую панораму воспроизведения ((левый канал)-1...1(правый канал)).

VB Code:
  1. ' Class clsTrickMP3Player.cls - for asynchronous play mp3-files from memory.
  2. ' © Кривоус Анатолий Анатольевич (The trick), 2015
  3. ' Warning! You need to remove objects in the same order as they were created!
  4.  
  5. Option Explicit
  6.  
  7. Private Type WNDCLASSEX
  8.     cbSize              As Long
  9.     style               As Long
  10.     lpfnwndproc         As Long
  11.     cbClsextra          As Long
  12.     cbWndExtra2         As Long
  13.     hInstance           As Long
  14.     hIcon               As Long
  15.     hCursor             As Long
  16.     hbrBackground       As Long
  17.     lpszMenuName        As Long
  18.     lpszClassName       As Long
  19.     hIconSm             As Long
  20. End Type
  21.  
  22. Private Type MPEGLAYER3WAVEFORMAT
  23.     wFormatTag          As Integer
  24.     nChannels           As Integer
  25.     nSamplesPerSec      As Long
  26.     nAvgBytesPerSec     As Long
  27.     nBlockAlign         As Integer
  28.     wBitsPerSample      As Integer
  29.     cbSize              As Integer
  30.     wID                 As Integer
  31.     fdwFlags            As Long
  32.     nBlockSize          As Integer
  33.     nFramesPerBlock     As Integer
  34.     nCodecDelay         As Integer
  35. End Type
  36.  
  37. Private Type FrameInfo
  38.     offset              As Long
  39.     bitrate             As Long
  40. End Type
  41.  
  42. Private Type Mp3Info
  43.     format              As MPEGLAYER3WAVEFORMAT
  44.     lpFrameOffset       As Long
  45.     szDataSize          As Long
  46.     samplesPerFrame     As Long
  47.     framesCount         As Long
  48.     frameOffset()       As FrameInfo
  49. End Type
  50.  
  51. Private Type WAVEHDR
  52.     lpData              As Long
  53.     dwBufferLength      As Long
  54.     dwBytesRecorded     As Long
  55.     dwUser              As Long
  56.     dwFlags             As Long
  57.     dwLoops             As Long
  58.     lpNext              As Long
  59.     Reserved            As Long
  60. End Type
  61.  
  62. Private Type mp3Buffer
  63.     header              As WAVEHDR
  64.     status              As Boolean
  65. End Type
  66.  
  67. Private Type mp3Const
  68.     bitrate(1, 15)      As Integer
  69.     smprate(2, 3)       As Long
  70. End Type
  71.  
  72. Private Type curBuffer
  73.     b(15)               As Currency
  74. End Type
  75.  
  76. Private Declare Function GetMem4 Lib "msvbvm60" (Src As Any, Dst As Any) As Long
  77. Private Declare Function GetMem8 Lib "msvbvm60" (Src As Any, Dst As Any) As Long
  78. Private Declare Sub memcpy Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  79. Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleW" (ByVal lpModuleName As Long) As Long
  80. Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
  81. Private Declare Function GetProcessHeap Lib "kernel32" () As Long
  82. Private Declare Function HeapCreate Lib "kernel32" (ByVal flOptions As Long, ByVal dwInitialSize As Long, ByVal dwMaximumSize As Long) As Long
  83. Private Declare Function HeapDestroy Lib "kernel32" (ByVal hHeap As Long) As Long
  84. Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
  85. Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
  86. Private Declare Function SetEnvironmentVariable Lib "kernel32" Alias "SetEnvironmentVariableW" (ByVal lpName As Long, lpValue As Any) As Long
  87. Private Declare Function GetEnvironmentVariable Lib "kernel32" Alias "GetEnvironmentVariableW" (ByVal lpName As Long, lpBuffer As Any, ByVal nSize As Long) As Long
  88. Private Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassW" (ByVal lpClassName As Long, ByVal hInstance As Long) As Long
  89. Private Declare Function RegisterClassEx Lib "user32" Alias "RegisterClassExW" (pcWndClassEx As WNDCLASSEX) As Integer
  90. Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExW" (ByVal dwExStyle As Long, ByVal lpClassName As Long, ByVal lpWindowName As Long, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
  91. Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
  92. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  93. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongW" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
  94. Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcW" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  95. Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcW" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  96. Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
  97. Private Declare Function waveOutOpen Lib "winmm" (lphWaveOut As Long, ByVal uDeviceID As Long, lpFormat As Any, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
  98. Private Declare Function waveOutPrepareHeader Lib "winmm" (ByVal hWaveOut As Long, lpWaveOutHdr As WAVEHDR, ByVal uSize As Long) As Long
  99. Private Declare Function waveOutWrite Lib "winmm" (ByVal hWaveOut As Long, lpWaveOutHdr As WAVEHDR, ByVal uSize As Long) As Long
  100. Private Declare Function waveOutUnprepareHeader Lib "winmm" (ByVal hWaveOut As Long, lpWaveOutHdr As WAVEHDR, ByVal uSize As Long) As Long
  101. Private Declare Function waveOutClose Lib "winmm" (ByVal hWaveOut As Long) As Long
  102. Private Declare Function waveOutReset Lib "winmm" (ByVal hWaveOut As Long) As Long
  103. Private Declare Function waveOutPause Lib "winmm" (ByVal hWaveOut As Long) As Long
  104. Private Declare Function waveOutRestart Lib "winmm" (ByVal hWaveOut As Long) As Long
  105. Private Declare Function waveOutSetVolume Lib "winmm" (ByVal wDeviceID As Long, ByVal dwVolume As Long) As Long
  106. Private Declare Function waveOutGetVolume Lib "winmm" (ByVal wDeviceID As Long, dwVolume As Long) As Long
  107.  
  108. Private Const Mp3Class                      As String = "TrickMP3PlayerClass"
  109. Private Const HWND_MESSAGE                  As Long = -3
  110. Private Const WAVE_MAPPER                   As Long = -1&
  111. Private Const WHDR_DONE                     As Long = &H1
  112. Private Const CALLBACK_WINDOW               As Long = &H10000
  113. Private Const MM_WOM_DONE                   As Long = &H3BD
  114. Private Const WM_TIMER                      As Long = &H113
  115. Private Const WNDPROCINDEX                  As Long = 13
  116. Private Const HEAP_CREATE_ENABLE_EXECUTE    As Long = &H40000
  117. Private Const HEAP_NO_SERIALIZE             As Long = &H1
  118. Private Const HEAP_ZERO_MEMORY              As Long = &H8
  119. Private Const GWL_WNDPROC                   As Long = (-4)
  120. Private Const GWL_USERDATA                  As Long = (-21)
  121. Private Const MPEGLAYER3_FLAG_PADDING_OFF   As Long = 2
  122. Private Const WAVE_FORMAT_MPEGLAYER3        As Long = &H55
  123. Private Const MPEGLAYER3_WFX_EXTRA_BYTES    As Long = 12
  124. Private Const MPEGLAYER3_ID_MPEG            As Long = 1
  125. Private Const BUFFERS_COUNT                 As Long = 8
  126.  
  127. Private init        As Boolean
  128. Private loaded      As Boolean
  129. Private playing     As Boolean
  130. Private paused      As Boolean
  131. Private isLoop      As Boolean
  132. Private constants   As mp3Const
  133. Private hwnd        As Long
  134. Private hHeap       As Long
  135. Private lpWndProc   As Long
  136. Private lpPrvProc   As Long
  137. Private hWave       As Long
  138. Private headers()   As mp3Buffer
  139. Private curPosition As Long
  140. Private fileInfo    As Mp3Info
  141. Private buffer()    As Byte
  142. Private mPan        As Single
  143. Private mVolume     As Single
  144.  
  145. ' // Initialize playback. The first parameter is a pointer to data of the raw mp3 file.
  146. ' // Second parameter is a size of this file in bytes.
  147. ' // Last parameter indicates that need to copy this file in the internal buffer.
  148. Public Function Initialize(ByVal lpData As Long, ByVal szData As Long, Optional ByVal blCopy As Boolean) As Boolean
  149.     Dim status  As Boolean
  150.     Dim info    As Mp3Info
  151.     Dim ret     As Long
  152.     Dim index   As Long
  153.     
  154.     If Not init Then Exit Function
  155.     
  156.     status = Mp3GetInfo(lpData, szData, info)
  157.     If Not status Then Exit Function
  158.     
  159.     If hWave Then ClearAll
  160.     
  161.     If blCopy Then
  162.         
  163.         ReDim buffer(info.szDataSize - 1)
  164.         memcpy buffer(0), ByVal info.lpFrameOffset, info.szDataSize
  165.         info.lpFrameOffset = VarPtr(buffer(0))
  166.         
  167.     End If
  168.     
  169.     ret = waveOutOpen(hWave, WAVE_MAPPER, info.format, hwnd, 0, CALLBACK_WINDOW)
  170.     If ret Then hWave = 0:  Exit Function
  171.  
  172.     fileInfo = info
  173.     curPosition = 0
  174.     Me.Pan = mPan
  175.     Me.Volume = mVolume
  176.     
  177.     loaded = True
  178.     playing = False
  179.     
  180. End Function
  181.  
  182. ' // Start playback. If it is the first call after stopping or initialization then parameter "looped" allows to play a data by circularly.
  183. Public Function Play(Optional ByVal looped As Boolean) As Boolean
  184.     Dim index   As Long
  185.     Dim ret     As Long
  186.     
  187.     If Not (init And loaded) Then Exit Function
  188.     
  189.     isLoop = looped
  190.     
  191.     If paused Then
  192.         
  193.         If waveOutRestart(hWave) Then Exit Function
  194.         paused = False
  195.         
  196.     Else
  197.         
  198.         curPosition = 0
  199.         
  200.         For index = 0 To BUFFERS_COUNT - 1
  201.     
  202.             headers(index).header.lpData = fileInfo.lpFrameOffset + fileInfo.frameOffset(curPosition).offset
  203.     
  204.             If index < fileInfo.framesCount - 1 Then
  205.             
  206.                 headers(index).header.dwBufferLength = fileInfo.frameOffset(curPosition + 1).offset - fileInfo.frameOffset(curPosition).offset
  207.                 
  208.             Else
  209.  
  210.                 headers(index).header.dwBufferLength = fileInfo.szDataSize - fileInfo.frameOffset(curPosition).offset
  211.                 
  212.                 If isLoop Then
  213.                     curPosition = 0
  214.                 Else
  215.                     Exit For
  216.                 End If
  217.                 
  218.             End If
  219.     
  220.             ret = waveOutPrepareHeader(hWave, headers(index).header, Len(headers(index).header))
  221.             headers(index).status = ret = 0
  222.     
  223.             If ret Then ClearAll: Exit Function
  224.     
  225.             ret = waveOutWrite(hWave, headers(index).header, Len(headers(index).header))
  226.             If ret Then ClearAll: Exit Function
  227.             
  228.             curPosition = curPosition + 1
  229.             
  230.         Next
  231.         
  232.     End If
  233.     
  234.     playing = True
  235.     Play = True
  236.     
  237. End Function
  238.  
  239. ' // Pause playback.
  240. Public Function Pause() As Boolean
  241.  
  242.     If Not (init And loaded And playing) Then Exit Function
  243.     
  244.     waveOutPause hWave
  245.     
  246.     paused = True
  247.     Pause = True
  248.     
  249. End Function
  250.  
  251. ' // Stop playback.
  252. Public Function StopPlaying() As Boolean
  253.  
  254.     If Not (init And loaded And playing) Then Exit Function
  255.     
  256.     paused = False
  257.     playing = False
  258.     curPosition = -1
  259.     
  260.     waveOutReset hWave
  261.  
  262.     StopPlaying = True
  263.     
  264. End Function
  265.  
  266. ' // Set current playback position (in milliseconds).
  267. Public Function SetPositionMs(ByVal pos As Long) As Boolean
  268.     Dim frameLength As Single
  269.     Dim index       As Long
  270.     
  271.     If Not (init And loaded) Then Err.Raise 5: Exit Function
  272.     
  273.     frameLength = fileInfo.samplesPerFrame / fileInfo.format.nSamplesPerSec
  274.     index = pos / 1000 / frameLength
  275.     
  276.     If index >= fileInfo.framesCount Then Err.Raise 5:  Exit Function
  277.     
  278.     curPosition = index
  279.     SetPositionMs = True
  280.     
  281. End Function
  282.  
  283. ' // Get current playback position (in milliseconds).
  284. Public Function GetPositionMs() As Long
  285.     Dim frameLength As Single
  286.     
  287.     If Not (init And loaded) Then Exit Function
  288.     
  289.     frameLength = fileInfo.samplesPerFrame / fileInfo.format.nSamplesPerSec
  290.     GetPositionMs = curPosition * frameLength * 1000
  291.     
  292. End Function
  293.  
  294. ' // Get duration of the data in milliseconds.
  295. Public Function GetDurationMs() As Long
  296.     Dim frameLength As Single
  297.     
  298.     If Not (init And loaded) Then Exit Function
  299.     
  300.     frameLength = fileInfo.samplesPerFrame / fileInfo.format.nSamplesPerSec
  301.     GetDurationMs = fileInfo.framesCount * frameLength * 1000
  302.     
  303. End Function
  304.  
  305. ' // Get current bitrate.
  306. Public Function GetBitrate() As Long
  307.     
  308.     If curPosition < 0 Then Exit Function
  309.     GetBitrate = fileInfo.frameOffset(curPosition).bitrate
  310.     
  311. End Function
  312.  
  313. ' // If playback is active then true.
  314. Public Property Get IsPlaying() As Boolean
  315.     IsPlaying = init And loaded And playing And Not paused
  316. End Property
  317.  
  318. ' // Volume
  319. Public Property Get Volume() As Single
  320.     Dim dwVolume    As Long
  321.     Dim volLeft     As Long
  322.     Dim volRight    As Long
  323.     
  324.     waveOutGetVolume hWave, dwVolume
  325.     
  326.     volLeft = dwVolume And &HFFFF&
  327.     volRight = ((dwVolume And &HFFFF0000) \ &H10000) And &HFFFF&
  328.     
  329.     If volLeft > volRight Then Volume = volLeft / 65535 Else Volume = volRight / 65535
  330.     
  331. End Property
  332. Public Property Let Volume(ByVal value As Single)
  333.     Dim dwVolume    As Long
  334.     Dim volRight    As Long
  335.     
  336.     If value > 1 Or value <= 0 Then Err.Raise 6: Exit Property
  337.     
  338.     mVolume = value
  339.     
  340.     If mPan > 0 Then
  341.         volRight = value * 65535
  342.         dwVolume = volRight * (1 - mPan)
  343.     Else
  344.         dwVolume = value * 65535
  345.         volRight = dwVolume * (1 + mPan)
  346.     End If
  347.         
  348.     If volRight And &H8000& Then
  349.         dwVolume = dwVolume Or ((volRight And &H7FFF&) * &H10000) Or &H80000000
  350.     Else
  351.         dwVolume = dwVolume Or (volRight * &H10000)
  352.     End If
  353.     
  354.     waveOutSetVolume hWave, dwVolume
  355.     
  356. End Property
  357.  
  358. ' // Pan
  359. Public Property Get Pan() As Single
  360.     Dim dwVolume    As Long
  361.     Dim volLeft     As Long
  362.     Dim volRight    As Long
  363.     
  364.     waveOutGetVolume hWave, dwVolume
  365.     
  366.     volLeft = dwVolume And &HFFFF&
  367.     volRight = ((dwVolume And &HFFFF0000) \ &H10000) And &HFFFF&
  368.     If volLeft > volRight Then dwVolume = volLeft Else dwVolume = volRight
  369.     
  370.     If dwVolume = 0 Then dwVolume = 1
  371.     Pan = (volRight - volLeft) / dwVolume
  372.     
  373. End Property
  374. Public Property Let Pan(ByVal value As Single)
  375.     
  376.     If value > 1 Or value < -1 Then Err.Raise 6: Exit Property
  377.     
  378.     mPan = value
  379.     Me.Volume = mVolume
  380.     
  381. End Property
  382.  
  383. ' // Local procedures.
  384. Private Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  385.     Dim index   As Long
  386.     Dim lpData  As Long
  387.     Dim inIDE   As Boolean
  388.     
  389.     Debug.Assert MakeTrue(inIDE)
  390.     
  391.     If inIDE Then
  392.     
  393.         If Msg = WM_TIMER Then
  394.         
  395.             KillTimer hwnd, wParam
  396.             
  397.             For index = 0 To BUFFERS_COUNT - 1
  398.                 
  399.                 If headers(index).header.dwFlags And WHDR_DONE Then
  400.                     
  401.                     WriteNext index
  402.                     
  403.                 End If
  404.                 
  405.             Next
  406.             
  407.         End If
  408.         
  409.     End If
  410.     
  411.     If Msg = MM_WOM_DONE Then
  412.         
  413.         If wParam <> hWave Then GoTo DefCall
  414.         
  415.         GetMem4 ByVal lParam, lpData
  416.  
  417.         index = GetBufferIndex(lpData)
  418.  
  419.         If index = -1 Then GoTo DefCall
  420.         
  421.         WriteNext index
  422.         
  423.     End If
  424.     
  425. DefCall:
  426.     
  427.     If lpPrvProc Then
  428.         WndProc = CallWindowProc(lpPrvProc, hwnd, Msg, wParam, lParam)
  429.     Else
  430.         WndProc = DefWindowProc(hwnd, Msg, wParam, lParam)
  431.     End If
  432.     
  433. End Function
  434.  
  435. Private Sub WriteNext(ByVal index As Long)
  436.     
  437.     waveOutUnprepareHeader hWave, headers(index).header, Len(headers(index).header)
  438.     
  439.     If playing = False And paused = False Then Exit Sub
  440.     
  441.     If curPosition = -1 Then Exit Sub
  442.     
  443.     headers(index).header.dwFlags = headers(index).header.dwFlags And Not WHDR_DONE
  444.     headers(index).header.lpData = fileInfo.lpFrameOffset + fileInfo.frameOffset(curPosition).offset
  445.  
  446.     If curPosition < fileInfo.framesCount - 1 Then
  447.     
  448.         headers(index).header.dwBufferLength = fileInfo.frameOffset(curPosition + 1).offset - fileInfo.frameOffset(curPosition).offset
  449.         curPosition = curPosition + 1
  450.         
  451.     Else
  452.     
  453.         headers(index).header.dwBufferLength = fileInfo.szDataSize - fileInfo.frameOffset(curPosition).offset
  454.         
  455.         If isLoop Then
  456.             curPosition = 0
  457.         Else
  458.             curPosition = -1
  459.         End If
  460.             
  461.     End If
  462.     
  463.     waveOutPrepareHeader hWave, headers(index).header, Len(headers(index).header)
  464.     waveOutWrite hWave, headers(index).header, Len(headers(index).header)
  465.     
  466. End Sub
  467.  
  468. Private Sub ClearAll()
  469.     Dim index   As Long
  470.  
  471.     If hWave = 0 Then Exit Sub
  472.  
  473.     For index = 0 To BUFFERS_COUNT - 1
  474.  
  475.         If headers(index).status Then
  476.             waveOutUnprepareHeader hWave, headers(index).header, Len(headers(index).header)
  477.         End If
  478.  
  479.     Next
  480.     
  481.     If playing Or paused Then waveOutReset hWave
  482.     
  483.     waveOutClose hWave
  484.     
  485.     loaded = False
  486.     playing = False
  487.     paused = False
  488.     hWave = 0
  489.     
  490. End Sub
  491.  
  492. Private Function GetBufferIndex(ByVal ptr As Long) As Long
  493.     Dim index As Long
  494.  
  495.     For index = 0 To UBound(headers)
  496.  
  497.         If headers(index).header.lpData = ptr Then
  498.             GetBufferIndex = index
  499.             Exit Function
  500.         End If
  501.  
  502.     Next
  503.  
  504.     GetBufferIndex = -1
  505. End Function
  506.  
  507. Private Function Mp3GetInfo(ByVal lpData As Long, ByVal szData As Long, info As Mp3Info) As Boolean
  508.     Dim hdr(9)  As Byte
  509.     Dim size    As Long
  510.     
  511.     If szData >= 128 Then
  512.         ' Skip ID3V1 tag
  513.         memcpy hdr(0), ByVal lpData + szData - 128, 3
  514.         
  515.         If hdr(0) = &H54 And hdr(1) = &H41 And hdr(2) = &H47 Then
  516.             
  517.             szData = szData - 128
  518.             
  519.         End If
  520.         
  521.     End If
  522.     
  523.     ' Skip ID3V2 tags from beginning
  524.     memcpy hdr(0), ByVal lpData, 10
  525.     
  526.     If hdr(0) = &H49 And hdr(1) = &H44 And hdr(2) = &H33 Then
  527.         
  528.         ' footer present
  529.         If hdr(5) And &H10 Then
  530.             szData = szData - 10
  531.         End If
  532.     
  533.         size = hdr(6) * &H200000
  534.         size = size Or (hdr(7) * &H4000&)
  535.         size = size Or (hdr(8) * &H80&)
  536.         size = size Or hdr(9)
  537.         size = size + 10
  538.         
  539.         lpData = lpData + size
  540.         szData = szData - size
  541.             
  542.     Else
  543.         ' Skip ID3V2 tags from end
  544.         memcpy hdr(0), ByVal lpData + szData - 10, 10
  545.         
  546.         If hdr(2) = &H49 And hdr(1) = &H44 And hdr(0) = &H33 Then
  547.             
  548.             szData = szData - 10
  549.             
  550.             size = hdr(6) * &H200000
  551.             size = size Or (hdr(7) * &H4000&)
  552.             size = size Or (hdr(8) * &H80&)
  553.             size = size Or hdr(9)
  554.             size = size + 10
  555.         
  556.             szData = szData - size
  557.             
  558.         End If
  559.         
  560.     End If
  561.     
  562.     If szData < 4 Then Exit Function
  563.     
  564.     info.framesCount = 0
  565.     'Scan headers
  566.     Do
  567.         ' Find a frame sync
  568.         Do
  569.         
  570.             GetMem4 ByVal lpData, hdr(0)
  571.             
  572.             If hdr(0) = &HFF And (hdr(1) And &HE0) = &HE0 Then
  573.                 Dim vers    As Long
  574.                 Dim layer   As Long
  575.                 Dim bitrate As Long
  576.                 Dim smprate As Long
  577.                 Dim padding As Long
  578.                 Dim channel As Long
  579.                               
  580.                 vers = (hdr(1) And &H18) \ 8
  581.                 If vers = 1 Then Exit Function
  582.     
  583.                 layer = (hdr(1) And &H6) \ 2
  584.                 If layer <> 1 Then Exit Function ' Only Layer 3
  585.     
  586.                 If vers = 3 Then
  587.                     bitrate = constants.bitrate(0, (hdr(2) And &HF0) \ &H10)
  588.                 Else
  589.                     bitrate = constants.bitrate(1, (hdr(2) And &HF0) \ &H10)
  590.                 End If
  591.  
  592.                 If vers = 3 Then
  593.                     smprate = constants.smprate(0, (hdr(2) And &HC) \ &H4)
  594.                 ElseIf vers = 2 Then
  595.                     smprate = constants.smprate(1, (hdr(2) And &HC) \ &H4)
  596.                 Else
  597.                     smprate = constants.smprate(2, (hdr(2) And &HC) \ &H4)
  598.                 End If
  599.                 
  600.                 padding = (hdr(2) And &H2) \ 2
  601.                 channel = -(((hdr(3) And &HC0) \ 64) <> 3) + 1
  602.                 
  603.                 If vers = 3 Then
  604.                     size = Int(144000 * bitrate / smprate) + padding
  605.                 Else
  606.                     size = Int(72000 * bitrate / smprate) + padding
  607.                 End If
  608.                 
  609.                 With info
  610.                     If .framesCount = 0 Then
  611.  
  612.                         With .format
  613.                             .wFormatTag = WAVE_FORMAT_MPEGLAYER3
  614.                             .cbSize = MPEGLAYER3_WFX_EXTRA_BYTES
  615.                             .nChannels = channel
  616.                             .nAvgBytesPerSec = bitrate * 128
  617.                             .wBitsPerSample = 0
  618.                             .nBlockAlign = 1
  619.                             .nSamplesPerSec = smprate
  620.                             .nFramesPerBlock = 1
  621.                             .nCodecDelay = 0
  622.                             .fdwFlags = MPEGLAYER3_FLAG_PADDING_OFF
  623.                             .wID = MPEGLAYER3_ID_MPEG
  624.                             .nBlockSize = size
  625.                         End With
  626.                                         
  627.                         .lpFrameOffset = lpData
  628.                         .szDataSize = szData
  629.                         
  630.                         If vers = 3 Then
  631.                             .samplesPerFrame = 1152
  632.                         Else
  633.                             .samplesPerFrame = 576
  634.                         End If
  635.                         
  636.                         ReDim .frameOffset(511)
  637.                     
  638.                     Else
  639.                         
  640.                         If UBound(.frameOffset) = info.framesCount Then
  641.                             ReDim Preserve .frameOffset(UBound(.frameOffset) + 512)
  642.                         End If
  643.                         
  644.                     End If
  645.                     
  646.                     .frameOffset(info.framesCount).offset = lpData - .lpFrameOffset
  647.                     .frameOffset(info.framesCount).bitrate = bitrate
  648.                     
  649.                 End With
  650.                 
  651.                 lpData = lpData + size
  652.                 szData = szData - size
  653.                 
  654.                 Exit Do
  655.                 
  656.             End If
  657.             
  658.             lpData = lpData + 1
  659.             szData = szData - 1
  660.             
  661.         Loop While szData >= 4
  662.         
  663.         info.framesCount = info.framesCount + 1
  664.         
  665.     Loop While szData >= 4
  666.  
  667.     Mp3GetInfo = True
  668.     
  669. End Function
  670.  
  671. Private Function GetWindowAndHeap(l_hwnd As Long, l_hHeap As Long) As Boolean
  672.     Dim i1      As Long
  673.     Dim i2      As Long
  674.     Dim b       As Long
  675.     Dim arr(16) As Integer
  676.     
  677.     If GetEnvironmentVariable(StrPtr(Mp3Class), arr(0), 32) Then
  678.         
  679.         i1 = 0: i2 = 8
  680.         Do
  681.             If arr(i1) <= &H39 Then b = arr(i1) - &H30 Else b = arr(i1) - &H37
  682.             If l_hHeap And &H8000000 Then l_hHeap = ((l_hHeap And &H7FFFFF) * &H10 Or &H80000000) Or b Else l_hHeap = (l_hHeap * &H10) Or b
  683.             If arr(i2) <= &H39 Then b = arr(i2) - &H30 Else b = arr(i2) - &H37
  684.             If l_hwnd And &H8000000 Then l_hwnd = ((l_hwnd And &H7FFFFF) * &H10 Or &H80000000) Or b Else l_hwnd = (l_hwnd * &H10) Or b
  685.             i1 = i1 + 1: i2 = i2 + 1
  686.         Loop While i1 < 8
  687.         
  688.         GetWindowAndHeap = l_hwnd <> 0 And l_hHeap <> 0
  689.         
  690.     End If
  691.  
  692. End Function
  693.  
  694. Private Function SaveWindowAndHeap(ByVal l_hwnd As Long, ByVal l_hHeap As Long) As Boolean
  695.     Dim i1      As Long
  696.     Dim i2      As Long
  697.     Dim b       As Long
  698.     Dim arr(16) As Integer
  699.     
  700.     i1 = 7: i2 = 15
  701.     Do
  702.         b = l_hHeap And &HF
  703.         If b < 10 Then arr(i1) = b + &H30 Else arr(i1) = b + &H37
  704.         b = l_hwnd And &HF
  705.         If b < 10 Then arr(i2) = b + &H30 Else arr(i2) = b + &H37
  706.         l_hHeap = (l_hHeap And &HFFFFFFF0) \ &H10
  707.         l_hwnd = (l_hwnd And &HFFFFFFF0) \ &H10
  708.         i1 = i1 - 1: i2 = i2 - 1
  709.     Loop While i1 >= 0
  710.  
  711.     SaveWindowAndHeap = SetEnvironmentVariable(StrPtr(Mp3Class), arr(0))
  712.     
  713. End Function
  714.  
  715. Private Sub Class_Initialize()
  716.     Dim cls     As WNDCLASSEX
  717.     Dim b       As curBuffer
  718.     Dim isFirst As Boolean
  719.     Dim inIDE   As Boolean
  720.     Dim AsmSize As Long
  721.     Dim lpAsm   As Long
  722.     Dim lpFlag  As Long
  723.     
  724.     b.b(0) = 450377142658.6656@:    b.b(1) = 900743977448.248@:     b.b(2) = 1351114248211.6672@
  725.     b.b(3) = 1801487954948.9248@:   b.b(4) = 2702228496423.3344@:   b.b(5) = 3602975909897.8496@
  726.     b.b(6) = 4503737067267.712@:    b.b(7) = 18941235272.0895@:     b.b(8) = 4735201446.045@
  727.     b.b(9) = 10307921515.2@:        b.b(10) = 13743895348.4@:       b.b(11) = 3435973838.4@
  728.         
  729.     memcpy constants.bitrate(0, 1), b.b(0), 96
  730.     
  731.     ReDim headers(BUFFERS_COUNT - 1)
  732.     mVolume = 1
  733.     
  734.     isFirst = Not GetWindowAndHeap(hwnd, hHeap)
  735.  
  736.     Debug.Assert MakeTrue(inIDE)
  737.     
  738.     If inIDE Then
  739.     
  740.         Dim hInstVB6    As Long
  741.         Dim lpEbMode    As Long
  742.         Dim hInstUser32 As Long
  743.         Dim lpDefProc   As Long
  744.         Dim lpSetTimer  As Long
  745.         Dim clearFlag   As Long
  746.         
  747.         AsmSize = &H5D
  748.         
  749.         hInstVB6 = GetModuleHandle(StrPtr("vba6"))
  750.         hInstUser32 = GetModuleHandle(StrPtr("user32"))
  751.         
  752.         lpEbMode = GetProcAddress(hInstVB6, "EbMode")
  753.         lpDefProc = GetProcAddress(hInstUser32, "DefWindowProcW")
  754.         lpSetTimer = GetProcAddress(hInstUser32, "SetTimer")
  755.  
  756.         b.b(0) = 108086391056893.4787@:   b.b(1) = -481036337152.3195@:     b.b(2) = -396370043377935.9745@:
  757.         b.b(3) = 55020249744.3444@:       b.b(4) = -172483857236981.0944@:  b.b(5) = -5287104741.3804@:
  758.         b.b(6) = -165732466287194.9313@:  b.b(7) = -802975918315693.6764@:  b.b(8) = 522808547116743.0705@:
  759.         b.b(9) = 756460491841765.3508@:   b.b(10) = -9685956558.8481@:      b.b(11) = 28117.2223@:
  760.  
  761.         If isFirst Then
  762.             
  763.             lpFlag = HeapAlloc(GetProcessHeap(), HEAP_NO_SERIALIZE Or HEAP_ZERO_MEMORY, 4)
  764.             If lpFlag = 0 Then Exit Sub
  765.         
  766.         Else
  767.             
  768.             lpFlag = GetWindowLong(hwnd, 0)
  769.             
  770.             GetMem4 ByVal lpFlag, clearFlag
  771.             
  772.             If clearFlag Then
  773.                 
  774.                 DestroyWindow hwnd
  775.                 HeapDestroy hHeap
  776.                 UnregisterClass StrPtr(Mp3Class), App.hInstance
  777.                 
  778.                 GetMem4 0&, ByVal lpFlag
  779.                 isFirst = True
  780.                 
  781.                 hwnd = 0
  782.                 hHeap = 0
  783.                 
  784.                 SaveWindowAndHeap 0, 0
  785.                 
  786.             End If
  787.             
  788.         End If
  789.  
  790.     Else
  791.         
  792.         AsmSize = &H20
  793.         
  794.         b.b(0) = 522808547116743.0705@:   b.b(1) = 756460491841765.3508@:   b.b(2) = -7926737954.4065@
  795.         b.b(3) = 28117.2223@
  796.         
  797.     End If
  798.     
  799.     If isFirst Then
  800.     
  801.         hHeap = HeapCreate(HEAP_CREATE_ENABLE_EXECUTE Or HEAP_NO_SERIALIZE, 0, 0)
  802.         If hHeap = 0 Then Exit Sub
  803.         
  804.     End If
  805.     
  806.     lpAsm = HeapAlloc(hHeap, HEAP_NO_SERIALIZE, AsmSize)
  807.     
  808.     If lpAsm = 0 Then
  809.         If isFirst Then HeapDestroy hHeap
  810.         Exit Sub
  811.     End If
  812.     
  813.     lpWndProc = lpAsm
  814.  
  815.     memcpy ByVal lpAsm, b.b(0), AsmSize
  816.  
  817.     If inIDE Then
  818.     
  819.         GetMem4 lpEbMode - lpAsm - &H12, ByVal lpAsm + &HE              ' Call EbMode
  820.         GetMem4 lpSetTimer - (lpAsm + &H2C), ByVal lpAsm + &H28         ' Call SetTimer
  821.         GetMem4 lpDefProc - (lpAsm + &HD), ByVal lpAsm + &H9            ' Jz   DefWindowProcW
  822.         GetMem4 lpDefProc - (lpAsm + &H31), ByVal lpAsm + &H2D          ' Jmp  DefWindowProcW
  823.         GetMem4 lpDefProc - (lpAsm + &H3C), ByVal lpAsm + &H38          ' Jmp  DefWindowProcW
  824.         GetMem4 lpFlag, ByVal lpAsm + &H2                               ' Cmp [flag], 0
  825.         GetMem4 lpFlag, ByVal lpAsm + &H33                              ' Inc [flag]
  826.         
  827.         lpAsm = lpAsm + &H40
  828.         
  829.     End If
  830.     
  831.     Dim lpMeth      As Long
  832.     Dim vTable      As Long
  833.     
  834.     GetMem4 ByVal ObjPtr(Me), vTable
  835.     GetMem4 ByVal vTable + WNDPROCINDEX * 4 + &H1C, lpMeth
  836.     GetMem4 ObjPtr(Me), ByVal lpAsm + &H10                             ' Push Me
  837.     GetMem4 lpMeth - (lpAsm + &H14) - 5, ByVal lpAsm + &H14 + 1        ' Call WndProc
  838.         
  839.     If isFirst Then
  840.     
  841.         cls.hInstance = App.hInstance
  842.         cls.lpfnwndproc = lpWndProc
  843.         cls.lpszClassName = StrPtr(Mp3Class)
  844.         cls.cbSize = Len(cls)
  845.         cls.cbWndExtra2 = 8
  846.         
  847.         If RegisterClassEx(cls) = 0 Then
  848.   
  849.             HeapDestroy hHeap
  850.             Exit Sub
  851.  
  852.         End If
  853.         
  854.         hwnd = CreateWindowEx(0, StrPtr(Mp3Class), 0, 0, 0, 0, 0, 0, HWND_MESSAGE, 0, App.hInstance, ByVal 0&)
  855.         If hwnd = 0 Then Exit Sub
  856.         
  857.         SaveWindowAndHeap hwnd, hHeap
  858.         
  859.         If inIDE Then Call SetWindowLong(hwnd, 0, lpFlag)
  860.     
  861.     Else
  862.         
  863.         lpPrvProc = SetWindowLong(hwnd, GWL_WNDPROC, lpWndProc)
  864.         SetWindowLong hwnd, GWL_USERDATA, GetWindowLong(hwnd, GWL_USERDATA) + 1
  865.         
  866.     End If
  867.     
  868.     init = True
  869.     
  870. End Sub
  871.  
  872. Private Sub Class_Terminate()
  873.     Dim refCt   As Long
  874.     
  875.     If Not init Then Exit Sub
  876.     
  877.     refCt = GetWindowLong(hwnd, GWL_USERDATA)
  878.     
  879.     If refCt = 0 Then
  880.     
  881.         DestroyWindow hwnd
  882.         HeapDestroy hHeap
  883.         UnregisterClass StrPtr(Mp3Class), App.hInstance
  884.         SaveWindowAndHeap 0, 0
  885.         
  886.     Else
  887.         
  888.         SetWindowLong hwnd, GWL_WNDPROC, lpPrvProc
  889.         SetWindowLong hwnd, GWL_USERDATA, refCt - 1
  890.         HeapFree hHeap, HEAP_NO_SERIALIZE, ByVal lpWndProc
  891.         
  892.     End If
  893.     
  894. End Sub
  895.  
  896. Private Function MakeTrue(refBool As Boolean) As Boolean
  897.     MakeTrue = True
  898.     refBool = True
  899. End Function
Миниатюры Вложения
Метки: Нет Добавить / редактировать метки
Категории
Visual Basic 6.0

Комментарии

  1. Аватар для playfortuna
  2. Аватар для FelixMacintosh
    GetMem4, GetMem8 у этого человека абсолютный талант.
    Если честно, раньше я думал что только я на это способен ))
  3. Аватар для FelixMacintosh
    Позже я продемонстрирую свои штуки