function IsPalindrom(S: string): boolean;

var i,len: integer;

    pal: boolean;

begin

     pal:=true; {считаем, что в начале у нас палиндром}

 

     len:=length(S);

     for i:=1 to (len div 2) do {проверяем до половины строки}

         if S[i]<>S[len-i+1] then {одинаковы ли парные символы, начиная с обоих концов строки}

         begin

              pal:=false; {мы былы не правы}

              break; {выходим из цикла, не проверяя остальные символы}

         end;

 

     IsPalindrom:=pal

end;

 

var Str: string;

begin

     write('Enter string: ');

     readln(str);

     writeln('Palindrom: ',IsPalindrom(str));

     readln;

end.

 

function NormalizeNumber(x:real): string;

var

  l : integer;

  s : string;

begin

 

  s:='';

  str(x:0:99,s);

  l:=Length(s);

  while s[l] in ['0','.'] do

    begin

      dec(l);

      if s[l]='.' then

        begin

          dec(l);

          break

        end;

    end;

 

  NormalizeNumber:=copy(s,1,l)

end;

Function Replace(Source : String; What, Repl : String) : String;

Var P : Integer;

    Head, Tail : String;

Begin

 If (Length(Source) <= 0) Then Exit; {В пустой строке нечего менять. Это и есть "якорь" рекурсии}

 If Pos(What, Source) > 0 Then {Если нашли что менять}

  Begin

   P:=Pos(What, Source);

   Delete(Source, P, Length(What));

   Insert(Repl, Source, P); {Удаляем и вставляем нужную строку (замена первой похожей подстроки)}

   Head:=Copy(Source, 1, P + Length(Repl) - Length(What)); {В этой подстроке замен больше делать не надо}

   Tail:=Copy(Source, Length(Head) + 1, Length(Source) - Length(Head)); {А здесь надо!}

   Source:=Head + Replace(Tail, What, Repl); {Рекурсивный вызов}

  End;

 Replace:=Source;

End;

 

Begin

 Writeln(Replace('I love cheese', 'e', 'ee'));

End.

Function Replace(Source : String; What, Repl : String) : String;

Var P : Integer;

Begin

 While Pos(What, Source) > 0 Do

  Begin

   P:=Pos(What, Source);

   Delete(Source, P, Length(What));

   Insert(Repl, Source, P);

  End;

 Replace:=Source;

End;

 

Begin

 Writeln(Replace('I love cheese', 've', 'EEEE'));

End.

procedure FindWords(s: string);

Const Letters: Set Of Char = ['A'..'Z','a'..'z','А'..'Я','а'..'п','р'..'я'];

var p,q: byte;

    sc : string;

begin

  p := 1; { Проверять с 1-го символа в строке }

 

  while p <= length (s) do { Поиск по строке}

  begin

    q := p; { Запомнить позицию p }

 

    while (p <= length (s)) and (s[p] in Letters) do

      inc(p);  { Пока не конец строки и очередной символ является буквой, увеличивать позицию p}

 

    if q <> p then { Если позиция p сдвинута относительно q, значит найдено слово }

    begin

      sc := copy (s, q, p - q); { Вырезать слово }

      writeln (sc); { и вывести его на экран }

    end;

 

    inc (p); { передвинув позицию p продолжить поиск по строке }

  end;

 

end;

 

begin

  FindWords ('abc 1a333 где34слово?')

end.

program Parsing;

 

procedure ParseWords(s: string);

const Delimiters : set of char = [' ', '.' , ',']; { Разделители слов в предложении. Можно добавить другие }

var i, op: word;

 

procedure CutWord;

var _word: string;

begin

     _word:=copy(s,op,i-op);

     writeln('"',_word,'"'); { вывод слова }

end;

 

begin

     i:=0;

     op:=1;

     while i<=length(s) do

     begin

          inc(i);

 

          if s[i] in Delimiters then { если найден разделитель, то "вырезать" слово }

          begin

               CutWord;

               op:=i+1; { Запомнить начало предыдущего слова. Т.е. следующий индекс после разделителя }

          end;

     end;

     if op<>i then CutWord; { Осталось нетронутое слово. Его тоже не забудем :) }

end;

 

begin

     ParseWords('tester.1 23'); { Вывод слов из предложения, разделённых знаками }

     readln;

end.

function findSubStr(Str1, Str2: string): string;

function findSubStr(Str1, Str2: string): string;

var

  Sout: string;

   i,j, len: integer;

begin

  len := 0;

  for j := 1 to length (Str1) do

   for i := 1 to length (Str1) - j + 1 do

    begin

      Sout := copy (Str2, i, j);

      if (pos (Sout, Str1) > 0) and (length (Sout) > len) then

       begin

         findSubStr := copy(Str1, pos (Sout, Str1), j);

         len := j;

       end;

    end;

end;

 

...

  s1 := 'The power of Turbo Pascal';

  s2 := 'Pascal is a powerful programming language';

  writeln ('Substr = ' + findSubStr (s1, s2));       { Substr='Pascal' }

...