📄 apetag.pas
字号:
{ *************************************************************************** }
{ }
{ 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 + -