|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Запись звука с программы
Здравствуйте, как можно записать звук из программы, у меня в программе например играет песня и как записать именно те звуки которые воспроизводятся в программе и не чего кроме этой программы
|
Этот пользователь сказал Спасибо BlackMonsta за это полезное сообщение: | ||
prograys (11.05.2022)
|
#2
|
|||
|
|||
Все) нашел решение))
Код:
// (c) Ter-Osipov Alex V. as known as Eraser on delphimaster.ru. 2009 unit MainForm; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, MMDeviceAPI, StdCtrls, ComObj, ActiveX, ComCtrls, MMSystem; type TInputRecordThread = class(TThread) private FData: TMemoryStream; FLoopback: Boolean; protected procedure Execute; override; public constructor Create(CreateSuspended: Boolean); destructor Destroy; override; property Data: TMemoryStream read FData; property Loopback: Boolean read FLoopback write FLoopback; end; TfmMain = class(TForm) tbMaster: TTrackBar; gbRecordInput: TGroupBox; btnStartInput: TButton; btnStopInput: TButton; SaveDialog: TSaveDialog; lbMasterVolume: TLabel; gbRecordLoopback: TGroupBox; btnStartLoopback: TButton; btnStopLoopback: TButton; procedure tbMasterChange(Sender: TObject); procedure btnStartInputClick(Sender: TObject); procedure btnStopInputClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure btnStartLoopbackClick(Sender: TObject); procedure btnStopLoopbackClick(Sender: TObject); private FInputRecordThread, FLoopbackRecordThread: TInputRecordThread; FMMDev: IMMDevice; FMMDevEnum: IMMDeviceEnumerator; FEndpoint: IAudioEndpointVolume; FVolumeUpdating: Boolean; procedure InitMasterVolume; procedure UpdateMasterVolume; procedure InputRecordTerminateHandler(Sender: TObject); public property VolumeUpdating: Boolean read FVolumeUpdating write FVolumeUpdating; end; TMyEndpointVolumeCallback = class(TInterfacedObject, IAudioEndpointVolumeCallback) public function OnNotify(pNotify: PAUDIO_VOLUME_NOTIFICATION_DATA): HRESULT; stdcall; end; var fmMain: TfmMain; implementation uses WaveUtils; {$R *.dfm} procedure TfmMain.btnStartInputClick(Sender: TObject); begin btnStartInput.Enabled := False; btnStopInput.Enabled := True; FInputRecordThread := TInputRecordThread.Create(True); FInputRecordThread.OnTerminate := InputRecordTerminateHandler; FInputRecordThread.Resume; end; procedure TfmMain.btnStartLoopbackClick(Sender: TObject); begin btnStartLoopback.Enabled := False; btnStopLoopback.Enabled := True; FLoopbackRecordThread := TInputRecordThread.Create(True); FLoopbackRecordThread.Loopback := True; FLoopbackRecordThread.OnTerminate := InputRecordTerminateHandler; FLoopbackRecordThread.Resume; end; procedure TfmMain.btnStopInputClick(Sender: TObject); begin FInputRecordThread.Terminate; end; procedure TfmMain.btnStopLoopbackClick(Sender: TObject); begin FLoopbackRecordThread.Terminate; end; procedure TfmMain.FormCreate(Sender: TObject); begin // Òîëüêî äëÿ âèñòû è âûøå. if (Win32Platform <> VER_PLATFORM_WIN32_NT) or (Win32MajorVersion < 6) then begin ShowMessage('For Vista and above only.'); Application.Terminate; Exit; end; InitMasterVolume; end; procedure TfmMain.InitMasterVolume; var PropVar: ^tag_inner_PROPVARIANT; MyEndpointVolumeCallback: IAudioEndpointVolumeCallback; begin PropVar := nil; CoCreateInstance(CLASS_MMDeviceEnumerator, nil, CLSCTX_ALL, IID_IMMDeviceEnumerator, FMMDevEnum); FMMDevEnum.GetDefaultAudioEndpoint(eRender, eMultimedia, FMMDev); FMMDev.Activate(IID_IAudioEndpointVolume, CLSCTX_ALL, PropVar^, Pointer(FEndPoint)); // Volume changes handler. MyEndpointVolumeCallback := TMyEndpointVolumeCallback.Create; FEndPoint.RegisterControlChangeNotify(MyEndpointVolumeCallback); UpdateMasterVolume; end; procedure TfmMain.InputRecordTerminateHandler(Sender: TObject); begin if TInputRecordThread(Sender).Loopback then begin btnStartLoopback.Enabled := True; btnStopLoopback.Enabled := False; end else begin btnStartInput.Enabled := True; btnStopInput.Enabled := False; end; if SaveDialog.Execute then begin TInputRecordThread(Sender).Data.Position := 0; TInputRecordThread(Sender).Data.SaveToFile(SaveDialog.FileName); end; end; procedure TfmMain.tbMasterChange(Sender: TObject); begin if FVolumeUpdating then Exit; FEndPoint.SetMasterVolumeLevelScalar(tbMaster.Position / 100, nil); end; procedure TfmMain.UpdateMasterVolume; var VolLevel: Single; begin FEndPoint.GetMasterVolumeLevelScalar(VolLevel); tbMaster.Position := Round(VolLevel * 100); end; { TMyEndpointVolumeCallback } function TMyEndpointVolumeCallback.OnNotify( pNotify: PAUDIO_VOLUME_NOTIFICATION_DATA): HRESULT; begin Result := S_OK; fmMain.VolumeUpdating := True; try fmMain.tbMaster.Position := Round(pNotify.fMasterVolume * 100); finally fmMain.VolumeUpdating := False; end; end; { TInputRecordThread } constructor TInputRecordThread.Create(CreateSuspended: Boolean); begin inherited Create(CreateSuspended); FData := TMemoryStream.Create; end; destructor TInputRecordThread.Destroy; begin FData.Free; inherited; end; // http://msdn.microsoft.com/en-us/library/ms678709(VS.85).aspx procedure TInputRecordThread.Execute; const REFTIMES_PER_SEC = 10000000; REFTIMES_PER_MILLISEC = 10000; var MMDev: IMMDevice; MMDevEnum: IMMDeviceEnumerator; AudioClient: IAudioClient; CaptureClient: IAudioCaptureClient; PropVar: ^tag_inner_PROPVARIANT; hnsRequestedDuration, hnsActualDuration: Int64; pWfx, pCloseWfx: PWaveFormatEx; BufferFrameCount, NumFramesAvailable, Flags, StreamFlags, PacketLength, FrameSize: Cardinal; pData: PByte; uDummy: UInt64; Returned: HRESULT; Wave: TWaveImage; Empty: array of byte; pEx: PWaveFormatExtensible; begin FreeOnTerminate := True; pCloseWfx := nil; uDummy := 0; PropVar := nil; CoInitializeEx(nil, COINIT_APARTMENTTHREADED); CoCreateInstance(CLASS_MMDeviceEnumerator, nil, CLSCTX_ALL, IID_IMMDeviceEnumerator, MMDevEnum); if FLoopback then Returned := MMDevEnum.GetDefaultAudioEndpoint(eRender, eConsole, MMDev) else Returned := MMDevEnum.GetDefaultAudioEndpoint(eCapture, eConsole, MMDev); if Returned <> S_OK then begin OleCheck(Returned); Exit; end; Returned := MMDev.Activate(IID_IAudioClient, CLSCTX_ALL, PropVar^, Pointer(AudioClient)); if Returned <> S_OK then begin OleCheck(Returned); Exit; end; AudioClient.GetMixFormat(pWfx); // http://www.ambisonic.net/mulchaud.html case pWfx.wFormatTag of WAVE_FORMAT_IEEE_FLOAT: begin pWfx.wFormatTag := WAVE_FORMAT_PCM; pWfx.wBitsPerSample := 16; pWfx.nBlockAlign := pWfx.nChannels * pWfx.wBitsPerSample div 8; pWfx.nAvgBytesPerSec := pWfx.nBlockAlign * pWfx.nSamplesPerSec; end; WAVE_FORMAT_EXTENSIBLE: begin pEx := PWaveFormatExtensible(pWfx); if not IsEqualGUID(KSDATAFORMAT_SUBTYPE_IEEE_FLOAT, pEx.SubFormat) then begin Exit; end; pEx.SubFormat := KSDATAFORMAT_SUBTYPE_PCM; pEx.ValidBitsPerSample := 16; pWfx.wBitsPerSample := 16; pWfx.nBlockAlign := pWfx.nChannels * pWfx.wBitsPerSample div 8; pWfx.nAvgBytesPerSec := pWfx.nBlockAlign * pWfx.nSamplesPerSec; end; else Exit; end; if AudioClient.IsFormatSupported(AUDCLNT_SHAREMODE_SHARED, pWfx, pCloseWfx) <> S_OK then begin Exit; end; // Ðàçìåð ôðýéìà. FrameSize := pWfx.wBitsPerSample * pWfx.nChannels div 8; hnsRequestedDuration := REFTIMES_PER_SEC; if FLoopback then StreamFlags := AUDCLNT_STREAMFLAGS_LOOPBACK else StreamFlags := 0; Returned := AudioClient.Initialize(AUDCLNT_SHAREMODE_SHARED, StreamFlags, hnsRequestedDuration, 0, pWfx, nil); if Returned <> S_OK then begin Exit; end; AudioClient.GetBufferSize(BufferFrameCount); Returned := AudioClient.GetService(IID_IAudioCaptureClient, Pointer(CaptureClient)); if Returned <> S_OK then begin Exit; end; // Calculate the actual duration of the allocated buffer. hnsActualDuration := REFTIMES_PER_SEC * BufferFrameCount div pWfx.nSamplesPerSec; // Start recording. AudioClient.Start(); Wave := TWaveImage.Create(FData); try Wave.InitHeader(pWfx^); // Each loop fills about half of the shared buffer. while not Terminated do begin // Sleep for half the buffer duration. Sleep(hnsActualDuration div REFTIMES_PER_MILLISEC div 2); CaptureClient.GetNextPacketSize(PacketLength); while PacketLength <> 0 do begin // Get the available data in the shared buffer. pData := nil; Returned := CaptureClient.GetBuffer(pData, NumFramesAvailable, Flags, uDummy, uDummy); if Returned <> S_OK then begin Exit; end; if (Flags or Cardinal(AUDCLNT_BUFFERFLAGS_SILENT)) = Flags then begin pData := nil; // Tell CopyData to write silence. end; if pData = nil then begin SetLength(Empty, NumFramesAvailable * FrameSize); FillChar(Empty[0], Length(Empty), 0); FData.Write(Empty[0], Length(Empty)); end else begin // Ñîõðàíÿåì äàííûå. FData.Write(pData^, NumFramesAvailable * FrameSize); end; CaptureClient.ReleaseBuffer(NumFramesAvailable); CaptureClient.GetNextPacketSize(PacketLength); end; end; // Îñòàíàâëèâàåì çàïèñü. AudioClient.Stop(); // Îòêîððåòèðóåì çàãîëîâîê. Wave.CorretHeader; FData.Position := 0; finally Wave.Free; if pWfx <> nil then CoTaskMemFree(pWfx); end; end; end. |
#3
|
|||
|
|||
Нет, этот код не рабочий( помогите как еще можно записать звук с компьютера??
|
#4
|
||||
|
||||
Оффтоп:
Цитата:
Цитата:
Приведенный выше код хоть что-то пишет? Он работает от системного микшера, MMDev как раз в роли микрофона запущен. Нужно искать в системе по ID девайс этой программы и с него брать данные, но это похоже не реально, джеки у переходника не подходят к разъёму Я не понял Вашего вопроса, но всё же Вам на него отвечу! |
#5
|
||||
|
||||
как воспроизводится звук? может можно поток перехватить и НИИ-Баста?
— Как тебя понимать? — Понимать меня не обязательно. Обязательно меня любить и кормить вовремя. На Delphi, увы, больше не программирую. Рекомендуемая литература по программированию |
#6
|
|||
|
|||
Ура)) нашел)) вот рабочий проект)) Запись очень хорошая^^
|