2017年10月18日普及组 文件名排序

程序：

var
l,n,i,j,p:longint;
a,b,c,s:array[1..1000]of string;
w:string;
begin
    readln(n);
    for i:=1 to n do
    readln(a[i]);
    for i:=1 to n do
    begin
        p:=pos('.',a[i]);
        s[i]:=a[i];
        l:=length(s[i]);
        if p>0 then
        begin
            b[i]:=copy(s[i],p+1,l-p);
            c[i]:=copy(s[i],1,p-1);
        end else
        begin
            b[i]:='zzz';
            c[i]:=s[i];
        end;
    end;
    for i:=1 to n-1 do
    for j:=i+1 to n do
    if b[i]>b[j] then
    begin
        w:=b[i];b[i]:=b[j];b[j]:=w;
        w:=c[i];c[i]:=c[j];c[j]:=w;
        w:=s[i];s[i]:=s[j];s[j]:=w;
    end;
    for i:=1 to n-1 do
    for j:=i+1 to n do
    if c[i]>c[j] then
    if b[i]>=b[j] then
    begin
        w:=b[i];b[i]:=b[j];b[j]:=w;
        w:=c[i];c[i]:=c[j];c[j]:=w;
        w:=s[i];s[i]:=s[j];s[j]:=w;
    end;
    for i:=1 to n do
    for j:=1 to n do
    if a[i]=s[j] then
    begin
        writeln(j);
        break;
    end;
end.