Создание нового WAV-файла

unit utestrec;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, MPlayer, MMSystem, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure AppException(Sender: TObject; E: Exception);
  private
    FDeviceID: Word;
    { Private declarations }
  public
    procedure OpenMedia;
    procedure RecordMedia;
    procedure StopMedia;
    procedure SaveMedia;
    procedure CloseMedia;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

var
  MyError, Flags: Longint;

procedure TForm1.OpenMedia;
var
  MyOpenParms: TMCI_Open_Parms;
  MyPChar: PChar;
  TextLen: Longint;
begin
  Flags := mci_Wait or mci_Open_Element or mci_Open_Type;
  with MyOpenParms do
  begin
    dwCallback := Handle; // TForm1.Handle
    lpstrDeviceType := PChar('WaveAudio');
    lpstrElementName := PChar('');
  end;
  MyError := mciSendCommand(0, mci_Open, Flags,
    Longint(@MyOpenParms));
  if MyError = 0 then
    FDeviceID := MyOpenParms.wDeviceID;
end;

procedure TForm1.RecordMedia;
var
  MyRecordParms: TMCI_Record_Parms;
  TextLen: Longint;
begin
  Flags := mci_Notify;
  with MyRecordParms do
  begin
    dwCallback := Handle; // TForm1.Handle
    dwFrom := 0;
    dwTo := 10000;
  end;
  MyError := mciSendCommand(FDeviceID, mci_Record, Flags,
    Longint(@MyRecordParms));
end;

procedure TForm1.StopMedia;
var
  MyGenParms: TMCI_Generic_Parms;
begin
  if FDeviceID <> 0 then
  begin
    Flags := mci_Wait;
    MyGenParms.dwCallback := Handle; // TForm1.Handle
    MyError := mciSendCommand(FDeviceID, mci_Stop, Flags,
      Longint(@MyGenParms));
  end;
end;

procedure TForm1.SaveMedia;
type // не реализовано в Delphi
  PMCI_Save_Parms = ^TMCI_Save_Parms;
  TMCI_Save_Parms = record
    dwCallback: DWord;
    lpstrFileName: PAnsiChar; // имя файла, который нужно сохранить
  end;
var
  MySaveParms: TMCI_Save_Parms;
begin
  if FDeviceID <> 0 then
  begin
    // сохраняем файл...
    Flags := mci_Save_File or mci_Wait;
    with MySaveParms do
    begin
      dwCallback := Handle;
      lpstrFileName := PChar('c:\message.wav');
    end;
    MyError := mciSendCommand(FDeviceID, mci_Save, Flags,
      Longint(@MySaveParms));
  end;
end;

procedure TForm1.CloseMedia;
var
  MyGenParms: TMCI_Generic_Parms;
begin
  if FDeviceID <> 0 then
  begin
    Flags := 0;
    MyGenParms.dwCallback := Handle; // TForm1.Handle
    MyError := mciSendCommand(FDeviceID, mci_Close, Flags,
      Longint(@MyGenParms));
    if MyError = 0 then
      FDeviceID := 0;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  OpenMedia;
  RecordMedia;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  StopMedia;
  SaveMedia;
  CloseMedia;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnException := AppException;
end;

procedure TForm1.AppException(Sender: TObject; E: Exception);
begin
  CloseMedia;
end;

end.