var
s:string; n,i:byte;
begin
readln(s);
readln(n);
for i:=1 to length(s) do
if i mod n = 0 then write(s[i],'!') else write(s[i]);
end.
Следующий вариант
function Task(cosnt s:string; const n:byte):string;
var t:string; var i:byte;
t:='';
begin
for i:=1 to length(s) do
if i mod n = 0 then t:=s[i]+'!' else t:=s[i];
Task:=t;
end;