Форум программистов [Powered by Invision Power Board]

Код
Option Explicit
 
Private Type MMCKINFO
    ckid As Long
    ckSize As Long
    fccType As Long
    dwDataOffset As Long
    dwFlags As Long
End Type
Public Type WAVEFORMAT
    wFormatTag As Integer
    nChannels As Integer
    nSamplesPerSec As Long
    nAvgBytesPerSec As Long
    nBlockAlign As Integer
    wBitsPerSample As Integer
    cbSize As Integer
End Type
 
Private Declare Function mmioClose Lib "winmm.dll" (ByVal hmmio As Long, ByVal uFlags As Long) As Long
Private Declare Function mmioDescend Lib "winmm.dll" (ByVal hmmio As Long, lpck As MMCKINFO, lpckParent As Any, ByVal uFlags As Long) As Long
Private Declare Function mmioOpen Lib "winmm.dll" Alias "mmioOpenA" (ByVal szFileName As String, lpmmioinfo As Any, ByVal dwOpenFlags As Long) As Long
Private Declare Function mmioRead Lib "winmm.dll" (ByVal hmmio As Long, pch As Any, ByVal cch As Long) As Long
Private Declare Function mmioStringToFOURCC Lib "winmm.dll" Alias "mmioStringToFOURCCA" (ByVal sz As String, ByVal uFlags As Long) As Long
Private Declare Function mmioAscend Lib "winmm.dll" (ByVal hmmio As Long, lpck As MMCKINFO, ByVal uFlags As Long) As Long
 
Private Const MMIO_READ = &H0
Private Const MMIO_FINDCHUNK = &H10
Private Const MMIO_FINDRIFF = &H20
 
Public Format As WAVEFORMAT             ' Формат файла
Public WaveData() As Integer            ' Данные звукового файла
Public Offset As Long                   ' Смещение данных относительно начала файла
' Открытие Wav файла
Public Function ReadWaveFile(FileName As String) As Boolean
    Dim hIn As Long, ret As Long, Inf As MMCKINFO, sInf As MMCKINFO, ct As Long
    
    hIn = mmioOpen(FileName, ByVal 0, MMIO_READ)            ' Открываем файл
    If (hIn = 0) Then MsgBox "Ошибка открытия файла": Exit Function
 
    Inf.fccType = mmioStringToFOURCC("WAVE", 0)             ' Проверка является ли вав файлом
    If mmioDescend(hIn, Inf, ByVal 0, MMIO_FINDRIFF) Then _
        mmioClose hIn, 0: MsgBox "Не являеться звуковым файлом": Exit Function
    sInf.ckid = mmioStringToFOURCC("fmt", 0)                 ' Ишем чанк с форматом
    If mmioDescend(hIn, sInf, Inf, MMIO_FINDCHUNK) Then _
        mmioClose hIn, 0: MsgBox "Не найден чанк с форматом": Exit Function
    ' Проверяем размер формата
    If sInf.ckSize > Len(Format) Then _
        mmioClose hIn, 0: MsgBox "Не поддерживаемый формат": Exit Function
    ' Читаем формат
    If mmioRead(hIn, Format, sInf.ckSize) = -1 Then _
        mmioClose hIn, 0: MsgBox "Не возможно прочитать формат": Exit Function
        
    mmioAscend hIn, sInf, 0
    
    If Format.wBitsPerSample <> 16 Then _
        mmioClose hIn, 0: MsgBox "Поддерживается только 16 бит на семпл": Exit Function
    ' Ищем чанк с данными
    sInf.ckid = mmioStringToFOURCC("data", 0)
    If mmioDescend(hIn, sInf, Inf, MMIO_FINDCHUNK) Then _
        mmioClose hIn, 0: MsgBox "Не найдены данные в вав файле ": Exit Function
    
    ct = sInf.ckSize \ 2        ' Получаем количество выборок
    If ct = 0 Then mmioClose hIn, 0: MsgBox "Нулевой размер файла": Exit Function
    
    ReDim WaveData(ct - 1)      ' Выделяем буфер
    
    Offset = sInf.dwDataOffset  ' Указываем смещение
    
    If mmioRead(hIn, WaveData(0), sInf.ckSize) = -1 Then _
        mmioClose hIn, 0: MsgBox "Не возможно прочитать данные": Exit Function
        
    mmioClose hIn, 0                                        ' Закрываем файл
    
    ReadWaveFile = True
End Function