apetag.pas

Lossless Audio 缩解压 window

  SourceFile: file;
begin
  try
    Result := true;
    { Allow write-access and open file }
    FileSetAttr(FileName, 0);
    AssignFile(SourceFile, FileName);
    FileMode := 2;
    Reset(SourceFile, 1);
    { Delete tag }
    Seek(SourceFile, FileSize(SourceFile) - TagSize);
    Truncate(SourceFile);
    CloseFile(SourceFile);
  except
    { Error }
    Result := false;
  end;
end;

{ --------------------------------------------------------------------------- }

procedure BuildFooter(var Tag: TagInfo);
var
  Iterator: Integer;
begin
  { Build tag footer }
  Tag.ID := APE_ID;
  Tag.Version := APE_VERSION_1_0;
  Tag.Size := APE_TAG_FOOTER_SIZE;
  for Iterator := 1 to APE_FIELD_COUNT do
    if Tag.Field[Iterator] <> '' then
    begin
      Inc(Tag.Size, Length(APE_FIELD[Iterator] + Tag.Field[Iterator]) + 10);
      Inc(Tag.Fields);
    end;
end;

{ --------------------------------------------------------------------------- }

function AddToFile(const FileName: string; TagData: TStream): Boolean;
var
  FileData: TFileStream;
begin
  try
    { Add tag data to file }
    FileData := TFileStream.Create(FileName, fmOpenWrite or fmShareExclusive);
    FileData.Seek(0, soFromEnd);
    TagData.Seek(0, soFromBeginning);
    FileData.CopyFrom(TagData, TagData.Size);
    FileData.Free;
    Result := true;
  except
    { Error }
    Result := false;
  end;
end;

{ --------------------------------------------------------------------------- }

function SaveTag(const FileName: string; Tag: TagInfo): Boolean;
var
  TagData: TStringStream;
  Iterator, ValueSize, Flags: Integer;
begin
  { Build and write tag fields and footer to stream }
  TagData := TStringStream.Create('');
  for Iterator := 1 to APE_FIELD_COUNT do
    if Tag.Field[Iterator] <> '' then
    begin
      ValueSize := Length(Tag.Field[Iterator]) + 1;
      Flags := 0;
      TagData.Write(ValueSize, SizeOf(ValueSize));
      TagData.Write(Flags, SizeOf(Flags));
      TagData.WriteString(APE_FIELD[Iterator] + #0);
      TagData.WriteString(Tag.Field[Iterator] + #0);
    end;
  BuildFooter(Tag);
  TagData.Write(Tag, APE_TAG_FOOTER_SIZE);
  { Add created tag to file }
  Result := AddToFile(FileName, TagData);
  TagData.Free;
end;

{ ********************** Private functions & procedures ********************* }

procedure TAPEtag.FSetTitle(const NewTitle: string);
begin
  { Set song title }
  FTitle := Trim(NewTitle);
end;

{ --------------------------------------------------------------------------- }

procedure TAPEtag.FSetArtist(const NewArtist: string);
begin
  { Set artist name }
  FArtist := Trim(NewArtist);
end;

{ --------------------------------------------------------------------------- }

procedure TAPEtag.FSetAlbum(const NewAlbum: string);
begin
  { Set album title }
  FAlbum := Trim(NewAlbum);
end;

{ --------------------------------------------------------------------------- }

procedure TAPEtag.FSetTrack(const NewTrack: Byte);
begin
  { Set track number }
  FTrack := NewTrack;
end;

{ --------------------------------------------------------------------------- }

procedure TAPEtag.FSetYear(const NewYear: string);
begin
  { Set release year }
  FYear := Trim(NewYear);
end;

{ --------------------------------------------------------------------------- }

procedure TAPEtag.FSetGenre(const NewGenre: string);
begin
  { Set genre name }
  FGenre := Trim(NewGenre);
end;

{ --------------------------------------------------------------------------- }

procedure TAPEtag.FSetComment(const NewComment: string);
begin
  { Set comment }
  FComment := Trim(NewComment);
end;

{ --------------------------------------------------------------------------- }

procedure TAPEtag.FSetCopyright(const NewCopyright: string);
begin
  { Set copyright information }
  FCopyright := Trim(NewCopyright);
end;

{ ********************** Public functions & procedures ********************** }

constructor TAPEtag.Create;
begin
  { Create object }
  inherited;
  ResetData;
end;

{ --------------------------------------------------------------------------- }

procedure TAPEtag.ResetData;
begin
  { Reset all variables }
  FExists := false;
  FVersion := 0;
  FSize := 0;
  FTitle := '';
  FArtist := '';
  FAlbum := '';
  FTrack := 0;
  FYear := '';
  FGenre := '';
  FComment := '';
  FCopyright := '';
end;

{ --------------------------------------------------------------------------- }

function TAPEtag.ReadFromFile(const FileName: string): Boolean;
var
  Tag: TagInfo;
begin
  { Reset data and load footer from file to variable }
  ResetData;
  FillChar(Tag, SizeOf(Tag), 0);
  Result := ReadFooter(FileName, Tag);
  { Process data if loaded and footer valid }
  if (Result) and (Tag.ID = APE_ID) then
  begin
    FExists := true;
    { Fill properties with footer data }
    FVersion := Tag.Version;
    FSize := Tag.Size;
    { Get information from fields }
    ReadFields(FileName, Tag);
    FTitle := Tag.Field[1];
    FArtist := Tag.Field[2];
    FAlbum := Tag.Field[3];
    FTrack := GetTrack(Tag.Field[4]);
    FYear := Tag.Field[5];
    FGenre := Tag.Field[6];
    FComment := Tag.Field[7];
    FCopyright := Tag.Field[8];
  end;
end;

{ --------------------------------------------------------------------------- }

function TAPEtag.RemoveFromFile(const FileName: string): Boolean;
var
  Tag: TagInfo;
begin
  { Remove tag from file if found }
  FillChar(Tag, SizeOf(Tag), 0);
  if ReadFooter(FileName, Tag) then
  begin
    if Tag.ID <> APE_ID then Tag.Size := 0;
    if (Tag.Flags shr 31) > 0 then Inc(Tag.Size, APE_TAG_HEADER_SIZE);
    Result := TruncateFile(FileName, Tag.DataShift + Tag.Size)
  end
  else
    Result := false;
end;

{ --------------------------------------------------------------------------- }

function TAPEtag.SaveToFile(const FileName: string): Boolean;
var
  Tag: TagInfo;
begin
  { Prepare tag data and save to file }
  FillChar(Tag, SizeOf(Tag), 0);
  Tag.Field[1] := FTitle;
  Tag.Field[2] := FArtist;
  Tag.Field[3] := FAlbum;
  if FTrack > 0 then Tag.Field[4] := IntToStr(FTrack);
  Tag.Field[5] := FYear;
  Tag.Field[6] := FGenre;
  Tag.Field[7] := FComment;
  Tag.Field[8] := FCopyright;
  { Delete old tag if exists and write new tag }
  Result := (RemoveFromFile(FileName)) and (SaveTag(FileName, Tag));
end;

end.