[RESOLVED] How to get a pointer to an element in a byte array?-VBForums
Results 1 to 9 of 9

Thread: [RESOLVED] How to get a pointer to an element in a byte array?

  1. #1

    Thread Starter
    Fanatic Member
    Join Date
    Sep 2012
    Posts
    814

    Resolved [RESOLVED] How to get a pointer to an element in a byte array?

    When I got a pointer to a byte array, how to get a pointer to an element in this byte array? For example:

    If the pointer to arrBytes(0) is 10000, then what is the pointer to the 44th element arrBytes(44)?

    Description:
    This question is a continuation of another thread:
    http://www.vbforums.com/showthread.p...array-variable

    When I get a pointer to a byte array, I need to do two actions on this array:
    (1) Write a wav file header(it has 44 bytes) into this byte array. (This step has been completed)

    (2) Write wav data, starting from the 44th byte of the byte array.

    Because it is written through mmioRead API, I need to know the 44th byte pointer (memory address) of the byte array.

    Edit:
    Byte-array will be saved into the database
    Last edited by dreammanor; Jan 12th, 2018 at 01:57 AM.

  2. #2
    Fanatic Member
    Join Date
    Feb 2015
    Posts
    960

    Re: How to get a pointer to an element in a byte array?

    If the pointer to arrBytes(0) is 10000, then what is the pointer to the 44th element arrBytes(44)?
    10044
    When I get a pointer to a byte array, I need to do two actions on this array:
    (1) Write a wav file header(it has 44 bytes) into this byte array.
    (This step has been completed)

    (2) Write wav data, starting from the 44th byte of the byte array.
    Because it is written through mmioRead API, I need to know the 44th byte pointer (memory address) of the byte array.
    Don't. You can just use MMIO functions. I show you the code from TrickComposer to export a wave file to the file (you can change it to export to byte array without problem). It also store the tags of song you can remove/change:

    Code:
    Public Function ExportToWave( _
                    ByVal curSong As Song, _
                    ByRef fileName As String) As Boolean
        Dim Ret         As Long
        Dim hWave       As Long
        Dim chkRIFF     As MMCKINFO
        Dim chkData     As MMCKINFO
        Dim chkList     As MMCKINFO
        Dim chkSub      As MMCKINFO
        Dim dstFormat   As WAVEFORMATEX
        Dim buffer()    As Integer
        Dim Year        As String
    
        SetProgressState frmMain, TBPF_NORMAL
        
        curSong.SetPos 0
    
        dstFormat.wFormatTag = 1
        dstFormat.wBitsPerSample = 16
        dstFormat.nSamplesPerSec = curSong.SampleRate
        dstFormat.nChannels = 2
        dstFormat.nBlockAlign = (dstFormat.wBitsPerSample \ 8) * dstFormat.nChannels
        dstFormat.nAvgBytesPerSec = dstFormat.nBlockAlign * dstFormat.nSamplesPerSec
        
        If Len(Dir$(fileName)) Then Kill fileName
        
        ' // Create wave file
        hWave = mmioOpen(fileName, ByVal 0&, MMIO_WRITE Or MMIO_CREATE)
        If hWave = 0 Then
            MsgBox "Error creating wave file"
            GoTo ExitExport
        End If
        
        ' // Create RIFF-WAVE chunk
        chkRIFF.fccType = mmioStringToFOURCC("WAVE", 0)
        If mmioCreateChunk(hWave, chkRIFF, MMIO_CREATERIFF) Then
            mmioClose hWave
            MsgBox "Error creating RIFF-WAVE chunk"
            GoTo ExitExport
        End If
            
        ' // Create fmt chunk
        chkData.ckid = mmioStringToFOURCC("fmt", 0)
        If mmioCreateChunk(hWave, chkData, 0) Then
            mmioClose hWave
            MsgBox "Error creating fmt chunk"
            GoTo ExitExport
        End If
        
        ' // Write format
        If mmioWrite(hWave, dstFormat, Len(dstFormat)) = -1 Then
            mmioClose hWave
            MsgBox "Error writing format"
            GoTo ExitExport
        End If
        
        ' // Update fmt-chunk size
        mmioAscend hWave, chkData, 0
        
        ' // Create data chunk
        chkData.ckid = mmioStringToFOURCC("data", 0)
        If mmioCreateChunk(hWave, chkData, 0) Then
            mmioClose hWave
            MsgBox "Error creating data chunk"
            GoTo ExitExport
        End If
    
        ReDim buffer(12000 - 1)
        
        ' // Write pause
        If mmioWrite(hWave, buffer(0), (UBound(buffer) + 1) * Len(buffer(0))) = -1 Then
            mmioClose hWave
            MsgBox "Error writing data"
            GoTo ExitExport
        End If
    
        Do While curSong.GetPos <= curSong.SongDuration
    
            DoEvents
    
            curSong.Play buffer()
    
            ' // Write data
            If mmioWrite(hWave, buffer(0), (UBound(buffer) + 1) * Len(buffer(0))) = -1 Then
                mmioClose hWave
                MsgBox "Error writing data"
                GoTo ExitExport
            End If
    
            ZeroMemory buffer(0), (UBound(buffer) + 1) * Len(buffer(0))
            
            SetProgressValue frmMain, curSong.GetPos() / curSong.SongDuration()
            
            'frmMain.picProgress.Line (0, 0)-(curSong.GetPos(), 1), vbRed, BF
    
        Loop
           
        ' // Update data-chunk size
        mmioAscend hWave, chkData, 0
        
        ' // Create LIST chunk
        chkList.fccType = mmioStringToFOURCC("INFO", 0)
        If mmioCreateChunk(hWave, chkList, MMIO_CREATELIST) Then
            mmioClose hWave
            MsgBox "Error creating LIST-INFO chunk"
            GoTo ExitExport
        End If
        
        ' // Create IART chunk
        chkSub.ckid = mmioStringToFOURCC("IART", 0)
        If mmioCreateChunk(hWave, chkSub, 0) Then
            mmioClose hWave
            MsgBox "Error creating IART chunk"
            GoTo ExitExport
        End If
        
        ' // Write IART
        If mmioWrite(hWave, ByVal StrPtr(StrConv(ARTIST_NAME, vbFromUnicode)), Len(ARTIST_NAME)) = -1 Then
            mmioClose hWave
            MsgBox "Error writing IART"
            GoTo ExitExport
        End If
        
        ' // Update IART-chunk size
        mmioAscend hWave, chkSub, 0
        
        Year = CStr(DateTime.Year(Now))
        
        ' // Create ICRD chunk
        chkSub.ckid = mmioStringToFOURCC("ICRD", 0)
        If mmioCreateChunk(hWave, chkSub, 0) Then
            mmioClose hWave
            MsgBox "Error creating ICRD chunk"
            GoTo ExitExport
        End If
        
        ' // Write ICRD
        If mmioWrite(hWave, ByVal StrPtr(StrConv(Year, vbFromUnicode)), Len(Year)) = -1 Then
            mmioClose hWave
            MsgBox "Error writing ICRD"
            GoTo ExitExport
        End If
        
        ' // Update ICRD-chunk size
        mmioAscend hWave, chkSub, 0
        
        ' // Create IGNR chunk
        chkSub.ckid = mmioStringToFOURCC("IGNR", 0)
        If mmioCreateChunk(hWave, chkSub, 0) Then
            mmioClose hWave
            MsgBox "Error creating IGNR chunk"
            GoTo ExitExport
        End If
        
        ' // Write IGNR
        If mmioWrite(hWave, ByVal StrPtr(StrConv(GENRE_NAME, vbFromUnicode)), Len(GENRE_NAME)) = -1 Then
            mmioClose hWave
            MsgBox "Error writing IGNR"
            GoTo ExitExport
        End If
        
        ' // Update IGNR-chunk size
        mmioAscend hWave, chkSub, 0
        
        ' // Create INAM chunk
        chkSub.ckid = mmioStringToFOURCC("INAM", 0)
        If mmioCreateChunk(hWave, chkSub, 0) Then
            mmioClose hWave
            MsgBox "Error creating INAM chunk"
            GoTo ExitExport
        End If
        
        ' // Write INAM
        If mmioWrite(hWave, ByVal StrPtr(StrConv(curSong.Name, vbFromUnicode)), Len(curSong.Name)) = -1 Then
            mmioClose hWave
            MsgBox "Error writing INAM"
            GoTo ExitExport
        End If
        
        ' // Update INAM-chunk size
        mmioAscend hWave, chkSub, 0
        
        ' // Update LIST-chunk size
        mmioAscend hWave, chkList, 0
        
        ' // Update RIFF-chunk size
        mmioAscend hWave, chkRIFF, 0
    
        ExportToWave = True
        
    ExitExport:
        
        mmioClose hWave
        
        SetProgressState frmMain, TBPF_NOPROGRESS
    
    End Function

  3. #3

    Thread Starter
    Fanatic Member
    Join Date
    Sep 2012
    Posts
    814

    Re: How to get a pointer to an element in a byte array?

    Sorry, I didn't make the question clear. I need to save a paragraph of a wav file as binary data into the database, and in the future this section of wave data could be read out and play. So, I wrote the following function:

    Code:
    Private Function ReadToByteArr(arrByte, Optional ByVal nStart_Sample As Long = 0, _
                                               Optional ByVal nEnd_Sample As Long = -1) As Boolean
        If nStart_Sample < 0 Or nEnd_Sample <= nStart_Sample Then Exit Function
        If VarType(arrByte) = vbString Then Exit Function
        
        Dim nBeginPos As Long:           Dim lpArrBytePtr As Long
        Dim nDataSize As Long
    
        ReDim arrByte(44 - 1) As Byte
                
        mmioSeek m_hInput, 0, SEEK_SET
                
        lpArrBytePtr = VarPtrVar(arrByte)
        
        '--- Write Wave Header ---
        If mmioRead(m_hInput, lpArrBytePtr, 44) = -1 Then
            MsgBox "Can't read wave header data":           Exit Function
        End If
        
        nDataSize = (nEnd_Sample - nStart_Sample) * 4
        nBeginPos = UBound(arrByte) + 1
        ReDim Preserve arrByte(nBeginPos + nDataSize - 1) As Byte
        
        '--- Seek Absolute
        mmioSeek m_hInput, (nStart_Sample * 4) + 44, SEEK_SET
       
        '--- Write wave data ---                             
        lpArrBytePtr = VarPtrVar(arrByte) + nBeginPos
        If mmioRead(m_hInput, lpArrBytePtr, nDataSize) = -1 Then
            MsgBox "Can't read wave data":           Exit Function
        End If
                                                
        ReadToByteArr = True
        
    End Function
    But writing data to the byte-array was not successfully, the problem is in the red line of the above source code.
    Last edited by dreammanor; Jan 12th, 2018 at 03:01 AM.

  4. #4
    Fanatic Member
    Join Date
    Feb 2015
    Posts
    960

    Re: How to get a pointer to an element in a byte array?

    dreammanor, you can use MMIO functions and parse all RIFF file to know format, data, tags etc because a RIFF file can contain data or format into other positions. You can use mmioDescend to search WAVE and fmt chunks and from given nBlockAlign you can calculate offset in bytes within data chunk.
    To make the file in memory you also can use MMIO functions. mmioCreateChunk to create a WAVE and fmt chunks and copy data from first file (from database) to new in-memory-file.
    You should make the same actions for data chunk. To update fields you just use mmioAscend function that store size of chunk.

  5. #5

    Thread Starter
    Fanatic Member
    Join Date
    Sep 2012
    Posts
    814

    Re: How to get a pointer to an element in a byte array?

    Hi The trick, thanks for your advice. The function that I want to realize now is: How to use mmioRead to read a piece of wave data into a byte-array. I guess it should be done with array-pointer.

    Edit:
    I think of another way, that is, write the file-header to buffer1, then write the wave data to buffer2, and then merge buffer1 and buffer2 into buffer3 (or attach buffer2 to buffer1). But in this case, the speed will be much slower.
    Last edited by dreammanor; Jan 12th, 2018 at 03:10 AM.

  6. #6
    PowerPoster
    Join Date
    Jun 2013
    Posts
    3,553

    Re: How to get a pointer to an element in a byte array?

    Quote Originally Posted by dreammanor View Post
    The function that I want to realize now is:
    How to use mmioRead to read a piece of wave data into a byte-array.
    I guess it should be done with array-pointer.

    Edit:
    I think of another way, that is, write the file-header to buffer1, then write the wave data to buffer2, and then merge buffer1 and buffer2 into buffer3 (or attach buffer2 to buffer1). But in this case, the speed will be much slower.
    A few years ago, I wrote a little WavInfo-Class, which works (RC5-) Stream-Based -
    and it parses out all the Info from a *.wav-file without using the mmio-API.

    Beside the usual Wav-Format-Fields, it also gives reliable info about the Offset to the real PCM-Data
    (which does not necessarily need to start at offset 44).

    Here it is (I named it cWavInfo):
    Code:
    Option Explicit 'RC5-cStream-based Wav-info-reader (Author Olaf Schmidt, 2012)
    
    'precalculated FourCCs
    Private Const RIFF As Long = &H46464952, Wave As Long = &H45564157
    Private Const data As Long = &H61746164, FMT_ As Long = &H20746D66
    
    Private Type tRiffChunk
      ID As Long
      Size As Long
    End Type
    Private Type tWaveHeader
      RiffChunk As tRiffChunk
      RiffChunkFormat As Long
      RiffSubChunk As tRiffChunk
      WaveAudioFormat As Integer
      WaveNumChannels As Integer
      WaveSampleRate As Long
      WaveByteRate As Long
      WaveBlockAlign As Integer
      WaveBitsPerSample As Integer
      cbSize   As Integer
      wValidBitsPerSample   As Integer
      dwChannelMask   As Long
      SubFormat(0 To 7) As Integer
    End Type
    
    Private Header As tWaveHeader
    Private mWaveMSec As Long, mWaveSamples As Long, mWaveDataOffs As Long, mWaveDataLen As Long
    
    Public Sub ReadWaveInfoFromStream(Strm As cStream)
    Dim Pos As Long, RiffChunk As tRiffChunk, EmptyHeader As tWaveHeader
      Header = EmptyHeader
      mWaveMSec = 0:     mWaveSamples = 0
      mWaveDataOffs = 0: mWaveDataLen = 0
       Strm.SetPosition 0
       Strm.ReadToPtr VarPtr(Header), Len(Header)
       If Header.RiffChunk.ID <> RIFF Then Err.Raise vbObjectError, , "The file is not in RIFF format."
       If Header.RiffChunkFormat <> Wave Then Err.Raise vbObjectError, , "The file is in RIFF format but is not a WAVE file."
    
       Do Until Header.RiffSubChunk.ID = FMT_
          Pos = Pos + Len(RiffChunk) + Header.RiffSubChunk.Size
          If Pos <= 0 Or Pos >= Strm.GetSize Then Err.Raise vbObjectError, , "The file is a WAVE file, but the header is corrupt."
          Strm.SetPosition Pos
          Strm.ReadToPtr VarPtr(Header), Len(Header)
       Loop
    
       Strm.SetPosition Pos + 20 + Header.RiffSubChunk.Size
       Strm.ReadToPtr VarPtr(RiffChunk), Len(RiffChunk)
    
       Do Until RiffChunk.ID = data
         Strm.SetPosition RiffChunk.Size, STRM_SeekFromCurPos
         If Strm.GetPosition = Strm.GetSize Then Err.Raise vbObjectError, , "The file is in RIFF format but is not a WAVE file."
         Strm.ReadToPtr VarPtr(RiffChunk), Len(RiffChunk)
       Loop
       
       If Header.RiffSubChunk.Size = 40 Then
         Header.WaveAudioFormat = Header.SubFormat(0)
       Else
         Header.wValidBitsPerSample = Header.WaveBitsPerSample
       End If
       
       mWaveDataLen = RiffChunk.Size
       mWaveDataOffs = Strm.GetPosition
        
       mWaveSamples = mWaveDataLen / Header.WaveNumChannels / (Header.WaveBitsPerSample / 8)
       mWaveMSec = (mWaveSamples / Header.WaveSampleRate) * 1000
    End Sub
     
    Public Property Get AudioFormat() As Long
      AudioFormat = Header.WaveAudioFormat
    End Property
    Public Property Get AudioFormatString() As String
      AudioFormatString = Choose(AudioFormat + 1, "Unknown", "PCM", "ADPCM", "IEEE_FLOAT")
    End Property
    
    Public Property Get Channels() As Integer
      Channels = Header.WaveNumChannels
    End Property
    
    Public Property Get SampleRate() As Long
      SampleRate = Header.WaveSampleRate
    End Property
    
    Public Property Get ByteRate() As Long
      ByteRate = Header.WaveByteRate
    End Property
     
    Public Property Get BitsPerSample() As Integer
      BitsPerSample = Header.WaveBitsPerSample
    End Property
    
    Public Property Get BlockAlign() As Integer
      BlockAlign = Header.WaveBlockAlign
    End Property
    
    Public Property Get ValidBitsPerSample() As Integer
      ValidBitsPerSample = Header.wValidBitsPerSample
    End Property
    
    Public Property Get Samples() As Long
      Samples = mWaveSamples
    End Property
    
    Public Property Get DataOffs() As Long
      DataOffs = mWaveDataOffs
    End Property
    Public Property Get DataLen() As Long
      DataLen = mWaveDataLen
    End Property
    Public Property Get DataLenSec() As Double
      DataLenSec = mWaveMSec / 1000
    End Property
    Public Property Get DataLen_msec() As Long
      DataLen_msec = mWaveMSec
    End Property
    And if your intent is, to describe (and later play) shorter "Selection-Snippets" from a larger Wav-File,
    you could use a cSelection-Class like the following (which has 4 Read/Write-Props and 2 "calculated ones"):

    Code:
    Option Explicit
    
    Public StreamTotalLengthSec As Double, StartPerc As Double, EndPerc As Double, Text As String
     
    Public Property Get StreamOffsetSeconds() As Double
      StreamOffsetSeconds = StartPerc * StreamTotalLengthSec
    End Property
    
    Public Property Get LengthSeconds() As Double
      LengthSeconds = EndPerc * StreamTotalLengthSec - StreamOffsetSeconds
    End Property
    Well, once you're "armed" with the two little Classes above, the remaining Form-Demo-Code becomes as simple as that:
    (define a Wav-File of your choice in Form_Load, and then click the Form).
    Code:
    Option Explicit
     
    Private Declare Function PlaySound& Lib "winmm" (data As Any, Optional ByVal hMod&, Optional ByVal Flags& = 5)
    
    Private Stream As cStream, WavInfo As New cWavInfo
    
    Private Sub Form_Load()
      Set Stream = New_c.FSO.OpenFileStream("c:\temp\SampleLoop.wav")
      WavInfo.ReadWaveInfoFromStream Stream
    End Sub
     
    Private Sub Form_Click()
      'init a Selection-Object with the Duration from cWavInfo and a Percent-Range
      Dim Sel As New cSelection
          Sel.StreamTotalLengthSec = WavInfo.DataLenSec
          Sel.StartPerc = 0.15
          Sel.EndPerc = 0.35
          
      'now play the selection-snippet
      PlaySelection Sel, WavInfo
    End Sub
    
    Public Sub PlaySelection(Sel As cSelection, WavInfo As cWavInfo)
      If Sel Is Nothing Or Stream Is Nothing Then Exit Sub
      With WavInfo
        Dim B() As Byte: B = "" 'init B to an empty Array
        Stream.SetPosition .DataOffs + Int(Sel.StreamOffsetSeconds * .SampleRate) * .BlockAlign
        Stream.ReadToByteArr B, Int(Sel.LengthSeconds * .SampleRate) * .BlockAlign
        PlayWavBuf .SampleRate, .Channels, .BitsPerSample, B
      End With
    End Sub
    
    Public Sub PlayWavBuf(ByVal Freq As Long, ByVal Channels As Long, ByVal Bits As Long, WavBuf() As Byte)
      PlaySound ByVal 0& 'cancel any (potentially) still asynchronously playing sounds
      Static B() As Byte
      Dim WavBufLen As Long, Strm As cStream
          WavBufLen = UBound(WavBuf) + 1
      
      Set Strm = New_c.Stream 'let's create an InMemory-Stream
          Strm.WriteFromByteArr StrConv("RIFF    WAVEfmt                     data    ", vbFromUnicode)
          Strm.WriteFromByteArr WavBuf
          Strm.SetPosition 4:  Strm.WriteFromPtr VarPtr(WavBufLen + 36), 4 'FileSize (without the 8 Riff-Hdr-Bytes)
          Strm.SetPosition 16: Strm.WriteFromPtr VarPtr(16&), 4            'Format-Data-Length
          Strm.WriteFromPtr VarPtr(1 + 65536 * Channels), 4                'PCM=1 + Channels
          Strm.WriteFromPtr VarPtr(Freq), 4                                'Samples per second
          Strm.WriteFromPtr VarPtr(Freq * Channels * Bits \ 8), 4          'Bytes per second
          Strm.WriteFromPtr VarPtr(Channels * Bits \ 8 + 65536 * Bits), 4  'Bytes per Sample + Bits
          Strm.SetPosition 40: Strm.WriteFromPtr VarPtr(WavBufLen), 4      'Wav-Data-length
          Strm.SetPosition 0 'prepare for a re-read of the whole stream (now including the header)
       If Strm.ReadToByteArr(B) Then PlaySound B(0) 'read and finally play the (now wav-hdr-prefixed) buffer
    End Sub
     
    Private Sub Form_Terminate()
      PlaySound ByVal 0& 'cancel any (potentially) still asynchronously playing sounds
      New_c.CleanupRichClientDll
    End Sub
    The above PlaySelection-Function (which works in conjunction with the WavInfo-Class and the RC5-cStream-Class),
    answers a lot of your recent questions I assume.

    HTH

    Olaf

  7. #7
    Fanatic Member
    Join Date
    Feb 2015
    Posts
    960

    Re: How to get a pointer to an element in a byte array?

    Code:
    Option Explicit
    
    Private Const FOURCC_MEM      As Long = &H204D454D
    Private Const MMIO_CREATERIFF As Long = &H20
    Private Const MMIO_DIRTY      As Long = &H10000000
    Private Const MMIO_CREATE     As Long = &H1000
    Private Const MMIO_WRITE      As Long = &H1
    Private Const MMIO_READWRITE  As Long = &H2
    Private Const WAVE_FORMAT_PCM As Long = 1
    Private Const SEEK_SET        As Long = 0
    Private Const MMIO_FINDCHUNK  As Long = &H10
    Private Const MMIO_FINDRIFF   As Long = &H20
    
    Private Type MMCKINFO
        ckid            As Long
        ckSize          As Long
        fccType         As Long
        dwDataOffset    As Long
        dwFlags         As Long
    End Type
    
    Private Type MMIOINFO
        dwFlags         As Long
        fccIOProc       As Long
        pIOProc         As Long
        wErrorRet       As Long
        htask           As Long
        cchBuffer       As Long
        pchBuffer       As Long
        pchNext         As Long
        pchEndRead      As Long
        pchEndWrite     As Long
        lBufOffset      As Long
        lDiskOffset     As Long
        adwInfo(4)      As Long
        dwReserved1     As Long
        dwReserved2     As Long
        hmmio           As Long
    End Type
    
    Private Type WAVEFORMATEX
        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, _
                             Optional ByVal uFlags As Long) As Long
    Private Declare Function mmioOpen Lib "winmm.dll" _
                             Alias "mmioOpenW" ( _
                             ByVal szFileName As Long, _
                             ByRef lpmmioinfo As Any, _
                             ByVal dwOpenFlags 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, _
                             ByRef lpck As MMCKINFO, _
                             ByVal uFlags As Long) As Long
    Private Declare Function mmioCreateChunk Lib "winmm.dll" ( _
                             ByVal hmmio As Long, _
                             ByRef lpck As MMCKINFO, _
                             ByVal uFlags As Long) As Long
    Private Declare Function mmioWrite Lib "winmm.dll" ( _
                             ByVal hmmio As Long, _
                             ByRef pch As Any, _
                             ByVal cch As Long) As Long
    Private Declare Function mmioDescend Lib "winmm.dll" ( _
                             ByVal hmmio As Long, _
                             ByRef lpck As MMCKINFO, _
                             ByRef lpckParent As Any, _
                             ByVal uFlags As Long) As Long
    Private Declare Function mmioSeek Lib "winmm.dll" ( _
                             ByVal hmmio As Long, _
                             ByVal lOffset As Long, _
                             ByVal iOrigin As Long) As Long
    Private Declare Function memcpy Lib "kernel32" _
                             Alias "RtlMoveMemory" ( _
                             ByRef Destination As Any, _
                             ByRef Source As Any, _
                             ByVal Length As Long) As Long
    Private Declare Function mmioRead Lib "winmm.dll" ( _
                             ByVal hmmio As Long, _
                             ByRef pch As Any, _
                             ByVal cch As Long) As Long
    Private Declare Function mmioGetInfo Lib "winmm.dll" ( _
                             ByVal hmmio As Long, _
                             ByRef lpmmioinfo As Any, _
                             ByVal wFlags As Long) As Long
    
    Sub main()
        Dim bData()     As Byte
        Dim bOutPart()  As Byte
        
        ' // Open file to array
        Open "E:\Distance_to_Mars.wav" For Binary Access Read As #1
        ReDim bData(LOF(1) - 1)
        Get 1, , bData
        Close 1
        
        ' // Extract part of file to other file in-memory
        ' // Select from 1777777 sample to 1777777 + 55556 sample
        ExtractPartOfWaveFile bData(), 1777777, 55556, bOutPart()
        
        ' // Save part of file to file
        Open "E:\Distance_to_Mars_part.wav" For Binary Access Write As #1
        Put 1, , bOutPart
        Close 1
        
    End Sub
    
    ' // Extract part of a WAVE-file-in-memory to other WAVE-file-in-memory
    ' // !!! NO BOUNDS CHECKING (arrays etc.) !!!
    Private Function ExtractPartOfWaveFile( _
                     ByRef bData() As Byte, _
                     ByVal lStartSample As Long, _
                     ByVal lLength As Long, _
                     ByRef bOut() As Byte) As Boolean
        Dim tIoInfo         As MMIOINFO
        Dim tckRIFF         As MMCKINFO
        Dim tckWAVE         As MMCKINFO
        Dim tckFMT          As MMCKINFO
        Dim tckDATA         As MMCKINFO
        Dim bInData()       As Byte
        Dim bFMT()          As Byte
        Dim hOutFile        As Long
        
        If Not ExtractData(bData(), lStartSample, lLength, bInData(), bFMT()) Then
            Exit Function
        End If
        
        With tIoInfo
            .fccIOProc = FOURCC_MEM
            .cchBuffer = 2048
            .adwInfo(0) = 2048& * 2048
        End With
        
        hOutFile = mmioOpen(0, tIoInfo, MMIO_READWRITE Or MMIO_CREATE)
        If hOutFile = 0 Then
            MsgBox "Error opening wave file"
            Exit Function
        End If
    
        tckRIFF.fccType = mmioStringToFOURCC("WAVE", 0)
        
        If mmioCreateChunk(hOutFile, tckRIFF, MMIO_CREATERIFF) Then
            MsgBox "Error creating RIFF-WAVE chunk"
            GoTo CleanUp
        End If
        
        tckFMT.ckid = mmioStringToFOURCC("fmt", 0)
        
        If mmioCreateChunk(hOutFile, tckFMT, 0) Then
            MsgBox "Error creating fmt chunk"
            GoTo CleanUp
        End If
        
        If mmioWrite(hOutFile, bFMT(0), UBound(bFMT) + 1) = -1 Then
            MsgBox "Error writing format"
            GoTo CleanUp
        End If
        
        mmioAscend hOutFile, tckFMT, 0
        
        tckDATA.ckid = mmioStringToFOURCC("data", 0)
        
        If mmioCreateChunk(hOutFile, tckDATA, 0) Then
            MsgBox "Error creating data chunk"
            GoTo CleanUp
        End If
        
        If mmioWrite(hOutFile, bInData(0), UBound(bInData) + 1) = -1 Then
            MsgBox "Error writing data"
            GoTo CleanUp
        End If
        
        mmioAscend hOutFile, tckDATA, 0
        mmioAscend hOutFile, tckRIFF, 0
        
        If mmioGetInfo(hOutFile, tIoInfo, 0) Then
            MsgBox "Unable to get stream info"
            GoTo CleanUp
        End If
        
        ReDim bOut(tIoInfo.pchNext - tIoInfo.pchBuffer - 1)
        
        memcpy bOut(0), ByVal tIoInfo.pchBuffer, UBound(bOut) + 1
        
        ExtractPartOfWaveFile = True
        
    CleanUp:
        
        mmioClose hOutFile, 0
        
    End Function
    
    ' // Extract format and part of data from in-memory-file
    Private Function ExtractData( _
                     ByRef bData() As Byte, _
                     ByVal lStartSample As Long, _
                     ByVal lLength As Long, _
                     ByRef bOut() As Byte, _
                     ByRef bFMT() As Byte) As Boolean
        Dim tIoInfo         As MMIOINFO
        Dim tckRIFF         As MMCKINFO
        Dim tckWAVE         As MMCKINFO
        Dim tckFMT          As MMCKINFO
        Dim tckDATA         As MMCKINFO
        Dim tFMT            As WAVEFORMATEX
        Dim hInFile         As Long
        Dim lByteOffset     As Long
        Dim lBytesCount     As Long
        
        With tIoInfo
            .fccIOProc = FOURCC_MEM
            .cchBuffer = UBound(bData) + 1
            .pchBuffer = VarPtr(bData(0))
        End With
        
        hInFile = mmioOpen(0, tIoInfo, MMIO_READWRITE)
        If hInFile = 0 Then
            MsgBox "Error opening wave file"
            Exit Function
        End If
    
        tckWAVE.fccType = mmioStringToFOURCC("WAVE", 0)
    
        If mmioDescend(hInFile, tckWAVE, ByVal 0&, MMIO_FINDRIFF) Then
            MsgBox "Is not valid file"
            GoTo CleanUp
        End If
        
        tckFMT.ckid = mmioStringToFOURCC("fmt", 0)
        
        If mmioDescend(hInFile, tckFMT, tckWAVE, MMIO_FINDCHUNK) Then
            MsgBox "Format chunk not found"
            GoTo CleanUp
        End If
        
        If tckFMT.ckSize < 0 Then
            MsgBox "Invalid format"
            GoTo CleanUp
        End If
        
        ReDim bFMT(tckFMT.ckSize - 1)
        
        If mmioRead(hInFile, bFMT(0), tckFMT.ckSize) = -1 Then
            MsgBox "Can't read format"
            GoTo CleanUp
        End If
        
        mmioAscend hInFile, tckFMT, 0
        
        tckDATA.ckid = mmioStringToFOURCC("data", 0)
    
        If mmioDescend(hInFile, tckDATA, tckWAVE, MMIO_FINDCHUNK) Then
            MsgBox "Wave data is not found"
            GoTo CleanUp
        End If
        
        If tckDATA.ckSize <= 0 Then
            MsgBox "Invalid data size"
            GoTo CleanUp
        End If
        
        If tckFMT.ckSize > Len(tFMT) Then
            tckFMT.ckSize = Len(tFMT)
        End If
        
        memcpy tFMT, bFMT(0), tckFMT.ckSize
        
        lByteOffset = lStartSample * tFMT.nBlockAlign
        lBytesCount = lLength * tFMT.nBlockAlign
        
        If mmioSeek(hInFile, tckDATA.dwDataOffset + lByteOffset, SEEK_SET) = -1 Then
            MsgBox "Unable to locate data"
            GoTo CleanUp
        End If
        
        ReDim bOut(lBytesCount - 1)
        
        If mmioRead(hInFile, bOut(0), lBytesCount) = -1 Then
            MsgBox "Can't read data"
            GoTo CleanUp
        End If
        
        ExtractData = True
        
    CleanUp:
        
        mmioClose hInFile, 0
        
    End Function

  8. #8

    Thread Starter
    Fanatic Member
    Join Date
    Sep 2012
    Posts
    814

    Re: How to get a pointer to an element in a byte array?

    Quote Originally Posted by The trick View Post
    Code:
    Option Explicit
    
    Private Const FOURCC_MEM      As Long = &H204D454D
    Private Const MMIO_CREATERIFF As Long = &H20
    Private Const MMIO_DIRTY      As Long = &H10000000
    Private Const MMIO_CREATE     As Long = &H1000
    Private Const MMIO_WRITE      As Long = &H1
    Private Const MMIO_READWRITE  As Long = &H2
    Private Const WAVE_FORMAT_PCM As Long = 1
    Private Const SEEK_SET        As Long = 0
    Private Const MMIO_FINDCHUNK  As Long = &H10
    Private Const MMIO_FINDRIFF   As Long = &H20
    
    Private Type MMCKINFO
        ckid            As Long
        ckSize          As Long
        fccType         As Long
        dwDataOffset    As Long
        dwFlags         As Long
    End Type
    
    Private Type MMIOINFO
        dwFlags         As Long
        fccIOProc       As Long
        pIOProc         As Long
        wErrorRet       As Long
        htask           As Long
        cchBuffer       As Long
        pchBuffer       As Long
        pchNext         As Long
        pchEndRead      As Long
        pchEndWrite     As Long
        lBufOffset      As Long
        lDiskOffset     As Long
        adwInfo(4)      As Long
        dwReserved1     As Long
        dwReserved2     As Long
        hmmio           As Long
    End Type
    
    Private Type WAVEFORMATEX
        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, _
                             Optional ByVal uFlags As Long) As Long
    Private Declare Function mmioOpen Lib "winmm.dll" _
                             Alias "mmioOpenW" ( _
                             ByVal szFileName As Long, _
                             ByRef lpmmioinfo As Any, _
                             ByVal dwOpenFlags 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, _
                             ByRef lpck As MMCKINFO, _
                             ByVal uFlags As Long) As Long
    Private Declare Function mmioCreateChunk Lib "winmm.dll" ( _
                             ByVal hmmio As Long, _
                             ByRef lpck As MMCKINFO, _
                             ByVal uFlags As Long) As Long
    Private Declare Function mmioWrite Lib "winmm.dll" ( _
                             ByVal hmmio As Long, _
                             ByRef pch As Any, _
                             ByVal cch As Long) As Long
    Private Declare Function mmioDescend Lib "winmm.dll" ( _
                             ByVal hmmio As Long, _
                             ByRef lpck As MMCKINFO, _
                             ByRef lpckParent As Any, _
                             ByVal uFlags As Long) As Long
    Private Declare Function mmioSeek Lib "winmm.dll" ( _
                             ByVal hmmio As Long, _
                             ByVal lOffset As Long, _
                             ByVal iOrigin As Long) As Long
    Private Declare Function memcpy Lib "kernel32" _
                             Alias "RtlMoveMemory" ( _
                             ByRef Destination As Any, _
                             ByRef Source As Any, _
                             ByVal Length As Long) As Long
    Private Declare Function mmioRead Lib "winmm.dll" ( _
                             ByVal hmmio As Long, _
                             ByRef pch As Any, _
                             ByVal cch As Long) As Long
    Private Declare Function mmioGetInfo Lib "winmm.dll" ( _
                             ByVal hmmio As Long, _
                             ByRef lpmmioinfo As Any, _
                             ByVal wFlags As Long) As Long
    
    Sub main()
        Dim bData()     As Byte
        Dim bOutPart()  As Byte
        
        ' // Open file to array
        Open "E:\Distance_to_Mars.wav" For Binary Access Read As #1
        ReDim bData(LOF(1) - 1)
        Get 1, , bData
        Close 1
        
        ' // Extract part of file to other file in-memory
        ' // Select from 1777777 sample to 1777777 + 55556 sample
        ExtractPartOfWaveFile bData(), 1777777, 55556, bOutPart()
        
        ' // Save part of file to file
        Open "E:\Distance_to_Mars_part.wav" For Binary Access Write As #1
        Put 1, , bOutPart
        Close 1
        
    End Sub
    
    ' // Extract part of a WAVE-file-in-memory to other WAVE-file-in-memory
    ' // !!! NO BOUNDS CHECKING (arrays etc.) !!!
    Private Function ExtractPartOfWaveFile( _
                     ByRef bData() As Byte, _
                     ByVal lStartSample As Long, _
                     ByVal lLength As Long, _
                     ByRef bOut() As Byte) As Boolean
        Dim tIoInfo         As MMIOINFO
        Dim tckRIFF         As MMCKINFO
        Dim tckWAVE         As MMCKINFO
        Dim tckFMT          As MMCKINFO
        Dim tckDATA         As MMCKINFO
        Dim bInData()       As Byte
        Dim bFMT()          As Byte
        Dim hOutFile        As Long
        
        If Not ExtractData(bData(), lStartSample, lLength, bInData(), bFMT()) Then
            Exit Function
        End If
        
        With tIoInfo
            .fccIOProc = FOURCC_MEM
            .cchBuffer = 2048
            .adwInfo(0) = 2048& * 2048
        End With
        
        hOutFile = mmioOpen(0, tIoInfo, MMIO_READWRITE Or MMIO_CREATE)
        If hOutFile = 0 Then
            MsgBox "Error opening wave file"
            Exit Function
        End If
    
        tckRIFF.fccType = mmioStringToFOURCC("WAVE", 0)
        
        If mmioCreateChunk(hOutFile, tckRIFF, MMIO_CREATERIFF) Then
            MsgBox "Error creating RIFF-WAVE chunk"
            GoTo CleanUp
        End If
        
        tckFMT.ckid = mmioStringToFOURCC("fmt", 0)
        
        If mmioCreateChunk(hOutFile, tckFMT, 0) Then
            MsgBox "Error creating fmt chunk"
            GoTo CleanUp
        End If
        
        If mmioWrite(hOutFile, bFMT(0), UBound(bFMT) + 1) = -1 Then
            MsgBox "Error writing format"
            GoTo CleanUp
        End If
        
        mmioAscend hOutFile, tckFMT, 0
        
        tckDATA.ckid = mmioStringToFOURCC("data", 0)
        
        If mmioCreateChunk(hOutFile, tckDATA, 0) Then
            MsgBox "Error creating data chunk"
            GoTo CleanUp
        End If
        
        If mmioWrite(hOutFile, bInData(0), UBound(bInData) + 1) = -1 Then
            MsgBox "Error writing data"
            GoTo CleanUp
        End If
        
        mmioAscend hOutFile, tckDATA, 0
        mmioAscend hOutFile, tckRIFF, 0
        
        If mmioGetInfo(hOutFile, tIoInfo, 0) Then
            MsgBox "Unable to get stream info"
            GoTo CleanUp
        End If
        
        ReDim bOut(tIoInfo.pchNext - tIoInfo.pchBuffer - 1)
        
        memcpy bOut(0), ByVal tIoInfo.pchBuffer, UBound(bOut) + 1
        
        ExtractPartOfWaveFile = True
        
    CleanUp:
        
        mmioClose hOutFile, 0
        
    End Function
    
    ' // Extract format and part of data from in-memory-file
    Private Function ExtractData( _
                     ByRef bData() As Byte, _
                     ByVal lStartSample As Long, _
                     ByVal lLength As Long, _
                     ByRef bOut() As Byte, _
                     ByRef bFMT() As Byte) As Boolean
        Dim tIoInfo         As MMIOINFO
        Dim tckRIFF         As MMCKINFO
        Dim tckWAVE         As MMCKINFO
        Dim tckFMT          As MMCKINFO
        Dim tckDATA         As MMCKINFO
        Dim tFMT            As WAVEFORMATEX
        Dim hInFile         As Long
        Dim lByteOffset     As Long
        Dim lBytesCount     As Long
        
        With tIoInfo
            .fccIOProc = FOURCC_MEM
            .cchBuffer = UBound(bData) + 1
            .pchBuffer = VarPtr(bData(0))
        End With
        
        hInFile = mmioOpen(0, tIoInfo, MMIO_READWRITE)
        If hInFile = 0 Then
            MsgBox "Error opening wave file"
            Exit Function
        End If
    
        tckWAVE.fccType = mmioStringToFOURCC("WAVE", 0)
    
        If mmioDescend(hInFile, tckWAVE, ByVal 0&, MMIO_FINDRIFF) Then
            MsgBox "Is not valid file"
            GoTo CleanUp
        End If
        
        tckFMT.ckid = mmioStringToFOURCC("fmt", 0)
        
        If mmioDescend(hInFile, tckFMT, tckWAVE, MMIO_FINDCHUNK) Then
            MsgBox "Format chunk not found"
            GoTo CleanUp
        End If
        
        If tckFMT.ckSize < 0 Then
            MsgBox "Invalid format"
            GoTo CleanUp
        End If
        
        ReDim bFMT(tckFMT.ckSize - 1)
        
        If mmioRead(hInFile, bFMT(0), tckFMT.ckSize) = -1 Then
            MsgBox "Can't read format"
            GoTo CleanUp
        End If
        
        mmioAscend hInFile, tckFMT, 0
        
        tckDATA.ckid = mmioStringToFOURCC("data", 0)
    
        If mmioDescend(hInFile, tckDATA, tckWAVE, MMIO_FINDCHUNK) Then
            MsgBox "Wave data is not found"
            GoTo CleanUp
        End If
        
        If tckDATA.ckSize <= 0 Then
            MsgBox "Invalid data size"
            GoTo CleanUp
        End If
        
        If tckFMT.ckSize > Len(tFMT) Then
            tckFMT.ckSize = Len(tFMT)
        End If
        
        memcpy tFMT, bFMT(0), tckFMT.ckSize
        
        lByteOffset = lStartSample * tFMT.nBlockAlign
        lBytesCount = lLength * tFMT.nBlockAlign
        
        If mmioSeek(hInFile, tckDATA.dwDataOffset + lByteOffset, SEEK_SET) = -1 Then
            MsgBox "Unable to locate data"
            GoTo CleanUp
        End If
        
        ReDim bOut(lBytesCount - 1)
        
        If mmioRead(hInFile, bOut(0), lBytesCount) = -1 Then
            MsgBox "Can't read data"
            GoTo CleanUp
        End If
        
        ExtractData = True
        
    CleanUp:
        
        mmioClose hInFile, 0
        
    End Function
    Hi The trick, after reading your source code, I realized that the way I wrote the wave file-header was wrong. Your source code completely solved my problem. Extremely grateful.

  9. #9

    Thread Starter
    Fanatic Member
    Join Date
    Sep 2012
    Posts
    814

    Re: How to get a pointer to an element in a byte array?

    Quote Originally Posted by Schmidt View Post
    A few years ago, I wrote a little WavInfo-Class, which works (RC5-) Stream-Based -
    and it parses out all the Info from a *.wav-file without using the mmio-API.

    Beside the usual Wav-Format-Fields, it also gives reliable info about the Offset to the real PCM-Data
    (which does not necessarily need to start at offset 44).

    Here it is (I named it cWavInfo):
    Code:
    Option Explicit 'RC5-cStream-based Wav-info-reader (Author Olaf Schmidt, 2012)
    
    'precalculated FourCCs
    Private Const RIFF As Long = &H46464952, Wave As Long = &H45564157
    Private Const data As Long = &H61746164, FMT_ As Long = &H20746D66
    
    Private Type tRiffChunk
      ID As Long
      Size As Long
    End Type
    Private Type tWaveHeader
      RiffChunk As tRiffChunk
      RiffChunkFormat As Long
      RiffSubChunk As tRiffChunk
      WaveAudioFormat As Integer
      WaveNumChannels As Integer
      WaveSampleRate As Long
      WaveByteRate As Long
      WaveBlockAlign As Integer
      WaveBitsPerSample As Integer
      cbSize   As Integer
      wValidBitsPerSample   As Integer
      dwChannelMask   As Long
      SubFormat(0 To 7) As Integer
    End Type
    
    Private Header As tWaveHeader
    Private mWaveMSec As Long, mWaveSamples As Long, mWaveDataOffs As Long, mWaveDataLen As Long
    
    Public Sub ReadWaveInfoFromStream(Strm As cStream)
    Dim Pos As Long, RiffChunk As tRiffChunk, EmptyHeader As tWaveHeader
      Header = EmptyHeader
      mWaveMSec = 0:     mWaveSamples = 0
      mWaveDataOffs = 0: mWaveDataLen = 0
       Strm.SetPosition 0
       Strm.ReadToPtr VarPtr(Header), Len(Header)
       If Header.RiffChunk.ID <> RIFF Then Err.Raise vbObjectError, , "The file is not in RIFF format."
       If Header.RiffChunkFormat <> Wave Then Err.Raise vbObjectError, , "The file is in RIFF format but is not a WAVE file."
    
       Do Until Header.RiffSubChunk.ID = FMT_
          Pos = Pos + Len(RiffChunk) + Header.RiffSubChunk.Size
          If Pos <= 0 Or Pos >= Strm.GetSize Then Err.Raise vbObjectError, , "The file is a WAVE file, but the header is corrupt."
          Strm.SetPosition Pos
          Strm.ReadToPtr VarPtr(Header), Len(Header)
       Loop
    
       Strm.SetPosition Pos + 20 + Header.RiffSubChunk.Size
       Strm.ReadToPtr VarPtr(RiffChunk), Len(RiffChunk)
    
       Do Until RiffChunk.ID = data
         Strm.SetPosition RiffChunk.Size, STRM_SeekFromCurPos
         If Strm.GetPosition = Strm.GetSize Then Err.Raise vbObjectError, , "The file is in RIFF format but is not a WAVE file."
         Strm.ReadToPtr VarPtr(RiffChunk), Len(RiffChunk)
       Loop
       
       If Header.RiffSubChunk.Size = 40 Then
         Header.WaveAudioFormat = Header.SubFormat(0)
       Else
         Header.wValidBitsPerSample = Header.WaveBitsPerSample
       End If
       
       mWaveDataLen = RiffChunk.Size
       mWaveDataOffs = Strm.GetPosition
        
       mWaveSamples = mWaveDataLen / Header.WaveNumChannels / (Header.WaveBitsPerSample / 8)
       mWaveMSec = (mWaveSamples / Header.WaveSampleRate) * 1000
    End Sub
     
    Public Property Get AudioFormat() As Long
      AudioFormat = Header.WaveAudioFormat
    End Property
    Public Property Get AudioFormatString() As String
      AudioFormatString = Choose(AudioFormat + 1, "Unknown", "PCM", "ADPCM", "IEEE_FLOAT")
    End Property
    
    Public Property Get Channels() As Integer
      Channels = Header.WaveNumChannels
    End Property
    
    Public Property Get SampleRate() As Long
      SampleRate = Header.WaveSampleRate
    End Property
    
    Public Property Get ByteRate() As Long
      ByteRate = Header.WaveByteRate
    End Property
     
    Public Property Get BitsPerSample() As Integer
      BitsPerSample = Header.WaveBitsPerSample
    End Property
    
    Public Property Get BlockAlign() As Integer
      BlockAlign = Header.WaveBlockAlign
    End Property
    
    Public Property Get ValidBitsPerSample() As Integer
      ValidBitsPerSample = Header.wValidBitsPerSample
    End Property
    
    Public Property Get Samples() As Long
      Samples = mWaveSamples
    End Property
    
    Public Property Get DataOffs() As Long
      DataOffs = mWaveDataOffs
    End Property
    Public Property Get DataLen() As Long
      DataLen = mWaveDataLen
    End Property
    Public Property Get DataLenSec() As Double
      DataLenSec = mWaveMSec / 1000
    End Property
    Public Property Get DataLen_msec() As Long
      DataLen_msec = mWaveMSec
    End Property
    And if your intent is, to describe (and later play) shorter "Selection-Snippets" from a larger Wav-File,
    you could use a cSelection-Class like the following (which has 4 Read/Write-Props and 2 "calculated ones"):

    Code:
    Option Explicit
    
    Public StreamTotalLengthSec As Double, StartPerc As Double, EndPerc As Double, Text As String
     
    Public Property Get StreamOffsetSeconds() As Double
      StreamOffsetSeconds = StartPerc * StreamTotalLengthSec
    End Property
    
    Public Property Get LengthSeconds() As Double
      LengthSeconds = EndPerc * StreamTotalLengthSec - StreamOffsetSeconds
    End Property
    Well, once you're "armed" with the two little Classes above, the remaining Form-Demo-Code becomes as simple as that:
    (define a Wav-File of your choice in Form_Load, and then click the Form).
    Code:
    Option Explicit
     
    Private Declare Function PlaySound& Lib "winmm" (data As Any, Optional ByVal hMod&, Optional ByVal Flags& = 5)
    
    Private Stream As cStream, WavInfo As New cWavInfo
    
    Private Sub Form_Load()
      Set Stream = New_c.FSO.OpenFileStream("c:\temp\SampleLoop.wav")
      WavInfo.ReadWaveInfoFromStream Stream
    End Sub
     
    Private Sub Form_Click()
      'init a Selection-Object with the Duration from cWavInfo and a Percent-Range
      Dim Sel As New cSelection
          Sel.StreamTotalLengthSec = WavInfo.DataLenSec
          Sel.StartPerc = 0.15
          Sel.EndPerc = 0.35
          
      'now play the selection-snippet
      PlaySelection Sel, WavInfo
    End Sub
    
    Public Sub PlaySelection(Sel As cSelection, WavInfo As cWavInfo)
      If Sel Is Nothing Or Stream Is Nothing Then Exit Sub
      With WavInfo
        Dim B() As Byte: B = "" 'init B to an empty Array
        Stream.SetPosition .DataOffs + Int(Sel.StreamOffsetSeconds * .SampleRate) * .BlockAlign
        Stream.ReadToByteArr B, Int(Sel.LengthSeconds * .SampleRate) * .BlockAlign
        PlayWavBuf .SampleRate, .Channels, .BitsPerSample, B
      End With
    End Sub
    
    Public Sub PlayWavBuf(ByVal Freq As Long, ByVal Channels As Long, ByVal Bits As Long, WavBuf() As Byte)
      PlaySound ByVal 0& 'cancel any (potentially) still asynchronously playing sounds
      Static B() As Byte
      Dim WavBufLen As Long, Strm As cStream
          WavBufLen = UBound(WavBuf) + 1
      
      Set Strm = New_c.Stream 'let's create an InMemory-Stream
          Strm.WriteFromByteArr StrConv("RIFF    WAVEfmt                     data    ", vbFromUnicode)
          Strm.WriteFromByteArr WavBuf
          Strm.SetPosition 4:  Strm.WriteFromPtr VarPtr(WavBufLen + 36), 4 'FileSize (without the 8 Riff-Hdr-Bytes)
          Strm.SetPosition 16: Strm.WriteFromPtr VarPtr(16&), 4            'Format-Data-Length
          Strm.WriteFromPtr VarPtr(1 + 65536 * Channels), 4                'PCM=1 + Channels
          Strm.WriteFromPtr VarPtr(Freq), 4                                'Samples per second
          Strm.WriteFromPtr VarPtr(Freq * Channels * Bits \ 8), 4          'Bytes per second
          Strm.WriteFromPtr VarPtr(Channels * Bits \ 8 + 65536 * Bits), 4  'Bytes per Sample + Bits
          Strm.SetPosition 40: Strm.WriteFromPtr VarPtr(WavBufLen), 4      'Wav-Data-length
          Strm.SetPosition 0 'prepare for a re-read of the whole stream (now including the header)
       If Strm.ReadToByteArr(B) Then PlaySound B(0) 'read and finally play the (now wav-hdr-prefixed) buffer
    End Sub
     
    Private Sub Form_Terminate()
      PlaySound ByVal 0& 'cancel any (potentially) still asynchronously playing sounds
      New_c.CleanupRichClientDll
    End Sub
    The above PlaySelection-Function (which works in conjunction with the WavInfo-Class and the RC5-cStream-Class),
    answers a lot of your recent questions I assume.

    HTH

    Olaf
    Hi Olaf, I tested the source code you provided and it worked very well. Both of your method and The Trick's method can completely solve my problem, and these two different methods will all be added to my project. Extremely grateful.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width