VERSION 5.00
Begin VB.Form frmMain
Caption = "Form1"
ClientHeight = 3675
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 3675
ScaleWidth = 4680
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton cmdGetInfo
Caption = "GetInfo"
Height = 495
Left = 360
TabIndex = 5
Top = 3060
Width = 1215
End
Begin VB.CommandButton cmdGetTag
Caption = "GetTag"
Height = 495
Left = 1740
TabIndex = 4
Top = 3060
Width = 1215
End
Begin VB.CommandButton cmdEnum
Caption = "Enum"
Height = 495
Left = 3120
TabIndex = 3
Top = 2400
Width = 1215
End
Begin VB.CommandButton cmdPlay
Caption = "Play"
Height = 495
Left = 1740
TabIndex = 2
Top = 2400
Width = 1215
End
Begin VB.TextBox txtLog
Height = 1995
Left = 240
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 1
Top = 180
Width = 4215
End
Begin VB.CommandButton cmdOK
Caption = "OK"
Height = 495
Left = 360
TabIndex = 0
Top = 2400
Width = 1215
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim dx As New DirectX7
Dim ds As DirectSound
Dim dsb As DirectSoundBuffer
Dim dsbd As DSBUFFERDESC
Dim wf As WAVEFORMATEX
Dim bPlaying As Boolean
Dim bContinue As Boolean
Dim endEvent As Long
Implements DirectXEvent
Private Sub cmdEnum_Click()
Dim de As DirectSoundEnum
Dim i As Integer
Set de = dx.GetDSEnum
For i = 1 To de.GetCount
txtLog.Text = txtLog.Text & de.GetGuid(i) & " " & de.GetName(i) & " " & de.GetDescription(i) & vbCrLf
Next
Set de = Nothing
End Sub
Private Sub cmdGetInfo_Click()
Dim s As String
Dim l As Long
Dim status As Integer
Dim t As XA_InputModule
Dim d As XA_DecoderInfo
Dim dp As Long
Dim opbi As XA_OutputBufferInfo
Dim i As Long
dp = VarPtr(d)
status = decoder_new(VarPtr(dp))
If status <> XA_SUCCESS Then
MsgBox "can not create decoder!"
Exit Sub
End If
CopyMemory VarPtr(d), dp, 60
status = file_input_module_register(t)
status = decoder_input_module_register(d, t)
If status <> XA_SUCCESS Then MsgBox xaudio_error_string(status)
status = decoder_input_new(d, App.Path & "\3.mp3", XA_DECODER_INPUT_AUTOSELECT)
If status <> XA_SUCCESS Then
MsgBox "can not create input!" & status & vbCrLf & xaudio_error_string(status)
Exit Sub
End If
status = decoder_input_open(d)
If status <> XA_SUCCESS Then
MsgBox "can not open input!" & vbCrLf & xaudio_error_string(status)
Exit Sub
End If
Dim mp3info As MP3InfoType
Dim l1 As Long, l2 As Long
Dim l3 As Single
Do
DoEvents
status = decoder_decode(d, 0)
CopyMemory VarPtr(opbi), d.Addr06, Len(opbi)
With mp3info.WaveFormat
.BitsPerSample = opbi.bytes_per_sample * 8
.Channels = 2 ^ opbi.stereo
.SamplesPerSec = opbi.sample_rate
End With
l1 = l1 + 1
l2 = l2 + opbi.size
l3 = l3 + opbi.size / (opbi.sample_rate * ((2 ^ opbi.stereo) * opbi.bytes_per_sample))
Loop While status = XA_SUCCESS Or status = XA_ERROR_TIMEOUT Or status = XA_ERROR_INVALID_FRAME
With mp3info
.Frames = l1
.ByteLength = l2
.SecondLength = l3
End With
MsgBox "Frames: " & mp3info.Frames & vbCrLf & "Bytes: " & mp3info.ByteLength & vbCrLf & "Seconds: " & mp3info.SecondLength
l = xaudio_get_api_version(XA_API_ID_SYNC)
MsgBox "XAudio DLL Version: " & ((l \ (2 ^ 16)) And &H255) & "." & ((l \ (2 ^ 8)) And &H255) & "." & (l And &H255)
End Sub
Private Sub cmdGetTag_Click()
Dim fp As Integer
Dim mp3tag As ID3V1
Dim SongType() As String
SongType = Split(LoadResString(1001), ";")
fp = FreeFile
Open App.Path & "\4.mp3" For Binary As #fp
Seek #fp, FileLen(App.Path & "\4.mp3") - 127
Get #fp, , mp3tag
Close #fp
MsgBox RTrim(mp3tag.Title) & vbCrLf & RTrim(mp3tag.Artist) & vbCrLf & RTrim(mp3tag.Album) & _
vbCrLf & RTrim(mp3tag.Year) & vbCrLf & RTrim(mp3tag.Comment)
End Sub
Private Sub cmdOK_Click()
Dim s As String
Dim l As Long
Dim status As Integer
Dim t As XA_InputModule
Dim d As XA_DecoderInfo
Dim dp As Long
Dim opbi As XA_OutputBufferInfo
Dim i As Long
dp = VarPtr(d)
status = decoder_new(VarPtr(dp))
If status <> XA_SUCCESS Then
MsgBox "can not create decoder!"
Exit Sub
End If
CopyMemory VarPtr(d), dp, 60
status = file_input_module_register(t)
status = decoder_input_module_register(d, t)
If status <> XA_SUCCESS Then MsgBox xaudio_error_string(status)
status = decoder_input_new(d, App.Path & "\3.mp3", XA_DECODER_INPUT_AUTOSELECT)
If status <> XA_SUCCESS Then
MsgBox "can not create input!" & status & vbCrLf & xaudio_error_string(status)
Exit Sub
End If
status = decoder_input_open(d)
If status <> XA_SUCCESS Then
MsgBox "can not open input!" & vbCrLf & xaudio_error_string(status)
Exit Sub
End If
Set ds = dx.DirectSoundCreate(vbNullString)
ds.SetCooperativeLevel Me.hWnd, DSSCL_PRIORITY
Dim sb(100000000) As Byte
Dim psa(0) As DSBPOSITIONNOTIFY
'ReDim sb(0)
Do
DoEvents
status = decoder_decode(d, 0)
CopyMemory VarPtr(opbi), d.Addr06, Len(opbi)
'ReDim Preserve sb(i + opbi.size)
'CopyMemory VarPtr(UBound(sb) - opbi.size), opbi.pcm_samples, opbi.size
CopyMemory VarPtr(sb(i)), opbi.pcm_samples, opbi.size
i = i + opbi.size
Loop While status = XA_SUCCESS Or status = XA_ERROR_TIMEOUT Or status = XA_ERROR_INVALID_FRAME
dsbd.lFlags = DSBCAPS_CTRLVOLUME Or DSBCAPS_STATIC Or DSBCAPS_CTRLPOSITIONNOTIFY
dsbd.lBufferBytes = i
wf = MakeWaveEX(opbi.sample_rate, 2 ^ opbi.stereo, opbi.bytes_per_sample * 8)
Set dsb = ds.CreateSoundBuffer(dsbd, wf)
dsb.WriteBuffer 0, i, sb(0), DSBLOCK_DEFAULT
dsb.SetVolume 0
dx.SetEvent endEvent
psa(0).hEventNotify = endEvent
psa(0).lOffset = i - 1
dsb.SetNotificationPositions 1, psa()
dsb.Play DSBPLAY_DEFAULT
bContinue = True
'l = xaudio_get_api_version(XA_API_ID_SYNC)
'MsgBox "XAudio DLL Version: " & ((l \ (2 ^ 16)) And &H255) & "." & ((l \ (2 ^ 8)) And &H255) & "." & (l And &H255)
End Sub
Private Sub cmdPlay_Click()
Dim s As String
Dim l As Long
Dim status As Integer
Dim t As XA_InputModule
Dim d As XA_DecoderInfo
Dim dp As Long
Dim opbi As XA_OutputBufferInfo
Dim i As Long
dp = VarPtr(d)
status = decoder_new(VarPtr(dp))
If status <> XA_SUCCESS Then
MsgBox "can not create decoder!"
Exit Sub
End If
CopyMemory VarPtr(d), dp, 60
status = file_input_module_register(t)
status = decoder_input_module_register(d, t)
If status <> XA_SUCCESS Then MsgBox xaudio_error_string(status)
status = decoder_input_new(d, App.Path & "\4.mp3", XA_DECODER_INPUT_AUTOSELECT)
If status <> XA_SUCCESS Then
MsgBox "can not create input!" & status & vbCrLf & xaudio_error_string(status)
Exit Sub
End If
status = decoder_input_open(d)
If status <> XA_SUCCESS Then
MsgBox "can not open input!" & vbCrLf & xaudio_error_string(status)
Exit Sub
End If
Set ds = dx.DirectSoundCreate(vbNullString)
ds.SetCooperativeLevel Me.hWnd, DSSCL_PRIORITY
Dim sb(5000000) As Byte
Dim psa(0) As DSBPOSITIONNOTIFY
bPlaying = False
Do
DoEvents
status = decoder_decode(d, 0)
CopyMemory VarPtr(opbi), d.Addr06, Len(opbi)
If i + opbi.size > 5000000 Then
Do While bPlaying
DoEvents
Loop
dsbd.lFlags = DSBCAPS_CTRLVOLUME Or DSBCAPS_STATIC Or DSBCAPS_CTRLPOSITIONNOTIFY Or DSBCAPS_GLOBALFOCUS
dsbd.lBufferBytes = i
wf = MakeWaveEX(opbi.sample_rate, 2 ^ opbi.stereo, opbi.bytes_per_sample * 8)
Set dsb = ds.CreateSoundBuffer(dsbd, wf)
dsb.WriteBuffer 0, i, sb(0), DSBLOCK_DEFAULT
dsb.SetVolume 0
dx.SetEvent endEvent
psa(0).hEventNotify = endEvent
psa(0).lOffset = i - 1
dsb.SetNotificationPositions 1, psa()
dsb.Play DSBPLAY_DEFAULT
bContinue = True
bPlaying = True
i = 0
End If
CopyMemory VarPtr(sb(i)), opbi.pcm_samples, opbi.size
i = i + opbi.size
Loop While status = XA_SUCCESS Or status = XA_ERROR_TIMEOUT Or status = XA_ERROR_INVALID_FRAME
dsbd.lFlags = DSBCAPS_CTRLVOLUME Or DSBCAPS_STATIC Or DSBCAPS_CTRLPOSITIONNOTIFY Or DSBCAPS_GLOBALFOCUS
dsbd.lBufferBytes = i
wf = MakeWaveEX(opbi.sample_rate, 2 ^ opbi.stereo, opbi.bytes_per_sample * 8)
Set dsb = ds.CreateSoundBuffer(dsbd, wf)
dsb.WriteBuffer 0, i, sb(0), DSBLOCK_DEFAULT
dsb.SetVolume 0
dx.SetEvent endEvent
psa(0).hEventNotify = endEvent
psa(0).lOffset = i - 1
dsb.SetNotificationPositions 1, psa()
dsb.Play DSBPLAY_DEFAULT
bContinue = True
bPlaying = True
End Sub
Private Sub Form_Load()
endEvent = dx.CreateEvent(Me)
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If endEvent Then dx.DestroyEvent endEvent
If Not dsb Is Nothing Then dsb.Stop
bPlaying = False
Set dsb = Nothing
Set ds = Nothing
Set dx = Nothing
End
End Sub
Private Function MakeWaveEX(Hz As Long, Channels As Integer, Bits As Integer) As WAVEFORMATEX
MakeWaveEX.lSamplesPerSec = Hz
MakeWaveEX.lExtra = 0
MakeWaveEX.nSize = 0
MakeWaveEX.nBitsPerSample = Bits
MakeWaveEX.nChannels = Channels
MakeWaveEX.nFormatTag = WAVE_FORMAT_PCM
MakeWaveEX.nBlockAlign = Channels * Bits \ 8
MakeWaveEX.lAvgBytesPerSec = Hz * (Channels * Bits \ 8)
End Function
Private Sub DirectXEvent_DXCallback(ByVal eventid As Long)
If bContinue Then bContinue = False: Exit Sub
bPlaying = False
End Sub
modXAudio.bas
Attribute VB_Name = "modXAudio"
Option Explicit
'/*****************************************************************
'|
'| Xaudio General Definitions
'|
'| (c) 1996-1998 MpegTV, LLC
'| Author: Gilles Boccon-Gibod (gilles@mpegtv.com)
'|
' ****************************************************************/
'/*----------------------------------------------------------------------
'| types
'+---------------------------------------------------------------------*/
'typedef void (*XA_ProgressNotificationFunction)(void *client,
' int source,
' int code,
' long value,
' const char *message);
'typedef void (*XA_DebugNotificationFunction)(void *client,
' int source,
' int level,
' const char *message,
' const char *reason);
'typedef void (*XA_ErrorNotificationFunction)(void *client,
' int source,
' int code,
' const char *message,
' const char *reason);
Public Type XA_NotificationClient
'void *client;
'XA_ProgressNotificationFunction notify_progress;
'XA_DebugNotificationFunction notify_debug;
'XA_ErrorNotificationFunction notify_error;
Addr01 As Long
Addr02 As Long
Addr03 As Long
Addr04 As Long
End Type
'#define XA_NOTIFY_PROGRESS(_client, _source, _code, _value, _message) \
'if ((_client) && (_client)->notify_progress) \
' (*(_client)->notify_progress)((_client)->client, \
' _source, _code, _value, _message)
'#define XA_NOTIFY_DEBUG(_client, _source, _level, _message, _reason) \
'if ((_client) && (_client)->notify_debug) \
' (*(_client)->notify_debug)((_client)->client, \
' _source, _level, _message, _reason)
'#define XA_NOTIFY_ERROR(_client, _source, _code, _message, _reason) \
'if ((_client) && (_client)->notify_error) \
' (*(_client)->notify_error)((_client)->client, \
' _source, _code, _message, _reason)
'/*----------------------------------------------------------------------
'| apis
'+---------------------------------------------------------------------*/
Public Const XA_API_ID_SYNC = 1
Public Const XA_API_ID_ASYNC = 2
'/*----------------------------------------------------------------------
'| error codes
'+---------------------------------------------------------------------*/
Public Const XA_SUCCESS = (0)
Public Const XA_FAILURE = (-1)
'/* general error codes */
Public Const XA_ERROR_BASE_GENERAL = (-100)
Public Const XA_ERROR_OUT_OF_MEMORY = (XA_ERROR_BASE_GENERAL - 0)
Public Const XA_ERROR_INVALID_PARAMETERS = (XA_ERROR_BASE_GENERAL - 1)
Public Const XA_ERROR_INTERNAL = (XA_ERROR_BASE_GENERAL - 2)
Public Const XA_ERROR_TIMEOUT = (XA_ERROR_BASE_GENERAL - 3)
Public Const XA_ERROR_VERSION_EXPIRED = (XA_ERROR_BASE_GENERAL - 4)
'/* network error codes */
Public Const XA_ERROR_BASE_NETWORK = (-200)
Public Const XA_ERROR_CONNECT_TIMEOUT = (XA_ERROR_BASE_NETWORK - 0)
Public Const XA_ERROR_CONNECT_FAILED = (XA_ERROR_BASE_NETWORK - 1)
Public Const XA_ERROR_CONNECTION_REFUSED = (XA_ERROR_BASE_NETWORK - 2)
Public Const XA_ERROR_ACCEPT_FAILED = (XA_ERROR_BASE_NETWORK - 3)
Public Const XA_ERROR_LISTEN_FAILED = (XA_ERROR_BASE_NETWORK - 4)
Public Const XA_ERROR_SOCKET_FAILED = (XA_ERROR_BASE_NETWORK - 5)
Public Const XA_ERROR_SOCKET_CLOSED = (XA_ERROR_BASE_NETWORK - 6)
Public Const XA_ERROR_BIND_FAILED = (XA_ERROR_BASE_NETWORK - 7)
Public Const XA_ERROR_HOST_UNKNOWN = (XA_ERROR_BASE_NETWORK - 8)
Public Const XA_ERROR_HTTP_INVALID_REPLY = (XA_ERROR_BASE_NETWORK - 9)
Public Const XA_ERROR_HTTP_ERROR_REPLY = (XA_ERROR_BASE_NETWORK - 10)
Public Const XA_ERROR_HTTP_FAILURE = (XA_ERROR_BASE_NETWORK - 11)
Public Const XA_ERROR_FTP_INVALID_REPLY = (XA_ERROR_BASE_NETWORK - 12)
Public Const XA_ERROR_FTP_ERROR_REPLY = (XA_ERROR_BASE_NETWORK - 13)
Public Const XA_ERROR_FTP_FAILURE = (XA_ERROR_BASE_NETWORK - 14)
'/* control error codes */
Public Const XA_ERROR_BASE_CONTROL = (-300)
Public Const XA_ERROR_PIPE_FAILED = (XA_ERROR_BASE_CONTROL - 0)
Public Const XA_ERROR_FORK_FAILED = (XA_ERROR_BASE_CONTROL - 1)
Public Const XA_ERROR_SELECT_FAILED = (XA_ERROR_BASE_CONTROL - 2)
Public Const XA_ERROR_PIPE_CLOSED = (XA_ERROR_BASE_CONTROL - 3)
Public Const XA_ERROR_PIPE_READ_FAILED = (XA_ERROR_BASE_CONTROL - 4)
Public Const XA_ERROR_PIPE_WRITE_FAILED = (XA_ERROR_BASE_CONTROL - 5)
Public Const XA_ERROR_INVALID_MESSAGE = (XA_ERROR_BASE_CONTROL - 6)
Public Const XA_ERROR_CIRQ_FULL = (XA_ERROR_BASE_CONTROL - 7)
Public Const XA_ERROR_POST_FAILED = (XA_ERROR_BASE_CONTROL - 8)
'/* url error codes */
Public Const XA_ERROR_BASE_URL = (-400)
Public Const XA_ERROR_URL_UNSUPPORTED_SCHEME = (XA_ERROR_BASE_URL - 0)
Public Const XA_ERROR_URL_INVALID_SYNTAX = (XA_ERROR_BASE_URL - 1)
'/* i/o error codes */
Public Const XA_ERROR_BASE_IO = (-500)
Public Const XA_ERROR_OPEN_FAILED = (XA_ERROR_BASE_IO - 0)
Public Const XA_ERROR_CLOSE_FAILED = (XA_ERROR_BASE_IO - 1)
Public Const XA_ERROR_READ_FAILED = (XA_ERROR_BASE_IO - 2)
Public Const XA_ERROR_WRITE_FAILED = (XA_ERROR_BASE_IO - 3)
Public Const XA_ERROR_PERMISSION_DENIED = (XA_ERROR_BASE_IO - 4)
Public Const XA_ERROR_NO_DEVICE = (XA_ERROR_BASE_IO - 5)
Public Const XA_ERROR_IOCTL_FAILED = (XA_ERROR_BASE_IO - 6)
Public Const XA_ERROR_MODULE_NOT_FOUND = (XA_ERROR_BASE_IO - 7)
Public Const XA_ERROR_UNSUPPORTED_INPUT = (XA_ERROR_BASE_IO - 8)
Public Const XA_ERROR_UNSUPPORTED_OUTPUT = (XA_ERROR_BASE_IO - 9)
Public Const XA_ERROR_UNSUPPORTED_FORMAT = (XA_ERROR_BASE_IO - 10)
Public Const XA_ERROR_DEVICE_BUSY = (XA_ERROR_BASE_IO - 11)
Public Const XA_ERROR_NO_SUCH_DEVICE = (XA_ERROR_BASE_IO - 12)
Public Const XA_ERROR_NO_SUCH_FILE = (XA_ERROR_BASE_IO - 13)
Public Const XA_ERROR_INPUT_EOF = (XA_ERROR_BASE_IO - 14)
'/* bitstream error codes */
Public Const XA_ERROR_BASE_BITSTREAM = (-600)
Public Const XA_ERROR_INVALID_FRAME = (XA_ERROR_BASE_BITSTREAM - 0)
'/* dynamic linking error codes */
Public Const XA_ERROR_BASE_DYNLINK = (-700)
Public Const XA_ERROR_DLL_NOT_FOUND = (XA_ERROR_BASE_DYNLINK - 0)
Public Const XA_ERROR_SYMBOL_NOT_FOUND = (XA_ERROR_BASE_DYNLINK - 1)
'/* environment variables error codes */
Public Const XA_ERROR_BASE_ENVIRONMENT = (-800)
Public Const XA_ERROR_NO_SUCH_ENVIRONMENT = (XA_ERROR_BASE_ENVIRONMENT - 0)
Public Const XA_ERROR_ENVIRONMENT_TYPE_MISMATCH = (XA_ERROR_BASE_ENVIRONMENT - 1)
[1] [2] 下一页 |
相关文章：（只显示最新16条）