wave.pas

delphi中很有名的delphiX组件。传奇2客户端源代码也是用这个组件。

  begin
    if FPosition>Size then
      FPosition := Size;
    if FPosition+Count>Size then
      Result := Size-FPosition
    else
      Result := Count;

    Result := ReadWave(Buffer, Result);
  end;

  Inc(FPosition, Result);
end;

function TCustomWaveStream.ReadWave(var Buffer; Count: Integer): Integer;
begin
  Result := 0;
end;

function TCustomWaveStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  case Origin of
    soFromBeginning: FPosition := Offset;
    soFromCurrent  : FPosition := FPosition + Offset;
    soFromEnd      : FPosition := GetSize + Offset;
  end;
  if FPosition<0 then FPosition := 0;
  if FPosition>GetSize then FPosition := GetSize;

  Result := FPosition;
end;

procedure TCustomWaveStream.SetPCMFormat(SamplesPerSec, BitsPerSample, Channels: Integer);
begin
  FormatSize := SizeOf(TWaveFormatEx);
  MakePCMWaveFormatEx(Format^, SamplesPerSec, BitsPerSample, Channels);
end;

procedure TCustomWaveStream.SetSize(Value: Integer);
begin
end;

function TCustomWaveStream.Write(const Buffer; Count: Longint): Longint;
begin
  if FPosition>Size then
    FPosition := Size;
  Result := WriteWave(Buffer, Count);
  Inc(FPosition, Result);
end;

function TCustomWaveStream.WriteWave(const Buffer; Count: Integer): Integer;
begin
  Result := 0;
end;

{  TCustomWaveStream2  }

destructor TCustomWaveStream2.Destroy;
begin
  FormatSize := 0;
  inherited Destroy;
end;

function TCustomWaveStream2.GetFormat: PWaveFormatEx;
begin
  Result := FFormat;
end;

function TCustomWaveStream2.GetFormatSize: Integer;
begin
  Result := FFormatSize;
end;

procedure TCustomWaveStream2.SetFormatSize(Value: Integer);
begin
  ReAllocMem(FFormat, Value);
  FFormatSize := Value;
end;

{  TWaveObjectStream  }

constructor TWaveObjectStream.Create(AWave: TWave);
begin
  inherited Create;
  FWave := AWave;

  FormatSize := FWave.FormatSize;
  Move(FWave.Format^, Format^, FormatSize);
end;

function TWaveObjectStream.GetFormat: PWaveFormatEx;
begin
  Result := FWave.Format;
end;

function TWaveObjectStream.GetFormatSize: Integer;
begin
  Result := FWave.FormatSize;
end;

function TWaveObjectStream.GetSize: Integer;
begin
  Result := FWave.Size;
end;

function TWaveObjectStream.ReadWave(var Buffer; Count: Integer): Integer;
begin
  Result := Count;
  Move(Pointer(Integer(FWave.Data)+Position)^, Buffer, Count);
end;

procedure TWaveObjectStream.SetFormatSize(Value: Integer);
begin
  FWave.FormatSize := Value;
end;

procedure TWaveObjectStream.SetSize(Value: Integer);
begin
  FWave.Size := Value;
end;

function TWaveObjectStream.WriteWave(const Buffer; Count: Integer): Integer;
begin
  Result := Count;
  if Position+Count>Size then
    SetSize(Size+(Position+Count+Size));
  Move(Buffer, Pointer(Integer(FWave.Data)+Position)^, Count);
end;

{  TWaveStream  }

const
  ID_RIFF = Ord('R') + Ord('I')*$100 + Ord('F')*$10000 + Ord('F')*$1000000;
  ID_WAVE = Ord('W') + Ord('A')*$100 + Ord('V')*$10000 + Ord('E')*$1000000;
  ID_FMT  = Ord('f') + Ord('m')*$100 + Ord('t')*$10000 + Ord(' ')*$1000000;
  ID_FACT = Ord('f') + Ord('a')*$100 + Ord('c')*$10000 + Ord('t')*$1000000;
  ID_DATA = Ord('d') + Ord('a')*$100 + Ord('t')*$10000 + Ord('a')*$1000000;

type
  TWaveFileHeader = packed record
    FType: Integer;
    Size: Longint;
    RType: Integer;
  end;

  TWaveChunkHeader = packed record
    CType: Longint;
    Size: Longint;
  end;

constructor TWaveStream.Create(AStream: TStream);
begin
  inherited Create;
  FStream := AStream;

  FOriPosition := FStream.Position;
end;

destructor TWaveStream.Destroy;
begin
  if FOpened and (not FReadMode) then
    CloseWriteMode;
  inherited Destroy;
end;

function TWaveStream.GetSize: Integer;
begin
  if FOpened then
  begin
    if not FReadMode then
      Result := FStream.Size-FDataPosition
    else
      Result := FSize;
  end else
    Result := 0;
end;

function TWaveStream.ReadWave(var Buffer; Count: Integer): Integer;
begin
  if not FOpened then
    raise EWaveStreamError.Create(SStreamNotOpend);

  FStream.Position := FDataPosition+Position;
  Result := FStream.Read(Buffer, Count);
end;

function TWaveStream.WriteWave(const Buffer; Count: Integer): Integer;
begin
  if not FOpened then
    raise EWaveStreamError.Create(SStreamNotOpend);

  if FReadMode then
  begin
    if Position+Count>FSize then
      Count := FSize-Position;
  end;

  FStream.Position := FDataPosition+Position;
  Result := FStream.Write(Buffer, Count);
end;

procedure TWaveStream.Open(WriteMode: Boolean);
begin
  if WriteMode then
    OpenWriteMode
  else
    OpenReadMode;
end;

procedure TWaveStream.OpenReadMode;
var
  WF: TWaveFileHeader;
  WC: TWaveChunkHeader;

  procedure Readfmt;   { fmt }
  begin
    FormatSize := WC.Size;
    FStream.ReadBuffer(Format^, WC.Size);
  end;

  procedure Readdata; { data }
  begin
    FSize := WC.Size;
    FDataPosition := FStream.Position;
    FStream.Seek(FSize, 1);
  end;

begin
  if FOpened then
    raise EWaveStreamError.Create(SStreamOpend);

  FOpened := True;
  FReadMode := True;

  FStream.Position := FOriPosition;

  //if FStream.Size-FStream.Position<=0 then Exit;

  {  File header reading.  }
  FStream.ReadBuffer(WF, SizeOf(TWaveFileHeader));

  {  Is it Wave file of the file?  }
  if (WF.FType<>ID_RIFF) or (WF.RType<>ID_WAVE) then
    raise EWaveStreamError.Create(SInvalidWave);

  {  Chunk reading.  }
  FillChar(WC, SizeOf(WC), 0);
  FStream.Read(WC, SizeOf(TWaveChunkHeader));
  while WC.CType<>0 do
  begin
    case WC.CType of
      ID_FMT : Readfmt;
      ID_DATA: Readdata;
    else
    {  Chunk which does not correspond is disregarded.  }
      FStream.Seek(WC.Size, 1);
    end;

    FillChar(WC, SizeOf(WC), 0);
    FStream.Read(WC, SizeOf(TWaveChunkHeader));
  end;
end;

procedure TWaveStream.OpenWriteMode;

  procedure WriteFmt;    { fmt }
  var
    WC: TWaveChunkHeader;
  begin
    with WC do
    begin
      CType := ID_FMT;
      Size := FFormatSize;
    end;

    FStream.WriteBuffer(WC, SizeOf(WC));
    FStream.WriteBuffer(FFormat^, FFormatSize);
  end;

  procedure WriteData;   { data }
  var
    WC: TWaveChunkHeader;
  begin
    FDataHeaderPosition := FStream.Position;

    with WC do
    begin
      CType := ID_DATA;
      Size := 0;
    end;

    FStream.WriteBuffer(WC, SizeOf(WC));

    FDataPosition := FStream.Position;
  end;

var
  WF: TWaveFileHeader;
begin
  if FOpened then
    raise EWaveStreamError.Create(SStreamOpend);

  if FormatSize=0 then
    raise EWaveStreamError.Create(SInvalidWaveFormat);

  FOpened := True;
  FStream.Position := FOriPosition;

  FStream.WriteBuffer(WF, SizeOf(TWaveFileHeader));

  {  Chunk writing.  }
  WriteFmt;
  WriteData;
end;

procedure TWaveStream.CloseWriteMode;

  procedure WriteDataHeader; { data }
  var
    WC: TWaveChunkHeader;
  begin
    FStream.Position := FDataHeaderPosition;

    with WC do
    begin
      CType := ID_DATA;
      Size := Self.Size;
    end;

    FStream.WriteBuffer(WC, SizeOf(WC));
  end;

var
  WF: TWaveFileHeader;
begin
  with WF do
  begin
    FType := ID_RIFF;
    Size := (FStream.Size-FOriPosition)-SizeOf(TWaveChunkHeader);
    RType := ID_WAVE;
  end;
  FStream.Position := FOriPosition;
  FStream.WriteBuffer(WF, SizeOf(TWaveFileHeader));
  WriteDataHeader;
  FStream.Position := FStream.Size;
end;

{  TWaveFileStream  }

constructor TWaveFileStream.Create(const FileName: string; FileMode: Integer);
begin
  FFileStream := TFileStream.Create(FileName, FileMode);
  inherited Create(FFileStream);
end;

destructor TWaveFileStream.Destroy;
begin
  inherited Destroy;
  FFileStream.Free;
end;

end.