VPF::Проблема с записью в файл - Форум программистов

Teq

Дата 2.1.2007, 17:09 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 17
Регистрация: 10.6.2005

Репутация: нет
Всего: нет

Купил себе на днях mp3 плеер и вот незадача такая приключилась : не понимает он,чурка, по-русски=) Решил написать прогу, которая тэги из русского в транслит переводит.Нашёл в DRKB статью о чтении тегов ID3. Далее читаю тег, перевожу в транслит и пишу на тоже место.Но при записи перед тегом всегда появляется некий символ с кодом 30 и в итоге получается ,к примеру, samaya krutaya pesnya.Как его убрать?Хочу чтоб всё красиво было=)

aktuba

Дата 2.1.2007, 17:18 (ссылка)

(нет голосов)

Загрузка ...

Смышленный

Профиль
Группа: Завсегдатай
Сообщений: 1915
Регистрация: 24.4.2006
Где: Планета Земля

Репутация: 16
Всего: 38

покажи код и результат выполнения. а так ничего не понятно....

--------------------

Teq

Дата 2.1.2007, 18:20 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 17
Регистрация: 10.6.2005

Репутация: нет
Всего: нет

А вот и код.Это вся программа.

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, FileCtrl, Gauges, XPMan;

type
  TForm1 = class(TForm)
    FileListBox1: TFileListBox;
    DirectoryListBox1: TDirectoryListBox;
    Button2: TButton;
    Label1: TLabel;
    DriveComboBox1: TDriveComboBox;
    Gauge1: TGauge;
    Label2: TLabel;
    Label3: TLabel;
    CheckBox1: TCheckBox;
    XPManifest1: TXPManifest;
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  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',  
    'Death Metal','Pranks','Soundtrack','Euro-Techno','Ambient',  
    'Trip-Hop','Vocal','Jazz+Funk','Fusion','Trance','Classical',  
    'Instrumental','Acid','House','Game','Sound Clip','Gospel','Noise',  
    'Alternative Rock','Bass','Punk','Space','Meditative','Instrumental Pop',  
    'Instrumental Rock','Ethnic','Gothic','Darkwave','Techno-Industrial','Electronic',
    'Pop-Folk','Eurodance','Dream','Southern Rock','Comedy','Cult','Gangsta',  
    'Top 40','Christian Rap','Pop/Funk','Jungle','Native US','Cabaret','New Wave',  
    'Psychadelic','Rave','Showtunes','Trailer','Lo-Fi','Tribal','Acid Punk',  
    'Acid Jazz','Polka','Retro','Musical','Rock & Roll','Hard Rock','Folk',
    'Folk-Rock','National Folk','Swing','Fast Fusion','Bebob','Latin','Revival',
    'Celtic','Bluegrass','Avantgarde','Gothic Rock','Progressive Rock',
    'Psychedelic Rock','Symphonic Rock','Slow Rock','Big Band','Chorus',  
    'Easy Listening','Acoustic','Humour','Speech','Chanson','Opera',
    'Chamber Music','Sonata','Symphony','Booty Bass','Primus','Porn Groove',
    'Satire','Slow Jam','Club','Tango','Samba','Folklore','Ballad',  
    'Power Ballad','Rhytmic Soul','Freestyle','Duet','Punk Rock','Drum Solo',  
    'Acapella','Euro-House','Dance Hall','Goa','Drum & Bass','Club-House',  
    'Hardcore','Terror','Indie','BritPop','Negerpunk','Polsk Punk','Beat',
    'Christian Gangsta','Heavy Metal','Black Metal','Crossover','Contemporary C',  
    'Christian Rock','Merengue','Salsa','Thrash Metal','Anime','JPop','SynthPop');
var
  Form1: TForm1;

implementation
var
  Buffer: array [1..128] of Char;
  filesmassive : array[1..3000] of string;
  a:tid3tag;
Function Translit(s:string):string;
var
  i,n,k:integer;
  cash : string;
begin
  i:=1;
  n:=length(s);
  While i<=n do begin
    n:=length(s);
    Case s[i] of
     'а' : s[i]:='a';
     'А' : s[i]:='A';
     'б' : s[i]:='b';
     'Б' : s[i]:='B';
     'в' : s[i]:='v';
     'В' : s[i]:='V';
     'г' : s[i]:='g';
     'Г' : s[i]:='G';
     'д' : s[i]:='d';
     'Д' : s[i]:='D';
     'е' : s[i]:='e';
     'Е' : s[i]:='E';
     'ж' : s[i]:='j';
     'Ж' : s[i]:='J';
     'з' : s[i]:='z';
     'З' : s[i]:='Z';
     'и' : s[i]:='i';
     'И' : s[i]:='I';
     'к' : s[i]:='k';
     'К' : s[i]:='K';
     'л' : s[i]:='l';
     'Л' : s[i]:='L';
     'м' : s[i]:='m';
     'М' : s[i]:='M';
     'н' : s[i]:='n';
     'Н' : s[i]:='N';
     'о' : s[i]:='o';
     'О' : s[i]:='O';
     'п' : s[i]:='p';
     'П' : s[i]:='P';
     'р' : s[i]:='r';
     'Р' : s[i]:='R';
     'с' : s[i]:='s';
     'С' : s[i]:='S';
     'т' : s[i]:='t';
     'Т' : s[i]:='T';
     'у' : s[i]:='y';
     'У' : s[i]:='Y';
     'ф' : s[i]:='f';
     'Ф' : s[i]:='F';
     'х' : s[i]:='x';
     'Х' : s[i]:='X';
     'ц' : s[i]:='c';
     'Ц' : s[i]:='C';
     'ч' : begin
             setlength(s,n+1);
             If i<>n then insert(' ',s,i+1);
             s[i]:='c';
             s[i+1]:='h';
             n:=length(s);
           end;
     'Ч' : begin
             setlength(s,n+1);
             If i<>n then insert(' ',s,i+1);
             s[i]:='C';
             s[i+1]:='H';
             n:=length(s);
           end;
     'ш' : begin
             setlength(s,n+1);
             If i<>n then insert(' ',s,i+1);
             s[i]:='s';
             s[i+1]:='h';
             n:=length(s);
            end;
      'Ш' : begin
             setlength(s,n+1);
             If i<>n then insert(' ',s,i+1);
             s[i]:='S';
             s[i+1]:='H';
             n:=length(s);
            end;
       'ь' : s[i]:='"';
       'ю' : s[i]:='u';
       'Ю' : s[i]:='U';
       'э' : s[i]:='a';
       'Э' : s[i]:='A';
       'й' : s[i]:='"';
       'я' : begin
               setlength(s,n+1);
               If i<>n then insert(' ',s,i+1);
               s[i]:='y';
               s[i+1]:='a';
               n:=length(s)
             end;
        'Я' : begin
               setlength(s,n+1);
               If i<>n then insert(' ',s,i+1);
               s[i]:='Y';
               s[i+1]:='A';
               n:=length(s);
             end;
    end;
    inc(i);
  end;
result:=s;
end;


function readID3Tag(FileName: string): tid3tag;
var
  FS: TFileStream;
  i:integer;
begin
  FS := TFileStream.Create(FileName,  fmOpenReadWrite);
  try
    FS.Seek(-128, soFromEnd);
    FS.Read(Buffer, 128);
    with a do
    begin
      ID := translit(Copy(Buffer, 1, 3));
      Titel :=  translit(Copy(Buffer, 4, 30));
      Artist :=  translit(Copy(Buffer, 34, 30));
      Album :=  translit(Copy(Buffer, 64, 30));
      Year :=  translit(Copy(Buffer, 94, 4));
      Comment :=  translit(Copy(Buffer, 98, 30));
      Genre :=  Ord(Buffer[128]);
    end;
  finally
    FS.Free;
  end;
end;

Procedure writeID3Tag(FileName: string);
var
  FS: TFileStream;
begin
  FS := TFileStream.Create(FileName, fmOpenWrite);
  try
  FS.Seek(-125, soFromEnd);
  FS.write(a.titel, length(a.Titel));
  FS.Seek(-95, soFromEnd);
  FS.write(a.artist, length(a.Titel));
  FS.Seek(0, soFrombeginning);
  FS.write(a.titel, 2);
  finally
    FS.Free;
  end;
end;

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
var
  SearchRec:tsearchrec;
  n,i,findresult:integer;
begin
 n:=0;
 i:=1;
 Findresult:=Findfirst(DIRECTORYlistbox1.Directory+'\*.mp3*',faanyfile,SearchRec);
  while FIndResult=0 do begin
    with SearchRec do
      if (Name <> '.') and (Name <> '..') then begin
        If checkbox1.Checked then begin
          inc(n);
          FilesMassive[i]:=expandfilename(SearchRec.Name);
          FileSetAttr(expandfilename(SearchRec.Name),((not fareadonly) and (not faArchive) and (not faSysfile) and (not faHidden)));
          inc(i);
          showmessage(filelistbox1.FileName);
         end else If checkbox1.Checked=false then  begin
           If DIRECTORYlistbox1.Directory+'\'+Searchrec.Name=filelistbox1.FileName then begin
             inc(n);
             FilesMassive[1]:=expandfilename(SearchRec.Name);
             FileSetAttr(expandfilename(SearchRec.Name),((not fareadonly) and (not faArchive) and (not faSysfile) and (not faHidden)));
           end;
         end;
      end;
      Findresult := FindNext(SearchRec);
   end;
   FindClose(SearchRec);
   Gauge1.MaxValue:=n;
for i:=1 to n do begin
  readID3Tag(filesmassive[i]);
  writeid3tag(filesmassive[i]);
  gauge1.Progress:=i;
  application.ProcessMessages;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  drivecombobox1.Drive:='C';
  directorylistbox1.Directory:='c:\';
end;

end.

Alexeis

Дата 2.1.2007, 18:54 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

Какой-то странный способ.

Код


     'Ч' : begin
             setlength(s,n+1);
             If i<>n then insert(' ',s,i+1);
             s[i]:='C';
             s[i+1]:='H';
             n:=length(s);
           end;

Строка увеличивается в длину на 2 символа причем используется из них всего один, а хвостик с мусором остается.

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

Teq

Дата 2.1.2007, 19:17 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 17
Регистрация: 10.6.2005

Репутация: нет
Всего: нет

Цитата(Alexeis @ 2.1.2007, 18:54)

Какой-то странный способ.

Код


     'Ч' : begin
             setlength(s,n+1);
             If i<>n then insert(' ',s,i+1);
             s[i]:='C';
             s[i+1]:='H';
             n:=length(s);
           end;

"ч" в транслите занимает два символа : "c" и "h".Поэтому длина увеличивается на один(setlength(s,n+1)).Если символ, занимающий в транслите 2 символа, находится в конце строки, то переносить все, следующие за ним, символы уже незачем ибо их нет.В противном случае insert(' ',s,i+1), длина строки здесь не меняется, а просто все последующие символы за "ч" отодвигаются на один вправо путём вставки пустого.

Sunvas

Дата 2.1.2007, 19:55 (ссылка)

(нет голосов)

Загрузка ...

Соль и сахар

Профиль
Группа: Участник
Сообщений: 3388
Регистрация: 12.3.2006
Где: Тосно

Репутация: 28
Всего: 89

Teq, а какой тег у тебя криво пишется именно?

--------------------

Воспитывая детей по своему образу и подобию, родители почему-то надеются, что они будут лучше их.

VICTAR

Дата 2.1.2007, 20:18 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник
Сообщений: 1108
Регистрация: 6.10.2006

Репутация: 37
Всего: 80

Не знаю где там ошибка, но меня несколько удивила Function Translit(s:string):string;
... Я бы сделал так:

Код


function Translit(s: string):  string;
const trans: array [0..31] of string=
('a','b','v','g','d','e','zh','z','i','i','k','l','m',
 'n','o','p','r','s','t','u','f','h','ts','ch','sh','sch',
 '"','y','''','e','yu','ya');
var
  i:integer;
begin
  result:='';
  for i:=1 to length(s) do
    case s[i] of
      'а'..'я': result:=result+trans[ord(s[i])-224];
      'А'..'Я': result:=result+AnsiUpperCase(trans[ord(s[i])-192]);
      else result:=result+s[i];
    end;
end;

Teq

Дата 2.1.2007, 20:35 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 17
Регистрация: 10.6.2005

Репутация: нет
Всего: нет

VICTAR ,спасибо.Это я неопытный по-тупому всё делал;)
Sunvas,в любом.
Кстати, вот файлик проекта, может кому то поможет разобраться.

Присоединённый файл ( Кол-во скачиваний: 7 )

Project1.dpr 0,18 Kb

Alexeis

Дата 2.1.2007, 21:24 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

Цитата(Teq @ 2.1.2007, 19:17

)

В противном случае insert(' ',s,i+1), длина строки здесь не меняется,

Кто сказал, что не меняется? Как раз меняется увеличиваясь на единицу (вставка увеличивает размер строки)! Вот об этом я и говорил, что вместо увеличения на единицу идет увеличение на 2 символа! Т.е. сзади образуется мусор.

--------------------

VICTAR

Дата 2.1.2007, 23:44 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник
Сообщений: 1108
Регистрация: 6.10.2006

Репутация: 37
Всего: 80

Не знаю, насколько грамотно, но могу предолжить такой вариант:

Код


...

type
  TID3Tag = record
    ID      : array[0..2] of Char;
    Title,
    Artist,
    Album   : array[0..29] of Char;
    Year    : array[0..3] of Char;
    Comment : array[0..29] of Char;
    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',  
    'Death Metal','Pranks','Soundtrack','Euro-Techno','Ambient',  
    'Trip-Hop','Vocal','Jazz+Funk','Fusion','Trance','Classical',  
    'Instrumental','Acid','House','Game','Sound Clip','Gospel','Noise',  
    'Alternative Rock','Bass','Punk','Space','Meditative','Instrumental Pop',  
    'Instrumental Rock','Ethnic','Gothic','Darkwave','Techno-Industrial','Electronic',
    'Pop-Folk','Eurodance','Dream','Southern Rock','Comedy','Cult','Gangsta',  
    'Top 40','Christian Rap','Pop/Funk','Jungle','Native US','Cabaret','New Wave',  
    'Psychadelic','Rave','Showtunes','Trailer','Lo-Fi','Tribal','Acid Punk',  
    'Acid Jazz','Polka','Retro','Musical','Rock & Roll','Hard Rock','Folk',
    'Folk-Rock','National Folk','Swing','Fast Fusion','Bebob','Latin','Revival',
    'Celtic','Bluegrass','Avantgarde','Gothic Rock','Progressive Rock',
    'Psychedelic Rock','Symphonic Rock','Slow Rock','Big Band','Chorus',  
    'Easy Listening','Acoustic','Humour','Speech','Chanson','Opera',
    'Chamber Music','Sonata','Symphony','Booty Bass','Primus','Porn Groove',
    'Satire','Slow Jam','Club','Tango','Samba','Folklore','Ballad',  
    'Power Ballad','Rhytmic Soul','Freestyle','Duet','Punk Rock','Drum Solo',  
    'Acapella','Euro-House','Dance Hall','Goa','Drum & Bass','Club-House',  
    'Hardcore','Terror','Indie','BritPop','Negerpunk','Polsk Punk','Beat',
    'Christian Gangsta','Heavy Metal','Black Metal','Crossover','Contemporary C',  
    'Christian Rock','Merengue','Salsa','Thrash Metal','Anime','JPop','SynthPop');

var
  Form1 : TForm1;
  a         : TID3Tag;

implementation

{$R *.dfm}

function ReadTag(fname: string; var mtag: TID3Tag): boolean;
var mfile  : file;
    bRead : integer;
begin
  result:=false;
    AssignFile(mfile, fname);
      try
        Reset(mfile,1);
        Seek(mfile, FileSize(mfile)-128);
        BlockRead(mfile, mtag, SizeOf(mtag),bRead);
        result:=mtag.ID='TAG';
      except
      end;
    CloseFile(mfile);
end;

function WriteTag(fname: string; mtag: TID3Tag): boolean;
var mfile : file;
    tmp    : TID3Tag;
begin
  result:=true;
    AssignFile(mfile, fname);
      try
        Reset(mfile,1);
          if ReadTag(fname,tmp)
            then Seek(mfile, FileSize(mfile)-128)
          else Seek(mfile, FileSize(mfile));
        BlockWrite(mfile, mtag, SizeOf(mtag));
      except
        result:=false;
      end;
    CloseFile(mfile);
end;

procedure TransliteTAG(var mtag: TID3Tag);

procedure Translit(var s: array of char);
const alph: array [0..31] of string=
('a','b','v','g','d','e','zh','z','i','i','k','l','m',
 'n','o','p','r','s','t','u','f','h','ts','ch','sh','sch',
 '"','y','''','e','yu','ya');
var
  i       : integer;
  str   : string;
begin
  str:='';
  for i:=0 to pred(length(s)) do
    case s[i] of
      'а'..'я': str:=str+alph[ord(s[i])-224];
      'А'..'Я': str:=str+AnsiUpperCase(alph[ord(s[i])-192]);
      else str:=str+s[i];
    end;
  for i:=0 to pred(length(s)) do
    if i+1>length(str) then s[i]:=#0
      else s[i]:=str[i+1];
end;

begin
  Translit(mtag.Title);
  Translit(mtag.Artist);
  Translit(mtag.Album);
  Translit(mtag.Comment);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if ReadTag('01-Take Me Away.mp3',a) then
    begin
      TransliteTAG(a);
      WriteTag('01-Take Me Away.mp3',a);
    end;
end;

end.

Teq

Дата 3.1.2007, 18:34 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 17
Регистрация: 10.6.2005

Репутация: нет
Всего: нет

Цитата(Alexeis @ 2.1.2007, 21:24)

Цитата(Teq @ 2.1.2007, 19:17

)

В противном случае insert(' ',s,i+1), длина строки здесь не меняется,

Да.Так и есть.Я был неправ.

Это сообщение отредактировал(а) Teq - 3.1.2007, 18:38

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »