Develop and Download Open Source Software

bad-mp3player

Browse Subversion Repository

/[bad-mp3player]/Mp3FileUtils.pas

Annotation of /Mp3FileUtils.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: 156069 byte(s) 
タグ読み取りに使用するユニットを変更しました。現在Androidでは利用できませんが、書き換えをして使えるようにしようと思います。
1 yamat0jp 7 {
2     -------------------------------------------------------
3    
4     The contents of this file are subject to the Mozilla Public License
5     Version 1.1 (the "License"); you may not use this file except in
6     compliance with the License. You may obtain a copy of the License at
7     http://www.mozilla.org/MPL/
8    
9     Software distributed under the License is distributed on an "AS IS"
10     basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
11     License for the specific language governing rights and limitations
12     under the License.
13    
14     The Original Code is MP3FileUtils.
15    
16     The Initial Developer of the Original Code is Daniel Gaussmann,
17     mail@gausi.de. Portions created by the Initial Developer are
18     Copyright (C) 2005-2011 the Initial Developer. All Rights Reserved.
19    
20     Contributor(s): (none yet)
21    
22     Alternatively, the contents of this file may be used under the terms
23     of the GNU Lesser General Public License Version 2.1 or later
24     (the "LGPL"), in which case the provisions of LGPL are applicable
25     instead of those above. If you wish to allow use of your version of
26     this file only under the terms of the LGPL and not to allow others to use
27     your version of this file under the MPL, indicate your decision by
28     deleting the provisions above and replace them with the notice and
29     other provisions required by the LGPL. If you do not delete
30     the provisions above, a recipient may use your version of this file
31     under either the MPL or the LGPL License.
32    
33     -------------------------------------------------------
34     }
35    
36     {
37     Extract and set several information in mp3-Files.
38    
39     - TID3v1Tag:
40     Read and write ID3v1-Tags
41     All information are supported
42     Version 1.1 is supported
43    
44     - TMpegInfo
45     Read MPEG-information (bitrate, duration, ...)
46    
47     - TID3v2Tag:
48     Read and write ID3v2-Tags.
49     Support for all sub-versions (2.2, 2.3, 2.4)
50    
51     - TID3v2Frame:
52     Edit ID3v2-Tag on Frame-level (experienced users only)
53    
54    
55     Supported Third-Party-Tools
56     ========================================================================================================
57     - TntWare Delphi Unicode Controls
58     Download: http://www.tntware.com/delphicontrols/unicode/
59     Note: Tnt is only used for File-Access.
60     If you just need Ansi-Filenames, you will NOT need TNTs
61     Delphi 2009 do not need the TNTs.
62    
63    
64     Version-History
65     ========================================================================================================
66    
67     December 2011: v0.6 -> v0.6a
68     ============================
69     Bugfix
70     - method SetRatingAndCounter didn't work properly, when no POPM-Frame
71     was in the file: Instead of writing the Rating and Playcounter into the Tag,
72     the Value for "Playcounter" was written as "Rating".
73    
74    
75     June 2011: v0.5b -> v0.6
76     ========================
77     New features
78     - Private Frames
79     - VBRI-Header-Detection
80     - added some more genres to the Genres-List
81     - added methods GetUserText, SetUserText, GetAllUserTextFrames,
82     deleted TXXX-Frames from GetAllTextFrames
83     (see TXXX-Bugfix below)
84    
85     Changes
86     - ID3v2Tag.ReadFromStream: Copy all frames into a memorystream before reading
87     - deleted methods SetRating and SetPersonalPlayCounter
88     use SetRatingAndCounter instead to set both values at once
89     (both values are stored in the same frame)
90    
91     Bugfixes
92     - correct reading of UTF8-encoded Textframes with Delphi2009
93     - ExtendedHeader-Size has been misinterpreted
94     - User defined Textframes (TXXX) have NOT the same structure as other Textframes
95     - result of TMpegInfo.GetframeLength is integer (negative value is used as error indication),
96     but TMpegHeader.Framelentgh is Word. The direct assignment provided some errors whith
97     range checking enabled
98    
99    
100     August 2009: v0.5a -> 0.5b
101     ========================
102     - Fatal Bug fixed: ID3-v1-Tag could not be deleted in Delphi 2009, and every
103     write-access (WriteToFile/-Stream) to ID3v1-Tags created a new one at the
104     end of the file. (This was the case only in Delphi 2009, it was a
105     Char-AnsiChar-thingy.)
106     - DefaultRatingDescription is a var now.
107     - Added frame-support for PlayCounter. Not the PCNT-Frame, but the
108     counter included within Rating-Frames.
109     (Use with care, this is not tested very well. This should have come along
110     with some more new features (private-frames), but someone showed me
111     this ID3v1-bug, which really must be fixed.)
112    
113     April 2009: v0.5 -> 0.5a (not published)
114     ========================
115     - fixed a possible memory-leak in TID3v2Tag.RemoveFromStream
116    
117     April 2009: v0.4a -> 0.5
118     ========================
119     - update to Delphi 2009
120     - kicked out DIConverters.
121     Conversion will now use the MultiByteToWideChar-Function from the Windows-API
122     (-) some codepages are not supported any longer
123     (+) easier to use, no third-party-stuff required
124     (+) smaller binary
125     - kicked out some methods, which were declared "deprecated" in v0.4
126     - AcceptAllEncodings replaced by AutoCorrectCodepage
127     - CharCode replaced by CodePage
128     - GetCharcode replaced by GetCodePage
129     - added TMpegInfo.Duration (same as .Dauer, just for the english users ;-) )
130     - fixed a bug which possibly caused invalid encoded URLs on "Unicode-filenames"
131     - fixed a problem with activated range-checking and PaddingSize of zero
132     - translated (most) comments to english
133    
134     Dezember 2008: v0.4 -> 0.4a (sorry, from here on only german ;-))
135     ===========================
136     - Fehler behoben, der bei Tags mit einer bestimmten Text-Kodierung das letzte
137     Zeichen der Textfelder abschnitt
138    
139     Juni 2008: v0.3b -> 0.4
140     =======================
141     - Code anders strukturiert - einiges in die Klasse TID3v2Frame ausgelagert
142     - Unterst�Ezung von Unsynchronisation
143     - Unterst�Ezung von GroupID und DataLength-Flags in Frame-Headern
144     - Bei Compression und/oder Encryption wird das Auslesen abgebrochen
145     - Unterst�Ezung von URLs
146     - Unterst�Ezung von Bewertungen
147     - Fehler in der Behandlung bei "Beschreibungen" mit Unicode - das f�Erte u.a. dazu,
148     dass viele Cover in Dateien von jamendo.com nicht angezeigt wurden.
149    
150     Februar 2008: v0.3a -> 0.3b
151     ==========================
152     - Funktion GetTrackFromV2TrackString hinzugef�Et
153     - Bug in der Funktion GetPaddingSize behoben
154    
155     Juni 2007: v0.3 -> 0.3a
156     ==========================
157     - Bei den Gettern des ID3v1-Tags wurden h�ufig Leerstellen und/oder Nullbytes mit �Eergeben, was ein Trim() au�erhalb
158     der Klasse n�tig machte. Das wurde korrigiert - das trim() wird jetzt hier intern gemacht.
159     - Sch�nheitsfehler bei der Benennung beseitigt: TPictureFrameDes()ription hei�t jetzt TPictureFrameDes(c)ription
160    
161    
162     Februar 2007: v0.2a -> 0.3
163     ==========================
164     - INT/WE- Versionen �Eer Compiler-Schalter vereint.
165     Siehe dazu das Ende dieses einleitenden Kommentars
166     - Fehler entfernt, die bei einer Verkleinerung des ID3v2-Tags unter gewissen Umst�nden zu unsch�nen
167     Effekten bei den getaggten mp3s f�Erte - die letzten Frames/Sekunden des Liedes wurden dann doppelt
168     abgespielt.
169     - intelligenteres Padding-System (abh�ngig von der Clustergr��e)
170     f�E den ID3v1Tag werden 128 Byte im Cluster freigehalten (falls er nicht existiert), so
171     dass ein nachtr�gliches Einf�Een keinen Zusatzplatz ben�tigt.
172    
173    
174     ========================================================================================================
175     September 2006: v0.2 -> 0.2a (beide Versionen)
176     ==============================================
177     - katastrophalen Bug behoben, der ung�Etige ID3v2-TextFrames erzeugt.
178    
179    
180     August 2006: v0.1 -> v0.2(International)
181     =========================================
182    
183     Kleinere Bugs:
184     ==============
185     - Der ID3v1-Tag wurde vor dem Lesen nicht gel�scht, so dass u.U noch alte Informationen �Erigblieben
186     - Unter gewissen Umst�nden wurden Lyrics und Comments bei ID3v2 nicht richtig ausgelesen.
187     Das lag aber an fehlerhaften Language-Informationen, die jetzt ausgeb�Eelt werden.
188     - Fehler beim Lesen einer Variante von Unicode behoben (Stichwort: Byte-Order)
189     - Finalize-Abschnitt (wieder) hinzugef�Et. Der ist zwischendurch mal irgendwo verlorengegangen.
190    
191     Updates/�nderungen:
192     ===================
193     Klasse TID3v1Tag:
194     -----------------
195     - in der 'International'-Version werden alle Textinformationen als WideString zur�Ekgeliefert
196     - beim Lesen findet ggf. eine Konvertierung statt, die vom CharCode abh�ngt.
197     Mit Hilfe der Funktion GetCharCode aus der Unit U_CharCode (mitgeliefert) kann
198     der beim Taggen verwendete Zeichensatz anhand des Dateinamens bestimmt werden.
199     Das funktioniert nat�Elich nur mit einer gewissen Fehlerquote. Mehr dazu in der Datei 'Unicode.txt'.
200     - beim Schreiben wird ebenfalls dieser Zeichensatz verwendet und der WideString entsprechend konvertiert
201     - Flag 'AcceptAllEncodings' hinzugef�Et. Ist dieser 'False', findet keine Konvertierung statt
202     (weder beim schreiben, noch beim lesen).
203     Was das f�E einen Effekt auf Systemen au�erhalb Westeuropas hat, kann ich nicht genau sagen.
204    
205     Klasse TID3v2Tag:
206     -----------------
207     - S�mtliche TextInformationen werden jetzt als WideString geliefert.
208     - Textinformationen werden automatisch im Unicode-Format gespeichert, falls dies n�tig ist.
209     - Flag 'AlwaysWriteUnicode' hinzugef�Et. Ist dies gesetzt, wird immer im Unicode-Format gespeichert,
210     auch wenn das nicht n�tig ist (d.h. wenn nur "Standard"-Buchstaben verwendet werden)
211     - beim Lesen findet ggf. eine Konvertierung statt, die vom CharCode abh�ngt.
212     Mit Hilfe der Funktion GetCharCode aus der Unit U_CharCode (mitgeliefert) kann
213     der beim Taggen verwendete Zeichensatz anhand des Dateinamens bestimmt werden.
214     Im Gegensatz zur Klasse ID3v1Tag tritt dies nur dann auf, wenn beim Taggen auf Unicode verzichtet
215     wurde. D.h. auch wenn das Flag 'AcceptAllEncodings' nicht gesetzt ist, kann man kyrillische oder asiatische (oder...)
216     Zeichen erhalten. Dies sollte eigentlich sogar die Regel sein - ist es aber nicht, weswegen ich den ganzen
217     Kram mit der Konvertierung �Eerhaupt implementieren musste.
218     Das funktioniert nat�Elich nur mit einer gewissen Fehlerquote. Mehr dazu in der Datei 'Unicode.txt'.
219     - Flag 'AcceptAllEncodings' hinzugef�Et. Ist dieser 'False', findet keine Konvertierung statt
220    
221     }
222    
223     unit Mp3FileUtils;
224    
225     {$I config.inc}
226    
227     interface
228    
229     uses
230     SysUtils, Classes, Windows, Contnrs, U_CharCode
231     {$IFDEF USE_TNT_COMPOS}, TntSysUtils, TntClasses{$ENDIF}, Id3v2Frames;
232    
233     type
234    
235     {$IFDEF USE_TNT_COMPOS}
236     TMPFUFileStream = TTNTFileStream;
237     {$ELSE}
238     TMPFUFileStream = TFileStream;
239     {$ENDIF}
240    
241    
242    
243     //--------------------------------------------------------------------
244     // Teil 1: Some small helpers
245     //--------------------------------------------------------------------
246     TBuffer = Array of byte;
247     TMP3Error = (MP3ERR_None, MP3ERR_NoFile, MP3ERR_FOpenCrt, MP3ERR_FOpenR,
248     MP3ERR_FOpenRW, MP3ERR_FOpenW, MP3ERR_SRead, MP3ERR_SWrite,
249     ID3ERR_Cache, ID3ERR_NoTag, ID3ERR_Invalid_Header, ID3ERR_Compression,
250     ID3ERR_Unclassified,
251     MPEGERR_NoFrame );
252     TID3Version = record
253     Major: Byte;
254     Minor: Byte;
255     end;
256     //--------------------------------------------------------------------
257    
258    
259     //--------------------------------------------------------------------
260     // Teil 2: Types for ID3v1-tag
261     //--------------------------------------------------------------------
262     String4 = String[4]; // OK. ShortStrings are short AnsiStrings in Delphi2009
263     String30 = String[30];
264    
265     // Structure of ID3v1Tags in the file
266     TID3v1Structure = record
267     ID: array[1..3] of AnsiChar; // all together 128 Bytes
268     Title: Array [1..30] of AnsiChar; // Use AnsiChars
269     Artist: Array [1..30] of AnsiChar;
270     Album: Array [1..30] of AnsiChar;
271     Year: array [1..4] of AnsiChar;
272     Comment: Array [1..30] of AnsiChar;
273     Genre: Byte;
274     end;
275    
276     TID3v1Tag = class(TObject)
277     private
278     FTitle: String30;
279     FArtist: String30;
280     FAlbum: String30;
281     FComment: String30;
282     FTrack: Byte;
283     FYear: String4;
284     FGenre: Byte;
285     FExists: Boolean;
286     FVersion: Byte;
287    
288     // convert the ansi-data to UnicodeString using a codepage
289     // * use GetCodepage(Filename) to get the probably used codepage
290     // * fAutoCorrectCodepage = False: Use the System-Codepage
291     fAutoCorrectCodepage: Boolean;
292     FCharCode: TCodePage;
293     function GetConvertedUnicodeText(Value: String30): UnicodeString;
294    
295     function GetTitle: UnicodeString;
296     function GetArtist: UnicodeString;
297     function GetAlbum: UnicodeString;
298     function GetComment: UnicodeString;
299    
300     function GetGenre: String; // Delphi-Default-String. Just for display, as Genre is stored as one byte
301     function GetTrack: String; // Delphi-Default-String. Just for display, as Track is stored as one byte
302     function GetYear: String4;
303    
304     function SetString30(value: UnicodeString): String30;
305     procedure SetTitle(Value: UnicodeString);
306     procedure SetArtist(Value: UnicodeString);
307     procedure SetAlbum(Value: UnicodeString);
308     procedure SetGenre(Value: String); // Delphi-Default-String.
309     procedure SetYear(Value: String4);
310     procedure SetComment(Value: UnicodeString);
311     procedure SetTrack(Value: String); // Delphi-Default-String.
312     public
313     constructor Create;
314     destructor Destroy; override;
315     property TagExists: Boolean read FExists;
316     property Exists: Boolean read FExists;
317    
318     property Version: Byte read FVersion;
319     property Title: UnicodeString read GetTitle write SetTitle;
320     property Artist: UnicodeString read GetArtist write SetArtist;
321     property Album: UnicodeString read GetAlbum write SetAlbum;
322     property Genre: String read GetGenre write SetGenre; // Delphi-Default-String.
323     property Track: String read GetTrack write SetTrack; // Delphi-Default-String.
324     property Year: String4 read GetYear write SetYear;
325     property Comment: UnicodeString read GetComment write SetComment;
326    
327     property CharCode: TCodePage read FCharCode write FCharCode;
328     property AutoCorrectCodepage: Boolean read FAutoCorrectCodepage write FAutoCorrectCodepage;
329    
330     procedure Clear;
331     function ReadFromStream(Stream: TStream): TMP3Error;
332     function WriteToStream(Stream: TStream): TMP3Error;
333     function RemoveFromStream(Stream: TStream): TMP3Error;
334     function ReadFromFile(Filename: UnicodeString): TMP3Error; // UnicodeString
335     function WriteToFile(Filename: UnicodeString): TMP3Error;
336     function RemoveFromFile(Filename: UnicodeString): TMP3Error;
337     end;
338     //--------------------------------------------------------------------
339    
340    
341    
342     //--------------------------------------------------------------------
343     // Teil 3: Types for ID3v2-tags
344     //--------------------------------------------------------------------
345     TInt28 = array[0..3] of Byte; // Sync-Safe Integer
346    
347    
348     // Header-Structure of ID3v2-Tags
349     // same on all subversions
350     TID3v2Header = record
351     ID: array[1..3] of AnsiChar;
352     Version: Byte;
353     Revision: Byte;
354     Flags: Byte;
355     TagSize: TInt28;
356     end;
357    
358     TID3v2Tag = class(TObject)
359     private
360     Frames: TObjectList;
361     fExists: Boolean;
362     fVersion: TID3Version;
363     fFlgUnsynch: Boolean;
364     fFlgCompression: Boolean;
365     fFlgExtended: Boolean;
366     fFlgExperimental: Boolean;
367     fFlgFooterPresent: Boolean;
368     fFlgUnknown: Boolean;
369     fPaddingSize: LongWord;
370     fTagSize: LongWord;
371     fDataSize: LongWord;
372     fUsePadding: Boolean;
373     fUseClusteredPadding: Boolean;
374     fFilename: UnicodeString;
375    
376     // Always write Unicode?
377     // True: frames will be written as utf-16 always
378     // False: ..only if needed, Ansi otherwise (recommended for compatibilty to other taggers ;-))
379     fAlwaysWriteUnicode: Boolean;
380     fAutoCorrectCodepage: Boolean;
381     fCharCode: TCodePage;
382    
383     function GetFrameIDString(ID:TFrameIDs):AnsiString;
384    
385     function GetFrameIndex(ID:TFrameIDs):integer;
386     function GetUserTextFrameIndex(aDescription: UnicodeString): integer;
387     function GetDescribedTextFrameIndex(ID:TFrameIDs; Language:AnsiString; Description:UnicodeString): Integer;
388     function GetPictureFrameIndex(aDescription: UnicodeString): Integer;
389     function GetUserDefinedURLFrameIndex(Description: UnicodeString): Integer;
390     function GetPopularimaterFrameIndex(aEMail: AnsiString):integer;
391     function GetPrivateFrameIndex(aOwnerID: AnsiString): Integer;
392    
393     function GetDescribedTextFrame(ID:TFrameIDs; Language:AnsiString; Description: UnicodeString): UnicodeString;
394     procedure SetDescribedTextFrame(ID:TFrameIDs; Language:AnsiString; Description: UnicodeString; Value: UnicodeString);
395    
396     function ReadFrames(From: LongInt; Stream: TStream): TMP3Error;
397     function ReadHeader(Stream: TStream): TMP3Error;
398     procedure SyncStream(Source, Target: TStream);
399    
400     // property read functions
401     function GetTitle: UnicodeString;
402     function GetArtist: UnicodeString;
403     function GetAlbum: UnicodeString;
404     function ParseID3v2Genre(value: UnicodeString): UnicodeString;
405     function GetGenre: UnicodeString;
406     function GetTrack: UnicodeString;
407     function GetYear: UnicodeString;
408     function GetStandardComment: UnicodeString;
409     function GetStandardLyrics: UnicodeString;
410     function GetComposer: UnicodeString;
411     function GetOriginalArtist: UnicodeString;
412     function GetCopyright: UnicodeString;
413     function GetEncodedBy: UnicodeString;
414     function GetLanguages: UnicodeString;
415     function GetSoftwareSettings: UnicodeString;
416     function GetMediatype: UnicodeString;
417     function Getid3Length: UnicodeString;
418     function GetPublisher: UnicodeString;
419     function GetOriginalFilename: UnicodeString;
420     function GetOriginalLyricist: UnicodeString;
421     function GetOriginalReleaseYear: UnicodeString;
422     function GetOriginalAlbumTitel: UnicodeString;
423    
424     //property set functions
425     procedure SetTitle(Value: UnicodeString);
426     procedure SetArtist(Value: UnicodeString);
427     procedure SetAlbum(Value: UnicodeString);
428     function BuildID3v2Genre(value: UnicodeString): UnicodeString;
429     procedure SetGenre(Value: UnicodeString);
430     procedure SetTrack(Value: UnicodeString);
431     procedure SetYear(Value: UnicodeString);
432     procedure SetStandardComment(Value: UnicodeString);
433     procedure SetStandardLyrics(Value: UnicodeString);
434     procedure SetComposer(Value: UnicodeString);
435     procedure SetOriginalArtist(Value: UnicodeString);
436     procedure SetCopyright(Value: UnicodeString);
437     procedure SetEncodedBy(Value: UnicodeString);
438     procedure SetLanguages(Value: UnicodeString);
439     procedure SetSoftwareSettings(Value: UnicodeString);
440     procedure SetMediatype(Value: UnicodeString);
441     procedure Setid3Length(Value: UnicodeString);
442     procedure SetPublisher(Value: UnicodeString);
443     procedure SetOriginalFilename(Value: UnicodeString);
444     procedure SetOriginalLyricist(Value: UnicodeString);
445     procedure SetOriginalReleaseYear(Value: UnicodeString);
446     procedure SetOriginalAlbumTitel(Value: UnicodeString);
447    
448     function GetStandardUserDefinedURL: AnsiString;
449     procedure SetStandardUserDefinedURL(Value: AnsiString);
450    
451     // SetRatingAndCounter: use aRating = -1 or aCounter = -1 to let this value untouched
452     // use aRating = 0 AND aCounter = 0 to delete the frame
453     //procedure SetRatingAndCounter(aEMail: AnsiString; aRating: Integer {Byte}; aCounter: Integer{Cardinal});
454     function GetArbitraryRating: Byte;
455     procedure SetArbitraryRating(Value: Byte);
456     function GetArbitraryPersonalPlayCounter: Cardinal;
457     procedure SetArbitraryPersonalPlayCounter(Value: Cardinal);
458    
459     procedure SetCharCode(Value: TCodePage);
460     procedure SetAutoCorrectCodepage(Value: Boolean);
461    
462    
463     public
464    
465    
466     constructor Create;
467     destructor Destroy; override;
468    
469     // "Level 1": Easy access through properties.
470     // The setter and getter will do all the complicated stuff for you
471     property Title: UnicodeString read GetTitle write SetTitle;
472     property Artist: UnicodeString read GetArtist write SetArtist;
473     property Album: UnicodeString read GetAlbum write SetAlbum;
474     property Genre: UnicodeString read GetGenre write SetGenre;
475     property Track: UnicodeString read GetTrack write SetTrack;
476     property Year: UnicodeString read GetYear write SetYear;
477    
478     property Comment: UnicodeString read GetStandardComment write SetStandardComment;
479     property Lyrics : UnicodeString read GetStandardLyrics write SetStandardLyrics;
480     property URL: AnsiString read GetStandardUserDefinedURL write SetStandardUserDefinedURL;
481     property Rating: Byte read GetArbitraryRating write SetArbitraryRating;
482     property PlayCounter: Cardinal read GetArbitraryPersonalPlayCounter write SetArbitraryPersonalPlayCounter;
483    
484     property Composer: UnicodeString read GetComposer write SetComposer ;
485     property OriginalArtist: UnicodeString read GetOriginalArtist write SetOriginalArtist ;
486     property Copyright: UnicodeString read GetCopyright write SetCopyright ;
487     property EncodedBy: UnicodeString read GetEncodedBy write SetEncodedBy ;
488     property Languages: UnicodeString read GetLanguages write SetLanguages ;
489     property SoftwareSettings: UnicodeString read GetSoftwareSettings write SetSoftwareSettings;
490     property Mediatype: UnicodeString read GetMediatype write SetMediatype ;
491     property id3Length: UnicodeString read Getid3Length write Setid3Length ;
492     property Publisher: UnicodeString read GetPublisher write SetPublisher ;
493     property OriginalFilename: UnicodeString read GetOriginalFilename write SetOriginalFilename ;
494     property OriginalLyricist: UnicodeString read GetOriginalLyricist write SetOriginalLyricist ;
495     property OriginalReleaseYear: UnicodeString read GetOriginalReleaseYear write SetOriginalReleaseYear;
496     property OriginalAlbumTitel: UnicodeString read GetOriginalAlbumTitel write SetOriginalAlbumTitel ;
497    
498    
499     property FlgUnsynch : Boolean read fFlgUnsynch write fFlgUnsynch;
500     property FlgCompression : Boolean read fFlgCompression;
501     property FlgExtended : Boolean read fFlgExtended;
502     property FlgExperimental : Boolean read fFlgExperimental;
503     property FlgFooterPresent : Boolean read fFlgFooterPresent;
504     property FlgUnknown : Boolean read fFlgUnknown;
505    
506     property Size: LongWord read fTagSize;
507     property Exists: Boolean read fExists; // two properties twice
508     property TagExists: Boolean read fExists; // due to backward compatibility
509     property Padding: Longword read fPaddingSize; //
510     property PaddingSize:Longword read fPaddingSize; //
511    
512     property Version: TID3Version read fVersion;
513     property UsePadding: Boolean read fUsePadding write fUsePadding;
514     property UseClusteredPadding: Boolean read fUseClusteredPadding write fUseClusteredPadding;
515    
516     property AlwaysWriteUnicode: Boolean read fAlwaysWriteUnicode write fAlwaysWriteUnicode;
517    
518     property CharCode: TCodePage read fCharCode write SetCharCode;
519     property AutoCorrectCodepage: Boolean read fAutoCorrectCodepage write SetAutoCorrectCodepage;
520    
521     function ReadFromStream(Stream: TStream): TMP3Error;
522     function WriteToStream(Stream: TStream): TMP3Error;
523     function RemoveFromStream(Stream: TStream): TMP3Error;
524     function ReadFromFile(Filename: UnicodeString): TMP3Error;
525     function WriteToFile(Filename: UnicodeString): TMP3Error;
526     function RemoveFromFile(Filename: UnicodeString): TMP3Error;
527     procedure Clear;
528    
529    
530     // "Level 2": Some advanced Frames. Get/edit them on Tag-Level
531     // Setting a value to '' will delete the frame
532     function GetText(FrameID: TFrameIDs): UnicodeString;
533     procedure SetText(FrameID:TFrameIDs; Value: UnicodeString);
534    
535     // User defined TextFrames (TXXX)
536     function GetUserText(Description: UnicodeString): UnicodeString;
537     procedure SetUserText(Description, Value: UnicodeString);
538    
539     function GetURL(FrameID: TFrameIDs): AnsiString;
540     procedure SetURL(FrameID:TFrameIDs; Value: AnsiString);
541    
542     // Comments (COMM)
543     // Note: Delete by Set(..., '');
544     procedure SetExtendedComment(Language: AnsiString; Description: UnicodeString; value: UnicodeString);
545     function GetExtendedComment(Language: AnsiString; Description: UnicodeString): UnicodeString;
546    
547     // Lyrics
548     // Note: Delete by Set(..., '');
549     procedure SetLyrics(Language: AnsiString; Description: UnicodeString; value: UnicodeString);
550     function GetLyrics(Language: AnsiString; Description: UnicodeString): UnicodeString;
551    
552     // Pictures (APIC)
553     // Note: Delete by setting Stream = Nil
554     function GetPicture(stream: TStream; Description: UnicodeString): AnsiString; // R�Ekgabe: Mime-Type
555     procedure SetPicture(MimeTyp: AnsiString; PicType: Byte; Description: UnicodeString; stream: TStream);
556    
557     // User-defined URL (WXXX)
558     // Note: Delete by Set(..., '');
559     function GetUserDefinedURL(Description: UnicodeString): AnsiString;
560     procedure SetUserDefinedURL(Description: UnicodeString; Value: AnsiString);
561    
562     // Ratings (POPM)
563    
564     // Note: GetRating('*') gets an arbitrary rating (in case more than one exist in the tag)
565     function GetRating(aEMail: AnsiString): Byte;
566     //procedure SetRating(aEMail: AnsiString; Value: Byte); (method from version 0.5)
567     function GetPersonalPlayCounter(aEMail: AnsiString): Cardinal;
568     // procedure SetPersonalPlayCounter(aEMail: AnsiString; Value: Cardinal); (method from version 0.5)
569    
570     // SetRatingAndCounter('*', .., ..) overwrites an arbitrary rating/counter
571     // SetRatingAndCounter(.., -1, ..) lets the rating untouched
572     // SetRatingAndCounter(.., .., -1) lets the counter untouched
573     // SetRatingAndCounter(.., 0, 0) deletes the rating/counter-frame
574     procedure SetRatingAndCounter(aEMail: AnsiString; aRating: Integer {Byte}; aCounter: Integer{Cardinal});
575    
576     // Private Frames
577     function GetPrivateFrame(aOwnerID: AnsiString; Content: TStream): Boolean;
578     procedure SetPrivateFrame(aOwnerID: AnsiString; Content: TStream);
579    
580    
581    
582     // "Level 3": Manipulation on Frame-Level
583     // Be careful with writing on this level
584     // These Methods gives you some lists with different types of frames
585     // See ID3v2Frames.pas how to edit these Frames
586     function GetAllFrames: TObjectlist;
587     function GetAllTextFrames: TObjectlist;
588     function GetAllUserTextFrames: TObjectlist;
589     function GetAllCommentFrames: TObjectlist;
590     function GetAllLyricFrames: TObjectlist;
591     function GetAllUserDefinedURLFrames: TObjectlist;
592     function GetAllPictureFrames: TObjectlist;
593     function GetAllPopularimeterFrames: TObjectlist;
594     function GetAllURLFrames: TObjectlist;
595     function GetAllPrivateFrames: TObjectList;
596    
597     // Check, wether a new frame is valid, i.e. unique
598     function ValidNewCommentFrame(Language: AnsiString; Description: UnicodeString): Boolean;
599     function ValidNewLyricFrame(Language: AnsiString; Description: UnicodeString): Boolean;
600     function ValidNewPictureFrame(Description: UnicodeString): Boolean;
601     function ValidNewUserDefUrlFrame(Description: UnicodeString): Boolean;
602     function ValidNewPopularimeterFrame(EMail: AnsiString): Boolean;
603    
604     // Get allowed Frame-IDs (not every frame is allowed in every subversion)
605     function GetAllowedTextFrames: TList;
606     function GetAllowedURLFrames: TList; // WOAR, ... Not the user definied WXXX-Frame
607    
608     function AddFrame(aID: TFrameIDs): TID3v2Frame;
609     procedure DeleteFrame(aFrame: TID3v2Frame);
610     end;
611     //--------------------------------------------------------------------
612    
613    
614     //--------------------------------------------------------------------
615     // Teil 4. Types for MPEG
616     //--------------------------------------------------------------------
617    
618     TMpegHeader = record
619     version: byte;
620     layer: byte;
621     protection: boolean;
622     bitrate: LongInt;
623     samplerate: LongInt;
624     channelmode: byte;
625     extension: byte;
626     copyright: boolean;
627     original: boolean;
628     emphasis: byte;
629     padding: boolean;
630     framelength: word;
631     valid: boolean;
632     end;
633    
634     TXingHeader = record
635     Frames: integer;
636     Size: integer;
637     valid: boolean;
638     end;
639     TVBRIHeader = TXingHeader;
640    
641     TMpegInfo = class(TObject)
642     Private
643     FFilesize: int64;
644     Fversion:integer;
645     Flayer:integer;
646     Fprotection:boolean;
647     Fbitrate:word;
648     Fsamplerate:integer;
649     Fchannelmode:byte;
650     Fextension:byte;
651     Fcopyright:boolean;
652     Foriginal:boolean;
653     Femphasis:byte;
654     Fframes:Integer;
655     Fdauer:Longint;
656     Fvbr:boolean;
657     Fvalid: boolean;
658     FfirstHeaderPosition: int64;
659    
660     // Check, wether there is in aBuffer on position a valid MPEG-header
661     function GetValidatedHeader(aBuffer: TBuffer; position: integer): TMpegHeader;
662     // Check, wether the MPEG-header is followed by a Xing-Frame
663     function GetXingHeader(aMpegheader: TMpegHeader; aBuffer: TBuffer; position: integer ): TXingHeader;
664     function GetVBRIHeader(aMpegheader: TMpegHeader; aBuffer: TBuffer; position: integer ): TVBRIHeader;
665    
666     function GetFramelength(version:byte;layer:byte;bitrate:integer;Samplerate:integer;padding:boolean):integer;
667    
668     public
669     constructor create;
670     function LoadFromStream(stream: tStream): TMP3Error;
671     function LoadFromFile(FileName: UnicodeString): TMP3Error;
672     property Filesize: int64 read FFilesize;
673     property Version: integer read Fversion;
674     property Layer: integer read Flayer;
675     property Protection: boolean read Fprotection;
676     property Bitrate: word read Fbitrate;
677     property Samplerate: integer read Fsamplerate;
678     property Channelmode: byte read Fchannelmode;
679     property Extension: byte read Fextension;
680     property Copyright: boolean read Fcopyright;
681     property Original: boolean read Foriginal;
682     property Emphasis: byte read Femphasis;
683     property Frames: Integer read Fframes;
684     property Dauer: Longint read Fdauer;
685     property Duration: Longint read Fdauer; // Same as "Dauer" - for the english user ;-)
686     property Vbr: boolean read Fvbr;
687     property Valid: boolean read Fvalid;
688     property FirstHeaderPosition: int64 read FfirstHeaderPosition;
689     end;
690    
691    
692    
693     // Some useful functions.
694     // Use them e.g. in OnChange of a TEdit
695     function IsValidV2TrackString(value:string):boolean;
696     function IsValidV1TrackString(value:string):boolean;
697     function IsValidYearString(value:string):boolean;
698    
699     // Get a TrackNr. from a ID3v2-Tag-trackstring
700     // e.g.: 3/15 => 3
701     function GetTrackFromV2TrackString(value: string): Byte;
702    
703     const
704    
705     MPEG_BIT_RATES : array[1..3] of array[1..3] of array[0..15] of word =
706     { Version 1, Layer I }
707     (((0,32,64,96,128,160,192,224,256,288,320,352,384,416,448,0),
708     { Version 1, Layer II }
709     (0,32,48,56, 64, 80, 96,112,128,160,192,224,256,320,384,0),
710     { Version 1, Layer III }
711     (0,32,40,48, 56, 64, 80, 96,112,128,160,192,224,256,320,0)),
712     { Version 2, Layer I }
713     ((0,32,48, 56, 64, 80, 96,112,128,144,160,176,192,224,256,0),
714     { Version 2, Layer II }
715     (0, 8,16,24, 32, 40, 48, 56, 64, 80, 96, 112,128,144,160,0),
716     { Version 2, Layer III }
717     (0, 8,16,24, 32, 40, 48, 56, 64, 80, 96, 112,128,144,160,0)),
718     { Version 2.5, Layer I }
719     ((0,32,48, 56, 64, 80, 96,112,128,144,160,176,192,224,256,0),
720     { Version 2.5, Layer II }
721     (0, 8,16,24, 32, 40, 48, 56, 64, 80, 96, 112,128,144,160,0),
722     { Version 2.5, Layer III }
723     (0, 8,16,24, 32, 40, 48, 56, 64, 80, 96, 112,128,144,160,0)));
724    
725     sample_rates: array[1..3] of array [0..3] of word=
726     ((44100,48000,32000,0),
727     (22050,24000,16000,0),
728     (11025,12000,8000,0));
729     channel_modes:array[0..3] of string=('Stereo','Joint stereo','Dual channel (Stereo)','Single channel (Mono)');
730     extensions:array[1..3] of array [0..3] of string=
731     (('bands 4 to 31','bands 8 to 32','bands 12 to 31','bands 16 to 31'),
732     ('bands 4 to 31','bands 8 to 32','bands 12 to 31','bands 16 to 31'),
733     ('IS:off, MS:off','IS:on, MS:off','IS:off, MS:on','IS:on, MS:on'));
734     emphasis_values: array[0..3] of string = ('None', '50/15ms','reserved','CCIT J.17');
735    
736     {$Message Hint 'You should change the default rating description for your projects'}
737     var
738     DefaultRatingDescription: AnsiString = 'Mp3ileUtils, www.gausi.de';
739     // Changig this should be done e.g. in MainFormCreate or in the initialization-part
740     // It should be like "<Name of the program>, <URL to your webpage>"
741    
742    
743     var
744     Genres: TStringList;
745     LanguageCodes: TStringlist;
746     LanguageNames: TStringlist;
747    
748    
749     implementation
750    
751    
752    
753     //--------------------------------------------------------------------
754     // Some useful functions outside the classes
755     //--------------------------------------------------------------------
756    
757     //--------------------------------------------------------------------
758     // before Delphi 2009:
759     // * String is AnsiString
760     // * If no TNTs are used, Delphi cannot handle Unicode-Filenames
761     // * If TNTs are used, the following two methods will not be compiled
762     // and WideFileExists/-ExtractFileDrive will be the TNT-function with WideString-Parameter
763     // Delphi 2009:
764     // * TNTs are not used (as Delphi itself can handle Unicode)
765     // * String is UnicodeString
766     //--------------------------------------------------------------------
767     {$IFNDEF USE_TNT_COMPOS}
768     function WideFileExists(aString: string):boolean;
769     begin
770     result := FileExists(aString);
771     end;
772    
773     function WideExtractFileDrive(aString: String): string;
774     begin
775     result := ExtractFileDrive(aString);
776     end;
777     {$ENDIF}
778    
779    
780     //--------------------------------------------------------------------
781     // Check, wether Frame-ID is valid
782     //--------------------------------------------------------------------
783     function ValidFrame(ID: AnsiString): Boolean;
784     var
785     i: Cardinal;
786     begin
787     result := true;
788     for i := 1 to length(ID) do
789     if not (ID[i] in ['0'..'9', 'A'..'Z']) then
790     begin
791     result := false;
792     Break;
793     end;
794     end;
795    
796     function ValidTextFrame(ID: AnsiString): Boolean;
797     begin
798     result := (length(ID) >= 3) and (ID[1] = 'T');
799     end;
800    
801     //--------------------------------------------------------------------
802     // Convert a 28bit-integer to a 32bit-integer
803     //--------------------------------------------------------------------
804     function Int28ToInt32(Value: TInt28): LongWord;
805     begin
806     // Take the rightmost byte and let it there,
807     // take the second rightmost byte and move it 7bit to left
808     // (in an 32bit-variable)
809     // a.s.o.
810     result := (Value[3]) shl 0 or
811     (Value[2]) shl 7 or
812     (Value[1]) shl 14 or
813     (Value[0]) shl 21;
814     end;
815    
816     //--------------------------------------------------------------------
817     // Convert a 32bit-integer to a 28bit-integer
818     //--------------------------------------------------------------------
819     function Int32ToInt28(Value: LongWord): TInt28;
820     begin
821     // move every byte in Value to the right, take the 7 LSBs
822     // and assign them to the result
823     Result[3] := (Value shr 0) and $7F;
824     Result[2] := (Value shr 7) and $7F;
825     Result[1] := (Value shr 14) and $7F;
826     Result[0] := (Value shr 21) and $7F;
827     end;
828    
829     //--------------------------------------------------------------------
830     // Get a temporary filename
831     //--------------------------------------------------------------------
832     function GetTempFile: String;
833     var
834     Path: String;
835     i: Integer;
836     begin
837     SetLength(Path, 256);
838     FillChar(PChar(Path)^, 256 * sizeOf(Char), 0);
839     GetTempPath(256, PChar(Path));
840     Path := Trim(Path);
841     if Path[Length(Path)] <> '\' then
842     Path := Path + '\';
843     i := 0;
844     repeat
845     result := Path + 'TagTemp.t' + IntToHex(i, 2);
846     inc(i);
847     until not FileExists(result);
848     end;
849    
850    
851     //--------------------------------------------------------------------
852     // ID3v1 or ID3v1.1 ?
853     //--------------------------------------------------------------------
854     function GetID3v1Version(Tag: TID3v1Structure): Byte;
855     begin
856     // If the 29th byte of the comment is =0 an
857     // 30th <> 0, then this is the Track-nr.
858     if (Tag.Comment[29] = #00) and (Tag.Comment[30] <> #00) then
859     result := 1
860     else
861     result := 0;
862     end;
863    
864     //---------------------------------------------------
865     // check, wether value is a valid track-string for id3v2 ...
866     //---------------------------------------------------
867     function IsValidV2TrackString(value:string):boolean;
868     var
869     del: Integer;
870     Track, Overall: String;
871     begin
872     del := Pos('/', Value); // getting the position of the delimiter
873     if del = 0 then
874     // If there is none, then the whole string is the TrackNumber
875     result := (StrToIntDef(Value, -1) > -1)
876     else begin
877     Overall := Trim(Copy(Value, del + 1, Length(Value) - (del)));
878     Track := Trim(Copy(Value, 1, del - 1));
879     result := ((StrToIntDef(Track, -1) > -1) AND (StrToIntDef(Overall, -1) > -1))
880     end;
881     end;
882    
883     //--------------------------------------------------------------------
884     // ... and for v1
885     //--------------------------------------------------------------------
886     function IsValidV1TrackString(value:string):boolean;
887     begin
888     result := (StrToIntDef(Value, -1) > -1);
889     end;
890    
891     //--------------------------------------------------------------------
892     // Check for valid year
893     //--------------------------------------------------------------------
894     function IsValidYearString(value:string):boolean;
895     var tmp:integer;
896     begin
897     tmp := StrToIntDef(Value, -1);
898     result := (tmp > -1) AND (tmp < 10000);
899     end;
900    
901     //--------------------------------------------------------------------
902     // Get Track-Nr. from track-string
903     //--------------------------------------------------------------------
904     function GetTrackFromV2TrackString(value: string): Byte;
905     var
906     del: Integer;
907     Track: String;
908     begin
909     del := Pos('/', Value); // getting the position of the delimiter
910     if del = 0 then
911     // If there is none, then the whole string is the TrackNumber
912     result := StrToIntDef(Value, 0)
913     else begin
914     //Overall := Trim(Copy(Value, del + 1, Length(Value) - (del)));
915     Track := Trim(Copy(Value, 1, del - 1));
916     result := StrToIntDef(Track, 0);
917     end;
918     end;
919    
920     //--------------------------------------------------------------------
921     // Get a "reasonable" padding-size (i.e.: fill the last used cluster)
922     //--------------------------------------------------------------------
923     function GetPaddingSize(DataSize: Int64; aFilename: UnicodeString; UseClusterSize: Boolean): Cardinal;
924     var
925     Drive: string;
926     ClusterSize : Cardinal;
927     SectorPerCluster : Cardinal;
928     BytesPerSector : Cardinal;
929     NumberOfFreeClusters : Cardinal;
930     TotalNumberOfClusters : Cardinal;
931     begin
932     Drive := WideExtractFileDrive(aFileName);
933     if UseClusterSize and (trim(Drive) <> '')then
934     begin
935     if Drive[Length(Drive)]<>'\' then Drive := Drive+'\';
936     try
937     if GetDiskFreeSpace(PChar(Drive),
938     SectorPerCluster,
939     BytesPerSector,
940     NumberOfFreeClusters,
941     TotalNumberOfClusters) then
942     ClusterSize := SectorPerCluster * BytesPerSector
943     else
944     ClusterSize := 2048;
945     except
946     ClusterSize := 2048;
947     end;
948     end else
949     ClusterSize := 2048;
950     Result := (((DataSize DIV ClusterSize) + 1) * Clustersize) - DataSize;
951     end;
952    
953    
954     //--------------------------------------------------------------------
955     //--------------------------------------------------------------------
956     // *** TID3v1Tag ***
957     //--------------------------------------------------------------------
958     //--------------------------------------------------------------------
959    
960    
961     constructor TID3v1Tag.Create;
962     begin
963     inherited Create;
964     // Set default-values
965     Clear;
966     FCharCode := DefaultCharCode;
967     AutoCorrectCodepage := False;
968     end;
969    
970     destructor TID3v1Tag.destroy;
971     begin
972     inherited destroy;
973     end;
974    
975     // Read the Tag from a stream
976     function TID3v1Tag.ReadFromStream(Stream: TStream): TMP3Error;
977     var
978     RawTag: TID3v1Structure;
979     begin
980     clear;
981     result := MP3ERR_None;
982     FExists := False;
983     try
984     Stream.Seek(-128, soFromEnd);
985     if (Stream.Read(RawTag, 128) = 128) then
986     if (RawTag.ID = 'TAG') then
987     begin
988     FExists := True;
989     FVersion := GetID3v1Version(RawTag);
990     FTitle := (RawTag.Title);
991     FArtist := (RawTag.Artist);
992     FAlbum := (RawTag.Album);
993     FYear := (RawTag.Year);
994     //String4(Trim(String(FYear)));
995     if FVersion = 0 then
996     begin
997     FComment := (RawTag.Comment);
998     FTrack := 0;
999     end
1000     else
1001     begin
1002     Move(RawTag.Comment[1], FComment[1], 28);
1003     FComment[29] := #0;
1004     FComment[30] := #0;
1005     FTrack := Ord(RawTag.Comment[30]);
1006     end;
1007     FGenre := RawTag.Genre;
1008     end
1009     else
1010     result := ID3ERR_NoTag
1011     else
1012     result := MP3ERR_SRead;
1013     except
1014     on E: Exception do
1015     begin
1016     result := ID3ERR_Unclassified;
1017     MessageBox(0, PChar(E.Message), PChar('Error'), MB_OK or MB_ICONERROR or MB_TASKMODAL or MB_SETFOREGROUND);
1018     end;
1019     end;
1020     end;
1021    
1022     // Write Tag to a stream
1023     function TID3v1Tag.WriteToStream(Stream: TStream): TMP3Error;
1024     var
1025     RawTag: TID3v1Structure;
1026     Buffer: Array [1..3] of AnsiChar;
1027     begin
1028     result := MP3ERR_NONE;
1029     try
1030     FillChar(RawTag, 128, 0);
1031     RawTag.ID := 'TAG';
1032     Move(FTitle[1], RawTag.Title, Length(FTitle));
1033     Move(FArtist[1], RawTag.Artist, Length(FArtist));
1034     Move(FAlbum[1], RawTag.Album, Length(FAlbum));
1035     Move(FYear[1], RawTag.Year, Length(FYear));
1036     Move(FComment[1], RawTag.Comment, Length(FComment));
1037     if FTrack > 0 then
1038     begin
1039     RawTag.Comment[29] := #0;
1040     RawTag.Comment[30] := AnsiChar(Chr(FTrack));
1041     end;
1042     RawTag.Genre := FGenre;
1043    
1044     // Search for an existing tag and set position to write the new one
1045     Stream.Seek(-128, soFromEnd);
1046     Stream.Read(Buffer[1], 3);
1047     if (Buffer[1]='T') AND (Buffer[2]='A') AND (Buffer[3]='G') then
1048     Stream.Seek(-128, soFromEnd)
1049     else
1050     Stream.Seek(0, soFromEnd);
1051    
1052     if Stream.Write(RawTag, 128) <> 128 then
1053     result := MP3ERR_SWrite;
1054     except
1055     on E: Exception do
1056     begin
1057     result := ID3ERR_Unclassified;
1058     MessageBox(0, PChar(E.Message), PChar('Error'), MB_OK or MB_ICONERROR or MB_TASKMODAL or MB_SETFOREGROUND);
1059     end;
1060     end;
1061     end;
1062    
1063     // Delete Tag, if existing
1064     function TID3v1Tag.RemoveFromStream(Stream: TStream): TMP3Error;
1065     var
1066     Buffer: Array [1..3] of AnsiChar;
1067     begin
1068     result := MP3ERR_NONE;
1069     try
1070     Stream.Seek(-128, soFromEnd);
1071     Stream.Read(Buffer[1], 3);
1072     if (Buffer[1]='T') AND (Buffer[2]='A') AND (Buffer[3]='G') then
1073     begin
1074     Stream.Seek(-128, soFromEnd);
1075     SetStreamEnd(Stream);
1076     end
1077     else
1078     result := ID3ERR_NoTag;
1079     except
1080     on E: Exception do
1081     begin
1082     result := ID3ERR_Unclassified;
1083     MessageBox(0, PChar(E.Message), PChar('Error'), MB_OK or MB_ICONERROR or MB_TASKMODAL or MB_SETFOREGROUND);
1084     end;
1085     end;
1086     end;
1087    
1088     // Set default-values
1089     procedure TID3v1Tag.Clear;
1090     begin
1091     FTitle := String30(StringOfChar(#0, 30));
1092     FArtist := String30(StringOfChar(#0, 30));
1093     FAlbum := String30(StringOfChar(#0, 30));
1094     FYear := String4(StringOfChar(#0, 4));
1095     FComment := String30(StringOfChar(#0, 30));
1096    
1097     FTrack := 0;
1098     FGenre := 0;
1099     FVersion := 0;
1100     FExists := False;
1101     end;
1102    
1103     // read tag from a file
1104     // -> use stream-function
1105     function TID3v1Tag.ReadFromFile(Filename: UnicodeString): TMP3Error;
1106     var
1107     Stream: TMPFUFileStream;
1108     begin
1109     if WideFileExists(Filename) then
1110     try
1111     Stream := TMPFUFileStream.Create(Filename, fmOpenRead or fmShareDenyWrite);
1112     try
1113     result := ReadFromStream(Stream);
1114     finally
1115     Stream.Free;
1116     end;
1117     except
1118     result := MP3ERR_FOpenR;
1119     end
1120     else
1121     result := MP3ERR_NoFile;
1122     end;
1123    
1124     // Write a tag to a file
1125     // -> use stream-function
1126     function TID3v1Tag.WriteToFile(Filename: UnicodeString): TMP3Error;
1127     var
1128     Stream: TMPFUFileStream;
1129     begin
1130     if WideFileExists(Filename) then
1131     try
1132     Stream := TMPFUFileStream.Create(Filename, fmOpenReadWrite or fmShareDenyWrite);
1133     try
1134     result := WriteToStream(Stream);
1135     finally
1136     Stream.Free;
1137     end;
1138     except
1139     result := MP3ERR_FOpenRW;
1140     end
1141     else
1142     result := MP3ERR_NoFile;
1143     end;
1144    
1145     // Delete Tag from a file
1146     // -> use stream-function
1147     function TID3v1Tag.RemoveFromFile(Filename: UnicodeString): TMP3Error;
1148     var
1149     Stream: TMPFUFileStream;
1150     begin
1151     if WideFileExists(Filename) then
1152     try
1153     Stream := TMPFUFileStream.Create(Filename, fmOpenReadWrite or fmShareDenyWrite);
1154     try
1155     result := RemoveFromStream(Stream);
1156     finally
1157     Stream.Free;
1158     end;
1159     except
1160     result := MP3ERR_FOpenRW;
1161     end
1162     else
1163     result := MP3ERR_NoFile;
1164     end;
1165    
1166    
1167     // Converts a String[30] to UnicodeString
1168     // * if AutoCorrectCodepage=True then the conversion is done by the
1169     // given CodePage
1170     // * otherwise it will be done by delphi, i.e. the system-codepage
1171     function TID3v1Tag.GetConvertedUnicodeText(Value: String30): UnicodeString;
1172     var
1173     tmp: AnsiString;
1174     L: Integer;
1175     begin
1176     if AutoCorrectCodepage then
1177     begin
1178     L := MultiByteToWideChar(FCharCode.CodePage,
1179     MB_PRECOMPOSED, // Flags
1180     @Value[1], // data to convert
1181     Length(Value), // Size in bytes
1182     nil, // output - not used here
1183     0); // 0=> Get required BufferSize
1184    
1185     if L = 0 then
1186     begin
1187     // Something's wrong => Fall back to ANSI
1188     setlength(tmp, 30);
1189     move(Value[1], tmp[1], 30);
1190     {$IFDEF UNICODE}
1191     // use explicit typecast
1192     result := trim(String(tmp));
1193     {$ELSE}
1194     result := trim(tmp);
1195     {$ENDIF}
1196     end else
1197     begin
1198     // SetBuffer, Size in WChars, not Bytes.
1199     SetLength(Result, L);
1200     // Convert
1201     MultiByteToWideChar(FCharCode.CodePage,
1202     MB_PRECOMPOSED,
1203     @Value[1],
1204     length(Value),
1205     @Result[1],
1206     L);
1207     // trim string
1208     result := Trim(Result);
1209     end;
1210     end
1211    
1212     else
1213     begin
1214     // copy to AnsiString and typecast
1215     setlength(tmp,30);
1216     move(Value[1], tmp[1], 30);
1217     {$IFDEF UNICODE}
1218     // use explicit typecast
1219     result := trim(String(tmp));
1220     {$ELSE}
1221     result := trim(tmp);
1222     {$ENDIF}
1223     end;
1224     end;
1225    
1226     function TID3v1Tag.GetTitle: UnicodeString;
1227     begin
1228     result := GetConvertedUnicodeText(FTitle);
1229     end;
1230     function TID3v1Tag.GetArtist: UnicodeString;
1231     begin
1232     result := GetConvertedUnicodeText(FArtist);
1233     end;
1234     function TID3v1Tag.GetAlbum: UnicodeString;
1235     begin
1236     result := GetConvertedUnicodeText(FAlbum);
1237     end;
1238     function TID3v1Tag.GetComment: UnicodeString;
1239     begin
1240     result := GetConvertedUnicodeText(FComment);
1241     end;
1242     function TID3v1Tag.GetGenre: String;
1243     begin
1244     if FGenre <= 125 then
1245     result := Genres[FGenre]
1246     else
1247     result := '';
1248     end;
1249     function TID3v1Tag.GetTrack: String;
1250     begin
1251     result := IntToStr(FTrack);
1252     end;
1253    
1254     function TID3v1Tag.GetYear: String4;
1255     begin
1256     result := FYear;
1257     end;
1258    
1259    
1260     // Converts a UnicodeString to String[30]
1261     // * if AutoCorrectCodepage=True then the conversion is done by the
1262     // given CodePage
1263     // * otherwise it will be done by delphi, i.e. the system-codepage
1264     function TID3v1Tag.SetString30(value: UnicodeString): String30;
1265     var i, max, L: integer;
1266     tmpstr: AnsiString;
1267     begin
1268     result := String30(StringOfChar(#0, 30));
1269     if fAutoCorrectCodepage then
1270     begin
1271    
1272     if length(value) > 0 then
1273     begin
1274    
1275     L := WideCharToMultiByte(FCharCode.CodePage, // CodePage
1276     0, // Flags
1277     @Value[1], // String to Convert
1278     -1,//length(Value), // ... and its length
1279     Nil, // output, not needed here
1280     0, // and its length, 0 to get required length
1281     Nil, // DefaultChar, Nil=SystemDefault
1282     Nil); // DefaultChar needed
1283    
1284     if L = 0 then
1285     begin
1286     // Failure, Fall back to Ansi
1287     tmpstr := AnsiString(value);
1288     max := length(tmpstr);
1289     if max > 30 then max := 30;
1290     for i := 1 to max do
1291     result[i] := tmpstr[i];
1292     end
1293     else
1294     begin
1295     // use a tmp-AnsiString, as the UnicodeString may be longer
1296     SetLength(tmpstr, L);
1297     //tmpstr := (StringOfChar(#0, L));
1298     WideCharToMultiByte(FCharCode.CodePage, // CodePage
1299     0, // Flags
1300     @Value[1], // String to Convert
1301     -1, //length(Value), // ... and its length
1302     @tmpstr[1], // output
1303     L, // and its length
1304     Nil, // DefaultChar, Nil=SystemDefault
1305     Nil); // DefaultChar needed
1306    
1307    
1308     result := String30(tmpstr);
1309     end;
1310     end;
1311     end else
1312     begin
1313     // Write as Ansi
1314    
1315     tmpstr := AnsiString(value);
1316     max := length(tmpstr);
1317     if max > 30 then max := 30;
1318     for i := 1 to max do
1319     result[i] := tmpstr[i];
1320     end;
1321     end;
1322    
1323    
1324     procedure TID3v1Tag.SetTitle(Value: UnicodeString);
1325     begin
1326     FTitle := SetString30(Value);
1327     end;
1328     procedure TID3v1Tag.SetArtist(Value: UnicodeString);
1329     begin
1330     FArtist := SetString30(Value);
1331     end;
1332     procedure TID3v1Tag.SetAlbum(Value: UnicodeString);
1333     begin
1334     FAlbum := SetString30(Value);
1335     end;
1336     procedure TID3v1Tag.SetGenre(Value: String);
1337     var
1338     i: integer;
1339     begin
1340     i := Genres.IndexOf(Value);
1341     if i in [0..125] then
1342     FGenre := i
1343     else
1344     FGenre := 255; // undefined
1345     end;
1346    
1347     procedure TID3v1Tag.SetYear(Value: String4);
1348     begin
1349     FYear := Value;
1350     end;
1351    
1352     procedure TID3v1Tag.SetComment(Value: UnicodeString);
1353     begin
1354     FComment := SetString30(Value);
1355     end;
1356     procedure TID3v1Tag.SetTrack(Value : String);
1357     begin
1358     FTrack := StrToIntDef(Value, 0);
1359     end;
1360    
1361    
1362    
1363    
1364    
1365    
1366     //--------------------------------------------------------------------
1367     //--------------------------------------------------------------------
1368     // *** TID3v2Tag ***
1369     //--------------------------------------------------------------------
1370     //--------------------------------------------------------------------
1371    
1372     constructor TID3v2Tag.Create;
1373     begin
1374     inherited Create;
1375     Frames := TObjectList.Create(True);
1376    
1377     FUseClusteredPadding := True;
1378     AlwaysWriteUnicode := False;
1379     FCharCode := DefaultCharCode;
1380     AutoCorrectCodepage := False;
1381     FVersion.Major := 3;
1382     FVersion.Minor := 0;
1383     FExists := False;
1384     FTagSize := 0;
1385     fPaddingSize := 0;
1386     fFlgUnsynch := False;
1387     fFlgCompression := False;
1388     fFlgExtended := False;
1389     fFlgExperimental := False;
1390     fFlgFooterPresent := False;
1391     fFlgUnknown := False;
1392     end;
1393    
1394     Destructor TID3v2tag.Destroy;
1395     begin
1396     Frames.Free;
1397     inherited destroy;
1398     end;
1399    
1400     function TID3v2Tag.GetFrameIDString(ID:TFrameIDs):AnsiString;
1401     begin
1402     case fVersion.Major of
1403     2: result := ID3v2KnownFrames[ID].IDs[FV_2];
1404     3: result := ID3v2KnownFrames[ID].IDs[FV_3];
1405     4: result := ID3v2KnownFrames[ID].IDs[FV_4];
1406     else result := '';
1407     end;
1408     end;
1409    
1410     // Get the Index of a Frame (given by its ID) in the Frame-Array
1411     // Note: Use this only for unique frames.
1412     // DO NOT use it for frames like Comments, Picture, Lyrics
1413     function TID3v2Tag.GetFrameIndex(ID:TFrameIDs):integer;
1414     var i:integer;
1415     IDstr: AnsiString; // FrameIDs are ANSIStrings
1416     begin
1417     result := -1;
1418     idstr := GetFrameIDString(ID);
1419     for i := 0 to Frames.Count - 1 do
1420     begin
1421     if (Frames[i] as TID3v2Frame).FrameIDString = IDstr then
1422     begin
1423     result := i;
1424     break;
1425     end;
1426     end;
1427     end;
1428    
1429     function TID3v2Tag.GetUserTextFrameIndex(aDescription: UnicodeString): integer;
1430     var i: Integer;
1431     iDescription: UnicodeString;
1432     begin
1433     result := -1;
1434     for i := 0 to Frames.Count - 1 do
1435     begin
1436     if (TID3v2Frame(Frames[i]).FrameType = FT_UserTextFrame) then
1437     begin
1438     TID3v2Frame(Frames[i]).GetUserText(iDescription);
1439     If aDescription = iDescription then
1440     begin
1441     result := i;
1442     break;
1443     end;
1444     end;
1445     end;
1446     end;
1447    
1448     // Get the index of a Frame, given by its ID and a "language-description"-Combination
1449     // as used in Lyrics or Comments
1450     function TID3v2Tag.GetDescribedTextFrameIndex(ID:TFrameIDs; Language:AnsiString; Description: UnicodeString): Integer;
1451     var i:integer;
1452     IDstr: AnsiString;
1453     iLanguage: AnsiString;
1454     iDescription: UnicodeString;
1455     check: Boolean;
1456     begin
1457     result := -1;
1458     idstr := GetFrameIDString(ID);
1459     for i := 0 to Frames.Count - 1 do
1460     begin
1461     if (Frames[i] as TID3v2Frame).FrameIDString = IDstr then
1462     begin
1463     (Frames[i] as TID3v2Frame).GetCommentsLyrics(iLanguage, iDescription);
1464     check := False;
1465     if ((Language = '*') OR (Language = '')) or (Language = iLanguage) then
1466     Check := True;
1467     If Check and ((Description = '*') or (Description = iDescription)) then
1468     begin
1469     result := i;
1470     break;
1471     end;
1472     end;
1473     end;
1474     end;
1475     // Get the index of a Picture-Frame, given by its description
1476     function TID3v2Tag.GetPictureFrameIndex(aDescription: UnicodeString): Integer;
1477     var mime, idstr: AnsiString;
1478     i: integer;
1479     PictureData : TMemoryStream;
1480     desc: UnicodeString;
1481     picTyp: Byte;
1482     begin
1483     result := -1;
1484     idstr := GetFrameIDString(IDv2_PICTURE);
1485     for i := 0 to Frames.Count - 1 do
1486     if (Frames[i] as TID3v2Frame).FrameIDString = IDstr then
1487     begin
1488     // matching IDstring found
1489     PictureData := TMemoryStream.Create;
1490     (Frames[i] as TID3v2Frame).GetPicture(Mime, PicTyp, Desc, PictureData);
1491     PictureData.Free;
1492    
1493     if (aDescription = Desc) or (aDescription = '*') then
1494     begin
1495     // matching description found
1496     result := i;
1497     break;
1498     end;
1499     end;
1500     end;
1501     // Get the index of a URL-Frame, given by its description
1502     function TID3v2Tag.GetUserDefinedURLFrameIndex(Description: UnicodeString): Integer;
1503     var i: Integer;
1504     IDstr: AnsiString;
1505     iDescription: UnicodeString;
1506     begin
1507     result := -1;
1508     idstr := GetFrameIDString(IDv2_USERDEFINEDURL);
1509     for i := 0 to Frames.Count - 1 do
1510     begin
1511     if (Frames[i] as TID3v2Frame).FrameIDString = IDstr then
1512     begin
1513     (Frames[i] as TID3v2Frame).GetUserdefinedURL(iDescription);
1514     If Description = iDescription then
1515     begin
1516     result := i;
1517     break;
1518     end;
1519     end;
1520     end;
1521     end;
1522     // Get the index of a Rating-Frame, given by its user-email
1523     function TID3v2Tag.GetPopularimaterFrameIndex(aEMail: AnsiString):integer;
1524     var idstr, iEMail: AnsiString;
1525     i: Integer;
1526     begin
1527     result := -1;
1528     idstr := GetFrameIDString(IDv2_RATING);
1529     for i := 0 to Frames.Count - 1 do
1530     if (Frames[i] as TID3v2Frame).FrameIDString = IDstr then
1531     begin
1532     (Frames[i] as TID3v2Frame).GetRating(iEMail);
1533     if (aEMail = iEMail) or (aEMail = '*') then
1534     begin
1535     result := i;
1536     break;
1537     end;
1538     end;
1539     end;
1540    
1541    
1542     function TID3v2Tag.GetPrivateFrameIndex(aOwnerID: AnsiString): Integer;
1543     var i: Integer;
1544     idStr, iOwner: AnsiString;
1545     dummyStream: TStream;
1546     begin
1547     result := -1;
1548     idstr := GetFrameIDString(IDv2_Private);
1549     for i := 0 to Frames.Count - 1 do
1550     if (Frames[i] as TID3v2Frame).FrameIDString = IDstr then
1551     begin
1552     dummyStream := TMemoryStream.Create;
1553     try
1554     (Frames[i] as TID3v2Frame).GetPrivateFrame(iOwner, dummyStream);
1555     finally
1556     dummyStream.Free;
1557     end;
1558     if (aOwnerID = iOwner) then
1559     begin
1560     result := i;
1561     break;
1562     end;
1563     end;
1564     end;
1565    
1566    
1567     //--------------------------------------------------------------------
1568     // Read the ID3v2Header
1569     //--------------------------------------------------------------------
1570     function TID3v2Tag.ReadHeader(Stream: TStream): TMP3Error;
1571     var
1572     RawHeader: TID3v2Header;
1573     ExtendedHeader: Array[0..3] of byte;
1574     ExtendedHeaderSize: Integer;
1575     begin
1576     result := MP3ERR_None;
1577     try
1578     Stream.Seek(0, soFromBeginning);
1579     Stream.ReadBuffer(RawHeader, 10);
1580     if RawHeader.ID = 'ID3' then
1581     if RawHeader.Version in [2,3,4] then
1582     begin
1583     FTagSize := Int28ToInt32(RawHeader.TagSize) + 10;
1584     FExists := True;
1585     case RawHeader.Version of
1586     2: begin
1587     FFlgUnsynch := (RawHeader.Flags and 128) = 128;
1588     fFlgCompression := (RawHeader.Flags and 64) = 64;
1589     fFlgUnknown := (RawHeader.Flags and 63) <> 0;
1590     FFlgExtended := False;
1591     FFlgExperimental := False;
1592     if fFlgCompression then
1593     result := ID3ERR_Compression;
1594     FFlgFooterPresent := False;
1595     end;
1596     3: begin
1597     FFlgUnsynch := (RawHeader.Flags and 128) = 128;
1598     FFlgExtended := (RawHeader.Flags and 64) = 64;
1599     FFlgExperimental := (RawHeader.Flags and 32) = 32;
1600     fFlgUnknown := (RawHeader.Flags and 31) <> 0;
1601     fFlgCompression := False;
1602     FFlgFooterPresent := False;
1603     end;
1604     4: begin
1605     FFlgUnsynch := (RawHeader.Flags and 128) = 128;
1606     FFlgExtended := (RawHeader.Flags and 64) = 64;
1607     FFlgExperimental := (RawHeader.Flags and 32) = 32;
1608     fFlgCompression := False;
1609     FFlgFooterPresent := (RawHeader.Flags and 16) = 16;
1610     fFlgUnknown := (RawHeader.Flags and 15) <> 0;
1611     if FFlgFooterPresent then
1612     FTagSize := FTagSize + 10;
1613     end;
1614     end;
1615    
1616     // Version
1617     FVersion.Major := RawHeader.Version;
1618     FVersion.Minor := RawHeader.Revision;
1619    
1620     // extendedHeader: Just read its size and ignore the rest
1621     if FFlgExtended then
1622     begin
1623     // Size is SyncSafe in subversion 2.4
1624     Stream.ReadBuffer(ExtendedHeader[0], 4); // Minimum-size is 6bytes
1625     if fversion.Major =4 then
1626     ExtendedHeaderSize := 2097152 * ExtendedHeader[0]
1627     + 16384 * ExtendedHeader[1]
1628     + 128 * ExtendedHeader[2]
1629     + ExtendedHeader[3]
1630     else
1631     ExtendedHeaderSize := 16777216 * ExtendedHeader[0]
1632     + 65536 * ExtendedHeader[1]
1633     + 256 * ExtendedHeader[2]
1634     + ExtendedHeader[3];
1635    
1636     Stream.Seek(ExtendedHeaderSize, soFromCurrent);
1637     // ExtendedHeaderSize is the size _Excluding_ the 4 Size-Bytes
1638     // thanks to J�Egen vom Projekt inEx information explorer
1639     end;
1640     end
1641     else
1642     // subversion <> 2,3 or 4: invalid Header, invalid Tag
1643     result := ID3ERR_Invalid_Header
1644     else
1645     result := ID3ERR_NoTag;
1646     except
1647     on EReadError do result := MP3ERR_SRead;
1648     on E: Exception do
1649     begin
1650     result := ID3ERR_Unclassified;
1651     MessageBox(0, PChar(E.Message), PChar('Error'), MB_OK or MB_ICONERROR or MB_TASKMODAL or MB_SETFOREGROUND);
1652     end;
1653     end;
1654     end;
1655    
1656     //--------------------------------------------------------------------
1657     // Read the frames of the ID3v2 Tags
1658     //--------------------------------------------------------------------
1659     function TID3v2Tag.ReadFrames(From: LongInt; Stream: TStream): TMP3Error;
1660     var FrameIDstr: AnsiString;
1661     newFrame: TID3v2Frame;
1662     begin
1663     result := MP3ERR_None;
1664     FUsePadding := False;
1665     try
1666     case fVersion.Major of
1667     // Version 2-Header has a size of 6 bytes (3 Byte ID, 3 Byte size)
1668     2 : Setlength(FrameIDstr,3)
1669     else Setlength(FrameIDstr,4);
1670     end;
1671    
1672     if Stream.Position <> From then
1673     Stream.Position := From;
1674    
1675     // delete old frames (from "self", not from the file ;-))
1676     Frames.Clear;
1677    
1678     while (Stream.Position < (FTagSize - fPaddingSize))
1679     and (Stream.Position < Stream.Size) do
1680     begin
1681     // read FrameID
1682     Stream.Read(FrameIDStr[1], length(FrameIDStr));
1683    
1684     if ValidFrame(FrameIDstr) then
1685     begin
1686     newFrame := TID3v2Frame.Create(FrameIDstr, TID3v2FrameVersions(FVersion.Major));
1687     newFrame.ReadFromStream(Stream);
1688     NewFrame.AlwaysWriteUnicode := fAlwaysWriteUnicode;
1689    
1690     newFrame.CharCode := fCharCode;
1691     NewFrame.AutoCorrectCodepage := fAutoCorrectCodepage;
1692    
1693     Frames.Add(newFrame);
1694     end else
1695     // No valid Frame found. Rest of the Tag is padding
1696     // (I ignore the ID3v2-footer)
1697     begin
1698     fPaddingSize := FTagSize - (Stream.Position - length(FrameIDStr));
1699     FUsePadding := True;
1700     Break;
1701     end;
1702     end;
1703    
1704     except
1705     on EReadError do result := MP3ERR_SRead;
1706     on E: Exception do
1707     begin
1708     result := ID3ERR_Unclassified;
1709     MessageBox(0, PChar(E.Message), PChar('Error'), MB_OK or MB_ICONERROR or MB_TASKMODAL or MB_SETFOREGROUND);
1710     end;
1711     end;
1712     end;
1713    
1714     // SyncStream:
1715     // Replace all $FF 00 by $FF
1716     // See Unsynchronisation-Scheme on id3.org for details.
1717     procedure TID3v2Tag.SyncStream(Source, Target: TStream);
1718     var buf: TBuffer;
1719     i, last: Int64;
1720     begin
1721     if FTagSize = 0 then exit; // this should never occur
1722     setlength(buf, FTagSize);
1723     Source.Read(buf[0], FTagSize);
1724     Target.Size := FTagSize;
1725     i := 0;
1726     last := 0;
1727     while i <= length(buf)-1 do
1728     begin
1729     While (i < length(buf)-2) and ((buf[i] <> $FF) or (buf[i+1] <> $00)) do
1730     inc(i);
1731     // i is now at most length(buf)-2
1732     // or buf[i] = 255 and buf[i+1] = 0
1733     // => copy from last position to i into the new stream and skip buf[i+1]
1734     Target.Write(buf[last], i - last + 1);
1735     last := i + 2;
1736     inc(i, 2); // d.h. last = i
1737     end;
1738     // write the rest
1739     if last <= length(buf)-1 then
1740     Target.Write(buf[last], length(buf) - last);
1741    
1742     SetStreamEnd(Target);
1743     end;
1744    
1745     //--------------------------------------------------------------------
1746     // read the tag. Header first, Frames afterwards
1747     //--------------------------------------------------------------------
1748     function TID3v2Tag.ReadFromStream(Stream: TStream): TMP3Error;
1749     var SyncedStream: TMemoryStream;
1750     begin
1751     // Clear self
1752     clear;
1753    
1754     result := ReadHeader(Stream);
1755     if (FExists) and (result = MP3ERR_None) then
1756     begin
1757     // if unsync and subversion 2.2 or 2.3 then:
1758     // ReadfromStream - Synch to new stream - Readframes from new stream
1759     if (Version.Major <> 4) and (FFlgUnsynch) then
1760     begin
1761     SyncedStream := TMemoryStream.Create;
1762     try
1763     SyncStream(Stream, SyncedStream);
1764     SyncedStream.Position := 0;
1765     result := ReadFrames(SyncedStream.Position, SyncedStream);
1766     finally
1767     SyncedStream.Free;
1768     end;
1769     end else
1770     begin
1771     // otheriwse: read frames from original stream
1772     // but: copy the whole thing first - should be faster on slow devices
1773     // Note: Synch on subversion 2.4 is done on frame-level
1774     SyncedStream := TMemoryStream.Create;
1775     try
1776     SyncedStream.CopyFrom(Stream, fTagSize - Stream.Position);
1777     SyncedStream.Position := 0;
1778     result := ReadFrames(SyncedStream.Position, SyncedStream)
1779     finally
1780     SyncedStream.Free;
1781     end;
1782     end;
1783     end;
1784     end;
1785    
1786    
1787     //--------------------------------------------------------------------
1788     // write tag
1789     //--------------------------------------------------------------------
1790     function TID3v2Tag.WriteToStream(Stream: TStream): TMP3Error;
1791     var
1792     aHeader: TID3v2Header;
1793     TmpStream, ID3v2Stream: TMPFUFileStream;
1794     TmpName, FrameName: String; // temporary filenames. Delphi-Default-Strings
1795     v1Tag: String[3];
1796     v1AdditionalPadding: Cardinal;
1797     Buffer: TBuffer;
1798     CacheAudio: Boolean;
1799     i: Integer;
1800     AudioDataSize: int64;
1801     tmpFrameStream: TMemoryStream;
1802     ExistingID3Tag: TID3v2Tag;
1803     begin
1804     result := MP3ERR_None;
1805     AudioDataSize := 0;
1806     v1AdditionalPadding := 0;
1807    
1808     // A ID3v2Tag must contain at least one frame, and this must be at least one byte long
1809     // If all Frames are deleted, one frame must be restored - I choose
1810     // "Title" and set it to ' ' (one space)
1811     //
1812     // Note: Other frames are not empty - they will care for it by themself. ;-)
1813     if Frames.Count = 0 then
1814     Title := ' ';
1815    
1816    
1817     // write frames to temporary file
1818     FrameName := GetTempFile;
1819     try
1820     ID3v2Stream := TMPFUFileStream.Create(FrameName, fmCreate or fmShareDenyWrite);
1821    
1822     try
1823     // build a new header
1824     // size is unkown yet - must be set later in this method
1825     aHeader.ID := 'ID3';
1826     aHeader.Version := fVersion.Major;
1827     aHeader.Revision := fVersion.Minor;
1828     for i:=0 to 3 do
1829     aHeader.TagSize[i] := 0;
1830    
1831     if fFlgUnsynch then
1832     begin
1833     // set unsnych-flag in header
1834     aHeader.Flags := $80;
1835     // write header. Size will be corrected later in this method
1836     ID3v2Stream.WriteBuffer(aHeader,10);
1837     case fversion.Major of
1838     2,3: begin
1839     // write frames, unsynch here
1840     tmpFrameStream := TMemoryStream.Create;
1841     for i := 0 to Frames.Count - 1 do
1842     (Frames[i] as TID3v2Frame).WriteToStream(tmpFrameStream);
1843     tmpFrameStream.Position := 0;
1844     UnSyncStream(tmpFrameStream, ID3v2Stream);
1845     tmpFrameStream.Free;
1846     end ;
1847     4: begin
1848     // write frames, unsynch in frames
1849     for i := 0 to Frames.Count - 1 do
1850     (Frames[i] as TID3v2Frame).WriteUnsyncedToStream(ID3v2Stream);
1851     end;
1852     end;
1853     end else
1854     begin
1855     // write frames, no unsynch
1856     aHeader.Flags := $00;
1857     ID3v2Stream.WriteBuffer(aHeader,10);
1858     for i := 0 to Frames.Count - 1 do
1859     (Frames[i] as TID3v2Frame).WriteToStream(ID3v2Stream);
1860     end;
1861    
1862     // proceed with writing the mp3-file
1863     if ID3v2Stream.Size > 0 then
1864     begin
1865     // Check stream for existing tag
1866     ExistingID3Tag := TID3v2Tag.Create;
1867     ExistingID3Tag.ReadHeader(Stream);
1868    
1869     // jump to the end of this tag
1870     Stream.Seek(ExistingID3Tag.FTagSize, soFromBeginning);
1871    
1872     // CacheAudio: If the new Tag is bigger than the existing or no padding is wanted,
1873     // then the whole file must be rewritten. -> Cache Audiodata in this case.
1874     if FUsePadding and (ExistingID3Tag.FTagSize > (ID3v2Stream.Size + 30)) then
1875     CacheAudio := False
1876     else
1877     CacheAudio := True;
1878    
1879     if CacheAudio then
1880     begin
1881     // Existing ID3v2Tag is too small (or too big in case of no padding) for the new one
1882     // Write Audiodata to temporary file
1883     TmpName := GetTempFile;
1884     try
1885     TmpStream := TMPFUFileStream.Create(TmpName, fmCreate or fmShareDenyWrite);
1886     TmpStream.Seek(0, soFromBeginning);
1887    
1888     AudioDataSize := Stream.Size - Stream.Position;
1889     if TmpStream.CopyFrom(Stream, Stream.Size - Stream.Position) <> AudioDataSize then
1890     begin
1891     TmpStream.Free;
1892     result := ID3ERR_Cache;
1893     Exit;
1894     end;
1895    
1896     // Check for ID3v1Tag
1897     // adjust paddingsize, so that an id3v1Tag will not need another cluster on disk
1898     Stream.Seek(-128, soFromEnd);
1899     v1Tag := ' ';
1900     if (Stream.Read(v1Tag[1], 3) = 3) then
1901     begin
1902     if (v1Tag = 'TAG') then
1903     v1AdditionalPadding := 0
1904     else
1905     v1AdditionalPadding := 128;
1906     end;
1907     TmpStream.Free;
1908     except
1909     result := ID3ERR_Cache;
1910     // Failure -> Exit, to not damage the file
1911     Exit;
1912     end;
1913     end;
1914    
1915     // situation here:
1916     // Old Audiodata is in "tmpstream" (if neccessary)
1917     // New ID3Tag is in "ID3v2Stream"
1918     // But: Header is invalid, as the tags size was unknown before
1919     FDataSize := ID3v2Stream.Size;
1920     if FUsePadding then
1921     begin
1922     // Get paddingsize
1923     if CacheAudio then
1924     begin
1925     fPaddingSize := GetPaddingSize(AudioDataSize + FDataSize + v1AdditionalPadding, FFilename, FUseClusteredPadding);
1926     FTagSize := FDataSize + fPaddingSize;
1927     end
1928     else begin
1929     fPaddingSize := ExistingID3Tag.FTagSize - FDataSize;
1930     FTagSize := ExistingID3Tag.FTagSize;
1931     end;
1932     end else
1933     begin
1934     // Padding-size is 0
1935     fPaddingSize := 0;
1936     FTagSize := FDataSize;
1937     end;
1938    
1939     // Correct the Headersize
1940     aHeader.TagSize := Int32ToInt28(FTagSize - 10);
1941     ID3v2Stream.Seek(0, soFromBeginning);
1942     ID3v2Stream.WriteBuffer(aHeader,10);
1943    
1944     // Finally, write all the new stuff into the stream
1945     Stream.Seek(0, soFromBeginning);
1946     ID3v2Stream.Seek(0, soFromBeginning);
1947    
1948     // write new tag
1949     Stream.CopyFrom(ID3v2Stream, ID3v2Stream.Size);
1950     // write padding
1951     if fPaddingSize > 0 then
1952     begin
1953     setlength(Buffer, fPaddingSize);
1954     FillChar(Buffer[0], fPaddingSize, 0);
1955     Stream.Write(Buffer[0], fPaddingSize);
1956     end;
1957     // write audiodata
1958     if CacheAudio then
1959     begin
1960     try
1961     TmpStream := TMPFUFileStream.Create(TmpName, fmOpenRead);
1962     try
1963     TmpStream.Seek(0, soFromBeginning);
1964     Stream.CopyFrom(TmpStream, TmpStream.Size);
1965     SetStreamEnd(Stream);
1966     finally
1967     TmpStream.Free;
1968     end;
1969     except
1970     result := MP3ERR_FOpenR;
1971     Exit;
1972     end;
1973     end;
1974     // delete cache
1975     DeleteFile(PChar(TmpName));
1976    
1977     // delete existing-tag-object
1978     ExistingID3Tag.Free;
1979    
1980     end; // if ID3v2Stream.Size > 0;
1981    
1982     finally
1983     ID3v2Stream.Free;
1984     // delete cache
1985     DeleteFile(PChar(FrameName));
1986     end;
1987     except
1988     on EFCreateError do result := MP3ERR_FopenCRT;
1989     on EWriteError do result := MP3ERR_SWrite;
1990     on E: Exception do
1991     begin
1992     result := ID3ERR_Unclassified;
1993     MessageBox(0, PChar(E.Message), PChar('Error Error'), MB_OK or MB_ICONERROR or MB_TASKMODAL or MB_SETFOREGROUND);
1994     end;
1995     end;
1996     end;
1997    
1998     //--------------------------------------------------------------------
1999     // delete tag
2000     //--------------------------------------------------------------------
2001     function TID3v2Tag.RemoveFromStream(Stream: TStream): TMP3Error;
2002     var
2003     TmpStream: TMPFUFileStream;
2004     TmpName: String; // temporary filename. Delphi-Default-String
2005     tmpsize: int64;
2006     ExistingID3Tag: TID3v2Tag;
2007     begin
2008     result := MP3ERR_None;
2009     try
2010     ExistingID3Tag := TID3v2Tag.Create;
2011     ExistingID3Tag.ReadHeader(Stream);
2012    
2013     // if a Tag existiert...
2014     if ExistingID3Tag.FExists then
2015     begin
2016     // ...jump to its end...
2017     Stream.Seek(ExistingID3Tag.FTagSize, soFromBeginning);
2018    
2019     // ...cache Audiodat to temporary file...
2020     TmpName := GetTempFile;
2021     try
2022     TmpStream := TMPFUFileStream.Create(TmpName, fmCreate);
2023     try
2024     TmpStream.Seek(0, soFromBeginning);
2025     tmpsize := Stream.Size - Stream.Position;
2026     if TmpStream.CopyFrom(Stream, Stream.Size - Stream.Position) <> tmpsize then
2027     begin
2028     TmpStream.Free;
2029     ExistingID3Tag.Free;
2030     result := ID3ERR_Cache;
2031     Exit;
2032     end;
2033     // ...cut the stream...
2034     Stream.Seek(-ExistingID3Tag.FTagSize, soFromEnd);
2035     SetStreamEnd(Stream);
2036     ExistingID3Tag.Free;
2037     // ...and write the audiodata back.
2038     Stream.Seek(0, soFromBeginning);
2039     TmpStream.Seek(0, soFromBeginning);
2040     if Stream.CopyFrom(TmpStream, TmpStream.Size) <> TmpStream.Size then
2041     begin
2042     TmpStream.Free;
2043     ExistingID3Tag.Free;
2044     result := ID3ERR_Cache;
2045     Exit;
2046     end;
2047     except
2048     on EWriteError do result := MP3ERR_SWrite;
2049     on E: Exception do
2050     begin
2051     result := ID3ERR_Unclassified;
2052     MessageBox(0, PChar(E.Message), PChar('Error'), MB_OK or MB_ICONERROR or MB_TASKMODAL or MB_SETFOREGROUND);
2053     end;
2054     end;
2055     // delete tmp-file
2056     TmpStream.Free;
2057     DeleteFile(PChar(TmpName));
2058     except
2059     on EFOpenError do result := MP3ERR_FOpenCRT;
2060     on E: Exception do
2061     begin
2062     result := ID3ERR_Unclassified;
2063     MessageBox(0, PChar(E.Message), PChar('Error'), MB_OK or MB_ICONERROR or MB_TASKMODAL or MB_SETFOREGROUND);
2064     end;
2065     end;
2066     end
2067     else
2068     begin
2069     ExistingID3Tag.Free;
2070     result := ID3ERR_NoTag;
2071     end;
2072     except
2073     on E: Exception do
2074     begin
2075     result := ID3ERR_Unclassified;
2076     MessageBox(0, PChar(E.Message), PChar('Error'), MB_OK or MB_ICONERROR or MB_TASKMODAL or MB_SETFOREGROUND);
2077     end;
2078     end;
2079     end;
2080    
2081    
2082     //--------------------------------------------------------------------
2083     // read tag from file
2084     //--------------------------------------------------------------------
2085     function TID3v2Tag.ReadFromFile(Filename: UnicodeString): TMP3Error;
2086     var Stream: TMPFUFileStream;
2087     begin
2088     if WideFileExists(Filename) then
2089     try
2090     FFilename := Filename;
2091     Stream := TMPFUFileStream.Create(Filename, fmOpenRead or fmShareDenyWrite);
2092     try
2093     result := ReadFromStream(Stream);
2094     finally
2095     Stream.Free;
2096     end;
2097     except
2098     result := MP3ERR_FOpenR;
2099     end
2100     else
2101     result := MP3ERR_NoFile;
2102     end;
2103    
2104     //--------------------------------------------------------------------
2105     // write tag to file
2106     //--------------------------------------------------------------------
2107     function TID3v2Tag.WriteToFile(Filename: UnicodeString): TMP3Error;
2108     var Stream: TMPFUFileStream;
2109     begin
2110     if WideFileExists(Filename) then
2111     try
2112     FFilename := Filename;
2113     Stream := TMPFUFileStream.Create(Filename, fmOpenReadWrite or fmShareDenyWrite);
2114     try
2115     result := WriteToStream(Stream);
2116     finally
2117     Stream.Free;
2118     end;
2119     except
2120     result := MP3ERR_FOpenRW;
2121     end
2122     else
2123     result := MP3ERR_NoFile;
2124     end;
2125    
2126     //--------------------------------------------------------------------
2127     // delete tag from file
2128     //--------------------------------------------------------------------
2129     function TID3v2Tag.RemoveFromFile(Filename: UnicodeString): TMP3Error;
2130     var Stream: TMPFUFileStream;
2131     begin
2132     if WideFileExists(Filename) then
2133     try
2134     FFilename := Filename;
2135     Stream := TMPFUFileStream.Create(Filename, fmOpenReadWrite or fmShareDenyWrite);
2136     try
2137     result := RemoveFromStream(Stream);
2138     finally
2139     Stream.Free;
2140     end;
2141     except
2142     result := MP3ERR_FOpenRW;
2143     end
2144     else
2145     result := MP3ERR_NoFile;
2146     end;
2147    
2148    
2149     procedure TID3v2Tag.Clear;
2150     begin
2151     // default-subversion is 3. I think this is common to most other taggers
2152     FVersion.Major := 3;
2153     FVersion.Minor := 0;
2154     FTagSize := 0;
2155     FDataSize :=0;
2156     fPaddingSize := 0;
2157     FExists := False;
2158     FUsePadding := True;
2159     fFlgUnsynch := False;
2160     fFlgCompression := False;
2161     fFlgExtended := False;
2162     fFlgExperimental := False;
2163     fFlgFooterPresent := False;
2164     fFlgUnknown := False;
2165     FUseClusteredPadding := True;
2166    
2167     Frames.Clear;
2168     end;
2169    
2170    
2171     //--------------------------------------------------------------------
2172     // Get the text from a text-frame
2173     //--------------------------------------------------------------------
2174     function TID3v2Tag.GetText(FrameID: TFrameIDs): UnicodeString;
2175     var i:integer;
2176     begin
2177     i := GetFrameIndex(FrameID);
2178     if i > -1 then
2179     result := (Frames[i] as TID3v2Frame).GetText
2180     else
2181     result := '';
2182     end;
2183    
2184     //--------------------------------------------------------------------
2185     // Write a String in a text-frame
2186     // if value = '', the frame will be deleted
2187     //--------------------------------------------------------------------
2188     procedure TID3v2Tag.SetText(FrameID:TFrameIDs; Value: UnicodeString);
2189     var i:integer;
2190     idStr: AnsiString;
2191     NewFrame: TID3v2Frame;
2192     begin
2193     // Check for valid frame-id
2194     idStr := GetFrameIDString(FrameID);
2195     if not ValidTextFrame(iDStr) then exit;
2196    
2197     i := GetFrameIndex(FrameID);
2198     if i > -1 then
2199     begin
2200     // Frame already exists
2201     if value = '' then
2202     Frames.Delete(i)
2203     else
2204     (Frames[i] as TID3v2Frame).SetText(Value);
2205     end
2206     else
2207     if value <> '' then
2208     begin
2209     // create new frame
2210     NewFrame := TID3v2Frame.Create(idStr, TID3v2FrameVersions(FVersion.Major));
2211     NewFrame.AlwaysWriteUnicode := fAlwaysWriteUnicode;
2212    
2213     newFrame.CharCode := fCharCode;
2214     NewFrame.AutoCorrectCodepage := fAutoCorrectCodepage;
2215     Frames.Add(newFrame);
2216     newFrame.SetText(Value);
2217     end;
2218     end;
2219    
2220     function TID3v2Tag.GetURL(FrameID: TFrameIDs): AnsiString;
2221     var i:integer;
2222     begin
2223     i := GetFrameIndex(FrameID);
2224     if i > -1 then
2225     result := (Frames[i] as TID3v2Frame).GetURL
2226     else
2227     result := '';
2228     end;
2229     procedure TID3v2Tag.SetURL(FrameID:TFrameIDs; Value: AnsiString);
2230     var i:integer;
2231     idStr: AnsiString;
2232     NewFrame: TID3v2Frame;
2233     begin
2234     idStr := GetFrameIDString(FrameID);
2235     if not ValidFrame(iDStr) then exit;
2236    
2237     i := GetFrameIndex(FrameID);
2238     if i > -1 then
2239     begin
2240     // Frame already exists
2241     if value = '' then
2242     Frames.Delete(i)
2243     else
2244     (Frames[i] as TID3v2Frame).SetURL(Value);
2245     end
2246     else
2247     if value <> '' then
2248     begin
2249     // create new frame
2250     NewFrame := TID3v2Frame.Create(idStr, TID3v2FrameVersions(FVersion.Major));
2251     NewFrame.AlwaysWriteUnicode := fAlwaysWriteUnicode;
2252     newFrame.CharCode := fCharCode;
2253     NewFrame.AutoCorrectCodepage := fAutoCorrectCodepage;
2254     Frames.Add(newFrame);
2255     newFrame.SetURL(Value);
2256     end;
2257     end;
2258    
2259     //--------------------------------------------------------------------
2260     // Get the text from an "user defined textframe" (TXXX)
2261     //--------------------------------------------------------------------
2262     function TID3v2Tag.GetUserText(Description: UnicodeString): UnicodeString;
2263     var i: integer;
2264     DummyDescription: UnicodeString;
2265     begin
2266     i := GetUserTextFrameIndex(Description);
2267     if i > -1 then
2268     result := TID3v2Frame(Frames[i]).GetUserText(DummyDescription)
2269     else
2270     result := '';
2271     end;
2272     procedure TID3v2Tag.SetUserText(Description, Value: UnicodeString);
2273     var i: Integer;
2274     NewFrame: TID3v2Frame;
2275     idStr: AnsiString;
2276     begin
2277     // search Frame
2278     i := GetUserTextFrameIndex(Description);
2279    
2280     if i > -1 then
2281     begin
2282     // Frame already exists
2283     if value = '' then
2284     Frames.Delete(i)
2285     else
2286     (Frames[i] as TID3v2Frame).SetUserText(Description, value);
2287     end
2288     else
2289     begin
2290     if value <> '' then
2291     begin
2292     // create new frame
2293     idStr := GetFrameIDString(IDv2_USERDEFINEDTEXT); // TXX or TXXX
2294     NewFrame := TID3v2Frame.Create(idStr, TID3v2FrameVersions(FVersion.Major));
2295     NewFrame.AlwaysWriteUnicode := fAlwaysWriteUnicode;
2296     NewFrame.CharCode := fCharCode;
2297     NewFrame.AutoCorrectCodepage := fAutoCorrectCodepage;
2298     Frames.Add(NewFrame);
2299     NewFrame.SetUserText(Description, value);
2300     end;
2301     end;
2302     end;
2303    
2304    
2305     //--------------------------------------------------------------------
2306     // Get the text from an "described textframe", like lyrics and comments
2307     //--------------------------------------------------------------------
2308     function TID3v2Tag.GetDescribedTextFrame(ID: TFrameIDs; Language: AnsiString; Description: UnicodeString): UnicodeString;
2309     var i: integer;
2310     DummyLanguage: AnsiString;
2311     DummyDescription: UnicodeString;
2312     begin
2313     i := GetDescribedTextFrameIndex(ID,Language,Description);
2314     if i > -1 then
2315     result := (Frames[i] as TID3v2Frame).GetCommentsLyrics(DummyLanguage,DummyDescription)
2316     else
2317     result:='';
2318     end;
2319    
2320     procedure TID3v2Tag.SetDescribedTextFrame(ID:TFrameIDs; Language: AnsiString; Description: UnicodeString; Value: UnicodeString);
2321     var i:integer;
2322     idstr: AnsiString;
2323     NewFrame: TID3v2Frame;
2324     begin
2325     // Note: There can be multiple frames with such IDs in a tag. They can be identified by id + language + description
2326     // Many programs show a "comment" or "lyric" without further information.
2327     // in this case, the description is often '' (empty string), language may differ
2328     // To get this "pseudo-default-comment/lyric" and overwrite it:
2329     // Use '*' as language to get the first frame mathcing the id and description
2330     // if no matching frame can be found, the language will be changed to 'eng'
2331    
2332     idStr := GetFrameIDString(ID);
2333     if not ValidFrame(iDStr) then exit;
2334    
2335     if (language <>'*') AND (length(language)<>3)
2336     then language := 'eng';
2337    
2338     // search Frame
2339     i := GetDescribedTextFrameIndex(ID, Language, Description);
2340    
2341     if i > -1 then
2342     begin
2343     // Frame already exists
2344     if value= '' then
2345     Frames.Delete(i)
2346     else
2347     (Frames[i] as TID3v2Frame).SetCommentsLyrics(Language, Description, Value);
2348     end
2349     else
2350     if value <> '' then
2351     begin
2352     // create new frame
2353     NewFrame := TID3v2Frame.Create(idStr, TID3v2FrameVersions(FVersion.Major));
2354     NewFrame.AlwaysWriteUnicode := fAlwaysWriteUnicode;
2355     newFrame.CharCode := fCharCode;
2356     NewFrame.AutoCorrectCodepage := fAutoCorrectCodepage;
2357     Frames.Add(newFrame);
2358     newFrame.SetCommentsLyrics(Language, Description, Value);
2359     end;
2360     end;
2361    
2362     // ------------------------------------------
2363     // comments / lyrics
2364     // ------------------------------------------
2365     procedure TID3v2Tag.SetExtendedComment(Language:AnsiString; Description: UnicodeString; value:UnicodeString);
2366     begin
2367     SetDescribedTextFrame(IDv2_COMMENT,Language,Description,value);
2368     end;
2369     function TID3v2Tag.GetExtendedComment(Language: AnsiString; Description: UnicodeString): UnicodeString;
2370     begin
2371     result := GetDescribedTextFrame(IDv2_COMMENT,Language,Description);
2372     end;
2373    
2374     // ------------------------------------------
2375     // lyrics
2376     // ------------------------------------------
2377     procedure TID3v2Tag.SetLyrics(Language:AnsiString; Description: UnicodeString; value: UnicodeString);
2378     begin
2379     SetDescribedTextFrame(IDv2_LYRICS,Language,Description,value);
2380     end;
2381     function TID3v2Tag.GetLyrics(Language:AnsiString; Description: UnicodeString): UnicodeString;
2382     begin
2383     result := GetDescribedTextFrame(IDv2_LYRICS,Language,Description);
2384     end;
2385    
2386     // ------------------------------------------
2387     // read pictures
2388     // ------------------------------------------
2389     function TID3v2Tag.GetPicture(stream: TStream; Description: UnicodeString): AnsiString;
2390     var idx: Integer;
2391     mime: AnsiString;
2392     DummyPicTyp: Byte;
2393     DummyDesc: UnicodeString;
2394     begin
2395     IDX := GetPictureFrameIndex( Description);
2396     if IDX <> -1 then
2397     begin
2398     (Frames[IDX] as TID3v2Frame).GetPicture(Mime, DummyPicTyp, DummyDesc, stream);
2399     result := mime;
2400     end else
2401     result := '';
2402     end;
2403     // ------------------------------------------
2404     // set pictures
2405     // ------------------------------------------
2406     procedure TID3v2Tag.SetPicture(MimeTyp: AnsiString; PicType: Byte; Description: UnicodeString; stream: TStream);
2407     var IDX: Integer;
2408     NewFrame: TID3v2Frame;
2409     idStr: AnsiString;
2410     oldMime: AnsiString;
2411     oldDescription: UnicodeString;
2412     oldType: Byte;
2413     oldStream: TMemoryStream;
2414     begin
2415     idStr := GetFrameIDString(IDv2_PICTURE);
2416     IDX := GetPictureFrameIndex({PicType,} Description);
2417     if IDX <> -1 then
2418     begin
2419     if Stream = NIL then
2420     Frames.Delete(IDX)
2421     else
2422     begin
2423     if (Description = '*') or (MimeTyp = '*') or (Stream.size = 0) then
2424     begin
2425     oldStream := TMemoryStream.Create;
2426     (Frames[IDX] as TID3v2Frame).GetPicture(oldMime, oldType, oldDescription, oldStream);
2427     if (Description = '*') then
2428     Description := oldDescription;
2429     if (MimeTyp = '*') then
2430     MimeTyp := oldMime;
2431     if Stream.Size = 0 then
2432     oldStream.SaveToStream(Stream);
2433     oldStream.Free;
2434     end;
2435     (Frames[IDX] as TID3v2Frame).SetPicture(MimeTyp, PicType, Description, Stream)
2436     end;
2437    
2438     end else
2439     begin
2440     if (Stream <> NIL) and (Stream.Size > 0)then
2441     begin
2442     NewFrame := TID3v2Frame.Create(idStr, TID3v2FrameVersions(FVersion.Major));
2443     NewFrame.AlwaysWriteUnicode := fAlwaysWriteUnicode;
2444     newFrame.CharCode := fCharCode;
2445     NewFrame.AutoCorrectCodepage := fAutoCorrectCodepage;
2446     Frames.Add(newFrame);
2447     if (Description = '*') then
2448     Description := '';
2449     if (MimeTyp = '*') then
2450     MimeTyp := 'image/jpeg';
2451     newFrame.SetPicture(MimeTyp, PicType, Description, stream)
2452     end;
2453     end;
2454     end;
2455    
2456    
2457     // ------------------------------------------
2458     // URLs
2459     // ------------------------------------------
2460     function TID3v2Tag.GetUserDefinedURL(Description: UnicodeString): AnsiString;
2461     var IDX: Integer;
2462     DummyDesc: UnicodeString;
2463     begin
2464     IDX := GetUserDefinedURLFrameIndex(Description);
2465     if IDX <> -1 then
2466     result := (Frames[IDX] as TID3v2Frame).GetUserdefinedURL(DummyDesc);
2467     end;
2468     procedure TID3v2Tag.SetUserDefinedURL(Description: UnicodeString; Value: AnsiString);
2469     var IDX: Integer;
2470     NewFrame: TID3v2Frame;
2471     idStr: AnsiString;
2472     begin
2473     idStr := GetFrameIDString(IDv2_USERDEFINEDURL);
2474     IDX := GetUserDefinedURLFrameIndex(Description);
2475     if IDX <> -1 then
2476     begin
2477     if Value <> '' then
2478     (Frames[IDX] as TID3v2Frame).SetUserdefinedURL(Description, Value)
2479     else
2480     Frames.Delete(IDX);
2481     end else
2482     begin
2483     if Value <> '' then
2484     begin
2485     NewFrame := TID3v2Frame.Create(idStr, TID3v2FrameVersions(FVersion.Major));
2486     NewFrame.AlwaysWriteUnicode := fAlwaysWriteUnicode;
2487     newFrame.CharCode := fCharCode;
2488     NewFrame.AutoCorrectCodepage := fAutoCorrectCodepage;
2489     Frames.Add(newFrame);
2490     newFrame.SetUserdefinedURL(Description, Value)
2491     end;
2492     end;
2493     end;
2494    
2495    
2496     function TID3v2Tag.GetStandardUserDefinedURL: AnsiString;
2497     begin
2498     result := GetUserDefinedURL('');
2499     end;
2500     procedure TID3v2Tag.SetStandardUserDefinedURL(Value: AnsiString);
2501     begin
2502     SetUserDefinedURL('', Value);
2503     end;
2504    
2505     // ------------------------------------------
2506     // Ratings
2507     // ------------------------------------------
2508     procedure TID3v2Tag.SetRatingAndCounter(aEMail: AnsiString; aRating: Integer {Byte}; aCounter: Integer{Cardinal});
2509     var IDX: Integer;
2510     NewFrame: TID3v2Frame;
2511     idStr: AnsiString;
2512     currentRating: Byte;
2513     currentCounter: Cardinal;
2514     currentMail: AnsiString;
2515     newRating: Byte;
2516     newCounter: Cardinal;
2517     begin
2518     if aRating >= 0 then
2519     newRating := aRating Mod 256
2520     else
2521     newRating := 0;
2522    
2523     if aCounter >= 0 then
2524     newCounter := aCounter
2525     else
2526     newCounter := 0;
2527    
2528     idStr := GetFrameIDString(IDv2_RATING);
2529     IDX := GetPopularimaterFrameIndex(aEMail);
2530     if IDX <> -1 then
2531     begin
2532     // there is a Rating/Counter-Frame in the tag
2533     // 1.) Get the currentRating, - Counter and eMail (Out-Paramater)
2534     currentRating := (Frames[IDX] as TID3v2Frame).GetRating(currentMail);
2535     currentCounter := (Frames[IDX] as TID3v2Frame).GetPersonalPlayCounter(currentMail);
2536     // 2. Check if the frame should be deleted
2537     if ((aRating = 0) and (aCounter = 0)) // set both to 0
2538     or ((aRating = 0) and ((aCounter = -1) and (currentCounter = 0))) // set one to 0 and the
2539     or ((aRating = -1) and (currentRating = 0) and (aCounter = 0)) // other (which is 0 atm) untouched
2540     then
2541     // the frame will contain no information after this, so it can be deleted
2542     Frames.Delete(IDX)
2543     else
2544     begin
2545     // Set new information, the frame should NOT be deleted
2546     if aEMail = '*' then
2547     aEMail := currentMail;
2548    
2549     if aRating <> -1 then
2550     (Frames[IDX] as TID3v2Frame).SetRating(aEMail, newRating);
2551     if aCounter <> -1 then
2552     (Frames[IDX] as TID3v2Frame).SetPersonalPlayCounter(aEMail, newCounter);
2553     end;
2554     end else
2555     begin
2556     // create a new frame
2557     NewFrame := TID3v2Frame.Create(idStr, TID3v2FrameVersions(FVersion.Major));
2558     NewFrame.AlwaysWriteUnicode := fAlwaysWriteUnicode;
2559