Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Транслитератор названий mp3-файлов FileTranslator

Автор: Denny

С того момента, как подруга приобрела музыкальный центр, читающий диски mp3, мой десктоп стал резать музыкальные болванки в небывалых ранее количествах. Не сразу, но все же всплыл вопрос нормальной записи файлов, названных по-русски, так как центр отказывался читать названия по-русски, выдавая вместо связки "исполнитель-песня" какую-то чушь. Переименовывать "руками" сотню с лишним файлов - обезьянья работа, которую можно произвести однократно из любви к искусству, но не более. Возникло желание автоматизировать процесс, и я задумался как это можно сделать.

В этот раз путь от задумки до претворения в жизнь был недолог. В этот же день программа была готова. Ниже я попробую изложить процесс написания программы как можно более полно.

Средством решения поставленной задачи была выбрана программа, помещаемая в папку с mp3-файлами (для упрощения программы), предназначенными для копирования на CD, и переименовывающая все файлы, содержащие в названии буквы кириллицы. Все символы кириллицы заменяются на соответствующие им латинские по правилам транслитерации. Так как музыкальный центр читает только названия файлов, но не теги, то с ними морочиться я не счел нужным. Что получилось? Получилось, что программа не получает от пользователя никаких указаний (кроме запуска) и никаких сообщений пользователю не выдает. То есть нет необходимости в каком бы то ни было интерфейсе, что значительно упрощает поставленную задачу и уменьшает размер программы.

Распишем алгоритм работы программы. Он прост: перебор файлов в папке и проверка их названий на наличие русских букв, при положительном ответе - переименование. Все.

Что ж, приступим.

Для начала напишем процедуру переименования. У меня она получилась такой:

function Renaming(fn: TSearchRec): string;
// Функция переименования файла .mp3 транслитерацией
var
  S: string;
  i, j: Byte;
  Ch: Char;
begin
  S := extractfilename(fn.Name);
  j := Length(S);
  result := '';
  for i := 1 to j do
  begin
    Ch := S[i];
    case Ch of
      'А': result := result + 'A';
      'а': result := result + 'a';
      'Б': result := result + 'B';
      'б': result := result + 'b';
      'В': result := result + 'V';
      'в': result := result + 'v';
      'Г': result := result + 'G';
      'г': result := result + 'g';
      'Д': result := result + 'D';
      'д': result := result + 'd';
      'Е': result := result + 'E';
      'е': result := result + 'e';
      'Ё': result := result + 'Yo';
      'ё': result := result + 'yo';
      'Ж': result := result + 'Zh';
      'ж': result := result + 'zh';
      'З': result := result + 'Z';
      'з': result := result + 'z';
      'И': result := result + 'I';
      'и': result := result + 'i';
      'Й': result := result + 'I';
      'й': result := result + 'i';
      'К': result := result + 'K';
      'к': result := result + 'k';
      'Л': result := result + 'L';
      'л': result := result + 'l';
      'М': result := result + 'M';
      'м': result := result + 'm';
      'Н': result := result + 'N';
      'н': result := result + 'n';
      'О': result := result + 'O';
      'о': result := result + 'o';
      'П': result := result + 'P';
      'п': result := result + 'p';
      'Р': result := result + 'R';
      'р': result := result + 'r';
      'С': result := result + 'S';
      'с': result := result + 's';
      'Т': result := result + 'T';
      'т': result := result + 't';
      'У': result := result + 'U';
      'у': result := result + 'u';
      'Ф': result := result + 'F';
      'ф': result := result + 'f';
      'Х': result := result + 'H';
      'х': result := result + 'h';
      'Ц': result := result + 'Ts';
      'ц': result := result + 'ts';
      'Ч': result := result + 'Ch';
      'ч': result := result + 'ch';
      'Ш': result := result + 'Sh';
      'ш': result := result + 'sh';
      'Щ': result := result + 'Chsh';
      'щ': result := result + 'chsh';
      'Ъ': result := result + '''' + '''';
      'ъ': result := result + '''' + '''';
      'Ы': result := result + 'Y';
      'ы': result := result + 'y';
      'Ь': result := result + '''';
      'ь': result := result + '''';
      'Э': result := result + 'E';
      'э': result := result + 'e';
      'Ю': result := result + 'Yu';
      'ю': result := result + 'yu';
      'Я': result := result + 'Ya';
      'я': result := result + 'ya'
    else
      result := result + Ch
    end
  end;
  if FileExists(result) then
    result := '' // в случае существования файла с таким же именем
end;

В функцию передается информация о найденном файле. Здесь из него извлекается имя и посимвольно преображается. Результат преображения передается в вызывающую программу. Обратите внимание на последнюю операцию в функции. В ней происходит проверка на существование в папке файла с именем, совпадающим с результатом транслитерации имени другого файла, так как в случае попытки присвоения уже существующего имени происходит фатальная ошибка. Ведь равно возможны две ситуации : переименование файла Queen - Show Must Go On.mp3 в Queen - Show Must Go On.mp3, что глупо, и переименование Секрет - Алиса.mp3 в Sekret - Alisa.mp3 при существовании файла Sekret - Alisa.mp3 , что фатально. Сейчас же и отвечу, почему не переименовывается здесь же. Первоначально новое имя файл обретал здесь же, в функции переименования, но во время тестирования программы в папке с большим количеством файлов, начинался перебор уже переименованных файлов. То есть возникла необходимость разделения во времени процедур перебора и непосредственного переименования.

Обратимся теперь к главной программе:

var
  R: TextFile;
  Renamed: file;
  S, NewName: string;
  MusicFile: TSearchRec;
  i, b: Integer;
begin
  AssignFile(R, 'R.1'); // связываем файловую переменную с временным файлом R.1
  if FindFirst('*.mp3', faAnyFile, MusicFile) = 0 then
  begin
    Rewrite(R);
    b := 0;
    repeat
      NewName := Renaming(MusicFile);
      if NewName <> '' then
      begin
        inc(b); // считаем mp3-файлы
        WriteLn(R, NewName); // заносим новое название файла во временный файл
        WriteLn(R, MusicFile.Name) // заносим старое название файла туда же
      end
    until FindNext(MusicFile) <> 0;
    CloseFile(R);
    Reset(R);
    for i := 1 to b do
    begin
      ReadLn(R, NewName);
      ReadLn(R, S);
      AssignFile(Renamed, S);
      Rename(Renamed, NewName)
    end;
    CloseFile(R);
    Erase(R);
    FindClose(MusicFile)
  end
end.

Начнем с переменных. R - текстовый файл, куда в процессе работы будут заноситься "старое" и "новое" имена файлов. Файл временный (его название, кстати, выбрано абсолютно случайно), и по окончании работы программы уничтожается. С остальными, думаю, все понятно.

Программа перебирает содержимое директории по маске '*.mp3', отбрасывая все "другие" файлы. Как только находится первый подходящий файл, создается временный файл R.1, а сам музыкальный файл "отправляется" на переименование. После перебора всех файлов директории временный файл закрывается и вновь открывается, уже для чтения. Согласно сделанным в нем записям производится переименование.

Анализ. Нельзя сказать, что приведенная реализация идеальна. Начнем с того, что если произвести извлечение имени файла в теле программы, и в функцию отправлять уже fn : String, то эту процедуру без значительных преобразований можно использовать в другой программе для транслитерации строк. Спорен также выбор файла для хранения временных данных. Можно для этих же целей воспользоваться динамическим массивом, но это увеличит требования программы к объему оперативной памяти (хотя современные компьютеры не страдают ее недостатком), зато вырастет скорость исполнения (человеку не ощутить разницу) из-за различий времени доступа к постоянной и оперативной памяти. Мало того, можно вообще отказаться от хранения временных данных. Ну и что с того, что программа будет переименовывать уже переименованные файлы? От присвоения файлу его же собственного имени мы себя застраховали, а увеличившееся время работы, повторяю, неощутимо и абсолютно не критично.

То есть, размер кода можно значительно сократить, сохранив при этом работоспособность программы, надо только преобразовать функцию Renaming в процедуру.

Тогда основная программа будет выглядеть так:

var
  MusicFile: TSearchRec;
begin
  if FindFirst('*.mp3', faAnyFile, MusicFile) = 0 then
  begin
    repeat
      Renaming(MusicFile)
    until FindNext(MusicFile) <> 0;
    FindClose(MusicFile)
  end
end.

Повторю, необходимо немного переделать функцию Renaming. Например так:

procedure Renaming(fn: TSearchRec);
var
  Renamed: file;
  OldName, NewName: string;
  i: Byte;
  Ch: Char;
begin
  OldName := ExtractFileName(fn.Name);
  for i := 1 to Length(OldName) do
  begin
    Ch := OldName[i];
    case Ch of
      'А': NewName := NewName + 'A';
      ...
        'я': NewName := NewName + 'ya'
    else
      NewName := NewName + Ch
    end;
    if not FileExists(NewName) then
    begin
      AssignFile(Renamed, OldName);
      Rename(Renamed, NewName)
    end
  end;

И наоборот, программу можно усложнить, но тогда появится форма, компоненты, интерфейс и все связанные с этим проблемы, но и восприниматься программа будет совсем иначе.

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.