[程序测试] FreePascal之Dos单元
{
最近每天都去写了几个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单元里常用的函数
还有其他更多的函数用到的时候再说吧
第二部分
介绍我程序的结构 以及使用方法
先给源码
Code
{
$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的原因 本程序及其他附件暂不支持下载 待故障排除即可下载)