mmacmsup.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Fax.: [phone]               =}
{=  Loewenstr.7a                = [e-mail]                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/index.html               =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 27.01.99 - 02:33:52 $                                        =}
{========================================================================}
unit MMACMSup;

{$I COMPILER.INC}

interface

uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    SysUtils,
    Classes,
    Forms,
    MMSystem,
    MMUtils,
    MMRegs,
    MMPCMSup,
    MMACM
    {$IFDEF USEWAVEMPEG}
    ,L3DecDLL,
    L2DecDLL
    {$ENDIF}
    ;

type
   PACMStream  = ^TACMStream;
   TACMStream  = packed record
     lpSrcBuffer    : PChar;
     lpDstBuffer    : PChar;
     dwSrcBufferSize: Longint;
     dwDstBufferSize: Longint;
     dwRemaining    : Longint;
     acmStream      : THACMSTREAM;
     acmStreamHeader: TACMStreamHeader;
   end;

   PACMConvert = ^TACMConvert;
   TACMConvert = packed record
      lpSrcBuffer      : PChar;
      lpDstBuffer      : PChar;
      dwSrcBufferSize  : Longint;
      dwDstBufferSize  : Longint;
      dwBytesConverted : Longint;
      dwBytesRead      : Longint;
      bPending         : Boolean;
      bQueued          : Boolean;
      bFreeSrcBuffer   : Boolean;
      Streams          : TList;
      {$IFDEF USEWAVEMPEG}
      lpDecBuffer      : array[0..16384-1] of Byte;
      bUseL3Decoder    : Boolean;
      pL3DLL           : THandle;
      bUseL2Decoder    : Boolean;
      pL2DLL           : PL2DLL; 
      DataSection      : TRTLCriticalSection;
      {$ENDIF}
   end;

{ a set of low level conversion routines to convert Formats }
function  acmMustConvert(pwfxSrc,pwfxDst: PWaveFormatEx): Boolean;
function  acmQueryConvert(pwfxSrc,pwfxDst: PWaveFormatEx; RealTime: Boolean): Boolean;
function  acmSuggestPCMFormat(pwfxSrc: PWaveFormatEx): TWaveFormatEx;
function  acmSuggestPCMFormatEx(pwfxSrc: PWaveFormatEx; Bits,Channels,SampleRate: Longint): TWaveFormatEx;
function  acmSizeOutputData(pwfxSrc,pwfxDst: PWaveFormatEx; SrcBufSize: Longint): Longint;
function  acmBeginConvert(pwfxSrc,pwfxDst: PWaveFormatEx;
                          SrcBuffer: PChar; SrcBufSize: Longint; RealTime: Boolean): PACMConvert;
function  acmDoConvert(pConvert: PACMConvert; SrcBufSize: Longint): Longint;
function  acmFlushConvert(pConvert: PACMConvert): Boolean;
function  acmEndConvert(pConvert: PACMConvert; SrcBufSize: Longint): Longint;
procedure acmDoneConvert(var pConvert: PACMConvert);

implementation

{------------------------------------------------------------------------}
function acmMustConvert(pwfxSrc,pwfxDst: PWaveFormatEx): Boolean;
begin
   Result := ((pwfxSrc <> nil) and (pwfxDst <> nil)) and
              ((pwfxSrc^.wFormatTag <> pwfxDst^.wFormatTag) or
               (pwfxSrc^.wBitsPerSample <> pwfxDst^.wBitsPerSample) or
               (pwfxSrc^.nChannels <> pwfxDst^.nChannels) or
               (pwfxSrc^.nSamplesPerSec <> pwfxDst^.nSamplesPerSec));
end;

{------------------------------------------------------------------------}
function acmSuggestPCMFormat(pwfxSrc: PWaveFormatEx): TWaveFormatEx;
var
   Ready: Boolean;
   dwSuggest: Longint;
   wfx: TWaveFormatEx;

begin
   if (pwfxSrc^.wFormatTag <> WAVE_FORMAT_PCM) then
   begin
      Ready := False;

      try
         FillChar(Result,sizeOf(Result),0);
         FillChar(wfx, sizeOf(wfx),0);
         wfx.wFormatTag := WAVE_FORMAT_PCM;
         dwSuggest := ACM_FORMATSUGGESTF_WFORMATTAG;

         { 'suggest' a PCM format' }
         if acmFormatSuggest(0, pwfxSrc, @wfx, SizeOf(wfx), dwSuggest) <> 0 then
            exit;

         if acmStreamOpen(nil, 0, pwfxSrc, @wfx, nil, 0, 0, ACM_STREAMOPENF_QUERY) <> 0 then
            exit;

         Ready  := True;
         Result := wfx;

      finally
         {$IFDEF USEWAVEMPEG}
         if not Ready then
         begin
            if (pwfxSrc.wFormatTag = WAVE_FORMAT_MPEG) or
               (pwfxSrc.wFormatTag = WAVE_FORMAT_MPEG_LAYER3) then
            begin
               pcmBuildWaveHeader(@wfx,16,pwfxSrc.nChannels,pwfxSrc.nSamplesPerSec);
               Result := wfx;
            end;
         end;
         {$ENDIF}
      end;
   end
   else Result := pwfxSrc^;
end;

{------------------------------------------------------------------------}
function acmSuggestPCMFormatEx(pwfxSrc: PWaveFormatEx; Bits,Channels,SampleRate: Longint): TWaveFormatEx;
var
   Ready: Boolean;
   dwSuggest: Longint;
   wfx: TWaveFormatEx;

begin
   Result := pwfxSrc^;
   if (pwfxSrc^.wFormatTag <> WAVE_FORMAT_PCM) or
      ((Bits > 0) and (pwfxSrc^.wBitsPerSample <> Bits)) or
      ((Channels > 0) and (pwfxSrc^.nChannels <> Channels)) or
      ((SampleRate > 0) and (pwfxSrc^.nSamplesPerSec <> SampleRate)) then
   begin
      Ready := False;

      try
         wfx.wFormatTag := WAVE_FORMAT_PCM;
         dwSuggest := ACM_FORMATSUGGESTF_WFORMATTAG;

         if (Bits > 0) then
         begin
            wfx.wBitsPerSample := Bits;
            dwSuggest := ACM_FORMATSUGGESTF_WBITSPERSAMPLE;
         end;

         if (Channels > 0) then
         begin
            wfx.nChannels := Channels;
            dwSuggest := ACM_FORMATSUGGESTF_NCHANNELS;
         end;

         if (SampleRate > 0) then
         begin
            wfx.nSamplesPerSec := SampleRate;
            dwSuggest := ACM_FORMATSUGGESTF_NSAMPLESPERSEC;
         end;

         { 'suggest' a PCM format' }
         if acmFormatSuggest(0, pwfxSrc, @wfx, SizeOf(wfx), dwSuggest) <> 0 then
            exit;

         if acmStreamOpen(nil, 0, pwfxSrc, @wfx, nil, 0, 0, ACM_STREAMOPENF_QUERY) <> 0 then
            exit;

         Ready := True;
         Result := wfx;

      finally
         {$IFDEF USEWAVEMPEG}
         if not Ready then
         begin
            if (pwfxSrc.wFormatTag = WAVE_FORMAT_MPEG) or
               (pwfxSrc.wFormatTag = WAVE_FORMAT_MPEG_LAYER3) then
            begin
               pcmBuildWaveHeader(@wfx,Bits,Channels,SampleRate);
            end;
         end;
         {$ENDIF}
      end;
   end;
end;

{------------------------------------------------------------------------}
function acmQueryConvert(pwfxSrc,pwfxDst: PWaveFormatEx; RealTime: Boolean): Boolean;
Label Ready;
var
   Buf: array[0..1024] of Char;
   pwfx: PWaveFormatEx;
   dwSuggest,dwFlags: Longint;

begin
   Result := False;

   if acmDLLLoaded and (HiWord(acmGetVersion) >= $0200) and
      (pwfxSrc <> nil) and (pwfxSrc <> nil) then
   begin
      if acmMustConvert(pwfxSrc,pwfxDst) then
      begin
         dwFlags := ACM_STREAMOPENF_QUERY;
         if not RealTime then dwFlags := dwFlags or ACM_STREAMOPENF_NONREALTIME;

         if (acmStreamOpen(nil, 0, pwfxSrc, pwfxDst, nil, 0, 0, dwFlags) = 0) then
         begin
            Result := True;
            exit;
         end
         {$IFDEF USEWAVEMPEG}
         else if ((pwfxSrc.wFormatTag = WAVE_FORMAT_MPEG) or
                  (pwfxSrc.wFormatTag = WAVE_FORMAT_MPEG_LAYER3)) and
                  (pwfxDst.wFormatTag = WAVE_FORMAT_PCM) then
         begin
            if (pwfxSrc^.nSamplesPerSec = pwfxDst.nSamplesPerSec) and
               (pwfxSrc^.nChannels = pwfxDst.nChannels) then
            begin
               Result := True;
               exit;
            end;
         end
         {$ENDIF};

         pwfx := Pointer(@Buf);
         FillChar(pwfx^, sizeOf(pwfx^), 0);

         if (pwfxSrc^.wFormatTag <> WAVE_FORMAT_PCM) then
         begin
            pwfx^.wFormatTag     := WAVE_FORMAT_PCM;
            pwfx^.nChannels      := pwfxDst^.nChannels;
            pwfx^.nSamplesPerSec := pwfxDst^.nSamplesPerSec;
            dwSuggest            := ACM_FORMATSUGGESTF_WFORMATTAG or
                                    ACM_FORMATSUGGESTF_NCHANNELS or
                                    ACM_FORMATSUGGESTF_NSAMPLESPERSEC;

            { 'suggest' a format' }
            if acmFormatSuggest(0, pwfxSrc, pwfx, SizeOf(Buf), dwSuggest) = 0 then
               goto ready;

            dwSuggest           := ACM_FORMATSUGGESTF_WFORMATTAG;

            { 'suggest' a format' }
            if acmFormatSuggest(0, pwfxSrc, pwfx, SizeOf(Buf), dwSuggest) = 0 then
               goto ready;
         end
         else if (pwfxSrc^.nChannels <> pwfxDst^.nChannels) or
                 (pwfxSrc^.nSamplesPerSec <> pwfxDst^.nSamplesPerSec) then
         begin
            pwfx^.nChannels      := pwfxDst^.nChannels;
            pwfx^.nSamplesPerSec := pwfxDst^.nSamplesPerSec;
            dwSuggest            := ACM_FORMATSUGGESTF_NCHANNELS or
                                    ACM_FORMATSUGGESTF_NSAMPLESPERSEC;

            { 'suggest' a format' }
            if acmFormatSuggest(0, pwfxSrc, pwfx, SizeOf(Buf), dwSuggest) = 0 then
            begin
               if (acmStreamOpen(nil, 0, pwfx, pwfxDst, nil, 0, 0, dwFlags) = 0) then
                   goto ready;

               if (pwfx^.wBitsperSample = 16) then
                   pwfx^.wBitsPerSample := 8
               else
                   pwfx^.wBitsPerSample := 16;

               dwSuggest := dwSuggest or ACM_FORMATSUGGESTF_WBITSPERSAMPLE;
               if acmFormatSuggest(0, pwfxSrc, pwfx, SizeOf(Buf), dwSuggest) = 0 then
                  goto ready;
            end;
         end;

         exit;
Ready:
         if (acmStreamOpen(nil, 0, pwfxSrc, pwfx, nil, 0, 0, dwFlags) <> 0) then
             exit;

         if acmMustConvert(pwfx,pwfxDst) then
            Result := acmQueryConvert(pwfx,pwfxDst,RealTime)
         else
             Result := True;
      end
      else Result := True;
   end;
end;

{-------------------------------------------------------------------------}
function acmSizeOutputData(pwfxSrc,pwfxDst: PWaveFormatEx; SrcBufSize: Longint): Longint;
var
   Ready: Boolean;
   ACMStream: THACMSTREAM;

begin
   Result := -1;

   if (pwfxSrc <> nil) and (pwfxDst <> nil) then
   begin
      Ready := False;
      try
         if acmStreamOpen(@ACMStream, 0, pwfxSrc, pwfxDst, nil, 0, 0, 0) <> 0 then
            exit;

         try
            if acmStreamSize(ACMStream, SrcBufSize, Result, ACM_STREAMSIZEF_SOURCE) <> 0 then
               exit;
            Ready := True;
         finally
            acmStreamClose(ACMStream, 0);
         end;

      finally
         {$IFDEF USEWAVEMPEG}
         if not Ready and ((pwfxSrc.wFormatTag = WAVE_FORMAT_MPEG) or
                           (pwfxSrc.wFormatTag = WAVE_FORMAT_MPEG_LAYER3)) then
         begin
            Result := ((SrcBufSize*pwfxDst^.nAvgBytesPerSec) div pwfxSrc^.nAvgBytesPerSec)+4096;
         end;
         {$ENDIF}
      end;
   end;
end;