小弟程序如下：
function change(y:string):longint;
begin
    if (y='A')or(y='B')or(y='C') then change:=2 else
    if (y='D')or(y='E')or(y='F') then change:=3 else
    if (y='G')or(y='H')or(y='I') then change:=4 else
    if (y='J')or(y='K')or(y='L') then change:=5 else
    if (y='M')or(y='N')or(y='O') then change:=6 else
    if (y='P')or(y='R')or(y='S') then change:=7 else
    if (y='T')or(y='U')or(y='V') then change:=8 else
    if (y='W')or(y='X')or(y='Y') then change:=9;
end;
var a:array[0..10000000] of longint;
    b:array[0..1000000] of string;
    j,k,l,n,m,i,o,p:longint;
    s:string;
procedure done(x:string);
var j,k,l,n,m:longint;
begin
    n:=0;
    j:=length(x);
    l:=1000000;
    for k:=1 to j do
    begin
    if (ord(x[k])>=48)and(ord(x[k])<=57) then  begin
                                              n:=n+l*(ord(x[k])-48);
                                              l:=l div 10;
                                              end
    else if (ord(x[k])>=65)and(ord(x[k])<=90) then begin
                                                   n:=n+change(x[k])*l;
                                                   l:=l div 10;
                                                   end;
    end;
    write(n);
    inc(a[n]);
end;
procedure writeout(q,r:longint);
var s:string;
    h,e,w:longint;
begin
    w:=r;
    s:='';
    e:=1000000;
    for h:=1 to 3 do
    begin
    s:=s+char((w div e)+48);
    w:=w-w div e*e;
    e:=e div 10;
    end;
    s:=s+'-';
    for h:=1 to 4 do
    begin
    s:=s+char((w div e)+48);
    w:=w-w div e*e;
    e:=e div 10;
    end;
    writeln(s,' ',q);
end;
begin
    readln(n);
    for i:=1 to n do
    begin
    readln(s);
    done(s);
    end;
    for i:=0 to 10000000 do
    if a[i]>1 then writeout(a[i],i);
end.
手头的测试数据过了，可在网上过不了，请高手看看那错了，谢谢了。