Строки в Pascal

var
  str: string[30];
  x: char;
  i, k: integer;
 
begin
  k := 0;
  x := 'b ';
  readln(str);
  for i := 1 to length(str) do
  begin
    if str[i] = x then k := k + 1;
  end;
  writeln(k);
end.

var a,x:string; 
    i,dl:integer;
begin
read(a);
dl:=length(a);
for i:=1 to dl do begin
if a[i]='и' then x:=x+'и';
if a[i]='и' then write(a[i]+x) else write(a[i]);
end;
end.

var
  n:integer;
  s:string;
begin
readln(n);
s:='*'*n;
writeln(s);
end.

program stroki;
var
  s: string;
  i: byte;
begin
  write('введите строку: '); read(s);
  writeln;
  i := 1;
  while i <= length(s) do
   begin
   if (s[i] in ['/','\']) then
    begin
    delete(s, i, 1);
    i := i - 1;
    end;
   inc(i);
   end;
  writeln(s);
  writeln(); 
  writeln(); 
end. 

s:string='класс';
begin
for i:=1 to length(s) do
if(s[i]='с')s[i]='1';
end.

var
  s: string;
  k, i: integer;
  b: set of char := ['0'..'9'];
 
begin
  write('Строка: ');readln(s);
  for i := 1 to length(s) do
    if (s[i] in b) then inc(k);
 
  write('Кол-во цифр: ', k);
 
end.

var
  s: string;
  i: integer;
  f: boolean;
 
begin
  write('Текст: ');readln(s);
  for i := 1 to length(s) - 2 do
  begin
    if (s[i] = 'o') and (s[i + 1] = 'n') and (s[i + 2] = 'e') then 
    begin
      f := true;
      break;
    end;
  end;
 
  if f then writeln('Есть!') else writeln('Нет!');
 
end.

var
  s: string;
  f: boolean;
  ch: set of char := ['a'..'z','0'..'9','а'..'я',' ','A'..'Z','А'..'Я'];
begin
  readln(s);
  for var i:=1 to length(s) do
    if (s[i] in ch) then f:=false
    else 
      begin
      f:=true;
      break;
      end;
 
 
    writeln;
    if f then writeln('Содержит!') else writeln('Не содержит!');
 
 
end.

// Если есть одинаковое кол-во максимальных букв - выводит первое из списка)
var
  s: string;
  max_c, k: integer;
  max_b: char;
  mas1: array [1..1000] of char;
  mas2: array [1..1000] of integer;
 
begin
  readln(s);
  k := 2;
  for var i := 1 to 1000 do mas2[i] := 1;
 
  mas1[1] := upcase(s[1]);
 
  for var i := 2 to length(s) do
  begin
    if s[i] = ' ' then
    begin
      mas1[k] := upcase(s[i + 1]);inc(k); end;
  end;
 
 
  for var i := 1 to k - 1 do
    for var j := i + 1 to k do
    begin
      if mas1[i] = mas1[j] then inc(mas2[i]);
    end;
 
  max_c := -1;
  for var i := 1 to k do
  begin
    if max_c < mas2[i] then max_c := mas2[i];
  end;
 
  for var i := 1 to k do
    if max_c = mas2[i] then begin max_b := mas1[i];break; end;
 
  writeln;
  writeln('Буква: ', max_b, '. Кол-во: ', max_c);
end.

var s:string; k,i:longint;
 
begin
readln(s);
for i:=1 to Length(s) do if Upcase(s[i])='P' then inc(k);
writeln(k);
end.

var
  s: string;
  i: integer;
  c: set of char;
 
begin
  readln(s);
  c := ['0'..'ф9'];
  for i := 1 to Length(s) do
    if s[i] in c then begin writeln('Верно!'); break; end;
end.

var
strk: string;
i: longint;
 
begin
write('LINE: ');
readln(strk);
for i := 1 to length(strk) do
if length(strk) < 4 then break else
if ((strk[i] = 'b') and (strk[i + 1] = 'a') and (strk[i + 2] = 'l') and (strk[i + 3] = 'l')) then
insert('on', strk, i + 4);
writeln('LINE(NEW): ', strk);
end.

uses
  crt;
 
var
  slovo: array [1..250] of string;
  stroka: string;
  i, j, k: integer;
 
begin
  write('Vvedite danie: ');
  readln(stroka);
  j := 1;
  k := 0;
  slovo[j] := '';
  for i := 1 to length(stroka) do
  begin
    if stroka[i] <> ' ' then
      slovo[j] := slovo[j] + stroka[i]
    else j := j + 1;
  end;
 
 
  for j := j downto 1 do
    if slovo[j][1] = slovo[j][length(slovo[j])] then k := k + 1;
 
  writeln('Otvet = ', k);
  readkey();
end.

var
	s:string;
	i,n:integer;
	c:char;
begin
	write('Введите строку: ');
	read(s);
	while i<length(s) do
	begin
		inc(i);
		if (s[i] in ['A','a','E','e','I','i','O','o','U','Y',
		             'А','а','Е','е','Ё','ё','И','и','О','о',
		             'У','у','Ы','ы','Э','э','Ю','ю','Я','я'])
			and ((i=1) or (s[i-1]=' ')) then
		begin
			n:=i;
			c:=s[i];
			repeat
				inc(i);
			until (s[i]=' ') or (i=length(s));
			if s[i]=' ' then
			begin
				s[n]:=s[i-1];
				s[i-1]:=c;
			end
			else
			begin
				s[n]:=s[i];
				s[i]:=c;
			end;
		end;
	end;
	write('Новая строка:   ');
	writeln(s);
end.

uses
  crt;
 
var
  stroka: string;
  z, d, tsz, i: integer;
 
begin
  write('Vvedite stroku: ');
  readln(stroka);
  z := 0; d := 0; tsz := 0;
  for i := 1 to length(stroka) do
    case stroka[i] of
      '*': z := z + 1;
      ':': d := d + 1;
      ';': tsz := tsz + 1;
    end;
  writeln('Kolichestvo (*  :  ;) sootvetstvenno: ', z, ' ', d, ' ', tsz);
end.

program Schet3;
 
var
  t: string;
  s1, s2, s3: char;
  i, r, y, u: integer;
 
begin
  readln(t);
  readln(s1);
  readln(s2);
  readln(s3);
  r := 0;
  y := 0;
  u := 0;
  for i := 1 to length(t) do
  begin
    if t[i] = s1 then    
      r := r + 1;
    if t[i] = s2 then  
      y := y + 1;
    if t[i] = s3 then  
      u := u + 1;
  end;
  writeln(s1, ' в тексте ', r);
  writeln(s2, ' в тексте ', y);
  writeln(s3, ' в тексте ', u);
end.

uses crt;
var
 s,s1: string;
 sum, probel, i,b: integer;
 a: longint; {вдруг число большое будет}
begin
 clrscr;
 readln(s);
 s:=s+' '; {добавляем пробел, чтоб читалось и последнее число}
 sum:=0;
 s1:='';
 probel:=1;
 while probel <> 0 do
  begin
   probel:=pos(' ',s);
   if probel=1 then delete(s,1,1) else  
   begin
   for i:=1 to probel-1 do
    begin
     s1:=s1+s[i];  {получили строку с числом}
    end;
   val(s1,a,b);  {эта процедура возвращает в а число в строке, b для сообщения об ошибке}
   if (a mod 10 = 3) or (a mod 10 = 4) then
    sum:=sum+a;
   delete(s,1,probel); {удаляем то, что уже обработали, включая пробел}
   s1:='';
   end;
  end;
  write(sum);
  readln
 end.

program zadacha_4;
uses crt;
const n = 60;
var str : string[n];
ch:char;
i : integer;
cnt,tek : integer;
begin
clrscr;
readln(str);
ch:= str[1];
tek:=0;
cnt:= 1;
for i:=2 to n do
 begin
 if str[i] = str[i-1] then
  begin
  inc(cnt);
  end
 else
  begin
  if cnt>tek then
   begin
   tek := cnt;
   ch := str[i-1];
   cnt := 1;
   end
  else cnt := 1;
  end;
 end;
writeln;
writeln(ch,' - dlina=',tek);
readln;
end.