Solved

Recording sound in DirectShow

Posted on 2004-04-13
14
2,115 Views
Last Modified: 2012-06-21
Hi,
I would like to record voice with DirectShow(or DirectSound). But I don't want to record in a file, I want to record into an array(of bytes) or stream. If possible I want to record in mp3 or gsm(not in PCM). Please help me.

_cnt
0
Comment
Question by:_cnt
  • 7
  • 4
  • 2
  • +1
14 Comments
 
LVL 12

Expert Comment

by:Lee_Nover
ID: 10812556
go to www.progdigy.com and get DSPack
there's a capture demo .. instead of capturing a bitmap set the capture format to audio format you want
also change the source
in the OnCapture (or something like that) event of the SampleGrabber you get the converted data
that's basicaly it
0
 

Author Comment

by:_cnt
ID: 10812774
Thanks, but I want to record voice by microphone (SampleGrabber demo can make pictures from a frame of a video file). VideoCap demo records sound and captures video by a webcam, but it renders it in an avi file.
0
 
LVL 12

Expert Comment

by:Lee_Nover
ID: 10820384
doesn't matter .. just change the source and the format
0
 
LVL 3

Expert Comment

by:MikProg
ID: 10821353
You can use File Mapping machanism of WinAPI to
 1. map any empty file into memory (or default file placed into swap)
 2. record sounds using file handle just mapped. at this point you must not FlushViewOfFile. All data will be stored into memory even phisical memory have less size then recorded data (overflow Windows will send to swap).
 3. Use MapViewOfFile to get memory address where file mapped data is stored
 4. Make any manipulation with recorded data
 5. Close file mapping without  flushing data to disk
0
 

Author Comment

by:_cnt
ID: 10832425
MikProg: I don't think that it is the right way, but thanks.

Lee Nover: I tried it but I don't know how can I change the source. I tried the videocap demo. I put a TSampleGrabber on the Form and connected it to the FilterGraph and it worked(in the OnBuffer event of the SampleGrabber I could get the buffer). But when I removed the videocapture part of the program it didn't work. (the format was on automatic choose)
What can be the problem?
0
 
LVL 12

Expert Comment

by:Lee_Nover
ID: 10832444
when I get home I'll copy the relevant part from one of my projects .. it does exactly that
0
 
LVL 12

Accepted Solution

by:
Lee_Nover earned 200 total points
ID: 10835015
this is a stripped down version of a unit in one of my projects (won't even compile)
the necesary component conenctions are there .. also the relevant code

unit code:


unit dmMainUStripped;

interface

uses
  Windows, Messages, Graphics, SysUtils, Forms, Classes, Controls,
  DirectShow9, ActiveX, DSPack, DSUtil, mmsystem, lnDSUtil;

type
  TdmMain = class(TDataModule)
    fgMain: TFilterGraph;
    sgAudio: TSampleGrabber;
    dsfAudio: TFilter;
    dsfMic: TFilter;
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
    procedure sgAudioBuffer(sender: TObject; SampleTime: Double;
      pBuffer: Pointer; BufferLen: Integer);
  private
    Multiplexer: IBaseFilter;
    Writer: IFileSinkFilter;

    procedure AddAudioBufferData(Buffer: Pointer; Size: Cardinal);
    procedure ApplySettings;
    procedure SaveSettings;
    function StartCapture: Boolean;
    function StopCapture: Boolean;
    function UpdateAudioFormat(const WFEX: TWaveFormatEx): Boolean;
  public
  end;

var
  dmMain: TdmMain;
  AudioBuffer: TlnDynBuffer;
  DevEnum: TSysDevEnum;
  AMediaTypes: TEnumMediaType;

implementation

{$R *.dfm}

procedure TdmMain.DataModuleCreate(Sender: TObject);
begin
     DevEnum:=TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
end;

procedure TdmMain.DataModuleDestroy(Sender: TObject);
begin
     with fgMain do
       if Active then
       begin
         ClearGraph;
         Active:=false;
       end;
end;

procedure TdmMain.ApplySettings;
var wfex: TWaveFormatEx;
    PinList: TPinList;
    ok: Boolean;
    hr: HRESULT;
begin
     tmrMovement.Enabled:=false;
     CoInitialize(nil);

     with fgMain do
       if Active then
       begin
         Stop;
         DisconnectFilters;
         ClearGraph;
         Active:=false;
       end;

     if CameraSettings.CaptureAudio then
     begin
       DevEnum.SelectGUIDCategory(CLSID_AudioInputDeviceCategory);
       dsfMic.BaseFilter.Moniker:=GetMonikerByName(DevEnum, CameraSettings.AudioDevice);
       if dsfMic.BaseFilter.Moniker = nil then
       begin
         {$IFDEF DEBUG}
         SetStatus('dsfMic.BaseFilter.Moniker = nil');
         {$ENDIF}
         exit;
       end;

       // get formats for selected device
       PinList:=PinListForMoniker(dsfMic.BaseFilter.Moniker);
       try
          AMediaTypes.Assign(PinList.First);
       finally
          PinList.Free;
       end;

       sgAudio.MediaType:=GetMediaTypeByName(AMediaTypes, CameraSettings.AudioFormat);
       if Assigned(sgAudio.MediaType) then
       begin
         with sgAudio.MediaType.AMMediaType^ do
           if formattype.D1 = $05589F81 then
              wfex:=PWaveFormatEx(pbFormat)^;

         PinList:=PinListForMoniker(dsfMic.BaseFilter.Moniker);
         try
            // set audio format
            with (PinList.First as IAMStreamConfig) do
              hr:=SetFormat(sgAudio.MediaType.AMMediaType^);
             
            ok:=Succeeded(hr);
            if not ok then
            begin
              {$IFDEF DEBUG}
              SetStatus('not Succeeded(SetFormat(sgAudio.MediaType.AMMediaType^))');
              {$ENDIF}
              exit;
            end;
         finally
            PinList.Free;
         end;

         if CameraSettings.CompressAudio and (CameraSettings.AudioCodec <> '') then
         begin
           DevEnum.SelectGUIDCategory(CLSID_AudioCompressorCategory);
           dsfAudio.BaseFilter.Moniker:=GetMonikerByName(DevEnum, CameraSettings.AudioCodec);
         end;
       end
       else
       begin
         {$IFDEF DEBUG}
         SetStatus('not Assigned(sgAudio.MediaType)');
         {$ENDIF}
         exit;
       end;
     end; { CameraSettings.CaptureAudio }

     // will include all the filters in the graph
     fgMain.Active:=true;

     // now render streams
     with fgMain as ICaptureGraphBuilder2 do
     try
        SetOutputFileName(MEDIASUBTYPE_Avi, OleStr, Multiplexer, Writer);

        // Connect Mic -> Sample Grabber
        hr:=RenderStream(nil, @MEDIATYPE_Audio, dsfMic as IBaseFilter, nil, sgAudio as IBaseFilter);
        if not Succeeded(hr) then
        begin
          {$IFDEF DEBUG}
          SetStatus('not Succeeded(Connect Mic -> Sample Grabber)');
          {$ENDIF}
          exit;
        end;
     except
     end;

     ok:=fgMain.Play;
end;

function TdmMain.StartCapture: Boolean;
var FileName: string;
    OleStr: PWideChar;
begin
     Result:=false;
     CoInitialize(nil); // coz it might be called from a new thread
     try
       if not fgMain.Active then exit;

       with CameraSettings do
         if (not CaptureVideo) and (not CaptureAudio) then exit;

       fgMain.Stop;

       FileName:=SettingsPath + 'VideoNadzor.avi';
       OleStr:=StringToOleStr(FileName);
       with CameraSettings, (fgMain as ICaptureGraphBuilder2) do
       try
          SetOutputFileName(MEDIASUBTYPE_Avi, OleStr, Multiplexer, Writer);

          if CaptureAudio then
          begin
            // render audio
            RenderStream(@PIN_CATEGORY_PREVIEW, nil, dsfMic as IBaseFilter, nil,
              sgAudio as IBaseFilter);
            // render the audio compressor
            if CompressAudio and (AudioCodec <> '') then
            begin
              {
              // SampleGrabber -> AudioCompressor
              RenderStream(nil, nil, sgAudio as IBaseFilter, nil, dsfAudio as IBaseFilter);
              // AudioCompressor -> Multiplexer
              RenderStream(nil, nil, dsfAudio as IBaseFilter, nil, Multiplexer);
              }
              RenderStream(nil, @MEDIATYPE_Audio, sgAudio as IBaseFilter, dsfAudio as IBaseFilter, Multiplexer);
            end
            else
              {// SampleGrabber -> Multiplexer
              RenderStream(nil, nil, sgAudio as IBaseFilter, nil, Multiplexer);
              }
              RenderStream(nil, @MEDIATYPE_Audio, sgAudio as IBaseFilter, nil, Multiplexer);
          end;
          CaptureInfo.ManualRecord:=true;
       finally
          Result:=fgMain.Play;
          SysFreeString(OleStr);
       end;
     finally
       CoUninitialize;
     end;
end;

function TdmMain.StopCapture: Boolean;
begin
     CaptureInfo.ManualRecord:=false;
     Result:=true;
     ApplySettings;
end;

procedure TdmMain.AddAudioBufferData(Buffer: Pointer; Size: Cardinal);
var p: Pointer;
    bb: TBufferBlock;
    bh: TBufferHeader;
begin
     // here I convert the audio to a custom format
     // you don't need this coz u can specify in what format to capture
     bh.DataSize:=deAC.ConvertAudio(Buffer, Size);
     if bh.DataSize = 0 then exit;
     p:=deAC.BufferOut;
     bh.Tag:=0;
     bh.ID:=GetTickCount;
     bb:=TBufferBlock.Create(bh);
     CopyMemory(bb.Data, p, bh.DataSize);
     AudioBuffer.AddBlock(bb);
end;

procedure TdmMain.sgAudioBuffer(sender: TObject; SampleTime: Double;
  pBuffer: Pointer; BufferLen: Integer);
begin
     if ActiveClients > 0 then
        AddAudioBufferData(pBuffer, BufferLen);
end;

end.


-------------------------------------

unit form:

object dmMain: TdmMain
  OldCreateOrder = False
  OnCreate = DataModuleCreate
  OnDestroy = DataModuleDestroy
  Left = 628
  Top = 109
  Height = 384
  Width = 451
  object fgMain: TFilterGraph
    Mode = gmCapture
    GraphEdit = True
    Left = 24
    Top = 80
  end
  object sgAudio: TSampleGrabber
    OnBuffer = sgAudioBuffer
    FilterGraph = fgMain
    MediaType.data = {
      6175647300001000800000AA00389B710100000000001000800000AA00389B71
      FFFFFFFF0000000001000000819F580556C3CE11BF0100AA0055595A00000000
      0000000000000000}
    Left = 104
    Top = 80
  end
  object dsfAudio: TFilter
    BaseFilter.data = {
      9600000037D415438C5BD011BD3B00A0C911CE86820000004000640065007600
      6900630065003A0063006D003A007B0033003300440039004100370036003100
      2D0039003000430038002D0031003100440030002D0042004400340033002D00
      3000300041003000430039003100310043004500380036007D005C0038003500
      4D0050004500470020004C0061007900650072002D0033000000}
    FilterGraph = fgMain
    Left = 104
    Top = 136
  end
  object dsfMic: TFilter
    BaseFilter.data = {
      B600000037D415438C5BD011BD3B00A0C911CE86A20000004000640065007600
      6900630065003A0063006D003A007B0033003300440039004100370036003200
      2D0039003000430038002D0031003100440030002D0042004400340033002D00
      3000300041003000430039003100310043004500380036007D005C004C006F00
      67006900740065006300680020004D006900630072006F00700068006F006E00
      650020002800500072006F002000340030003000300029000000}
    FilterGraph = fgMain
    Left = 104
    Top = 24
  end
end

------------------------------------------


helper unit:

{-----------------------------------------------------------------------------
 Unit Name: lnDSUtil
 Author:    Lee_Nover - Lee_Nover@delphi-si.com
 Purpose:   DirectShow and DSPack helper unit
 History:
-----------------------------------------------------------------------------}


unit lnDSUtil;

interface

uses Classes, SysUtils, ActiveX, DirectShow9, DSPack, DSUtil;

function PinListForMoniker(Moniker: IMoniker): TPinList;
function GetMonikerByName(DevEnum: TSysDevEnum; const AName: string): IMoniker;
function GetMediaTypeByName(MediaTypes: TEnumMediaType; const AName: string): TMediaType;
function GetFormatsForDevice(Category: TGUID; DeviceName: string = ''; List: TStrings = nil): Integer;
function GetVideoFormats(DeviceName: string; List: TStrings): Integer;
function GetAudioFormats(DeviceName: string; List: TStrings): Integer;
function EnumCategory(const ACategory: TGUID; const List: TStrings = nil): Integer;
function GetVideoDevices(List: TStrings = nil): Integer;
function GetAudioDevices(List: TStrings = nil): Integer;
function GetVideoCodecs(List: TStrings = nil): Integer;
function GetAudioCodecs(List: TStrings = nil): Integer;


implementation


function PinListForMoniker(Moniker: IMoniker): TPinList;
var
  BF: TBaseFilter;
  IBF: IBaseFilter;
begin
     BF:=TBaseFilter.Create;
     try
        BF.Moniker:=Moniker;
        IBF:=BF.CreateFilter;
        Result:=TPinList.Create(IBF);
     finally
        IBF:=nil;
        BF.Free;
     end;
end;

function GetMonikerByName(DevEnum: TSysDevEnum; const AName: string): IMoniker;
var I: Integer;
begin
     Result:=nil;
     for I:=0 to DevEnum.CountFilters-1 do
         if AnsiSameText(DevEnum.Filters[I].FriendlyName, AName) then
         begin
           Result:=DevEnum.GetMoniker(I);
           exit;
         end;
end;

function GetMediaTypeByName(MediaTypes: TEnumMediaType; const AName: string): TMediaType;
var I: Integer;
begin
     Result:=nil;
     for I:=0 to MediaTypes.Count-1 do
         if AnsiSameText(MediaTypes.MediaDescription[I], AName) then
         begin
           Result:=MediaTypes.Items[I];
           exit;
         end;
end;

function GetFormatsForDevice(Category: TGUID; DeviceName: string = ''; List: TStrings = nil): Integer;
var
  PinList: TPinList;
  DevEnum: TSysDevEnum;
  MediaTypes: TEnumMediaType;
  I, idxDevice: Integer;
begin
    Result:=0;
    if (List = nil) or (DeviceName = '') or IsEqualGUID(Category, GUID_NULL) then exit;
   
    idxDevice:=-1;
    List.Clear;
    DevEnum:=TSysDevEnum.Create(Category);
    try
       for I:=0 to DevEnum.CountFilters-1 do
           if AnsiSameText(DevEnum.Filters[I].FriendlyName, DeviceName) then
           begin
             idxDevice:=I;
             break;
           end;

       if idxDevice < 0 then exit;

       PinList:=PinListForMoniker(DevEnum.GetMoniker(idxDevice));
       try
          MediaTypes:=TEnumMediaType.Create(PinList.First);
          try
             for I:=0 to MediaTypes.Count-1 do
                 List.Add(MediaTypes.MediaDescription[I]);
             Result:=List.Count;
          finally
             MediaTypes.Free;
          end;
       finally
          PinList.Free;
       end;
    finally
       DevEnum.Free;
    end;
end;

function GetVideoFormats(DeviceName: string; List: TStrings): Integer;
begin
     Result:=GetFormatsForDevice(CLSID_VideoInputDeviceCategory, DeviceName, List);
end;

function GetAudioFormats(DeviceName: string; List: TStrings): Integer;
begin
     Result:=GetFormatsForDevice(CLSID_AudioInputDeviceCategory, DeviceName, List);
end;

function EnumCategory(const ACategory: TGUID; const List: TStrings = nil): Integer;
var
  DevEnum: TSysDevEnum;
  I: Integer;
begin
    Result:=0;
    if (List = nil) or IsEqualGUID(ACategory, GUID_NULL) then exit;
    List.Clear;
    DevEnum:=TSysDevEnum.Create(ACategory);
    try
       for I:=0 to DevEnum.CountFilters-1 do
           List.Add(DevEnum.Filters[I].FriendlyName);
       Result:=List.Count;
    finally
       DevEnum.Free;
    end;
end;

function GetVideoDevices(List: TStrings = nil): Integer;
begin
     Result:=EnumCategory(CLSID_VideoInputDeviceCategory, List);
end;

function GetAudioDevices(List: TStrings = nil): Integer;
begin
     Result:=EnumCategory(CLSID_AudioInputDeviceCategory, List);
end;

function GetVideoCodecs(List: TStrings = nil): Integer;
begin
     Result:=EnumCategory(CLSID_VideoCompressorCategory, List);
end;

function GetAudioCodecs(List: TStrings = nil): Integer;
begin
     Result:=EnumCategory(CLSID_AudioCompressorCategory, List);
end;

end.







that should be all
0
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 

Author Comment

by:_cnt
ID: 10841562
Thanks Lee Nover, I got the answer. I'll accept your comment, but could you tell me how can I play from buffer(eg. I have an array of byte and I want to play it with directshow).
0
 
LVL 12

Expert Comment

by:Lee_Nover
ID: 10841672
you can use DirectShow StreamSource - http://codecentral.borland.com/codecentral/ccweb.exe/listing?id=21110
or play it with DirectSound - I have an implementation of that (no buffer synching yet !)
0
 

Author Comment

by:_cnt
ID: 10842707
Thanks all.
0
 

Expert Comment

by:albertorcf
ID: 22442350
I can't compile the code:

[Error] dmMainUStripped.pas(34): Undeclared identifier: 'TlnDynBuffer'
0
 
LVL 12

Expert Comment

by:Lee_Nover
ID: 22442565
wow this is old :) I'm sorry, but I don't have that old code anymore.
0
 
LVL 12

Expert Comment

by:Lee_Nover
ID: 22442656
btw .. you don't need that anyway! it's just for storing the data, instead, in the function TdmMain.AddAudioBufferData simply use the data passed on
0
 

Expert Comment

by:albertorcf
ID: 22454250
yes, this is really very old!
but, anyway, thank you very much for the answer and the excused attention.
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Suggested Solutions

Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
This video explains how to create simple products associated to Magento configurable product and offers fast way of their generation with Store Manager for Magento tool.

758 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now