Develop and Download Open Source Software

Browse Subversion Repository

Annotation of /Id3v2Frames.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 7 - (hide annotations) (download) (as text)
Sat Aug 15 03:06:09 2015 UTC (8 years, 6 months ago) by yamat0jp
File MIME type: text/x-pascal
File size: 68887 byte(s)
タグ読み取りに使用するユニットを変更しました。現在Androidでは利用できませんが、書き換えをして使えるようにしようと思います。
1 yamat0jp 7 {
2     part of: MP3FileUtils v0.6b
3    
4     -------------------------------------------------------
5    
6     The contents of this file are subject to the Mozilla Public License
7     Version 1.1 (the "License"); you may not use this file except in
8     compliance with the License. You may obtain a copy of the License at
9     http://www.mozilla.org/MPL/
10    
11     Software distributed under the License is distributed on an "AS IS"
12     basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
13     License for the specific language governing rights and limitations
14     under the License.
15    
16     The Original Code is ID3v2Frames, part of MP3FileUtils.
17    
18     The Initial Developer of the Original Code is Daniel Gaussmann,
19     mail@gausi.de. Portions created by the Initial Developer are
20     Copyright (C) 2005-2011 the Initial Developer. All Rights Reserved.
21    
22     Contributor(s): (none yet)
23    
24     Alternatively, the contents of this file may be used under the terms
25     of the GNU Lesser General Public License Version 2.1 or later
26     (the "LGPL"), in which case the provisions of LGPL are applicable
27     instead of those above. If you wish to allow use of your version of
28     this file only under the terms of the LGPL and not to allow others to use
29     your version of this file under the MPL, indicate your decision by
30     deleting the provisions above and replace them with the notice and
31     other provisions required by the LGPL. If you do not delete
32     the provisions above, a recipient may use your version of this file
33     under either the MPL or the LGPL License.
34    
35     -------------------------------------------------------
36     }
37    
38     unit ID3v2Frames;
39    
40     {$I config.inc}
41    
42     interface
43    
44     uses
45     SysUtils, Classes, Windows, U_CharCode
46     {$IFDEF USE_TNT_COMPOS}, TntSysUtils, TntClasses{$ENDIF};
47    
48    
49     type
50    
51     {$IFDEF USE_TNT_COMPOS}
52     TMPFUFileStream = TTNTFileStream;
53     {$ELSE}
54     TMPFUFileStream = TFileStream;
55     {$ENDIF}
56    
57     {$IFNDEF UNICODE}
58     UnicodeString = WideString;
59     {$ENDIF}
60    
61     TID3v2FrameTypes = (FT_INVALID, FT_UNKNOWN,
62     FT_TextFrame,
63     FT_CommentFrame,
64     FT_LyricFrame,
65     FT_UserDefinedURLFrame,
66     FT_PictureFrame,
67     FT_PopularimeterFrame,
68     FT_URLFrame,
69     FT_UserTextFrame
70     );
71    
72     TID3v2FrameVersions = (FV_2 = 2, FV_3, FV_4);
73    
74     // flags in frame-header
75     // the unknown-flags are used to clear the flags on writing
76     TFrameFlags = (FF_TagAlter, FF_FileAlter, FF_ReadOnly, FF_UnknownStatus,
77     FF_Compression, FF_Encryption, FF_GroupID, FF_Unsync, FF_DataLength, FF_UnknownFormat);
78    
79     const TFrameFlagValues : Array [TID3v2FrameVersions] of Array [TFrameFlags] of Byte =
80     (
81     (0,0,0,0,0,0,0,0,0,0), // no flags in subversion 2.2
82     (128, 64, 32, 31, 128, 64, 32, 0, 0, 31 ),
83     (128, 64, 32, 31, 8, 4, 64, 2, 1, 176)
84     );
85     Type TFrameIDs = (
86     IDv2_UNKNOWN,
87     IDv2_MP3FileUtilsExperimental, // WARNING. DO NOT USE THIS FRAME. It's for testing only!
88     // Text-Frames
89     IDv2_ARTIST, IDv2_TITEL, IDv2_ALBUM, IDv2_YEAR, IDv2_GENRE, // ----
90     IDv2_TRACK, IDv2_COMPOSER, IDv2_ORIGINALARTIST, IDv2_COPYRIGHT, IDv2_ENCODEDBY, // ----
91     IDv2_LANGUAGES, IDv2_SOFTWARESETTINGS, IDv2_MEDIATYPE, IDv2_LENGTH, IDv2_PUBLISHER, // ----
92     IDv2_ORIGINALFILENAME, IDv2_ORIGINALLYRICIST, IDv2_ORIGINALRELEASEYEAR, IDv2_ORIGINALALBUMTITEL,// ---- // til here: textframes from mp3fileutils 0.3
93     IDv2_BPM, IDv2_PLAYLISTDELAY, IDv2_FILETYPE, IDv2_INITIALKEY, IDv2_BANDACCOMPANIMENT, // ----
94     IDv2_CONDUCTORREFINEMENT, IDv2_INTERPRETEDBY, IDv2_PARTOFASET, IDv2_ISRC, IDv2_CONTENTGROUPDESCRIPTION, // ----
95     IDv2_SUBTITLEREFINEMENT, IDv2_LYRICIST, IDv2_FILEOWNER, IDv2_INTERNETRADIONAME, IDv2_INTERNETRADIOOWNER, // ----
96     // following textframes exists only in subversion 2.4
97     IDv2_ENCODINGTIME, IDv2_RECORDINGTIME, IDv2_RELEASETIME, IDv2_TAGGINGTIME, IDv2_MUSICIANCREDITLIST, //----
98     IDv2_MOOD, IDv2_PRODUCEDNOTICE, IDv2_ALBUMSORTORDER, IDv2_PERFORMERSORTORDER, IDv2_TITLESORTORDER, IDv2_SETSUBTITLE,
99     //---
100     // User-defined Text-Frames
101     IDv2_USERDEFINEDTEXT,
102     //----//----//----
103     // URL-Frames
104     IDv2_AUDIOFILEURL, IDv2_ARTISTURL, IDv2_AUDIOSOURCEURL, IDv2_COMMERCIALURL, IDv2_COPYRIGHTURL,
105     IDv2_PUBLISHERSURL, IDv2_RADIOSTATIONURL, IDv2_PAYMENTURL,
106     //----//----
107     // more Frames
108     IDv2_PICTURE, IDv2_LYRICS, IDv2_COMMENT, IDv2_RATING, IDv2_USERDEFINEDURL, IDv2_RECOMMENDEDBUFFERSIZE, //----
109     IDv2_PLAYCOUNTER, IDv2_AUDIOENCRYPTION, IDv2_EVENTTIMINGCODES, IDv2_EQUALIZATION, IDv2_GENERALOBJECT, //----
110     IDv2_LINKEDINFORMATION, IDv2_MUSICCDID, IDv2_MPEGLOOKUPTABLE, IDv2_REVERB, IDv2_VOLUMEADJUSTMENT, //----
111     IDv2_SYNCHRONIZEDLYRICS, IDv2_SYNCEDTEMPOCODES, IDv2_UNIQUEFILEID,
112     // Frames, which exists only in some subversions
113     IDv2_COMMERCIALFRAME, IDv2_ENCRYPTIONMETHODREGISTRATION, IDv2_GROUPIDREGISTRATION, IDv2_OWNERSHIP,
114     IDv2_PRIVATE, IDv2_POSITIONSYNCHRONISATION, IDv2_TERMSOFUSE, IDv2_SEEKPOINTINDEX, IDv2_SEEKFRAME,
115     IDv2_SIGNATURE,
116     // more frames, should NOT be created
117     IDv2_INVOLVEDPEOPLE, IDv2_ENCRYPTEDMETAFRAME, IDv2_RECORDINGDATES, IDv2_DATE, IDv2_TIME, IDv2_SIZE
118     ) ;
119    
120    
121     type
122    
123     TTextEncoding = (TE_Ansi, TE_UTF16, TE_UTF16BE, UTF8);
124    
125     // Type for this one big const-array "ID3v2KnownFrames" (scroll down to see it)
126     TID3v2FrameDescriptionData = record
127     IDs: Array[TID3v2FrameVersions] of AnsiString; // MUST be AnsiString
128     Description: String; // Doesn't matter, use Delphi-Default
129     end;
130    
131    
132     TBuffer = Array of byte;
133    
134     TID3v2Frame = class(TObject)
135     private
136    
137     fVersion: TID3v2FrameVersions; //(2,3,4)
138     fIDString: AnsiString; // e.g. 'TALB', must be AnsiString
139     fID: TFrameIDs; // e.G. IDv2_ARTIST
140     fHeader: TBuffer;
141     fData: TBuffer;
142     fGroupID: Byte;
143     fDataLength: Integer; // this is the size given in v2.4, in case the according flag is set
144    
145     fAlwaysWriteUnicode: Boolean;
146     fAutoCorrectCodepage: Boolean; // formerly fAcceptAllEncodings
147     fCharCode: TCodePage;
148    
149     fParsable: Boolean;
150    
151     function ValidFrameID: Boolean;
152     function GetFrameType: TID3v2FrameTypes; // Textframe, URLFrame, Picture-Frame, etc...
153     function GetFrameTypeDescription: String; // Description of content according to ID3.org
154     // use Delphi-Default-String, its just for displaying the info
155     function GetFrameTypeID: TFrameIDs;
156    
157     // Get teh flags of the frame
158     // "Unimportant Flags"
159     // Note for future versions: Do what they want me to do ;-)
160     function GetFlagTagAlterPreservation: Boolean;
161     function GetFlagFileAlterPreservation: Boolean;
162     function GetFlagReadOnly: Boolean;
163     // "Important Flags", they change the way how the frame must be parsed
164     function GetFlagCompression: Boolean;
165     function GetFlagEncryption : Boolean;
166     function GetFlagGroupingIdentity : Boolean;
167     procedure SetFlagGroupingIdentity(Value: Boolean);
168     function GetFlagUnsynchronisation : Boolean;
169     function GetFlagDataLengthIndicator : Boolean;
170     function GetUnknownStatusFlags: Boolean;
171     function GetUnknownEncodingFlags: Boolean;
172    
173     procedure SetFlag(aFlag: TFrameFlags);
174     procedure UnSetFlag(aFlag: TFrameFlags);
175    
176     procedure UnSetFlagSomeFlagsAfterDataSet;
177    
178     function GetDataSize: Integer;
179    
180     procedure SyncStream(Source, Target: TStream; aSize: Integer);
181     procedure UpdateHeader(aSize: Integer = -1); // Update the size-field in frame-header
182    
183     function IsUnicodeNeeded(aString: UnicodeString): Boolean; // Must be Unicodestring - otherwise senseless. ;-)
184    
185     // Reads Bytes from "Start" to "Ende" into an UnicodeString
186     // Must be UnicodeString
187     function GetConvertedUnicodeText(Start, Ende: integer; TextEncoding: TTextEncoding): UnicodeString;
188     // Write Value to fData
189     function WideStringToData(Value: UnicodeString; start: integer; UnicodeIsNeeded: Boolean): integer;
190     function AnsiStringToData(Value: AnsiString; start: integer): integer;
191    
192     public
193     property FrameType: TID3v2FrameTypes read GetFrameType;
194     property FrameTypeDescription: String read GetFrameTypeDescription; // Delphi-Default-String
195     property FrameIDString: AnsiString read fIDString; // Must be AnsiString
196     property FrameID: TFrameIDs read GetFrameTypeID;
197    
198     property FlagTagAlterPreservation : Boolean read GetFlagTagAlterPreservation;
199     property FlagFileAlterPreservation: Boolean read GetFlagFileAlterPreservation;
200     property FlagReadOnly : Boolean read GetFlagReadOnly;
201    
202     property FlagCompression : Boolean read GetFlagCompression;
203     property FlagEncryption : Boolean read GetFlagEncryption;
204     property FlagGroupingIndentity : Boolean read GetFlagGroupingIdentity write SetFlagGroupingIdentity;
205     property FlagUnsynchronisation : Boolean read GetFlagUnsynchronisation;
206     property FlagDataLengthIndicator : Boolean read GetFlagDataLengthIndicator;
207     property FlagUnknownStatus : Boolean read GetUnknownStatusFlags;
208     property FlagUnknownEncoding : Boolean read GetUnknownEncodingFlags;
209    
210     property GroupID : Byte read fGroupID write fGroupID;
211    
212     // The size of Data after a Re-Synchronisation
213     // On Parsable-Frames: GroupID and DataLength are NOT included,
214     // otherwise included
215     property DataSize : Integer read GetDataSize;
216    
217     property AlwaysWriteUnicode: Boolean read fAlwaysWriteUnicode write fAlwaysWriteUnicode;
218    
219     property CharCode: TCodePage read fCharCode write fCharCode;
220     property AutoCorrectCodepage: Boolean read fAutoCorrectCodepage write fAutoCorrectCodepage;
221    
222     constructor Create(aID: AnsiString; aVersion: TID3v2FrameVersions); // must be AnsiString
223    
224     procedure ReadFromStream(aStream: tStream); // Note: Read only data - Header is already readed
225     procedure WriteToStream(aStream: tStream); // Write (including header)
226     // WARNING: Use WriteUnsyncedToStream ONLY FOR subversion 2.4 !
227     // on 2.2/2.3 unsynchronisation is done on Tag-Level, i.e. frames will
228     // be written NOT unsynched
229     procedure WriteUnsyncedToStream(aStream: TStream);
230    
231     // Texts, Lyrics: Unicode
232     // Language-IDs, Mime: Ansi
233     // Descriptions: Unicode
234     // URLs: Ansi
235     function GetText: UnicodeString;
236     procedure SetText(Value: UnicodeString);
237    
238     function GetUserText(out Description: UnicodeString): UnicodeString;
239     procedure SetUserText(Description, Value: UnicodeString);
240    
241     function GetCommentsLyrics(out Language: AnsiString; out Description: UnicodeString): UnicodeString;
242     procedure SetCommentsLyrics(Language: AnsiString; Description, Value: UnicodeString);
243    
244     function GetUserdefinedURL(out Description: UnicodeString): AnsiString;
245     procedure SetUserdefinedURL(Description: UnicodeString; URL: AnsiString);
246    
247     function GetURL: AnsiString;
248     procedure SetURL(Value: AnsiString);
249    
250     function GetPicture(out Mime: AnsiString; out PicType: Byte; out Description: UnicodeString; PictureData: TStream): Boolean;
251     procedure SetPicture(Mime: AnsiString; PicType: Byte; Description: UnicodeString; PictureData: TStream);
252    
253     function GetRating(out UserEMail: AnsiString): Byte;
254     procedure SetRating(UserEMail: AnsiString; Value: Byte);
255    
256     // PersonalCounter:
257     // This is the Counter within the Popularimeter(=Rating)-Frames
258     // NOT the PCNT-Frame!
259     function GetPersonalPlayCounter(out UserEMail: AnsiString): Cardinal;
260     procedure SetPersonalPlayCounter(UserEMail: AnsiString; Value: Cardinal);
261    
262     // Private Frames
263     function GetPrivateFrame(out OwnerID: AnsiString; Data: TStream): Boolean;
264     procedure SetPrivateFrame(aOwnerID: AnsiString; Data: TStream);
265    
266     procedure GetData(Data: TStream);
267     // WARNING. Use SetData only, when you exactly know what you are doing
268     // Seriously. Do not use it!
269     procedure SetData(Data: TStream);
270     end;
271    
272    
273    
274    
275    
276     const ID3v2KnownFrames : Array[TFrameIDs] of TID3v2FrameDescriptionData =
277    
278     ( // DO NOT CHANGE ORDER (without changing the enum-type as well)
279     // Text-Frames
280     ( IDs: ('XXX', 'XXXX', 'XXXX') ; Description : 'Unknown/experimental Frame'),
281     ( IDs: ('XMP', 'XMP3', 'XMP3') ; Description : 'Mp3FileUtils experimental Frame'),
282     ( IDs: ('TP1', 'TPE1', 'TPE1') ; Description : 'Lead artist(s)/Lead performer(s)/Soloist(s)/Performing group'),
283     ( IDs: ('TT2', 'TIT2', 'TIT2') ; Description : 'Title/Songname/Content description'),
284     ( IDs: ('TAL', 'TALB', 'TALB') ; Description : 'Album/Movie/Show title'),
285     ( IDs: ('TYE', 'TYER', 'TDRC') ; Description : 'Year'),
286     ( IDs: ('TCO', 'TCON', 'TCON') ; Description : 'Content type'),
287     // ----
288     ( IDs: ('TRK', 'TRCK', 'TRCK') ; Description : 'Track number/Position in set'),
289     ( IDs: ('TCM', 'TCOM', 'TCOM') ; Description : 'Composer'),
290     ( IDs: ('TOA', 'TOPE', 'TOPE') ; Description : 'Original artist(s)/performer(s)'),
291     ( IDs: ('TCR', 'TCOP', 'TCOP') ; Description : 'Copyright message'),
292     ( IDs: ('TEN', 'TENC', 'TENC') ; Description : 'Encoded by'),
293     // ----
294     ( IDs: ('TLA', 'TLAN', 'TLAN') ; Description : 'Language(s)'),
295     ( IDs: ('TSS', 'TSSE', 'TSSE') ; Description : 'Software/hardware and settings used for encoding'),
296     ( IDs: ('TMT', 'TMED', 'TMED') ; Description : 'Media type'),
297     ( IDs: ('TLE', 'TLEN', 'TLEN') ; Description : 'Length'),
298     ( IDs: ('TPB', 'TPUB', 'TPUB') ; Description : 'Publisher'),
299     // ----
300     ( IDs: ('TOF', 'TOFN', 'TOFN') ; Description : 'Original filename'),
301     ( IDs: ('TOL', 'TOLY', 'TOLY') ; Description : 'Original Lyricist(s)/text writer(s)'),
302     ( IDs: ('TOR', 'TORY', 'TDOR') ; Description : 'Original release year'),
303     ( IDs: ('TOT', 'TOAL', 'TOAL') ; Description : 'Original album/Movie/Show title'),
304     // ----//til here textframes existed in mp3fileutils 0.3
305     ( IDs: ('TBP', 'TBPM', 'TBPM') ; Description : 'BPM (Beats Per Minute)'),
306     ( IDs: ('TDY', 'TDLY', 'TDLY') ; Description : 'Playlist delay'),
307     ( IDs: ('TFT', 'TFLT', 'TFLT') ; Description : 'File type'),
308     ( IDs: ('TKE', 'TKEY', 'TKEY') ; Description : 'Initial key'),
309     ( IDs: ('TP2', 'TPE2', 'TPE2') ; Description : 'Band/Orchestra/Accompaniment'),
310     // ----
311     ( IDs: ('TP3', 'TPE3', 'TPE3') ; Description : 'Conductor/Performer refinement'),
312     ( IDs: ('TP4', 'TPE4', 'TPE4') ; Description : 'Interpreted, remixed, or otherwise modified by'),
313     ( IDs: ('TPA', 'TPOS', 'TPOS') ; Description : 'Part of a set'),
314     ( IDs: ('TRC', 'TSRC', 'TSRC') ; Description : 'ISRC (International Standard Recording Code)'),
315     ( IDs: ('TT1', 'TIT1', 'TIT1') ; Description : 'Content group description'),
316     // ----
317     ( IDs: ('TT3', 'TIT3', 'TIT3') ; Description : 'Subtitle/Description refinement'),
318     ( IDs: ('TXT', 'TEXT', 'TEXT') ; Description : 'Lyricist/text writer'),
319     ( IDs: ('---', 'TOWN', 'TOWN') ; Description : 'File owner/licensee'),
320     ( IDs: ('---', 'TRSN', 'TRSN') ; Description : 'Internet radio station name'),
321     ( IDs: ('---', 'TRSO', 'TRSO') ; Description : 'Internet radio station owner'),
322     // ----
323     ( IDs: ('---', '----', 'TDEN') ; Description : 'Encoding time'),
324     ( IDs: ('---', '----', 'TDRC') ; Description : 'Recording time'),
325     ( IDs: ('---', '----', 'TDRL') ; Description : 'Release time'),
326     ( IDs: ('---', '----', 'TDTG') ; Description : 'Tagging time'),
327     ( IDs: ('---', '----', 'TMCL') ; Description : 'Musician credits list'),
328     //----
329     ( IDs: ('---', '----', 'TMOO') ; Description : 'Mood'),
330     ( IDs: ('---', '----', 'TPRO') ; Description : 'Produced notice'),
331     ( IDs: ('---', '----', 'TSOA') ; Description : 'Album sort order'),
332     ( IDs: ('---', '----', 'TSOP') ; Description : 'Performer sort order'),
333     ( IDs: ('---', '----', 'TSOT') ; Description : 'Title sort order'),
334     ( IDs: ('---', '----', 'TSST') ; Description : 'Set subtitle'),
335     ( IDs: ('TXX', 'TXXX', 'TXXX') ; Description : 'User defined text information frame'),
336     //----//----//----
337     // URL-Frames
338     ( IDs: ('WAF', 'WOAF', 'WOAF') ; Description : 'Official audio file webpage'),
339     ( IDs: ('WAR', 'WOAR', 'WOAR') ; Description : 'Official artist/performer webpage'),
340     ( IDs: ('WAS', 'WOAS', 'WOAS') ; Description : 'Official audio source webpage'),
341     ( IDs: ('WCM', 'WCOM', 'WCOM') ; Description : 'Commercial information'),
342     ( IDs: ('WCP', 'WCOP', 'WCOP') ; Description : 'Copyright/Legal information'),
343     ( IDs: ('WPB', 'WPUB', 'WPUB') ; Description : 'Publishers official webpage'),
344     ( IDs: ('---', 'WORS', 'WORS') ; Description : 'Official internet radio station homepage'),
345     ( IDs: ('---', 'WPAY', 'WPAY') ; Description : 'Payment'),
346     // more Frames
347     ( IDs: ('PIC', 'APIC', 'APIC') ; Description : 'Attached picture'),
348     ( IDs: ('ULT', 'USLT', 'USLT') ; Description : 'Unsychronized lyric/text transcription'),
349     ( IDs: ('COM', 'COMM', 'COMM') ; Description : 'Comments'),
350     ( IDs: ('POP', 'POPM', 'POPM') ; Description : 'Popularimeter'),
351     ( IDs: ('WXX', 'WXXX', 'WXXX') ; Description : 'User defined URL link frame'),
352     ( IDs: ('BUF', 'RBUF', 'RBUF') ; Description : 'Recommended buffer size'),
353     //----
354     ( IDs: ('CNT', 'PCNT', 'PCNT') ; Description : 'Play counter'),
355     ( IDs: ('CRA', 'AENC', 'AENC') ; Description : 'Audio encryption'),
356     ( IDs: ('ETC', 'ETCO', 'ETCO') ; Description : 'Event timing codes'),
357     ( IDs: ('EQU', 'EQUA', 'EQU2') ; Description : 'Equalization'),
358     ( IDs: ('GEO', 'GEOB', 'GEOB') ; Description : 'General encapsulated object'),
359     //----
360     ( IDs: ('LNK', 'LINK', 'LINK') ; Description : 'Linked information'),
361     ( IDs: ('MCI', 'MCDI', 'MCDI') ; Description : 'Music CD Identifier'),
362     ( IDs: ('MLL', 'MLLT', 'MLLT') ; Description : 'MPEG location lookup table'),
363     ( IDs: ('REV', 'RVRB', 'RVRB') ; Description : 'Reverb'),
364     ( IDs: ('RVA', 'RVAD', 'RVA2') ; Description : 'Relative volume adjustment'),
365     //----
366     ( IDs: ('SLT', 'SYLT', 'SYLT') ; Description : 'Synchronized lyric/text'),
367     ( IDs: ('STC', 'SYTC', 'SYTC') ; Description : 'Synced tempo codes'),
368     ( IDs: ('UFI', 'UFID', 'UFID') ; Description : 'Unique file identifier'),
369     // Frames, which do not exist in every subversion
370     ( IDs: ('---', 'COMR', 'COMR') ; Description : 'Commercial frame'),
371     ( IDs: ('---', 'ENCR', 'ENCR') ; Description : 'Encryption method registration'),
372     ( IDs: ('---', 'GRID', 'GRID') ; Description : 'Group identification registration'),
373     ( IDs: ('---', 'OWNE', 'OWNE') ; Description : 'Ownership frame'),
374     // Note: PRV is not defined in ID3v2.2! I added this by myself!
375     ( IDs: ('PRV', 'PRIV', 'PRIV') ; Description : 'Private frame'),
376     ( IDs: ('---', 'POSS', 'POSS') ; Description : 'Position synchronisation frame'),
377     ( IDs: ('---', 'USER', 'USER') ; Description : 'Terms of use'),
378     ( IDs: ('---', '----', 'ASPI') ; Description : 'Audio seek point index'),
379     ( IDs: ('---', '----', 'SEEK') ; Description : 'Seek frame'),
380     ( IDs: ('---', '----', 'SIGN') ; Description : 'Signature frame'),
381     // even more Frames, deprecated, do not create
382     ( IDs: ('IPL', 'IPLS', 'TIPL') ; Description : 'Involved people list'),
383     ( IDs: ('CRM', '----', '----') ; Description : 'Encrypted meta frame'),
384     ( IDs: ('TRD', 'TRDA', '----') ; Description : 'Recording dates'),
385     ( IDs: ('TDA', 'TDAT', '----') ; Description : 'Date'),
386     ( IDs: ('TIM', 'TIME', '----') ; Description : 'Time'),
387    
388     ( IDs: ('TSI', 'TSIZ', '----') ; Description : 'Size')
389     );
390    
391     Picture_Types: Array[0..20] of string = // Delphi-Default-String. Doesn't matter
392     ( 'Other',
393     '32x32 pixels file icon (PNG only)',
394     'Other file icon',
395     'Cover (front)',
396     'Cover (back)',
397     'Leaflet page',
398     'Media (e.g. lable side of CD)',
399     'Lead artist/lead performer/soloist',
400     'Artist/performer',
401     'Conductor',
402     'Band/Orchestra',
403     'Composer',
404     'Lyricist/text writer',
405     'Recording Location',
406     'During recording',
407     'During performance',
408     'Movie/video screen capture',
409     'A bright coloured fish',
410     'Illustration',
411     'Band/artist logotype',
412     'Publisher/Studio logotype' );
413    
414    
415     function UnSyncStream(Source, Target: TStream): Boolean;
416     procedure SetStreamEnd(aStream: TStream);
417    
418     implementation
419    
420     function ByteToTextEncoding(Value: Byte): TTextEncoding;
421     begin
422     case Value of
423     0: result := TE_Ansi;
424     1: result := TE_UTF16;
425     2: result := TE_UTF16BE;
426     3: result := UTF8
427     else
428     result := TE_Ansi;
429     end;
430     end;
431    
432     // Delete Syncs from the Stream.
433     // i.e. FF Ex => FF 00 Ex (FF E: Mpeg-Header-Identifier)
434     // FF 00 => FF 00 00
435     // return value:
436     // True: changes were necessary
437     // False: no changes
438     function UnSyncStream(Source, Target: TStream): Boolean;
439     var buf: TBuffer;
440     i, last: Int64;
441     const
442     zero: byte = 0;
443     begin
444     result := false;
445     setlength(buf, Source.Size);
446     Source.Read(buf[0], length(buf));
447     i := 0;
448     last := 0;
449    
450     while i <= length(buf)-1 do
451     begin
452     While (i < length(buf)-2)
453     and
454     ( (buf[i] <> $FF)
455     or
456     ( (buf[i+1] <> $00) and (buf[i+1] < $E0) )
457     )
458     do
459     inc(i);
460    
461     // buf[i] buf[i+1] is $FF Ex or $FF 00
462     if (buf[i] = $FF) and
463     ( (buf[i+1] = $00) or (buf[i+1] >= $E0) )
464     then
465     begin
466     // critical position found - unsynch it!
467     Target.Write(buf[last], i - last + 1);
468     Target.Write(zero, SizeOf(Zero));
469     last := i + 1;
470     inc(i, 1); // i.e. last = i
471     result := True;
472     end else
473     begin
474     // End of Stream
475     Target.Write(buf[last], length(buf) - last);
476     // if last byte = $FF: Append $00
477     if buf[length(buf)-1] = $FF then
478     begin
479     result := True;
480     Target.Write(zero, SizeOf(Zero));
481     end;
482     i := length(buf);
483    
484     end;
485     end;
486     end;
487    
488     //--------------------------------------------------------------------
489     // Set end of Stream
490     //--------------------------------------------------------------------
491     procedure SetStreamEnd(aStream: TStream);
492     begin
493     if aStream is THandleStream then
494     SetEndOfFile((aStream as THandleStream).Handle)
495     else
496     if aStream is TMemoryStream then
497     TMemoryStream(aStream).SetSize(aStream.Position);
498     end;
499    
500    
501    
502     constructor TID3v2Frame.Create(aID: AnsiString; aVersion: TID3v2FrameVersions);
503     begin
504     inherited Create;
505     fVersion := aVersion;
506     fIDString := aID;
507     fID := IDv2_UNKNOWN;
508     fParsable := True;
509     if fVersion = FV_2 then
510     begin
511     Setlength(fHeader, 6);
512     if not ValidFrameID then
513     fIDString := 'XXX';
514     end
515     else
516     begin
517     Setlength(fHeader, 10);
518     if not ValidFrameID then
519     fIDString := 'XXXX';
520     end;
521    
522     move(fIDString[1], fHeader[0], length(fIDString));
523    
524     fAlwaysWriteUnicode := False;
525     fCharCode := DefaultCharCode;
526     fAutoCorrectCodepage := False;
527     end;
528    
529     // similar to Tag.SyncStream
530     procedure TID3v2Frame.SyncStream(Source, Target: TStream; aSize: Integer);
531     var buf: TBuffer;
532     i, last: Int64;
533     begin
534     setlength(buf, aSize);
535     Source.Read(buf[0], aSize);
536     Target.Size := aSize;
537     i := 0;
538     last := 0;
539     while i <= length(buf)-1 do
540     begin
541     While (i < length(buf)-2) and ((buf[i] <> $FF) or (buf[i+1] <> $00)) do
542     inc(i);
543     // i ist hier maximal length(buf)-2, d.h. buf[i] ist das vorletzte g�Etige Element
544     // oder buf[i] = 255 und buf[i+1] = 0
545     // also: vom letzten Fund bis zu i in den neuen Stream kopieren und buf[i+1] �Eerspringen
546     if (buf[i] = $FF) and (buf[i+1] = $00) then
547     begin
548     Target.Write(buf[last], i - last + 1);
549     last := i + 2;
550     inc(i, 2); // d.h. last = i
551     end else
552     begin
553     // wir sind am Ende des Streams und haben da kein FF 00
554     Target.Write(buf[last], length(buf) - last);
555     i := length(buf); // End.
556     end;
557     end;
558     SetStreamEnd(Target);
559     end;
560    
561    
562    
563     procedure TID3v2Frame.ReadFromStream(aStream: tStream);
564     var locSize: Integer;
565     DataOffset: Integer;
566     SyncedStream: TStream;
567     begin
568     // Note: IDStr was read by mp3fileutils in the TID3v2Tag.ReadFrames-method
569     locSize := 0;
570     fParsable := True;
571     // read the rest of the header
572     aStream.Read(fHeader[length(fIDString)], length(fHeader) - length(fIDString));
573     case fVersion of
574     FV_2: begin locSize := 65536 * fHeader[3]
575     + 256 * fHeader[4]
576     + fHeader[5];
577     fParsable := True;
578     // no Header-Flags
579     end;
580     FV_3: begin locSize := 16777216 * fHeader[4]
581     + 65536 * fHeader[5]
582     + 256 * fHeader[6]
583     + fHeader[7];
584     if (fHeader[9] and $DF) <> 0 then
585     // frame is not readable for mp3fileUtils
586     // (Compression or Encryption are used)
587     fParsable := False;
588     end;
589     FV_4: begin locSize := 2097152 * fHeader[4]
590     + 16384 * fHeader[5]
591     + 128 * fHeader[6]
592     + fHeader[7];
593     if (fHeader[9] and $BC) <> 0 then
594     // frame is not readable for mp3fileUtils
595     // (Compression or Encryption are used)
596     fParsable := False;
597     end;
598     end;
599    
600     // read data
601     // first: eventually synch . (yes, GroupID and other stuff has been unsynched, too!)
602     if FlagUnsynchronisation then
603     begin
604     SyncedStream := TMemoryStream.Create;
605     SyncStream(aStream, SyncedStream, locSize);
606     locSize := SyncedStream.Size;
607     SyncedStream.Position := 0;
608     end else
609     SyncedStream := aStream;
610    
611     DataOffset := 0;
612     if fParsable then
613     begin
614     if FlagGroupingIndentity then
615     begin
616     inc(DataOffset);
617     SyncedStream.Read(fGroupID, SizeOf(fGroupID));
618     end;
619     if FlagDataLengthIndicator then
620     begin
621     inc(DataOffset, 4);
622     SyncedStream.Read(fDataLength, SizeOf(fDataLength));
623     end;
624     SetLength(fData, locSize - DataOffset);
625     if length(fData) <> 0 then
626     SyncedStream.ReadBuffer(fData[0], length(fData))
627     else
628     fData := NIL;
629     end else
630     begin
631     // read data as the are
632     SetLength(fData, SyncedStream.Size);
633     if length(fData) <> 0 then
634     SyncedStream.ReadBuffer(fData[0], length(fData))
635     else
636     fData := NIL;
637     end;
638    
639     if aStream <> SyncedStream then
640     SyncedStream.Free;
641     end;
642    
643     // note: after reading the situation is as follows
644     // if the frame is parsable (i.e. not encrypted and not compressed)
645     // fData contains just the data of the frame. Datalength-Indicator and Group-ID
646     // are stored separately.
647     // If it is not parsable, "everything" is contained in fData
648    
649     procedure TID3v2Frame.WriteToStream(aStream: tStream);
650     begin
651     //No unsynchronisation here (use WriteUnsyncedToStream instead)
652     UnsetFlag(FF_Unsync);
653    
654     if fParsable then
655     begin
656     UnsetFlag(FF_DataLength); // do not write DataLength
657    
658     if FlagGroupingIndentity then
659     Updateheader(length(fData) + 1);
660     // write Header
661     aStream.WriteBuffer(fHeader[0],length(fHeader));
662     // write GroupID (if flag is set)
663     if FlagGroupingIndentity then
664     aStream.Write(fGroupID, SizeOf(fGroupID));
665     // write data
666     aStream.WriteBuffer(fData[0],length(fData));
667     end else
668     begin
669     UpdateHeader; // note: maybe changes in unsynch
670     // write Header
671     aStream.WriteBuffer(fHeader[0],length(fHeader));
672     // write data
673     aStream.WriteBuffer(fData[0],length(fData));
674     end;
675     end;
676    
677     procedure TID3v2Frame.WriteUnsyncedToStream(aStream: TStream);
678     var tmpStream, UnsyncedStream: TMemoryStream;
679     begin
680     UnsyncedStream := TMemoryStream.Create;
681     tmpStream := TMemoryStream.Create;
682    
683     if fParsable then
684     begin
685     UnsetFlag(FF_DataLength);
686    
687     if FlagGroupingIndentity then
688     tmpStream.Write(fGroupID, SizeOf(fGroupID));
689    
690     tmpStream.WriteBuffer(fData[0],length(fData));
691     tmpStream.Position := 0;
692    
693     // Set flag only if changes are neccessary in the stream
694     if UnsyncStream(tmpStream, UnsyncedStream) then
695     begin
696     SetFlag(FF_Unsync)
697     end else
698     UnSetFlag(FF_Unsync);
699    
700     UpdateHeader(UnsyncedStream.Size);
701     aStream.WriteBuffer(fHeader[0],length(fHeader));
702     aStream.CopyFrom(UnsyncedStream, 0);
703    
704     end else
705     begin
706     tmpStream.WriteBuffer(fData[0],length(fData));
707     tmpStream.Position := 0;
708     if UnsyncStream(tmpStream, UnsyncedStream) then
709     begin
710     SetFlag(FF_Unsync)
711     end else
712     UnsetFlag(FF_Unsync);
713    
714     UpdateHeader(UnsyncedStream.Size);
715     aStream.WriteBuffer(fHeader[0],length(fHeader));
716     aStream.CopyFrom(UnsyncedStream, 0);
717     end;
718     UnsyncedStream.Free;
719     tmpStream.Free;
720     end;
721    
722    
723     // Basic Validation. A Frame-ID consists only of capital letters A..Z and numbers 0..9
724     function TID3v2Frame.ValidFrameID: Boolean;
725     var i: Integer;
726     begin
727     result := True;
728     if ((fVersion = FV_2) and (length(fIDString) <> 3))
729     OR
730     ((fVersion <> FV_2) and (length(fIDString) <> 4)) then
731     begin
732     result := False;
733     exit;
734     end;
735    
736     for i := 1 to length(fIDString) do
737     if not (fIDString[i] in ['0'..'9', 'A'..'Z']) then
738     begin
739     result := False;
740     Break;
741     end;
742     end;
743    
744    
745     function TID3v2Frame.GetFrameType: TID3v2FrameTypes;
746     begin
747     if Not ValidFrameID then
748     begin
749     result := FT_INVALID;
750     exit;
751     end;
752    
753     case self.fVersion of
754     FV_2: begin
755     if (fIDString[1] = 'T') and (fIDString <> 'TXX') then
756     result := FT_TextFrame
757     else
758     if (fIDString = 'TXX') then
759     result := FT_UserTextFrame
760     else
761     if (fIDString = 'WXX') then
762     result := FT_UserDefinedURLFrame
763     else
764     if (fIDString = 'COM') then
765     result := FT_CommentFrame
766     else
767     if (fIDString = 'ULT') then
768     result := FT_LyricFrame
769     else
770     if (fIDString = 'PIC') then
771     result := FT_PictureFrame
772     else
773     if (fIDString = 'POP') then
774     result := FT_PopularimeterFrame
775     else
776     if (fIDString = 'WCM') OR (fIDString = 'WCP') OR (fIDString = 'WAF') OR
777     (fIDString = 'WAR') OR (fIDString = 'WAS') OR (fIDString = 'WPB') then
778     result := FT_URLFrame
779     else
780     result := FT_UNKNOWN;
781     end
782     else begin
783     if (fIDString[1] = 'T') and (fIDString <> 'TXXX') then
784     result := FT_TextFrame
785     else
786     if (fIDString = 'TXXX') then
787     result := FT_UserTextFrame
788     else
789     if (fIDString = 'WXXX') then
790     result := FT_UserDefinedURLFrame
791     else
792     if (fIDString = 'COMM') then
793     result := FT_CommentFrame
794     else
795     if (fIDString = 'USLT') then
796     result := FT_LyricFrame
797     else
798     if (fIDString = 'APIC') then
799     result := FT_PictureFrame
800     else
801     if (fIDString = 'POPM') then
802     result := FT_PopularimeterFrame
803     else
804     if (fIDString = 'WCOM') OR (fIDString = 'WCOP') OR (fIDString = 'WOAF') OR (fIDString = 'WOAR') OR
805     (fIDString = 'WOAS') OR (fIDString = 'WORS') OR (fIDString = 'WPAY') OR (fIDString = 'WPUB') then
806     result := FT_URLFrame
807     else
808     result := FT_UNKNOWN;
809     end;
810     end; //case
811     end;
812    
813     function TID3v2Frame.GetFrameTypeDescription: String; // Delphi-Default-String.
814     var i: TFrameIDs;
815     begin
816     if fID <> IDv2_UNKNOWN then
817     result := ID3v2KnownFrames[fID].Description
818     else
819     begin
820     {$IFDEF UNICODE}
821     // Explicit typecast
822     result := 'Unknown Frame (' + String(fIDString) + ')';
823     {$ELSE}
824     result := 'Unknown Frame (' + fIDString + ')';
825     {$ENDIF}
826     for i := low(TFrameIDs) to High(TFrameIDs) do
827     if ID3v2KnownFrames[i].IDs[fVersion] = fIDString then
828     begin
829     result := ID3v2KnownFrames[i].Description;
830     break;
831     end;
832     end;
833     end;
834    
835     function TID3v2Frame.GetFrameTypeID: TFrameIDs;
836     var i: TFrameIDs;
837     begin
838     if fID <> IDv2_UNKNOWN then
839     result := fID
840     else
841     begin
842     result := IDv2_UNKNOWN;
843     for i := low(TFrameIDs) to High(TFrameIDs) do
844     if ID3v2KnownFrames[i].IDs[fVersion] = fIDString then
845     begin
846     result := i;
847     fID := i;
848     break;
849     end;
850     end;
851     end;
852    
853     // Flag-scheme:
854     // Version 2.3: abc00000 ijk00000
855     // Version 2.4: 0abc0000 0h00kmnp
856     // see id3.org for details
857     function TID3v2Frame.GetFlagTagAlterPreservation: Boolean;
858     begin
859     case fVersion of
860     FV_2: result := True;
861     FV_3: result := (fHeader[8] and 128) = 0;
862     FV_4: result := (fHeader[8] and 128) = 0
863     else result := True;
864     end;
865     end;
866     function TID3v2Frame.GetFlagFileAlterPreservation: Boolean;
867     begin
868     case fVersion of
869     FV_2: result := True;
870     FV_3: result := (fHeader[8] and 64) = 0;
871     FV_4: result := (fHeader[8] and 64) = 0
872     else result := True;
873     end;
874     end;
875     function TID3v2Frame.GetFlagReadOnly: Boolean;
876     begin
877     case fVersion of
878     FV_2: result := False;
879     FV_3: result := (fHeader[8] and 32) = 32;
880     FV_4: result := (fHeader[8] and 32) = 32
881     else result := True;
882     end;
883     end;
884     function TID3v2Frame.GetFlagCompression: Boolean;
885     begin
886     case fVersion of
887     FV_2: result := False;
888     FV_3: result := (fHeader[9] and 128) = 128;
889     FV_4: result := (fHeader[9] and 8) = 8
890     else result := True;
891     end;
892     end;
893     function TID3v2Frame.GetFlagEncryption : Boolean;
894     begin
895     case fVersion of
896     FV_2: result := False;
897     FV_3: result := (fHeader[9] and 64) = 64;
898     FV_4: result := (fHeader[9] and 4) = 4
899     else result := True;
900     end;
901     end;
902     function TID3v2Frame.GetFlagGroupingIdentity : Boolean;
903     begin
904     case fVersion of
905     FV_2: result := False;
906     FV_3: result := (fHeader[9] and 32) = 32;
907     FV_4: result := (fHeader[9] and 64) = 64
908     else result := True;
909     end;
910     end;
911     procedure TID3v2Frame.SetFlagGroupingIdentity(Value: Boolean);
912     begin
913     if Value then
914     SetFlag(FF_GroupID)
915     else
916     UnsetFlag(FF_GroupID);
917     end;
918     function TID3v2Frame.GetFlagUnsynchronisation : Boolean;
919     begin
920     case fVersion of
921     FV_2: result := False;
922     FV_3: result := False;
923     FV_4: result := (fHeader[9] and 2) = 2
924     else result := True;
925     end;
926     end;
927     function TID3v2Frame.GetFlagDataLengthIndicator : Boolean;
928     begin
929     case fVersion of
930     FV_2: result := False;
931     FV_3: result := False;
932     FV_4: result := (fHeader[9] and 1) = 1
933     else result := True;
934     end;
935     end;
936     function TID3v2Frame.GetUnknownStatusFlags: Boolean;
937     begin
938     case fVersion of
939     FV_2: result := False;
940     FV_3: result := (fHeader[8] and 31) <> 0;
941     FV_4: result := (fHeader[8] and 143) <> 0 // 143 = %10001111
942     else result := True;
943     end;
944     end;
945     function TID3v2Frame.GetUnknownEncodingFlags: Boolean;
946     begin
947     case fVersion of
948     FV_2: result := False;
949     FV_3: result := (fHeader[9] and 31) <> 0;
950     FV_4: result := (fHeader[9] and 176) = 176 // = %1011 0000
951     else result := True;
952     end;
953     end;
954    
955     procedure TID3v2Frame.SetFlag(aFlag: TFrameFlags);
956     begin
957     if fVersion <> FV_2 then
958     begin
959     if aFlag <= FF_UnknownStatus then
960     fHeader[8] := fHeader[8] or TFrameFlagValues[fVersion][aFlag]
961     else
962     fHeader[9] := fHeader[9] or TFrameFlagValues[fVersion][aFlag];
963     end;
964     end;
965    
966     procedure TID3v2Frame.UnSetFlag(aFlag: TFrameFlags);
967     begin
968     if fVersion <> FV_2 then
969     begin
970     if aFlag <= FF_UnknownStatus then
971     fHeader[8] := fHeader[8] and (Not TFrameFlagValues[fVersion][aFlag])
972     else
973     fHeader[9] := fHeader[9] and (Not TFrameFlagValues[fVersion][aFlag]);
974     end;
975     end;
976    
977     procedure TID3v2Frame.UnSetFlagSomeFlagsAfterDataSet;
978     begin
979     if fVersion <> FV_2 then
980     begin
981     // delete all flags except "Preserve-Flags" and GroupID
982     fHeader[8] := fHeader[8] and (Not TFrameFlagValues[fVersion][FF_ReadOnly]);
983     fHeader[8] := fHeader[8] and (Not TFrameFlagValues[fVersion][FF_UnknownStatus]);
984     fHeader[9] := fHeader[9] and (Not TFrameFlagValues[fVersion][FF_Compression]);
985     fHeader[9] := fHeader[9] and (Not TFrameFlagValues[fVersion][FF_Encryption]);
986     fHeader[9] := fHeader[9] and (Not TFrameFlagValues[fVersion][FF_Unsync]);
987     fHeader[9] := fHeader[9] and (Not TFrameFlagValues[fVersion][FF_DataLength]);
988     fHeader[9] := fHeader[9] and (Not TFrameFlagValues[fVersion][FF_UnknownFormat]);
989     end;
990     end;
991    
992    
993     function TID3v2Frame.GetDataSize: Integer;
994     begin
995     if fData <> NIL then
996     result := length(fData)
997     else
998     result := 0;
999     end;
1000    
1001     procedure TID3v2Frame.UpdateHeader(aSize: Integer = -1);
1002     begin
1003     if aSize = -1 then
1004     aSize := length(fData);
1005    
1006     case fVersion of
1007     FV_2: begin
1008     fHeader[3] := aSize DIV 65536;
1009     aSize := aSize MOD 65536;
1010     fHeader[4] := aSize DIV 256;
1011     aSize := aSize MOD 256;
1012     fHeader[5] := aSize;
1013     end;
1014     FV_3: begin
1015     fHeader[4] := aSize DIV 16777216;
1016     aSize := aSize MOD 16777216;
1017     fHeader[5] := aSize DIV 65536;
1018     aSize := aSize MOD 65536;
1019     fHeader[6] := aSize DIV 256;
1020     aSize := aSize MOD 256;
1021     fHeader[7] := aSize;
1022     end;
1023     FV_4: begin
1024     fHeader[4] := aSize DIV 2097152;
1025     aSize := aSize MOD 2097152;
1026     fHeader[5] := aSize DIV 16384;
1027     aSize := aSize MOD 16384;
1028     fHeader[6] := aSize DIV 128;
1029     aSize := aSize MOD 128;
1030     fHeader[7] := aSize;
1031     end;
1032     end;
1033     end;
1034    
1035     function TID3v2Frame.IsUnicodeNeeded(aString: UnicodeString): Boolean;
1036     var i:integer;
1037     begin
1038     result := False;
1039     for i := 1 to length(aString) do
1040     if Word(aString[i]) > 255 then
1041     begin
1042     result := True;
1043     break;
1044     end;
1045     end;
1046    
1047    
1048     function TID3v2Frame.GetConvertedUnicodeText(Start, Ende: integer; TextEncoding: TTextEncoding): UnicodeString;
1049     var
1050     L, i:integer;
1051     tmp: AnsiString;
1052     tmpbuf: TBuffer;
1053     aLength: Integer;
1054    
1055     begin
1056     if Ende >= length(fData) then Ende := length(fData) - 1;
1057     if Start < 0 then Start := 0;
1058     if Start > Ende then
1059     begin
1060     result := '';
1061     exit;
1062     end;
1063     aLength := Ende-Start+1;
1064     Setlength(result, aLength);
1065     Fillchar(result[1], length(result)*2, 0);
1066    
1067     case TextEncoding of // TE_Ansi, TE_UTF16, TE_UTF16BE, UTF8
1068     TE_Ansi: begin
1069     // No Unicode, but Ansi
1070     // It _should_ be encoded as Iso8859-1, but sometimes it's not.
1071     // => Decode it, if wanted
1072     if (fAutoCorrectCodepage) then
1073     begin
1074     // Use the probably correct CodePage to convert the Data
1075     setlength(tmp, aLength);
1076     move(fData[start], tmp[1], length(tmp));
1077    
1078     L := MultiByteToWideChar( FCharCode.CodePage,
1079     MB_PRECOMPOSED,// Flags
1080     @tmp[1], // data to convert
1081     length(tmp), // Size in bytes
1082     nil, // output - not used here
1083     0); // 0=> Get required BufferSize
1084    
1085     if L = 0 then
1086     begin
1087     // Something's wrong => Fall back to ANSI
1088     setlength(tmp, aLength);
1089     move(fData[start], tmp[1], length(tmp));
1090     {$IFDEF UNICODE}
1091     // use explicit typecast
1092     result := trim(String(tmp));
1093     {$ELSE}
1094     result := trim(tmp);
1095     {$ENDIF}
1096     end else
1097     begin
1098     // SetBuffer, Size in WChars, not Bytes.
1099     SetLength(Result, L);
1100     // Convert
1101     MultiByteToWideChar(FCharCode.CodePage,
1102     MB_PRECOMPOSED,
1103     @tmp[1],
1104     length(tmp),
1105     @Result[1],
1106     L);
1107     end;
1108     end else
1109     begin
1110     // Just get the data as an AnsiString and let Delphi convert it.
1111     setlength(tmp, aLength);
1112     move(fData[start], tmp[1], length(tmp));
1113     {$IFDEF UNICODE}
1114     // use explicit typecast
1115     result := trim(String(tmp));
1116     {$ELSE}
1117     result := trim(tmp);
1118     {$ENDIF}
1119     end;
1120     result := trim(result);
1121     end;
1122     TE_UTF16: begin
1123     { UTF-16 [UTF-16] encoded Unicode [UNICODE] __with__ BOM. All
1124     strings in the same frame SHALL have the same byteorder.
1125     Terminated with $00 00. }
1126     setlength(result, aLength DIV 2 - 1);
1127     if (fData[start] = $FE) and (fData[start + 1] = $FF) then
1128     begin
1129     // byteorder is different to delphi-byteorder. => Swap bytes
1130     setlength(tmpbuf, alength - 2);
1131     for i := 1 to length(result) do
1132     begin
1133     tmpbuf[2*i - 2] := fData[start + 2*i + 1];
1134     tmpbuf[2*i - 1] := fData[start + 2*i];
1135     move(tmpbuf[0], result[1], 2*length(result));
1136     end;
1137     end else
1138     begin
1139     // ByteOrder as in wideStrings. Just copy it.
1140     setlength(result, alength DIV 2 - 1); // -1
1141     if length(result) > 0 then
1142     move(fData[start+2], result[1], 2*length(result))
1143     else
1144     result := '';
1145     end;
1146     result := trim(result);
1147     end;
1148     TE_UTF16BE: begin
1149     { UTF-16BE [UTF-16] encoded Unicode [UNICODE] __without__ BOM.
1150     Terminated with $00 00 } // LE
1151     setlength(result, alength DIV 2);
1152     move(fData[start], result[1], 2*length(result));
1153     result := trim(result);
1154     end;
1155     UTF8: begin
1156     {03 UTF-8 [UTF-8] encoded Unicode [UNICODE]. Terminated with $00.}
1157     setlength(tmp,alength);
1158     move(fData[start], tmp[1], alength);
1159     {$IFDEF UNICODE}
1160     result := UTF8ToString(tmp); // Bugfix 03.2010: "result := "
1161     {$ELSE}
1162     result := UTF8Decode(tmp); // Deprecated in Delphi 2009
1163     {$ENDIF}
1164     result := trim(result);
1165     end;
1166     else result := '';
1167     end;
1168     end;
1169    
1170    
1171     function TID3v2Frame.WideStringToData(Value: UnicodeString; start: integer; UnicodeIsNeeded: Boolean): integer;
1172     var tmpstr: AnsiString;
1173     begin
1174     if UnicodeIsNeeded then
1175     begin
1176     // ByteOrder
1177     fData[start] := $FF;
1178     fData[start+1] := $FE;
1179     // copy to fData
1180     if length(value) > 0 then
1181     move(value[1], fData[start+2], length(Value) * SizeOf(Widechar));
1182    
1183     result := 2 + SizeOf(WideChar)*length(Value);
1184     end else
1185     begin
1186     // Convert Value to AnsiString
1187     {$IFDEF UNICODE}
1188     // use explicit typecast
1189     tmpstr := AnsiString(Value);
1190     {$ELSE}
1191     tmpstr := Value;
1192     {$ENDIF}
1193    
1194     // copy to fDate
1195     if length(tmpstr) > 0 then
1196     move(tmpstr[1], fData[start], length(tmpstr));
1197     result := length(tmpstr);
1198     end;
1199     end;
1200    
1201     function TID3v2Frame.AnsiStringToData(Value: AnsiString; start: integer): integer;
1202     begin
1203     if length(Value) > 0 then
1204     move(Value[1], fData[start], length(Value));
1205     result := length(Value);
1206     end;
1207    
1208    
1209     function TID3v2Frame.GetText: UnicodeString;
1210     begin
1211     if fParsable then
1212     result :=
1213     GetConvertedUnicodeText(
1214     1, // start at second byte
1215     length(fData)-1, // read to the end
1216     ByteToTextEncoding(fData[0]) // first byte contains the "TextEncoding"
1217     )
1218     else
1219     result := '';
1220     end;
1221    
1222    
1223     {
1224     <Header for 'User defined text information frame', ID: "TXXX">
1225     Text encoding $xx
1226     Description <text string according to encoding> $00 (00)
1227     Value <text string according to encoding>
1228    
1229     <Header for 'Comment', ID: "COMM">
1230     Text encoding $xx
1231     Language $xx xx xx
1232     Short content descrip. <text string according to encoding> $00 (00)
1233     The actual text <full text string according to encoding>
1234     }
1235    
1236    
1237    
1238    
1239     procedure TID3v2Frame.SetText(Value: UnicodeString);
1240     var UseUnicode: Boolean;
1241     begin
1242     UseUnicode := fAlwaysWriteUnicode OR IsUnicodeNeeded(Value);
1243     If UseUnicode then
1244     begin
1245     // 2 bytes per character + 1 byte TextEncoding + 2 bytes byteorder (FF FE)
1246     Setlength(fData, length(Value) * SizeOf(WideChar) + 3);
1247     // TextEncoding "UTF-16 with BOM"
1248     fData[0] := 1;
1249     end else
1250     begin
1251     // 1 byte per character + 1 byte TextEncoding
1252     Setlength(fData, length(Value)+1);
1253     // TextEncoding "IS0-8859-1"
1254     fData[0] := 0;
1255     end;
1256     // write data. Conversion "Unicodestring <-> Ansistring"
1257     // will be done in method WideStringToData
1258     WideStringToData(Value, 1, UseUnicode);
1259     UnSetFlagSomeFlagsAfterDataSet;
1260     UpdateHeader;
1261     end;
1262    
1263     function TID3v2Frame.GetUserText(out Description: UnicodeString): UnicodeString;
1264     var enc: TTextEncoding;
1265     i: Integer;
1266     begin
1267     if fParsable then
1268     begin
1269     if length(fData) < 3 then
1270     begin
1271     Description := '';
1272     result := '';
1273     exit;
1274     end;
1275     // get TextEncoding
1276     enc := ByteToTextEncoding(fData[0]);
1277     i := 1;
1278     if (enc = TE_UTF16) or (enc = TE_UTF16BE) then
1279     begin
1280     While (i < length(fData)-1) and ((fData[i] <> 0) or (fData[i+1] <> 0)) do
1281     inc(i,2);
1282     Description := GetConvertedUnicodetext(1, i, enc);
1283     inc(i,2) // 2 bytes termination (00 00)
1284     end
1285     else
1286     begin
1287     While (i < length(fData)) and (fData[i] <> 0) do
1288     inc(i);
1289     Description := GetConvertedUnicodetext(1, i, enc);
1290     inc(i,1); // 1 byte termination (00)
1291     end;
1292    
1293     result := GetConvertedUnicodetext(i, length(fData)-1, enc);
1294     end
1295     else
1296     begin
1297     result := '';
1298     Description := '';
1299     end;
1300     end;
1301    
1302     procedure TID3v2Frame.SetUserText(Description, Value: UnicodeString);
1303     var UseUnicode: Boolean;
1304     BytesWritten: Integer;
1305     begin
1306     UseUnicode := AlwaysWriteUnicode OR IsUnicodeNeeded(Value) OR IsUnicodeNeeded(Description);
1307    
1308     If UseUnicode then
1309     begin
1310     Setlength(fData,
1311     1 // Text-Encoding
1312     + 4 + length(Description) * SizeOf(WideChar) // 2 Bytes BOM + 2Bytes per character + 2 Bytes termination (Description)
1313     + 2 + length(Value) * SizeOf(WideChar) ); // 2 Bytes BOM + 2Bytes per character (Value)
1314     fData[0] := 1; // TextEncodingg "UTF-16 with BOM"
1315     end else
1316     begin
1317     Setlength(fData,
1318     1 // Text-Encoding
1319     + 1 + length(Description) // 1 Byte per character + 1 Byte termination (Description)
1320     + length(Value) ); // 1 Byte per character
1321     fData[0] := 0; // TextEncoding "IS0-8859-1"
1322     end;
1323    
1324     // Set description
1325     BytesWritten := WideStringToData(Description, 1, UseUnicode);
1326     // Set termination
1327     fData[1 + BytesWritten] := 0;
1328     inc(BytesWritten);
1329     if UseUnicode then
1330     begin // Termination with two zeros (00 00)
1331     fData[1 + BytesWritten] := 0;
1332     inc(BytesWritten);
1333     end;
1334     // set value
1335     WideStringToData(Value, 1 + BytesWritten, UseUnicode);
1336     UnSetFlagSomeFlagsAfterDataSet;
1337     UpdateHeader;
1338     end;
1339    
1340    
1341     function TID3v2Frame.GetCommentsLyrics(out Language: AnsiString; out Description: UnicodeString): UnicodeString;
1342     var enc: TTextEncoding;
1343     i: Integer;
1344     begin
1345     // frame structure:
1346     // 1 Byte Encoding
1347     // 3 Byte Language
1348     // <..> 00 (00) Description (enc)
1349     // <..> Value (enc)
1350    
1351     if fParsable then
1352     begin
1353     if length(fData) < 5 then
1354     begin
1355     Language := '';
1356     Description := '';
1357     result := '';
1358     exit;
1359     end;
1360    
1361     // get TextEncoding
1362     enc := ByteToTextEncoding(fData[0]);
1363     // get language
1364     setlength(Language, 3);
1365     Move(fData[1], Language[1], 3);
1366     //get description
1367     i := 4;
1368    
1369     if (enc = TE_UTF16) or (enc = TE_UTF16BE) then
1370     begin
1371     While (i < length(fData)-1) and ((fData[i] <> 0) or (fData[i+1] <> 0)) do
1372     inc(i,2);
1373     Description := GetConvertedUnicodetext(4, i, enc);
1374     inc(i,2) // 2 bytes termination (00 00)
1375     end
1376     else
1377     begin
1378     While (i < length(fData)) and (fData[i] <> 0) do
1379     inc(i);
1380     Description := GetConvertedUnicodetext(4, i, enc);
1381     inc(i,1); // 1 byte termination (00)
1382     end;
1383    
1384     result := GetConvertedUnicodetext(i, length(fData)-1, enc);
1385     end else
1386     begin
1387     Language := '';
1388     Description := '';
1389     Result := '';
1390     end;
1391     end;
1392    
1393     procedure TID3v2Frame.SetCommentsLyrics(Language: AnsiString; Description, Value: UnicodeString);
1394     var UseUnicode: Boolean;
1395     BytesWritten: Integer;
1396     begin
1397     UseUnicode := AlwaysWriteUnicode OR IsUnicodeNeeded(Value) OR IsUnicodeNeeded(Description);
1398     if length(Language) <> 3 then Language := 'eng';
1399    
1400     If UseUnicode then
1401     begin
1402     Setlength(fData,
1403     4 // Text-Encoding + Language
1404     + 4 + length(Description) * SizeOf(WideChar) // 2 Bytes BOM + 2Bytes per character + 2 Bytes termination (Description)
1405     + 2 + length(Value) * SizeOf(WideChar) ); // 2 Bytes BOM + 2Bytes per character (Value)
1406     fData[0] := 1; // TextEncodingg "UTF-16 with BOM"
1407     end else
1408     begin
1409     Setlength(fData,
1410     4 // Text-Encoding + Language
1411     + 1 + length(Description) // 1 Byte per character + 1 Byte termination (Description)
1412     + length(Value) ); // 1 Byte per character
1413     fData[0] := 0; // TextEncoding "IS0-8859-1"
1414     end;
1415     // Set language
1416     move(Language[1], fData[1], 3);
1417     // Set description
1418     BytesWritten := WideStringToData(Description, 4, UseUnicode);
1419     // Set termination
1420     fData[4 + BytesWritten] := 0;
1421     inc(BytesWritten);
1422     if UseUnicode then
1423     begin // Termination with two zeros (00 00)
1424     fData[4 + BytesWritten] := 0;
1425     inc(BytesWritten);
1426     end;
1427     // set value
1428     WideStringToData(Value, 4 + BytesWritten, UseUnicode);
1429     UnSetFlagSomeFlagsAfterDataSet;
1430     UpdateHeader;
1431     end;
1432    
1433     function TID3v2Frame.GetUserdefinedURL(out Description: UnicodeString): AnsiString;
1434     var enc: TTextEncoding;
1435     i: Integer;
1436     begin
1437     // frame structure:
1438     // 1 Byte Encoding
1439     // <..> 00 (00) Description (enc)
1440     // <..> Value (ansii)
1441     if fParsable then
1442     begin
1443     if length(fData) < 2 then
1444     begin
1445     Description := '';
1446     result := '';
1447     exit;
1448     end;
1449    
1450     // get TextEncoding (for description)
1451     enc := ByteToTextEncoding(fData[0]);
1452     //get description
1453     i := 1;
1454    
1455     if (enc = TE_UTF16) or (enc = TE_UTF16BE) then
1456     begin
1457     While (i < length(fData)-1) and ((fData[i] <> 0) or (fData[i+1] <> 0)) do
1458     inc(i,2);
1459     Description := GetConvertedUnicodetext(1, i, enc);
1460     inc(i,2) // 2 bytes termination
1461     end
1462     else
1463     begin
1464     While (i < length(fData)) and (fData[i] <> 0) do
1465     inc(i);
1466     Description := GetConvertedUnicodetext(1, i, enc);
1467     inc(i,1); // 1 byte termination
1468     end;
1469    
1470     setlength(result, length(fData) - i);
1471     move(fData[i], result[1], length(result));
1472     {$IFDEF UNICODE}
1473     // use explicit typecasts
1474     result := AnsiString(trim(String(result)));
1475     {$ELSE}
1476     result := trim(result);
1477     {$ENDIF}
1478     end else
1479     begin
1480     Description := '';
1481     result := '';
1482     end;
1483     end;
1484    
1485     procedure TID3v2Frame.SetUserdefinedURL(Description: UnicodeString; URL: AnsiString);
1486     var UseUnicode: Boolean;
1487     BytesWritten: Integer;
1488     begin
1489     UseUnicode := IsUnicodeNeeded(Description);
1490     If UseUnicode then
1491     begin
1492     Setlength(fData,
1493     1 // Text-Encoding + Language
1494     + 4 + length(Description) * SizeOf(WideChar) // 2 Bytes BOM + 2Bytes per character + 2 Bytes termination (Description)
1495     + length(URL) ); // 1 Byte per character (Value)
1496     fData[0] := 1; // TextEncoding "UTF16 with BOM"
1497     end else
1498     begin
1499     Setlength(fData,
1500     1 // Text-Encoding + Language
1501     + 1 + length(Description) // 1 Byte per character + 1 Byte termination (Description)
1502     + length(URL) ); // 1 Byte per character
1503     fData[0] := 0; // TextEncoding "IS0-8859-1"
1504     end;
1505     // Set description
1506     BytesWritten := WideStringToData(Description, 1, UseUnicode);
1507     // Set termination
1508     fData[1 + BytesWritten] := 0;
1509     inc(BytesWritten);
1510     if UseUnicode then
1511     begin
1512     fData[1 + BytesWritten] := 0;
1513     inc(BytesWritten);
1514     end;
1515     // Set Value
1516     AnsiStringToData(URL, 1 + BytesWritten);
1517    
1518     UnSetFlagSomeFlagsAfterDataSet;
1519     UpdateHeader;
1520     end;
1521    
1522     function TID3v2Frame.GetURL: AnsiString;
1523     begin
1524     if fParsable then
1525     begin
1526     setlength(result, length(fData));
1527     if length(result) > 0 then
1528     move(fData[0], result[1], length(result))
1529     else
1530     result := '';
1531     end else
1532     result := '';
1533     end;
1534    
1535     procedure TID3v2Frame.SetURL(Value: AnsiString);
1536     begin
1537     if Value = '' then
1538     Value := ' ';
1539     Setlength(fData, length(Value));
1540     move(Value[1], fData[0], length(Value));
1541     UnSetFlagSomeFlagsAfterDataSet;
1542     UpdateHeader;
1543     end;
1544    
1545     function TID3v2Frame.GetPicture(out Mime: AnsiString; out PicType: Byte; out Description: UnicodeString; PictureData: TStream): Boolean;
1546     var
1547     enc: TTextEncoding;
1548     i, dStart: Integer;
1549     begin
1550     if fParsable then
1551     begin
1552     result := True;
1553     case fVersion of
1554     FV_2: begin
1555     if length(fData) <= 6 then // 1 Enc, 3 Mime, 1 PicTyp, 1 Descr.-Terminierung -> 6 is minimum
1556     begin
1557     Mime := '';
1558     PicType := 0;
1559     Description := '';
1560     result := False;
1561     end else
1562     begin
1563     // at least 7 Bytes in fData, so index of 6 will be ok
1564     enc := ByteToTextEncoding(fData[0]);
1565     // Mime-Type always 3 characters in subversion 2.2
1566     SetLength(Mime, 3);
1567     Move(fData[1], Mime[1], 3);
1568     // PicType
1569     PicType := fData[4];
1570    
1571     // description is terminated with 00 (00)
1572     i := 5;
1573     if (enc = TE_UTF16) or (enc = TE_UTF16BE) then
1574     begin
1575     While (i < length(fData)-1) and ((fData[i] <> 0) or (fData[i+1] <> 0)) do
1576     inc(i,2);
1577     Description := GetConvertedUnicodetext(5, i, enc);
1578     inc(i,2) // 2 Bytes termination
1579     end
1580     else
1581     begin
1582     While (i < length(fData)) and (fData[i] <> 0) do
1583     inc(i);
1584     Description := GetConvertedUnicodetext(5, i, enc);
1585     inc(i,1); // 1 Byte termination
1586     end;
1587    
1588     // here the image-data starts
1589     if i < length(fData) then
1590     PictureData.Write(fData[i], length(fData) - i)
1591     else
1592     result := False;
1593     end;
1594     end
1595     else begin
1596     // subversion 2.3 or 2.4
1597     if length(fData) <= 4 then // 1 Enc, 1 mime-termination, 1 PicTyp, 1 Descr.-Terminierung -> this is minimum
1598     begin
1599     Mime := '';
1600     PicType := 0;
1601     Description := '';
1602     result := False;
1603     end else
1604     begin
1605     enc := ByteToTextEncoding(fData[0]);
1606     i := 1;
1607     // get termination of mime-Type
1608     While (i < length(fData)) and (fData[i] <> 0) do
1609     inc(i);
1610     // get mime-type
1611     Setlength(Mime, i-1);
1612     Move(fData[1], Mime[1], i-1);
1613     // 1 byte termination
1614     inc(i);
1615    
1616     // PicType
1617     if i < length(fData) then
1618     PicType := fData[i]
1619     else result := False;
1620    
1621     inc(i);
1622     // get termination of description
1623     dStart := i;
1624    
1625     if (enc = TE_UTF16) or (enc = TE_UTF16BE) then
1626     begin
1627     While (i < length(fData)-1) and ((fData[i] <> 0) or (fData[i+1] <> 0)) do
1628     inc(i,2);
1629     Description := GetConvertedUnicodetext(dStart, i, enc);
1630     inc(i,2) // 2 Bytes
1631     end
1632     else
1633     begin
1634     While (i < length(fData)) and (fData[i] <> 0) do
1635     inc(i);
1636     Description := GetConvertedUnicodetext(dStart, i, enc);
1637     inc(i,1); // 1 Byte
1638     end;
1639    
1640     // here the image-data starts
1641     if i < length(fData) then
1642     PictureData.Write(fData[i], length(fData) - i)
1643     else
1644     result := False;
1645     end
1646     end; // else
1647     end;
1648     end else
1649     begin
1650     result := False;
1651     Mime := '';
1652     PicType := 0;
1653     Description := '';
1654     end;
1655     end;
1656    
1657    
1658     procedure TID3v2Frame.SetPicture(Mime: AnsiString; PicType: Byte; Description: UnicodeString; PictureData: TStream);
1659     var UseUnicode: Boolean;
1660     BytesWritten, helpIdx: Integer;
1661     begin
1662     UseUnicode := IsUnicodeNeeded(Description);
1663     if Pictype > 20 then PicType := 0;
1664    
1665     case fVersion of
1666     FV_2: begin
1667     // adjust mime-type for subversion 2.2
1668     If length(Mime) <> 3 then
1669     begin
1670     if Mime = 'image/png' then
1671     Mime := 'PNG'
1672     else
1673     Mime := 'JPG';
1674     end;
1675     if UseUnicode then
1676     begin
1677     setlength(fData, 1 + 3 + 1 + (length(Description) + 1) * SizeOf(Widechar) + PictureData.size);
1678     fData[0] := 1;
1679     end else
1680     begin
1681     setlength(fData, 1 + 3 + 1 + length(Description) + 1 + PictureData.size);
1682     fData[0] := 0;
1683     end;
1684     move(Mime[1], fData[1], 3);
1685     fData[4] := PicType;
1686     helpIdx := 5;
1687     end
1688     else
1689     begin
1690     // subversion 2.3 or 2.4
1691     if UseUnicode then
1692     begin
1693     setlength(fData, 1 + length(Mime) + 1 + 1 + (length(Description) + 1) * SizeOf(Widechar) + PictureData.size);
1694     fData[0] := 1;
1695     end else
1696     begin
1697     setlength(fData, 1 + length(Mime) + 1 + 1 + length(Description) + 1 + PictureData.size);
1698     fData[0] := 0;
1699     end;
1700     move(Mime[1], fData[1], length(Mime));
1701     fData[1 + length(Mime)] := 0; // termination
1702     fData[2 + length(Mime)] := PicType;
1703     helpIdx := 3 + length(Mime);
1704     end; // else
1705     end; // Case
1706    
1707     BytesWritten := WideStringToData(Description, helpIdx, UseUnicode);
1708     fData[helpIdx + BytesWritten] := 0;
1709     inc(BytesWritten);
1710     if UseUnicode then
1711     begin
1712     fData[helpIdx + BytesWritten] := 0;
1713     inc(BytesWritten);
1714     end;
1715     PictureData.Seek(0, soFromBeginning);
1716     PictureData.Read(fData[helpIdx + BytesWritten], PictureData.Size);
1717     UnSetFlagSomeFlagsAfterDataSet;
1718     UpdateHeader;
1719     end;
1720    
1721    
1722     function TID3v2Frame.GetRating(out UserEMail: AnsiString): Byte;
1723     var i: Integer;
1724     begin
1725     if fParsable then
1726     begin
1727     i := 0;
1728     result := 0; // undef.
1729    
1730     //get length of user-mail
1731     While (i < length(fData)) and (fData[i] <> 0) do
1732     inc(i);
1733     // get user-mail
1734     Setlength(UserEMail, i);
1735     Move(fData[0], UserEMail[1], i);
1736     inc(i); // termination byte
1737     // get rating
1738     if i < length(fData) then
1739     result := fData[i];
1740     end else
1741     begin
1742     result := 0;
1743     UserEMail := '';
1744     end;
1745     end;
1746    
1747     procedure TID3v2Frame.SetRating(UserEMail: AnsiString; Value: Byte);
1748     var tmpmail: AnsiString;
1749     BackUpCounter: Cardinal;
1750     i: Integer;
1751     begin
1752     // Todo:
1753     // Check for an PlayCounter after the rating, backup it, write it
1754     BackUpCounter := GetPersonalPlayCounter(tmpmail);
1755    
1756     // Set length of Data. If a Counter is present, we need 4 additional bytes.
1757     if BackUpCounter = 0 then
1758     Setlength(fData, length(UserEMail) + 2)
1759     else
1760     Setlength(fData, length(UserEMail) + 2 + 4);
1761    
1762     move(UserEMail[1], fData[0], length(UserEMail));
1763     fData[length(UserEMail)] := 0;
1764     fData[length(UserEMail) + 1] := Value;
1765    
1766     if BackUpCounter <> 0 then
1767     begin
1768     // Write the existing counter into the frame
1769     i := length(UserEMail) + 2;
1770     fData[i] := BackUpCounter DIV 16777216;
1771     BackUpCounter := BackUpCounter MOD 16777216;
1772     fData[i+1] := BackUpCounter DIV 65536;
1773     BackUpCounter := BackUpCounter MOD 65536;
1774     fData[i+2] := BackUpCounter DIV 256;
1775     BackUpCounter := BackUpCounter MOD 256;
1776     fData[i+3] := BackUpCounter;
1777     end;
1778    
1779     UnSetFlagSomeFlagsAfterDataSet;
1780     UpdateHeader;
1781     end;
1782    
1783     function TID3v2Frame.GetPersonalPlayCounter(out UserEMail: AnsiString): Cardinal;
1784     var i: Integer;
1785     begin
1786     if fParsable then
1787     begin
1788     i := 0;
1789     //get length of user-mail
1790     While (i < length(fData)) and (fData[i] <> 0) do
1791     inc(i);
1792     // get user-mail
1793     Setlength(UserEMail, i);
1794     Move(fData[0], UserEMail[1], i);
1795     inc(i); // termination byte
1796     inc(i); // Rating byte
1797     if i < length(fData) then
1798     begin
1799     // We have information after the rating byte.
1800     case (length(fData) - i) of
1801     0..3: begin
1802     // Invalid Counter
1803     result := 0;
1804     end;
1805     4: begin
1806     // valid Counter
1807     result := fData[i] * 16777216
1808     + fData[i+1] * 65536
1809     + fData[i+2] * 256
1810     + fData[i+3];
1811     end;
1812     else
1813     begin
1814     // Counter to large, but valid
1815     // Note: We read only counters smaller then 4.294.967.295
1816     // - this should be enough for all cases
1817     // Edit: No. Some POPM-Frames are kinda invalid (only several zero-bytes),
1818     // which will cause unexpected results here.
1819     // So: Set these Counts to zero
1820     result := 0; // ... and NOT to high(Cardinal);
1821     end;
1822     end;
1823     end else
1824     begin
1825     // No Counter-Information in the Rating-Frame
1826     result := 0;
1827     end;
1828     end else
1829     begin
1830     result := 0;
1831     UserEMail := '';
1832     end;
1833     end;
1834    
1835     procedure TID3v2Frame.SetPersonalPlayCounter(UserEMail: AnsiString; Value: Cardinal);
1836     var tmpmail: AnsiString;
1837     BackUpRating: Byte;
1838     i: Integer;
1839     begin
1840     // Read the rating, backup it
1841     BackUpRating := GetRating(tmpmail);
1842    
1843     // if Value = 0, the write no Counting-information into the frame
1844     if Value = 0 then
1845     Setlength(fData, length(UserEMail) + 2)
1846     else
1847     Setlength(fData, length(UserEMail) + 2 + 4);
1848    
1849     move(UserEMail[1], fData[0], length(UserEMail));
1850     fData[length(UserEMail)] := 0;
1851     fData[length(UserEMail) + 1] := BackUpRating;
1852    
1853     if Value <> 0 then
1854     begin
1855     // Write the existing counter into the frame
1856     i := length(UserEMail) + 2;
1857     fData[i] := Value DIV 16777216;
1858     Value := Value MOD 16777216;
1859     fData[i+1] := Value DIV 65536;
1860     Value := Value MOD 65536;
1861     fData[i+2] := Value DIV 256;
1862     Value := Value MOD 256;
1863     fData[i+3] := Value;
1864     end;
1865     UnSetFlagSomeFlagsAfterDataSet;
1866     UpdateHeader;
1867     end;
1868    
1869    
1870     function TID3v2Frame.GetPrivateFrame(out OwnerID: AnsiString;
1871     Data: TStream): Boolean;
1872     var i: Integer;
1873     begin
1874     if fParsable then
1875     begin
1876     i := 0;
1877     result := True;
1878     //get length of OwnerID
1879     While (i < length(fData)) and (fData[i] <> 0) do
1880     inc(i);
1881     // get OwnerID
1882     Setlength(OwnerID, i);
1883     Move(fData[0], OwnerID[1], i);
1884     inc(i); // termination byte
1885    
1886     if i < length(fData) then
1887     Data.Write(fData[i], length(fData) - i)
1888     else
1889     result := False;
1890    
1891     end else
1892     result := False;
1893    
1894     end;
1895     procedure TID3v2Frame.SetPrivateFrame(aOwnerID: AnsiString; Data: TStream);
1896     begin
1897     SetLength(fData, Length(aOwnerID) + 1 + Data.Size);
1898     // write OwnerID to fData
1899     Move(aOwnerID[1], fData[0], length(aOwnerID));
1900     // Termination Byte
1901     fData[length(aOwnerID)] := 0;
1902     // Write Data
1903     Data.Seek(0, soFromBeginning);
1904     Data.Read(fData[length(aOwnerID) + 1], Data.Size);
1905    
1906     UnSetFlagSomeFlagsAfterDataSet;
1907     UpdateHeader;
1908     end;
1909    
1910    
1911    
1912     procedure TID3v2Frame.GetData(Data: TStream);
1913     begin
1914     if length(fData) > 0 then
1915     Data.Write(fData[0], length(fData));
1916     end;
1917    
1918     procedure TID3v2Frame.SetData(Data: TStream);
1919     begin
1920     Data.Seek(0, soFromBeginning);
1921     setlength(fData, Data.Size);
1922     Data.Read(fData[0], Data.Size);
1923     UpdateHeader;
1924     end;
1925    
1926    
1927     end.

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26