Solved

Capturing sounds

Posted on 2001-06-30
5
407 Views
Last Modified: 2010-04-04
Hello:

  How can I capture a sound that's playing in the system?? like from a game... and save that as .wav file or any other format..??

  Thanks
0
Comment
Question by:tearsoftragedy
5 Comments
 
LVL 17

Expert Comment

by:inthe
ID: 6241759
hi,
you probably want to read this:

How to create/save a Wave file
This Delphi project illustrates how to capture a sound from standard sound inputs and save it to a wave file. It even shows you how to specify (or create your own) a wave format, such as frequency, sampling rate, etc

http://www.bhnet.com.br/~simonet/archive/waverec.zip
0
 

Author Comment

by:tearsoftragedy
ID: 6242859
Inthe:

  Thanks for help, but is not exactly what I need, it records sounds from an Input, and the sound i want to record is playing from the system, i.e an Dos/Win game...

  Thank you for your time :)
  I appreciate it
0
 
LVL 5

Expert Comment

by:TheNeil
ID: 6244029
It might not be as easy (or even possible). Not all sound cards can capture the sound output from the system. I know that Soundblaster's Live range have a recording option which allows you to capture exactly what is being heard but this isn't (or wasn't) a widespread feature so depending on your hardware it might not be possible

The Neil =:(
0
 

Accepted Solution

by:
VanDamM earned 50 total points
ID: 6251179
connect (with audio cable) LineIn and LineOut(or SpeakerOut) into your soundcard (mini-jack audio cable)

and use this:

-- Wave Recorder source with low level routines --

Var
   WaveRecorder : TWaveRecorder;

   WaveRecorder := TwaveRecorder(2048, 4);  // 4 buffers of size 2048 bytes

  { Set the sampling parameters }
  With WaveRecorder.pWavefmtEx Do
    Begin
     wFormatTag := WAVE_FORMAT_PCM;
     nChannels := 1;
     nSamplesPerSec := 20000; // 20 khz
     wBitsPerSample := 16;
     nAvgBytesPerSec := nSamplesPerSec*(wBitsPerSample div 8)*nChannels;
   End;

   //  Next is a kludge since I don't know how to get the address of
   //  the object itself

   WaveRecorder.SetupRecord(@WaveRecorder);


   // Now start recording with
   WaveRecorder.StartRecord;
   
    ... Each time a buffer is full, the WaveRecorder.Processbuffer
   routine is called.  

   //  Stop recording with
   WaveRecorder.StopRecord;
   WaveRecorder.Destroy;


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

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

{
  File Name: RECUNIT.PAS  V 1.01
  Created: Aug 19 1996 at 21:56 on IBM ThinkPad
  Revision #7: Aug 22 1997, 15:01 on IBM ThinkPad
                                        -John Mertus

  This unit contains necessary routines for doing recording.

  Version 1.00 is initial release
          1.01 Added TWaveInGetErrorText
}



{-----------------Unit-RECUNIT---------------------John Mertus---Aug 96---}

          Unit RECUNIT;


{*************************************************************************}
                            Interface

Uses
   Windows, MMSystem, SysUtils, MSACM;


{  The following defines a class TWaveRecorder for sound card input.  }
{  It is expected that a new class is derived from TWaveRecorder      }
{  that overrides TWaveRecorder.ProcessBuffer.  After the recorder is }
{  started, the procedure is called whenever a buffer of data has     }
{  been sampled.                                                      }

Const
   MAX_BUFFERS = 8;

type
  PWaveRecorder = ^TWaveRecorder;
  TWaveRecorder = class(TObject)
     Constructor Create(BfSize, TotalBuffers : Integer);
     Destructor  Destroy;      Override;
     Procedure   ProcessBuffer(uMsg : Word; P : Pointer; n : Integer);    
Virtual;

  private
     fBufferSize        : Integer;          // Requsted size of buffer
     BufIndex           : Integer;
     fTotalBuffers       : Integer;

     pWaveHeader        : Array [0..MAX_BUFFERS-1] of PWAVEHDR;
     hWaveHeader        : Array [0..MAX_BUFFERS-1] of THANDLE;
     hWaveBuffer        : Array [0..MAX_BUFFERS-1] of THANDLE;
     hWaveFmtEx         : THANDLE;
     dwByteDataSize     : DWORD;
     dwTotalWaveSize    : DWORD;

     RecordActive       : Boolean;
     bDeviceOpen        : Boolean;

     { Functions that no one needs to know about }
     Function InitWaveHeaders : Boolean;
     Function AllocPCMBuffers : Boolean;
     Procedure FreePCMBuffers;

     Function AllocWaveFormatEx : Boolean;
     Procedure FreeWaveFormatEx;

     Function AllocWaveHeaders : Boolean;
     Procedure FreeWaveHeader;

     Function AddNextBuffer : Boolean;
     Procedure CloseWaveDeviceRecord;

  public
    { Public declarations }
    pWaveFmtEx         : PWaveFormatEx;
    WaveBufSize        : Integer;          // Size aligned to nBlockAlign Field
    InitWaveRecorder   : Boolean;
    RecErrorMessage    : String;
    QueuedBuffers,
    ProcessedBuffers   : Integer;
    pWaveBuffer        : Array [0..MAX_BUFFERS-1] of lpstr;
    WaveIn             : HWAVEIN;  { Wavedevice handle }

    Procedure StopRecord;
    Function  StartRecord : Boolean;
    Function  SetupRecord(P : PWaveRecorder) : Boolean;

  end;

{*************************************************************************}
                           implementation

{-------------TWaveInGetErrorText------------John Mertus---14-June--97--}

   Function TWaveInGetErrorText(iErr : Integer) : String;

{ This puts the WaveIn error messages in a Pascal type format.          }
{ iErr is the error number                                              }
{                                                                       }
{**********************************************************************}
Var
  PlayInErrorMsgC   : Array [0..255] of Char;

Begin
  waveInGetErrorText(iErr,PlayInErrorMsgC,255);
  TWaveInGetErrorText := StrPas(PlayInErrorMsgC);
End;

{-------------InitWaveHeaders----------------John Mertus---14-June--97--}

   Function TWaveRecorder.AllocWaveFormatEx : Boolean;

{ Allocate the larget format size required from installed ACM's         }
{                                                                       }
{**********************************************************************}
Var
  MaxFmtSize : UINT;

BEGIN
  { maxFmtSize is the sum of sizeof(WAVEFORMATEX) + pwavefmtex.cbSize }
  If( acmMetrics( 0, ACM_METRIC_MAX_SIZE_FORMAT, maxFmtSize ) <> 0) Then
    Begin
      RecErrorMessage := 'Error getting the max compression format size';
      AllocWaveFormatEx := False;
      Exit;
    End;


  { allocate the WAVEFMTEX structure }
  hWaveFmtEx := GlobalAlloc(GMEM_MOVEABLE, maxFmtSize);
  If (hWaveFmtEx = 0) Then
    Begin
      RecErrorMessage := 'Error allocating memory for WaveFormatEx structure';
      AllocWaveFormatEx := False;
      Exit;
    End;

  pWaveFmtEx := PWaveFormatEx(GlobalLock(hWaveFmtEx));
  If (pWaveFmtEx = Nil) Then
    Begin
      RecErrorMessage := 'Error locking WaveFormatEx memory';
      AllocWaveFormatEx := False;
      Exit;
    End;

  { initialize the format to standard PCM }
  ZeroMemory( pwavefmtex, maxFmtSize );
  pwavefmtex.wFormatTag := WAVE_FORMAT_PCM;
  pwavefmtex.nChannels := 1;
  pwavefmtex.nSamplesPerSec := 20000;
  pwavefmtex.nBlockAlign := 1;
  pwavefmtex.wBitsPerSample := 16;
  pwavefmtex.nAvgBytesPerSec := pwavefmtex.nSamplesPerSec*
                                (pwavefmtex.wBitsPerSample div
8)*pwavefmtex.nChannels;
  pwavefmtex.cbSize := 0;

  { Success, go home }
  AllocWaveFormatEx := True;
end;

{-------------InitWaveHeaders----------------John Mertus---14-June--97--}

   Function TWaveRecorder.InitWaveHeaders : Boolean;

{ Allocate memory, zero out wave headers and initialize                 }
{                                                                       }
{**********************************************************************}
Var
  i : Integer;

BEGIN
  { make the wave buffer size a multiple of the block align... }
  WaveBufSize := fBufferSize - (fBufferSize mod pwavefmtex.nBlockAlign);

  { Set the wave headers }
  For i := 0 to fTotalBuffers-1 Do
    With pWaveHeader[i]^ Do
      Begin
        lpData := pWaveBuffer[i];         // address of the waveform buffer
        dwBufferLength := WaveBufSize; // length, in bytes, of the buffer
        dwBytesRecorded := 0;          // see below
        dwUser := 0;                   // 32 bits of user data
        dwFlags := 0;                  // see below
        dwLoops := 0;                  // see below
        lpNext := Nil;                 // reserved; must be zero
        reserved := 0;                 // reserved; must be zero
      End;

  InitWaveHeaders := TRUE;
END;


{-------------AllocWaveHeader----------------John Mertus---14-June--97--}

   Function TWaveRecorder.AllocWaveHeaders : Boolean;

{ Allocate and lock header memory                                       }
{                                                                       }
{***********************************************************************}
Var
  i : Integer;

BEGIN
  For i := 0 to fTotalBuffers-1 Do
    begin
      hwaveheader[i] := GlobalAlloc( GMEM_MOVEABLE or GMEM_SHARE or
GMEM_ZEROINIT, sizeof(TWAVEHDR));
      if (hwaveheader[i] = 0) Then
        begin
          { NOTE: This could lead to a memory leak, fix someday }
          RecErrorMessage := 'Error allocating wave header memory';
          AllocWaveHeaders := FALSE;
          Exit;
        end;

      pwaveheader[i] := GlobalLock (hwaveheader[i]);
      If (pwaveheader[i] = Nil ) Then
        begin
         { NOTE: This could lead to a memory leak, fix someday }
          RecErrorMessage := 'Could not lock header memory for recording';
          AllocWaveHeaders := FALSE;
          Exit;
        end;

    End;

  AllocWaveHeaders := TRUE;
END;

{---------------FreeWaveHeader----------------John Mertus---14-June--97--}

   Procedure TWaveRecorder.FreeWaveHeader;

{ Just free up the memory AllocWaveHeaders allocated.                   }
{                                                                       }
{***********************************************************************}
Var
  i : Integer;

BEGIN
  For i := 0 to fTotalBuffers-1 Do
    begin
      If (hWaveHeader[i] <> 0) Then
        Begin
          GlobalUnlock(hwaveheader[i]);
          GlobalFree(hwaveheader[i]);
          hWaveHeader[i] := 0;
        End
    end;
END;

{
{-------------AllocPCMBuffers----------------John Mertus---14-June--97--}

   Function TWaveRecorder.AllocPCMBuffers : Boolean;

{ Allocate and lock the waveform memory.                                }
{                                                                       }
{***********************************************************************}
Var
  i : Integer;

BEGIN
  For i := 0 to fTotalBuffers-1 Do
    begin
      hWaveBuffer[i] := GlobalAlloc( GMEM_MOVEABLE or GMEM_SHARE, fBufferSize
);
      If (hWaveBuffer[i] = 0) Then
        begin
          { Possible Memory Leak here }
          RecErrorMessage := 'Error allocating wave buffer memory';
          AllocPCMBuffers := False;
          Exit;
        end;

      pWaveBuffer[i] := GlobalLock(hWaveBuffer[i]);
      If (pWaveBuffer[i] = Nil) Then
        begin
          { Possible Memory Leak here }
          RecErrorMessage := 'Error Locking wave buffer memory';
          AllocPCMBuffers := False;
          Exit;
        end;
      pWaveHeader[i].lpData := pWaveBuffer[i];
    End;

  AllocPCMBuffers := TRUE;
END;

{--------------FreePCMBuffers----------------John Mertus---14-June--97--}

   Procedure TWaveRecorder.FreePCMBuffers;

{ Free up the meomry AllocPCMBuffers used.                              }
{                                                                       }
{***********************************************************************}
Var
  i : Integer;

BEGIN
  For i := 0 to fTotalBuffers-1 Do
    begin
      If (hWaveBuffer[i] <> 0) Then
        Begin
          GlobalUnlock( hWaveBuffer[i] );
          GlobalFree( hWaveBuffer[i] );
          hWaveBuffer[i] := 0;
          pWaveBuffer[i] := Nil;
        End;
    end;
END;

{--------------FreeWaveFormatEx--------------John Mertus---14-June--97--}

   Procedure TWaveRecorder.FreeWaveFormatEx;

{ This just frees up the ExFormat headers                               }
{                                                                       }
{***********************************************************************}
BEGIN
  If (pWaveFmtEx = Nil) Then Exit;
  GlobalUnlock(hWaveFmtEx);
  GlobalFree(hWaveFmtEx);
  pWaveFmtEx := Nil;
END;

{-------------TWaveRecorder.Create------------John Mertus-----Aug--97--}

   Constructor TWaveRecorder.Create(BFSize, TotalBuffers : Integer);

{  This sets up the wave headers, initializes the data pointers and    }
{  allocates the sampling buffers                                      }
{     BFSize is the size of the buffer in BYTES                        }
{                                                                      }
{**********************************************************************}
Var
  i : Integer;
BEGIN
   Inherited Create;
   For i := 0 to fTotalBuffers-1 Do
     Begin
       hWaveHeader[i] := 0;
       hWaveBuffer[i] := 0;
       pWaveBuffer[i] := Nil;
       pWaveFmtEx := Nil;
     End;
   fBufferSize := BFSize;

   fTotalBuffers := TotalBuffers;
  { allocate memory for wave format structure }
  If(Not AllocWaveFormatEx) Then
    Begin
      InitWaveRecorder := FALSE;
      Exit;
    End;

  { find a device compatible with the available wave characteristics }
  If (waveInGetNumDevs < 1 ) Then
    Begin
      RecErrorMessage := 'No wave audio recording devices found';
      InitWaveRecorder := FALSE;
      Exit;
    End;

  { allocate the wave header memory }
  If (Not AllocWaveHeaders) Then
    Begin
      InitWaveRecorder := FALSE;
      Exit;
    End;

 { allocate the wave data buffer memory }
  If (Not AllocPCMBuffers)  Then
    Begin
      InitWaveRecorder := FALSE;
      Exit;
    End;

  InitWaveRecorder := TRUE;

END;

{---------------------Destroy----------------John Mertus---14-June--97--}

   Destructor TWaveRecorder.Destroy;

{ Just free up all memory allocated by InitWaveRecorder.                }
{                                                                       }
{***********************************************************************}

BEGIN
  FreeWaveFormatEx;
  FreePCMBuffers;
  FreeWaveHeader;
  Inherited Destroy;
END;

{------------CloseWaveDeviceRecord------------John Mertus---14-June--97--}

   Procedure TWaveRecorder.CloseWaveDeviceRecord;

{ Just close up the waveform device.                                    }
{                                                                       }
{***********************************************************************}
Var
  i : Integer;

BEGIN
   { if the device is already closed, just return }
   If (Not bDeviceOpen) Then Exit;

   { unprepare the headers }
   For i := 0 to fTotalBuffers-1 Do
    If (waveInUnprepareHeader(WaveIn, pWaveHeader[i], sizeof(TWAVEHDR)) <> 0 )
Then
      RecErrorMessage := 'Error in waveInUnprepareHeader';

   { save the total size recorded and update the display }
   dwTotalwavesize := dwBytedatasize;

   { close the wave input device }
   If (waveInClose(WaveIn) <> 0) Then
     RecErrorMessage := 'Error closing input device';

   { tell this function we are now closed }
   bDeviceOpen := FALSE;

END;

{------------------StopRecord-----------------John Mertus---14-June--97--}

   Procedure TWaveRecorder.StopRecord;

{ This stops the recording and sets some flags.                         }
{                                                                       }
{***********************************************************************}
Var
  iErr : Integer;

BEGIN

  RecordActive := False;
  iErr := waveInReset(WaveIn);
  { stop recording and return queued buffers }
  If (iErr <> 0) Then
     Begin
        RecErrorMessage := 'Error in waveInReset';
     End;

  CloseWaveDeviceRecord;
END;

{--------------AddNextBuffer------------------John Mertus---14-June--97--}

   Function TWaveRecorder.AddNextBuffer : Boolean;

{ This adds a buffer to the input queue and toggles buffer index.       }
{                                                                       }
{***********************************************************************}
Var
  iErr : Integer;

BEGIN
  { queue the buffer for input }
   iErr := waveInAddBuffer(WaveIn, pwaveheader[bufindex], sizeof(TWAVEHDR));
   If (iErr <> 0) Then
     begin
       StopRecord;
       RecErrorMessage := 'Error adding buffer' + TWaveInGetErrorText(iErr);
       AddNextBuffer := FALSE;
       Exit;
     end;

   { toggle for next buffer }
   bufindex := (bufindex+1) mod fTotalBuffers;
   QueuedBuffers := QueuedBuffers + 1;

   AddNextBuffer := TRUE;
END;


{--------------BufferDoneCallBack------------John Mertus---14-June--97--}

  Procedure BufferDoneCallBack(
    hW    : HWAVE;      // handle of waveform device
    uMsg  : DWORD;      // sent message
    dwInstance : DWORD; // instance data
    dwParam1 : DWORD;   // application-defined parameter
    dwParam2 : DWORD    // application-defined parameter
   );  stdcall;

{ This is called each time the wave device has info, e.g. fills a buffer}
{                                                                       }
{***********************************************************************}
Var
  BaseRecorder : PWaveRecorder;
BEGIN
  BaseRecorder := Pointer(DwInstance);
With BaseRecorder^ Do
  Begin
   ProcessBuffer(uMsg, pWaveBuffer[ProcessedBuffers Mod fTotalBuffers],
WaveBufSize);
   If (RecordActive) Then
      Case uMsg of
        WIM_DATA:
          Begin
            BaseRecorder.AddNextBuffer;
            ProcessedBuffers := ProcessedBuffers+1;
          End;
      End;
  End;
END;

{------------------StartRecord---------------John Mertus---14-June--97--}

   Function TWaveRecorder.StartRecord : Boolean;

{ This does all the work in creating the waveform recorder.             }
{                                                                       }
{***********************************************************************}
Var
  iErr, i : Integer;
 
BEGIN
  { start recording to first buffer }
  iErr := WaveInStart(WaveIn);
  If (iErr <> 0) Then
    begin
      CloseWaveDeviceRecord;
      RecErrorMessage := 'Error starting wave record: ' +
TWaveInGetErrorText(iErr);
    end;

   RecordActive := TRUE;

   { queue the next buffers }
   For i := 1 to fTotalBuffers-1 Do
     If (Not AddNextBuffer) Then
       Begin
         StartRecord := FALSE;
         Exit;
       End;

   StartRecord := True;
END;

{-----------------SetupRecord---------------John Mertus---14-June--97--}

   Function TWaveRecorder.SetupRecord(P : PWaveRecorder) : Boolean;

{ This does all the work in creating the waveform recorder.             }
{                                                                       }
{***********************************************************************}
Var
  iErr, i : Integer;

BEGIN
  dwTotalwavesize := 0;
  dwBytedatasize := 0;
  bufindex := 0;
  ProcessedBuffers := 0;
  QueuedBuffers := 0;

  { open the device for recording }
  iErr := waveInOpen(@WaveIn, WAVE_MAPPER, pWaveFmtEx,
Integer(@BufferDoneCallBack),
                 Integer(P), CALLBACK_FUNCTION + WAVE_ALLOWSYNC );
  If (iErr <> 0) Then
    Begin
      RecErrorMessage := 'Could not open the input device for recording: ' + ^M
+
                         TWaveInGetErrorText(iErr);
      SetupRecord := FALSE;
      Exit;
    End;

  { tell CloseWaveDeviceRecord() that the device is open }
  bDeviceOpen := TRUE;

  { prepare the headers }

  InitWaveHeaders();

  For i := 0 to fTotalBuffers-1 Do
    Begin
     iErr := waveInPrepareHeader( WaveIn, pWaveHeader[I], sizeof(TWAVEHDR));
       If (iErr <> 0) Then
         begin
           CloseWaveDeviceRecord;
           RecErrorMessage := 'Error preparing header for recording: ' + ^M +
                               TWaveInGetErrorText(iErr);
           SetupRecord := FALSE;
           Exit;
         end;
    End;

  { add the first buffer }
  If (Not AddNextBuffer) Then
    begin
      SetupRecord := FALSE;
      Exit;
    end;

   SetupRecord := TRUE;
END;

{-----------------ProcessBuffer---------------John Mertus---14-June--97--}

     Procedure   TWaveRecorder.ProcessBuffer(uMsg: Word; P : Pointer; n :
Integer);

{ Dummy procedure that is called when a buffer is ready.                }
{                                                                       }
{***********************************************************************}
BEGIN
END;

END.

0
 

Author Comment

by:tearsoftragedy
ID: 6253461
Ooh, well it seems that sending back the sound to inside is the only solution...

  Thanks VanDamM :)  thanks for your time
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Suggested Solutions

Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
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…
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.
In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're interested in additional methods for monitoring bandwidt…

744 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

11 Experts available now in Live!

Get 1:1 Help Now