Cod sursa(job #129296)

Utilizator Myha3Lacazacu mihaela Myha3La Data 28 ianuarie 2008 21:45:37
Problema Text Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.03 kb
var f,g:text;
    i,p,j,k:integer;v:array[1..50] of string;
    s,cuv:string; aux:char;
begin
assign(f,'text.in');reset(f);
assign(g,'text.out');rewrite(g);
read(f,s);
i:=1;
while i<=length(s) do
begin
 if (s[i]<>' ') or (s[i]<>'.') or (s[i]<>',') or (s[i]<>':') or (s[i]<>';') then
 begin
   cuv:='';
      while  (s[i]<>' ') or (s[i]<>'.') or (s[i]<>',') or (s[i]<>':') or (s[i]<>';') do
        begin
          cuv:=cuv+s[i];
          inc(i);
        end;
        p:=p+1;
        v[p]:=cuv;
  end
  else  i:=i+1;
 end;
 for i:=1 to p do
   begin
      for j:=1 to length(v[i])-1 do
        for k:=j+1 to length(v[i]) do
          if j>k then
            begin
             aux:=v[i][j];
             v[i][j]:=v[i][k];
             v[i][k]:=aux;
             end;
    end;
    for i:=1 to p-1 do
    for j:=i+1 to p do
     begin
     if length(v[i])=length(v[j]) then
     begin
        if v[i]=v[j] then
          writeln(g,v[i],' ',v[j]);
     end;
     end;
     close(f);close(g);
     end.