Develop and Download Open Source Software

Browse Subversion Repository

Contents of /Id3v2Frames.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 7 - (show 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 {
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