Задачи на строки и множества паскаль

[GamBitFRK]

Большое спасибо

Если можете, для 3 тело напишите, простите, что так наглею, сдать надо автомат получу

И со 2 я разобрался, но не понимаю, как дописать для просмотра второй строки

[GamBitFRK]

У первой задачи к коду пишет что операнды имеют неприводимые типы

[_Alerter_]

Первая:

type
	ss = array [1 .. 50] of string;
var
	i, count, j : integer;
	str : string;
	strs : ss;
procedure DeleteSpace(var str : string);
var
   i : integer;
begin
   i := 1;
   while i < length(str) do
   begin
      if (str[i] = ' ') and (str[i + 1] = ' ') then
         Delete(str, i + 1, 1)
      else
         i := i + 1;
   end;
   if str[length(str)] = ' ' then Delete(str, length(str), 1);
end;

function GetWords(s : string; var words : ss) : integer;
var
	i, j, k : integer;
begin
	i := 1;
	j := 1;
	k := 1;
	while i <= length(s) do
	begin
	if (s[i] <> ' ') and (s[i] <> ',') and (s[i] <> '.') then
	begin
		words[j, k] := s[i];
		k := k + 1;
	end
	else
	begin
		words[j, 0] := Chr(k - 1);
		j := j + 1;
		k := 1;
	end;
	i := i + 1;
	end;
	words[j, 0] := chr(k - 1);
	GetWords := j;
end;

begin
	readln(str);
	DeleteSpace(str);
	count := GetWords(str, strs);
	for i := 1 to count do
	if length(strs[i]) mod 2 = 1 then
		begin
			j := 1;
			while j <= length(strs[i]) do
			begin
				if (Ord(strs[i, j]) >= Ord('a')) and (Ord(strs[i, j]) <= Ord('z')) then
					strs[i, j] := Chr(Ord(strs[i, j]) - 32);
				j := j + 2;
			end;
			writeln(strs[i]);
		end;	
	readln
end.

Вторая

type
	ss = array [1 .. 50] of string;
var
   str1, str2 : string;
   strs1, strs2, res : ss;
   i, j, k, count1, count2 : integer;

procedure DeleteSpace(var str : string);
var
   i : integer;
begin
   i := 1;
   while i < length(str) do
   begin
      if (str[i] = ' ') and (str[i + 1] = ' ') then
         Delete(str, i + 1, 1)
      else
         i := i + 1;
   end;
   if str[length(str)] = ' ' then Delete(str, length(str), 1);
end;

function GetWords(s : string; var words : ss) : integer;
var
	i, j, k : integer;
begin
	i := 1;
	j := 1;
	k := 1;
	while i <= length(s) do
	begin
	if (s[i] <> ' ') and (s[i] <> ',') and (s[i] <> '.') then
	begin
		words[j, k] := s[i];
		k := k + 1;
	end
	else
	begin
		words[j, 0] := Chr(k - 1);
		j := j + 1;
		k := 1;
	end;
	i := i + 1;
	end;
	words[j, 0] := chr(k - 1);
	GetWords := j;
end;

begin
	readln(str1);
	DeleteSpace(str1);
	count1 := GetWords(str1, strs1);
	readln(str2);
	DeleteSpace(str2);
	count2 := GetWords(str2, strs2);
	k := 1;
	for i := 1 to count1 do
		for j := 1 to count2 do
			if strs1[i] = strs2[j] then
			begin
				res[k] := strs1[i];
				k := k + 1;
			end;
	for i := 1 to k - 1 do
		for j := 1 to k - 2 do
			if res[j] > res[j + 1] then
			begin
				str1 := res[j];
				res[j] := res[j + 1];
				res[j + 1] := str1;
			end;
	for i := 1 to k - 1 do
		writeln(res[i], ' ');
	readln
end.

Третья

var
	i : integer;
	znaki : set of char;
    znaki2 : set of char;
	str : string;
begin
	znaki := [];
    znaki2 := [];
	readln(str);
	for i := 1 to length(str) do
		if ((str[i] = '.') or (str[i] = ',') or (str[i] = '!') or (str[i] = '?')) and (not (str[i] in znaki)) then
			znaki := znaki + [str[i]]
    else if (str[i] in znaki) and (not(str[i] in znaki2)) then
    begin
      writeln(str[i]);
      znaki2 := znaki2 + [str[i]];
    end;
	readln
end.