mmdscapt.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/mmtools.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: 11.08.98 - 16:02:05 $                                        =}
{========================================================================}
unit MMDsCapt;

{$C FIXED PRELOAD PERMANENT}

{$I COMPILER.INC}

{.$DEFINE _MMDEBUG}

interface

uses
  Windows,
  Classes,
  SysUtils,
  MMObj,
  MMSystem,
  MMOLE2,
  MMUtils,
  MMRegs,
  MMWaveIO,
  MMPCMSup,
{$IFDEF _MMDEBUG}
  MMDebug,
{$ENDIF}
  MMDSound;

type
  EDSWaveIn = class(Exception)
  protected
    FCode: MMRESULT;
  public
    constructor Create(Code: MMRESULT);
  end;

function DSWaveInGetNumDevs: UINT; stdcall;
function DSWaveInGetDevCaps(HIn: HWaveIn; lpCaps: PWaveInCaps; uSize: UINT): MMRESULT; stdcall;
function DSWaveInGetErrorText(mmrError: MMRESULT; lpText: PChar; uSize: UINT): MMRESULT; stdcall;
function DSWaveInOpen(lpHWaveIn: PHWaveIn; uDeviceID: UINT; lpFormatEx: PWaveFormatEx; dwCallback, dwInstance, dwFlags: DWORD): MMRESULT; stdcall;
function DSWaveInClose(HIn: HWaveIn): MMRESULT; stdcall;
function DSWaveInPrepareHeader(HIn: HWaveIn; lpWaveInHdr: PWaveHdr; uSize: UINT): MMRESULT; stdcall;
function DSWaveInUnprepareHeader(HIn: HWaveIn; lpWaveInHdr: PWaveHdr; uSize: UINT): MMRESULT; stdcall;
function DSWaveInAddBuffer(HIn: HWaveIn; lpWaveInHdr: PWaveHdr; uSize: UINT): MMRESULT; stdcall;
function DSWaveInStart(HIn: HWaveIn): MMRESULT; stdcall;
function DSWaveInStop(HIn: HWaveIn): MMRESULT; stdcall;
function DSWaveInReset(HIn: HWaveIn): MMRESULT; stdcall;
function DSWaveInGetPosition(HIn: HWaveIn; lpInfo: PMMTime; uSize: UINT): MMRESULT; stdcall;
function DSWaveInGetID(HIn: HWaveIn; lpuDeviceID: PUINT): MMRESULT; stdcall;
function DSWaveInMessage(HIn: HWaveIn; uMessage: UINT; dw1, dw2: DWORD): MMRESULT; stdcall;
function DSWaveInGetIDirectSoundCapture(HIn: HWaveIn): IDirectSoundCapture;

implementation

const
  DEFAULT_BUFFERSIZE    = 2048 + 1024;
  DEFAULT_BUFFERCOUNT   = 4;

  NOTIFICATIONTHREAD_TIMEOUT = INFINITE;

type
  TDsNotificationThread = class(TMMThreadEx)
  protected
    FSystemEvent: THandle;
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy; override;
  end;

  TDsWaveInDevice = class;

  TDsWaveBuffer = class(TMMObject)
  private
    FData: PWaveHdr;
  protected
    function CanAccept: Integer;
    function Accept(WaveData: Pointer; var Length: Integer): Boolean;
  public
    constructor Create(lpWaveHdr: PWaveHdr);
    property Data: PWaveHdr read FData;
  end;

  TWaveDeviceState = (wdsInactive, wdsIdle, wdsStarted, wdsPaused);

  PNotifyPointArray = ^TNotifyPointArray;
  TNotifyPointArray = array[0..15] of TDSBPOSITIONNOTIFY;

  TDsWaveInDevice = class(TMMObject)
  private
    FCapture: IDirectSoundCapture;
    FGuid: PGUID;
    FWaveMapped: Boolean;
    FBuffer: IDirectSoundCaptureBuffer;
    FNotifications: IDirectSoundNotify;
    FNotifyPts: PNotifyPointArray;
    FState: TWaveDeviceState;
    FWaveBuffers,
    FQueue: TList;

    FBufferCount,                 // Count of buffer divisions
    FBufferPartSize,              // Each division size
    FBufferSize,                  // Multiplication of the previous two
    FBufferOrigin,                // Global origin of DX buffer
    FWritePosition: Integer;     // Global processed data position

    FCallBackMode,
    FCallBack,
    FCBInstance: Integer;

    function GetFormat: PWaveFormatEx;
    procedure SetFormat(Value: PWaveFormatEx);
    procedure ReturnBuffer;
    function CaptureActive: Boolean;
  protected
    procedure NotifyMessage(Msg: UINT; wParam: WPARAM; lParam: LPARAM); stdcall;
    procedure ProcessData(PointNumber: Integer);
    procedure Reconfigure(lpFormat: PWaveFormatEx; ABufCount, ABufSize: Integer);
  public
    constructor Create(DeviceGuid: PGUID; lpFormat: PWaveFormatEx);
    destructor Destroy; override;
    class procedure EnterCritical;
    class procedure LeaveCritical;

    procedure AddBuffer(Header: PWaveHdr);
    procedure PrepareBuffer(Header: PWaveHdr);
    procedure UnprepareBuffer(Header: PWaveHdr);
    function  FindBuffer(Header: PWaveHdr): TDsWaveBuffer;
    procedure Start;
    procedure Stop;
    procedure Reset;
    procedure GetPosition(lpInfo: PMMTime);
    procedure GetCaps(var Caps: TWaveInCaps);

    property Format: PWaveFormatEx read GetFormat write SetFormat;
  end;

var
  CaptureDeviceList: TList;
  OpenDevices: TList;

  DsNotificationThread: TDsNotificationThread;
  DsNotificationThread_RefCount: Integer = 0;

 // EDSWaveIn

constructor EDSWaveIn.Create(Code: MMRESULT);
var
  S: String;
begin
  SetLength(S, 250);
  DSWaveInGetErrorText(Code, PChar(S), Length(S));
  SetLength(S, StrLen(PChar(S)));
  inherited Create(S);
  FCode := Code;
end;

procedure MMCheck(Code: MMRESULT);
begin
  if Code <> MMSYSERR_NOERROR then
    raise EDSWaveIn.Create(Code);
end;

procedure MMAssert(Condition: Boolean; Code: MMRESULT);
begin
  if not Condition then
    raise EDSWaveIn.Create(Code);
end;

function HandleException: MMRESULT;
begin
  if ExceptObject is EDSWaveIn then
    Result := EDSWaveIn(ExceptObject).FCode
  else
    Result := MMSYSERR_ERROR;
end;

procedure CheckHandle(HIn: HWaveIn);
begin
  MMAssert((OpenDevices <> nil) and (OpenDevices.IndexOf(Pointer(HIn)) <> -1),
    MMSYSERR_INVALHANDLE);
end;

procedure DsNotificationThread_Addref;
begin
  if DsNotificationThread_RefCount = 0 then
    DsNotificationThread := TDsNotificationThread.Create;
  Inc(DsNotificationThread_RefCount);
end;

procedure DsNotificationThread_Release;
begin
  if DSNotificationThread_RefCount > 0 then
  begin
    Dec(DsNotificationThread_RefCount);
    if DsNotificationThread_RefCount = 0 then
    begin
      DsNotificationThread.Terminate;
      SetEvent(DsNotificationThread.FSystemEvent);
      DsNotificationThread.Free;
      DsNotificationThread := nil;
    end;
  end;
end;

function DeviceIdToGuid(DeviceID: Integer): PGUID;
begin
  if (DeviceID >= 0) and (DeviceID < DSWaveInGetNumDevs)
    then Result := PDSDRIVERDESC(CaptureDeviceList[DeviceID]).lpGuid
    else Result := nil;
end;

function IsEqualGuidEx(const p1, p2: TGUID): Boolean;
begin
  if Assigned(@p1) and Assigned(@p2) then
    Result := IsEqualGUID(p1, p2)
  else
    Result := (not Assigned(@p1) or IsEqualGUID(p1, GUID_NULL)) and
              (not Assigned(@p2) or IsEqualGUID(p2, GUID_NULL));
end;

procedure CaptureCapsToWaveInCaps(Capture: IDirectSoundCapture;
  Guid: PGUID; var Caps: TWaveInCaps);
var
  CCaps: TDSCCAPS;
  Index: Integer;
begin
  ZeroMemory(@CCaps, SizeOf(CCaps));
  CCaps.dwSize := SizeOf(CCaps);
  MMAssert(Capture.GetCaps(CCaps) = DS_OK, MMSYSERR_ERROR);
  Caps.dwFormats := CCaps.dwFormats;
  Caps.wChannels := CCaps.dwChannels;
  for Index := CaptureDeviceList.Count-1 downto 0 do
    with PDSDRIVERDESC(CaptureDeviceList[Index])^ do
      if IsEqualGuidEx(lpGUID^, Guid^) then
      begin
        StrLCopy(Caps.szPname, PChar(Description), SizeOf(Caps.szPname));
        break;
      end;
end;

 // WaveIn -> DirectCapture API

function DSWaveInGetNumDevs: UINT;
begin
  if not Assigned(CaptureDeviceList) then
  begin
    CaptureDeviceList := TList.Create;
    if LoadDSoundDLL and Assigned(DirectSoundCaptureEnumerate) then
      DirectSoundCaptureEnumerate(DriverEnumerate, CaptureDeviceList);
  end;
  Result := CaptureDeviceList.Count;
end;

function DSWaveInGetDevCaps(HIn: HWaveIn; lpCaps: PWaveInCaps; uSize: UINT): MMRESULT;
var
  Index: Integer;
  AlreadyOpened: Boolean;
  lpGuid: PGUID;
  Capture: IDirectSoundCapture;
begin
  try
     // HIn can be eather an opened device handle ...
    if Assigned(OpenDevices) and (OpenDevices.IndexOf(Pointer(HIn)) <> -1) then
    begin
      TDsWaveInDevice(HIn).GetCaps(lpCaps^)
    end else
     // ... or DeviceID ...
    if (HIn = integer(WAVE_MAPPER)) or ((HIn >= 0) and (HIn < CaptureDeviceList.Count)) then
    begin
      AlreadyOpened := False;
      lpGuid := DeviceIdToGuid(HIn);
       // Maybe it is already opened ?
      if Assigned(OpenDevices) then
        for Index := OpenDevices.Count-1 downto 0 do
          if IsEqualGuidEx(TDsWaveInDevice(OpenDevices[Index]).FGuid^,
               lpGuid^) then
          begin
            TDsWaveInDevice(OpenDevices[Index]).GetCaps(lpCaps^);
            AlreadyOpened := True;
            break;
          end;
      if not AlreadyOpened then
      begin
        MMAssert(Assigned(DirectSoundCaptureCreate), MMSYSERR_NODRIVER);
        MMAssert(DirectSoundCaptureCreate(lpGuid, Capture, nil) = DS_OK,
          MMSYSERR_NODRIVER);
        try
          CaptureCapsToWaveInCaps(Capture, lpGuid, lpCaps^);
        finally
          Capture.Release
        end;
      end;
    end else
     // ... otherwise this is an error
      CheckHandle(HIn);
    Result := MMSYSERR_NOERROR;
  except
    Result := HandleException;
  end;
end;

function DSWaveInGetErrorText(mmrError: MMRESULT; lpText: PChar; uSize: UINT): MMRESULT;
begin
  Result := waveInGetErrorText(mmrError, lpText, uSize)
end;

function DSWaveInOpen(lpHWaveIn: PHWaveIn; uDeviceID: UINT; lpFormatEx: PWaveFormatEx; dwCallback, dwInstance, dwFlags: DWORD): MMRESULT;
var
  Capture: TDsWaveInDevice;
  CallbackType: Integer;
begin
  try
     // TODO: uDeviceID cab be a handle of an open device ???

    MMAssert(LoadDSoundDLL and Assigned(DirectSoundCaptureCreate) and
      (uDeviceID < DSWaveInGetNumDevs), MMSYSERR_NODRIVER);
    MMAssert(lpFormatEx <> nil, MMSYSERR_INVALPARAM);
    MMAssert(dwFlags and WAVE_ALLOWSYNC = 0, MMSYSERR_NOTSUPPORTED);

    Capture := TDsWaveInDevice.Create(DeviceIdToGuid(uDeviceID), lpFormatEx);
    if dwFlags and WAVE_FORMAT_QUERY = 0 then
    begin
      CallbackType := CALLBACK_NULL;
      if dwFlags and CALLBACK_FUNCTION <> 0 then CallbackType := CALLBACK_FUNCTION else
      if dwFlags and CALLBACK_WINDOW   <> 0 then CallbackType := CALLBACK_WINDOW   else
      if dwFlags and CALLBACK_THREAD   <> 0 then CallbackType := CALLBACK_THREAD   else
        MMCheck(MMSYSERR_INVALPARAM);
      MMAssert(dwCallBack <> 0, MMSYSERR_INVALPARAM);

      Capture.FCallBackMode := CallbackType;
      Capture.FCallBack := dwCallback;
      Capture.FCBInstance := dwInstance;

      MMAssert(Assigned(lpHWaveIn), MMSYSERR_INVALPARAM);
      lpHWaveIn^ := HWaveIn(Capture);
      Capture.NotifyMessage(MM_WIM_OPEN, lphWaveIn^, 0);
    end else
      Capture.Free;
    Result := MMSYSERR_NOERROR;
  except
    Result := HandleException;
  end;
end;

function DSWaveInClose(HIn: HWaveIn): MMRESULT;
begin
  try
    CheckHandle(HIn);
    with TDsWaveInDevice(HIn) do
    begin
      NotifyMessage(MM_WIM_CLOSE, HIn, 0);
      Free;
    end;
    Result := MMSYSERR_NOERROR;
  except
    Result := HandleException;
  end;
end;

function DSWaveInPrepareHeader(HIn: HWaveIn; lpWaveInHdr: PWaveHdr; uSize: UINT): MMRESULT;
begin
  try
    CheckHandle(HIn);
    TDsWaveInDevice(HIn).PrepareBuffer(lpWaveInHdr);
    Result := MMSYSERR_NOERROR;
  except
    Result := HandleException;
  end;
end;

function DSWaveInUnprepareHeader(HIn: HWaveIn; lpWaveInHdr: PWaveHdr; uSize: UINT): MMRESULT;
begin
  try
    CheckHandle(HIn);
    TDsWaveInDevice(HIn).UnprepareBuffer(lpWaveInHdr);
    Result := MMSYSERR_NOERROR;
  except
    Result := HandleException;
  end;
end;

function DSWaveInAddBuffer(HIn: HWaveIn; lpWaveInHdr: PWaveHdr; uSize: UINT): MMRESULT;
begin
  try
    CheckHandle(HIn);
    TDsWaveInDevice(HIn).AddBuffer(lpWaveInHdr);
    Result := MMSYSERR_NOERROR;
  except
    Result := HandleException;
  end;
end;

function DSWaveInStart(HIn: HWaveIn): MMRESULT;
begin
  try
    CheckHandle(HIn);
    TDsWaveInDevice(HIn).Start;
    Result := MMSYSERR_NOERROR;
  except
    Result := HandleException;
  end;
end;

function DSWaveInStop(HIn: HWaveIn): MMRESULT;
begin
  try
    CheckHandle(HIn);
    TDsWaveInDevice(HIn).Stop;
    Result := MMSYSERR_NOERROR;
  except
    Result := HandleException;
  end;
end;

function DSWaveInReset(HIn: HWaveIn): MMRESULT;
begin
  try
    CheckHandle(HIn);
    TDsWaveInDevice(HIn).Reset;
    Result := MMSYSERR_NOERROR;
  except
    Result := HandleException;
  end;
end;

function DSWaveInGetPosition(HIn: HWaveIn; lpInfo: PMMTime; uSize: UINT): MMRESULT;
begin
  try
    CheckHandle(HIn);
    TDsWaveInDevice(HIn).GetPosition(lpInfo);
    Result := MMSYSERR_NOERROR;
  except
    Result := HandleException;
  end;
end;

function DSWaveInGetID(HIn: HWaveIn; lpuDeviceID: PUINT): MMRESULT;
begin
  try
    CheckHandle(HIn);
    lpuDeviceID^ := HIn;
    Result := MMSYSERR_NOERROR;
  except
    Result := HandleException;
  end;
end;

function DSWaveInMessage(HIn: HWaveIn; uMessage: UINT; dw1, dw2: DWORD): MMRESULT;
begin
  try
    CheckHandle(HIn);
     // ??? What are these messages
     // TDsWaveInDevice(HIn).NotifyMessage(uMessage, dw1, dw2);
    Result := MMSYSERR_NOERROR;
  except
    Result := HandleException;
  end;
end;

function DSWaveInGetIDirectSoundCapture(HIn: HWaveIn): IDirectSoundCapture;
begin
  Result := nil;
  try
    CheckHandle(HIn);
    Result := TDsWaveInDevice(HIn).FCapture;
  except
    ;
  end;
end;

 // TDsNotificationThread

constructor TDsNotificationThread.Create;
begin
   inherited Create(False);
   FSystemEvent := CreateEvent(nil, False, False, nil);
end;

destructor TDsNotificationThread.Destroy;
begin
   CloseHandle(FSystemEvent);
   inherited;
end;

procedure TDsNotificationThread.Execute;
type
  TDeviceArray = array[0..0] of TDsWaveInDevice;
  PDeviceArray = ^TDeviceArray;
var
  HandleCount: Integer;
  Handles: PWOHandleArray;
  Devices: PDeviceArray;

  procedure CollectHandles;
  var
    Index, HandleIndex, i,
    DeviceCount: Integer;
    Device: TDsWaveInDevice;
  begin
    TDsWaveInDevice.EnterCritical;
    try
      DeviceCount := OpenDevices.Count;
      HandleCount := 1;
      for Index := 0 to DeviceCount-1 do
      begin
        Device := OpenDevices[Index];
        Inc(HandleCount, Device.FBufferCount + 1);
      end;
      GetMem(Handles, HandleCount * SizeOf(THandle));
      GetMem(Devices, HandleCount * SizeOf(Devices^[0]));

      HandleIndex := 0;
      for Index := 0 to DeviceCount-1 do
      begin
        Device := OpenDevices[Index];
        for i := 0 to Device.FBufferCount do
        begin
          Handles^[HandleIndex] := Device.FNotifyPts[i].hEventNotify;
          Devices^[HandleIndex] := Device;
          Inc(HandleIndex);
        end;
      end;