yes that is what i want but i have do it self
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, mp3FileUtils, StdCtrls, ShlObj, ActiveX;
const
cMP3Error : Array[TMP3Error] of String = (
'MP3ERR_None',
'MP3ERR_NoFile',
'MP3ERR_FOpenCrt',
'MP3ERR_FOpenR',
'MP3ERR_FOpenRW',
'MP3ERR_FOpenW',
'MP3ERR_SRead',
'MP3ERR_SWrite',
'ID3ERR_Cache',
'ID3ERR_NoTag',
'ID3ERR_Invalid_Header',
'ID3ERR_Compression',
'ID3ERR_Unclassified',
'MPEGERR_NoFrame'
);
type
TForm1 = class(TForm)
btnSearch: TButton;
edSearchpath: TEdit;
Label1: TLabel;
Label2: TLabel;
lblProgress: TLabel;
btnDoIt: TButton;
Label3: TLabel;
lblCount: TLabel;
btnHelp: TButton;
lstSearch: TListBox;
lblMessage: TLabel;
lblMessageVal: TLabel;
procedure btnSearchClick(Sender: TObject);
procedure btnHelpClick(Sender: TObject);
procedure btnDoItClick(Sender: TObject);
procedure lstSearchDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
State: TOwnerDrawState);
private
{ Private-Deklarationen }
failed: array of BOOL;
ProgressCounter: Integer;
procedure WinProcessMessages;
procedure SetCoverpic(Picfile: string; mp3file: string; Index: Integer);
function GetFolder(const ARoot: integer; const ACaption: String): String;
procedure FindMediaFiles(const FileList: tstrings; RootFolder: string;
Maske: array of string; Recurse: Boolean);
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.btnDoItClick(Sender: TObject);
var
IntI: Integer;
strCover, oldCover: string;
begin
oldCover := '';
ProgressCounter:= lstSearch.Count;
for IntI := 0 to (lstSearch.Count - 1) do
begin
failed[IntI] := false;
if oldCover <> ExtractFilePath(lstSearch.Items[IntI]) then
begin
strCover := ExtractFilePath(lstSearch.Items[IntI]);
strCover := strCover + lowercase('AlbumArtSmall.jpg');
oldCover := ExtractFilePath(lstSearch.Items[IntI]);
end;
if FileExists(strCover) then
begin
SetCoverpic(strCover, lstSearch.Items[IntI], IntI);
dec(ProgressCounter);
lblProgress.Caption := IntToStr(ProgressCounter);
lblProgress.Repaint;
lstSearch.Selected[IntI] := true;
end else
begin
failed[IntI] := true;
dec(ProgressCounter);
lblProgress.Caption := IntToStr(ProgressCounter);
lblProgress.Repaint;
lstSearch.Repaint;
lstSearch.Selected[IntI] := true;
end;
end;
end;
procedure TForm1.btnHelpClick(Sender: TObject);
var
pString: string;
begin
pString := 'the application writes PRIV: Frames to MP3 Tag' + #13#10 +
'necessary to make the visual plugins for WMP work properly' + #13#10 +
'without having created the Mp3 tag via WMP (Windows Media Player)' + #13#10 +
'a file called AlbumArtSmall.jpg is required in the Search path' + #13#10 +
#13#10 +
'WARNING: after executing the function over DoIt, process can''t be stopped' + #13#10 +
#13#10 +
'Artist' + #13#10 +
'Album' + #13#10 +
'Title' + #13#10 +
'Year' + #13#10 +
'Track' + #13#10 +
'Genre' + #13#10 +
'Comment' + #13#10 +
#13#10 +
'are not changed' + #13#10 +
'if your use more entries in the Mp3 tag' + #13#10 +
'please close the application, or your data will be lost!';
MessageBox(Handle, PWideChar(pString), 'Readme first', MB_OK);
end;
procedure TForm1.btnSearchClick(Sender: TObject);
var
List: TStringList;
IntI: Integer;
Mask: array[0..0] of string;
begin
edSearchpath.Text := GetFolder(CSIDL_DRIVES, 'Select search path');
If edSearchpath.Text <> '' then
begin
if lstSearch.Count > 0 then
lstSearch.clear;
List := TStringList.Create;
try
Mask[0] := '.mp3';
FindMediaFiles(List, edSearchpath.Text, Mask, True);
lblCount.Caption := IntToStr(List.Count);
ProgressCounter := List.Count;
lblProgress.Caption := IntToStr(ProgressCounter);
if List.Count > 0 then
begin
btnDoIt.Enabled := true;
Setlength(failed, List.Count);
end;
for IntI := 0 to List.Count - 1 do
lstSearch.Items.Add(List[IntI]);
finally
List.Free;
end;
end;
end;
procedure TForm1.FindMediaFiles(const FileList: tstrings; RootFolder: string;
Maske: array of string; Recurse: Boolean);
var
SR: TSearchRec;
i: Integer;
begin
RootFolder := IncludeTrailingPathDelimiter(RootFolder);
if Recurse then
if FindFirst(RootFolder + '*.*', faAnyFile, SR) = 0 then
try
repeat
if SR.Attr and faDirectory = faDirectory then
if (SR.Name <> '.') and (SR.Name <> '..') then
FindMediaFiles(FileList, RootFolder + SR.Name, Maske, Recurse);
until FindNext(SR) <> 0;
finally
FindClose(SR);
end;
i := 0;
repeat
begin
if FindFirst(RootFolder + '*' + Maske[i], faAnyFile, SR) = 0 then
try
repeat
if SR.Attr and faDirectory <> faDirectory then
begin
FileList.add(RootFolder + SR.Name);
end;
until FindNext(SR) <> 0;
finally
FindClose(SR);
end;
i := i + 1;
end
until i = high(Maske) + 1;
end;
function TForm1.GetFolder(const ARoot: integer; const ACaption: String): String;
var
bi: TBROWSEINFO;
lpBuffer: PChar;
pidlPrograms,
pidlBrowse: PItemIDList;
ShellH: IMalloc;
begin
pidlBrowse := nil;
if (not SUCCEEDED(SHGetSpecialFolderLocation(GetActiveWindow,
ARoot,
pidlPrograms))) then
Exit;
try
GetMem(lpBuffer, MAX_PATH);
try
bi.hwndOwner:=GetActiveWindow;
bi.pidlRoot:=pidlPrograms;
bi.pszDisplayName:=lpBuffer;
bi.lpszTitle:=PChar(ACaption);
bi.ulFlags:=BIF_RETURNONLYFSDIRS;
bi.lpfn:=NIL;
bi.lParam:=0;
pidlBrowse:=SHBrowseForFolder(bi);
if (pidlBrowse <> nil) and (SHGetPathFromIDList(pidlBrowse,
lpBuffer)) then
Result:=lpBuffer;
finally
FreeMem(lpBuffer);
end;
finally
if SHGetMalloc(ShellH) = NOERROR then
ShellH.Free(pidlBrowse);
end;
end;
procedure TForm1.lstSearchDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
State: TOwnerDrawState);
begin
with (Control as TListBox).Canvas do
begin
if not (odFocused in State) then
begin
if failed[Index] then
begin
Brush.Color:= clWebDarkOrange;
Font.Color:= clBlack;
end else
begin
Brush.Color := clWebLightGreen;
Font.Color:= clBlack;
end;
FillRect(Rect);
TextOut(Rect.Left + 2, Rect.Top, (Control as TListBox).Items[Index]);
end;
end;
end;
procedure TForm1.SetCoverpic(Picfile, mp3file: string; Index: Integer);
var
MP3Tags, v23Tag: TId3v2Tag;
PicData: TMemorystream;
GUID: TMemorystream;
error : TMP3Error;
i: Integer;
b: Byte;
begin
MP3Tags:= TId3v2Tag.Create;
v23Tag := TId3v2Tag.Create;
PicData:= TMemoryStream.Create;
GUID := TMemorystream.Create;
try
Error := MP3Tags.ReadFromFile(mp3File);
If Error = MP3ERR_None then
begin
Picdata.LoadFromFile(Picfile);
// basic converting
v23Tag.Artist := MP3Tags.Artist;
v23Tag.Album := MP3Tags.Album;
v23Tag.Title := MP3Tags.Title;
v23Tag.Year := MP3Tags.Year;
v23Tag.Track := MP3Tags.Track;
v23Tag.Genre := MP3Tags.Genre;
v23Tag.Comment := MP3Tags.Comment;
if MP3Tags.Rating = 0 then
v23Tag.Rating := 128 // 3 Sterne
else
v23Tag.Rating := MP3Tags.Rating;
for i := 1 to 16 do
begin
b := Random(255);
GUID.Write(b, 1);
end;
v23Tag.SetPrivateFrame('WM/WMCollectionID', GUID);
v23Tag.SetPrivateFrame('WM/WMCollectionGroupID', GUID);
v23Tag.SetPicture('image/jpeg', 0, '*', PicData);
v23Tag.WriteToFile(mp3file);
end else
lblMessageVal.Caption := cMP3Error[Error];
finally
FreeAndNIL(MP3Tags);
FreeAndNIl(PicData);
FreeAndNIl(GUID);
FreeAndNIl(v23Tag);
Winprocessmessages;
end;
end;
procedure TForm1.WinProcessMessages;
// Allow Windows to process other system messages
var
ProcMsg: TMsg;
begin
while PeekMessage(ProcMsg, 0, 0, 0, PM_REMOVE) do
begin
if (ProcMsg.message = WM_QUIT) then
Exit;
TranslateMessage(ProcMsg);
DispatchMessage(ProcMsg);
end;
end;
end.
thanks for your time..
greets
