запись звукового потока

← →
mstitel (2006-10-07 22:35) [0]

подскажите как записать все звуки, которые в данный момент проигрываются на компе.

← →
Eraser © (2006-10-08 15:13) [1]

> [0] mstitel (07.10.06 22:35)

waveInAddBuffer
waveInClose
waveInGetDevCaps
waveInGetErrorText
waveInGetID
waveInGetNumDevs
waveInGetPosition
waveInMessage
waveInOpen
waveInPrepareHeader
waveInProc
waveInReset
waveInStart
waveInStop
waveInUnprepareHeader
+ F1

← →
Проггер из библиотеки (2006-10-08 15:17) [2]

> [1]
А оно поможет отловить, например, те звуки, которые в это время играет какой-нибудь WinAmp или Windows Media Player? Насколько я понимаю, автор именно это прости...

← →
Vovan#1 (2006-10-08 15:37) [3]

>А оно поможет отловить, например, те звуки, которые в это время играет какой-нибудь WinAmp или Windows Media Player? Насколько я понимаю, автор именно это прости..

Может.

← →
Сергей М. © (2006-10-09 08:28) [4]

> Проггер из библиотеки (08.10.06 15:17) [2]
>
> > [1]
> А оно поможет

Нет, не поможет.

← →
ProgRAMmer Dimonych © (2006-10-09 18:49) [5]

> [3] и [4]
Так да или нет? :)

← →
Сергей М. © (2006-10-10 08:23) [6]

> ProgRAMmer Dimonych © (09.10.06 18:49) [5]

Точнее поможет лишь в частном случае, когда микшер аудиокарты поддерживает запись от источника "What you hear".

← →
S0ldier © (2006-10-10 18:28) [7]

http://delphimaster.net/view/8-1154023549/

← →
Vovan#1 (2006-10-10 20:57) [8]

2 Сергей М:

Похоже, за Вами правда. Но как тогда работают программы, которые грабят любой звук, производимый системой?

← →
Eraser © (2006-10-11 01:08) [9]

> [8] Vovan#1 (10.10.06 20:57)

и midi тоже? )

большенство современных звуковых карт (я б сказал 95%) позволяют "перехватывать" микшер.

← →
Сергей М. © (2006-10-11 08:28) [10]

> Vovan#1 (10.10.06 20:57) [8]

> программы, которые грабят любой звук

Таких программ нет и быть не может.

← →
zorgens (2006-10-11 14:08) [11]

> Таких программ нет и быть не может.

Это точно.
В свойствах записи выбирай стереомикшер и всё будешь писать.

> zorgens (11.10.06 14:08) [11]

Аудиодивйс не обязан иметь такое свойство.

← →
zorgens (2006-10-11 14:53) [13]

> Аудиодивайс не обязан иметь такое свойство.

ну это уже риторический пошёл разговор.
давайте ещё вспомним когда софт на спикер что-то там синтезировал,
помню был у меня типа spechApi под DOS, мда было время...

вот мститель, разбирайся если хочешь:

uses MMSystem, wavfile;

procedure TForm1.Button1Click(Sender: TObject);
const
fr = 11025; {Частота в герцах}
len = 1; {Длина звука в секундах}

procedure GetData(ch: smallint; index: integer; var res);
var
v: smallint absolute res; // конечное значение
amp: single; // амплитуда
begin
if ch = 0
then amp := sin(index * 2 * Pi / (fr * len))
else amp := cos(index * 2 * Pi / (fr * len));
v := round(amp * (random(60000) - 30000));
end;

var
M: TMemoryStream; // поток для хранения информации в памяти
F: TFileStream; // Поток для созранения файла
begin
M := nil; F := nil;
try
M := TMemoryStream.Create;
randomize;
SaveSound(M {Куда записывать}, round(fr * len) {len секунд},
fr {частота}, 16 {16 бит}, 2 {2 каналла}, @GetData);
// Воспроизведение звука:
if not playsound(M.Memory, 0, SND_MEMORY or SND_LOOP or SND_ASYNC)
then ShowMessage("Can not play the sound");

F := TFileStream.Create("ex.wav", fmCreate);
M.Position := 0;
F.CopyFrom(M, M.Size);
finally
M.Free; F.Free;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
playsound(nil, 0, 0); // Остановка воспроизведения
end;

procedure TForm1.Button3Click(Sender: TObject);
var
SampleCount, SamplesPerSec: integer;
BitsPerSample, Channeles: smallint;
F: TFileStream;
Volume: array [0..1] of single;
ToPercent: single;
buf: pointer;
buf8: ^shortint;
buf16: ^smallint;
i, ch: integer;
begin
F := nil; buf := nil;
try
Volume[0] := 0; Volume[1] := 0;
F := TFileStream.Create("ex.wav", fmOpenRead);
ReadWaveHeader(F, SampleCount, SamplesPerSec,
BitsPerSample, Channeles);

// Чтение данных:
GetMem(buf, SampleCount * Channeles * BitsPerSample);
F.Read(buf^, SampleCount * Channeles * BitsPerSample);
if BitsPerSample = 8 then begin
buf8 := buf;
for i := 0 to SampleCount - 1 do
for ch := 0 to Channeles - 1 do begin
Volume[ch] := Volume[ch] + abs(buf8^);
inc(buf8); // Переход к следующему элементу
end
end else begin
buf16 := buf;
for i := 0 to SampleCount - 1 do
for ch := 0 to Channeles - 1 do begin
Volume[ch] := Volume[ch] + abs(buf16^);
inc(buf16); // Переход к следующему элементу
end;
end;

// Вывод результатов:
ToPercent := (1 shl BitsPerSample) / 100 * SampleCount;
if Channeles = 1
then Form1.Caption := Format("volume: %2.2f%%",
[Volume[0] / ToPercent])
else Form1.Caption := Format("left: %2.2f%%, right: %2.2f%%",
[Volume[0] / ToPercent, Volume[1] / ToPercent]);
finally
F.Free;
FreeMem(buf);
end;
end;

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

unit wavfile;

interface

uses classes, sysutils;

type
TWaveHeader = record
idRiff: array [0..3] of char;
RiffLen: longint;
idWave: array [0..3] of char;
idFmt: array [0..3] of char;
InfoLen: longint;
WaveType: smallint;
Ch: smallint;
Freq: longint;
BytesPerSec: longint;
align: smallint;
Bits: smallint;
end;

TDataHeader = record
idData: array [0..3] of char;
DataLen: longint;
end;

TGetData = procedure(ch: smallint; index: integer; var res);
TSetData = procedure(ch: smallint; index: integer; data: smallint);

procedure CreateWaveHeader(SampleCount, SamplesPerSec: integer;
BitsPerSample, Channeles: smallint; var WaveHeader: TWaveHeader;
var DataHeader: TDataHeader);
procedure ReadWaveHeader(Stream: TStream;
var SampleCount, SamplesPerSec: integer;
var BitsPerSample, Channeles: smallint);
procedure SaveSound(Stream: TStream; SampleCount, SamplesPerSec: integer;
BitsPerSample, Channeles: smallint; GetData: TGetData);

implementation

procedure Creat
BitsPerSample, Channeles: smallint; var WaveHeader: TWaveHeader;
var DataHeader: TDataHeader);
var
len: integer;
begin
if (SampleCount < 0) or (SamplesPerSec < 1) or
(not BitsPerSample in [8, 16]) or
(not Channeles in [1, 2])
then raise Exception.Create("Wrong params");

len := SampleCount * BitsPerSample div 8 * Channeles;
with WaveHeader do begin
idRiff := "RIFF";
RiffLen := len + 38;
idWave := "WAVE";
idFmt := "fmt ";
InfoLen := 16;
WaveType := 1;
Ch := Channeles;
Freq := SamplesPerSec;
BytesPerSec := SamplesPerSec * BitsPerSample div 8 * Channeles;
align := Channeles * BitsPerSample div 8;
Bits := BitsPerSample;
end;
with DataHeader do begin
idData := "data";
DataLen := len;
end;
end;

procedure ReadWaveHeader(Stream: TStream;
var SampleCount, SamplesPerSec: integer;
var BitsPerSample, Channeles: smallint);
var
WaveHeader: TWaveHeader;
DataHeader: TDataHeader;
begin
Stream.Read(WaveHeader, sizeof(TWaveHeader));
with WaveHeader do begin
if idRiff < > "RIFF" then raise EReadError.Create("Wrong idRIFF");
if idWave < > "WAVE" then raise EReadError.Create("Wrong idWAVE");
if idFmt < > "fmt " then raise EReadError.Create("Wrong idFmt");
if WaveType < > 1 then raise EReadError.Create("Unknown format");
Channeles := Ch;
SamplesPerSec := Freq;
BitsPerSample := Bits;
Stream.Seek(InfoLen - 16, soFromCurrent);
end;
Stream.Read(DataHeader, sizeof(TDataHeader));
if DataHeader.idData = "fact" then begin
Stream.Seek(4, soFromCurrent);
Stream.Read(DataHeader, sizeof(TDataHeader));
end;
with DataHeader do begin
if idData < > "data" then raise EReadError.Create("Wrong idData");
SampleCount := DataLen div (Channeles * BitsPerSample div 8)
end;
end;

procedure SaveSound(Stream: TStream; SampleCount, SamplesPerSec: integer;
BitsPerSample, Channeles: smallint; GetData: TGetData);
var
WaveHeader: TWaveHeader;
DataHeader: TDataHeader;
buf: smallint;
BytesPerSample: smallint;
i: integer;
begin
CreateWaveHeader(SampleCount, SamplesPerSec, BitsPerSample,
Channeles, WaveHeader, DataHeader);
Stream.Write(WaveHeader, sizeof(TWaveHeader));
Stream.Write(DataHeader, sizeof(TDataHeader));
BytesPerSample := BitsPerSample div 8;
if Channeles = 1
then
for i := 0 to SampleCount - 1 do begin
GetData(0, i, buf);
Stream.Write(buf, BytesPerSample);
end
else
for i := 0 to SampleCount - 1 do begin
GetData(0, i, buf);
Stream.Write(buf, BytesPerSample);
GetData(1, i, buf);
Stream.Write(buf, BytesPerSample);
end;
end;

end.

> zorgens (11.10.06 14:53) [13]
> ну это уже риторический пошёл разговор

Это, увы и ах, далеко не "риторика" - в эксплуатации находится еще немало карт, не поддерживающих WUH-ф-цию микшера в принципе.

запись звукового потока Найти похожие ветки