Форум программистов [Powered by Invision Power Board]

Код

unit LineWavePlayer;

interface

uses TapiH, MMSystem, Windows, SysUtils, Forms, Messages, Classes, ExtCtrls,
      MainForm;

const
  ecFileNotFound           = -2;       {File not found}
  ecTapiWaveFail           = -13936;
  ecTapiWaveReadError      = -13940;
  ecTapiWaveDeviceInUse    = -13943;

  WaveInError   = 1;
  WaveOutError  = 2;
  MMioError     = 3;

  WaveOutBufferSeconds = 3;

type
  TPathCharArray=array[0..255]of char;
  TWaveState  = (wsIdle, wsPlaying, wsData);
  TWaveMessage = (waPlayOpen, waPlayDone, waPlayClose,
                 waRecordOpen, waDataReady, waRecordClose);

  {For returning TAPI VARSTRING data}
  PVarString = ^TVarString;
  TVarString = record
    case integer of
      1: (TotalSize     : DWORD;
          NeededSize    : DWORD;
          UsedSize      : DWORD;
          StringFormat  : DWORD;
          StringSize    : DWORD;
          StringOffset  : DWORD);
      2: (StringData    : array[0..1024] of Char);
  end;



  EWaveTapiException = class(Exception)
  private
    FErrorCode : Integer;
  public
    constructor Create(const EC : Integer; PassThru : Boolean);
    constructor CreateUnknown(const Msg : String; Dummy : Byte);
    class function MapCodeToStringID(const Code : Integer) : Word;
    property ErrorCode : Integer read FErrorCode write FErrorCode;
  end;

  TLineWavePlayer=class
  private
    LineHandle         : HLINE;            {Handle of the opened line device}
    CallHandle         : HCALL;            {Handle of the current call}

    FWaveState      : TWaveState;         {Current wave device state}
    FInterruptWave  : Boolean;
    FWaveFileName   : TFileName;          {Wave file name}
    FUseSoundCard   : Boolean;            {Play the sound through the sound card}
    FHandle         : HWnd;               {Window handle for hidden window}
    MmioOutHandle   : Integer;          {File handle for recording}
    WaveOutHandle   : HWaveOut;         {Handle of the wave out device}
    WaveOutHeader   : PWaveHdr;         {Wave header for playing}
    SamplesPerSecond   : Integer;          {Samples per sec for recording}
    BitsPerSample      : Byte;             {Bits per sample for recording}
    BytesToPlay        : LongInt;          {# of bytes in the wave file}
    TotalBytesToPlay   : Longint;
    BytesPlayed        : LongInt;          {# of bytes already played}
    BytesInBuffer      : LongInt;          {# of bytes in current buffer}
    WaveOutBuffers     : array of Pointer;          {Buffer for wave playing  }
    WaveOutBufferSizes : array of Integer;
    ActiveWaveOutBuffer: Byte;             {The active wave out buffer}
    VS                 : TVarString;       {Used to return Cid}
    TapiDevOpened      : Boolean;
    FDropTimer         : TTimer;
    procedure DropTimerEvent(Sender:TObject);
    
  public
    constructor Create(ALine:HLine; ACall:HCall; ADropDelay:Integer);
    destructor  Destroy; override;
    procedure PlayWaveFile(FileNames : TStringList);
    procedure StopWaveFile;
    function  GetWaveDeviceId(const Play : Boolean) : DWORD;
    procedure CheckWaveException(ErrorCode : Integer; Mode : Integer);
    procedure FreeWaveOutBuffer;
    procedure LoadWaveOutBuffer(Buf:Integer);
    procedure PlayWaveOutBuffer;
    procedure WndProc(var Message : TMessage);
   end;

implementation

  constructor TLineWavePlayer.Create(ALine:HLine; ACall:HCall; ADropDelay:Integer);
  begin
    inherited Create;
    {Create the TAPI name string list}

    {Private inits}
    LineHandle      := ALine;
    CallHandle      := ACall;

    {Property inits}
    FWaveState       := wsIdle;
    FInterruptWave   := True;
    FWaveState       := wsIdle;
    FUseSoundCard    := False;
    SamplesPerSecond := 8000;
    BitsPerSample    := 16;

    FHandle := AllocateHWnd(WndProc);

    FDropTimer:=TTimer.Create(nil);
    FDropTimer.Interval:=ADropDelay;
    FDropTimer.Enabled:=False;
    FDropTimer.OnTimer:=DropTimerEvent;

  end;

destructor TLineWavePlayer.Destroy;
begin
  StopWaveFile;

  FDropTimer.Free;
end;

procedure TLineWavePlayer.PlayWaveFile(FileNames : TStringList);
    { Play a wave file through the TAPI device or through the sound card. }
  var
    MmCkInfoParent   : TMMCkInfo;
    MmCkInfoSubchunk : TMMCkInfo;
    FormatSize       : DWORD;
    WaveFormat       : PWaveFormatEx;
    Res              : LongInt;
    WaveOutDevCaps   : TWaveOutCaps;
    DeviceId         : DWORD;
    Temp             : TPathCharArray;
    Flags            : LongInt;
    I:Integer;
  begin
   
    { If a wave file is playing then stop it. }
    if FWaveState = wsPlaying then
      if FInterruptWave then begin
        StopWaveFile;
        while (WaveOutHandle <> 0) do
          Application.ProcessMessages;
      end
      else
        Exit;

      if (WaveOutHeader <> nil) then
        FreeWaveOutBuffer;
    SetLength(WaveOutBuffers,FileNames.Count);
    SetLength(WaveOutBufferSizes,FileNames.Count);
    TotalBytesToPlay:=0;
    BytesPlayed := 0;
    for I:=0 to FileNames.Count-1 do begin
      FWaveFileName := FileNames[I];
      { Check for the existence of the wave file first. }
      if (not FileExists(FWaveFileName)) then
        raise EWaveTapiException.Create(ecFileNotFound, True);

      if FUseSoundCard then
        DeviceId := WAVE_MAPPER
      else
        DeviceId := GetWaveDeviceId(True);

      { Open the wave file }
      MmioOutHandle := mmioOpen(StrPCopy(Temp, FWaveFileName),
        nil, MMIO_READ or MMIO_ALLOCBUF);

      { Look for the 'WAVE' chunk to be sure it's a .WAV file.}
      MmCkInfoParent.fccType := mmioStringToFOURCC('WAVE', 0);

      Res := MmioDescend(MmioOutHandle,
        @MmCkInfoParent, nil, MMIO_FINDRIFF);
      CheckWaveException(Res, MMioError);

      { Locate the format chunk. }
      MmCkInfoSubchunk.ckid := mmioStringToFOURCC('fmt ', 0);

      Res := mmioDescend(MmioOutHandle, @MmCkinfoSubchunk, @MmCkinfoParent, MMIO_FINDCHUNK);
      CheckWaveException(Res, MMioError);

      { Get the size of the format chunk and allocate some memory for it. }
      FormatSize := MmCkinfoSubchunk.cksize;
      GetMem(WaveFormat, FormatSize);

      { Read the format chunk. }
      Res := mmioRead(MmioOutHandle, PChar(WaveFormat), FormatSize);
      if Res = -1 then
         raise EWaveTapiException.Create(ecTapiWaveReadError, True);

      { Make sure the TAPI wave out device supports the   }
      { wave file format. The WAVE_FORMAT_QUERY flag will }
      { query the device without actually opening it.     }
      waveOutGetDevCaps(deviceId,
        @WaveOutDevCaps, SizeOf(WaveOutDevCaps));
      Flags := WAVE_FORMAT_QUERY;
      if not FUseSoundCard then
       Flags := Flags or WAVE_MAPPED;
      Res := waveOutOpen(@WaveOutHandle,
        DeviceId, WaveFormat, 0, 0, Flags);
      CheckWaveException(Res, WaveOutError);

      { Find the data subchunk. }
      mmioAscend(MmioOutHandle, @MmCkinfoSubchunk, 0);
      MmCkinfoSubchunk.ckid := mmioStringToFOURCC('data', 0);
      Res := mmioDescend(MmioOutHandle, @MmCkinfoSubchunk, @MmCkinfoParent, MMIO_FINDCHUNK);
      CheckWaveException(Res, MMioError);

      { Get the size of the data. }
      BytesToPlay := MmCkinfoSubchunk.cksize;
      WaveOutBufferSizes[I] := BytesToPlay;
      TotalBytesToPlay:=TotalBytesToPlay+BytesToPlay;

      if not TapiDevOpened then begin
        { Open the TAPI wave out device. }
        Flags := CALLBACK_WINDOW;
        if not FUseSoundCard then
          Flags := Flags or WAVE_MAPPED;
        Res := waveOutOpen(@WaveOutHandle, Integer(DeviceId),
          WaveFormat, MakeLong(FHandle, 0), DWORD(Self), Flags);
        if Res=0 then
          TapiDevOpened:=True
        else begin
           if (Res = MMSYSERR_NOTENABLED) then begin
             FreeMem(WaveFormat, SizeOf(FormatSize));
             WaveOutHandle := 0;
             Exit;
           end
           else
             CheckWaveException(Res, WaveOutError);
        end;
      end;
      { Free the memory allocated for the format header. }
      FreeMem(WaveFormat, SizeOf(FormatSize));

      { Set up WaveOutHeader record. }
      GetMem(WaveOutHeader, SizeOf(TWaveHdr));
      WaveOutHeader^.dwFlags        := 0;
      WaveOutHeader^.dwLoops        := 0;
      WaveOutHeader^.dwUser         := 0;

      { Allocate memory for the data. This memory will be }
      { freed when the wave file finishes playing. }
      GetMem(WaveOutBuffers[I], WaveOutBufferSizes[I]);
      LoadWaveOutBuffer(I);
      mmioClose(mmioOutHandle, 0);
    end;

    ActiveWaveOutBuffer := 0;
    { Start playing. }
    PlayWaveOutBuffer;
    FWaveState := wsPlaying;
end;

  procedure TLineWavePlayer.StopWaveFile;
    { Stop the wave file from playing. }
  begin
    {if (FWaveState <> wsPlaying) then Exit;}
    if WaveOutHandle = 0 then exit;
    BytesPlayed := -1;
    waveOutReset(WaveOutHandle);
  end;

  function TLineWavePlayer.GetWaveDeviceId(const Play : Boolean) : DWORD;
    { Gets the device ID for the TAPI wave device. }
  var
    Res              : DWORD;
  begin
    Result := 0;
    FillChar(VS, SizeOf(TVarString), 0);
    VS.TotalSize := SizeOf(TVarString);
    if Play then
      // TAPI!!!
      Res := lineGetID(LineHandle, 0, CallHandle,
                   LINECALLSELECT_CALL,
                   @VS, 'wave/out')
    else
      Res := lineGetID(LineHandle, 0, CallHandle,
                   LINECALLSELECT_CALL,
                   @VS, 'wave/in');
    if Res <> 0 then
      raise EWaveTapiException.Create(ecTapiWaveFail, True)
    else with VS do
      Move(StringData[StringOffset], Result, SizeOf(DWORD));
  end;

  procedure TLineWavePlayer.CheckWaveException(ErrorCode : Integer;
                                                    Mode : Integer);
    { Checks to see if a wave or mmio exception was raised. }
  var
    ErrorText : array [0..MAXERRORLENGTH] of Char;
    ErrorString : string;
  begin
    if (ErrorCode = 0) then Exit;
    case Mode of
      WaveInError  :
        begin
          waveInGetErrorText(ErrorCode, ErrorText, SizeOf(ErrorText));
          ErrorString := StrPas(ErrorText);
        end;
      WaveOutError :
        begin
          waveOutGetErrorText(ErrorCode, ErrorText, SizeOf(ErrorText));
          ErrorString := StrPas(ErrorText);
        end;
      MMioError    :
        ErrorString := 'Error'; // My correction
    end;
    raise  EWaveTapiException.CreateUnknown(ErrorString, 0);
  end;

  procedure TLineWavePlayer.FreeWaveOutBuffer;
    { Free the memory for the wave out buffer and WaveOutHeader. }
  var I:Integer;
  begin
    WaveOutHandle := 0;
    if (WaveOutHeader <> nil) then begin
      { Free the memory for the wave out buffers. }
      WaveOutHeader^.lpData := nil;
      for I:=0 to Length(WaveOutBuffers)-1 do
       begin
        FreeMem(WaveOutBuffers[I], WaveOutBufferSizes[I]);
       end;
      { Free the memory for the wave header. }
      FreeMem(WaveOutHeader, SizeOf(TWaveHdr));
      WaveOutHeader := nil;
    end;
  end;

  procedure TLineWavePlayer.LoadWaveOutBuffer(Buf:Integer);
  var
    Res   : LongInt;
  begin
      { Read the waveform data into the idle buffer. }
        Res := mmioRead(MmioOutHandle,
          PChar(WaveOutBuffers[Buf]), WaveOutBufferSizes[Buf]);
      if Res = -1 then
         raise EWaveTapiException.Create(ecTapiWaveReadError, True);
  end;

  procedure TLineWavePlayer.PlayWaveOutBuffer;
  var
    Res   : LongInt;
  begin
    BytesInBuffer:=WaveOutBufferSizes[ActiveWaveOutBuffer];
    WaveOutHeader^.lpData := PChar(WaveOutBuffers[ActiveWaveOutBuffer]);
    WaveOutHeader^.dwBufferLength := BytesInBuffer;
    waveOutPrepareHeader(
      WaveOutHandle, WaveOutHeader, SizeOf(TWaveHdr));
    { Write the data to the wave out device. }
    Res := waveOutWrite(
      WaveOutHandle, WaveOutHeader, SizeOf(TWaveHdr));
    if (Res <> 0) then begin
      waveOutUnprepareHeader(
        WaveOutHandle, WaveOutHeader, SizeOf(TWaveHdr));
      FreeWaveOutBuffer;
      Exit;
    end;

    BytesPlayed := BytesPlayed + WaveOutBufferSizes[ActiveWaveOutBuffer];

    Inc(ActiveWaveOutBuffer);
    { If the entire file has been loaded then set BytesPlayed}
    { to -1 so we know we are on the last buffer.}
    if (BytesPlayed >= TotalBytesToPlay)or(ActiveWaveOutBuffer>Length(WaveOutBuffers)) then
      BytesPlayed := -1;
  end;

  procedure TLineWavePlayer.WndProc(var Message: TMessage);
    { WndProc to handle wave messages. }
  var
    header:PWaveHdr;
  begin
    case Message.Msg of
      MM_WOM_CLOSE :
        { The wave output device was closed. }
        begin
          FWaveState := wsIdle;
        end;
      MM_WOM_DONE :
        { Done playing a wave buffer. }
        begin
          with Message do begin
            header:=PWaveHdr(Message.LParam);
           // form1.Memo1.Lines.add(IntToStr(header^.dwBufferLength));
            //VizualizeBuffer(header^.lpData, header^.dwBufferLength, Form1.PaintBox1);
            { Unprepare the header. }
            waveOutUnprepareHeader(
              hWaveOut(wParam), WaveOutHeader, SizeOf(TWaveHdr));
            { All done? }
            if BytesPlayed = -1 then begin
              if WaveOutHandle <> 0 then begin
                waveOutClose(WaveOutHandle);
                TapiDevOpened:=False;
                FWaveState := wsIdle;
                FreeWaveOutBuffer;
                FDropTimer.Enabled:=True;
              end;
            { Not done, play another buffer. }
            end else
              begin
                PlayWaveOutBuffer;
              end;
          end;
        end;
    end;

  end;

  procedure TLineWavePlayer.DropTimerEvent(Sender:TObject);
  begin
    FDropTimer.Enabled:=False;
    lineDrop(CallHandle,nil,0);
  end;



  constructor EWaveTapiException.Create(const EC : Integer; PassThru : Boolean);
  begin
    FErrorCode := EC;
    inherited Create('ERROR!!!'); // MyCorrection
  end;

  constructor EWaveTapiException.CreateUnknown(const Msg : String; Dummy : Byte);
  begin
    ErrorCode := 0;

    inherited Create(Msg);
  end;

  class function EWaveTapiException.MapCodeToStringID(const Code : Integer) : Word;
  begin
    Result := Abs(Code);
  end;