program p1500;

var a:array[1..1000]of string;

b:array[1..1000]of integer;

s:string;

i,j,k,n,t:integer;

procedure lala(s1,s2:string);

var k:integer;ss:string;

begin

k:=2;

if pos(s2,s1)=1 then

begin

ss:=a[i];a[i]:=a[j];a[j]:=ss;

exit;

end;

while (s1[k]=s2[k])and(kb[j] then

begin

s:=a[i];a[i]:=a[j];a[j]:=s;

t:=b[i];b[i]:=b[j];b[j]:=t;

end else if b[i]=b[j] then lala(a[i],a[j]);

if k=1 then for i:=1 to n do writeln(a[i])

else for i:=n downto 1 do writeln(a[i]);

end.

我测试的都对啊