关于使用WaveIn,WaveOut系列函数采集播放声音的程序

[kongrenxin]

我想做一个局域网间语音聊天的小程序，网上关于这个方面的资料不少，但讲述得稍微系统完整点的资料好难找呀！折腾了这么几天，还是有问题，拿出来大家看看，找找错误的地方 ^_^。 其中采集声音部分好像没什么问题了，在用udp发送的时候，偶尔会报‘invalid stream’错误，关闭程序的时候也报错误。
有兴趣的可以调试下，界面简单 三个TLabel,三个TEdit,2个TButton,一个NMUDP,一个进度条，一个TStatusBar
下面是我所有的代码：

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, MMSystem, StdCtrls, ComCtrls, NMUDP;

type
TForm1 = class(TForm)
btnStart: TButton;
edtHost: TEdit;
NMUDP: TNMUDP;
ProgressBar: TProgressBar;
Label1: TLabel;
Label2: TLabel;
edtRemotePort: TEdit;
Label3: TLabel;
edtLocalPort: TEdit;
btnActive: TButton;
StatusBar1: TStatusBar;
procedure btnStartClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnActiveClick(Sender: TObject);
procedure NMUDPDataSend(Sender: TObject);
procedure NMUDPDataReceived(Sender: TComponent; NumberBytes: Integer;
FromIP: String; Port: Integer);
private
{ Private declarations }
WavHandle: HWaveIn;
wHandle: HWaveOut;
WavFmt: TWaveFormatEx;
WavHdr: Array [0..1] of PWAVEHDR;
WavBuf: Array [0..1] of LPSTR;
wHdr: Array [0..1] of PWAVEHDR;
wBuf: Array [0..1] of LPSTR;
Flag: Boolean;
WavBufSize, index, outdex: Integer;
public
{ Public declarations }
procedure InitialWavHdr();
procedure AddBuffer;
procedure PlayWav();
procedure WAVEOPEN(var Msg: TMessage); message MM_WIM_OPEN;
procedure WAVEINBUFFINISHED(var Msg: TMessage); message MM_WIM_DATA;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btnStartClick(Sender: TObject);
var
i: Integer;
begin
WaveInStart(WavHandle);
for i := 0 to 1 do
AddBuffer;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
i, err: Integer;
begin
Flag := False;
WavFmt.wFormatTag := WAVE_FORMAT_PCM;
WavFmt.nChannels := 1;
WavFmt.nSamplesPerSec := 11025;
WavFmt.nAvgBytesPerSec := 11025;
WavFmt.nBlockAlign := 2;
WavFmt.wBitsPerSample := 16;
WavFmt.cbSize := 0;
WavBufSize := 4096;
index := 0;
outdex := 0;
if WaveInOpen(@WavHandle,WAVE_MAPPER,@WavFmt,self.Handle,0,CALLBACK_WINDOW or WAVE_ALLOWSYNC ) <> 0 then
begin
Showmessage('Error!');
Exit;
end;
WaveOutOpen(@WHandle,WAVE_MAPPER,@WavFmt,self.Handle,0,CALLBACK_WINDOW or WAVE_ALLOWSYNC);
InitialWavHdr;
for i := 0 to 1 do
begin
err :=WaveInPrepareHeader(WavHandle,WavHdr[i],SizeOf(WAVEHDR));
if err <> 0 then showmessage('error!');
end;

for i := 0 to 1 do
begin
err :=WaveOutPrepareHeader(wHandle,@wHdr[i],SizeOf(WAVEHDR));
if err <> 0 then showmessage('error!');
end;
end;

procedure TForm1.WAVEINBUFFINISHED(var Msg: TMessage);
var
sp: ^smallint;
i, N, V, xMin, xMax: Integer;
myStream: TMemoryStream;
begin
N := WavBufSize div 2;
sp := Pointer(WavBuf[Index]);
if Flag then
begin
try
myStream := TMemoryStream.Create;
myStream.Write(WavBuf[Index],Length(WavBuf[Index]));
//myStream.Write('slds',4);
NMUDP.ReportLevel := Status_Basic;
NMUDP.SendStream(myStream);
except
//因为这里偶尔会有invalid stream错误报告，先把它干掉，还不知道什么原因
end;
myStream.Free;

end;

xMin := sp^;
xMax := xMin;

For i := 0 to N-1 Do
Begin
v := SP^;
if v <> ProgressBar.Position then ProgressBar.Position := v;
Inc(SP);
End;
AddBuffer;
Flag := True;
end;

procedure TForm1.WAVEOPEN(var Msg: TMessage);
begin
//
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
i: Integer;
begin
for i := 0 to 1 do
begin
WaveInUnprepareHeader(WavHandle,WavHdr[i],SizeOf(WAVEHDR));
WaveOutUnPrepareHeader(wHandle,wHdr[i],SizeOf(WAVEHDR));
end;
WaveInReset(WavHandle);
WaveInClose(WavHandle);
WaveOutReset(wHandle);
WaveOutClose(wHandle);
end;

procedure TForm1.InitialWavHdr;
var
i: Integer;
begin
for i := 0 to 1 do
begin
WavHdr[i] := GlobalAllocPtr(GMEM_MOVEABLE or GMEM_SHARE, sizeof(WAVEHDR));
wHdr[i] := GlobalAllocPtr(GMEM_MOVEABLE or GMEM_SHARE, sizeof(WAVEHDR));
//if WavHdr[i] = nil then begin ShowMessage('Error!'); Exit; end;
WavBuf[i] := GlobalAllocPtr(GMEM_MOVEABLE or GMEM_SHARE,WavBufSize);
wBuf[i] := GlobalAllocPtr(GMEM_MOVEABLE or GMEM_SHARE,WavBufSize);
WavHdr[i].lpData := LPSTR(WavBuf[i]);
wHdr[i].lpData := LPSTR(wBuf[i]);
WavHdr[i].dwBufferLength := WavBufSize;
WavHdr[i].dwBytesRecorded := 0;
WavHdr[i].dwUser := 0;
WavHdr[i].dwFlags := 0;
WavHdr[i].dwLoops := 0;
WavHdr[i].lpNext := nil;
WavHdr[i].reserved := 0;
end;
end;

procedure TForm1.AddBuffer;
var
err: Integer;
begin
WavHdr[Index].dwFlags := WHDR_PREPARED;
err := WaveInAddBuffer(WavHandle,WavHdr[index],SizeOf(WAVEHDR));
if err <> 0 then
begin
ShowMessage('error!');
end;
Index := (Index+1) mod 2;
end;

procedure TForm1.btnActiveClick(Sender: TObject);
begin
NMUDP.RemoteHost := edtHost.Text;
NMUDP.LocalPort := StrToInt(edtLocalPort.Text);
NMUDP.RemotePort := StrToInt(edtRemotePort.Text);
end;

procedure TForm1.NMUDPDataSend(Sender: TObject);
begin
StatusBar1.Panels[0].Text := 'Stream sended out!';
repaint;
end;

procedure TForm1.NMUDPDataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String; Port: Integer);
var
myStream: TMemoryStream;
begin
myStream := TMemoryStream.Create;
NMUDP.ReadStream(myStream);
myStream.Read(wBuf[0],NumberBytes);
PlayWav;

end;

procedure TForm1.PlayWav;
var
err: Integer;
begin
wHdr[Index].dwFlags := WHDR_PREPARED;
err := WaveOutWrite(wHandle,wHdr[outdex],SizeOf(WAVEHDR));
if err <> 0 then
begin
ShowMessage('error!');
end;
outdex := (outdex+1) mod 2;
end;

end.