Файлы input.txt и output.txt

[Vladimir_S]

Можно ли как то преобразовать программу, чтобы удалялись не только восклицательные знаки, но еще и запятые?

А почему нет? Вставьте в функцию еще одну строку с Pos, Delete, аналогичную той, что для "!", но для запятых.
P.S. А всё-таки в чём была проблема с запуском программы? Уж поделитесь, не побьём. Любопытно...

P.P.S. Немного модераторской воркотни. Абсолютно ни к чему ради этих запятых новую тему создавать. Давайте уж здесь.Тем более, что в листинге - ошибки: в функции во втором Pos вместо "T" стоит "s", что приводит к сбою.

Короче говоря, так:

program Main2;
var
 S:string;
 a,b:char;
 f1,f2:text;

function NewStr(S:string;q,p:char):string;
var T:string;
begin
 T:=S;
 while Pos(q+q,T) > 0 do delete(T, Pos(q+q,T), 1);
 while Pos(p+p,T) > 0 do delete(T, Pos(p+p,T), 1);
 NewStr:=T;
end;

begin
 assign(f1, 'D:\Input.txt');
 reset(f1);
 assign(f2, 'D:\Output.txt');
 rewrite(f2);
 a:=chr(33);
 b:=chr(44);
 readln(f1,S);
 writeln(f2,NewStr(S,a,b));
 close(f1);
 close(f2);
end.

P.P.P.S. А вот хотел бы я знать, на кой пёс Вы используете задание удаляемых символов через коды? Чтобы "красивше" было? Почему бы не просто a:='!'; b:=',';. Впрочем, тут "вольному воля", можно и так...

 

[Aksinia]

А зачем вводить новую переменную для нового знака? А если я захочу удалить много знаков - будет много переменных? Может быть, так лучше?

program Main2;
var S:string;
  a:char;
  f1,f2:text;


function NewStr(S:string;a:char):string;
var T:string;
begin
  T:=S;
  while Pos(a + a,T) > 0 do delete(T, Pos(a + a,s), 1);
  NewStr:=T;
end;

begin
  assign(f1, 'E:\Input.txt');
  reset(f1);
  assign(f2, 'E:\Output.txt');
  rewrite(f2);
  a:=chr(33);
  readln(f1,s);
  s:=NewStr(s, a);
  a:=chr(44);
  writeln(f2,NewStr(s, a));
  close(f1);
  close(f2);
end.

 

[Vladimir_S]

А зачем вводить новую переменную для нового знака? А если я захочу удалить много знаков - будет много переменных? Может быть, так лучше?

Аксинья, Вы меня просто поражаете. Как бы это поделикатнее... Ну так:
1. Я для кого в красном абзаце указываю на ошибку: в функции в ОБОИХ Pos должна фигурировать строка "T", а не в первом случае - "T", а во втором - "s"? Всё мимо, продолжаете тащить ошибку.
2. Непонятно, в какой мере эта программа решает задачу "удалить много знаков"? По-моему, совсем не решает. И вообще это просто старый листинг, да еще и, как сказано выше, с ошибкой. Удаляет (после исправления ошибки) только дубли восклицательного знака.

Задачу "удаления многих знаков" можно организовать по-разному. Например, вводить удаляемый символ по запросу с клавиатуры. Но тогда программу необходимо зациклить, и при этом организовать перезапись файла Output в Input после каждого удаления. Или можно организовать массив удаляемых символов, а в теле функции организовать цикл по этому массиву.

 

[Aksinia]

program project1;
var S:string;
  a:char;
  f1,f2:text;


function NewStr(S:string;a:char):string;
var T:string;
begin
  T:=S;
  while Pos(a + a,T) > 0 do delete(T, Pos(a + a,T), 1);
  NewStr:=T;
end;

begin
  assign(f1, 'Input.txt');
  reset(f1);
  assign(f2, 'Output.txt');
  rewrite(f2);
  a:=chr(33);
  readln(f1,s);
  s:=NewStr(s, a);
  a:=chr(44);
  writeln(f2,NewStr(s, a));
  close(f1);
  close(f2);
end.

 

[Vladimir_S]

Пожалуй. Хороший вариант.

 

[Aksinia]

Проверьте, пожалуйста. Первое слово строки должно начинаться с буквы. Функция должна удалять все предшествующие букве символы. Эта удаляет лишь половину(из за того, что к i всегда прибавляется единица). Как это исправить?

 function BeginOfLine(S:string):string;
  var O:string;i:integer;
    begin
      O:=S;
      i:=1;
      while not (((ord(O[i])>64) and (ord(O[i])<91)) or ((ord(O[i])>96) and (ord(O[i])<123))) do begin
      delete(O,(i-1),1);
      i:=i+1;
      end;
    BeginOfLine:=O;
    end;

 

[Aksinia]

Получилось)