求助QAQ

var
  i,j,m,n,k,p:longint;
  s,t:string;
  a,b:array[0..1000000]of string;
  check:array[0..1000000]of longint;
procedure qs(l,r:longint);
var
  i,j,x:longint;
  a1:string;
begin
  i:=l; j:=r;
  x:=(l+r) div 2;
  repeat
    while b[i]<b[x] do inc(i);
    while b[j]>b[x] do dec(j);
    if not(i>j) then
      begin
        a1:=b[i]; b[i]:=b[j]; b[j]:=a1;
        inc(i); dec(j);
      end;
  until i>j;
  if i<r then qs(i,r);
  if l<j then qs(l,j);
end;
begin
  readln(n);
  for i:=1 to n do
    readln(a[i]);
    readln(s);
  for i:=1 to n do
    begin
      t:='';
      for j:=1 to length(a[i]) do
        begin
          t:=t+a[i][j];
          if t=s then
            begin
              check[i]:=1;
              break;
            end;
        end;
    end;
    for i:=1 to n do
      if check[i]=1 then
        begin
          inc(m); b[m]:=a[i];
        end;
    qs(1,m);
    for i:=1 to m do
      writeln(b[i]);
end.
//样例过了但是全WA，求大牛教我。