Создание FLAC-файла или FLAC-потока с использованием BASS DLL с Delphi

Question

Я играю с BASS с http://www.un4seen.com/.

Мне нужно создать файл flac (16 бит) или поток flac от пользователя, говорящего на микрофоне.

Я видел эту демонстрацию в исходном коде BASS. Также есть bassenc_flac.dll с этими функциями:

function BASS_Encode_FLAC_Start(handle:DWORD; options:PChar; flags:DWORD; proc:ENCODEPROCEX; user:Pointer): HENCODE; {$IFDEF MSWINDOWS}stdcall{$ELSE}cdecl{$ENDIF}; external bassencflacdll;
function BASS_Encode_FLAC_StartFile(handle:DWORD; options:PChar; flags:DWORD; filename:PChar): HENCODE; {$IFDEF MSWINDOWS}stdcall{$ELSE}cdecl{$ENDIF}; external bassencflacdll;

Как я могу изменить следующий код для кодирования аудио в файл FLAC или поток?

От RecordTest BASS демо

(* This is called while recording audio *)
function RecordingCallback(Handle: HRECORD; buffer: Pointer; length: DWORD; user: Pointer): boolean; stdcall;
var level:dword;
begin
    level:=BASS_ChannelGetLevel(Handle);
    // Copy new buffer contents to the memory buffer
    Form1.WaveStream.Write(buffer^, length);
    // Allow recording to continue
    Result := True;
end;

(* Start recording to memory *)
procedure TForm1.StartRecording;
begin
    if ComboBox1.ItemIndex < 0 then Exit;
    if WaveStream.Size > 0 then
    begin   // free old recording
        BASS_StreamFree(chan);
        WaveStream.Clear;
    end;
    // generate header for WAV file
    with WaveHdr do
    begin
        riff := 'RIFF';
        len := 36;
        cWavFmt := 'WAVEfmt ';
        dwHdrLen := 16;
        wFormat := 1;
        wNumChannels := 2;
        dwSampleRate := 44100;
        wBlockAlign := 4;
        dwBytesPerSec := 176400;
        wBitsPerSample := 16;
        cData := 'data';
        dwDataLen := 0;
    end;
    WaveStream.Write(WaveHdr, SizeOf(WAVHDR));
    // start recording @ 44100hz 16-bit stereo
    rchan := BASS_RecordStart(44100, 2, 0, @RecordingCallback, nil);
    if rchan = 0 then
    begin
        MessageDlg('Couldn''t start recording!', mtError, [mbOk], 0);
        WaveStream.Clear;
    end
    else
    begin
        bRecord.Caption := 'Stop';
        bPlay.Enabled := False;
        bSave.Enabled := False;
    end;
end;


(* Stop recording *)
procedure TForm1.StopRecording;
var
    i: integer;
  he:BassEnc.HENCODE;
begin
    BASS_ChannelStop(rchan);
    bRecord.Caption := 'Record';
    // complete the WAV header
    WaveStream.Position := 4;
    i := WaveStream.Size - 8;
    WaveStream.Write(i, 4);
    i := i - $24;
    WaveStream.Position := 40;
    WaveStream.Write(i, 4);
    WaveStream.Position := 0;
    // create a stream from the recorded data
    chan := BASS_StreamCreateFile(True, WaveStream.Memory, 0, WaveStream.Size, 0);
    if chan <> 0 then
    begin
        // enable "Play" & "Save" buttons
        bPlay.Enabled := True;
        bSave.Enabled := True;
    end
    else
        MessageDlg('Error creating stream from recorded data!', mtError, [mbOk], 0);
    if SaveDialog.Execute then
       WaveStream.SaveToFile(SaveDialog.FileName);

end;

Answer 1

Я обновил код из-за комментариев, которые показывают некорректную работу предыдущей версии кодировщика. И я полностью согласен с этими комментариями.

Чтобы создать кодировщик для FLAC, нужно зайти на un4seen веб-сайт и скачать следующие файлы:

1. BASS audio library 2.4
2. BASSFLAC 2.4.4
3. BASSenc 2.4.14
4. BASSenc_FLAC 2.4.1.1

Просмотрите эти папки и найдите следующие файлы:

1. bass.pas
2. bassenc.pas
3. bassenc_flac.pas

Теперь поместите эти pas-файлы в одну папку и добавьте их в Library с помощью Delphi's опции.
После этого создайте новый проект, сохраните его в отдельной папке.
Затем просмотрите папки BASS_XXX и найдите *.dll файлы.
Объедините их вместе в папке, где вы сохранили свой проект!

Теперь давайте напишем некоторый код.

Добавить к uses пункт bass.pas, bassenc.pas а также bassenc_flac.pas, Затем скопируйте код, показанный ниже.

  uses ..., BASS, BASSEnc, BASSEnc_FLAC;

  ...

  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;      
  public
    { Public declarations }
    procedure StartEncode(SourceFileName, OutputFileName: String);
    procedure StopEncode;
  end;

...

procedure TForm1.StartEncode(SourceFileName, OutputFileName: String);
var
  PercentDone: Cardinal;
  Buffer: array [0..1024] of Byte;
begin
  Channel := BASS_StreamCreateFile(false, PChar(SourceFileName), 0, 0, BASS_MUSIC_DECODE or BASS_UNICODE);
  BASSEnc_FLAC.BASS_Encode_FLAC_StartFile(Channel, 0, BASS_ENCODE_FP_AUTO or BASS_UNICODE, PChar(OutputFileName));
  while BASS_ChannelIsActive(Channel) > 0 do
  begin
    BASS_ChannelGetData(Channel, @Buffer, 1024);
    PercentDone := Trunc(100 * (BASS_ChannelGetPosition(Channel, BASS_POS_BYTE) / BASS_ChannelGetLength(Channel, BASS_POS_BYTE)));
    ProgressBar1.Position := PercentDone;
  end;
  StopEncode;
end;

procedure TForm1.StopEncode;
begin
  BASS_Encode_Stop(Channel);
  BASS_StreamFree(Channel);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  BASS_Init(-1, 44100, 0, Application.Handle, nil);
  try   
    // Set name of file to convert it to FLAC and save it with output name
    StartEncode('SourceFileName', 'OutputFileName');
  finally
    BASS.BASS_Free;
  end;
end;

Одно уведомление:
Действительно, файл, закодированный с предыдущей версией кода, имел неправильный заголовок (я мог видеть его, когда открывал файл в Notepad.exe). После обновления кода я вижу действительный заголовок (конечно, в Блокноте, потому что у меня нет профессиональных инструментов для работы с аудио-файлами).
Теперь вам даже не нужно добавлять плагин в BASS как я делал раньше. С тех пор я думаю, что кодер работает так, как ожидалось.