DirectSound 录音

  1. //Delphi 6
  2. unit Unit1;
  3. interface
  4. uses
  5.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  6.   Dialogs, DSoundDevices, StdCtrls ,ActiveX, DirectSound, MMSystem;
  7. const
  8.   //流缓冲区在小于3 个通知位置时工作的效率最高
  9.   //波形音频数据传送速率(nAvgBytesPerSec)
  10.   //录音缓冲区大小:nAvgBytesPerSec * NUM_REC_COUNT      {缓冲区是NUM_REC_COUNT秒的录音数据}
  11.   NUM_REC_COUNT         = 4;
  12.   //录音通知块大小:nAvgBytesPerSec div NUM_REC_BLOCK
  13.   NUM_REC_BLOCK         = 1;
  14.   //录音通知个数
  15.   NUM_REC_NOTIFICATIONS = NUM_REC_COUNT * NUM_REC_BLOCK ;
  16.   so_Begin    = 0;
  17.   so_Current  = 1;
  18.   so_End      = 2;
  19. type
  20.   TWavHeader = packed record              //定义一个Wav文件头格式
  21.     RiffId:          array[0..3]of Char;  { 'RIFF' Identifier }
  22.     RiffLength:      Longword;            //字节数:文件大小-8字节
  23.     WaveId:          array[0..3]of Char;  { 'WAVE' Identifier }
  24.     FormatId:        array[0..3]of Char;  { 'fmt ' Identifier }
  25.     FormatSize:      Longword;            //块尺寸
  26.     FormatTag:       Word;                { identifies PCM=1, ALAW=6, ULAW=7, etc }
  27.     Channels:        Word;                { Mono=1, Stereo=2 }
  28.     SamplesPerSec:   Longword;            { SampleRate in Hertz }
  29.     AvgBytesPerSec:  Longword;
  30.     BlockAlign:      Word;
  31.     BitsPerSample:   Word;                { Resolution, e.g. 8 or 16 }
  32.     DataId:          array[0..3]of Char;  { 'data' Identifier }
  33.     FactSize:        Longword;
  34.   end;
  35. type
  36.   TRecordCapturedData = class(TThread)
  37.   private
  38.   public
  39.     procedure Execute; override;
  40.   end;
  41.   TForm1 = class(TForm)
  42.     ComboBox1: TComboBox;
  43.     Label1: TLabel;
  44.     Memo1: TMemo;
  45.     Button1: TButton;
  46.     Button2: TButton;
  47.     Button3: TButton;
  48.     clear: TButton;
  49.     procedure FormCreate(Sender: TObject);
  50.     procedure Button1Click(Sender: TObject);
  51.     procedure Button2Click(Sender: TObject);
  52.     procedure Button3Click(Sender: TObject);
  53.     procedure clearClick(Sender: TObject);
  54.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  55.   public
  56.     function  CreateCaptureBuffer(pDSC : IDirectSoundCapture8;
  57.                              out pDSCB : IDirectSoundCaptureBuffer;
  58.                             out pDSCB8 : IDirectSoundCaptureBuffer8;
  59.                                    wfx : TWAVEFORMATEX;
  60.                                    Num : Integer;
  61.                         out buffersize : DWORD):HRESULT;
  62.     //录音块数量(dscbd.dwBufferBytes := wfx.nAvgBytesPerSec * Num;)
  63.     function  InitNotifications(pDSCB   : IDirectSoundCaptureBuffer8;
  64.                          out pDSNotify8 : IDIRECTSOUNDNOTIFY8;
  65.                          out rghEvent   : THandle;
  66.                           dwNotifySize  : DWORD):HRESULT;      //通知位置
  67.     function  RecordCapturedData(pDSCB8 : IDIRECTSOUNDCAPTUREBUFFER8):HRESULT;
  68.     //自定义写一个Wav文件头过程
  69.     procedure CreateWav(channels : word; resolution : word; rate : longint; fn : string);
  70.     procedure SaveWave(filename : String; const Buffer; Count: LongWord);
  71.     procedure CloseWav();
  72.     procedure SaveEndWave(filename : String);
  73.     procedure DestroyWav();
  74.   private
  75.     CaptureRecThread    : TRecordCapturedData;  //IDirectSoundCapture8录音线程
  76.     filePath            : String;
  77.     wh                  : TWavHeader;
  78.   end;
  79. var
  80.   Form1: TForm1;
  81.   g_pDSCapture            : IDirectSoundCapture8 = nil;                               //设备对象指针
  82.   g_pDSCB                 : IDIRECTSOUNDCAPTUREBUFFER = nil;                          //主缓冲区对象指针
  83.   g_pDSCB8                : IDIRECTSOUNDCAPTUREBUFFER8 = nil;                         //缓冲区对象指针
  84.   g_pDSNotify             : IDIRECTSOUNDNOTIFY8 = nil;                                //用来设置通知的对象接口
  85.   
  86.   g_hNotificationEvent    : THandle;           //通知事件
  87.   g_bRecording            : BOOLEAN = FALSE;                                          //是否正在录音
  88.   g_dwCaptureBufferSize   : DWORD;                                                    //录音用缓冲区块的大小
  89.   g_dwNotifySize          : DWORD;                                                    //通知位置
  90.   g_dwNextCaptureOffset   : DWORD = 0;                                                //偏移位置
  91.   RecordFileHandle        : Integer = 0 ;
  92. implementation
  93. {$R *.DFM}
  94. //Thread
  95. procedure TRecordCapturedData.Execute;
  96. var
  97.   dwResult : DWORD ;
  98. begin
  99.   inherited;
  100.   FreeOnTerminate := True;
  101.   dwResult     := 0;
  102.   g_bRecording := TRUE ;
  103.   While g_bRecording do
  104.   begin
  105.     //dwResult 范围: WAIT_OBJECT_0 ~ (WAIT_OBJECT_0 + NUM_REC_NOTIFICATIONS – 1)
  106.     dwResult := WaitForMultipleObjects(1, @g_hNotificationEvent,FALSE,INFINITE);
  107.     case dwResult  of
  108.       WAIT_OBJECT_0 + 0: Form1.RecordCapturedData(g_pDSCB8);
  109.     end;
  110.   end;
  111. end;
  112. //Form
  113. procedure TForm1.FormCreate(Sender: TObject);
  114. var
  115.   i : integer;
  116.   Guid : TGuid;
  117. begin
  118.   ComboBox1.Clear;
  119.   Memo1.Clear ;
  120.   
  121.   if DSDeviceList.Count < 1 then Exit;
  122.   for i := 0 to DSDeviceList.Count -1 do
  123.   begin
  124.     ComboBox1.Items.Add(DSDeviceList.Items[i].DeviceName);
  125.   end;
  126.   ComboBox1.ItemIndex := 0;
  127.   
  128. end;
  129. procedure TForm1.Button1Click(Sender: TObject);
  130. var
  131.   devIndex     : integer;
  132.   devGUID      : TGUID;
  133.   hr           : HResult;
  134.   dsBuffer     : DSCBUFFERDESC;
  135.   wfx          : TWAVEFORMATEX;
  136. begin
  137.   devIndex     := ComboBox1.ItemIndex;  //设备枚举序号
  138.   devGUID      := DSDeviceList.Items[devIndex].DeviceGUID;
  139.   g_pDSCapture := nil;
  140.   //创建设备对象
  141.   if not IsEqualGUID(GUID_NULL,devGUID) then
  142.   begin
  143.     hr := DirectSoundCaptureCreate8(@devGUID, g_pDSCapture, nil);
  144.     Memo1.Lines.Add('GUID_Null OK:' + inttostr(hr));
  145.   end
  146.   else
  147.   begin
  148.     hr := DirectSoundCaptureCreate8(@DSDEVID_DefaultCapture, g_pDSCapture, nil);
  149.     Memo1.Lines.Add('GUID_Null Error:' + inttostr(hr));
  150.   end;
  151.   if hr <>  0 then
  152.   begin
  153.     Memo1.Lines.Add('创建设备对象出错!');
  154.     exit;
  155.   end;
  156.   //wave格式
  157.   wfx.wFormatTag      := WAVE_FORMAT_PCM;
  158.   wfx.nChannels       := 2;
  159.   wfx.wBitsPerSample  := 16;
  160.   wfx.nSamplesPerSec  := 8000;
  161.   wfx.nBlockAlign     := wfx.nChannels * wfx.wBitsPerSample div 8;
  162.   wfx.nAvgBytesPerSec := wfx.nSamplesPerSec * wfx.nBlockAlign ;
  163.   wfx.cbSize          := 0;
  164.   //创建录音的缓冲区对象
  165.   hr := CreateCaptureBuffer(g_pDSCapture, g_pDSCB, g_pDSCB8, wfx, NUM_REC_COUNT, g_dwCaptureBufferSize);
  166.   if hr <> 0 then
  167.   begin
  168.     Memo1.Lines.Add('创建录音的缓冲区对象出错!');
  169.     exit;
  170.   end;
  171.   
  172.   //创建通知事件
  173.   g_dwNotifySize        := wfx.nAvgBytesPerSec div NUM_REC_BLOCK;
  174.   hr := InitNotifications(g_pDSCB8, g_pDSNotify, g_hNotificationEvent, g_dwNotifySize);
  175.   if hr <> 0 then
  176.   begin
  177.     Memo1.Lines.Add('创建录音的缓冲区对象出错!');
  178.     exit;
  179.   end;
  180.   //启动线程
  181.   CaptureRecThread := TRecordCapturedData.Create(True);
  182. end;
  183. function  TForm1.CreateCaptureBuffer(pDSC : IDirectSoundCapture8;
  184.                                 out pDSCB : IDirectSoundCaptureBuffer;
  185.                                out pDSCB8 : IDirectSoundCaptureBuffer8;
  186.                                       wfx : TWAVEFORMATEX;
  187.                                       Num : Integer;
  188.                            out buffersize : DWORD):HRESULT;
  189.           //录音块数量(dscbd.dwBufferBytes := wfx.nAvgBytesPerSec * Num;)
  190. var
  191.   hr      : HRESULT;
  192.   dscbd   : TDSCBufferDesc;
  193. begin
  194.   if nil = pDSC then result := E_INVALIDARG ;
  195.   dscbd.dwSize        := sizeof(DSCBUFFERDESC);
  196.   dscbd.dwFlags       := 0;
  197.   dscbd.dwBufferBytes := wfx.nAvgBytesPerSec * Num ;
  198.   dscbd.dwReserved    := 0;  
  199.   dscbd.lpwfxFormat   := @wfx;  //设置录音用的wave格式
  200.   dscbd.dwFXCount     := 0;
  201.   dscbd.lpDSCFXDesc   := nil;
  202.   buffersize          := wfx.nAvgBytesPerSec * Num;
  203.   //创建录音的缓冲区对象
  204.   hr := pDSC.CreateCaptureBuffer(dscbd, pDSCB, nil);
  205.   if SUCCEEDED(hr) then
  206.   begin
  207.     pDSCB.QueryInterface(IID_IDirectSoundCaptureBuffer8, pDSCB8);
  208.     //pDSCB._Release ;
  209.   end
  210.   else
  211.   begin
  212.     Result := hr;
  213.     Exit ;
  214.   end;
  215.   result := hr;
  216. end;
  217. function  TForm1.InitNotifications(pDSCB   : IDirectSoundCaptureBuffer8;
  218.                            out  pDSNotify8 : IDIRECTSOUNDNOTIFY8;
  219.                            out  rghEvent   : THandle;
  220.                              dwNotifySize  : DWORD):HRESULT;   //通知位置
  221. var
  222.   rgdsbpn   : array[0..NUM_REC_NOTIFICATIONS - 1of DSBPOSITIONNOTIFY; //设置通知标志的数组
  223.   hr        : HRESULT;
  224.   i         : integer;
  225. begin
  226.   //创建通知事件
  227.   if nil = pDSCB then
  228.   begin
  229.     result := E_INVALIDARG;
  230.     exit;
  231.   end;
  232.   hr := pDSCB.QueryInterface(IID_IDirectSoundNotify, pchar(pDSNotify8));
  233.   if hr <> 0 then
  234.   begin
  235.     result := -1;
  236.     exit;
  237.   end;
  238.   rghEvent := CreateEvent(nilfalsefalsenil);
  239.   for i := 0 to NUM_REC_NOTIFICATIONS -1 do
  240.   begin
  241.     rgdsbpn[i].dwOffset     := (dwNotifySize * i) + dwNotifySize - 1;
  242.     rgdsbpn[i].hEventNotify := rghEvent;
  243.   end;
  244.   hr := pDSNotify8.SetNotificationPositions(NUM_REC_NOTIFICATIONS, @rgdsbpn);
  245.   //pDSNotify8._Release;
  246.   if FAILED(hr) then    Result := hr;
  247.   Result := hr;
  248. end;
  249. function  TForm1.RecordCapturedData(pDSCB8 : IDIRECTSOUNDCAPTUREBUFFER8):HRESULT;
  250. var
  251.   hr              : HRESULT ;
  252.   pbCaptureData   : pointer ;
  253.   dwCaptureLength : cardinal ;
  254.   pbCaptureData2  : pointer ;
  255.   dwCaptureLength2: cardinal ;
  256.   dwDataWrote     : UINT ;
  257.   dwReadPos       : DWORD ;
  258.   dwCapturePos    : DWORD ;
  259.   lLockSize       : Longint  ;
  260.   str: string;
  261. begin
  262.   Memo1.Lines.Add('有数据了!');
  263.   pbCaptureData  := nil;
  264.   pbCaptureData2 := nil;
  265.   if nil = pDSCB8  then Result := S_FALSE ;
  266.   //GetCurrentPosition ->可以获取buffer中read指针和录制指针的偏差
  267.   hr := pDSCB8.GetCurrentPosition(@dwCapturePos, @dwReadPos);
  268.   if(FAILED(hr)) then  Result := hr;
  269.   lLockSize := dwReadPos - g_dwNextCaptureOffset;
  270.   if (lLockSize < 0then  lLockSize :=  lLockSize + g_dwCaptureBufferSize;
  271.   
  272.   //锁住内存的大小
  273.   //这里取模是为了使得我们读取的数据大小为g_dwNotifySize整数倍,这样buffer里剩下的也是notify的倍数
  274.   lLockSize := lLockSize - (lLockSize mod g_dwNotifySize);
  275.   if lLockSize = 0 then
  276.   begin
  277.     Result := S_FALSE;
  278.     Exit ;
  279.   end;
  280.   //锁住内存
  281.   hr := pDSCB8.Lock(g_dwNextCaptureOffset, lLockSize, pbCaptureData, dwCaptureLength,
  282.                            pbCaptureData2, dwCaptureLength2, 0 );
  283.   if(FAILED(hr)) then  Result := hr;
  284.   str := format('OFFset:%d-len1:%d-len2:%d',[g_dwNextCaptureOffset,dwCaptureLength,dwCaptureLength2]);
  285.   Memo1.Lines.Add(str);
  286.   // 将内存中的数据拷贝到wave文件中
  287.   SaveWave(filePath, pbCaptureData^, dwCaptureLength);
  288.   //移动偏移标志,循环移动
  289.   g_dwNextCaptureOffset := g_dwNextCaptureOffset + dwCaptureLength;
  290.   g_dwNextCaptureOffset := g_dwNextCaptureOffset mod g_dwCaptureBufferSize; // Circular buffer
  291.   if pbCaptureData2 <> nil then
  292.   begin
  293.     // 将内存中的数据拷贝到wave文件中
  294.     SaveWave(filePath, pbCaptureData2^, dwCaptureLength2);
  295.     // 移动偏移标志
  296.     g_dwNextCaptureOffset := g_dwNextCaptureOffset + dwCaptureLength2;
  297.     g_dwNextCaptureOffset := g_dwNextCaptureOffset mod g_dwCaptureBufferSize; // Circular buffer
  298.   end;
  299.   //内存解锁
  300.   pDSCB8.Unlock(pbCaptureData,  dwCaptureLength, pbCaptureData2, dwCaptureLength2);
  301.   Result := S_OK;
  302. end;
  303. procedure TForm1.CreateWav( channels   : word{ 1(单声)或者2(立体声) }
  304.                             resolution : word{ 8或者16,代表8位或16位声音 }
  305.                             rate       : longint{ 声音频率,如11025,22050, 44100}
  306.                             fn         : string { 对应的文件名称 } );
  307. var
  308.   wf : file of TWavHeader;
  309. begin
  310.   wh.RiffId         := 'RIFF';
  311.   wh.RiffLength     := 36;
  312.   wh.WaveId         := 'WAVE';
  313.   wh.FormatId       := 'fmt ';
  314.   wh.FormatSize     := 16;
  315.   wh.FormatTag      := 1;
  316.   wh.Channels       := channels;
  317.   wh.SamplesPerSec  := rate;
  318.   wh.AvgBytesPerSec := channels*rate*(resolution div 8);
  319.   wh.BlockAlign     := channels*(resolution div 8);
  320.   wh.BitsPerSample  := resolution;
  321.   wh.DataId         := 'data';
  322.   wh.FactSize       := 0;
  323.   assignfile(wf,fn);    {打开对应文件 }
  324.   rewrite(wf);          {移动指针到文件头}
  325.   write(wf,wh);         {写进文件头 }
  326.   closefile(wf);        {关闭文件 }
  327. end;
  328. procedure TForm1.SaveWave(filename : String; const Buffer; Count: LongWord);
  329. begin
  330.   if RecordFileHandle = 0 then
  331.   begin
  332.     RecordFileHandle := FileOpen(filename, fmOpenWrite);
  333.   end;
  334.   FileSeek(RecordFileHandle, 0, so_End);
  335.   FileWrite(RecordFileHandle, Buffer, Count);
  336. end;
  337. procedure TForm1.SaveEndWave(filename : String);
  338. var
  339.   iFileHandle : Integer;
  340.   fileLen     : Longword ;
  341.   stream      : TFileStream;
  342. begin
  343.   //写文件 ------ 方案一
  344.   {stream:=TFileStream.Create(filename, fmOpenReadWrite);
  345.   stream.Read(wh, sizeof(TWavHeader));
  346.   wh.rLen          := stream.Size - 8;
  347.   wh.wSampleLength := stream.Size - sizeof(TWavHeader);
  348.   stream.Seek(0 ,soFromBeginning);
  349.   stream.Write(wh, sizeof(TWavHeader));
  350.   stream.Free ;}
  351.   //写文件 ------ 方案二
  352.   iFileHandle := FileOpen(filename, fmOpenReadWrite);
  353.   FileRead(iFileHandle, wh, sizeof(TWavHeader));
  354.   fileLen       := FileSeek(iFileHandle, 0, so_End);
  355.   wh.RiffLength := fileLen - 8;
  356.   wh.FactSize   := fileLen - sizeof(TWavHeader) ;
  357.   FileSeek(iFileHandle, 0, so_Begin);
  358.   FileWrite(iFileHandle, wh, sizeof(TWavHeader));
  359.   FileClose(iFileHandle);
  360. end;
  361. procedure TForm1.CloseWav();
  362. begin
  363.   if RecordFileHandle <> 0 then
  364.     FileClose(RecordFileHandle);
  365. end;
  366. procedure TForm1.Button2Click(Sender: TObject);
  367. var
  368.   filename  : String;
  369. begin
  370.   if nil = g_pDSCB8 then
  371.   begin
  372.     Memo1.Lines.Add('IDirectSoundCapture8 is nil!');
  373.     exit;
  374.   end;
  375.   //录音wave文件头
  376.   filename := FormatDateTime('yyyymmddhhnnsszzz',now);
  377.   filePath := ExtractFilePath(Application.ExeName) + filename +  '.wav';
  378.   CreateWav(2168000, filePath);
  379.   g_pDSCB8.Start(DSCBSTART_LOOPING);
  380.   CaptureRecThread.Resume ;
  381. end;
  382. procedure TForm1.Button3Click(Sender: TObject);
  383. begin
  384.   if nil = g_pDSCB8 then
  385.   begin
  386.     Memo1.Lines.Add('IDirectSoundCapture8 is nil!');
  387.     exit;
  388.   end;
  389.   RecordCapturedData(g_pDSCB8);
  390.   Memo1.Lines.Add('数据完了!');
  391.   CloseWav();
  392.   SaveEndWave(filePath);
  393.   g_pDSCB8.Stop ;
  394.   CaptureRecThread.Suspend ;
  395.   RecordFileHandle := 0;
  396. end;
  397. procedure TForm1.DestroyWav();
  398. begin
  399.   if CaptureRecThread <> nil then
  400.   begin
  401.     CaptureRecThread.Terminate ;
  402.   end;
  403.   if g_pDSNotify <> nil then
  404.   begin
  405.     g_pDSNotify := nil;
  406.   end;
  407.   if g_pDSCB8 <> nil then
  408.   begin
  409.     g_pDSCB8 := nil;
  410.   end;
  411.   if g_pDSCB <> nil then
  412.   begin
  413.     g_pDSCB := nil;
  414.   end;
  415.   if g_pDSCapture <> nil then
  416.   begin
  417.     g_pDSCapture := nil;
  418.   end;
  419. end;
  420. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  421. begin
  422.   DestroyWav;
  423. end;
  424. procedure TForm1.clearClick(Sender: TObject);
  425. begin
  426.   Memo1.Clear ;
  427. end;
  428. end.

pic:

发布了43 篇原创文章 · 获赞 1 · 访问量 16万+
展开阅读全文

没有更多推荐了,返回首页

©️2019 CSDN 皮肤主题: 大白 设计师: CSDN官方博客

分享到微信朋友圈

×

扫一扫,手机浏览