uses crt;
var f,g:text;
name,s,s1:string;
begin
clrscr;
write('Имя файла для чтения: ');
readln(name);
name:=name+'.txt';
assign(f,name);
{$I-} reset(f); {$I+}
if IOResult <> 0 then
begin
writeLn('Не могу открыть файл ',name);
writeLn('Работа программы завершена. Нажмите ENTER');
readln;
exit;
end;
write('Имя файла для записи: ');
readln(name);
name:=name+'.txt';
assign(g,name);
rewrite(g);
while not eof(f) do
begin
readln(f,s);
s1:=copy(s,1,pos(',',s)-1);{берем до первой запятой}
while pos(',',s)>0 do {пока есть запятые, }
delete(s,1,pos(',',s));{удаляем текст от начала до запятой}
s1:=s1+s;{приписываем ос таток строки}
writeln(g,s1);{пишем в новый файл}
end;
close(f);
close(g);
write('Файл переписан!');
readln
end.