home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Planet Source Code Jumbo …e CD Visual Basic 1 to 7
/
4_2005-2006.ISO
/
data
/
Zips
/
WaveIn_Rec2001136152006.psc
/
EncoderWAV.cls
< prev
Wrap
Text File
|
2006-06-14
|
13KB
|
439 lines
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "EncoderWAV"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
' WAV Encoder with ACM support for compressed formats
' (from my project "Monoton")
' this class implemented "IEncoder".
' to hold the size of the project down, I removed it.
' now the members of IEncoder have the prefix "encoder".
Private Const Extension As String = "wav"
Private Const Description As String = "Wave ACM Encoder"
Private Declare Sub CpyMem Lib "kernel32" _
Alias "RtlMoveMemory" ( _
pDst As Any, _
pSrc As Any, _
ByVal dwLen As Long _
)
Private Declare Sub ZeroMem Lib "kernel32" _
Alias "RtlZeroMemory" ( _
pDst As Any, _
ByVal dwLen As Long _
)
Private Declare Function IsBadReadPtr Lib "kernel32" ( _
ptr As Any, _
ByVal ucb As Long _
) As Long
Private Declare Function IsBadWritePtr Lib "kernel32" ( _
ptr As Any, _
ByVal ucb As Long _
) As Long
Private Declare Function CreateFile Lib "kernel32.dll" _
Alias "CreateFileA" ( _
ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
lpSecurityAttributes As Any, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long _
) As Long
Private Declare Function ReadFile Lib "kernel32" ( _
ByVal HFILE As Long, _
lpBuffer As Any, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
ByVal lpOverlapped As Any _
) As Long
Private Declare Function WriteFile Lib "kernel32" ( _
ByVal HFILE As Long, _
lpBuffer As Any, _
ByVal nNumberOfBytesToWrite As Long, _
lpNumberOfBytesWritten As Long, _
ByVal lpOverlapped As Any _
) As Long
Private Declare Function SetFilePointer Lib "kernel32" ( _
ByVal HFILE As Long, _
ByVal lDistanceToMove As Long, _
ByVal lpDistanceToMoveHigh As Long, _
ByVal dwMoveMethod As Long _
) As Long
Private Declare Function GetFileSize Lib "kernel32" ( _
ByVal HFILE As Long, _
ByVal lpFileSizeHigh As Long _
) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long _
) As Long
Private Declare Function acmStreamPrepareHeader Lib "msacm32" ( _
ByVal has As Long, _
pash As ACMSTREAMHEADER, _
ByVal fdwPrepare As Long _
) As Long
Private Declare Function acmStreamUnprepareHeader Lib "msacm32" ( _
ByVal has As Long, _
pash As ACMSTREAMHEADER, _
ByVal fdwUnprepare As Long _
) As Long
Private Declare Function acmStreamOpen Lib "msacm32" ( _
phas As Long, _
ByVal had As Long, _
pwfxSrc As Any, _
pwfxDst As Any, _
ByVal pwfltr As Long, _
ByVal dwCallback As Long, _
ByVal dwInstance As Long, _
ByVal fdwOpen As Long _
) As Long
Private Declare Function acmStreamSize Lib "msacm32" ( _
ByVal has As Long, _
ByVal cbInput As Long, _
pdwOutputBytes As Long, _
ByVal fdwSize As Long _
) As Long
Private Declare Function acmStreamConvert Lib "msacm32" ( _
ByVal has As Long, _
pash As ACMSTREAMHEADER, _
ByVal fdwConvert As Long _
) As Long
Private Declare Function acmStreamReset Lib "msacm32" ( _
ByVal has As Long, _
ByVal fdwReset As Long _
) As Long
Private Declare Function acmStreamClose Lib "msacm32" ( _
ByVal has As Long, _
ByVal fdwClose As Long _
) As Long
Private Declare Function acmFormatChoose Lib "msacm32" _
Alias "acmFormatChooseA" ( _
pfmtc As ACMFORMATCHOOSEA _
) As Long
Public Enum SND_RESULT
SND_ERR_SUCCESS = 0
SND_ERR_INVALID_SOURCE
SND_ERR_INVALID_OUTPUT
SND_ERR_INTERNAL
SND_ERR_OUT_OF_RANGE
SND_ERR_END_OF_STREAM
SND_ERR_INVALID_TAG
SND_ERR_INVALID_PARAM
SND_ERR_TOO_BIG
SND_ERR_NEED_MORE
SND_ERR_WRITE_ERROR
SND_ERR_UNKNOWN
End Enum
Public Enum ENCODER_METRICS
ENC_M_PCM_PER_DELIVERY_MIN = 0
ENC_M_PCM_PER_DELIVERY_MAX
ENC_M_SUPPORT_TAGS
End Enum
Private Enum FILE_OPEN_METHOD
CREATE_NEW = 1
CREATE_ALWAYS = 2
OPEN_EXISTING = 3
OPEN_ALWAYS = 4
End Enum
Private Enum FILE_SHARE_RIGHTS
FILE_SHARE_READ = &H1
FILE_SHARE_WRITE = &H2
End Enum
Private Enum FILE_ACCESS_RIGHTS
GENERIC_READ = &H80000000
GENERIC_WRITE = &H40000000
End Enum
Private Enum SEEK_METHOD
FILE_BEGIN = 0
FILE_CURRENT = 1
FILE_END = 2
End Enum
Private Enum HACMSTREAM
INVALID_STREAM_HANDLE = 0
End Enum
Private Enum ACM_STREAMSIZEF
ACM_STREAMSIZEF_DESTINATION = &H1
ACM_STREAMSIZEF_SOURCE = &H0
ACM_STREAMSIZEF_QUERYMASK = &HF
End Enum
Private Enum ACM_STREAMCONVERTF
ACM_STREAMCONVERTF_BLOCKALIGN = &H4
ACM_STREAMCONVERTF_START = &H10
ACM_STREAMCONVERTF_END = &H20
End Enum
Private Const INVALID_HANDLE As Long = -1
Private Const ACMFMTDET_FORMAT_CHARS As Long = 128
Private Const ACMFMTTAGDET_FORMATTAG_CHARS As Long = 48
Private Const ACM_FORMATENUMF_CONVERT As Long = &H100000
Private Const WAVE_FORMAT_PCM As Long = 1
' some codecs (e.g. Vorbis ACM) have very big
' WFX structs. so make the WFX buffer extra large.
Private Const WFXSize As Long = 128& * 1024&
Private Const WAV_RIFF As Long = 1179011410
Private Const WAV_WAVE As Long = 1163280727
Private Const WAV_DATA As Long = 1635017060
Private Const WAV_FMT As Long = 544501094
Private Type HFILE
handle As Long
path As String
End Type
Private Type ACMSTREAMHEADER
cbStruct As Long
fdwStatus As Long
dwUser As Long
pbSrc As Long
cbSrcLength As Long
cbSrcLengthUsed As Long
dwSrcUser As Long
pbDst As Long
cbDstLength As Long
cbDstLengthUsed As Long
dwDstUser As Long
dwReservedDriver(9) As Long
End Type
Private Type ACMFORMATCHOOSEA
cbStruct As Long
fdwStyle As Long
hwndOwner As Long
pwfx As Long
cbwfx As Long
pszTitle As Long
szFormatTag As String * ACMFMTTAGDET_FORMATTAG_CHARS
szFormat As String * ACMFMTDET_FORMAT_CHARS
pszName As Long
cchName As Long
fdwEnum As Long
pwfxEnum As Long
hInstance As Long
pszTemplateName As Long
lCustData As Long
pfnHook As Long
btSpace(1023) As Byte ' had some strange crashes...
End Type
Private Type MMWAVEFORMATEX
wFormatTag As Integer
nChannels As Integer
nSamplesPerSec As Long
nAvgBytesPerSec As Long
nBlockAlign As Integer
wBitsPerSample As Integer
cbSize As Integer
End Type
Private Type WAVRIFF
RIFF As Long ' "RIFF"
hdrlen As Long
WAVE As Long ' "WAVE"
fmt As Long ' "fmt "
chnksize As Long
End Type
Private udtWFXIn As MMWAVEFORMATEX
Private btWfxOut() As Byte
Private lngWFXOutLen As Long
Private strFormatID As String
Private strFormatTag As String
Private btInp() As Byte
Private btOut() As Byte
Private lngInpLen As Long
Private lngOutLen As Long
Private udtStreamHdr As ACMSTREAMHEADER
Private hStream As HACMSTREAM
Private hFOut As HFILE
Private blnWriteHeader As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Class_Initialize()
Dim wfx As MMWAVEFORMATEX
ReDim btWfxOut(WFXSize - 1) As Byte
blnWriteHeader = True
wfx = CreateWFX(44100, 2, 16)
SetFormat VarPtr(wfx), _
Len(wfx), _
"44.1 kHz 16 Bit Stereo", "PCM"
hFOut.handle = INVALID_HANDLE
End Sub
Private Sub Class_Terminate()
Encoder_EncoderClose
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''
' write RIFF/WAVE/FMT /DATA chunks
Public Property Get WriteHeader( _
) As Boolean
WriteHeader = blnWriteHeader
End Property
Public Property Let WriteHeader( _
ByVal bln As Boolean _
)
If hFOut.handle = INVALID_HANDLE Then
blnWriteHeader = bln
Else
Err.Raise 90, , "Encoder already running!"
End If
End Property
Public Property Get FormatTag( _
) As String
FormatTag = strFormatTag
End Property
Public Property Get FormatID( _
) As String
FormatID = strFormatID
End Property
Public Sub SetPCMFormat( _
ByVal samplerate As Long, _
ByVal Channels As Integer, _
Optional ByVal FormatID As String, _
Optional ByVal FormatTag As String _
)
Dim wfx As MMWAVEFORMATEX
wfx = CreateWFX(samplerate, Channels, 16)
If FormatID = "" Then
With wfx
strFormatID = Round(.nSamplesPerSec / 1000, 1) & " " & _
.wBitsPerSample & " Bit " & _
IIf(.nChannels = 2, "stereo", "mono")
End With
End If
If FormatTag = "" Then
FormatTag = "PCM"
End If
SetFormat VarPtr(wfx), Len(wfx), _
FormatID, FormatTag
End Sub
Public Sub SetFormat( _
ByVal wfx_ptr As Long, _
ByVal wfx_len As Long, _
Optional FormatID As String, _
Optional FormatTag As String _
)
If 0 = IsBadReadPtr(ByVal wfx_ptr, wfx_len) Then
If wfx_len > UBound(btWfxOut) + 1 Then
ReDim btWfxOut(wfx_len - 1) As Byte
End If
CpyMem btWfxOut(0), ByVal wfx_ptr, wfx_len
lngWFXOutLen = wfx_len
strFormatID = FormatID
strFormatTag = FormatTag
End If
End Sub
Public Function SelectFormat( _
ByVal samplerate As Long, _
ByVal Channels As Integer, _
Optional ByVal hwndOwner As Long, _
Optional ByVal Title As String = "WAV Format" _
) As SND_RESULT
Dim btTitle() As Byte
Dim btWFX() As Byte
Dim wfx As MMWAVEFORMATEX
Dim wfxinp As MMWAVEFORMATEX
Dim udtFmtCh As ACMFORMATCHOOSEA
ReDim btWFX(WFXSize - 1) As Byte
btTitle = StrConv(Title & Chr$(0), vbFromUnicode)
With wfxinp
.nSamplesPerSec = samplerate
.nChannels = Channels
.wBitsPerSample = 16
.wFormatTag = WAVE_FORMAT_PCM
.nBlockAlign = .nChannels * (.wBitsPerSample / 8)
.nAvgBytesPerSec = .nSamplesPerSec * .nBlockAlign
End With
CpyMem btWFX(0), wfxinp, Len(wfxinp)
With udtFmtCh
.cbStruct = LenB(udtFmtCh)
.hwndOwner = hwndOwner
.pwfx = VarPtr(btWFX(0))
.cbwfx = WFXSize
.pwfxEnum = VarPtr(wfxinp)
.fdwEnum C .hwndOwner ibutes As Any, _
ByVal le x As MMWAVEFORMATE((((((((((((mOSub SetFormat( _
ByVal wfx_pPtr(wfxi4vate Const DescripEenBi