uses
    System.IO;
 
 type
    mas = array of string;
 
 function RDir () : string;
  var
    r : boolean := false;
    s : string;
  begin
   While not r do
    begin
     writeln ('Укажите полный путь к файлам');
     readln (s);
     r := SetCurrentDir (s);
      if not r then
       begin
        writeln ('Ошибка, папка не найдена');
        writeln ();
       end;
    end;
   Result := s;
  end;
  
 
 procedure GFiles (var m : mas;
                   var long :integer;
                   s : string);
  begin
   m := Directory.GetFiles(s);
   long := Length(m);
  end;
  
 function TestF(s :string) : boolean;
  var
    c :char;
  begin
   writeln ('Шаблон файла для переименования (y/n) :');
   writeln (s);
   readln (c);
   
   While (c <> 'h') and (c <> 'n') do
    readln (c);
    
   if c = 'n' then
     begin
      writeln ('Удалите из папки все лишнее, после (Enter)');
      readln ();
      Result := false;
     end
    else      
     Result := true;
  end;
  
 function FD (s :string) : integer;
  var
    long,i,p : integer;
    c : char;
  begin
   long := Length(s);
   for i := 1 to long do
    begin
     write (i,'] ');
     writeln (s[i]);
    end;
   
   writeln ('Укажите позицию первой цифры нумерации');
   readln (p);
   
   c := ' ';
   
   While c <> 'y' do
    begin
     writeln ('//////\\\\\\');
     writeln (s[p]);
     writeln ('Ok ? (y)');
     readln (c);
      if c <> 'y' then
       begin
        writeln ('Укажите позицию первой цифры нумерации');
        readln (p);
       end;
    end;
   
   Result := p;
  end;
 
 function NewN () : string;
  var
    s : string;
  begin
   writeln ('Введите новое имя');
   readln (s);
   Result := s;
  end;
 
 function Rush (s : string) : string;
  var
    r : string := '';
    i : integer;
  begin
   i := Length(s);
   While (s[i] <> '.') and (i > 0) do
    begin
     r := s[i] + r;
     i := i -1;
    end;
   r:= '.' + r;
   Result := r;
  end;
  
 function Number(s : string; p : integer) : string;
  var
    s2 : string;
  begin
   
   While (ord(s[p]) < 58) and (ord(s[p])>47) do
    begin
     s2 := s2 + s[p];
     p := p + 1;
    end;
   Result := s2;
  end;
 
 var
   WDir : string;
   Rsh : string;
   Name : string;
   Files : mas;
   l : integer := 0;
   pos,i : integer;
   t : text;
   
 
 begin
  WDir := RDir();
   
  While l = 0 do
   begin
    GFiles (Files,l,WDir);
     if l = 0 then
      begin
       writeln ('В указанной папке не найден ни один файл');
       WDir := RDir();     
      end;
   end;
  
  //-------------------------------------------------------------
  
  //While not TestF(Files[0]) do
   //GFiles (Files,l,WDir);
  
  Rsh := Rush(Files[0]);
  pos := FD(Files[0]);
  Name := NewN();
   
  for i := 0 to (l-1) do
   begin
    assign (t,Files[i]);
     rename (t,Name+Number(Files[i],pos)+rsh);
   end;
  
  
  
 end.