- //Delphi 6
- unit Unit1;
- interface
- uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, DSoundDevices, StdCtrls ,ActiveX, DirectSound, MMSystem;
- const
- //流缓冲区在小于3 个通知位置时工作的效率最高
- //波形音频数据传送速率(nAvgBytesPerSec)
- //录音缓冲区大小:nAvgBytesPerSec * NUM_REC_COUNT {缓冲区是NUM_REC_COUNT秒的录音数据}
- NUM_REC_COUNT = 4;
- //录音通知块大小:nAvgBytesPerSec div NUM_REC_BLOCK
- NUM_REC_BLOCK = 1;
- //录音通知个数
- NUM_REC_NOTIFICATIONS = NUM_REC_COUNT * NUM_REC_BLOCK ;
- so_Begin = 0;
- so_Current = 1;
- so_End = 2;
- type
- TWavHeader = packed record //定义一个Wav文件头格式
- RiffId: array[0..3]of Char; { 'RIFF' Identifier }
- RiffLength: Longword; //字节数:文件大小-8字节
- WaveId: array[0..3]of Char; { 'WAVE' Identifier }
- FormatId: array[0..3]of Char; { 'fmt ' Identifier }
- FormatSize: Longword; //块尺寸
- FormatTag: Word; { identifies PCM=1, ALAW=6, ULAW=7, etc }
- Channels: Word; { Mono=1, Stereo=2 }
- SamplesPerSec: Longword; { SampleRate in Hertz }
- AvgBytesPerSec: Longword;
- BlockAlign: Word;
- BitsPerSample: Word; { Resolution, e.g. 8 or 16 }
- DataId: array[0..3]of Char; { 'data' Identifier }
- FactSize: Longword;
- end;
- type
- TRecordCapturedData = class(TThread)
- private
- public
- procedure Execute; override;
- end;
- TForm1 = class(TForm)
- ComboBox1: TComboBox;
- Label1: TLabel;
- Memo1: TMemo;
- Button1: TButton;
- Button2: TButton;
- Button3: TButton;
- clear: TButton;
- procedure FormCreate(Sender: TObject);
- procedure Button1Click(Sender: TObject);
- procedure Button2Click(Sender: TObject);
- procedure Button3Click(Sender: TObject);
- procedure clearClick(Sender: TObject);
- procedure FormClose(Sender: TObject; var Action: TCloseAction);
- public
- function CreateCaptureBuffer(pDSC : IDirectSoundCapture8;
- out pDSCB : IDirectSoundCaptureBuffer;
- out pDSCB8 : IDirectSoundCaptureBuffer8;
- wfx : TWAVEFORMATEX;
- Num : Integer;
- out buffersize : DWORD):HRESULT;
- //录音块数量(dscbd.dwBufferBytes := wfx.nAvgBytesPerSec * Num;)
- function InitNotifications(pDSCB : IDirectSoundCaptureBuffer8;
- out pDSNotify8 : IDIRECTSOUNDNOTIFY8;
- out rghEvent : THandle;
- dwNotifySize : DWORD):HRESULT; //通知位置
- function RecordCapturedData(pDSCB8 : IDIRECTSOUNDCAPTUREBUFFER8):HRESULT;
- //自定义写一个Wav文件头过程
- procedure CreateWav(channels : word; resolution : word; rate : longint; fn : string);
- procedure SaveWave(filename : String; const Buffer; Count: LongWord);
- procedure CloseWav();
- procedure SaveEndWave(filename : String);
- procedure DestroyWav();
- private
- CaptureRecThread : TRecordCapturedData; //IDirectSoundCapture8录音线程
- filePath : String;
- wh : TWavHeader;
- end;
- var
- Form1: TForm1;
- g_pDSCapture : IDirectSoundCapture8 = nil; //设备对象指针
- g_pDSCB : IDIRECTSOUNDCAPTUREBUFFER = nil; //主缓冲区对象指针
- g_pDSCB8 : IDIRECTSOUNDCAPTUREBUFFER8 = nil; //缓冲区对象指针
- g_pDSNotify : IDIRECTSOUNDNOTIFY8 = nil; //用来设置通知的对象接口
- g_hNotificationEvent : THandle; //通知事件
- g_bRecording : BOOLEAN = FALSE; //是否正在录音
- g_dwCaptureBufferSize : DWORD; //录音用缓冲区块的大小
- g_dwNotifySize : DWORD; //通知位置
- g_dwNextCaptureOffset : DWORD = 0; //偏移位置
- RecordFileHandle : Integer = 0 ;
- implementation
- {$R *.DFM}
- //Thread
- procedure TRecordCapturedData.Execute;
- var
- dwResult : DWORD ;
- begin
- inherited;
- FreeOnTerminate := True;
- dwResult := 0;
- g_bRecording := TRUE ;
- While g_bRecording do
- begin
- //dwResult 范围: WAIT_OBJECT_0 ~ (WAIT_OBJECT_0 + NUM_REC_NOTIFICATIONS – 1)
- dwResult := WaitForMultipleObjects(1, @g_hNotificationEvent,FALSE,INFINITE);
- case dwResult of
- WAIT_OBJECT_0 + 0: Form1.RecordCapturedData(g_pDSCB8);
- end;
- end;
- end;
- //Form
- procedure TForm1.FormCreate(Sender: TObject);
- var
- i : integer;
- Guid : TGuid;
- begin
- ComboBox1.Clear;
- Memo1.Clear ;
- if DSDeviceList.Count < 1 then Exit;
- for i := 0 to DSDeviceList.Count -1 do
- begin
- ComboBox1.Items.Add(DSDeviceList.Items[i].DeviceName);
- end;
- ComboBox1.ItemIndex := 0;
- end;
- procedure TForm1.Button1Click(Sender: TObject);
- var
- devIndex : integer;
- devGUID : TGUID;
- hr : HResult;
- dsBuffer : DSCBUFFERDESC;
- wfx : TWAVEFORMATEX;
- begin
- devIndex := ComboBox1.ItemIndex; //设备枚举序号
- devGUID := DSDeviceList.Items[devIndex].DeviceGUID;
- g_pDSCapture := nil;
- //创建设备对象
- if not IsEqualGUID(GUID_NULL,devGUID) then
- begin
- hr := DirectSoundCaptureCreate8(@devGUID, g_pDSCapture, nil);
- Memo1.Lines.Add('GUID_Null OK:' + inttostr(hr));
- end
- else
- begin
- hr := DirectSoundCaptureCreate8(@DSDEVID_DefaultCapture, g_pDSCapture, nil);
- Memo1.Lines.Add('GUID_Null Error:' + inttostr(hr));
- end;
- if hr <> 0 then
- begin
- Memo1.Lines.Add('创建设备对象出错!');
- exit;
- end;
- //wave格式
- wfx.wFormatTag := WAVE_FORMAT_PCM;
- wfx.nChannels := 2;
- wfx.wBitsPerSample := 16;
- wfx.nSamplesPerSec := 8000;
- wfx.nBlockAlign := wfx.nChannels * wfx.wBitsPerSample div 8;
- wfx.nAvgBytesPerSec := wfx.nSamplesPerSec * wfx.nBlockAlign ;
- wfx.cbSize := 0;
- //创建录音的缓冲区对象
- hr := CreateCaptureBuffer(g_pDSCapture, g_pDSCB, g_pDSCB8, wfx, NUM_REC_COUNT, g_dwCaptureBufferSize);
- if hr <> 0 then
- begin
- Memo1.Lines.Add('创建录音的缓冲区对象出错!');
- exit;
- end;
- //创建通知事件
- g_dwNotifySize := wfx.nAvgBytesPerSec div NUM_REC_BLOCK;
- hr := InitNotifications(g_pDSCB8, g_pDSNotify, g_hNotificationEvent, g_dwNotifySize);
- if hr <> 0 then
- begin
- Memo1.Lines.Add('创建录音的缓冲区对象出错!');
- exit;
- end;
- //启动线程
- CaptureRecThread := TRecordCapturedData.Create(True);
- end;
- function TForm1.CreateCaptureBuffer(pDSC : IDirectSoundCapture8;
- out pDSCB : IDirectSoundCaptureBuffer;
- out pDSCB8 : IDirectSoundCaptureBuffer8;
- wfx : TWAVEFORMATEX;
- Num : Integer;
- out buffersize : DWORD):HRESULT;
- //录音块数量(dscbd.dwBufferBytes := wfx.nAvgBytesPerSec * Num;)
- var
- hr : HRESULT;
- dscbd : TDSCBufferDesc;
- begin
- if nil = pDSC then result := E_INVALIDARG ;
- dscbd.dwSize := sizeof(DSCBUFFERDESC);
- dscbd.dwFlags := 0;
- dscbd.dwBufferBytes := wfx.nAvgBytesPerSec * Num ;
- dscbd.dwReserved := 0;
- dscbd.lpwfxFormat := @wfx; //设置录音用的wave格式
- dscbd.dwFXCount := 0;
- dscbd.lpDSCFXDesc := nil;
- buffersize := wfx.nAvgBytesPerSec * Num;
- //创建录音的缓冲区对象
- hr := pDSC.CreateCaptureBuffer(dscbd, pDSCB, nil);
- if SUCCEEDED(hr) then
- begin
- pDSCB.QueryInterface(IID_IDirectSoundCaptureBuffer8, pDSCB8);
- //pDSCB._Release ;
- end
- else
- begin
- Result := hr;
- Exit ;
- end;
- result := hr;
- end;
- function TForm1.InitNotifications(pDSCB : IDirectSoundCaptureBuffer8;
- out pDSNotify8 : IDIRECTSOUNDNOTIFY8;
- out rghEvent : THandle;
- dwNotifySize : DWORD):HRESULT; //通知位置
- var
- rgdsbpn : array[0..NUM_REC_NOTIFICATIONS - 1] of DSBPOSITIONNOTIFY; //设置通知标志的数组
- hr : HRESULT;
- i : integer;
- begin
- //创建通知事件
- if nil = pDSCB then
- begin
- result := E_INVALIDARG;
- exit;
- end;
- hr := pDSCB.QueryInterface(IID_IDirectSoundNotify, pchar(pDSNotify8));
- if hr <> 0 then
- begin
- result := -1;
- exit;
- end;
- rghEvent := CreateEvent(nil, false, false, nil);
- for i := 0 to NUM_REC_NOTIFICATIONS -1 do
- begin
- rgdsbpn[i].dwOffset := (dwNotifySize * i) + dwNotifySize - 1;
- rgdsbpn[i].hEventNotify := rghEvent;
- end;
- hr := pDSNotify8.SetNotificationPositions(NUM_REC_NOTIFICATIONS, @rgdsbpn);
- //pDSNotify8._Release;
- if FAILED(hr) then Result := hr;
- Result := hr;
- end;
- function TForm1.RecordCapturedData(pDSCB8 : IDIRECTSOUNDCAPTUREBUFFER8):HRESULT;
- var
- hr : HRESULT ;
- pbCaptureData : pointer ;
- dwCaptureLength : cardinal ;
- pbCaptureData2 : pointer ;
- dwCaptureLength2: cardinal ;
- dwDataWrote : UINT ;
- dwReadPos : DWORD ;
- dwCapturePos : DWORD ;
- lLockSize : Longint ;
- str: string;
- begin
- Memo1.Lines.Add('有数据了!');
- pbCaptureData := nil;
- pbCaptureData2 := nil;
- if nil = pDSCB8 then Result := S_FALSE ;
- //GetCurrentPosition ->可以获取buffer中read指针和录制指针的偏差
- hr := pDSCB8.GetCurrentPosition(@dwCapturePos, @dwReadPos);
- if(FAILED(hr)) then Result := hr;
- lLockSize := dwReadPos - g_dwNextCaptureOffset;
- if (lLockSize < 0) then lLockSize := lLockSize + g_dwCaptureBufferSize;
- //锁住内存的大小
- //这里取模是为了使得我们读取的数据大小为g_dwNotifySize整数倍,这样buffer里剩下的也是notify的倍数
- lLockSize := lLockSize - (lLockSize mod g_dwNotifySize);
- if lLockSize = 0 then
- begin
- Result := S_FALSE;
- Exit ;
- end;
- //锁住内存
- hr := pDSCB8.Lock(g_dwNextCaptureOffset, lLockSize, pbCaptureData, dwCaptureLength,
- pbCaptureData2, dwCaptureLength2, 0 );
- if(FAILED(hr)) then Result := hr;
- str := format('OFFset:%d-len1:%d-len2:%d',[g_dwNextCaptureOffset,dwCaptureLength,dwCaptureLength2]);
- Memo1.Lines.Add(str);
- // 将内存中的数据拷贝到wave文件中
- SaveWave(filePath, pbCaptureData^, dwCaptureLength);
- //移动偏移标志,循环移动
- g_dwNextCaptureOffset := g_dwNextCaptureOffset + dwCaptureLength;
- g_dwNextCaptureOffset := g_dwNextCaptureOffset mod g_dwCaptureBufferSize; // Circular buffer
- if pbCaptureData2 <> nil then
- begin
- // 将内存中的数据拷贝到wave文件中
- SaveWave(filePath, pbCaptureData2^, dwCaptureLength2);
- // 移动偏移标志
- g_dwNextCaptureOffset := g_dwNextCaptureOffset + dwCaptureLength2;
- g_dwNextCaptureOffset := g_dwNextCaptureOffset mod g_dwCaptureBufferSize; // Circular buffer
- end;
- //内存解锁
- pDSCB8.Unlock(pbCaptureData, dwCaptureLength, pbCaptureData2, dwCaptureLength2);
- Result := S_OK;
- end;
- procedure TForm1.CreateWav( channels : word; { 1(单声)或者2(立体声) }
- resolution : word; { 8或者16,代表8位或16位声音 }
- rate : longint; { 声音频率,如11025,22050, 44100}
- fn : string { 对应的文件名称 } );
- var
- wf : file of TWavHeader;
- begin
- wh.RiffId := 'RIFF';
- wh.RiffLength := 36;
- wh.WaveId := 'WAVE';
- wh.FormatId := 'fmt ';
- wh.FormatSize := 16;
- wh.FormatTag := 1;
- wh.Channels := channels;
- wh.SamplesPerSec := rate;
- wh.AvgBytesPerSec := channels*rate*(resolution div 8);
- wh.BlockAlign := channels*(resolution div 8);
- wh.BitsPerSample := resolution;
- wh.DataId := 'data';
- wh.FactSize := 0;
- assignfile(wf,fn); {打开对应文件 }
- rewrite(wf); {移动指针到文件头}
- write(wf,wh); {写进文件头 }
- closefile(wf); {关闭文件 }
- end;
- procedure TForm1.SaveWave(filename : String; const Buffer; Count: LongWord);
- begin
- if RecordFileHandle = 0 then
- begin
- RecordFileHandle := FileOpen(filename, fmOpenWrite);
- end;
- FileSeek(RecordFileHandle, 0, so_End);
- FileWrite(RecordFileHandle, Buffer, Count);
- end;
- procedure TForm1.SaveEndWave(filename : String);
- var
- iFileHandle : Integer;
- fileLen : Longword ;
- stream : TFileStream;
- begin
- //写文件 ------ 方案一
- {stream:=TFileStream.Create(filename, fmOpenReadWrite);
- stream.Read(wh, sizeof(TWavHeader));
- wh.rLen := stream.Size - 8;
- wh.wSampleLength := stream.Size - sizeof(TWavHeader);
- stream.Seek(0 ,soFromBeginning);
- stream.Write(wh, sizeof(TWavHeader));
- stream.Free ;}
- //写文件 ------ 方案二
- iFileHandle := FileOpen(filename, fmOpenReadWrite);
- FileRead(iFileHandle, wh, sizeof(TWavHeader));
- fileLen := FileSeek(iFileHandle, 0, so_End);
- wh.RiffLength := fileLen - 8;
- wh.FactSize := fileLen - sizeof(TWavHeader) ;
- FileSeek(iFileHandle, 0, so_Begin);
- FileWrite(iFileHandle, wh, sizeof(TWavHeader));
- FileClose(iFileHandle);
- end;
- procedure TForm1.CloseWav();
- begin
- if RecordFileHandle <> 0 then
- FileClose(RecordFileHandle);
- end;
- procedure TForm1.Button2Click(Sender: TObject);
- var
- filename : String;
- begin
- if nil = g_pDSCB8 then
- begin
- Memo1.Lines.Add('IDirectSoundCapture8 is nil!');
- exit;
- end;
- //录音wave文件头
- filename := FormatDateTime('yyyymmddhhnnsszzz',now);
- filePath := ExtractFilePath(Application.ExeName) + filename + '.wav';
- CreateWav(2, 16, 8000, filePath);
- g_pDSCB8.Start(DSCBSTART_LOOPING);
- CaptureRecThread.Resume ;
- end;
- procedure TForm1.Button3Click(Sender: TObject);
- begin
- if nil = g_pDSCB8 then
- begin
- Memo1.Lines.Add('IDirectSoundCapture8 is nil!');
- exit;
- end;
- RecordCapturedData(g_pDSCB8);
- Memo1.Lines.Add('数据完了!');
- CloseWav();
- SaveEndWave(filePath);
- g_pDSCB8.Stop ;
- CaptureRecThread.Suspend ;
- RecordFileHandle := 0;
- end;
- procedure TForm1.DestroyWav();
- begin
- if CaptureRecThread <> nil then
- begin
- CaptureRecThread.Terminate ;
- end;
- if g_pDSNotify <> nil then
- begin
- g_pDSNotify := nil;
- end;
- if g_pDSCB8 <> nil then
- begin
- g_pDSCB8 := nil;
- end;
- if g_pDSCB <> nil then
- begin
- g_pDSCB := nil;
- end;
- if g_pDSCapture <> nil then
- begin
- g_pDSCapture := nil;
- end;
- end;
- procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
- begin
- DestroyWav;
- end;
- procedure TForm1.clearClick(Sender: TObject);
- begin
- Memo1.Clear ;
- end;
- end.
pic: