Зачет угрожает расправой..

[Deimossy]

Помогите, пожалуйста, с лабораторными! Все остальное сдала, а с этими двумя не могу справиться
1.Задача на множества.
Дан текст из строчных латинских букв. Напечатать буквы, входящие в текст не менее двух раз.

program CollectSample;
var
let1,let2: set of 'a'..'z';
c: char;
begin
let1:= []; 
let2:=[];
read( c );
while c <> '.' do begin
write( c );
let1:= let1 + [ c ];
end;
read©;
if (c in let1) and (c in (let1-[c])) and (not (c in let2)) then
begin
write©;
let2:=let2+[c];
read( c )
end;
writeln;
end.

2.Задача на строки.
Дана последовательность, содержащая от 2 до 30 слов, в каждом из которых от 2 до 10 латинских букв. Между соседними словами стоит не меньше одного пробела, за последним словом - точка. Напечатать все слова, отличные от последнего слова, предварительно преобразовав их следующим образом: перенести последнюю букву в начало слова.

program perenos;
uses crt;
var str,str1,str2,str3,str4:string;
i,n,p:integer;
Begin
clrscr;
writeln('Vvedite stroku: ');
readln(str);
i:=n-1;
str1:=' ';
repeat
if str[i]<>' ' then
str1:=str1 +str[i];
i:=i-1;
until str[i]=' ';
While pos(str1,str)>0 do
begin
p:=pos(str1,str);
delete(str,p,length(str1));
end;

for i:=1 to n-1 do
if str2[i]=' ' then
begin
copy(str2,i-1,1);
str3:=copy(str2,i-1,1);
insert(str3,str2,i-length(str3));
str4:=str2;
end;
writeln('konechnaya stroka',str2);
readln;

End.

Я очень долго пыталась написать сама, но, к сожалению, не вышло Помогите, пожалуйста.

[alex_fcsm]

var s:string;
    i:integer;
    m,out:set of char;
begin
m:=[];
out:=[];
Writeln('Inpu string');
readln(s);
writeln;
for i:=1 to length(s) do
 if UpCase(s[i]) in m then begin
                    if not(UpCase(s[i]) in out) then begin
                                             write(s[i],' ');
                                             out:=out+[UpCase(s[i])]; 
                                             end;
                   end
    else m:=m+[UpCase(s[i])];
end.

[Deimossy]

alex_fcsm, спасибо огромное!! вы спасли мне жизнь!!!!!

[alex_fcsm]

uses crt;
var s,sub:string;
    i,n,k,j:integer;
    a:array[1..100] of string;
    m:real;
    c:char;

begin
clrscr;
writeln('Input str');
readln(s);
i:=0;n:=0;
repeat
inc(i);
if (s[i]=' ')and(s[i+1]<>' ') then begin
                   inc(n);
                   a[n]:=sub;
                   sub:='';
                   end
else if (s[i]<>' ')and(s[i]<>'.') then sub:=sub+s[i];
until i=length(s);
if sub<>'' then begin
inc(n);
a[n]:=sub;
end;
writeln;

for i:=1 to n-1 do
  if a[i]<>a[n] then begin
                     sub:='';
                     sub:=sub+a[i][length(a[i])];
                     for j:=1 to length(a[i])-1 do
                       sub:=sub+a[i][j];
                     writeln(sub);
                     end;


end.

[Dushess]

alex_fcsm спасибо, а почему последнее слово в строке не обрабатывается?