根本没人

program test2000(input,output);
uses crt,dos;
{$M,64000,32000,600000}
type
screentype=array [1..2000] of word;
texttype=^tt;
tt=record
str:string;
prev,next:texttype;
end;
scoretype=record
xh:string[6];
name:string[10];
tttime:byte;
eng_corr,eng_err,ch_corr,ch_err:longint;
end;
const
VSEG=$B800;
UPKEY=256+72;
DOWNKEY=256+80;
HOMEKEY=256+71;
ENDKEY=256+79;
PGUPKEY=329;
PGDNKEY=337;
ESCAPE=27;
BACKKEY=8;
INSKEY=256+82;
DELKEY=256+83;
LEFTKEY=256+75;
RIGHTKEY=256+77;
LINELIMIT=100;
CTRLPGUP=256+132;
CTRL_f1=256+94;
CTRLF10=256+103;
ctrl3=256+122;
CTRL4=256+123;
CTRL6=256+125;
CTRL_ALT_f8_key=256+111;
CTRL_ALT_f10_key=256+113;
F1key=256+59;
F10key=256+68;
TABKEY=9;
SHIFTTAB=271;

procedure cursor(x,y:integer);
begin
gotoxy(y,x); end;
function upper(st:string):string;
var i:integer; begin for i:=1 to length(st) do if (st[i]>='a') and (st[i]<='z')
then st[i]:=chr(ord(st[i])-32); upper:=st;end;
function unupper(st:string):string;
var i:integer; begin for i:=1 to length(st) do if (st[i]>='A') and (st[i]<='Z')
then st[i]:=chr(ord(st[i])+32); unupper:=st;end;
function space(n:integer):string;
var i:integer; st:string;begin st:=''; for i:=1 to n do st:=st+' ';space:=st;end;
function repl(ch:char;n:integer):string;
var i:integer;st:string;begin st:='';for i:=1 to n do st:=st+ch;repl:=st;end;
function iifword(tj:boolean;st1,st2:word):word;
begin if tj then iifword:=st1 else iifword:=st2;end;
function iifstr(tj:boolean;st1,st2:string):string;
begin if tj then iifstr:=st1 else iifstr:=st2;end;
procedure color(i,j:byte);begin defaultattr:=i*16+j;end;
procedure setattr(i:byte);begin defaultattr:=i;end;
function getd(x,y:integer):word;var p:^integer;
begin p:=ptr(vseg,(x-1)*160+(y-1)*2);getd:=p^;end;
procedure putd(x,y:byte;ch:char);var p:^integer;begin
p:=ptr(vseg,(x-1)*160+(y-1)*2);p^:=defaultattr*256+ord(ch);end;
procedure putword(x,y:byte;ch:word);
var p:^integer;begin p:=ptr(vseg,(x-1)*160+(y-1)*2);p^:=ch;end;
procedure cls;
var i,j:integer;begin for i:=1 to 25 do for j:=1 to 80 do putd(i,j,' ') end;
function at(ch:char;str:string):integer;
var i:byte;bb:integer;begin bb:=0; for i:=1 to length(str) do if bb=0 then if str[i]=ch then bb:=i;
at:=bb;end;
function subs(st:string;i,j:integer):string;begin subs:=copy(st,i,j);end;
function trim(st:string):string;var i:byte;begin i:=length(st);
while st[i]=' ' do i:=i-1; trim:=copy(st,1,i);end;
function len(st:string):byte;
begin len:=length(st);end;
function ltrim(st:string):string;
var i:integer;begin i:=1;while (i<len(st)) and (st[i]=' ') do begin
i:=i+1;end;if (i=len(st)) then begin if st[i]=' ' then ltrim:='' else
ltrim:=st[i];end else ltrim:=copy(st,i,len(st)-i+1);end;
function alltrim(st:string):string;begin alltrim:=trim(ltrim(st));end;

procedure say(x,y:integer;st:string);
var i:integer;begin for i:=1 to length(st) do putd(x,y+i-1,st[i]);end;
procedure clear(x1,y1,x2,y2:integer);
var i,j:integer;begin for i:=x1 to x2 do for j:=y1 to y2 do putd(i,j,' ');end;
procedure savescreen(x1,y1,x2,y2:integer;VAR pp:screentype);
var i,j:integer;begin for i:=1 to 25 do for j:=1 to 80 do pp[(i-1)*80+j]:=getd(i,j);end;
procedure restorescreen(x1,y1,x2,y2:integer;pp:screentype);
var i,j:integer;begin for i:=1 to 25 do for j:=1 to 80 do putword(i,j,pp[(i-1)*80+j]);end;
procedure fill(x1,y1,x2,y2:integer;ch:integer);
var i,j:integer;begin for i:=x1 to x2 do for j:=y1 to y2 do begin putword(i,j,(getd(i,j) mod 256)+ch*256);end;end;
procedure box(x1,y1,x2,y2:integer);
var st1,st2,st3:string;i:integer;begin st1:=chr(218);st2:=chr(179);st3:=chr(192);
for i:=1 to y2-y1-1 do begin st1:=st1+chr(196);st2:=st2+' ';st3:=st3+chr(196);
end;st1:=st1+chr(191);st2:=st2+chr(179);st3:=st3+chr(217);say(x1,y1,st1);for i:=x1+1 to x2-1 do
say(i,y1,st2);say(x2,y1,st3);end;
procedure double(x1,y1,x2,y2:integer);
var st1,st2,st3:string;i:integer;begin st1:=chr(201);st2:=chr(186);st3:=chr(200);
for i:=1 to y2-y1-1 do begin st1:=st1+chr(205);st2:=st2+' ';st3:=st3+chr(205);
end;st1:=st1+chr(187);st2:=st2+chr(186);st3:=st3+chr(188);say(x1,y1,st1);for i:=x1+1 to x2-1 do
say(i,y1,st2);say(x2,y1,st3);end;
procedure clearkey;var ch:char;begin while keypressed do ch:=readkey;end;