{
最近每天都去写了几个DP题
blog没空更新了
这次把我的OI/ACM程序测试机贴出来
喜欢上OJ的同学可以下载用用
}
第一部分
还是结合几个程序段来讲解Dos单元的函数
1.调用Dos单元
1 {$M $4000,0,0}
2 uses Dos,Crt;
这次的程序需要加一句话{$M $4000,0,0} 很重要 不然Dos单元的部分函数会出问题
第二句照常调用所需要的单元 同时调用了 Crt单元 和 Dos单元
2.文件查找
1 procedure Title;
2 begin
3 auto: = false;
4 if FSearch('History.txt','')=''
5 then begin
6 n: = 2 ;
7 exn: = ' pas ' ;
FSearch用于在指定目录下查找一个文件
参数为文件名和地址 查找成功返回文件具体位置 查找失败返回空串
3.文件读写
1 assign(his,'History.txt' ); rewrite(his);
2 writeln(his,n);
3 writeln(his,exn);
4 writeln(his,pathc);
5 writeln(his,filen);
6 writeln(his,pathf);
7 close(his);
8 end
9 else begin
10 assign(his,'History.txt' ); reset(his);
11 readln(his,n);
12 readln(his,exn);
13 readln(his,pathc);
14 readln(his,filen);
15 readln(his,pathf);
16 close(his);
17 end ;
其实这个不是Dos单元的函数 是System单元的函数
只不过很重要带着介绍一下
定义文件类型: Var his:text;
Assign给文件类型重载一个文件 使指定文件类型可以指向一个文件
参数为 文件类型 和 文件位置+文件名 当前文件夹下 地址可以省略
write和read都要加入平时省略的参数 文件类型 否则会输入到屏幕
最后文件及时关闭 以防出错
4.调用外部程序
1 writeln( ' Test Case ' ,k, ' : ' );
2 writeln( ' ->Making Data... ' );
3 SwapVectors;
4 Exec(pathf+filen+'d.exe','' );
5 SwapVectors;
Exec 函数提供了调用外部应用程序的途径
这个函数需要两个字符串参数 一个是文件地址+文件名 另一个是外部程序运行所需的参数
如果没有参数就是空串 譬如我编译文件0.pas 需要调用Fpc.exe
写出来就就是 Exec ('C:\pp\bin\go32v2\fpc.exe','0.pas');
另外SwapVector在调用Exec一前一后一般都要调用
具体原理很复杂 不讲了
5.时间测定
1 write( ' ->Running Program ' ,i, ' ... ' );
2 SwapVectors;
3 GetTime(h1,m1,s1,hs1);
4 Exec(pathf + filen + char(i + 48 ) + ' .exe ' , '' );
5 GetTime(h2,m2,s2,hs2);
6 SwapVectors;
7 tt:=(h2-h1)*3600+(m2-m1)*60+s2-s1+(hs2-hs1)/100 ;
8 time[i]: = time[i] + tt;
9 writeln( ' [Time Cost: ' ,tt: 0 : 2 , ' s] ' );
GetTime可以记录当前的时刻
四个参数分别是时 分 秒 百分秒
测两次求差可以得到间隔的时间
利用单位转化的公式可以化成统一的单位
这些就是Dos单元里常用的函数
还有其他更多的函数用到的时候再说吧
第二部分
介绍我程序的结构 以及使用方法
先给源码
{ $M $4000,0,0 }
uses Dos,Crt;
const maxn = 10 ;
var res,his,chki,chkj:text;
n:longint;
exn,pathc,filen,pathf:string;
auto:boolean;
time: array [ 1 ..maxn] of real;
procedure Main(x:longint); forward;
procedure Options(x:longint); forward;
procedure Pause;
begin
gotoxy( 1 , 10 );
textcolor(LightGreen);
writeln( ' Press any key to continue... ' );
readkey;
end ;
procedure Title;
begin
auto: = false;
if FSearch( ' History.txt ' , '' ) = ''
then begin
n: = 2 ;
exn: = ' pas ' ;
pathc: = ' c:\pp\bin\go32v2\fpc.exe ' ;
filen: = ' bst ' ;
pathf: = '' ;
assign(his, ' History.txt ' ); rewrite(his);
writeln(his,n);
writeln(his,exn);
writeln(his,pathc);
writeln(his,filen);
writeln(his,pathf);
close(his);
end
else begin
assign(his, ' History.txt ' ); reset(his);
readln(his,n);
readln(his,exn);
readln(his,pathc);
readln(his,filen);
readln(his,pathf);
close(his);
end ;
clrscr;
writeln( ' +----------------------+ ' );
writeln( ' | BOB-TESTER | ' );
writeln( ' +----------------------+ ' );
writeln( ' | | ' );
writeln( ' | V-1.01.00 Beta | ' );
writeln( ' | | ' );
writeln( ' | Check Your Programs! | ' );
writeln( ' | | ' );
writeln( ' +----------------------+ ' );
Pause;
end ;
procedure Window;
begin
clrscr;
textcolor(White);
writeln( ' +-------------------------+ ' );
writeln( ' | | ' );
writeln( ' +-------------------------+ ' );
writeln( ' | | ' );
writeln( ' | | ' );
writeln( ' | | ' );
writeln( ' | | ' );
writeln( ' | | ' );
writeln( ' +-------------------------+ ' );
end ;
procedure MakeResults(x,m:longint);
var i:longint;
begin
assign(res, ' Result.txt ' );
rewrite(res);
writeln(res, ' Answer Comparation: ' );
if x = 1
then writeln(res, ' Totally one Case has been finished. ' )
else writeln(res, ' Totally ' ,x, ' Cases have been finished. ' );
if m = 0
then writeln(res, ' All cases are OK. ' )
else if m = 1
then writeln(res, ' There is a case that gets wrong answers. ' )
else writeln(res, ' There are ' ,m, ' Cases gets wrong answers. ' );
writeln(res,( 1 - m / x) * 100 : 0 : 3 , ' % of Cases are Accepted. ' );
writeln(res, ' Arrange Time Cost: ' );
for i: = 1 to n do
writeln(res, ' Program ' ,i, ' :[ ' ,time[i] / x: 0 : 3 , ' s] ' );
fillchar(time,sizeof(time), 0 );
close(res);
end ;
procedure Test;
var i,j,k,w:longint;
hs1,hs2,h1,h2,s1,s2,m1,m2:word;
chi,chj,ch:char;
flag,bool:boolean;
tt:real;
begin
clrscr;
Textcolor(LightRed);
writeln( ' Compiling... ' );
Textcolor(LightGreen);
writeln( ' ->Compile Data Making Program... ' );
Textcolor(White);
SwapVectors;
Exec(pathc,filen + ' d. ' + exn);
SwapVectors;
for i: = 1 to n do
begin
Textcolor(LightGreen);
writeln( ' ->Compile Program ' ,i, ' ... ' );
SwapVectors;
Exec(pathc,filen + char(i + 48 ) + ' . ' + exn);
SwapVectors;
end ;
Textcolor(LightGreen);
writeln( ' Press Enter to Continue... ' );
ch: = readkey;
Textcolor(LightRed);
writeln( ' Testing... ' );
if auto
then begin
k: = 0 ;
flag: = true;
while flag do
begin
inc(k);
Textcolor(LightGreen);
writeln( ' Test Case ' ,k, ' : ' );
writeln( ' ->Making Data... ' );
SwapVectors;
Exec(pathf + filen + ' d.exe ' , '' );
SwapVectors;
for i: = 1 to n do
begin
write( ' ->Running Program ' ,i, ' ... ' );
SwapVectors;
GetTime(h1,m1,s1,hs1);
Exec(pathf + filen + char(i + 48 ) + ' .exe ' , '' );
GetTime(h2,m2,s2,hs2);
SwapVectors;
tt: = (h2 - h1) * 3600 + (m2 - m1) * 60 + s2 - s1 + (hs2 - hs1) / 100 ;
time[i]: = time[i] + tt;
writeln( ' [Time Cost: ' ,tt: 0 : 2 , ' s] ' );
end ;
Textcolor(LightRed);
write( ' ->Difference: ' );
for i: = 1 to n - 1 do
begin
for j: = i + 1 to n do
begin
assign(chki,pathf + filen + char(i + 48 ) + ' .out ' );
assign(chkj,pathf + filen + char(j + 48 ) + ' .out ' );
reset(chki);
reset(chkj);
while ( not eof(chki)) and ( not eof(chkj)) do
begin
read(chki,chi);
read(chkj,chj);
if chi <> chj
then begin
flag: = false;
write( ' [ ' ,i, ' ' ,j, ' ] ' );
break;
end ;
end ;
if (flag) and (( not eof(chki)) or ( not eof(chkj)))
then begin
flag: = false;
write( ' [ ' ,i, ' ' ,j, ' ] ' );
end ;
close(chki);
close(chkj);
end ;
end ;
if flag then write( ' None. ' );
writeln;
end ;
end
else begin
k: = 0 ; w: = 0 ;
while (ch <> ' E ' ) and (ch <> ' e ' ) do
begin
flag: = true; bool: = true;
inc(k);
Textcolor(LightGreen);
writeln( ' Test Case ' ,k, ' : ' );
writeln( ' ->Making Data... ' );
SwapVectors;
Exec(pathf + filen + ' d.exe ' , '' );
SwapVectors;
for i: = 1 to n do
begin
write( ' ->Running Program ' ,i, ' ... ' );
SwapVectors;
GetTime(h1,m1,s1,hs1);
Exec(pathf + filen + char(i + 48 ) + ' .exe ' , '' );
GetTime(h2,m2,s2,hs2);
SwapVectors;
tt: = (h2 - h1) * 3600 + (m2 - m1) * 60 + s2 - s1 + (hs2 - hs1) / 100 ;
time[i]: = time[i] + tt;
writeln( ' [Time Cost: ' ,tt: 0 : 2 , ' s] ' );
end ;
Textcolor(LightRed);
write( ' ->Difference: ' );
for i: = 1 to n - 1 do
begin
for j: = i + 1 to n do
begin
assign(chki,pathf + filen + char(i + 48 ) + ' .out ' );
assign(chkj,pathf + filen + char(j + 48 ) + ' .out ' );
reset(chki);
reset(chkj);
while ( not eof(chki)) and ( not eof(chkj)) do
begin
read(chki,chi);
read(chkj,chj);
if chi <> chj
then begin
flag: = false;
write( ' [ ' ,i, ' ' ,j, ' ] ' );
if bool then inc(w);
bool: = false;
break;
end ;
end ;
if (flag) and (( not eof(chki)) or ( not eof(chkj)))
then begin
flag: = false;
write( ' [ ' ,i, ' ' ,j, ' ] ' );
if bool then inc(w);
bool: = false;
end ;
close(chki);
close(chkj);
end ;
end ;
if flag then write( ' None. ' );
writeln;
Textcolor(LightGreen);
writeln( ' Press Enter to Continue... ' );
ch: = readkey;
end ;
MakeResults(k,w);
end ;
clrscr;
textcolor(LightGreen);
writeln( ' Finished! ' );
writeln( ' Press any key to Go Back to Main Menu... ' );
readkey;
Main( 5 );
end ;
procedure Update;
begin
assign(his, ' History.txt ' );
rewrite(his);
writeln(his,n);
writeln(his,exn);
writeln(his,pathc);
writeln(his,filen);
writeln(his,pathf);
close(his);
end ;
procedure Amount;
begin
clrscr;
textcolor(White);
writeln( ' +-------------------------+ ' );
writeln( ' | Amount: | ' );
writeln( ' +-------------------------+ ' );
gotoxy( 15 , 2 );
readln(n);
update;
gotoxy( 1 , 4 );
textcolor(LightGreen);
writeln( ' Press any key to Back to Options... ' );
readkey;
Options( 4 );
end ;
procedure TestMode(x:longint);
var ch:char;
begin
Window;
gotoxy( 10 , 2 );
write( ' Test Mode ' );
textcolor(White);
gotoxy( 3 , 5 );
write( ' Hand Actuated. ' );
gotoxy( 3 , 6 );
write( ' Automatic. ' );
gotoxy( 3 , 7 );
write( ' Back to Options. ' );
gotoxy( 3 ,x);
textcolor(LightRed);
case x of
5 :write( ' ==> Hand Actuated. ' );
6 :write( ' ==> Automatic. ' );
7 :write( ' ==> Back to Options. ' );
end ;
ch: = readkey;
while ch <> # 13 do
begin
case ch of
# 87 ,# 119 :
begin
if x = 5
then begin
x: = 6 ;
ch: = # 83 ;
continue;
end ;
textcolor(White);
gotoxy( 3 , 5 );
write( ' Hand Actuated. ' );
gotoxy( 3 , 6 );
write( ' Automatic. ' );
gotoxy( 3 , 7 );
write( ' Back to Options. ' );
dec(x);
gotoxy( 3 ,x);
textcolor(LightRed);
case x of
5 :write( ' ==> Hand Actuated. ' );
6 :write( ' ==> Automatic. ' );
7 :write( ' ==> Back to Options. ' );
end ;
end ;
# 83 ,# 115 :
begin
if x = 7
then begin
x: = 6 ;
ch: = # 87 ;
continue;
end ;
textcolor(White);
gotoxy( 3 , 5 );
write( ' Hand Actuated. ' );
gotoxy( 3 , 6 );
write( ' Automatic. ' );
gotoxy( 3 , 7 );
write( ' Back to Options. ' );
inc(x);
gotoxy( 3 ,x);
textcolor(LightRed);
case x of
5 :write( ' ==> Hand Actuated. ' );
6 :write( ' ==> Automatic. ' );
7 :write( ' ==> Back to Options. ' );
end ;
end ;
end ;
ch: = readkey;
end ;
case x of
5 :auto: = false;
6 :auto: = true;
7 :Options( 5 );
end ;
TestMode(x);
end ;
procedure FilePN(x:longint);
var ch:char;
begin
Window;
gotoxy( 7 , 2 );
write( ' File Paths&Names ' );
textcolor(White);
gotoxy( 3 , 5 );
write( ' File Name ' );
gotoxy( 3 , 6 );
write( ' File Path ' );
gotoxy( 3 , 7 );
write( ' Back to Options. ' );
gotoxy( 3 ,x);
textcolor(LightRed);
case x of
5 :write( ' ==> File Name ' );
6 :write( ' ==> File Path ' );
7 :write( ' ==> Back to Options. ' );
end ;
ch: = readkey;
while ch <> # 13 do
begin
case ch of
# 87 ,# 119 :
begin
if x = 5
then begin
x: = 6 ;
ch: = # 83 ;
continue;
end ;
textcolor(White);
gotoxy( 3 , 5 );
write( ' File Name ' );
gotoxy( 3 , 6 );
write( ' File Path ' );
gotoxy( 3 , 7 );
write( ' Back to Options. ' );
dec(x);
gotoxy( 3 ,x);
textcolor(LightRed);
case x of
5 :write( ' ==> File Name ' );
6 :write( ' ==> File Path ' );
7 :write( ' ==> Back to Options. ' );
end ;
end ;
# 83 ,# 115 :
begin
if x = 7
then begin
x: = 6 ;
ch: = # 87 ;
continue;
end ;
textcolor(White);
gotoxy( 3 , 5 );
write( ' File Name ' );
gotoxy( 3 , 6 );
write( ' File Path ' );
gotoxy( 3 , 7 );
write( ' Back to Options. ' );
inc(x);
gotoxy( 3 ,x);
textcolor(LightRed);
case x of
5 :write( ' ==> File Name ' );
6 :write( ' ==> File Path ' );
7 :write( ' ==> Back to Options. ' );
end ;
end ;
end ;
ch: = readkey;
end ;
textcolor(LightGreen);
case x of
5 :
begin
gotoxy( 1 , 6 );
insline;
gotoxy( 3 , 6 );
readln(filen);
gotoxy( 1 , 6 );
delline;
end ;
6 :
begin
gotoxy( 1 , 7 );
insline;
gotoxy( 3 , 7 );
readln(pathf);
gotoxy( 1 , 7 );
delline;
end ;
7 :
begin
Update;
Options( 6 );
end ;
end ;
FilePN(x);
end ;
procedure CompileMode(x:longint);
var ch:char;
begin
Window;
gotoxy( 10 , 2 );
write( ' Compile Mode ' );
textcolor(White);
gotoxy( 3 , 5 );
write( ' Extension Name ' );
gotoxy( 3 , 6 );
write( ' Compiling Path ' );
gotoxy( 3 , 7 );
write( ' Back to Options. ' );
gotoxy( 3 ,x);
textcolor(LightRed);
case x of
5 :write( ' ==> Extension Name ' );
6 :write( ' ==> Compiling Path ' );
7 :write( ' ==> Back to Options. ' );
end ;
ch: = readkey;
while ch <> # 13 do
begin
case ch of
# 87 ,# 119 :
begin
if x = 5
then begin
x: = 6 ;
ch: = # 83 ;
continue;
end ;
textcolor(White);
gotoxy( 3 , 5 );
write( ' Extension Name ' );
gotoxy( 3 , 6 );
write( ' Compiling Path ' );
gotoxy( 3 , 7 );
write( ' Back to Options. ' );
dec(x);
gotoxy( 3 ,x);
textcolor(LightRed);
case x of
5 :write( ' ==> Extension Name ' );
6 :write( ' ==> Compiling Path ' );
7 :write( ' ==> Back to Options. ' );
end ;
end ;
# 83 ,# 115 :
begin
if x = 7
then begin
x: = 6 ;
ch: = # 87 ;
continue;
end ;
textcolor(White);
gotoxy( 3 , 5 );
write( ' Extension Name ' );
gotoxy( 3 , 6 );
write( ' Compiling Path ' );
gotoxy( 3 , 7 );
write( ' Back to Options. ' );
inc(x);
gotoxy( 3 ,x);
textcolor(LightRed);
case x of
5 :write( ' ==> Extension Name ' );
6 :write( ' ==> Compiling Path ' );
7 :write( ' ==> Back to Options. ' );
end ;
end ;
end ;
ch: = readkey;
end ;
textcolor(LightGreen);
case x of
5 :
begin
gotoxy( 1 , 6 );
insline;
gotoxy( 3 , 6 );
readln(exn);
gotoxy( 1 , 6 );
delline;
end ;
6 :
begin
gotoxy( 1 , 7 );
insline;
gotoxy( 3 , 7 );
readln(pathc);
gotoxy( 1 , 7 );
delline;
end ;
7 :
begin
Update;
Options( 7 );
end ;
end ;
CompileMode(x);
end ;
procedure Options(x:longint);
var ch:char;
begin
Window;
gotoxy( 11 , 2 );
write( ' Options ' );
textcolor(White);
gotoxy( 3 , 4 );
write( ' Amount of Programs. ' );
gotoxy( 3 , 5 );
write( ' Test Mode. ' );
gotoxy( 3 , 6 );
write( ' File Paths&Names. ' );
gotoxy( 3 , 7 );
write( ' Compile Mode. ' );
gotoxy( 3 , 8 );
write( ' Back to Main Menu. ' );
gotoxy( 3 ,x);
textcolor(LightRed);
case x of
4 :write( ' ==> Amount of Programs. ' );
5 :write( ' ==> Test Mode. ' );
6 :write( ' ==> File Paths&Names. ' );
7 :write( ' ==> Compile Mode. ' );
8 :write( ' ==> Back to Main Menu. ' );
end ;
ch: = readkey;
while ch <> # 13 do
begin
case ch of
# 87 ,# 119 :
begin
if x = 4
then begin
x: = 7 ;
ch: = # 83 ;
continue;
end ;
textcolor(White);
gotoxy( 3 , 4 );
write( ' Amount of Programs. ' );
gotoxy( 3 , 5 );
write( ' Test Mode. ' );
gotoxy( 3 , 6 );
write( ' File Paths&Names. ' );
gotoxy( 3 , 7 );
write( ' Compile Mode. ' );
gotoxy( 3 , 8 );
write( ' Back to Main Menu. ' );
dec(x);
gotoxy( 3 ,x);
textcolor(LightRed);
case x of
4 :write( ' ==> Amount of Programs. ' );
5 :write( ' ==> Test Mode. ' );
6 :write( ' ==> File Paths&Names. ' );
7 :write( ' ==> Compile Mode. ' );
8 :write( ' ==> Back to Main Menu. ' );
end ;
end ;
# 83 ,# 115 :
begin
if x = 8
then begin
x: = 5 ;
ch: = # 87 ;
continue;
end ;
textcolor(White);
gotoxy( 3 , 4 );
write( ' Amount of Programs. ' );
gotoxy( 3 , 5 );
write( ' Test Mode. ' );
gotoxy( 3 , 6 );
write( ' File Paths&Names. ' );
gotoxy( 3 , 7 );
write( ' Compile Mode. ' );
gotoxy( 3 , 8 );
write( ' Back to Main Menu. ' );
inc(x);
gotoxy( 3 ,x);
textcolor(LightRed);
case x of
4 :write( ' ==> Amount of Programs. ' );
5 :write( ' ==> Test Mode. ' );
6 :write( ' ==> File Paths&Names. ' );
7 :write( ' ==> Compile Mode. ' );
8 :write( ' ==> Back to Main Menu. ' );
end ;
end ;
end ;
ch: = readkey;
end ;
case x of
4 :Amount;
5 :TestMode( 5 );
6 :FilePN( 5 );
7 :CompileMode( 5 );
8 :Main( 6 );
end ;
end ;
procedure Quit;
var i:longint;
begin
Window;
gotoxy( 9 , 2 );
write( ' Exiting.... ' );
gotoxy( 8 , 6 );
textcolor(LightRed);
write( ' Good Bye ' );
for i: = 1 to 6 do
begin
write( ' . ' );
delay( 300 );
end ;
halt;
end ;
procedure Main(x:longint);
var ch:char;
begin
Window;
gotoxy( 10 , 2 );
write( ' Main Menu ' );
textcolor(White);
gotoxy( 3 , 5 );
write( ' Test Your Programs. ' );
gotoxy( 3 , 6 );
write( ' Change Options. ' );
gotoxy( 3 , 7 );
write( ' Exit Bob-Tester. ' );
gotoxy( 3 ,x);
textcolor(LightRed);
case x of
5 :write( ' ==> Test Your Programs. ' );
6 :write( ' ==> Change Options. ' );
7 :write( ' ==> Exit Bob-Tester. ' );
end ;
ch: = readkey;
while ch <> # 13 do
begin
case ch of
# 87 ,# 119 :
begin
if x = 5
then begin
x: = 6 ;
ch: = # 83 ;
continue;
end ;
textcolor(White);
gotoxy( 3 , 5 );
write( ' Test Your Programs. ' );
gotoxy( 3 , 6 );
write( ' Change Options. ' );
gotoxy( 3 , 7 );
write( ' Exit Bob-Tester. ' );
dec(x);
gotoxy( 3 ,x);
textcolor(LightRed);
case x of
5 :write( ' ==> Test Your Programs. ' );
6 :write( ' ==> Change Options. ' );
7 :write( ' ==> Exit Bob-Tester. ' );
end ;
end ;
# 83 ,# 115 :
begin
if x = 7
then begin
x: = 6 ;
ch: = # 87 ;
continue;
end ;
textcolor(White);
gotoxy( 3 , 5 );
write( ' Test Your Programs. ' );
gotoxy( 3 , 6 );
write( ' Change Options. ' );
gotoxy( 3 , 7 );
write( ' Exit Bob-Tester. ' );
inc(x);
gotoxy( 3 ,x);
textcolor(LightRed);
case x of
5 :write( ' ==> Test Your Programs. ' );
6 :write( ' ==> Change Options. ' );
7 :write( ' ==> Exit Bob-Tester. ' );
end ;
end ;
end ;
ch: = readkey;
end ;
case x of
5 :Test;
6 :Options( 4 );
7 :Quit;
end ;
end ;
begin
Title;
Main( 5 );
end .
写的很长 一坨一坨的
程序主要分两块
参数修改模块 和 具体执行模块
我先给一个框架
Main
Test Program
->具体执行 Test函数
Options //参数修改
Amount of Programs
->具体修改参与测试的程序数量
Test Mode //测试参数修改
->具体选择手动或自动
File Paths&Names //文件参数修改
->具体修改
->文件名
->文件地址
Compile Mode //编译参数修改
->具体修改
->文件后缀名
->编译器地址
Back to Main Menu
->具体执行返回操作
Exit
->具体执行 Quit函数
分这两块给出具有代表性的函数介绍一下
参数修改就举例Options主菜单
1 procedure Options(x:longint);
2 var ch:char;
3 begin
4 Window;
5 gotoxy( 11 , 2 );
6 write( ' Options ' );
7 textcolor(White);
8 gotoxy( 3 , 4 );
9 write( ' Amount of Programs. ' );
10 gotoxy( 3 , 5 );
11 write( ' Test Mode. ' );
12 gotoxy( 3 , 6 );
13 write( ' File Paths&Names. ' );
14 gotoxy( 3 , 7 );
15 write( ' Compile Mode. ' );
16 gotoxy( 3 , 8 );
17 write( ' Back to Main Menu. ' );
18 gotoxy( 3 ,x);
19 textcolor(LightRed);
20 case x of
21 4 :write( ' ==> Amount of Programs. ' );
22 5 :write( ' ==> Test Mode. ' );
23 6 :write( ' ==> File Paths&Names. ' );
24 7 :write( ' ==> Compile Mode. ' );
25 8 :write( ' ==> Back to Main Menu. ' );
26 end ;
27 ch: = readkey;
28 while ch <> # 13 do
29 begin
30 case ch of
31 # 87 ,# 119 :
32 begin
33 if x = 4
34 then begin
35 x: = 7 ;
36 ch: = # 83 ;
37 continue;
38 end ;
39 textcolor(White);
40 gotoxy( 3 , 4 );
41 write( ' Amount of Programs. ' );
42 gotoxy( 3 , 5 );
43 write( ' Test Mode. ' );
44 gotoxy( 3 , 6 );
45 write( ' File Paths&Names. ' );
46 gotoxy( 3 , 7 );
47 write( ' Compile Mode. ' );
48 gotoxy( 3 , 8 );
49 write( ' Back to Main Menu. ' );
50 dec(x);
51 gotoxy( 3 ,x);
52 textcolor(LightRed);
53 case x of
54 4 :write( ' ==> Amount of Programs. ' );
55 5 :write( ' ==> Test Mode. ' );
56 6 :write( ' ==> File Paths&Names. ' );
57 7 :write( ' ==> Compile Mode. ' );
58 8 :write( ' ==> Back to Main Menu. ' );
59 end ;
60 end ;
61 # 83 ,# 115 :
62 begin
63 if x = 8
64 then begin
65 x: = 5 ;
66 ch: = # 87 ;
67 continue;
68 end ;
69 textcolor(White);
70 gotoxy( 3 , 4 );
71 write( ' Amount of Programs. ' );
72 gotoxy( 3 , 5 );
73 write( ' Test Mode. ' );
74 gotoxy( 3 , 6 );
75 write( ' File Paths&Names. ' );
76 gotoxy( 3 , 7 );
77 write( ' Compile Mode. ' );
78 gotoxy( 3 , 8 );
79 write( ' Back to Main Menu. ' );
80 inc(x);
81 gotoxy( 3 ,x);
82 textcolor(LightRed);
83 case x of
84 4 :write( ' ==> Amount of Programs. ' );
85 5 :write( ' ==> Test Mode. ' );
86 6 :write( ' ==> File Paths&Names. ' );
87 7 :write( ' ==> Compile Mode. ' );
88 8 :write( ' ==> Back to Main Menu. ' );
89 end ;
90 end ;
91 end ;
92 ch: = readkey;
93 end ;
94 case x of
95 4 :Amount;
96 5 :TestMode( 5 );
97 6 :FilePN( 5 );
98 7 :CompileMode( 5 );
99 8 :Main( 6 );
100 end ;
101 end ;
每一个修改参数的函数都需要一个参数记录光标==>的位置
利用Crt单元的函数实现光标上下移动
根据光标的位置最后确定执行什么操作
然后是程序执行的模块 举例测试函数
1 procedure Test;
2 var i,j,k,w:longint;
3 hs1,hs2,h1,h2,s1,s2,m1,m2:word;
4 chi,chj,ch:char;
5 flag,bool:boolean;
6 tt:real;
7 begin
8 clrscr;
9 Textcolor(LightRed);
10 writeln( ' Compiling... ' );
11 Textcolor(LightGreen);
12 writeln( ' ->Compile Data Making Program... ' );
13 Textcolor(White);
14 SwapVectors;
15 Exec(pathc,filen + ' d. ' + exn);
16 SwapVectors;
17 for i: = 1 to n do
18 begin
19 Textcolor(LightGreen);
20 writeln( ' ->Compile Program ' ,i, ' ... ' );
21 SwapVectors;
22 Exec(pathc,filen + char(i + 48 ) + ' . ' + exn);
23 SwapVectors;
24 end ;
25 Textcolor(LightGreen);
26 writeln( ' Press Enter to Continue... ' );
27 ch: = readkey;
28 Textcolor(LightRed);
29 writeln( ' Testing... ' );
30 if auto
31 then begin
32 k: = 0 ;
33 flag: = true;
34 while flag do
35 begin
36 inc(k);
37 Textcolor(LightGreen);
38 writeln( ' Test Case ' ,k, ' : ' );
39 writeln( ' ->Making Data... ' );
40 SwapVectors;
41 Exec(pathf + filen + ' d.exe ' , '' );
42 SwapVectors;
43 for i: = 1 to n do
44 begin
45 write( ' ->Running Program ' ,i, ' ... ' );
46 SwapVectors;
47 GetTime(h1,m1,s1,hs1);
48 Exec(pathf + filen + char(i + 48 ) + ' .exe ' , '' );
49 GetTime(h2,m2,s2,hs2);
50 SwapVectors;
51 tt: = (h2 - h1) * 3600 + (m2 - m1) * 60 + s2 - s1 + (hs2 - hs1) / 100 ;
52 time[i]: = time[i] + tt;
53 writeln( ' [Time Cost: ' ,tt: 0 : 2 , ' s] ' );
54 end ;
55 Textcolor(LightRed);
56 write( ' ->Difference: ' );
57 for i: = 1 to n - 1 do
58 begin
59 for j: = i + 1 to n do
60 begin
61 assign(chki,pathf + filen + char(i + 48 ) + ' .out ' );
62 assign(chkj,pathf + filen + char(j + 48 ) + ' .out ' );
63 reset(chki);
64 reset(chkj);
65 while ( not eof(chki)) and ( not eof(chkj)) do
66 begin
67 read(chki,chi);
68 read(chkj,chj);
69 if chi <> chj
70 then begin
71 flag: = false;
72 write( ' [ ' ,i, ' ' ,j, ' ] ' );
73 break;
74 end ;
75 end ;
76 if (flag) and (( not eof(chki)) or ( not eof(chkj)))
77 then begin
78 flag: = false;
79 write( ' [ ' ,i, ' ' ,j, ' ] ' );
80 end ;
81 close(chki);
82 close(chkj);
83 end ;
84 end ;
85 if flag then write( ' None. ' );
86 writeln;
87 end ;
88 end
89 else begin
90 k: = 0 ; w: = 0 ;
91 while (ch <> ' E ' ) and (ch <> ' e ' ) do
92 begin
93 flag: = true; bool: = true;
94 inc(k);
95 Textcolor(LightGreen);
96 writeln( ' Test Case ' ,k, ' : ' );
97 writeln( ' ->Making Data... ' );
98 SwapVectors;
99 Exec(pathf + filen + ' d.exe ' , '' );
100 SwapVectors;
101 for i: = 1 to n do
102 begin
103 write( ' ->Running Program ' ,i, ' ... ' );
104 SwapVectors;
105 GetTime(h1,m1,s1,hs1);
106 Exec(pathf + filen + char(i + 48 ) + ' .exe ' , '' );
107 GetTime(h2,m2,s2,hs2);
108 SwapVectors;
109 tt: = (h2 - h1) * 3600 + (m2 - m1) * 60 + s2 - s1 + (hs2 - hs1) / 100 ;
110 time[i]: = time[i] + tt;
111 writeln( ' [Time Cost: ' ,tt: 0 : 2 , ' s] ' );
112 end ;
113 Textcolor(LightRed);
114 write( ' ->Difference: ' );
115 for i: = 1 to n - 1 do
116 begin
117 for j: = i + 1 to n do
118 begin
119 assign(chki,pathf + filen + char(i + 48 ) + ' .out ' );
120 assign(chkj,pathf + filen + char(j + 48 ) + ' .out ' );
121 reset(chki);
122 reset(chkj);
123 while ( not eof(chki)) and ( not eof(chkj)) do
124 begin
125 read(chki,chi);
126 read(chkj,chj);
127 if chi <> chj
128 then begin
129 flag: = false;
130 write( ' [ ' ,i, ' ' ,j, ' ] ' );
131 if bool then inc(w);
132 bool: = false;
133 break;
134 end ;
135 end ;
136 if (flag) and (( not eof(chki)) or ( not eof(chkj)))
137 then begin
138 flag: = false;
139 write( ' [ ' ,i, ' ' ,j, ' ] ' );
140 if bool then inc(w);
141 bool: = false;
142 end ;
143 close(chki);
144 close(chkj);
145 end ;
146 end ;
147 if flag then write( ' None. ' );
148 writeln;
149 Textcolor(LightGreen);
150 writeln( ' Press Enter to Continue... ' );
151 ch: = readkey;
152 end ;
153 MakeResults(k,w);
154 end ;
155 clrscr;
156 textcolor(LightGreen);
157 writeln( ' Finished! ' );
158 writeln( ' Press any key to Go Back to Main Menu... ' );
159 readkey;
160 Main( 5 );
161 end ;
这个是整个程序的核心
主要流程就是
执行数据生成程序
逐个执行参与测试的程序
逐个比较输出文件 最后输出结果并记录
判断是否跳出
更为具体的使用方法
可以参见帮助文件
还需加入更多的功能
Bob HAN 原创 转载请注明出处 http://www.cnblogs.com/Booble/
(由于cnblog的原因 本程序及其他附件暂不支持下载 待故障排除即可下载)