VB 循环播放声音文件时audiodg.exe进程占用内存持续增大，怎么解决？

[ajunajun]

循环播放声音文件时audiodg.exe进程占用内存持续增大，直到必须关闭程序，怎么解决？
这是从网上下的源程序，进行了修改，模块里的东西看不懂。
源程序网址：http://www.newxing.com/Code/VB/Multimedia/4296.html
我删除了波形显示部分，增加了timer1控件进行连续播放
窗体界面控件如下（只支持扩展名为wav格式的文件）：

Option Explicit
Dim filename As String
Dim errStr As String * 200
Const MAX_SCROLL_VALUE = 1000
Private Sub Command4_Click()
End
End Sub
Private Sub Command5_Click()
Timer1.Enabled = True
End Sub
Private Sub Form_Load()
' 初始化
   PlayWavModule.fFileLoaded = False
   CommonDialog1.filename = "*.wav"
   CommonDialog1.DefaultExt = "wav"
End Sub
Private Sub Command1_Click()
'打开一个wave文件
   CommonDialog1.ShowOpen
   filename = CommonDialog1.filename
   Text1.Text = filename
   LoadFile filename
   PlayWavModule.drawFrom = 0
   PlayWavModule.drawTo = PlayWavModule.numSamples
End Sub
Private Sub Command2_Click()
'播放
   If (PlayWavModule.fPlaying = False) Then
      Play -1
   End If
   Timer1.Enabled = False
End Sub
Private Sub Command3_Click()
' 停止播放
   StopPlay
   Timer1.Enabled = False
End Sub
Private Sub SetPlayRange()
   PlayWavModule.drawFrom = CLng(PlayWavModule.numSamples * (HScroll1.Value / MAX_SCROLL_VALUE))
   PlayWavModule.drawTo = CLng(PlayWavModule.numSamples * (HScroll2.Value / MAX_SCROLL_VALUE))
   waveForm.DrawWaves
End Sub
Private Sub Timer1_Timer()
  If PlayWavModule.fPlaying = False Then
      Play -1
  End If
End Sub

'模块内容如下：

Option Explicit
Public Const CALLBACK_FUNCTION = &H30000
Public Const MMIO_READ = &H0
Public Const MMIO_FINDCHUNK = &H10
Public Const MMIO_FINDRIFF = &H20
Public Const MM_WOM_DONE = &H3BD

Type mmioinfo
   dwFlags As Long
   fccIOProc As Long
   pIOProc As Long
   wErrorRet As Long
   htask As Long
   cchBuffer As Long
   pchBuffer As String
   pchNext As String
   pchEndRead As String
   pchEndWrite As String
   lBufOffset As Long
   lDiskOffset As Long
   adwInfo(4) As Long
   dwReserved1 As Long
   dwReserved2 As Long
   hmmio As Long
End Type

Type WAVEHDR
   lpData As Long
   dwBufferLength As Long
   dwBytesRecorded As Long
   dwUser As Long
   dwFlags As Long
   dwLoops As Long
   lpNext As Long
   Reserved As Long
   End Type
   Type WAVEINCAPS
   wMid As Integer
   wPid As Integer
   vDriverVersion As Long
   szPname As String * 32
   dwFormats As Long
   wChannels As Integer
   End Type
   Type WAVEFORMAT
   wFormatTag As Integer
   nChannels As Integer
   nSamplesPerSec As Long
   nAvgBytesPerSec As Long
   nBlockAlign As Integer
   wBitsPerSample As Integer
   cbSize As Integer
End Type
'Download by http://www.NewXing.com
Type MMCKINFO
    ckid As Long
    ckSize As Long
    fccType As Long
    dwDataOffset As Long
    dwFlags As Long
End Type


Declare Function waveOutOpen Lib "winmm.dll" _
    (lphWaveIn As Long, _
    ByVal uDeviceID As Long, _
    lpFormat As WAVEFORMAT, _
    ByVal dwCallback As Long, _
    ByVal dwInstance As Long, _
    ByVal dwFlags As Long) As Long
    
Declare Function waveOutPrepareHeader Lib "winmm.dll" _
    (ByVal hWaveIn As Long, _
    lpWaveInHdr As WAVEHDR, _
    ByVal uSize As Long) As Long
    
Declare Function waveOutReset Lib "winmm.dll" _
    (ByVal hWaveIn As Long) As Long
    
Declare Function waveOutStart Lib "winmm.dll" _
    (ByVal hWaveIn As Long) As Long
    
Declare Function waveOutStop Lib "winmm.dll" _
    (ByVal hWaveIn As Long) As Long
    
Declare Function waveOutUnprepareHeader Lib "winmm.dll" _
    (ByVal hWaveIn As Long, _
    lpWaveInHdr As WAVEHDR, _
    ByVal uSize As Long) As Long
    
Declare Function waveOutClose Lib "winmm.dll" _
    (ByVal hWaveIn As Long) As Long
    
Declare Function waveOutGetDevCaps Lib "winmm.dll" Alias "waveInGetDevCapsA" _
    (ByVal uDeviceID As Long, _
    lpCaps As WAVEINCAPS, _
    ByVal uSize As Long) As Long
    
Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long

Declare Function waveOutGetErrorText Lib "winmm.dll" Alias "waveInGetErrorTextA" _
    (ByVal err As Long, _
    ByVal lpText As String, _
    ByVal uSize As Long) As Long
    
Declare Function waveOutAddBuffer Lib "winmm.dll" _
    (ByVal hWaveIn As Long, _
    lpWaveInHdr As WAVEHDR, _
    ByVal uSize As Long) As Long
    
Declare Function waveOutWrite Lib "winmm.dll" _
    (ByVal hWaveOut As Long, _
    lpWaveOutHdr As WAVEHDR, _
    ByVal uSize As Long) As Long
    
Declare Function mmioClose Lib "winmm.dll" _
    (ByVal hmmio As Long, _
    ByVal uFlags As Long) As Long
    
Declare Function mmioDescend Lib "winmm.dll" _
    (ByVal hmmio As Long, _
    lpck As MMCKINFO, _
    lpckParent As MMCKINFO, _
    ByVal uFlags As Long) As Long
    
Declare Function mmioDescendParent Lib "winmm.dll" Alias "mmioDescend" _
    (ByVal hmmio As Long, _
    lpck As MMCKINFO, _
    ByVal x As Long, _
    ByVal uFlags As Long) As Long
    
Declare Function mmioOpen Lib "winmm.dll" Alias "mmioOpenA" _
    (ByVal szFileName As String, _
    lpmmioinfo As mmioinfo, _
    ByVal dwOpenFlags As Long) As Long
    
Declare Function mmioRead Lib "winmm.dll" _
    (ByVal hmmio As Long, _
    ByVal pch As Long, _
    ByVal cch As Long) As Long
    
Declare Function mmioReadFormat Lib "winmm.dll" Alias "mmioRead" _
    (ByVal hmmio As Long, _
    ByRef pch As WAVEFORMAT, _
    ByVal cch As Long) As Long
    
Declare Function mmioStringToFOURCC Lib "winmm.dll" Alias "mmioStringToFOURCCA" _
    (ByVal sz As String, _
    ByVal uFlags As Long) As Long
    
Declare Function mmioAscend Lib "winmm.dll" _
    (ByVal hmmio As Long, _
    lpck As MMCKINFO, _
    ByVal uFlags As Long) As Long
    
Declare Function GlobalAlloc Lib "kernel32" _
    (ByVal wFlags As Long, _
    ByVal dwBytes As Long) As Long
    
Declare Function GlobalLock Lib "kernel32" _
    (ByVal hmem As Long) As Long
    
Declare Function GlobalFree Lib "kernel32" _
    (ByVal hmem As Long) As Long
    
Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" _
    (struct As Any, _
    ByVal ptr As Long, _
    ByVal cb As Long)

Dim rc As Long
Dim msg As String * 200

' 和wav文件属性有关的变量
Public format As WAVEFORMAT
Dim hmmioOut As Long
Dim mmckinfoParentIn As MMCKINFO
Dim mmckinfoSubchunkIn As MMCKINFO
Dim hWaveOut As Long
Dim bufferIn As Long
Dim hmem As Long
Dim outHdr As WAVEHDR
Public numSamples As Long
Public drawFrom As Long
Public drawTo As Long
Public fFileLoaded As Boolean
Public fPlaying As Boolean

Sub waveOutProc(ByVal hwi As Long, ByVal uMsg As Long, ByVal dwInstance As Long, ByRef hdr As WAVEHDR, ByVal dwParam2 As Long)
   If (uMsg = MM_WOM_DONE) Then
      fPlaying = False
   End If
End Sub

Sub CloseWaveOut()
    rc = waveOutReset(hWaveOut)
    rc = waveOutUnprepareHeader(hWaveOut, outHdr, Len(outHdr))
    rc = waveOutClose(hWaveOut)
End Sub

Sub LoadFile(inFile As String)
' 加载wav文件
   Dim hmmioIn As Long
   Dim mmioinf As mmioinfo
   fFileLoaded = False
   If (inFile = "") Then
       GlobalFree (hmem)
       Exit Sub
   End If
   ' 打开wav文件
   hmmioIn = mmioOpen(inFile, mmioinf, MMIO_READ)
   If hmmioIn = 0 Then
       MsgBox "Error opening input file, rc = " & mmioinf.wErrorRet
       Exit Sub
   End If
   
   '检查是否是合法的wav文件
   mmckinfoParentIn.fccType = mmioStringToFOURCC("WAVE", 0)
   rc = mmioDescendParent(hmmioIn, mmckinfoParentIn, 0, MMIO_FINDRIFF)
   If (rc <> 0) Then
       rc = mmioClose(hmmioOut, 0)
       MsgBox "Not a wave file"
       Exit Sub
   End If
   
   mmckinfoSubchunkIn.ckid = mmioStringToFOURCC("fmt", 0)
   rc = mmioDescend(hmmioIn, mmckinfoSubchunkIn, mmckinfoParentIn, MMIO_FINDCHUNK)
   If (rc <> 0) Then
       rc = mmioClose(hmmioOut, 0)
       MsgBox "Couldn't get format chunk"
       Exit Sub
   End If
   rc = mmioReadFormat(hmmioIn, format, Len(format))
   If (rc = -1) Then
      rc = mmioClose(hmmioOut, 0)
      MsgBox "Error reading format"
      Exit Sub
   End If
   rc = mmioAscend(hmmioIn, mmckinfoSubchunkIn, 0)
   
   mmckinfoSubchunkIn.ckid = mmioStringToFOURCC("data", 0)
   rc = mmioDescend(hmmioIn, mmckinfoSubchunkIn, mmckinfoParentIn, MMIO_FINDCHUNK)
   If (rc <> 0) Then
      rc = mmioClose(hmmioOut, 0)
      MsgBox "Couldn't get data chunk"
      Exit Sub
   End If
   
   GlobalFree hmem
   hmem = GlobalAlloc(&H40, mmckinfoSubchunkIn.ckSize)
   bufferIn = GlobalLock(hmem)
   rc = mmioRead(hmmioIn, bufferIn, mmckinfoSubchunkIn.ckSize)
   
   numSamples = mmckinfoSubchunkIn.ckSize / format.nBlockAlign
   
   ' 关闭文件
   rc = mmioClose(hmmioOut, 0)
   
   fFileLoaded = True
    
End Sub

Sub Play(ByVal soundcard As Integer)

    rc = waveOutOpen(hWaveOut, soundcard, format, AddressOf waveOutProc, 0, CALLBACK_FUNCTION)
    If (rc <> 0) Then
      GlobalFree (hmem)
      waveOutGetErrorText rc, msg, Len(msg)
      MsgBox msg
      Exit Sub
    End If

    outHdr.lpData = bufferIn + (drawFrom * format.nBlockAlign)
    outHdr.dwBufferLength = (drawTo - drawFrom) * format.nBlockAlign
    outHdr.dwFlags = 0
    outHdr.dwLoops = 0

    rc = waveOutPrepareHeader(hWaveOut, outHdr, Len(outHdr))
    If (rc <> 0) Then
      waveOutGetErrorText rc, msg, Len(msg)
      MsgBox msg
    End If

    rc = waveOutWrite(hWaveOut, outHdr, Len(outHdr))
    If (rc <> 0) Then
      GlobalFree (hmem)
    Else
      fPlaying = True
      VoiceAlarmSetForm.Timer1.Enabled = True
    End If
End Sub

Sub StopPlay()
   waveOutReset (hWaveOut)
End Sub

Sub GetStereo16Sample(ByVal sample As Long, ByRef leftVol As Double, ByRef rightVol As Double)

   Dim sample16 As Integer
   Dim ptr As Long
   
   ptr = sample * format.nBlockAlign + bufferIn
   CopyStructFromPtr sample16, ptr, 2
   leftVol = sample16 / 32768
   CopyStructFromPtr sample16, ptr + 2, 2
   rightVol = sample16 / 32768

End Sub

Sub GetStereo8Sample(ByVal sample As Long, ByRef leftVol As Double, ByRef rightVol As Double)
   Dim sample8 As Byte
   Dim ptr As Long  
   ptr = sample * format.nBlockAlign + bufferIn
   CopyStructFromPtr sample8, ptr, 1
   leftVol = (sample8 - 128) / 128
   CopyStructFromPtr sample8, ptr + 1, 1
   rightVol = (sample8 - 128) / 128
End Sub

'实在写不下，自己回复时再添加

[ajunajun]

Sub GetMono16Sample(ByVal sample As Long, ByRef leftVol As Double)

   Dim sample16 As Integer
   Dim ptr As Long
   
   ptr = sample * format.nBlockAlign + bufferIn
   CopyStructFromPtr sample16, ptr, 2
   leftVol = sample16 / 32768

End Sub

Sub GetMono8Sample(ByVal sample As Long, ByRef leftVol As Double)

   Dim sample8 As Byte
   Dim ptr As Long
   
   ptr = sample * format.nBlockAlign + bufferIn
   CopyStructFromPtr sample8, ptr, 1
   leftVol = (sample8 - 128) / 128

End Sub

[赵4老师]

引用 8 楼 ajunajun 的回复:

赵老师，能发个完整的代码吗？不能用啊

百度搜相关关键字。

[熊孩子开学喽]

直接拿C写一个,或者网上下一个DOS下的WAV播放器, 然后shell吧.

[赵4老师]

为什么不 使用MCI呢？

[脆皮大雪糕]

你的主窗体每次timer 调用的 play 函数都又重新进行了文件读取之类的操作，想必声音停止了，这玩意也没有释放该释放的东西，建议在开始播放前先调一下waveOutReset试试

[ajunajun]

赵老师，能发个完整的代码吗？不能用啊

[ajunajun]

引用 2 楼 zhao4zhong1 的回复:

为什么不 使用MCI呢？

MC是什么？有链接吗？

[ajunajun]

引用 3 楼 chewinggum 的回复:

你的主窗体每次timer 调用的 play 函数都又重新进行了文件读取之类的操作，想必声音停止了，这玩意也没有释放该释放的东西，建议在开始播放前先调一下waveOutReset试试

是不是在Timer1的事件里这么写？

Dim wor As Long
Call waveOutReset(wor)

添加上以后内存还是持续增加。 下面这么写也不行，仍然会增加

Dim hwi1 As Long
Dim umsgq As Long
Dim dwinstance1 As Long
Dim hdr1 As WAVEHDR
Dim dwp1 As Long
Call waveOutProc(hwi1, umsgq, dwinstance1, hdr1, dwp1)

[赵4老师]

MCI

MCI32.OCX

   Begin MCI.MMControl wav
      Height          =   495
      Left            =   4845
      TabIndex        =   35
      Top             =   6705
      Visible         =   0   'False
      Width           =   3540
      _ExtentX        =   6244
      _ExtentY        =   873
      _Version        =   393216
      DeviceType      =   ""
      FileName        =   ""
   End
    wav.Notify = False
    wav.Wait = True
    wav.Shareable = False
    wav.TimeFormat = 0&
    wav.DeviceType = "WaveAudio"
Sub WAVPlay(WavName As String)
    wav.Command = "Stop"
    wav.Command = "Close"
    If FileExists(WavName + ".wav") Then
        wav.filename = WavName + ".wav"
    Else
        wav.filename = App.Path + "\a.wav"
    End If
    wav.Command = "Open"
    If Not Hidden Then wav.Command = "Play"
    'Sleep (wav.Length + 300)
End Sub

[赵4老师]

Multimedia MCI Multimedia MCI 包含一组高层次的独立于设备的命令，可以控制音频和视频外设。首先发送的 MCI 命令就是 Open。这条命令打开规定的 MCI 设备，标识将要在设备上播放或记录的文件。有些设备，如 CDAudio、VCR 和视盘等，并不使用文件，所以无需提供文件名。 设备打开后，可以发送任何其它的 MCI 命令（如 Prev、Next、Pause 等）。Close 命令是向设备发送的最后一条 MCI 命令，它返回到可用的系统资源缓冲池，Close 命令还关闭与设备相关的数据文件。 关于 Multimedia MCI 控件所支持的 MCI 命令清单，查看 Command 属性。关于 Multimedia MCI 的更多的信息，请参阅 Microsoft Win32 Software Development Kit Multimedia Programmer's Reference。