⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 apetag.pas

📁 Lossless Audio 缩解压 window
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{ *************************************************************************** }
{                                                                             }
{ Audio Tools Library (Freeware)                                              }
{ Class TAPEtag - for manipulating with APE tags                              }
{                                                                             }
{ Copyright (c) 2001,2002 by Jurgen Faul                                      }
{ E-mail: jfaul@gmx.de                                                        }
{ http://jfaul.de/atl                                                         }
{                                                                             }
{ Version 1.0 (21 April 2002)                                                 }
{   - Reading & writing support for APE 1.0 tags                              }
{   - Reading support for APE 2.0 tags (UTF-8 decoding)                       }
{   - Tag info: title, artist, album, track, year, genre, comment, copyright  }
{                                                                             }
{ *************************************************************************** }

unit APEtag;

interface

uses
  Classes, SysUtils;

type
  { Class TAPEtag }
  TAPEtag = class(TObject)
    private
      { Private declarations }
      FExists: Boolean;
      FVersion: Integer;
      FSize: Integer;
      FTitle: string;
      FArtist: string;
      FAlbum: string;
      FTrack: Byte;
      FYear: string;
      FGenre: string;
      FComment: string;
      FCopyright: string;
      procedure FSetTitle(const NewTitle: string);
      procedure FSetArtist(const NewArtist: string);
      procedure FSetAlbum(const NewAlbum: string);
      procedure FSetTrack(const NewTrack: Byte);
      procedure FSetYear(const NewYear: string);
      procedure FSetGenre(const NewGenre: string);
      procedure FSetComment(const NewComment: string);
      procedure FSetCopyright(const NewCopyright: string);
    public
      { Public declarations }
      constructor Create;                                     { Create object }
      procedure ResetData;                                   { Reset all data }
      function ReadFromFile(const FileName: string): Boolean;      { Load tag }
      function RemoveFromFile(const FileName: string): Boolean;  { Delete tag }
      function SaveToFile(const FileName: string): Boolean;        { Save tag }
      property Exists: Boolean read FExists;              { True if tag found }
      property Version: Integer read FVersion;                  { Tag version }
      property Size: Integer read FSize;                     { Total tag size }
      property Title: string read FTitle write FSetTitle;        { Song title }
      property Artist: string read FArtist write FSetArtist;    { Artist name }
      property Album: string read FAlbum write FSetAlbum;       { Album title }
      property Track: Byte read FTrack write FSetTrack;        { Track number }
      property Year: string read FYear write FSetYear;         { Release year }
      property Genre: string read FGenre write FSetGenre;        { Genre name }
      property Comment: string read FComment write FSetComment;     { Comment }
      property Copyright: string read FCopyright write FSetCopyright;   { (c) }
  end;

implementation

const
  { Tag ID }
  ID3V1_ID = 'TAG';                                                   { ID3v1 }
  APE_ID = 'APETAGEX';                                                  { APE }

  { Size constants }
  ID3V1_TAG_SIZE = 128;                                           { ID3v1 tag }
  APE_TAG_FOOTER_SIZE = 32;                                  { APE tag footer }
  APE_TAG_HEADER_SIZE = 32;                                  { APE tag header }

  { First version of APE tag }
  APE_VERSION_1_0 = 1000;

  { Max. number of supported tag fields }
  APE_FIELD_COUNT = 8;

  { Names of supported tag fields }
  APE_FIELD: array [1..APE_FIELD_COUNT] of string =
    ('Title', 'Artist', 'Album', 'Track', 'Year', 'Genre',
     'Comment', 'Copyright');

type
  { APE tag data - for internal use }
  TagInfo = record
    { Real structure of APE footer }
    ID: array [1..8] of Char;                             { Always "APETAGEX" }
    Version: Integer;                                           { Tag version }
    Size: Integer;                                { Tag size including footer }
    Fields: Integer;                                       { Number of fields }
    Flags: Integer;                                               { Tag flags }
    Reserved: array [1..8] of Char;                  { Reserved for later use }
    { Extended data }
    DataShift: Byte;                                { Used if ID3v1 tag found }
    FileSize: Integer;                                    { File size (bytes) }
    Field: array [1..APE_FIELD_COUNT] of string;    { Information from fields }
  end;

{ ********************* Auxiliary functions & procedures ******************** }

function ReadFooter(const FileName: string; var Tag: TagInfo): Boolean;
var
  SourceFile: file;
  TagID: array [1..3] of Char;
  Transferred: Integer;
begin
  { Load footer from file to variable }
  try
    Result := true;
    { Set read-access and open file }
    AssignFile(SourceFile, FileName);
    FileMode := 0;
    Reset(SourceFile, 1);
    Tag.FileSize := FileSize(SourceFile);
    { Check for existing ID3v1 tag }
    Seek(SourceFile, Tag.FileSize - ID3V1_TAG_SIZE);
    BlockRead(SourceFile, TagID, SizeOf(TagID));
    if TagID = ID3V1_ID then Tag.DataShift := ID3V1_TAG_SIZE;
    { Read footer data }
    Seek(SourceFile, Tag.FileSize - Tag.DataShift - APE_TAG_FOOTER_SIZE);
    BlockRead(SourceFile, Tag, APE_TAG_FOOTER_SIZE, Transferred);
    CloseFile(SourceFile);
    { if transfer is not complete }
    if Transferred < APE_TAG_FOOTER_SIZE then Result := false;
  except
    { Error }
    Result := false;
  end;
end;

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

function ConvertFromUTF8(const Source: string): string;
var
  Iterator, SourceLength, FChar, NChar: Integer;
begin
  { Convert UTF-8 string to ANSI string }
  Result := '';
  Iterator := 0;
  SourceLength := Length(Source);
  while Iterator < SourceLength do
  begin
    Inc(Iterator);
    FChar := Ord(Source[Iterator]);
    if FChar >= $80 then
    begin
      Inc(Iterator);
      if Iterator > SourceLength then break;
      FChar := FChar and $3F;
      if (FChar and $20) <> 0 then
      begin
        FChar := FChar and $1F;
        NChar := Ord(Source[Iterator]);
        if (NChar and $C0) <> $80 then  break;
        FChar := (FChar shl 6) or (NChar and $3F);
        Inc(Iterator);
        if Iterator > SourceLength then break;
      end;
      NChar := Ord(Source[Iterator]);
      if (NChar and $C0) <> $80 then break;
      Result := Result + WideChar((FChar shl 6) or (NChar and $3F));
    end
    else
      Result := Result + WideChar(FChar);
  end;
end;

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

procedure SetTagItem(const FieldName, FieldValue: string; var Tag: TagInfo);
var
  Iterator: Byte;
begin
  { Set tag item if supported field found }
  for Iterator := 1 to APE_FIELD_COUNT do
    if UpperCase(FieldName) = UpperCase(APE_FIELD[Iterator]) then
      if Tag.Version > APE_VERSION_1_0 then
        Tag.Field[Iterator] := ConvertFromUTF8(FieldValue)
      else
        Tag.Field[Iterator] := FieldValue;
end;

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

procedure ReadFields(const FileName: string; var Tag: TagInfo);
var
  SourceFile: file;
  FieldName: string;
  FieldValue: array [1..250] of Char;
  NextChar: Char;
  Iterator, ValueSize, ValuePosition, FieldFlags: Integer;
begin
  try
    { Set read-access, open file }
    AssignFile(SourceFile, FileName);
    FileMode := 0;
    Reset(SourceFile, 1);
    Seek(SourceFile, Tag.FileSize - Tag.DataShift - Tag.Size);
    { Read all stored fields }
    for Iterator := 1 to Tag.Fields do
    begin
      FillChar(FieldValue, SizeOf(FieldValue), 0);
      BlockRead(SourceFile, ValueSize, SizeOf(ValueSize));
      BlockRead(SourceFile, FieldFlags, SizeOf(FieldFlags));
      FieldName := '';
      repeat
        BlockRead(SourceFile, NextChar, SizeOf(NextChar));
        FieldName := FieldName + NextChar;
      until Ord(NextChar) = 0;
      ValuePosition := FilePos(SourceFile);
      BlockRead(SourceFile, FieldValue, ValueSize mod SizeOf(FieldValue));
      SetTagItem(Trim(FieldName), Trim(FieldValue), Tag);
      Seek(SourceFile, ValuePosition + ValueSize);
    end;
    CloseFile(SourceFile);
  except
  end;
end;

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

function GetTrack(const TrackString: string): Byte;
var
  Index, Value, Code: Integer;
begin
  { Get track from string }
  Index := Pos('/', TrackString);
  if Index = 0 then Val(TrackString, Value, Code)
  else Val(Copy(TrackString, 1, Index - 1), Value, Code);
  if Code = 0 then Result := Value
  else Result := 0;
end;

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

function TruncateFile(const FileName: string; TagSize: Integer): Boolean;
var

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -