/src/externallibs/Mp3FileUtils.pas

Large files files are truncated, but you can click here to view the full file

{

  -------------------------------------------------------



  The contents of this file are subject to the Mozilla Public License

  Version 1.1 (the "License"); you may not use this file except in

  compliance with the License. You may obtain a copy of the License at

  http://www.mozilla.org/MPL/



  Software distributed under the License is distributed on an "AS IS"

  basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the

  License for the specific language governing rights and limitations

  under the License.



  The Original Code is MP3FileUtils.



  The Initial Developer of the Original Code is Daniel Gaussmann,

  mail@gausi.de. Portions created by the Initial Developer are

  Copyright (C) 2005-2009 the Initial Developer. All Rights Reserved.



  Contributor(s): (none yet)



  Alternatively, the contents of this file may be used under the terms

  of the GNU Lesser General Public License Version 2.1 or later

  (the  "LGPL"), in which case the provisions of LGPL are applicable

  instead of those above. If you wish to allow use of your version of

  this file only under the terms of the LGPL and not to allow others to use

  your version of this file under the MPL, indicate your decision by

  deleting the provisions above and replace them with the notice and

  other provisions required by the LGPL. If you do not delete

  the provisions above, a recipient may use your version of this file

  under either the MPL or the LGPL License.



  -------------------------------------------------------

}



{

 Extract and set several information in mp3-Files.



      - TID3v1Tag:

        Read and write ID3v1-Tags

        All information are supported

        Version 1.1 is supported



      - TMpegInfo

        Read MPEG-information (bitrate, duration, ...)



      - TID3v2Tag:

        Read and write ID3v2-Tags.

        Support for all sub-versions (2.2, 2.3, 2.4)



      - TID3v2Frame:

        Edit ID3v2-Tag on Frame-level (experienced users only)





  Supported Third-Party-Tools

  ========================================================================================================

    - TntWare Delphi Unicode Controls

      Download: http://www.tntware.com/delphicontrols/unicode/

      Note: Tnt is only used for File-Access.

            If you just need Ansi-Filenames, you will NOT need TNTs

            Delphi 2009 do not need the TNTs.





  Version-History

  ========================================================================================================



  June 2011: v0.5b -> v0.6

  ========================

  New features

    - Private Frames

    - VBRI-Header-Detection

    - added some more genres to the Genres-List

    - added methods GetUserText, SetUserText, GetAllUserTextFrames,

      deleted TXXX-Frames from GetAllTextFrames

      (see TXXX-Bugfix below)



  Changes

    - ID3v2Tag.ReadFromStream: Copy all frames into a memorystream before reading

    - deleted methods SetRating and SetPersonalPlayCounter

      use SetRatingAndCounter instead to set both values at once

      (both values are stored in the same frame)



  Bugfixes

    - correct reading of UTF8-encoded Textframes with Delphi2009

    - ExtendedHeader-Size has been misinterpreted

    - User defined Textframes (TXXX) have NOT the same structure as other Textframes

    - result of TMpegInfo.GetframeLength is integer (negative value is used as error indication),

      but TMpegHeader.Framelentgh is Word. The direct assignment provided some errors whith

      range checking enabled





  August 2009: v0.5a -> 0.5b

  ========================

    - Fatal Bug fixed: ID3-v1-Tag could not be deleted in Delphi 2009, and every

      write-access (WriteToFile/-Stream) to ID3v1-Tags created a new one at the

      end of the file. (This was the case only in Delphi 2009, it was a

      Char-AnsiChar-thingy.)

    - DefaultRatingDescription is a var now.

    - Added frame-support for PlayCounter. Not the PCNT-Frame, but the

      counter included within Rating-Frames.

      (Use with care, this is not tested very well. This should have come along

      with some more new features (private-frames), but someone showed me

      this ID3v1-bug, which really must be fixed.)



  April 2009: v0.5 -> 0.5a (not published)

  ========================

    - fixed a possible memory-leak in TID3v2Tag.RemoveFromStream



  April 2009: v0.4a -> 0.5

  ========================

    - update to Delphi 2009

    - kicked out DIConverters.

      Conversion will now use the MultiByteToWideChar-Function from the Windows-API

      (-) some codepages are not supported any longer

      (+) easier to use, no third-party-stuff required

      (+) smaller binary

    - kicked out some methods, which were declared "deprecated" in v0.4

    - AcceptAllEncodings replaced by AutoCorrectCodepage

    - CharCode replaced by CodePage

    - GetCharcode replaced by GetCodePage

    - added TMpegInfo.Duration (same as .Dauer, just for the english users ;-) )

    - fixed a bug which possibly caused invalid encoded URLs on "Unicode-filenames"

    - fixed a problem with activated range-checking and PaddingSize of zero

    - translated (most) comments to english



  Dezember 2008: v0.4 -> 0.4a (sorry, from here on only german ;-))

  ===========================

    - Fehler behoben, der bei Tags mit einer bestimmten Text-Kodierung das letzte

      Zeichen der Textfelder abschnitt



  Juni 2008: v0.3b -> 0.4

  =======================

    - Code anders strukturiert - einiges in die Klasse TID3v2Frame ausgelagert

    - Unterst?tzung von Unsynchronisation

    - Unterst?tzung von GroupID und DataLength-Flags in Frame-Headern

    - Bei Compression und/oder Encryption wird das Auslesen abgebrochen

    - Unterst?tzung von URLs

    - Unterst?tzung von Bewertungen

    - Fehler in der Behandlung bei "Beschreibungen" mit Unicode - das f?hrte u.a. dazu,

      dass viele Cover in Dateien von jamendo.com nicht angezeigt wurden.



  Februar 2008: v0.3a -> 0.3b

  ==========================

    - Funktion GetTrackFromV2TrackString hinzugef?gt

    - Bug in der Funktion GetPaddingSize behoben



  Juni 2007: v0.3 -> 0.3a

  ==========================

    - Bei den Gettern des ID3v1-Tags wurden h?ufig Leerstellen und/oder Nullbytes mit ?bergeben, was ein Trim() au?erhalb

      der Klasse n?tig machte. Das wurde korrigiert - das trim() wird jetzt hier intern gemacht.

    - Sch?nheitsfehler bei der Benennung beseitigt: TPictureFrameDes()ription hei?t jetzt TPictureFrameDes(c)ription





  Februar 2007: v0.2a -> 0.3

  ==========================

    - INT/WE- Versionen ?ber Compiler-Schalter vereint.

      Siehe dazu das Ende dieses einleitenden Kommentars

    - Fehler entfernt, die bei einer Verkleinerung des ID3v2-Tags unter gewissen Umst?nden zu unsch?nen

      Effekten bei den getaggten mp3s f?hrte - die letzten Frames/Sekunden des Liedes wurden dann doppelt

      abgespielt.

    - intelligenteres Padding-System (abh?ngig von der Clustergr??e)

      f?r den ID3v1Tag werden 128 Byte im Cluster freigehalten (falls er nicht existiert), so

      dass ein nachtr?gliches Einf?gen keinen Zusatzplatz ben?tigt.





  ========================================================================================================

  September 2006: v0.2 -> 0.2a (beide Versionen)

  ==============================================

    - katastrophalen Bug behoben, der ung?ltige ID3v2-TextFrames erzeugt.





  August 2006:  v0.1 -> v0.2(International)

  =========================================



    Kleinere Bugs:

    ==============

    - Der ID3v1-Tag wurde vor dem Lesen nicht gel?scht, so dass u.U noch alte Informationen ?brigblieben

    - Unter gewissen Umst?nden wurden Lyrics und Comments bei ID3v2 nicht richtig ausgelesen.

      Das lag aber an fehlerhaften Language-Informationen, die jetzt ausgeb?gelt werden.

    - Fehler beim Lesen einer Variante von Unicode behoben (Stichwort: Byte-Order)

    - Finalize-Abschnitt (wieder) hinzugef?gt. Der ist zwischendurch mal irgendwo verlorengegangen.



    Updates/?nderungen:

    ===================

       Klasse TID3v1Tag:

       -----------------

       - in der 'International'-Version werden alle Textinformationen als WideString zur?ckgeliefert

       - beim Lesen findet ggf. eine Konvertierung statt, die vom CharCode abh?ngt.

         Mit Hilfe der Funktion GetCharCode aus der Unit U_CharCode (mitgeliefert) kann

         der beim Taggen verwendete Zeichensatz anhand des Dateinamens bestimmt werden.

         Das funktioniert nat?rlich nur mit einer gewissen Fehlerquote. Mehr dazu in der Datei 'Unicode.txt'.

       - beim Schreiben wird ebenfalls dieser Zeichensatz verwendet und der WideString entsprechend konvertiert

       - Flag 'AcceptAllEncodings' hinzugef?gt. Ist dieser 'False', findet keine Konvertierung statt

         (weder beim schreiben, noch beim lesen).

         Was das f?r einen Effekt auf Systemen au?erhalb Westeuropas hat, kann ich nicht genau sagen.



       Klasse TID3v2Tag:

       -----------------

       - S?mtliche TextInformationen werden jetzt als WideString geliefert.

       - Textinformationen werden automatisch im Unicode-Format gespeichert, falls dies n?tig ist.

       - Flag 'AlwaysWriteUnicode' hinzugef?gt. Ist dies gesetzt, wird immer im Unicode-Format gespeichert,

         auch wenn das nicht n?tig ist (d.h. wenn nur "Standard"-Buchstaben verwendet werden)

       - beim Lesen findet ggf. eine Konvertierung statt, die vom CharCode abh?ngt.

         Mit Hilfe der Funktion GetCharCode aus der Unit U_CharCode (mitgeliefert) kann

         der beim Taggen verwendete Zeichensatz anhand des Dateinamens bestimmt werden.

         Im Gegensatz zur Klasse ID3v1Tag tritt dies nur dann auf, wenn beim Taggen auf Unicode verzichtet

         wurde. D.h. auch wenn das Flag 'AcceptAllEncodings' nicht gesetzt ist, kann man kyrillische oder asiatische (oder...)

         Zeichen erhalten. Dies sollte eigentlich sogar die Regel sein - ist es aber nicht, weswegen ich den ganzen

         Kram mit der Konvertierung ?berhaupt implementieren musste.

         Das funktioniert nat?rlich nur mit einer gewissen Fehlerquote. Mehr dazu in der Datei 'Unicode.txt'.

       - Flag 'AcceptAllEncodings' hinzugef?gt. Ist dieser 'False', findet keine Konvertierung statt



}



unit Mp3FileUtils;



{$I config.inc}



interface



uses

  SysUtils, Classes, Windows, Contnrs, dialogs, U_CharCode

  {$IFDEF USE_TNT_COMPOS}, TntSysUtils, TntClasses{$ENDIF}, Id3v2Frames;



type



  {$IFDEF USE_TNT_COMPOS}

      TMPFUFileStream = TTNTFileStream;

  {$ELSE}

      TMPFUFileStream = TFileStream;

  {$ENDIF}







//--------------------------------------------------------------------

// Teil 1: Some small helpers

//--------------------------------------------------------------------

  TBuffer = Array of byte;

  TMP3Error = (MP3ERR_None, MP3ERR_NoFile, MP3ERR_FOpenCrt, MP3ERR_FOpenR,

               MP3ERR_FOpenRW, MP3ERR_FOpenW, MP3ERR_SRead, MP3ERR_SWrite,

               ID3ERR_Cache, ID3ERR_NoTag, ID3ERR_Invalid_Header, ID3ERR_Compression,

               ID3ERR_Unclassified,

               MPEGERR_NoFrame );

  TID3Version = record

    Major: Byte;

    Minor: Byte;

  end;

//--------------------------------------------------------------------





//--------------------------------------------------------------------

// Teil 2: Types for ID3v1-tag

//--------------------------------------------------------------------

  String4  = String[4];          // OK. ShortStrings are short AnsiStrings in Delphi2009

  String30 =  String[30];



  // Structure of ID3v1Tags in the file

  TID3v1Structure = record

    ID: array[1..3] of AnsiChar;               // all together 128 Bytes

    Title: Array [1..30] of AnsiChar;          // Use AnsiChars

    Artist: Array [1..30] of AnsiChar;

    Album: Array [1..30] of AnsiChar;

    Year: array [1..4] of AnsiChar;

    Comment: Array [1..30] of AnsiChar;

    Genre: Byte;

  end;



  TID3v1Tag = class(TObject)

  private

    FTitle: String30;

    FArtist: String30;

    FAlbum: String30;

    FComment: String30;

    FTrack: Byte;

    FYear: String4;

    FGenre: Byte;

    FExists: Boolean;

    FVersion: Byte;



    // convert the ansi-data to UnicodeString using a codepage

    // * use GetCodepage(Filename) to get the probably used codepage

    // * fAutoCorrectCodepage = False: Use the System-Codepage

    fAutoCorrectCodepage: Boolean;

    FCharCode: TCodePage;

    function GetConvertedUnicodeText(Value: String30): UnicodeString;



    function GetTitle: UnicodeString;

    function GetArtist: UnicodeString;

    function GetAlbum: UnicodeString;

    function GetComment: UnicodeString;



    function GetGenre: String;  // Delphi-Default-String. Just for display, as Genre is stored as one byte

    function GetTrack: String;  // Delphi-Default-String. Just for display, as Track is stored as one byte

    function GetYear: String4;



    function SetString30(value: UnicodeString): String30;

    procedure SetTitle(Value: UnicodeString);

    procedure SetArtist(Value: UnicodeString);

    procedure SetAlbum(Value: UnicodeString);

    procedure SetGenre(Value: String);         // Delphi-Default-String.

    procedure SetYear(Value: String4);

    procedure SetComment(Value: UnicodeString);

    procedure SetTrack(Value: String);        // Delphi-Default-String.

  public

    constructor Create;

    destructor Destroy; override;

    property TagExists: Boolean read FExists;

    property Exists:    Boolean read FExists;



    property Version: Byte read FVersion;

    property Title: UnicodeString read GetTitle write SetTitle;

    property Artist: UnicodeString read GetArtist write SetArtist;

    property Album: UnicodeString read GetAlbum write SetAlbum;

    property Genre: String read GetGenre write SetGenre;     // Delphi-Default-String.

    property Track: String read GetTrack write SetTrack;     // Delphi-Default-String.

    property Year: String4 read GetYear write SetYear;

    property Comment: UnicodeString read GetComment write SetComment;



    property CharCode: TCodePage read FCharCode write FCharCode;

    property AutoCorrectCodepage: Boolean read FAutoCorrectCodepage write FAutoCorrectCodepage;



    procedure Clear;

    function ReadFromStream(Stream: TStream): TMP3Error;

    function WriteToStream(Stream: TStream): TMP3Error;

    function RemoveFromStream(Stream: TStream): TMP3Error;

    function ReadFromFile(Filename: UnicodeString): TMP3Error;        // UnicodeString

    function WriteToFile(Filename: UnicodeString): TMP3Error;

    function RemoveFromFile(Filename: UnicodeString): TMP3Error;

  end;

//--------------------------------------------------------------------







//--------------------------------------------------------------------

// Teil 3: Types for ID3v2-tags

//--------------------------------------------------------------------

  TInt28 = array[0..3] of Byte;   // Sync-Safe Integer





  // Header-Structure of ID3v2-Tags

  // same on all subversions

  TID3v2Header = record

    ID: array[1..3] of AnsiChar;

    Version: Byte;

    Revision: Byte;

    Flags: Byte;

    TagSize: TInt28;

  end;



  TID3v2Tag = class(TObject)

  private

    Frames: TObjectList;

    fExists: Boolean;

    fVersion: TID3Version;

    fFlgUnsynch: Boolean;

    fFlgCompression: Boolean;

    fFlgExtended: Boolean;

    fFlgExperimental: Boolean;

    fFlgFooterPresent: Boolean;

    fFlgUnknown: Boolean;

    fPaddingSize: LongWord;

    fTagSize: LongWord;

    fDataSize: LongWord;

    fUsePadding: Boolean;

    fUseClusteredPadding: Boolean;

    fFilename: UnicodeString;



    // Always write Unicode?

    // True: frames will be written as utf-16 always

    // False: ..only if needed, Ansi otherwise (recommended for compatibilty to other taggers ;-))

    fAlwaysWriteUnicode: Boolean;

    fAutoCorrectCodepage: Boolean;

    fCharCode: TCodePage;



    function GetFrameIDString(ID:TFrameIDs):AnsiString;



    function GetFrameIndex(ID:TFrameIDs):integer;

    function GetUserTextFrameIndex(aDescription: UnicodeString): integer;

    function GetDescribedTextFrameIndex(ID:TFrameIDs; Language:AnsiString; Description:UnicodeString): Integer;

    function GetPictureFrameIndex(aDescription: UnicodeString): Integer;

    function GetUserDefinedURLFrameIndex(Description: UnicodeString): Integer;

    function GetPopularimaterFrameIndex(aEMail: AnsiString):integer;

    function GetPrivateFrameIndex(aOwnerID: AnsiString): Integer;



    function GetDescribedTextFrame(ID:TFrameIDs; Language:AnsiString; Description: UnicodeString): UnicodeString;

    procedure SetDescribedTextFrame(ID:TFrameIDs; Language:AnsiString; Description: UnicodeString; Value: UnicodeString);



    function ReadFrames(From: LongInt; Stream: TStream): TMP3Error;

    function ReadHeader(Stream: TStream): TMP3Error;

    procedure SyncStream(Source, Target: TStream);



    // property read functions

    function GetTitle: UnicodeString;

    function GetArtist: UnicodeString;

    function GetAlbum: UnicodeString;

    function ParseID3v2Genre(value: UnicodeString): UnicodeString;

    function GetGenre: UnicodeString;

    function GetTrack: UnicodeString;

    function GetYear: UnicodeString;

    function GetStandardComment: UnicodeString;

    function GetStandardLyrics: UnicodeString;

    function GetComposer: UnicodeString;

    function GetOriginalArtist: UnicodeString;

    function GetCopyright: UnicodeString;

    function GetEncodedBy: UnicodeString;

    function GetLanguages: UnicodeString;

    function GetSoftwareSettings: UnicodeString;

    function GetMediatype: UnicodeString;

    function Getid3Length: UnicodeString;

    function GetPublisher: UnicodeString;

    function GetOriginalFilename: UnicodeString;

    function GetOriginalLyricist: UnicodeString;

    function GetOriginalReleaseYear: UnicodeString;

    function GetOriginalAlbumTitel: UnicodeString;



    //property set functions

    procedure SetTitle(Value: UnicodeString);

    procedure SetArtist(Value: UnicodeString);

    procedure SetAlbum(Value: UnicodeString);

    function BuildID3v2Genre(value: UnicodeString): UnicodeString;

    procedure SetGenre(Value: UnicodeString);

    procedure SetTrack(Value: UnicodeString);

    procedure SetYear(Value: UnicodeString);

    procedure SetStandardComment(Value: UnicodeString);

    procedure SetStandardLyrics(Value: UnicodeString);

    procedure SetComposer(Value: UnicodeString);

    procedure SetOriginalArtist(Value: UnicodeString);

    procedure SetCopyright(Value: UnicodeString);

    procedure SetEncodedBy(Value: UnicodeString);

    procedure SetLanguages(Value: UnicodeString);

    procedure SetSoftwareSettings(Value: UnicodeString);

    procedure SetMediatype(Value: UnicodeString);

    procedure Setid3Length(Value: UnicodeString);

    procedure SetPublisher(Value: UnicodeString);

    procedure SetOriginalFilename(Value: UnicodeString);

    procedure SetOriginalLyricist(Value: UnicodeString);

    procedure SetOriginalReleaseYear(Value: UnicodeString);

    procedure SetOriginalAlbumTitel(Value: UnicodeString);



    function GetStandardUserDefinedURL: AnsiString;

    procedure SetStandardUserDefinedURL(Value: AnsiString);



    // SetRatingAndCounter: use aRating = -1 or aCounter = -1 to let this value untouched

    //                      use aRating = 0 AND aCounter = 0 to delete the frame

    //procedure SetRatingAndCounter(aEMail: AnsiString; aRating: Integer {Byte}; aCounter: Integer{Cardinal});

    function GetArbitraryRating: Byte;

    procedure SetArbitraryRating(Value: Byte);

    function GetArbitraryPersonalPlayCounter: Cardinal;

    procedure SetArbitraryPersonalPlayCounter(Value: Cardinal);



    procedure SetCharCode(Value: TCodePage);

    procedure SetAutoCorrectCodepage(Value: Boolean);





  public





    constructor Create;

    destructor Destroy; override;



    // "Level 1": Easy access through properties.

    //            The setter and getter will do all the complicated stuff for you

    property Title:   UnicodeString read GetTitle  write SetTitle;

    property Artist:  UnicodeString read GetArtist write SetArtist;

    property Album:   UnicodeString read GetAlbum  write SetAlbum;

    property Genre:   UnicodeString read GetGenre  write SetGenre;

    property Track:   UnicodeString read GetTrack  write SetTrack;

    property Year:    UnicodeString read GetYear   write SetYear;



    property Comment: UnicodeString read GetStandardComment write SetStandardComment;

    property Lyrics : UnicodeString read GetStandardLyrics write SetStandardLyrics;

    property URL: AnsiString read GetStandardUserDefinedURL write SetStandardUserDefinedURL;

    property Rating: Byte read GetArbitraryRating write SetArbitraryRating;

    property PlayCounter: Cardinal read GetArbitraryPersonalPlayCounter write SetArbitraryPersonalPlayCounter;



    property Composer:         UnicodeString read  GetComposer           write  SetComposer        ;

    property OriginalArtist:   UnicodeString read  GetOriginalArtist     write  SetOriginalArtist  ;

    property Copyright:        UnicodeString read  GetCopyright          write  SetCopyright       ;

    property EncodedBy:        UnicodeString read  GetEncodedBy          write  SetEncodedBy       ;

    property Languages:        UnicodeString read  GetLanguages          write  SetLanguages       ;

    property SoftwareSettings: UnicodeString read  GetSoftwareSettings   write  SetSoftwareSettings;

    property Mediatype:        UnicodeString read  GetMediatype          write  SetMediatype       ;

    property id3Length:           UnicodeString read  Getid3Length           write Setid3Length          ;

    property Publisher:           UnicodeString read  GetPublisher           write SetPublisher          ;

    property OriginalFilename:    UnicodeString read  GetOriginalFilename    write SetOriginalFilename   ;

    property OriginalLyricist:    UnicodeString read  GetOriginalLyricist    write SetOriginalLyricist   ;

    property OriginalReleaseYear: UnicodeString read  GetOriginalReleaseYear write SetOriginalReleaseYear;

    property OriginalAlbumTitel:  UnicodeString read  GetOriginalAlbumTitel  write SetOriginalAlbumTitel ;





    property FlgUnsynch       : Boolean read fFlgUnsynch write fFlgUnsynch;

    property FlgCompression   : Boolean read fFlgCompression;

    property FlgExtended      : Boolean read fFlgExtended;

    property FlgExperimental  : Boolean read fFlgExperimental;

    property FlgFooterPresent : Boolean read fFlgFooterPresent;

    property FlgUnknown       : Boolean read fFlgUnknown;



    property Size:       LongWord    read fTagSize;

    property Exists:     Boolean     read fExists;      //  two properties twice

    property TagExists:  Boolean     read fExists;      //  due to backward compatibility

    property Padding:    Longword    read fPaddingSize; //

    property PaddingSize:Longword    read fPaddingSize; //



    property Version:    TID3Version read fVersion;

    property UsePadding: Boolean     read fUsePadding write fUsePadding;

    property UseClusteredPadding: Boolean read fUseClusteredPadding write fUseClusteredPadding;



    property  AlwaysWriteUnicode: Boolean read fAlwaysWriteUnicode write fAlwaysWriteUnicode;



    property CharCode: TCodePage read fCharCode write SetCharCode;

    property  AutoCorrectCodepage: Boolean read fAutoCorrectCodepage write SetAutoCorrectCodepage;



    function ReadFromStream(Stream: TStream): TMP3Error;

    function WriteToStream(Stream: TStream): TMP3Error;

    function RemoveFromStream(Stream: TStream): TMP3Error;

    function ReadFromFile(Filename: UnicodeString): TMP3Error;

    function WriteToFile(Filename: UnicodeString): TMP3Error;

    function RemoveFromFile(Filename: UnicodeString): TMP3Error;

    procedure Clear;





    // "Level 2": Some advanced Frames. Get/edit them on Tag-Level

    //           Setting a value to '' will delete the frame

    function GetText(FrameID: TFrameIDs): UnicodeString;

    procedure SetText(FrameID:TFrameIDs; Value: UnicodeString);



    // User defined TextFrames (TXXX)

    function GetUserText(Description: UnicodeString): UnicodeString;

    procedure SetUserText(Description, Value: UnicodeString);



    function GetURL(FrameID: TFrameIDs): AnsiString;

    procedure SetURL(FrameID:TFrameIDs; Value: AnsiString);



    // Comments  (COMM)

    // Note: Delete by Set(..., '');

    procedure SetExtendedComment(Language: AnsiString; Description: UnicodeString; value: UnicodeString);

    function GetExtendedComment(Language: AnsiString; Description: UnicodeString): UnicodeString;



    // Lyrics

    // Note: Delete by Set(..., '');

    procedure SetLyrics(Language: AnsiString; Description: UnicodeString; value: UnicodeString);

    function GetLyrics(Language: AnsiString; Description: UnicodeString): UnicodeString;



    // Pictures (APIC)

    // Note: Delete by setting Stream = Nil

    function GetPicture(stream: TStream; Description: UnicodeString): AnsiString; // R?ckgabe: Mime-Type

    procedure SetPicture(MimeTyp: AnsiString; PicType: Byte; Description: UnicodeString; stream: TStream);



    // User-defined URL (WXXX)

    // Note: Delete by Set(..., '');

    function GetUserDefinedURL(Description: UnicodeString): AnsiString;

    procedure SetUserDefinedURL(Description: UnicodeString; Value: AnsiString);



    // Ratings (POPM)



    // Note: GetRating('*') gets an arbitrary rating (in case more than one exist in the tag)

    function GetRating(aEMail: AnsiString): Byte;

    //procedure SetRating(aEMail: AnsiString; Value: Byte); (method from version 0.5)

    function GetPersonalPlayCounter(aEMail: AnsiString): Cardinal;

    // procedure SetPersonalPlayCounter(aEMail: AnsiString; Value: Cardinal); (method from version 0.5)



    // SetRatingAndCounter('*', .., ..) overwrites an arbitrary rating/counter

    // SetRatingAndCounter(.., -1, ..) lets the rating untouched

    // SetRatingAndCounter(.., .., -1) lets the counter untouched

    // SetRatingAndCounter(.., 0, 0)  deletes the rating/counter-frame

    procedure SetRatingAndCounter(aEMail: AnsiString; aRating: Integer {Byte}; aCounter: Integer{Cardinal});



    // Private Frames

    function GetPrivateFrame(aOwnerID: AnsiString; Content: TStream): Boolean;

    procedure SetPrivateFrame(aOwnerID: AnsiString; Content: TStream);







    // "Level 3": Manipulation on Frame-Level

    //            Be careful with writing on this level

    //            These Methods gives you some lists with different types of frames

    //            See ID3v2Frames.pas how to edit these Frames

    function GetAllFrames: TObjectlist;

    function GetAllTextFrames: TObjectlist;

    function GetAllUserTextFrames: TObjectlist;

    function GetAllCommentFrames: TObjectlist;

    function GetAllLyricFrames: TObjectlist;

    function GetAllUserDefinedURLFrames: TObjectlist;

    function GetAllPictureFrames: TObjectlist;

    function GetAllPopularimeterFrames: TObjectlist;

    function GetAllURLFrames: TObjectlist;

    function GetAllPrivateFrames: TObjectList;



    // Check, wether a new frame is valid, i.e. unique

    function ValidNewCommentFrame(Language: AnsiString; Description: UnicodeString): Boolean;

    function ValidNewLyricFrame(Language: AnsiString; Description: UnicodeString): Boolean;

    function ValidNewPictureFrame(Description: UnicodeString): Boolean;

    function ValidNewUserDefUrlFrame(Description: UnicodeString): Boolean;

    function ValidNewPopularimeterFrame(EMail: AnsiString): Boolean;



    // Get allowed Frame-IDs (not every frame is allowed in every subversion)

    function GetAllowedTextFrames: TList;

    function GetAllowedURLFrames: TList; // WOAR, ... Not the user definied WXXX-Frame



    function AddFrame(aID: TFrameIDs): TID3v2Frame;

    procedure DeleteFrame(aFrame: TID3v2Frame);

  end;

//--------------------------------------------------------------------





//--------------------------------------------------------------------

// Teil 4. Types for MPEG

//--------------------------------------------------------------------



  TMpegHeader = record

    version: byte;

    layer: byte;

    protection: boolean;

    bitrate: LongInt;

    samplerate: LongInt;

    channelmode: byte;

    extension: byte;

    copyright: boolean;

    original: boolean;

    emphasis: byte;

    padding: boolean;

    framelength: word;

    valid: boolean;

  end;



  TXingHeader = record

    Frames: integer;

    Size: integer;

    valid: boolean;

  end;

  TVBRIHeader = TXingHeader;



  TMpegInfo = class(TObject)

  Private

    FFilesize: int64;

    Fversion:integer;

    Flayer:integer;

    Fprotection:boolean;

    Fbitrate:word;

    Fsamplerate:integer;

    Fchannelmode:byte;

    Fextension:byte;

    Fcopyright:boolean;

    Foriginal:boolean;

    Femphasis:byte;

    Fframes:Integer;

    Fdauer:Longint;

    Fvbr:boolean;

    Fvalid: boolean;

    FfirstHeaderPosition: int64;



    // Check, wether there is in aBuffer on position a valid MPEG-header

    function GetValidatedHeader(aBuffer: TBuffer; position: integer): TMpegHeader;

    // Check, wether the MPEG-header is followed by a Xing-Frame

    function GetXingHeader(aMpegheader: TMpegHeader; aBuffer: TBuffer; position: integer ): TXingHeader;

    function GetVBRIHeader(aMpegheader: TMpegHeader; aBuffer: TBuffer; position: integer ): TVBRIHeader;



    function GetFramelength(version:byte;layer:byte;bitrate:integer;Samplerate:integer;padding:boolean):integer;



  public

    constructor create;

    function LoadFromStream(stream: tStream): TMP3Error;

    function LoadFromFile(FileName: UnicodeString): TMP3Error;

    property Filesize: int64          read   FFilesize;

    property Version: integer         read   Fversion;

    property Layer: integer           read   Flayer;

    property Protection: boolean      read   Fprotection;

    property Bitrate: word            read   Fbitrate;

    property Samplerate: integer      read   Fsamplerate;

    property Channelmode: byte        read   Fchannelmode;

    property Extension: byte          read   Fextension;

    property Copyright: boolean       read   Fcopyright;

    property Original: boolean        read   Foriginal;

    property Emphasis: byte           read   Femphasis;

    property Frames: Integer          read   Fframes;

    property Dauer: Longint           read   Fdauer;

    property Duration: Longint        read   Fdauer; // Same as "Dauer" - for the english user ;-)

    property Vbr: boolean             read   Fvbr;

    property Valid: boolean           read   Fvalid;

    property FirstHeaderPosition: int64 read   FfirstHeaderPosition;

  end;







  // Some useful functions.

  // Use them e.g. in OnChange of a TEdit

  function IsValidV2TrackString(value:string):boolean;

  function IsValidV1TrackString(value:string):boolean;

  function IsValidYearString(value:string):boolean;



  // Get a TrackNr. from a ID3v2-Tag-trackstring

  // e.g.: 3/15 => 3

  function GetTrackFromV2TrackString(value: string): Byte;



const



 MPEG_BIT_RATES : array[1..3] of array[1..3] of array[0..15] of word =

  { Version 1, Layer I }

    (((0,32,64,96,128,160,192,224,256,288,320,352,384,416,448,0),

  { Version 1, Layer II }

    (0,32,48,56, 64, 80, 96,112,128,160,192,224,256,320,384,0),

  { Version 1, Layer III }

    (0,32,40,48, 56, 64, 80, 96,112,128,160,192,224,256,320,0)),

  { Version 2, Layer I }

    ((0,32,48, 56, 64, 80, 96,112,128,144,160,176,192,224,256,0),

  { Version 2, Layer II }

    (0, 8,16,24, 32, 40, 48, 56, 64, 80, 96, 112,128,144,160,0),

  { Version 2, Layer III }

    (0, 8,16,24, 32, 40, 48, 56, 64, 80, 96, 112,128,144,160,0)),

  { Version 2.5, Layer I }

    ((0,32,48, 56, 64, 80, 96,112,128,144,160,176,192,224,256,0),

  { Version 2.5, Layer II }

    (0, 8,16,24, 32, 40, 48, 56, 64, 80, 96, 112,128,144,160,0),

  { Version 2.5, Layer III }

    (0, 8,16,24, 32, 40, 48, 56, 64, 80, 96, 112,128,144,160,0)));



  sample_rates: array[1..3] of array [0..3] of word=

    ((44100,48000,32000,0),

    (22050,24000,16000,0),

    (11025,12000,8000,0));

  channel_modes:array[0..3] of string=('Stereo','Joint stereo','Dual channel (Stereo)','Single channel (Mono)');

  extensions:array[1..3] of array [0..3] of string=

    (('bands 4 to 31','bands 8 to 32','bands 12 to 31','bands 16 to 31'),

     ('bands 4 to 31','bands 8 to 32','bands 12 to 31','bands 16 to 31'),

     ('IS:off, MS:off','IS:on, MS:off','IS:off, MS:on','IS:on, MS:on'));

  emphasis_values: array[0..3] of string = ('None', '50/15ms','reserved','CCIT J.17');



  {$Message Hint 'You should change the default rating description for your projects'}

var

  DefaultRatingDescription: AnsiString = 'Mp3ileUtils, www.gausi.de';

  // Changig this should be done e.g. in MainFormCreate or in the initialization-part

  // It should be like "<Name of the program>, <URL to your webpage>"





var

  Genres: TStringList;

  LanguageCodes: TStringlist;

  LanguageNames: TStringlist;





implementation







//--------------------------------------------------------------------

// Some useful functions outside the classes

//--------------------------------------------------------------------



//--------------------------------------------------------------------

//  before Delphi 2009:

//    * String is AnsiString

//    * If no TNTs are used, Delphi cannot handle Unicode-Filenames

//    * If TNTs are used, the following two methods will not be compiled

//      and WideFileExists/-ExtractFileDrive will be the TNT-function with WideString-Parameter

//  Delphi 2009:

//    * TNTs are not used (as Delphi itself can handle Unicode)

//    * String is UnicodeString

//--------------------------------------------------------------------

{$IFNDEF USE_TNT_COMPOS}

function  WideFileExists(aString: string):boolean;

begin

  result := FileExists(aString);

end;



function WideExtractFileDrive(aString: String): string;

begin

  result := ExtractFileDrive(aString);

end;

{$ENDIF}





//--------------------------------------------------------------------

// Check, wether Frame-ID is valid

//--------------------------------------------------------------------

function ValidFrame(ID: AnsiString): Boolean;

var

  i: Cardinal;

begin

  result := true;

  for i := 1 to length(ID) do

    if not (ID[i] in ['0'..'9', 'A'..'Z']) then

    begin

      result := false;

      Break;

    end;

end;



function ValidTextFrame(ID: AnsiString): Boolean;

begin

  result := (length(ID) >= 3) and (ID[1] = 'T');

end;



//--------------------------------------------------------------------

// Convert a 28bit-integer to a 32bit-integer

//--------------------------------------------------------------------

function Int28ToInt32(Value: TInt28): LongWord;

begin

  // Take the rightmost byte and let it there,

  // take the second rightmost byte and move it 7bit to left

  //                                    (in an 32bit-variable)

  // a.s.o.

  result := (Value[3]) shl  0 or

            (Value[2]) shl  7 or

            (Value[1]) shl 14 or

            (Value[0]) shl 21;

end;



//--------------------------------------------------------------------

// Convert a 32bit-integer to a 28bit-integer

//--------------------------------------------------------------------

function Int32ToInt28(Value: LongWord): TInt28;

begin

  // move every byte in Value to the right, take the 7 LSBs

  // and assign them to the result

  Result[3] := (Value shr  0) and $7F;

  Result[2] := (Value shr  7) and $7F;

  Result[1] := (Value shr 14) and $7F;

  Result[0] := (Value shr 21) and $7F;

end;



//--------------------------------------------------------------------

// Get a temporary filename

//--------------------------------------------------------------------

function GetTempFile: String;

var

  Path: String;

  i: Integer;

begin

  SetLength(Path, 256);

  FillChar(PChar(Path)^, 256 * sizeOf(Char), 0);

  GetTempPath(256, PChar(Path));

  Path := Trim(Path);

  if Path[Length(Path)] <> '\' then

    Path := Path + '\';

  i := 0;

  repeat

    result := Path + 'TagTemp.t' + IntToHex(i, 2);

    inc(i);

  until not FileExists(result);

end;





//--------------------------------------------------------------------

// ID3v1 or ID3v1.1 ?

//--------------------------------------------------------------------

function GetID3v1Version(Tag: TID3v1Structure): Byte;

begin

  // If the 29th byte of the comment is =0 an

  // 30th <> 0, then this is the Track-nr.

  if (Tag.Comment[29] = #00) and (Tag.Comment[30] <> #00) then

    result := 1

  else

    result := 0;

end;



//---------------------------------------------------

// check, wether value is a valid track-string for id3v2 ...

//---------------------------------------------------

function IsValidV2TrackString(value:string):boolean;

var

  del: Integer;

  Track, Overall: String;

begin

  del := Pos('/', Value);       // getting the position of the delimiter

  if del = 0 then

    // If there is none, then the whole string is the TrackNumber

    result := (StrToIntDef(Value, -1) > -1)

  else begin

    Overall := Trim(Copy(Value, del + 1, Length(Value) - (del)));

    Track := Trim(Copy(Value, 1, del - 1));

    result := ((StrToIntDef(Track, -1) > -1) AND (StrToIntDef(Overall, -1) > -1))

  end;

end;



//--------------------------------------------------------------------

// ... and for v1

//--------------------------------------------------------------------

function IsValidV1TrackString(value:string):boolean;

begin

  result := (StrToIntDef(Value, -1) > -1);

end;



//--------------------------------------------------------------------

// Check for valid year

//--------------------------------------------------------------------

function IsValidYearString(value:string):boolean;

var tmp:integer;

begin

  tmp := StrToIntDef(Value, -1);

  result := (tmp > -1) AND (tmp < 10000);

end;



//--------------------------------------------------------------------

// Get Track-Nr. from track-string

//--------------------------------------------------------------------

function GetTrackFromV2TrackString(value: string): Byte;

var

  del: Integer;

  Track: String;

begin

  del := Pos('/', Value);       // getting the position of the delimiter

  if del = 0 then

    // If there is none, then the whole string is the TrackNumber

    result := StrToIntDef(Value, 0)

  else begin

    //Overall := Trim(Copy(Value, del + 1, Length(Value) - (del)));

    Track := Trim(Copy(Value, 1, del - 1));

    result := StrToIntDef(Track, 0);

  end;

end;



//--------------------------------------------------------------------

// Get a "reasonable" padding-size (i.e.: fill the last used cluster)

//--------------------------------------------------------------------

function GetPaddingSize(DataSize: Int64; aFilename: UnicodeString; UseClusterSize: Boolean): Cardinal;

var

   Drive: string;

   ClusterSize           : Cardinal;

   SectorPerCluster      : Cardinal;

   BytesPerSector        : Cardinal;

   NumberOfFreeClusters  : Cardinal;

   TotalNumberOfClusters : Cardinal;

begin

  Drive := WideExtractFileDrive(aFileName);

  if UseClusterSize and (trim(Drive) <> '')then

  begin

      if Drive[Length(Drive)]<>'\' then Drive := Drive+'\';

      try

          if GetDiskFreeSpace(PChar(Drive),

                              SectorPerCluster,

                              BytesPerSector,

                              NumberOfFreeClusters,

                              TotalNumberOfClusters) then

            ClusterSize := SectorPerCluster * BytesPerSector

          else

            ClusterSize := 2048;

      except

        ClusterSize := 2048;

      end;

  end else

    ClusterSize := 2048;

  Result := (((DataSize DIV ClusterSize) + 1) * Clustersize) - DataSize;

end;





//--------------------------------------------------------------------

//--------------------------------------------------------------------

//        *** TID3v1Tag ***

//--------------------------------------------------------------------

//--------------------------------------------------------------------





constructor TID3v1Tag.Create;

begin

  inherited Create;

  // Set default-values

  Clear;

  FCharCode := DefaultCharCode;

  AutoCorrectCodepage := False;

end;



destructor TID3v1Tag.destroy;

begin

  inherited destroy;

end;



// Read the Tag from a stream

function TID3v1Tag.ReadFromStream(Stream: TStream): TMP3Error;

var

  RawTag: TID3v1Structure;

begin

  clear;

  result := MP3ERR_None;

  FExists := False;

  try

    Stream.Seek(-128, soFromEnd);

    if (Stream.Read(RawTag, 128) = 128) then

      if (RawTag.ID = 'TAG') then

      begin

        FExists := True;

        FVersion := GetID3v1Version(RawTag);

        FTitle := (RawTag.Title);

        FArtist := (RawTag.Artist);

        FAlbum := (RawTag.Album);

        FYear := (RawTag.Year);

            //String4(Trim(String(FYear)));

        if FVersion = 0 then

        begin

          FComment := (RawTag.Comment);

          FTrack := 0;

        end

        else

        begin

          Move(RawTag.Comment[1], FComment[1], 28);

          FComment[29] := #0;

          FComment[30] := #0;

          FTrack := Ord(RawTag.Comment[30]);

        end;

        FGenre := RawTag.Genre;

      end

      else

        result := ID3ERR_NoTag

    else

      result := MP3ERR_SRead;

  except

    on E: Exception do

    begin

      result := ID3ERR_Unclassified;

      MessageBox(0, PChar(E.Message), PChar('Error'), MB_OK or MB_ICONERROR or MB_TASKMODAL or MB_SETFOREGROUND);

    end;

  end;

end;



// Write Tag to a stream

function TID3v1Tag.WriteToStream(Stream: TStream): TMP3Error;

var

  RawTag: TID3v1Structure;

  Buffer: Array [1..3] of AnsiChar;

begin

  result := MP3ERR_NONE;

  try

    FillChar(RawTag, 128, 0);

    RawTag.ID := 'TAG';

    Move(FTitle[1], RawTag.Title, Length(FTitle));

    Move(FArtist[1], RawTag.Artist, Length(FArtist));

    Move(FAlbum[1], RawTag.Album, Length(FAlbum));

    Move(FYear[1], RawTag.Year, Length(FYear));

    Move(FComment[1], RawTag.Comment, Length(FComment));

    if FTrack > 0 then

    begin

      RawTag.Comment[29] := #0;

      RawTag.Comment[30] := AnsiChar(Chr(FTrack));

    end;

    RawTag.Genre := FGenre;



    // Search for an existing tag and set position to write the new one

    Stream.Seek(-128, soFromEnd);

    Stream.Read(Buffer[1], 3);

    if (Buffer[1]='T') AND (Buffer[2]='A') AND (Buffer[3]='G') then

      Stream.Seek(-128, soFromEnd)

    else

      Stream.Seek(0, soFromEnd);



    if Stream.Write(RawTag, 128) <> 128 then

      result := MP3ERR_SWrite;

  except

    on E: Exception do

    begin

      result := ID3ERR_Unclassified;

      MessageBox(0, PChar(E.Message), PChar('Error'), MB_OK or MB_ICONERROR or MB_TASKMODAL or MB_SETFOREGROUND);

    end;

  end;

end;



// Delete Tag, if existing

function TID3v1Tag.RemoveFromStream(Stream: TStream): TMP3Error;

var

  Buffer: Array [1..3] of AnsiChar;

begin

  result := MP3ERR_NONE;

  try

    Stream.Seek(-128, soFromEnd);

    Stream.Read(Buffer[1], 3);

    if (Buffer[1]='T') AND (Buffer[2]='A') AND (Buffer[3]='G') then

    begin

      Stream.Seek(-128, soFromEnd);

      SetStreamEnd(Stream);

    end

    else

      result := ID3ERR_NoTag;

  except

    on E: Exception do

    begin

      result := ID3ERR_Unclassified;

      MessageBox(0, PChar(E.Message), PChar('Error'), MB_OK or MB_ICONERROR or MB_TASKMODAL or MB_SETFOREGROUND);

    end;

  end;

end;



// Set default-values

procedure TID3v1Tag.Clear;

begin

  FTitle   := String30(StringOfChar(#0, 30));

  FArtist  := String30(StringOfChar(#0, 30));

  FAlbum   := String30(StringOfChar(#0, 30));

  FYear    := String4(StringOfChar(#0, 4));

  FComment := String30(StringOfChar(#0, 30));



  FTrack   := 0;

  FGenre   := 0;

  FVersion := 0;

  FExists  := False;

end;



// read tag from a file

// -> use stream-function

function TID3v1Tag.ReadFromFile(Filename: UnicodeString): TMP3Error;

var

  Stream: TMPFUFileStream;

begin

  if WideFileExists(Filename) then

    try

      Stream := TMPFUFileStream.Create(Filename, fmOpenRead or fmShareDenyWrite);

      try

        result := ReadFromStream(Stream);

      finally

        Stream.Free;

      end;

    except

      result := MP3ERR_FOpenR;

    end

  else

    result := MP3ERR_NoFile;

end;



// Write a tag to a file

// -> use stream-function

function TID3v1Tag.WriteToFile(Filename: UnicodeString): TMP3Error;

var

  Stream: TMPFUFileStream;

begin

  if WideFileExists(Filename) then

    try

      Stream := TMPFUFileStream.Create(Filename, fmOpenReadWrite or fmShareDenyWrite);

      try

        result := WriteToStream(Stream);

      finally

        Stream.Free;

      end;

    except

      result := MP3ERR_FOpenRW;

    end

  else

    result := MP3ERR_NoFile;

end;



// Delete Tag from a file

// -> use stream-function

function TID3v1Tag.RemoveFromFile(Filename: UnicodeString): TMP3Error;

var

  Stream: TMPFUFileStream;

begin

  if WideFileExists(Filename) then

    try

      Stream := TMPFUFileStream.Create(Filename, fmOpenReadWrite or fmShareDenyWrite);

      try

        result := RemoveFromStream(Stream);

      finally

        Stream.Free;

      end;

    except

      result := MP3ERR_FOpenRW;

    end

  else

    result := MP3ERR_NoFile;

end;





// Converts a String[30] to UnicodeString

//   * if AutoCorrectCodepage=True then the conversion is done by the

//     given CodePage

//   * otherwise it will be done by delphi, i.e. the system-codepage

function TID3v1Tag.GetConvertedUnicodeText(Value: String30): UnicodeString;

var

  tmp: AnsiString;

  L: Integer;

begin

    if AutoCorrectCodepage then

    begin

        L := MultiByteToWideChar(FCharCode.CodePage,

                  MB_PRECOMPOSED,  // Flags

                  @Value[1],       // data to convert

                  Length(Value),   // Size in bytes

                  nil,             // output - not used here

                  0);              // 0=> Get required BufferSize



        if L = 0 then

        begin

            // Something's wrong => Fall back to ANSI

            setlength(tmp, 30);

            move(Value[1], tmp[1], 30);

            {$IFDEF UNICODE}

                // use explicit typecast

                result := trim(String(tmp));

            {$ELSE}

                result := trim(tmp);

            {$ENDIF}

        end else

        begin

            // SetBuffer, Size in WChars, not Bytes.

            SetLength(Result, L);

            // Convert

            MultiByteToWideChar(FCharCode.CodePage,

                      MB_PRECOMPOSED,

                      @Value[1],

                      length(Value),

                      @Result[1],

                      L);

            // trim string

            result := Trim(Result);

        end;

    end



    else

    begin

      // copy to AnsiString and typecast

      setlength(tmp,30);

      move(Value[1], tmp[1], 30);

      {$IFDEF UNICODE}

          // use explicit typecast

          result := trim(String(tmp));

      {$ELSE}

          result := trim(tmp);

      {$ENDIF}

    end;

end;



function TID3v1Tag.GetTitle: UnicodeString;

begin

  result := GetConvertedUnicodeText(FTitle);

end;

function TID3v1Tag.GetArtist: UnicodeString;

begin

  result := GetConvertedUnicodeText(FArtist);

end;

function TID3v1Tag.GetAlbum: UnicodeString;

begin

  result := GetConvertedUnicodeText(FAlbum);

end;

function TID3v1Tag.GetComment: UnicodeString;

begin

  result := GetConvertedUnicodeText(FComment);

end;

function TID3v1Tag.GetGenre: String;

begin

  if FGenre <= 125 then

    result := Genres[FGenre]

  else

    result := '';

end;

function TID3v1Tag.GetTrack: String;

begin

  result := IntToStr(FTrack);

end;



function TID3v1Tag.GetYear: String4;

begin

  result := FYear;

end;





// Converts a UnicodeString to String[30]

//   * if AutoCorrectCodepage=True then the conversion is done by the

//     given CodePage

//   * otherwise it will be done by delphi, i.e. the system-codepage

function TID3v1Tag.SetString30(value: UnicodeString): String30;

var i, max, L: integer;

    tmpstr: AnsiString;

begin

    result := String30(StringOfChar(#0, 30));

    if fAutoCorrectCodepage then

    begin



        if length(value) > 0 then

        begin



            L := WideCharToMultiByte(FCharCode.CodePage, // CodePage

                  0, // Flags

                  @Value[1],      // String to Convert

                  -1,//length(Value),  // ... and its length

                  Nil,     // output, not needed here

                  0,       // and its length, 0 to get required length

                  Nil,  // DefaultChar, Nil=SystemDefault

                  Nil);  // DefaultChar needed



            if L = 0 then

            begin

                // Failure, Fall back to Ansi

                tmpstr := AnsiString(value);

                max := length(tmpstr);

                if max > 30 then max := 30;

                for i := 1 to max do

                    result[i] := tmpstr[i];

            end

            else

            begin

                // use a tmp-AnsiString, as the UnicodeString may be longer

                SetLength(tmpstr, L);

              …