unit TagID3v2;

interface

uses Windows, KOL, ATLCommon;

type
  TID = array [1..4] of Char;
  PFrame = ^TFrame;
  TFrame = packed record
    ID: TID;                                      { Frame ID }
    Size: Integer;                                    { Size excluding header }
    Flags: Word;                                                      { Flags }
    Data: Pointer;
  end;

  TDuplicateFrameMethod = (dfmFirst, dfmFirstNonEmpty, dfmIgnoreDuplicate);
{        dfmFirst - добавляется только один тег, последующие игнорируются
         dfmFirstNonEmpty - добавляется только один тег, существующий пустой тег заменяется на непустой
         dfmIgnoreDuplicate - добавляются все один теги}

  PTagID3v2 = ^TTagID3v2;
  TID3v2Tag = PTagID3v2;
  TTagID3v2 = object(TTagInfo)
  private
    FVersion: Byte;
    FDuplicateFrameMethod: TDuplicateFrameMethod;

    function ReadHeader(const FileName: KOLstring; var ATagSize: Cardinal; ATag: Pointer): Boolean;

    function RebuildFile(const FileName: KOLstring; TagData: PStream): Boolean;
    function ReplaceTag(const FileName: KOLstring; TagData: PStream): Boolean;

    function FrameToString(AFrame: PFrame): String;
    function GetTagsFrame(Index: Integer): PFrame;
    function GetTagsByName(Index: TID): PFrame;
    function GetTagCount: Integer;
    function GetTagsByNameString(Index: TID): String;
    function GetTagExString(Index: Integer): String;                       // Добавляет тег

    function GetTag(const Index: TEasyTags): String; virtual;
    procedure SetTag(const Index: TEasyTags; const Value: String); virtual;

    function  NewTagEx(AID: TID; AFlags: Word = 0): Integer;
  public
    destructor Destroy; virtual;
    procedure ResetData; virtual;

    function ReadFromFile(const AFileName: KOLstring): Boolean; virtual;
    function SaveToFile(const AFileName: KOLstring): Boolean; virtual;
    function RemoveFromFile(const AFileName: KOLstring): Boolean; virtual;

    procedure SetTagEx(AID: TID; AValue: String; AFlags: Word = 0);             // Устанавливает значение тега, если он есть, а если нет - добавляет
    function  AddTagEx(AID: TID; AFlags: Word = 0): Integer;                    // Добавляет тег
    function  IndexOfTag(AID: TID): Integer;                                    // Находит тег по его ID
    procedure DeleteTag(Index: Integer);                                        // Удаляет тег

    property DuplicateFrameMethod: TDuplicateFrameMethod read FDuplicateFrameMethod write FDuplicateFrameMethod;

    property TagExCount: Integer read GetTagCount;                               // Количество тегов
    property TagEx[Index: Integer]: PFrame read GetTagsFrame;                    // Теги (список)
    property TagExString[Index: Integer]: String read GetTagExString;            // Строковое значени тега (по имени)
    property TagExByName[Index: TID]: PFrame read GetTagsByName;                 // Теги (по имени)
    property TagExByNameString[Index: TID]: String read GetTagsByNameString;     // Строковое значени тега (по имени)
  end;

  function NewTagID3v2: TID3v2Tag;
  function SizeOfID3v2Tag(AFileName: KOLString): Integer;

implementation

uses ATLLib;

type
  PTagRec = ^TTagRec;
  TTagRec = packed record
    { Real structure of ID3v2 header }
    ID: array [1..3] of Char;                                  { Always "ID3" }
    Version: Byte;                                           { Version number }
    Revision: Byte;                                         { Revision number }
    Flags: Byte;                                               { Flags of tag }
    Size: array [1..4] of Byte;                   { Tag size excluding header }
    { Extended data }
    FileSize: DWord;                                    { File size (bytes) }
    NeedRewrite: Boolean;                           { Tag should be rewritten }
    PaddingSize: Integer;                              { Padding size (bytes) }
  end;

const
  { TagID3v2 tag ID }
  TagID3v2_ID = 'ID3';
  TAG_VERSION_2_2 = 2;                               { Code for TagID3v2.2.x tag }
  TAG_VERSION_2_3 = 3;                               { Code for TagID3v2.3.x tag }
  TAG_VERSION_2_4 = 4;                               { Code for TagID3v2.4.x tag }

  MinOftenTags = etTrack;
  MaxOftenTags = etPerformer;
  TagID3v2_Frames: array [MinOftenTags..MaxOftenTags] of record
                                          Old: array[1..3] of Char; //(TagID3v2.2.x)
                                          New: TID; //(TagID3v2.3.x & TagID3v2.4.x)
                                         end =
                              ((Old: 'TRK'; New: 'TRCK'),
                               (Old: 'TT2'; New: 'TIT2'),
                               (Old: 'TP1'; New: 'TPE1'),
                               (Old: 'TAL'; New: 'TALB'),
                               (Old: 'TYE'; New: 'TYER'),
                               (Old: 'COM'; New: 'COMM'),
                               (Old: 'TCO'; New: 'TCON'),
                               (Old: 'TCM'; New: 'TCOM'),
                               (Old: 'TEN'; New: 'TENC'),
                               (Old: 'TCR'; New: 'TCOP'),
                               (Old: 'WXX'; New: 'WXXX'),
                               (Old: 'TT1'; New: 'TIT1'),
                               (Old: 'TLA'; New: 'TLAN'),
                               (Old: 'ULT'; New: 'USLT'),
                               (Old: 'TOA'; New: 'TOPE'));

  { Max. tag size for saving }
  TagID3v2_MAX_SIZE = 4096;
  { Unicode ID }
  UNICODE_ID = #1;
type
  TFrameHeader = packed record
    case Boolean of
      { Frame header (TagID3v2.3.x & TagID3v2.4.x) }
      True: (IDNew: TID;                                      { Frame ID }
             SizeNew: Integer;                                    { Size excluding header }
             FlagsNew: Word);                                                      { Flags }
      { Frame header (TagID3v2.2.x) }
      False: (IDOld: array [1..3] of Char;                                      { Frame ID }
              SizeOld: array [1..3] of Byte);                       { Size excluding header }
  end;

function NewTagID3v2: TID3v2Tag;
begin
    New(Result, Create);
    Result.FDuplicateFrameMethod:= dfmFirstNonEmpty;
    Result.FExistsTags:= [etVersion, MinOftenTags..MaxOftenTags];
    Result.FTagVendor:= tID3v2;
end;

function SizeOfID3v2Tag(AFileName: KOLString): Integer;
var TagID3v2: TID3v2Tag;
begin
    Result:= 0;
    TagID3v2:= NewTagID3v2;
    if TagID3v2.ReadFromFile(AFileName) then Result:= TagID3v2.TagSize;
    TagID3v2.Free;
end;

procedure TTagID3v2.ResetData;
var i: Integer;
begin
    FExists:= False;
    FTagSize:= 0;
    for i:= FTagList.Count-1 downto 0 do DeleteTag(i);
end;

function TTagID3v2.ReadFromFile(const AFileName: KOLstring): Boolean;
const FrameSize : array [Boolean] of Integer = (6, 10);
var _Tag: TTagRec;
    SourceFile: PStream;
    Frame: TFrameHeader;
    Data: Pointer;
    DataSize, DataPosition: Cardinal;
    k: Integer;
    ID: TID;
    Flags: Word;
begin
    { Reset data and load header from file to variable }
    ResetData;
    Result:= ReadHeader(AFileName, FTagSize, @_Tag);
    { Process data if loaded and header valid }
    if (Result) and (_Tag.ID = TagID3v2_ID) then begin
      FExists:= true;
      { Fill properties with header data }

      FVersion:= _Tag.Version;
      { Get information from frames if version supported }
      if (_Tag.Version in [TAG_VERSION_2_2..TAG_VERSION_2_4]) and (FTagSize > 0) then
        try
          SourceFile:= OpenFileRead(AFileName);
          try
            SourceFile.Seek(10, spBegin);

            while (SourceFile.Position < FTagSize) and (SourceFile.Position < SourceFile.Size) do begin
              SourceFile.Read(Frame, FrameSize[_Tag.Version > TAG_VERSION_2_2]);
              if not (Frame.IDOld[1] in ['A'..'Z']) then break;
              DataPosition:= SourceFile.Position;

              if _Tag.Version > TAG_VERSION_2_2 then DataSize:= SwapOrder32(Frame.SizeNew)
              else DataSize:= Frame.SizeOld[1] shl 16 + Frame.SizeOld[2] shl 8 + Frame.SizeOld[3];
              if DataSize > FTagSize - DataPosition then Break;

              Data:= AllocMem(DataSize);
              FillChar(Data^, DataSize, 0);
              SourceFile.Read(Data^, DataSize);

              if _Tag.Version > TAG_VERSION_2_2 then begin
                ID:= Frame.IDNew; Flags:= Frame.FlagsNew;
              end
              else begin
                ID:= Frame.IDNew; Flags:= 0;
                ID[4]:= ID[3];
              end;
              k:= AddTagEx(ID, Flags);
              if k <> -1 then begin
                TagEx[k].Size:= DataSize;
                TagEx[k].Data:= Data;
              end;
              SourceFile.Seek(DataPosition + DataSize, spBegin);
            end;
          finally
            SourceFile.Free;
          end;
        except
        end;
    end;
end;

function TTagID3v2.SaveToFile(const AFileName: KOLstring): Boolean;
var _Tag: TTagRec;
    i: Integer;
    j, TagSz, TgSize: DWord;
    TagData: PStream;
    FrameSize: Integer;
    Padding: array [1..TagID3v2_MAX_SIZE] of Byte;
    S: String;
begin
    { Check for existing tag }
    FillChar(_Tag, SizeOf(_Tag), 0);
    ReadHeader(AFileName, TgSize, @_Tag);

    { Build and write tag header and frames to stream }
    TagData:= NewMemoryStream;

    TagSz:= 10;
    for i:= 0 to FTagList.Count-1 do
      if TagEx[i].Size > 0 then Inc(TagSz, TagEx[i].Size + 10);
    { Check for ability to change existing tag }
    _Tag.NeedRewrite:= (_Tag.ID <> TagID3v2_ID) or
                       (TgSize < TagSz) or
                       (TgSize > TagID3v2_MAX_SIZE);
    { Calculate padding size and set padded tag size }
    if _Tag.NeedRewrite then _Tag.PaddingSize:= TagID3v2_MAX_SIZE - TagSz
    else _Tag.PaddingSize:= TgSize - TagSz;
    if _Tag.PaddingSize > 0 then Inc(TagSz, _Tag.PaddingSize);
    { Build tag header }
    _Tag.ID:= TagID3v2_ID;
    _Tag.Version:= TAG_VERSION_2_3;
    _Tag.Revision:= 0;
    _Tag.Flags:= 0;
    { Convert tag size }
    for j:= 1 to 4 do _Tag.Size[j]:= ((TagSz - 10) shr ((4 - j) * 7)) and $7F;

    TagData.Write(_Tag, 10);
    for i:= 0 to FTagList.Count-1 do
      if TagEx[i].Size > 0 then begin
        TagData.Write(TagEx[i].ID, SizeOf(TID));
        FrameSize:= SwapOrder32(TagEx[i].Size);
        TagData.Write(FrameSize, SizeOf(FrameSize));
        Setlength(S, TagEx[i].Size);
        Move(TagEx[i].Data^, S[1], TagEx[i].Size);
        S:= #0#0 + S;
        TagData.Write(S[1], TagEx[i].Size+2);
      end;
    { Add padding }
    FillChar(Padding, SizeOf(Padding), 0);
    if _Tag.PaddingSize > 0 then TagData.Write(Padding, _Tag.PaddingSize);
    { Rebuild file or replace tag with new tag data }
    if _Tag.NeedRewrite then Result:= RebuildFile(AFileName, TagData)
    else Result:= ReplaceTag(AFileName, TagData);
    TagData.Free;
end;

function TTagID3v2.RemoveFromFile(const AFileName: KOLstring): Boolean;
begin
    Result:= RebuildFile(AFileName, nil);
end;

destructor TTagID3v2.Destroy;
begin
    ResetData;
    inherited;
end;


function TTagID3v2.ReadHeader(const FileName: KOLstring; var ATagSize: Cardinal; ATag: Pointer): Boolean;
var SourceFile: PStream;
    Transferred: Integer;
begin
    try
      Result:= True;
      SourceFile:= OpenFileRead(FileName);
      try
        { Read header and get file size }
        Transferred:= SourceFile.Read(ATag^, 10);
        PTagRec(ATag).FileSize:= SourceFile.Size;
        { if transfer is not complete }
        if Transferred < 10 then Result:= false;

        ATagSize:= PTagRec(ATag).Size[1] * $200000 + PTagRec(ATag).Size[2] * $4000 + PTagRec(ATag).Size[3] * $80 + PTagRec(ATag).Size[4] + 10;
        if PTagRec(ATag).Flags and $10 = $10 then Inc(ATagSize, 10);
        if (ATagSize > PTagRec(ATag).FileSize)or(PTagRec(ATag).ID <> TagID3v2_ID) then ATagSize:= 0;
      finally
        SourceFile.Free;
      end;
    except
      Result:= false;
    end;
end;

function TTagID3v2.RebuildFile(const FileName: KOLstring; TagData: PStream): Boolean;
var _Tag: TTagRec;
    Source, Destination: PStream;
    BufferName: KOLstring;
    TgSize: Cardinal;
begin
    { Rebuild file with old file data and new tag data (optional) }
    Result:= false;
    if not FileExists(FileName) then exit;
    if not ReadHeader(FileName, TgSize, @_Tag) then exit;
    if (TagData = nil) and (_Tag.ID <> TagID3v2_ID) then exit;
    try
      { Create file streams }
      BufferName:= FileName + '~';
      Source:= OpenFileRead(FileName);
      Destination:= CreateFile(BufferName); 
      try
        if (Source.Handle = INVALID_HANDLE_VALUE)or(Destination.Handle = INVALID_HANDLE_VALUE) then Exit;
        { Copy data blocks }
        if _Tag.ID = TagID3v2_ID then Source.Seek(TgSize, spBegin);

        if TagData <> nil then begin
          TagData.Position:= 0; Stream2Stream(Destination, TagData, TagData.Size);
        end;
        Destination.Seek(0, spEnd);
        Stream2Stream(Destination, Source, Source.Size - Source.Position);
      finally
        Source.Free;         
        Destination.Free;
      end;
      Result:= DeleteFile(PKOLChar(FileName)) and MoveFile(PKOLChar(BufferName), PKOLChar(FileName));
    except
      if FileExists(BufferName) then DeleteFile(PKOLChar(BufferName));
    end;
end;

function TTagID3v2.ReplaceTag(const FileName: KOLstring; TagData: PStream): Boolean;
var Destination: PStream;
begin
    { Replace old tag with new tag data }
    Result:= false;
    if not FileExists(FileName) then exit;
    try
      TagData.Position:= 0;
      Destination:= OpenFileWrite(FileName);
      TagData.Position:= 0;
      Stream2Stream(Destination, TagData, TagData.Size);
      Destination.Free;
      Result:= true;
    except
      { Access error }
    end;
end;

function TTagID3v2.GetTagsFrame(Index: Integer): PFrame;
begin
    Result:= PFrame(FTagList.Objects[Index]);
end;

function TTagID3v2.GetTagsByName(Index: TID): PFrame;
var i: Integer;
begin
    Result:= nil;
    for i:= 0 to FTagList.Count-1 do
      if AnsiUpperCase(TagEx[i].ID) = AnsiUpperCase(Index) then begin
        Result:= TagEx[i];
        Break;
      end;
end;

function TTagID3v2.GetTagCount: Integer;
begin
    Result:= FTagList.Count;
end;

function TTagID3v2.NewTagEx(AID: TID; AFlags: Word = 0): Integer;
var Frame: PFrame;
begin
    New(Frame); Frame.ID:= AID; Frame.Flags:= AFlags; Frame.Size:= 0;
    Frame.Data:= AllocMem(Frame.Size);
    FTagList.AddObject('', Integer(Frame));
    Result:= FTagList.Count-1;
end;

procedure TTagID3v2.DeleteTag(Index: Integer);
begin
    DisposeMem(TagEx[Index].Data);
    FreeMem(Pointer(FTagList.Objects[Index]));
    FTagList.Delete(Index);
end;

procedure TTagID3v2.SetTagEx(AID: TID; AValue: String; AFlags: Word = 0);
var Frame: PFrame;
begin
    Frame:= TagExByName[AID];
    if Frame <> nil then begin
      DeleteTag(FTagList.IndexOfObj(Frame));
    end;
    if AValue <> '' then begin
      AValue:= #0+AValue;
      Frame:= TagEx[NewTagEx(AID, AFlags)];
      Frame.Size:= Length(AValue);
      Frame.Data:= AllocMem(Frame.Size);
      Move(Avalue[1], Frame.Data^, Frame.Size);
    end;
end;

function TTagID3v2.FrameToString(AFrame: PFrame): String;
var WC: PChar;
    Len: Integer;
//    S: String;
    IsUnicode: Boolean;
begin
    Result:= '';
    if AFrame <> nil then begin
      if AFrame.Size > 0 then
//        SetLength(S, Frame.Size);
//        Move(Frame.Data^, S[1], Frame.Size);

        WC:= AFrame.Data;
        Len:= AFrame.Size-1;

        IsUnicode:= Char(WC^) = #1;
        WC:= WC + 1;

        if AFrame.ID = TagID3v2_Frames[etComment].New then begin
          while (Char(WC^) <> #0)and(Len > 0)  do begin inc(WC); dec(Len); end;
        end;
        while (Char(WC^) = #0) and(Len > 0) do begin inc(WC); dec(Len); end;

        if IsUnicode then begin
          WC:= WC + 2;
          Result:= WideCharLenToString(PWideChar(WC), (Len-2) div 2)
        end
        else begin
          SetLength(Result, Len);
          Move(WC^, Result[1], Len);
        end;
    end;
end;

function TTagID3v2.GetTagExString(Index: Integer): String;
begin
    Result:= FrameToString(TagEx[Index]);
end;

function TTagID3v2.GetTagsByNameString(Index: TID): String;
begin
    Result:= FrameToString(TagExByName[Index]);
end;

function TTagID3v2.AddTagEx(AID: TID; AFlags: Word): Integer;
begin
    Result:= -1;
    case FDuplicateFrameMethod of
      dfmFirst: begin
        Result:= IndexOfTag(AID);
        if Result = -1 then Result:= NewTagEx(AID, AFlags)
        else Result:= -1;
      end;
      dfmFirstNonEmpty: begin
        Result:= IndexOfTag(AID);
        if Result = -1 then Result:= NewTagEx(AID, AFlags)
        else
           if TagExByNameString[AID] <> '' then Result:= -1;
      end;
      dfmIgnoreDuplicate: Result:= NewTagEx(AID, AFlags);
    end;

end;

function TTagID3v2.IndexOfTag(AID: TID): Integer;
begin
    for Result:= 0 to TagExCount-1 do if TagEx[Result].ID = AID then Exit;
    Result:= -1;
end;

function TTagID3v2.GetTag(const Index: TEasyTags): String;
var i: Integer;
begin
    Result:= '';
    case Index of
      etVersion: Result:= Int2Str(FVersion);
      MinOftenTags..MaxOftenTags: begin
        Result:= TagExByNameString[TagID3v2_Frames[Index].New];
        if (Index = etGenre) then begin //correct '(NN)Genre' to 'Genre'
          i:= Pos(')', Result);
          if i>0 then Delete(Result, 1, i);
        end;
      end;
    end;
end;

procedure TTagID3v2.SetTag(const Index: TEasyTags; const Value: String);
var S: String;
begin
    case Index of
      MinOftenTags..MaxOftenTags: begin
        case Index of
          etLink: S:= #0 + Value;
          etComment: S:= 'lng' + #0 + Value;
          else S:= Value;
        end;
        SetTagEx(TagID3v2_Frames[Index].New, S);
      end;
    end;
end;

end.
