2 задачки (String & Set )

[mshunter]

1. дан текст ,который составлен с букв , за которыми следут точка. Напечатать этот текст большими буквами в алфавитном порядке по шесть букв в рядке.

2. Дан текст, который заканчивается точкой..В алфавитном порядке напечатать (по одному разу ) все маленькие гласные буквы, которые входят в этот текст.
 СПАСИБО.....!!!!!

Ребяята очень прошу, СОС ))))!!! вопрос жизни и смерти (((

если что ася 362664751.....реально хелп плз.....

[capta1n]

program sg;
var
 stroka : string;
 mal : set of 'a'..'z';
 i : byte;
begin

  assign (input,'input.txt');
  reset (input);
  assign (output,'output.txt');
  rewrite (output);

  mal:=['a','e','i','o','u'];
  while not EOF do
  begin
    while not EOLN do
    begin
      read (stroka);
      for i:=1 to length(stroka) do
       if stroka[i] in mal then
       begin
         write (stroka[i]);
         mal:=mal-[stroka[i]]
       end
    end;
    stroka:='';
    readln
  end;

  Close (input);
  Close (output)

end.

[capta1n]

вот в общем архив - всего хорошего - парни - помогите чуваку вторую прогу написать - у меня реально нет времени - завтра экзамен (

[Tkirill]

uses crt;
var
ar:array[1..500] of string[10];
mas:array[1..10] of string;
s:string ;
i,j,k,n,m,l:integer;
begin
clrscr;
write(' CKOJIbKO CTPOK -> ');
readln(n);
writeln;
writelN(' BBODUTE CTPOKU ');
writeln;
for i:=1 to n do
readln(mas[i]);
for i:=1 to 500 do
ar[i]:='';
k:=1;
l:=0;
for i:=1 to n do
 begin
  mas[i]:=mas[i]+' ';
  for j:=1 to length(mas[i]) do
   begin
   if not(mas[i][j] in [' ','.','!','?',';',':']) then begin
   ar[k]:=ar[k]+upcase(mas[i][j]);
   l:=l+1;
   end;
   if l=6 then begin k:=k+1; l:=0; end;
   end;
 end;
 writeln;
 writeln;
for i:=1 to k-1 do
 begin
  for j:=1 to k-i do
   begin
   if (ar[j][1]>ar[j+1][1]) then
                       begin
                       s:=ar[j];
                       ar[j]:=ar[j+1];
                       ar[j+1]:=s;
                       end;
   end;
  end;
for i:=1 to k do
writeln(ar[i]);
readln;
end.

[capta1n]

Ткирилл - через файлы замени

[capta1n]

спасибо, что чуваку помог

[mshunter]

thanks ))!!

[Tkirill]

uses crt;
var
fil:text;
ar:array[1..500] of string[10];
mas:array[1..10] of string;
s:string ;
i,j,k,n,m,l:integer;
begin
clrscr;
writeln;
writeln;
assign(fil,'in.txt');
reset(fil);
n:=0;
while not eof(fil) do
begin
n:=n+1;
readln(mas[i]);
end;
for i:=1 to 500 do
ar[i]:='';
k:=1;
l:=0;
for i:=1 to n do
begin
mas[i]:=mas[i]+' ';
for j:=1 to length(mas[i]) do
begin
if not(mas[i][j] in [' ','.','!','?',';',':']) then begin
ar[k]:=ar[k]+upcase(mas[i][j]);
l:=l+1;
end;
if l=6 then begin k:=k+1; l:=0; end;
end;
end;
writeln;
writeln;
for i:=1 to k-1 do
begin
for j:=1 to k-i do
begin
if (ar[j][1]>ar[j+1][1]) then
begin
s:=ar[j];
ar[j]:=ar[j+1];
ar[j+1]:=s;
end;
end;
end;
close(fil);
assign(fil,'oyt.txt');
rewrite(fil);
for i:=1 to k do
writeln(fil,ar[i]);
close(fil);
readln;
end.