Переписать исходный файл, циклически сдвигая ключевое слово на k букв

uses crt;
 
var f1,f2: text;
    slovo,tmp: string;
    ch: char;
    k,i: integer;
 
 
begin clrscr;
write('Imea faila dlea chtenia: '); readln(slovo);
assign(f1,slovo); reset(f1);
write('Imea faila dlea chtenia: '); readln(slovo);
assign(f2,slovo); rewrite(f2);
write('Kliuchevoe slovo: '); readln(slovo);
write('K = '); readln(k);
 
while not eof(f1) do
 begin
 read(f1,ch);
 if ch = slovo[1] then
  begin
  tmp := ch;
  while not eof(f1) and (length(tmp) < length(slovo)) do
   begin
   read(f1,ch);
   tmp := tmp + ch;
   end;
  if pos(tmp,slovo) = 1 then
   for i := 1 to k do
    if not eof(f1) then
     begin
     read(f1,ch);
     write(f2,ch);
     end;
  write(f2,tmp);
  end
 else write(f2,ch);
 end;
 
close(f1); close(f2);
writeln('Fail byl uspeshno perepisan');
readkey; end.