mmdscptr.pas

一套及时通讯的原码

  begin
    DirectCapture.Release;
    DirectCapture := nil;
  end;
end;

{-- TMMDSCapture --------------------------------------------------------------}
procedure TMMDSCapture.SetCaps(Value: TMMDSCaptureCaps);
begin
end;

{-- TMMDSCapture --------------------------------------------------------------}
function TMMDSCapture.GetCaps: TMMDSCaptureCaps;
var
  Caps: TDSCCAPS;
begin
  ZeroMemory(@Caps, SizeOf(Caps));
  Caps.dwSize := SizeOf(Caps);

  if (DeviceID <> InvalidID) then
  begin
    if not Opened then
    begin
      Open;
      try
        DirectCapture.GetCaps(Caps);
      finally
        Close;
      end;
    end
    else
      DirectCapture.GetCaps(Caps);
  end;
  FCaps.SetCaps(Caps);
  Result := FCaps;
end;

{-- TMMDSCapture --------------------------------------------------------------}
function TMMDSCapture.GetBuffer(Index: integer): TMMDSCaptureBuffer;
begin
  Result := TMMDSCaptureBuffer(FBuffers[Index])
end;

{-- TMMDSCapture --------------------------------------------------------------}
function TMMDSCapture.GetBufferName(const Name: string): TMMDSCaptureBuffer;
var
  i: integer;
begin
  for i := 0 to FBuffers.Count-1 do
  begin
    Result := FBuffers[i];
    if Result.Name = Name then
      exit;
  end;
  Result := nil;
end;

{-- TMMDSCapture --------------------------------------------------------------}
function TMMDSCapture.FindFreeName(const Name: String): String;
var
  i: integer;
begin
  if (BufferByName[Name] <> nil) or (Name = '') then
  begin
    i := 0;
    repeat
      Inc(i);
      Result := Name + IntToStr(i);
    until BufferByName[Result] = nil;
  end else
    Result := Name;
end;

{-- TMMDSCapture --------------------------------------------------------------}
function TMMDSCapture.GetBufferCount: integer;
begin
  Result := FBuffers.Count;
end;

{-- TMMDSCapture --------------------------------------------------------------}
procedure TMMDSCapture.SetupBuffer(var Name: string; Buffer: TMMDSCaptureBuffer);
var
  BufferDesc: TDSCBUFFERDESC;
  BufferInterface: IDirectSoundCaptureBuffer;
begin
  if (Buffer = nil) or (Buffer.PWaveFormat = nil) then exit;

  Name := FindFreeName(Name);
  Buffer.FName := Name;

  ZeroMemory(@BufferDesc, SizeOf(BufferDesc));
  with BufferDesc do
  begin
    dwSize := SizeOf(BufferDesc);
    dwFlags := 0;
    dwBufferBytes := Buffer.BufferLength;
    lpwfxFormat := Buffer.PWaveFormat;
   end;

  Buffer.DirectSoundCaptureBuffer := nil;
  DSCheck(DirectCapture.CreateCaptureBuffer(BufferDesc,BufferInterface, nil));
  Buffer.DirectSoundCaptureBuffer := BufferInterface;

  Buffer.FCapture := Self;
  FBuffers.Add(Buffer);
end;

{-- TMMDSCapture --------------------------------------------------------------}
function TMMDSCapture.AddBuffer(var Name: string; BufferLength: Longint; Format: PWaveFormatEx): TMMDSCaptureBuffer;
begin
  Result := TMMDSCaptureBuffer.Create(BufferLength, Format);
  try
    SetupBuffer(Name, Result);
  except
    Result.Free;
    raise;
  end;
end;

{-- TMMDSCapture --------------------------------------------------------------}
procedure TMMDSCapture.FreeBuffers;
begin
  while BufferCount > 0 do RemoveBuffer(Buffer[0]);
end;

{-- TMMDSCapture --------------------------------------------------------------}
procedure TMMDSCapture.ClearBuffer(Buffer: TMMDSCaptureBuffer);
var
  i: integer;
begin
  i := FBuffers.IndexOf(Buffer);
  if i >= 0 then
  begin
    StopBuffer(Buffer);
    Buffer.ReleaseBuffer;
    FBuffers.Delete(i);
    FBuffers.Pack;
  end;
end;

{-- TMMDSCapture --------------------------------------------------------------}
procedure TMMDSCapture.RemoveBuffer(Buffer: TMMDSCaptureBuffer);
begin
  ClearBuffer(Buffer);
  Buffer.FreeBuffer;
end;

{-- TMMDSCapture --------------------------------------------------------------}
procedure TMMDSCapture.CaptureBuffer(Buffer: TMMDSCaptureBuffer);
begin
  if (Buffer <> nil) and (Buffer.DirectSoundCaptureBuffer <> nil) then
      Buffer.Capture;
end;

{-- TMMDSCapture --------------------------------------------------------------}
procedure TMMDSCapture.StopBuffer(Buffer: TMMDSCaptureBuffer);
begin
  if (Buffer <> nil) and (Buffer.DirectSoundCaptureBuffer <> nil) then
      Buffer.Stop;
end;

{-- TMMDSCapture --------------------------------------------------------------}
procedure TMMDSCapture.UpdateData(Buffer: TMMDSCaptureBuffer);
begin
   Buffer.CopyData
end;

{== TMMDSCaptureCaps ==========================================================}
procedure TMMDSCaptureCaps.SetIntDummy(Value: Integer);
begin
end;

{-- TMMDSCaptureCaps ----------------------------------------------------------}
function TMMDSCaptureCaps.GetHasFormat(Index: Integer): Boolean;
begin
  Result := FFormats and (1 shl Index) <> 0
end;

{-- TMMDSCaptureCaps ----------------------------------------------------------}
procedure TMMDSCaptureCaps.SetHasFormat(Index: Integer; Value: Boolean);
begin
end;

{-- TMMDSCaptureCaps ----------------------------------------------------------}
procedure TMMDSCaptureCaps.SetCaps(const Caps: TDSCCAPS);
begin
  FFormats := Caps.dwFormats;
  FChannels := Caps.dwChannels;
end;

const
  LoopFlags: array[Boolean] of Integer = (0, DSCBSTART_LOOPING);

{== TMMDSCaptureBuffer ========================================================}
constructor TMMDSCaptureBuffer.Create(Size: Longint; Format: PWaveFormatEx);
begin
   inherited Create;

   FMemory := TMemoryStream.Create;
   FBufferLength := Size;
   FFormat       := wioCopyWaveFormat(Format);
   FResetPosition:= True;
end;

{-- TMMDSCaptureBuffer --------------------------------------------------------}
destructor TMMDSCaptureBuffer.Destroy;
begin
  ReleaseBuffer;

  FMemory.Free;
  GlobalFreeMem(Pointer(FFormat));

  inherited Destroy;
end;

{-- TMMDSCaptureBuffer --------------------------------------------------------}
procedure TMMDSCaptureBuffer.SetFormat(Value: PWaveFormatEx);
begin
   GlobalFreeMem(Pointer(FFormat));
   FFormat := wioCopyWaveFormat(Value);
end;

{-- TMMDSCaptureBuffer --------------------------------------------------------}
function TMMDSCaptureBuffer.GetCaptureLength: Longint;
begin
   Result := FMemory.Size
end;

{-- TMMDSCaptureBuffer --------------------------------------------------------}
procedure TMMDSCaptureBuffer.SetCaptureBuffer(Value: IDirectSoundCaptureBuffer);
var
  Caps: TDSCBCAPS;
  Positions: array[0..2] of TDSBPOSITIONNOTIFY;

begin
  ReleaseBuffer;
  FCaptureBuffer := Value;
  if Value <> nil then
  begin
    if FCaptureBuffer.QueryInterface(IID_IDirectSoundNotify, FNotify) = S_OK then
    begin
      ZeroMemory(@Caps, SizeOf(Caps));
      Caps.dwSize := SizeOf(Caps);
      FCaptureBuffer.GetCaps(Caps);
      FCBSize := Caps.dwBufferBytes;

      FBufferStopEvent := CreateEvent(nil, False, False, nil);
      Positions[0].dwOffset := DSBPN_OFFSETSTOP;
      Positions[0].hEventNotify := FBufferStopEvent;
      FNotify.SetNotificationPositions(1, @Positions);

      FNotifyThread := TMMDSCaptureBufferNotifyThread.Create(Self);
    end;
  end;
end;

{-- TMMDSCaptureBuffer --------------------------------------------------------}
function TMMDSCaptureBuffer.GetPosition: Longint;
var
   aResult: DWORD;
begin
  if (FCaptureBuffer <> nil) then
  begin
    FCaptureBuffer.GetCurrentPosition(aResult, DWORD(nil^));
    Result := aResult;
  end
  else
    Result := 0;
end;

{-- TMMDSCaptureBuffer --------------------------------------------------------}
function TMMDSCaptureBuffer.GetReadPosition: Longint;
var
   aResult: DWORD;
begin
  if (FCaptureBuffer <> nil) then
  begin
     FCaptureBuffer.GetCurrentPosition(DWORD(nil^), aResult);
     Result := aResult;
  end
  else Result := 0;
end;

{-- TMMDSCaptureBuffer --------------------------------------------------------}
function TMMDSCaptureBuffer.GetCapturing: Boolean;
var
  Status: DWORD;
begin
  if FCaptureBuffer <> nil then
  begin
    FCaptureBuffer.GetStatus(Status);
    Result := Status and DSCBSTATUS_CAPTURING <> 0;
  end
  else
    Result := False;
end;

{-- TMMDSCaptureBuffer --------------------------------------------------------}
function TMMDSCaptureBuffer.GetCaps: TDSCBCAPS;
begin
  ZeroMemory(@Result, SizeOf(Result));
  Result.dwSize := SizeOf(Result);
  if FCaptureBuffer <> nil then
     FCaptureBuffer.GetCaps(Result);
end;

{-- TMMDSCaptureBuffer --------------------------------------------------------}
procedure TMMDSCaptureBuffer.Capture;
begin
  if FCaptureBuffer <> nil then
  begin
    if not Capturing then
    begin
      FCBOrigin := 0;
      FCBDataPosition := GetPosition;
      if FResetPosition then Memory.Clear;
    end;
    FCaptureBuffer.Start(LoopFlags[False]);
    FCapturing := True;
  end;
end;

{-- TMMDSCaptureBuffer --------------------------------------------------------}
procedure TMMDSCaptureBuffer.Stop;
begin
  if FCaptureBuffer <> nil then
  begin
    FCapturing := False;
    FCaptureBuffer.Stop;
  end;
end;

{-- TMMDSCaptureBuffer --------------------------------------------------------}
procedure TMMDSCaptureBuffer.ReleaseBuffer;
begin
  if FCaptureBuffer <> nil then
  begin
    FCaptureBuffer.Release;
    FCaptureBuffer := nil;
    if Assigned(FNotify) then
    begin
      with FNotifyThread do
      begin
        Terminate;
        SetEvent(FSystemEvent);
        if FSyncing then FreeOnTerminate := True else Free;
      end;
      FNotifyThread := nil;
      FNotify.Release;
      FNotify := nil;

      CloseHandle(FBufferStopEvent);
      FBufferStopEvent := 0;
    end;
    if Assigned(FOnRelease) then
       FOnRelease(Self);
  end;
end;

{-- TMMDSCaptureBuffer --------------------------------------------------------}
procedure TMMDSCaptureBuffer.FreeBuffer;
begin
  ReleaseBuffer;
  if not FOwned then Free;
end;

{-- TMMDSCaptureBuffer --------------------------------------------------------}
function TMMDSCaptureBuffer.IsThereNewData: Boolean;
begin
  Result := FCBOrigin + GetPosition > FCBDataPosition
end;

{$DEFINE ACCUMULATE}

{-- TMMDSCaptureBuffer --------------------------------------------------------}
procedure TMMDSCaptureBuffer.CopyData;
var
  p1, p2: Pointer;
  l1, l2: DWORD;
  CaptureCursor,
{$IFDEF ACCUMULATE}
  bl2,
{$ENDIF}
  bp1, bl1: DWORD;
begin
  if not IsThereNewData then
    exit;

  DSCheck(FCaptureBuffer.GetCurrentPosition(DWORD(nil^), CaptureCursor));

  if FCBDataPosition < FCBOrigin then
  begin
    bp1 := FCBDataPosition - (FCBOrigin - FCBSize);
    bl1 := FCBSize - bp1;
{$IFDEF ACCUMULATE}
    bl2 := CaptureCursor;
{$ENDIF}
  end else
  begin
    bp1 := FCBDataPosition - FCBOrigin;
    bl1 := CaptureCursor - bp1;
{$IFDEF ACCUMULATE}
    bl2 := 0;
{$ENDIF}
  end;

{$IFDEF _MMDEBUG}
    DB_FormatLn(0, 'Locking capture buffer from %d to %d and %d to %d',
      [bp1, bp1 + bl1, 0, {$IFDEF ACCUMULATE}bl2{$ELSE}0{$ENDIF}]);
{$ENDIF}