mmdscptr.pas

一套及时通讯的原码

  try
    with Memory do
{$IFDEF ACCUMULATE}
      Position := Size;
{$ELSE}
      if bp1 = 0 then Clear else Position := Size;
{$ENDIF}

    DSCheck(FCaptureBuffer.Lock(bp1, bl1, p1, l1, p2, l2, 0));
    Memory.Write(p1^, l1);
    if l2 > 0 then Memory.Write(p2^, l2);
    DSCheck(FCaptureBuffer.Unlock(p1, l1, p2, l2));
{$IFDEF ACCUMULATE}
    if bl2 > 0 then
    begin
       DSCheck(FCaptureBuffer.Lock(0, bl2, p1, l1, p2, l2, 0));
       Memory.Write(p1^, l1);
       if l2 > 0 then Memory.Write(p2^, l2);
       DSCheck(FCaptureBuffer.Unlock(p1, l1, p2, l2));
    end;
{$ENDIF}

{$IFDEF ACCUMULATE}
    Inc(FCBDataPosition, bl1 + bl2);
{$ELSE}
    Inc(FCBDataPosition, bl1);
{$ENDIF}
  except
    ReleaseBuffer;
    raise EMMDSCaptureError.Create(SLockFailed);
  end;
end;

{== TMMDSCaptureBufferNotifyThread ============================================}
constructor TMMDSCaptureBufferNotifyThread.Create(ABuffer: TMMDSCaptureBuffer);
begin
  inherited Create(False);

  FBuffer := ABuffer;
  FSystemEvent := CreateEvent(nil, False, False, nil);
end;

{-- TMMDSCaptureBufferNotifyThread --------------------------------------------}
destructor TMMDSCaptureBufferNotifyThread.Destroy;
begin
  CloseHandle(FSystemEvent);
  inherited;
end;

{-- TMMDSCaptureBufferNotifyThread --------------------------------------------}
procedure TMMDSCaptureBufferNotifyThread.Execute;
var
  HandleCount: Integer;
begin
  while not Terminated do
  begin
    if FBuffer.DirectSoundCaptureBuffer <> nil then
    begin
      FBufferStopEvent := FBuffer.FBufferStopEvent;
      HandleCount := 2;
    end
    else
      HandleCount := 1;

{$IFDEF _MMDEBUG}
    if HandleCount = 1
      then DB_FormatLn(0, 'Thread: Waiting for system event %d', [FSystemEvent])
      else DB_FormatLn(0, 'Thread: Waiting for system event %d and stop event %d', [FSystemEvent, FBufferStopEvent]);
{$ENDIF}
    case WaitForMultipleObjects(HandleCount, @FSystemEvent, False,
         NOTIFICATIONTHREAD_TIMEOUT) - WAIT_OBJECT_0 of
      0: {$IFDEF _MMDEBUG}
         DB_FormatLn(0, 'Thread: System event fired', [0])
         {$ENDIF}
         ;
      1: {$IFDEF _MMDEBUG}
         begin
           DB_FormatLn(0, 'Thread: Stop event, synchronizing...', [0]);
         {$ENDIF}
           Synchronize(DoBufferStop);
         {$IFDEF _MMDEBUG}
         end;
         {$ENDIF}
    end;
  end;
end;

{-- TMMDSCaptureBufferNotifyThread --------------------------------------------}
procedure TMMDSCaptureBufferNotifyThread.DoBufferStop;
begin
  FSyncing := True;
  try
     { detecting full loop by CursorPos }
    with FBuffer do
    if (GetPosition = 0) then Inc(FCBOrigin, FCBSize);

    if Assigned(FBuffer.FCapture) then
       FBuffer.FCapture.BufferStop(FBuffer);

  finally
    FSyncing := False;
  end;
end;

{== TMMDSCaptureChannel =======================================================}
constructor TMMDSCaptureChannel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  DSCheckAvailable;

  FCaptureBuffer := TMMDSCaptureBuffer.Create(100000,nil);
  FCaptureBuffer.FOnBufferStop := BufferStop;
  FCaptureBuffer.FOwned := True;

  SetPCMFormat(mMono, b8Bit, 11025);

   ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
   if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
destructor TMMDSCaptureChannel.Destroy;
begin
  if FCapture <> nil then FCapture.Close;

  FCaptureBuffer.Free;

  inherited Destroy;
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
procedure TMMDSCaptureChannel.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FCapture) then
    FCapture := Nil;
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
procedure TMMDSCaptureChannel.BufferStop(Sender: TObject);
begin
  if Assigned(FOnCaptureStop) then FOnCaptureStop(Self);

  if FCaptureBuffer.GetPosition = 0 then
     FCapture.RemoveBuffer(FCaptureBuffer);
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
procedure TMMDSCaptureChannel.Init;
var
  AName: string;
begin
  if (FCapture <> nil) and (BufferLength > 0) then
  with FCapture do
  begin
     if (FCaptureBuffer.DirectSoundCaptureBuffer = nil) then
     begin
        FCapture.Open;
        SetupBuffer(AName, FCaptureBuffer);
     end;
  end;
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
procedure TMMDSCaptureChannel.Reset;
begin
  if Assigned(FCaptureBuffer) then
     FCapture.RemoveBuffer(FCaptureBuffer);
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
procedure TMMDSCaptureChannel.Capture;
begin
  Init;
  if FCapture <> nil then
     FCapture.CaptureBuffer(FCaptureBuffer);
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
procedure TMMDSCaptureChannel.Stop;
begin
  if FCapture <> nil then
     FCapture.StopBuffer(FCaptureBuffer);
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
function TMMDSCaptureChannel.GetPosition: Longint;
begin
  Result := FCaptureBuffer.GetPosition
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
procedure TMMDSCaptureChannel.SetPWaveFormat(aValue: PWaveFormatEx);
begin
   FCaptureBuffer.PWaveFormat := aValue;

   inherited;
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
function TMMDSCaptureChannel.GetBufferLength: Longint;
begin
   Result := FCaptureBuffer.BufferLength;
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
procedure TMMDSCaptureChannel.SetBufferLength(Value: Longint);
begin
   FCaptureBuffer.BufferLength := Value;
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
function TMMDSCaptureChannel.GetCaptureLength: Longint;
begin
   Result := FCaptureBuffer.CaptureLength;
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
function TMMDSCaptureChannel.GetCapturing: Boolean;
begin
  Result := FCaptureBuffer.Capturing
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
procedure TMMDSCaptureChannel.SetReset(aValue: Boolean);
begin
   FCaptureBuffer.ResetPosition := aValue;
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
function TMMDSCaptureChannel.GetReset: Boolean;
begin
   Result := FCaptureBuffer.ResetPosition;
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
procedure TMMDSCaptureChannel.ReadData(Stream: TStream);
var
   Buf: PChar;
begin
   Buf := GlobalAllocMem(Stream.Size);
   try
      Stream.ReadBuffer(Buf^,Stream.Size);
      PWaveFormat := Pointer(Buf);
   finally
      GlobalFreeMem(Pointer(Buf));
   end;
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
procedure TMMDSCaptureChannel.WriteData(Stream: TStream);
begin
   if (PWaveFormat <> nil) then
       Stream.WriteBuffer(PWaveFormat^,wioSizeOfWaveFormat(PWaveFormat));
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
procedure TMMDSCaptureChannel.DefineProperties(Filer: TFiler);
begin
   inherited DefineProperties(Filer);
   Filer.DefineBinaryProperty('WaveFormatEx', ReadData, WriteData, PWaveFormat <> nil);
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
procedure TMMDSCaptureChannel.SetPCMFormat(Mode: TMMMode; Bits: TMMBits; SampleRate: Longint);
var
   wfx: TWaveFormatEx;
begin
   pcmBuildWaveHeader(@wfx, (Ord(Bits)+1)*8, Ord(Mode)+1, SampleRate);
   PWaveFormat := @wfx;
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
function TMMDSCaptureChannel.SelectFormat: Boolean;
var
   ACM: TMMACM;

begin
   ACM := TMMACM.Create(nil);
   try
      ACM.EnumFormats := efRestrict;
      Result := ACM.ChooseFormat(PWaveFormat,'Select Format');
      if Result then
         PWaveFormat := ACM.PWaveFormat;

   finally
      ACM.Free;
   end;
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
function TMMDSCaptureChannel.GetInputFormat: string;
var
   FormatTag, Format: string;
begin
   Result := 'Unknown';
   if (PWaveFormat <> nil) and
      acmGetFormatDescription(PWaveFormat, FormatTag, Format) then
      Result := FormatTag+' '+Format;
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
procedure TMMDSCaptureChannel.SetInputFormat(aValue: string);
begin
   MessageDlg('This is a read-only property, please use SelectFormat.',
              mtInformation,[mbOK],0);
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
procedure TMMDSCaptureChannel.SaveFormatInRegistry(RootKey: HKEY; Localkey, Field: string);
begin
   if (PWaveFormat <> nil) then
       SaveInRegistryBinary(RootKey,LocalKey,Field,PWaveFormat^,wioSizeOfWaveFormat(PWaveFormat));
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
procedure TMMDSCaptureChannel.LoadFormatFromRegistry(RootKey: HKEY; Localkey, Field: string);
var
   wfx: array[0..1024] of Char;
begin
   if GetFromRegistryBinary(RootKey,LocalKey,Field,wfx,sizeOf(wfx)) > 0 then
      PWaveFormat := @wfx;
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
function TMMDSCaptureChannel.SaveToRAWFile(FName: TFileName): Boolean;
begin
  Result := False;
  if (CaptureLength > 0) then
  try
     FCaptureBuffer.Memory.SaveToFile(FName);
     Result := True
  except
  end;
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
function TMMDSCaptureChannel.SaveToWaveFile(FName: TFileName): Boolean;
var
   lpwio: PWaveIOCB;
begin
   Result := False;
   if (CaptureLength > 0) then
   begin
      if (wioCreateFileInfo(lpwio, PWaveFormat) = 0) and (lpwio <> nil) then
      try
         if wioWriteFileInfo(lpwio, PChar(FName)) = 0 then
         try
            Result := wioWaveWriteData(lpwio, FCaptureBuffer.Memory.Memory, CaptureLength) = CaptureLength;
         finally
            wioWaveClose(lpwio);
         end;
      finally
         wioFreeFileInfo(lpwio);
      end;
   end;
end;

{-- TMMDSCaptureChannel -------------------------------------------------------}
procedure TMMDSCaptureChannel.GetVUMeter(var LeftValue, RightValue, BothValue: integer; Interval: integer);
var
   nBytes,dwPos: DWORD;
   PeakLeft,PeakRight: Smallint;
   wfx: TWaveFormatEx;
   p1,p2: Pointer;
   l1,l2: DWORD;

begin
   LeftValue  := 0;
   RightValue := 0;
   BothValue  := 0;

   if Capturing and (PWaveFormat^.wFormatTag = WAVE_FORMAT_PCM) then
   begin
      FCaptureBuffer.DirectSoundCaptureBuffer.GetFormat(@wfx, SizeOf(wfx), DWORD(nil^));

      nBytes := wioTimeToBytes(@wfx,Interval);

      dwPos := FCaptureBuffer.GetReadPosition;

      if (dwPos - nBytes > 0) then
      begin
         if FCaptureBuffer.DirectSoundCaptureBuffer.Lock(dwPos-nBytes,nBytes, p1, l1, p2, l2, 0) <> 0 then
            exit;

         if (l1 >= nBytes) then
         begin
            pcmFindPeak(@wfx,p1,nBytes, PeakLeft, PeakRight);

            if (wfx.wBitsPerSample = 8) then
            begin
               PeakLeft := (PeakLeft-128)*255;
               PeakRight:= (PeakRight-128)*255;
            end;

            LeftValue := abs(PeakLeft);
            RightValue := abs(PeakRight);

            BothValue := (LeftValue + RightValue) div 2;
         end;

         FCaptureBuffer.DirectSoundCaptureBuffer.Unlock(p1, l1, p2, l2);
      end;
   end;
end;

end.