Файловый менеджер с поддержкой поиска mp3-файлов по ID3-параметрам

  FromFile:=FromFile+#0;

  ToFile:=ToFile+#0; 

  If Not(CopyFile(@FromFile[1], @ToFile[1], False)) Then

    Result:=F_ER_NOTCOPY

  Else

    Result:=F_ER_SUCCESS;

End; 

Function GetFileError(ErrorCode:Integer):String;

Begin

  Result:='';

  Case ErrorCode Of

    F_ER_SUCCESS: Result:='';

F_ER_HIMSELF: Result:='Нельзя  копировать файл в себя';

    F_ER_EXISTS : Result:='Такой файл уже существует';

    F_ER_DIREXISTS : Result:='Такая папка уже существует';

F_ER_NOT_EXISTS : Result:='Такойфайлотсутствует';

F_ER_NOTCOPY: Result:='Ошибка  при копировании';

    F_ER_ERROR: Result:='Ошибка при работе с файлом';

End;

End; 

Function RenameOneFile(OldName, NewName:String):Integer;

Begin

  If (FileExists(NewName) Or DirectoryExists(NewName)) Then

  Begin

    Result:=F_ER_EXISTS;

    Exit;

  End;

  If MoveFile(PChar(OldName+#0), PChar(NewName+#0)) Then

    Result:=F_ER_SUCCESS

  Else

    Result:=F_ER_NOTCOPY;

End; 

Function DeleteOneFile(FileName:String):Integer;

Begin

  If Not(FileExists(FileName)) Then

  Begin

    Result:=F_ER_NOT_EXISTS;

    Exit;

  End;

{$I-}

FileSetAttr(FileName, faArchive);

  IOResult;

{$I+}

  If SysUtils.DeleteFile(FileName) Then

    Result:=F_ER_SUCCESS

  Else

    Result:=F_ER_ERROR;

End; 

Function DeleteOneDir(FileName:String):Integer;

Begin

  If Not(DirectoryExists(FileName)) Then

  Begin

    Result:=F_ER_NOT_EXISTS;

    Exit;

  End;

  If RemoveDir(FileName) Then

    Result:=F_ER_SUCCESS

  Else

    Result:=F_ER_ERROR;

End; 

Function CreateOneFolder(FolderName:String):Integer;

Begin

  If DirectoryExists(FolderName) Then

  Begin

    Result:=F_ER_DIREXISTS;

    Exit;

  End;

  If CreateDir(FolderName) Then

    Result:=F_ER_SUCCESS

  Else

    Result:=F_ER_ERROR;

End; 

end. 
 

Листинг3 – Модуль fmErrorDriveU.pas

{ Модуль fmErrorDriveU.pas } { гр. П-1 }

{ Разработчик:  Герасимчук, А.В.} { Модифицирован: 10 июня 2011 }

{ )

{ Содержит ошибки программы } 

unit fmErrorDriveU; 

interface 

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  StdCtrls, Buttons, FileCtrl; 

type

  TfmErrorDrive = class(TForm)

    Label1: TLabel;

    Label2: TLabel;

dcbxDrive: TDriveComboBox;

bbOk: TBitBtn;

procedure bbOkClick(Sender: TObject);

procedure FormShow(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end; 

var

fmErrorDrive: TfmErrorDrive; 

Function ChooseNewDrive(Var Drive:Char):Boolean; 

implementation 

uses StrConsts; 

{$R *.DFM}

Function ChooseNewDrive(Var Drive:Char):Boolean;

Begin

  fmErrorDrive.dcbxDrive.Drive:=Drive;

  If fmErrorDrive.ShowModal=mrOk Then

  Begin

    Drive:=fmErrorDrive.dcbxDrive.Drive;

    Result:=True;

  End

  Else

    Result:=False;

End;

procedure TfmErrorDrive.bbOkClick(Sender: TObject);

begin

  Hide;

end;

procedure TfmErrorDrive.FormShow(Sender: TObject);

begin

  dcbxDrive.SetFocus;

end;

end. 

Листинг4 – Модуль fmSearch.pas

{ Модуль fmSearch.pas } { гр. П-1 }

{ Разработчик:  Герасимчук, А.В.} { Модифицирован: 10 июня 2011 }

{ )

{ Поиск файлов } 

unit fmSearch;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, FileCtrl, Buttons;

type

  TfrSearch = class(TForm)

    lst1: TListBox;

    btn1: TBitBtn;

    btn2: TBitBtn;

    edt1: TEdit;

    edt2: TEdit;

    lbl1: TLabel;

    lbl2: TLabel;

    lbl3: TLabel;

    btn3: TBitBtn;

procedure btn2Click(Sender: TObject);

procedure btn1Click(Sender: TObject);

procedure Find;

function GetPath(mes: string):string;

procedure btn3Click(Sender: TObject); 

private

{ Private declarations }

public

 

{ Public declarations }

end;

var

frSearch: TfrSearch;

implementation

uses fmSearchmp3;

{$R *.dfm}

var

   FileName: string;  // имя или маскафайла

cDir: string;

   n: integer;       // количество файлов, удовлетворяющих запросу

// поиск файлов

procedure TfrSearch.Find;

var

   SearchRec: TSearchRec; // информация о файле или каталоге

begin

   GetDir(0,cDir); // получить имя текущего каталога

if cDir[length(cDir)] <> '\' then cDir := cDir+'\'; 

if FindFirst(FileName, faAnyFile,SearchRec) = 0 then

repeat

if (SearchRec.Attr and faAnyFile) = SearchRec.Attr then

begin

lst1.Items.Add(cDir +  SearchRec.Name);

n := n + 1;

end;

until FindNext(SearchRec) <> 0;

       // обработкаподкаталога

if FindFirst('*', faAnyFile, SearchRec) = 0 then

repeat

if (SearchRec.Attr and faDirectory) = faDirectory then

if SearchRec.Name[1] <> '.' then

begin

ChDir(SearchRec.Name);// войти в каталог

Find; // выполнить  поиск в подкаталоге

                         ChDir('..');// выйти из каталога

end;

until FindNext(SearchRec) <> 0;

end;

// Кнопка "Поиск"

procedure TfrSearch.btn2Click(Sender: TObject);

begin

if not DirectoryExists(edt1.Text) then

begin

            ShowMessage('Каталог указан не верно!');

edt1.SetFocus;

exit;

end;

btn2.Enabled := False;

lbl1.Caption := '';

        lbl1.Repaint;

        lst1.Clear;             // очистить ListBox

lbl1.Caption := '';

FileName := edt2.Text;  // что искать

        cDir := edt1.Text;      // где искать

        n:=0;                    // кол-во найденных файлов

        ChDir(cDir);             // войти в каталог начала поиска

        Find;                    // выполнить поиск

        if n = 0 then

           ShowMessage('Файлов, удовлетворяющих критерию  поиска нет.')

else lbl1.Caption := 'Найденофайлов:' + IntToStr(n);

btn2.Enabled := True;

end;

// Выбратькаталог

function TfrSearch.GetPath(mes: string):string;

var

  Root: string;      // корневой каталог

pwRoot : PWideChar;

  Dir: string;

begin

Root := '';

GetMem(pwRoot, (Length(Root)+1) * 2);

pwRoot := StringToWideChar(Root,pwRoot,MAX_PATH*2);

if SelectDirectory(mes, pwRoot, Dir)

then

if length(Dir) = 2

then GetPath := Dir+'\'

else GetPath := Dir

else

GetPath := '';

end;

// Кнопка "Обзор"

procedure TfrSearch.btn1Click(Sender: TObject);

var

  Path: string;

begin

Path := GetPath('Выберите папку');

if Path <> ''

then edt1.Text := Path;

end; 

procedure TfrSearch.btn3Click(Sender: TObject);

begin

frSearchmp3.Show;

close;

end;

end. 

Листинг5 – Модуль fmSearchmp3.pas

{ Модуль fmSearchmp3.pas } { гр. П-1 }

{ Разработчик:  Герасимчук, А.В.} { Модифицирован: 10 июня 2011 }

{ )

{ Поиск mp3-файлов по ID3-параметрам } 

unit fmSearchmp3;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, FileCtrl, Buttons; 

type

  TfrSearchmp3 = class(TForm)

    edt1: TEdit;

    edt2: TEdit;

    edt3: TEdit;

    edt4: TEdit;

    edt5: TEdit;

    edt6: TEdit;

    edt7: TEdit;

    edt8: TEdit;

    edt9: TEdit;

    edt10: TEdit;

    edt11: TEdit;

    edt12: TEdit;

    edt13: TEdit;

    lst1: TListBox;

    lbl1: TLabel;

    lbl2: TLabel;

    lbl3: TLabel;

    lbl4: TLabel;

    lbl5: TLabel;

    lbl6: TLabel;

    edt14: TEdit;

    edt15: TEdit;

    btn1: TBitBtn;

    btn2: TBitBtn;

    lbl7: TLabel;

procedure btn2Click(Sender: TObject);

procedure btn1Click(Sender: TObject);

procedure Find;

function GetPath(mes: string):string;

  //  function ReadID3Tag(FileName: string): TID3Tag;

private

{ Private declarations }

public

{ Public declarations }

end; 

type

  TID3Tag = record

    ID: string[3];

    Titel: string[30];

    Artist: string[30];

    Album: string[30];

    Year: string[4];

    Comment: string[30];

    Genre: Byte;

end;

const

Genres : array[0..146] of string =

    ('Blues','Classic Rock','Country','Dance','Disco','Funk','Grunge',

    'Hip- Hop','Jazz','Metal','New Age','Oldies','Other','Pop','R&B',

    'Rap','Reggae','Rock','Techno','Industrial','Alternative','Ska',