-
Jan 12th, 2018, 12:03 AM
#1
Thread Starter
PowerPoster
[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 02:57 AM.
-
Jan 12th, 2018, 12:14 AM
#2
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
-
Jan 12th, 2018, 02:51 AM
#3
Thread Starter
PowerPoster
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 04:01 AM.
-
Jan 12th, 2018, 03:31 AM
#4
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.
-
Jan 12th, 2018, 03:52 AM
#5
Thread Starter
PowerPoster
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 04:10 AM.
-
Jan 12th, 2018, 04:48 AM
#6
Re: How to get a pointer to an element in a byte array?
Originally Posted by dreammanor
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
-
Jan 12th, 2018, 06:30 AM
#7
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
-
Jan 12th, 2018, 09:01 PM
#8
Thread Starter
PowerPoster
Re: How to get a pointer to an element in a byte array?
Originally Posted by The trick
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.
-
Jan 12th, 2018, 09:04 PM
#9
Thread Starter
PowerPoster
Re: How to get a pointer to an element in a byte array?
Originally Posted by Schmidt
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
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|