uses
crt;
var
f,g:text;
i:byte;
name,s:string;
BEGIN
clrscr;
write('Name of the file for reading: '); {Имя файла для чтения}
readln(name);
name:=name+'.txt';
assign(f,name); {связываем файл с переменной}
{$I-} reset(f); {$I+} {пытаемся его открыть}
if IOResult <> 0 then
begin
writeLn('Can not open file ',name); {Не могу открыть файл}
writeLn('The work program is completed. Press ENTER');
readln;
exit;
end;
write('The file name for recording: '); {Имя файла для записи}
readln(name);
name:=name+'.txt';
assign(g,name); {связываем переменную с файлом для записи}
rewrite(g);
while not eof(f) do {пока не конец первого файла}
begin
readln(f,s); {читаем строки}
for i:=1 to length(s) do
if (s[i-1]=' ') and (s[i+1]=' ')
then
delete(s,i,1);
if (s[1]<>' ') and (s[2]=' ') then
delete(s,1,1);
if (s[length(s)-1]=' ') and (s[length(s)]<>' ') then
delete(s,length(s),1);
i:=1;
while i+1<=length(s) do
begin
if (s[i]=' ') and (s[i+1]=' ') then
begin
delete(s,i,1);
dec(i);
end;
inc(i);
end;
writeln(g,s); {записываем измененную строку в новый файл}
end;
close(f);
close(g); {закрываем файлы}
write('File is rewritten!'); {Файл переписан!}
readkey
END.