| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
запись звукового потока [D7, WinXP]
mstitel © (2006-10-07 22:35:00)подскажите как записать все звуки, которые в данный момент проигрываются на компе.
Сергей М. (2006-10-11 15:09:00) [1]
> zorgens (11.10.06 14:53) [13]
> ну это уже риторический пошёл разговор
Это, увы и ах, далеко не "риторика" - в эксплуатации находится еще немало карт, не поддерживающих WUH-ф-цию микшера в принципе.
zorgens (2006-10-11 14:53:00) [2]
> Аудиодивайс не обязан иметь такое свойство.
ну это уже риторический пошёл разговор.
давайте ещё вспомним когда софт на спикер что-то там синтезировал,
помню был у меня типа 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.
Сергей М. (2006-10-11 14:39:00) [3]
> zorgens (11.10.06 14:08) [11]
Аудиодивйс не обязан иметь такое свойство.
zorgens (2006-10-11 14:08:00) [4]
> Таких программ нет и быть не может.
Это точно.
В свойствах записи выбирай стереомикшер и всё будешь писать.
Сергей М. (2006-10-11 08:28:00) [5]
> Vovan#1 (10.10.06 20:57) [8]
> программы, которые грабят любой звук
Таких программ нет и быть не может.
Eraser (2006-10-11 01:08:00) [6]> [8] Vovan#1 (10.10.06 20:57)
и midi тоже? )
большенство современных звуковых карт (я б сказал 95%) позволяют "перехватывать" микшер.
Vovan#1 (2006-10-10 20:57:00) [7]2 Сергей М:
Похоже, за Вами правда. Но как тогда работают программы, которые грабят любой звук, производимый системой?
S0ldier (2006-10-10 18:28:00) [8]http://delphimaster.ru/cgi-bin/forum.pl?id=1154023549&n=7
Сергей М. (2006-10-10 08:23:00) [9]
> ProgRAMmer Dimonych © (09.10.06 18:49) [5]
Точнее поможет лишь в частном случае, когда микшер аудиокарты поддерживает запись от источника "What you hear".
ProgRAMmer Dimonych (2006-10-09 18:49:00) [10]> [3] и [4]
Так да или нет? :)
Сергей М. (2006-10-09 08:28:00) [11]
> Проггер из библиотеки (08.10.06 15:17) [2]
>
> > [1]
> А оно поможет
Нет, не поможет.
Vovan#1 (2006-10-08 15:37:00) [12]>А оно поможет отловить, например, те звуки, которые в это время играет какой-нибудь WinAmp или Windows Media Player? Насколько я понимаю, автор именно это прости..
Может.
Проггер из библиотеки (2006-10-08 15:17:00) [13]> [1]
А оно поможет отловить, например, те звуки, которые в это время играет какой-нибудь WinAmp или Windows Media Player? Насколько я понимаю, автор именно это прости...
Eraser (2006-10-08 15:13:00) [14]> [0] mstitel (07.10.06 22:35)
waveInAddBuffer
waveInClose
waveInGetDevCaps
waveInGetErrorText
waveInGetID
waveInGetNumDevs
waveInGetPosition
waveInMessage
waveInOpen
waveInPrepareHeader
waveInProc
waveInReset
waveInStart
waveInStop
waveInUnprepareHeader
+ F1
| |
