[Valik09]

Добрых суток, Кто хорошо разбирается помогите с описание программы, нужно описать что делает каждый пункт программы.

Код:

Var F1,F2: TextFile;
    fn1,fn2,st: string;

function NKP(st: string): string;
Var l: integer;
begin
 l:= length(st);
 while (l>0)and((st[1]=#32)or(st[l]=#32)) do
 begin
  if st[1]=#32 then delete(st,1,1);
  if st[l]=#32 then delete(st,l,1);
  l:= length(st);
 end;
 Result:= st;
end;

function PSLova(st: string): string;
Var i: integer;
begin
 i:=1;
 while i<length(st) do
 begin
  inc(i);
  if(st[i-1]=#32)and(st[i]=#32)Then
  begin
   delete(st,i,1);
   dec(i);
  end;
 end;
 Result:= st;
end;

begin
  try
   fn1:= ExtractFilePath(paramstr(0))+'!file.txt';
   fn2:= ExtractFilePath(paramstr(0))+'~!file.txt';

   AssignFile(F1, fn1);
   AssignFile(F2, fn2);
   {$I-}
   Reset(F1);
   if IOResult<>0 then
   begin
    Writeln('Source file not found '+fn1);
    Writeln('to quit press ENTER');
    Readln;
    Exit;
   end;
   Rewrite(F2);
   {$I+}
   if IOResult=0 then
   begin
    while not eof(F1) do
    begin
     Readln(F1,st);
     st:= NKP(st);
     st:= PSlova(st);
     Writeln(f2,st);
    end;
   end;
   CloseFile(F1);
   CloseFile(F2);
  except
    on E:Exception do
      Writeln(E.Classname, ': ', E.Message);
  end;
  Writeln('Operation completed!');
  Writeln('The output in the file '#13#10+fn2);
  Writeln('to quit press ENTER');
  Readln;
end.

Admin: Учимся правильно пользоваться тегами!

[Человек_Борща]

Оформи код как положено в тег CODE

[ЖабаДушитКота]

Код:

Var F1,F2: TextFile;
    fn1,fn2,st: string;

function NKP(st: string): string; //Эта функция убирает пробелы 
                                           //в начале и конце строки st
Var l: integer; 
begin
 //В числовую переменную l записывается длина строки st
 l:= length(st);
 //пока l (длина строки st в данном случае) больше нуля и в начале 
 //или конце строки есть пробел (#32), выполнять нижеследующие инструкции 
 while (l>0)and((st[1]=#32)or(st[l]=#32)) do 
 begin
  //Если пробел в начале - удалить первый символ строки
  if st[1]=#32 then delete(st,1,1);
  //Если в конце - удалить последний
  if st[l]=#32 then delete(st,l,1);
  //В переменную l записывается новая длина строки (пробелы
  //удалены, строка укоротилась) и возвращаемся к while
  l:= length(st); 
 end;
 //Как только условия while перестают выполняться, записываем 
 //получившуюся строку в результат и выходим их функции
 Result:= st; 
end;

function PSLova(st: string): string; //Эта функция удаляет лишние
                                                //лишние пробелы в середине
                                                //(если их больше одного между
                                                //словами)
Var i: integer;
begin
 //Вот тут я бы i присвоил 3, а не 1
 i:=1; 
 //Пока i меньше длины строки st выполнять нижеследующие действия
 while i<length(st) do
 begin
  //Прибавить к i единицу
  inc(i); 
  //Если символ находящийся по счету перед i И сам символ по счету i
  //равны #32 (символ пробела) тогда удалить символ по счету i.
  //Поэтому i изначально должен быть равен 3: первый символ не пробел по
  //определению, поскольку предыдущая функция вызывается первой, а второй
  //символ даже если и пробел, то первый все равно нет. Ну ты понел
  if(st[i-1]=#32)and(st[i]=#32)Then 
  begin
   delete(st,i,1);
   //Отнять от i единицу
   dec(i);
  end;
 end;
 //Записываем в результат строку без лишних пробелов
 Result:= st;
end;

//Основной код программы
begin
  //Это для обработки исключений
  try
   //В строку fn1 записывается путь к папке из которой 
   //запущена программа + название текстового файла 
   fn1:= ExtractFilePath(paramstr(0))+'!file.txt';
   //Аналогично, но для другого файла
   fn2:= ExtractFilePath(paramstr(0))+'~!file.txt';

   //F1 и F2 переменные типа Текстовый Файл
   //и здесь с ними "ассоциируются" пути к этим файлам
   AssignFile(F1, fn1);
   AssignFile(F2, fn2);
   {$I-}
   Reset(F1); //Попытка открыть файл F1
   if IOResult<>0 then //Ежели неудачно, то:
   begin
    Writeln('Source file not found '+fn1); //Файл не был найден
    Writeln('to quit press ENTER'); //Для выхода нажмите Enter
    Readln;
    Exit;
   end;
   Rewrite(F2); //F2 открывается для перезаписи
   {$I+}
   if IOResult=0 then //Если открывается без ошибок, то
   begin
    while not eof(F1) do //пока не достигнут конец файла F1:
    begin
     //Считать строку. Сначала первую, потом поочереди
     Readln(F1,st);
     //Отправляем на избавление от пробелов по краям
     st:= NKP(st);
     //Далее от лишних пробелов в середине
     st:= PSlova(st);
     //И с чистой совестью записывает во второй файл (F2)
     Writeln(f2,st);
    end;
   end;
   //Закрывает файлы F1 и F2 соответственно
   CloseFile(F1);
   CloseFile(F2);
  except //А это обработчик исключений для того try в начале
    on E:Exception do
      Writeln(E.Classname, ': ', E.Message);
  end;
  //Выдать пользователю, что все прошло успешно
  //нажмите ентер, чтобы выйти
  Writeln('Operation completed!');
  Writeln('The output in the file '#13#10+fn2);
  Writeln('to quit press ENTER');
  Readln;
end.

[Valik09]

Огромное спасибо за помощь