例1:德国数学家:【哥德巴赫猜想】的验证。
任一大于或等于６的偶数，总可分解为两个素数(质数)之和。
要求键盘输入一个不小于6的偶数N,然后输出6--N之间的这些哥德巴赫关系式:6=3+3,8=3+5,.....(每行输出一个式子)。
素数＝质数，判断素数的方法：用3与该数的平方根之间的所有奇数去除这个数，均不能被整除者，即为素数。
SET TALK OFF
CLEAR
N=6
@3,5 SAY 'N=?' GET N VALID N>=6.AND.MOD(N,2)=0
READ
I=6
DO WHILE I<=N
A=3
DO WHILE A<I
B=3
TA=.T.
DO WHILE B<=SQRT(A)
IF MOD(A,B)=0
TA=.F.
EXIT
ENDIF
B=B+2
ENDDO
IF TA
C=I-A
D=3
TC=.T.
DO WHILE D<=SQRT(C)
IF MOD(C,D)=0
TC=.F.
EXIT
ENDIF
D=D+2
ENDDO
IF TC
?LTRIM(STR(I))+"="+LTRIM(STR(A))+"+"+LTRIM(STR(C))
EXIT
ENDIF
ENDIF
A=A+2
ENDDO
I=I+2
ENDDO
SET TALK OFF
RETURN
例2:把一个两位的素数接到另外一个两位的素数后，得到一个四位数，而这个四位数可以被这两个素数之和的一半整除，求出所有这样的素数对。(两个素数不应相同). 运行结果：53,13,47,19,43,23,37,29
SET TALK OFF
I=9
DO WHILE I<99
I=I+2
TI=.F.
L=3
DO WHILE L<=SQRT(I)
IF MOD(I,L)=0
TI=.T.
EXIT
ENDIF
L=L+2
ENDDO
IF TI
LOOP
ENDIF
J=11
DO WHILE J<99
J=J+2
IF J=I.OR.I-J>0 && 过滤相同数或对称的反序数对
LOOP
ENDIF
TJ=.F.
L=3
DO WHILE L<=SQRT(J)
IF MOD(J,L)=0
TJ=.T.
EXIT
ENDIF
L=L+2
ENDDO
IF TJ
LOOP
ENDIF
S4=J*100+I
IF MOD(S4,(I+J)/2)=0
?I,J
ENDIF
ENDDO
ENDDO
SET TALK ON
RETURN
例3: (1)一框鸡蛋,每次取2、3、4、5、6个时分别剩下一个,每次取7个时不剩。问这框鸡蛋至少有多少个？
(2)一座七层宝塔，自上而下，每一层的灯都是上面一层灯的2倍，共有381盏灯。问每一层各有多少盏灯？
SET TALK OFF
SET DECI TO 0
clear
I=7
DO WHILE .T.
IF MOD(I,2)=1.AND.MOD(I,3)=1.AND.MOD(I,4)=1
IF MOD(I,5)=1.AND.MOD(I,6)=1.AND.MOD(I,7)=0
? "这框鸡蛋个数至少为:",I
EXIT
ENDIF
ENDIF
I=I+1
ENDDO
?
DIMENSION B(7)
I=1
DO WHILE .T.
S=0
J=1
DO WHILE J<=7
B(J)=I*2^(J-1)
S=S+B(J)
J=J+1
ENDDO
IF S=381
EXIT
ENDIF
I=I+1
ENDDO
?"这个宝塔各层的灯盏数分别为:"
J=1
DO WHILE J<=7
?B(J)
J=J+1
ENDDO
SET DECI TO 2
SET TALK ON
RETURN
例4: 从小到大找出5个素数，使后面的数都比前面的数大12。
SET TALK OFF
I=1
DO WHILE .T.
I=I+2 && 从3开始产生奇数
L=3
TI=.F.
DO WHILE L<=SQRT(I)
IF MOD(I,L)=0
TI=.T.
EXIT
ENDIF
L=L+2
ENDDO 检验当前的I是否为素数
IF TI
LOOP
ENDIF
K=I && 这个I已是素数
J=1
DO WHILE J<=4
K=K+12 && 检验后面4个数是否为素数
L=3
TK=.F.
DO WHILE L<=SQRT(K)
IF MOD(K,L)=0
TK=.T.
EXIT
ENDIF
L=L+2
ENDDO
IF TK
EXIT
ENDIF
J=J+1
ENDDO
IF J>4 &&若J<=4,则必是中途退出循环的,不符合题意
? I,I+12,I+12*2,I+12*3,I+12*4
**** 这5个素数后比前均相差12 ***
EXIT
ENDIF
ENDDO
SET TALK ON
RETURN
例5: XT1.PRG 字符塔
本题要求从屏幕顶部中间往下以▲画字符塔(字符填充)，由键盘输入确定塔的层数(字符▲个数),第1个▲画2层,往下层数递增,塔限23层,另外要求每个▲自顶向下每层分别以 A,B,C...字符填充。
请分别用两种方法编程运行(必须有递归调用法)。注: ASC("A")=65。颜色方面要求:各层塔颜色不同。
如第一层: A
BBB
SET TALK OFF
SET SCOR OFF
SET STAT OFF
SET PROC TO XT1
SET COLOR TO W+/GB+
CLEAR
N=1
@3,10 SAY '字符塔层数(≤23)=' GET N PICT '99' RANGE 1,23
READ
CLEAR
DO XX WITH N
WAIT ''
CLOSE PROCEDURE
SET COLOR TO
SET SCOR ON
SET STAT ON
SET TALK ON
RETURN
PROCEDURE XX
PARAMETERS N
IF N>1
DO XX WITH N-1 && 递归调用
ENDIF
C=STR(N+3,2)
SET COLOR TO &C./GB+
I=1
DO WHILE I<=N+1
? SPACE(40-I)+REPL(CHR(64+I),2*I-1)
I=I+1
ENDDO
RETURN
例6: 计算各代数式的值。
a. 2＋(2＋4)＋(2＋4＋6)＋……(2＋4＋……＋100)＝?
b. 1!＋(1!＋3!)＋(1!＋3!＋5!)＋……(1!＋3!＋……9!)＝?
c. e≈1＋1/1!＋1/2!＋1/3!＋……1/N!＋……(精确到1/N!<0.00001为止，近似到小数点后第4位)
3·1! 32·2! 33·3! 310·10!
d.───＋ ──── ＋ ──── ＋…… ────────
1 1·3 1·3·5 1·3·5……·19
e. 3＋33＋333＋……＋33333333＝?
*XT3.PRG
SET TALK OFF
CLEAR
STORE 0 TO X,S
N=2
DO WHILE N<=100
X=X+N
S=S+X
N=N+2
ENDDO
?"A. 2+(2+4)+(2+4+6)+...+(2+4+..+100)=",S
STORE 0 TO X,S
N=1
DO WHILE N<=9
STORE 1 TO M,L
DO WHILE L<=N
M=M*L
L=L+1
ENDDO && 求: N!
X=X+M
S=S+X
N=N+2
ENDDO
?"B. 1!+(1!+3!)+...+(1!+3!+5!+...+9!)=",S
E=2
STORE 1 TO M,N
DO WHILE .T.
N=N+1
M=M*N
E=E+1/M
IF 1/M<0.00001
EXIT
ENDIF
ENDDO
?"C. e≈"+STR(E,6,4)
STORE 1 TO I,J,M
S=0
DO WHILE I<=10
M=M*I && 求N!
J=J*(2*I-1) && 求分母积
S=S+3^I*M/J && 求单项式和
I=I+1
ENDDO
?"D. S=",S
S=0
M="3"
I=1
DO WHILE I<=8
S=S+VAL(M)
M=M+"3"
I=I+1
ENDDO
?"E. 3+33+333+...+33333333=",INT(S)
SET TALK ON
RETURN
例7:ZD.DBF
(库名称:C/12,
FIELD_NAME:C/10,FIELD_TYPE:C/1,FIELD_LEN:N/3,
FIELD_DEC:N/3)
ZG.DBF(职工号C/6，,姓名C/8,基本工资N/6.2,奖金N/6.2,津贴N/6.2,实发工资N/6.2)
bsh.dbf(考号C/6，笔试N/3)
shj.dbf(考号C/6，上机N/3)
系统中已有三个库文件zg.dbf、bsh.dbf、shj.dbf，另有数据字典库zd.dbf,请编写程序PROG1.PRG，在程序中先用ZAP命令把字典库记录删除，然后提示并接受用户输入数据库名，将库文件的全名及所有字段描述存放在数据字典库中。(注：可通过结构文件完成)
*PROG1.PRG
SET TALK OFF
SET SAFE OFF
SELECT 1
USE ZD
ZAP
CLEAR
I=1
DO WHILE I<=3
ACCEPT '输入库文件名:' TO NAME
NAME=UPPER(NAME)
NAME=IIF('.DBF'$NAME,NAME,NAME+'.DBF')
SELECT 2
USE &NAME
COPY TO AAA STRUCTURE EXTENDED
SELECT 1
APPEND FROM AAA
REPLACE 库名称 WITH NAME FOR 库名称=SPACE(12)
I=I+1
ENDDO
SELECT 1
DISPLAY ALL
CLOSE DATABASE
SET TALK ON
SET SAFE ON
RETURN
例8: XT5.PRG
a.一个四位数，已知它的个位数比十位数大1，百位数比十位数小2， 把这四位数各位上的数字前后次序颠倒， 所得到的新四位数与原四位数相加的和为10109，求原数。
b.有甲、乙两堆棋子，甲堆比乙堆多。 从甲堆取出与乙堆中一样多的模子放入乙堆中，然后从乙堆中取出与甲堆中所剩的棋子一样多的棋子放入甲堆中，这时甲堆有18个棋子，乙堆中有24个棋子，问甲、乙两堆原有多少个棋子?
c.一百个连续正整数相加，其和小于10100，求这些连续正整数之和中最大的一个，并打印出一百个数中的前四个数个最后一个数。
d.我国工业产值分别以6％、8％、10％、12％的增长率递增,翻两番需要多少年?
e.通过键盘输入若干个数，将其最大的最小的数打印出来。
f.打印出斐波纳契列前20个数，并计算它们的和。这个数列的特点是：第一个数为0，第二个数为1，第三个数是前二个数之和，以后的每个数都是它前面两个数之和，即：0，1，1，2，3，5，8，13……。
* XT5.PRG
SET TALK OFF
?"A 题:"
A=1
DO WHILE A<=9 && 千位数
B=0
DO WHILE B<=6
C=B+2
D=C+1
IF (A*1000+B*100+C*10+D)+(D*1000+C*100+B*10+A)=10109
?"这个数=",A*1000+B*100+C*10+D
ENDIF
B=B+1
ENDDO
A=A+1
ENDDO
?
WAIT
?
CLEAR ALL
?"B题:"
X=41
Y=1
DO WHILE X>Y
Y=42-X
MX=X-Y
MY=Y+Y
MY=MY-MX
MX=MX+MX
MX=MX-MY
MY=MY+MY
IF MX=14.AND.MY=28.AND.X+Y=42
?"甲堆有棋子数=",X
?"乙堆有棋子数=",Y
ENDIF
X=X-1
ENDDO
?
WAIT
?
CLEAR ALL
?"C题:"
STORE 0 TO S,I
DO WHILE I<=10000
I=I+1
S=0
J=I
DO WHILE J<I+100
S=S+J
J=J+1
ENDDO
IF S>=10100
EXIT
ENDIF
ENDDO
I=I-1
?"这100个数中前4个数是:",I,I+1,I+2,I+3
?"最后一个数是:",I+99
CLEAR ALL
?
WAIT
?
?"D题:"
S=1
N=0.06
I=0
DO WHILE S<=2
S=S*(1+N)
N=N+0.02
I=I+1
ENDDO
?"翻两翻需要年数为:",STR(I,2)
CLEAR ALL
?
WAIT
?
?"E题:"
I=1
DO WHILE .T.
CLEAR
N=0
@5,1 SAY "请输入第"+STR(I,2)+"个数:" GET N
READ
IF I<10
D=STR(I,1)
ELSE
D=STR(I,2)
ENDIF
X&D=N && 构造数组X(n)
IF I>=2
WAIT "继续输入下一个数吗(Y/N)?" TO YN
IF UPPER(YN)<>"Y"
EXIT
ENDIF
ENDIF
I=I+1
ENDDO
MAX=X1 && 假定最大数
MIN=X2 && 假定最小数
J=1
CLEAR
?"你输入的"+STR(I,2)+"个数是:"
DO WHILE J<=I
IF J<10
D=STR(J,1)
ELSE
D=STR(J,2)
ENDIF
?? X&D
IF X&D>MAX
MAX=X&D
ENDIF
IF X&D<MIN
MIN=X&D
ENDIF
J=J+1
ENDDO
?
?"最大数:",MAX,"最小数:",MIN
CLEAR ALL
?
WAIT
?
?"F题:“斐波纳契数列”问题"
?
STORE 0 TO A1,S
A2=1
??"这20个数是:",A1,A2
S=A1+A2
I=3
DO WHILE I<=20
A3=A1+A2
?? A3
S=S+A3
A1=A2
A2=A3
I=I+1
ENDDO
?
?"其和是:",S
SET TALK ON
RETURN
例9: 设有如下数据库文件：
仓库（仓库号C（4），城市C（8），面积N（4））
职工（仓库号C（4），职工号C（4），工资N（4））
PJGZ.DBF 城市(C/8),平均工资(N/7.2),平均面积(N/7.2)
请编写程序PROG1.PRG文件，计算出每个城市职工的平均工资,每个城市仓库的平均面积,并按城市的升序排列追加在PJGZ.DBF 库中, PJGZ.DBF中每个城市只有一条记录。
*02FOX1.PRG 这里提供两种解法供参考.
SET TALK OFF
SET SAFE OFF
clear
@5,5
wait '请选择：1、解法1 2、解法2: ' to ll
?
do case
case ll<>'2' && 第一种解法
SELECT 3
USE PJGZ
ZAP
SELECT 2
USE 仓库
INDEX ON 城市 TO CSH UNIQUE && 按城市唯一索引
CSF=''
N=0
DO WHILE .NOT.EOF()
N=N+1
CSF=CSF+城市
SKIP
ENDDO 统计城市个数
INDEX ON 仓库号 TO CKH
SELECT 1
USE 职工
SET RELATION TO 仓库号 INTO B
I=1
DO WHILE I<=N
CC=SUBSTR(CSF,4*I-3,4)
AVERAGE 工资 TO PJ FOR B->城市=CC
SELECT 2
AVERAGE 面积 TO S FOR 城市=CC
SELECT 3
APPEND BLANK
REPLACE 城市 WITH CC,平均工资 WITH PJ,平均面积 WITH S
I=I+1
SELECT 1
ENDDO
SELECT 3
case ll='2'&& 第二种解法
SELECT 4
USE PJGZ
ZAP
SELECT 1
USE 仓库
INDEX ON 城市 TO CSH
TOTAL ON 城市 TO CK && 按城市名汇总
INDEX ON 仓库号 TO CKH
SELECT 2
USE 职工
SET RELATION TO 仓库号 INTO A && 按仓库号建立关联-逻辑连接
SELECT 3
USE CK
DO WHILE .NOT.EOF()
SELECT 2
AVERAGE 工资 TO PJ FOR A->城市=C->城市
SELECT 1
AVERAGE 面积 TO S FOR 城市=C->城市
SELECT 4
APPEND BLANK
REPLACE 城市 WITH C->城市,平均工资 WITH PJ,平均面积 WITH S
SELECT 3
SKIP
ENDDO
SELECT 4
endcase
LIST
CLOSE DATABASE
SET SAFE ON
SET TALK ON
RETURN
例10: XT2.PRG 字符山
本题要求从18行左边起往右以▲画字符山,▲的个数由键盘输入确定,第一个▲画２层,往后层数递增,限8座山。各个▲在同一水平线上. 另外要求每个▲自上而下每层分别以 A,B,C...字符填充。ASC("A")=65
* XT2.PRG
SET TALK OFF
SET COLOR TO W+/BG+
CLEAR
N=1
@5,5 SAY '▲个数=?(1--8)' GET N PICT '9' RANGE 1,8
READ
CLEAR
L=1
DO WHILE L<=N
C=STR(L,2)
SET COLOR TO &C./BG+
I=1
DO WHILE I<=L+1
J=1
DO WHILE J<=2*I-1
@17-L+I,(L*L+(L-1)-I)+J SAY CHR(64+I)
J=J+1
ENDDO
I=I+1
ENDDO
例11:现有医院管理数据库系统，包括三个dbf文件：
YISHENG.DBF（医生）具体记录请打开观察(下同)
职工号(N/4),姓名(C/8),职称(C/8),部门(C/6),年龄(N/2)
YAO.DBF（药品）
药编号(N/4),药名(C/10),单位(C/2),单价(N/5,1),生产厂(C/10)
CHUFANG.DBF（处方）
药编号(N/4),数量(N/2),日期(D),职工号(N/4),处方号(N/4)
请编写符合下列要求的应用程序PROG1.PRG文件：
查询职称为"主任医师"的姓名、职称，所开处方的处方号、药名、单价、生产厂，并统计他们用药的种类，然后把查询结果按处方号升序排序存入JG1数据库中。
JG1的结构为：姓名，职称，处方号，药名，单价，生产厂。
再在JG1中增加一条记录，把统计出的用药种类填入该记录的药名字段中（注意：统计的结果与药名的数据类型不同；统计数不包括重复药名。如果使用唯一索引做统计，结果中应恢复原有记录）。
*PROG1.PRG
SET TALK OFF
SET SAFE OFF
SELE 4
USE JG1
ZAP
COPY TO AAA
USE AAA
SELE 1
USE YISHENG
SELECT 2
USE CHUFANG
SELECT 3
USE YAO
INDEX ON 药编号 TO YAOBH
SELECT 2
SET RELA TO 药编号 INTO C
SELECT 1
LOCATE ALL FOR 职称='主任医师'
DO WHILE .NOT.EOF()
SELECT 2
LOCATE ALL FOR 职工号= A->职工号
DO WHILE .NOT.EOF()
SELECT 4
APPEND BLANK
REPL 姓名 WITH A->姓名,职称 WITH A->职称,处方号 WITH B->处方号
REPL 药名 WITH C->药名,单价 WITH C->单价,生产厂 WITH C->生产厂
SELE 2
CONTINUE
ENDDO
SELECT 1
CONTINUE
ENDDO
SELECT 4
SORT ON 处方号/A TO JG1
USE JG1
INDEX ON 药名 TO YM UNIQUE
COUNT TO N
SET INDEX TO
APPEND BLANK
REPL 药名 WITH STR(N,4),姓名 WITH '药名种数'
LIST
CLOSE DATABASE
SET TALK ON
SET SAFE ON
RETURN
例12: （数据库同例11）
请编写符合下列要求的应用程序PROG2.PRG
查询由部门为"内科"的医生姓名、部门及他们所开处方的处方号、药名、单价、数量，并计算所有处方的总价格，并把结果按处方号的升序排序存入JG2数据库中，JG2的结构为:（姓名，部门，处方号，药名，单价，数量）。再在JG2中增加一条记录，把计算出的总价格填入该记录的单价字段中。
* PROG2.PRG
set talk off
set safe off
select 4
use jg2
zap
copy to aaa
use aaa
select 1
use yisheng
select 2
use yao
index on 药编号 to ybh
select 3
use chufang
set rela to 药编号 into b
select 1
locate for 部门='内科'
do while found()
select 3
locate for 职工号=A->职工号
do while found()
select 4
append blank
replace 姓名 with A->姓名,部门 WITH A->部门
REPLACE 处方号 WITH C->处方号,药名 WITH B->药名
REPLACE 单价 WITH B->单价,数量 WITH C->数量
select 3
continue
enddo
select 1
continue
enddo
select 4
sort on 处方号/A to jg2
use jg2
sum 单价*数量 TO X
append blank
replace 单价 WITH X,姓名 WITH "总价格"
list
close database
set talk on
set safe on
例13: （数据库同例11）
请编写符合下列要求的应用程序PROG3.PRG：
查询由年龄小于35岁医生的姓名、年龄，及他们所开处方的处方号、药名、单价、生产厂，并统计他们使用了几个制药厂的药品，并把查询结果按处方号升序排序存入JG3数据库中，JG3的结构为：姓名，年龄，处方号，药名，单价，生产厂。
再在JG3中增加一条记录，把统计出的制药厂个数填入该记录的生产厂字段中（注意：统计结果与生产厂字段的数据类型不同；统计数不包括重复厂名。如果使用唯一索引做统计，结果中应恢复原有记录）。
*PROG3.PRG
SET TALK OFF
SET SAFE OFF
SELE 4
USE JG3
ZAP
COPY TO AAA
USE AAA
SELE 1
USE YISHENG
SELECT 2
USE CHUFANG
SELECT 3
USE YAO
INDEX ON 药编号 TO YAOBH
SELECT 2
SET RELA TO 药编号 INTO C
SELECT 1
LOCATE ALL FOR 年龄<35
DO WHILE .NOT.EOF()
SELECT 2
LOCATE ALL FOR 职工号= A->职工号
DO WHILE .NOT.EOF()
SELECT 4
APPEND BLANK
REPL 姓名 WITH A->姓名,年龄 WITH A->年龄,处方号 WITH B->处方号
REPL 药名 WITH C->药名,单价 WITH C->单价,生产厂 WITH C->生产厂
SELE 2
CONTINUE
ENDDO
SELECT 1
CONTINUE
ENDDO
SELECT 4
SORT ON 处方号/A TO JG3
USE JG3
INDEX ON 生产厂 TO SCC UNIQUE
COUNT TO N
SET INDEX TO
APPEND BLANK
REPL 生产厂 WITH STR(N,4),姓名 WITH '生产厂数'
LIST
CLOSE DATABASE
SET TALK ON
SET SAFE ON
RETURN
例14: （数据库同例11）
请编写符合下列要求的应用程序PROG4.PRG文件：
查询所开处方中包含同仁堂生产的药品的医生姓名、职称、所在部门、处方号、药名和生产厂，并把查询结果按处方号升序排序存入JG4数据库中，JG4的结构为：(姓名，职称，部门，处方号，药名，生产厂)。统计有几位医生使用了同仁堂生产的药品，再在JG4中增加一条记录，把统计出的使用了同仁堂生产的药品的医生数填入该记录的姓名字段中(注意：医生数与姓名字段的数据类型不同；统计数不包括重复姓名。如果使用唯一索引做统计，结果中应恢复原有记录)。
*PROG4.PRG
SET TALK OFF
SET SAFE OFF
SELE 4
USE JG4
ZAP
COPY TO AAA
USE AAA
SELE 1
USE YAO
SELECT 2
USE CHUFANG
SELECT 3
USE YISHENG
INDEX ON 职工号 TO ZGH
SELE 2
SET RELA TO 职工号 INTO C
SELECT 1
LOCATE ALL FOR 生产厂='同仁堂'
DO WHILE .NOT.EOF()
SELECT 2
LOCATE ALL FOR 药编号= A->药编号
DO WHILE .NOT.EOF()
SELECT 4
APPEND BLANK
REPL 姓名 WITH C->姓名,职称 WITH C->职称,处方号 WITH B->处方号
REPL 药名 WITH A->药名,部门 WITH C->部门,生产厂 WITH A->生产厂
SELE 2
CONTINUE
ENDDO
SELECT 1
CONTINUE
ENDDO
SELECT 4
SORT ON 处方号/A TO JG4
USE JG4
INDEX ON 姓名 TO XM UNIQUE
COUNT TO N
SET INDEX TO
APPEND BLANK
REPL 姓名 WITH STR(N,6)
LIST
CLOSE DATABASE
SET TALK ON
SET SAFE ON
RETURN
例15: （数据库同例11）
编写符合下列要求的应用程序PROG5.PRG文件：
查询在99年5月1日以前开出处方的医生姓名和他们所在的部门、处方号、以及处方中所包含的药名及药品的单价和数量，并计算所有处方的总价格，把结果按处方号升序排序存入JG5数据库中，JG5的结构为：（姓名，部门，处方号，药名，单价，数量）。再在JG5中增加一条记录，把计算出的总价格填入该记录的单价字段中。
*PROG5.PRG
SET TALK OFF
SET SAFE OFF
SELECT 4
USE JG5
ZAP
COPY TO AAA
USE AAA
SELECT 1
USE CHUFANG
SELECT 2
USE YISHENG
SELECT 3
USE YAO
INDEX ON 药编号 TO YAOBH
SELECT 1
SET RELA TO 药编号 INTO C
LOCATE ALL FOR 日期<CTOD('05/01/99')
DO WHILE .NOT.EOF()
SELECT 2
LOCATE ALL FOR 职工号=A->职工号
DO WHILE .NOT.EOF()
SELECT 4
APPEND BLANK
REPL 姓名 WITH B->姓名,部门 WITH B->部门,处方号 WITH A->处方号
REPL 药名 WITH C->药名,单价 WITH C->单价,数量 WITH A->数量
SELECT 2
CONT
ENDDO
SELECT 1
CONT
ENDDO
SELECT 4
SORT ON 处方号/A TO JG5
USE JG5
SUM 数量*单价 TO N
APPEND BLANK
REPL 单价 WITH N,姓名 WITH '总价格'
LIST
CLOSE DATABASE
SET TALK ON
SET SAFE ON
RETURN
例16: STD.DBF(学号C/4，姓名C/6，性别C/2，生日D/8，民族C/6，政治面目C/4，优秀毕业生L/1,来源地区C/8，数学N/3，英语N/3，政治N/3，总分N/3)
BJ.DBF(班级号C/8，班号N/2，学生数N/3)
有两个库文件：学生库STD.DBF、班级库BJ.DBF，班级库开始时学生数字段值为0。每个学生学号的前两位是所在班级号。请编写程序PROG1.PRG，统计每个班级的学生数，存数,存放到班级数据库BJ.DBF的相应记录中。
*PROG1.PRG
SET TALK OFF
SET SAFE OFF
SELECT 1
USE BJ
COUNT TO BS
SELECT 2
USE STD
I=1
DO WHILE I<=BS
COUNT TO RS FOR VAL(SUBSTR(学号,1,2))=I
SELECT 1
LOCATE ALL FOR 班号=I
REPLACE 学生数 WITH RS
SELECT 2
I=I+1
ENDDO
SELECT 1
DISPLAY ALL
CLOSE DATA
SET TALK ON
SET SAFE ON
RETURN
例17: STD1~3.DBF(学号C/4，姓名C/6，性别C/2，生日D/8，民族C/6，政治面目C/4，优秀毕业生L/1，来源地区C/8，数学N/3，英语N/3，政治N/3，总分N/3)
有结构相同的三个班的学生数据库STD1.DBF、STD2.DBF、STD3.DBF，其中学号字段的前两位是所在班级号，后两位是顺序号。请先建立一个比赛库BS.DBF，其结构包括三个字段：编号(N,4.0)、学号(N,4.0)、姓名(C,6)。再编写程序PROG1.PRG，其功能是按学号后两位为1,9,17,25,...的规律在三个班中抽取学生参加计算机操作比赛，并按班级顺序将选取参加比赛学生的学号和姓名存放到比赛库中。
"编号"字段的前两位是班级号，后两位是按班级分别从1开始的顺序号。
*PROG1.PRG
SET TALK OFF
SET SAFE OFF
SELECT 1
USE BS
ZAP
I=1
DO WHILE I<=3
SELECT 2
NAME='STD'+STR(I,1)
USE &NAME
J=1
DO WHILE .NOT.EOF()
IF MOD(VAL(SUBSTR(学号,3,4)),8)=1
SELECT 1
APPEND BLANK
REPLACE 编号 WITH I*100+J,学号 WITH VAL(B->学号),姓名 WITH B->姓名
J=J+1
ENDIF
SELECT 2
SKIP
ENDDO
I=I+1
ENDDO
SELECT 1
DISPLAY ALL
SET TALK ON
SET SAFE ON
RETURN
例18: 现有结构相同的两个数据库，计算机小组JSJ.DBF和文艺小组WY.DBF数据库，它们的主关键字都是学号字段。根据学校规定，一个学生不能同时参加两个课外活动小组，但参加计算机小组的优先。请编写程序PROG1.PRG，其功能是将同时参加两个小组的学生记录从文艺小组库中删除。最后将被删除的记录转到相同结构的数据库CF.DBF中。
*F98FOX4.PRG
SET TALK OFF
SET SAFE OFF
SELECT 1
USE WY
COPY TO WY2
USE WY2
SELECT 2
USE JSJ
DO WHILE .NOT.EOF()
SELECT 1
LOCATE ALL FOR 学号=B->学号
IF FOUND()
DELETE
ENDIF
SELECT 2
SKIP
ENDDO
SELECT 1
COPY TO CF FOR DELETE()
PACK
USE CF
RECALL ALL
?'文艺组已被删除了的记录:'
LIST
CLOSE DATA
SET TALK ON
SET SAFE ON
RETURN
例19: GZ.DBF(职工号C/6，姓名C/8，基本工资N/6.2，奖金N/6.2， 津贴N/6.2，房租N/6.2，水电费N/6.2，实发工资N/6.2)
已有某单位的工资数据库gz.dbf，其中职工号的前四位是部门编码(1001-1005，共5个部门)。请编写程序PROG1.PRG，其功能是找出各个部门中实发工资最高的记录，将它们按部门编码顺序存放到与工资库gz.dbf具有相同结构的数据库ggz.dbf中。
*PROG1.PRG
SET TALK OFF
SET SAFE OFF
SELECT 1
USE GGZ
ZAP
SELECT 2
USE GZ
I=1
DO WHILE I<=5
BM='100'+STR(I,1)
COPY TO AAA FOR SUBSTR(职工号,1,4)=BM
SELECT 3
USE AAA
INDEX ON -实发工资 TO SFGZ
GO TOP
SCATTER TO SZ
USE && 本题在这里必须关闭!
SELECT 1
APPEND BLANK
GATHER FROM SZ
SELECT 2
I=I+1
ENDDO
SELECT 1
DISPLAY ALL
CLOSE DATABASE
SET TALK ON
SET SAFE ON
RETURN
例20: AA.DBF(AB：C/2，CD：C/2，EF：C/3，GH：N/5.2，IJ：N/3)
BB.DBF(AB：C/2，CD：C/2，EF：C/3，GH：N/5.2，IJ：N/3)
在传统的集合运算中，两个关系的交运算是取出两个关系中相同的元组存放到新关系中。现有结构相同的数据库AA.DBF和BB.DBF，它们的主关键字都是AB字段。请编写程序PROG1.PRG，程序功能是根据主关键字将AA.DBF和BB.DBF中的相同记录存到结构相同的数据库CC.DBF中，原数据库保持不变。(提示：可以使用逻辑删除，然后恢复)
*PROG1.PRG
SET TALK OFF
SET SAFE OFF
SELECT 3
USE CC
ZAP
SELECT 1
USE AA
SELECT 2
USE BB
DO WHILE .NOT.EOF()
SELECT 1
LOCATE ALL FOR AB=B->AB
DO WHILE .NOT.EOF()
SCATTER TO SZ
SELECT 3
APPEND BLANK
GATHER FROM SZ
SELECT 1
CONTINUE
ENDDO
SELECT 2
SKIP
ENDDO
SELECT 3
DISPLAY ALL
CLOSE DATA
SET TALK ON
SET SAFE ON
RETURN
例21:ZG.DBF(职工号C/6，姓名C/8，职称C/6，基本工资N/6.2，奖金N/6.2，津贴N/6.2，*实发工资N/6.2),有教职工数据库ZG.DBF，其中职工号的前四位是部门编码(1001~1005，共5个部门)。请先建立一个统计数据库TJK.DBF，其中包括6个字段：部门编码(C,4)、教授、副教授、讲师、助教和其它，后5个字段均为数值型(N,3.0)。请编写程序PROG1.PRG，程序功能是分部门统计各类职称的人数，存入统计数据库中，并要求按部门编码顺序排列。
*PROG1.PRG
SET TALK OFF
SET SAFE OFF
SELECT 1
USE TJK
ZAP
SELECT 2
USE ZG
I=1
DO WHILE I<=5
BM='100'+STR(I,1)
COPY TO AAA FOR SUBSTR(职工号,1,4)=BM
SELECT 3
USE AAA
COUNT TO N1 FOR 职称='教授'
COUNT TO N2 FOR 职称='副教授'
COUNT TO N3 FOR 职称='讲师'
COUNT TO N4 FOR 职称='助教'
COUNT TO N5 FOR 职称='其它'
USE && 本题在这里必须关闭!
SELECT 1
APPEND BLANK
REPLACE 部门编码 WITH BM,教授 WITH N1,副教授 WITH N2
REPLACE 讲师 WITH N3,助教 WITH N4,其它 WITH N5
SELECT 2
I=I+1
ENDDO
SELECT 1
DISPLAY ALL
CLOSE DATA
SET SAFE ON
SET TALK ON
RETURN
例22: GZZ.DBF(职工号C/6，姓名C/8，基本工资N/6.2，奖金N/6.2，津贴N/6.2，房租N/6.2，水电费N/6.2，实发工资N/6.2)
有某单位的工资数据库GZZ.DBF。其中职工号的前四位是部门编码(1001~1005，共5个部门)。先建立一个统计数据库GZTJ.DBF，包括三个字段：部门编码(C,4)、职工号(C,6)、增资额(N,7.2。请编写程序PROG1.PRG，在程序中首先由工资数据库拷贝生成GZ.DBF，然后再修改GZ.DBF，把实发工资等于或低于本部门平均工资的职工的实发工资提高百分之三十；并计算出每人的增资额，把有关数据存放到GZTJ.DBF中。
*98FOX8.PRG
SET TALK OFF
SET SAFE OFF
SELECT 1
USE GZTJ
ZAP
SELECT 2
USE GZZ
COPY TO GZ
USE GZ
REPLACE ALL 实发工资 WITH 基本工资+奖金+津贴-房租-水电费
I=1
DO WHILE I<=5
BM='100'+STR(I,1)
COPY TO AAA FOR SUBSTR(职工号,1,4)=BM
SELECT 3
USE AAA
AVERAGE 实发工资 TO PJ
GO TOP
DO WHILE .NOT.EOF()
IF 实发工资<=PJ
ZZE=实发工资*0.3
REPLACE 实发工资 WITH 实发工资+ZZE
SELECT 1
APPEND BLANK
REPLACE 部门编码 WITH BM,职工号 WITH C->职工号,增资额 WITH ZZE
ENDIF
SELECT 3
SKIP
ENDDO
USE && 本题在这里必须关闭!
SELECT 2
I=I+1
ENDDO
SELECT 1
DISPLAY ALL
CLOSE DATA
SET TALK ON
SET SAFE ON
RETURN
例23: BSH1.DBF(考号C/6，成绩N/3)
SHJ1.DBF(考号C/6，成绩N/3)
有存放计算机等级考试笔试成绩的数据库BSH1.DBF和上机成绩数据库SHJ1.DBF。请先建立数据库TJ1.DBF用于存放统计数据，该库文件有5个字段：类别(C,4)、优秀、良好、及格和不及格，后4个字段均为数值型，宽度2，小数位0。请考生编写程序PROG1.PRG，程序的功能是：分别将笔试成绩和上机成绩按等级
*进行统计：优秀(85以上)、良好(70-84)、及格(60-69)、60分以下为不及格。将相应人数分别存放到tj1.dbf中的类别为"笔试"的"上机"两条记录的相应字段中。
*98FOX9.PRG
SET TALK OFF
SET SAFE OFF
SELECT 1
USE TJ1
ZAP
I=1
DO WHILE I<=2
SELECT 2
DBM=IIF(I=1,'BSH1','SHJ1')
LB=IIF(I=1,'笔试','上机')
USE &DBM
COUNT TO N1 FOR 成绩>=85
COUNT TO N2 FOR 成绩>=70.AND.成绩<=84
COUNT TO N3 FOR 成绩>=60.AND.成绩<=69
COUNT TO N4 FOR 成绩<60
SELECT 1
APPEND BLANK
REPLACE 类别 WITH LB,优秀 WITH N1,良好 WITH N2
REPLACE 及格 WITH N3,不及格 WITH N4
I=I+1
ENDDO
SELECT 1
LIST
CLOSE DATABASE
SET TALK ON
SET SAFE ON
RETURN
例24: GZ.DBF(职工号C/6，姓名C/8，基本工资N/6.2，奖金N/6.2，津贴N/6.2，房租N/6.2，水电费N/6.2，实发工资N/6.2),已有某单位的工资数据库GZ.DBF。其中职工号的前四位是部门编码(1001~1005，共5个部门)。请先建立一个统计数据库TJGZ.DBF，包括四个字段：部门编码(C,4)、最高工资、最低工资、平均工资，均为(N,7.2)。请编写程序PROG1.PRG，程序的功能是按实发工资计算出各部门的最高、最低和平均工 资，存入统计数据库中。
*PROG1.PRG
SET TALK OFF
SET SAFE OFF
SELECT 1
USE TJGZ
ZAP
SELECT 2
USE GZ
REPLACE ALL 实发工资 with 基本工资+奖金+津贴-房租-水电费
I=1
DO WHILE I<=5
MZ='100'+STR(I,1)
COPY TO AAA FOR SUBSTR(职工号,1,4)=MZ
SELECT 3
USE AAA
INDEX ON 实发工资 TO SFGZ
GO TOP
ZD=实发工资
GO BOTTOM
ZG=实发工资
AVERAGE 实发工资 TO PJ
USE && 本题在这里必须关闭!
SELECT 1
APPEND BLANK
REPLACE 部门编码 WITH MZ,最高工资 WITH ZG,最低工资 WITH ZD,平均工资 WITH PJ
SELECT 2
I=I+1
ENDDO
SELECT 1
DISPLAY ALL
CLOSE DATABASE
SET SAFE ON
SET TALK ON
RETURN
例25: 设有如下数据库文件：
*职工（仓库号C（4），职工号C（4），工资N（4））
*订购单:职工号C（4）,供应商号C（4）,订购单号C（4）,订购日期D,总金额N（10）
*供应商:供应商号C（4），供应商名C（16），地址C（10）
*请编写程序PROG1.PRG文件，检索出与工资在1300元以上的职工没有联系的供应商的信息，将结果存放在sup1文件(和供应商文件具有同样的结构)中，并按供应商号升序排序。
*99FOX10.PRG
SET TALK OFF
SET SAFE OFF
SELECT 4
USE SUP1
ZAP
SELECT 1
USE 职工
INDEX ON 职工号 TO ZGH
SELECT 2
USE 订购单
SET RELATION TO 职工号 INTO A
SELECT 3
USE 供应商
INDEX ON 供应商号 TO GYSH
GO TOP
DO WHILE .NOT.EOF()
SCATTER TO SZ
SELECT 2
TF=.T.
LOCATE FOR 供应商号=C->供应商号
DO WHILE FOUND()
IF A->工资>1300
TF=.F.
EXIT
ENDIF
CONTINUE
ENDDO
IF TF
SELECT 4
APPEND BLANK
GATHER FROM SZ
ENDIF
SELECT 3
SKIP
ENDDO
SELECT 4
LIST
CLOSE DATABASE
SET SAFE ON
SET TALK ON
RETURN
例26: 已有库文件djks.dbf，再由考生建立库文件tt.dbf的结构，共有kh（考号）、xm（姓名）、bs（笔试）和sj（上机）共四个字段，字段类型和宽度参照djks.dbf。然后编写程序PROG1.PRG，按笔试上机两项考试成绩总和的降序把成绩最高的十名考生的考号、姓名、笔试及上机四个字段的数据，添加到库文件tt.dbf的相应字段中。
SET TALK OFF
SET SAFE OFF
SELECT 2
USE TT
ZAP
SELECT 1
USE DJKS
INDEX ON 200-(笔试+上机) TO CJ
GO TOP
I=1
DO WHILE I<=10
SELECT 2
APPEND BLANK
REPLACE KH WITH A->考号,XM WITH A->姓名,BS WITH A->笔试,SJ WITH A->上机
SELECT 1
SKIP
I=I+1
ENDDO
SELECT 2
DISPLAY ALL
CLOSE DATA
SET SAFE ON
SET TALK ON
RETURN
例27: djks.dbf（考号C(6)，姓名C(6)，性别C(2)，年龄N(2)，考场C(3)，笔试N(3)，上机N(3)，结论C(6)）
已有库文件djks.dbf。请编写程序PROG1.PRG，在程序中首先通过结构复制生成一个具有考号、姓名、笔试、上机及结论五个字段的数据库文件kkk.dbf，然后把djks.dbf库文件中笔试和上机考试成绩中有一次不及格考生的相应字段数据添加于该数据库中，并把"补考"填入结论字段中。
注意：要求按多工作区操作，以DO WHILE-ENDDO循环结构完成，不得使用APPEND FROM命令。
set talk off
set safe off
select 1
use djks
copy stru to kkk fields 考号,姓名,笔试,上机,结论
select 2
use kkk
select 1
go top
do while .not.eof()
if 笔试<60.and.上机>=60.or.笔试>=60.and.上机<60
select 2
append blank
replace 考号 WITH A->考号,姓名 WITH A->姓名,笔试 WITH A->笔试
REPLACE 上机 WITH A->上机,结论 WITH '补考'
endif
select 1
skip
enddo
select 2
list
close database
set safe on
set talk on
return
例28: 设有如下数据库文件：
仓库（仓库号C（4），城市C（8），面积N（4））
职工（仓库号C（4），职工号C（4），工资N（4））
订购单（职工号C（4），供应商号C（4），订购单号C（4），订购日期D，总金额N（10））
请编写程序PROG1.PRG文件，检索出在北京工作并且向S4供应商发出了订购单的职工信息，并将结果存放在emp1文件（和职工文件具有相同的结构）中。
SET TALK OFF
SET SAFE OFF
SELECT 4
USE EMP1
ZAP
SELECT 1
USE 仓库
index on 仓库号 to ckh
select 2
use 职工
set relation to 仓库号 INTO a
select 3
use 订购单
select 2
locate for A->城市='北京'
do while found()
scatter to sz
select 3
locate for 职工号=B->职工号.and.供应商号='S4'
if found()
select 4
append blank
gather from sz
endif
select 2
continue
enddo
select 4
list
CLOSE DATABASE
SET SAFE ON
SET TALK ON
RETURN
例29: 已有库文件djks.dbf。请编写程序PROG1.PRG，在程序中首先通过结构复制生成一个具有考号、姓名、笔试、上机、结论五个字段的数据库文件kkk.dbf，然后把djks.dbf库文件中笔试和上机考试成绩中均不及格考生的相应字段数据添加于该数据库中，并把“未通过”填入结论字段中。
SET TALK OFF
SET SAFE OFF
SELECT 1
USE DJKS
COPY STRU TO KKK FIELDS 考号,姓名,笔试,上机,结论
SELECT 2
USE KKK
SELECT 1
DO WHILE .NOT.EOF()
IF 笔试<60.AND.上机<60
SELECT 2
APPEND BLANK
REPLACE 考号 WITH A->考号,姓名 WITH A->姓名,笔试 WITH A->笔试,上机 WITH A->上机
REPLACE 结论 WITH "未通过"
SELECT 1
ENDIF
SKIP
ENDDO
SELECT 2
DISPLAY ALL
CLOSE DATABASE
SET TALK ON
SET SAFE ON
RETURN
例30: 设有如下数据库文件：
职工（仓库号C（4），职工号C（4），工资N（4））
订购单（职工号C（4），供应商号C（4），订购单号C（4），订购日期D,*总金额N（10））。首先由考生建立数据库：工资（职工号C（4），工资N（4）），然后编程序PROG1.PRG文件，检索出与供应商S7、S4和S6都有业务联系的职工的职工号和工资，并存放到所建立的工资文件中。
*99FOX6.PR
set talk off
set safe off
select 3
use 工资
zap
select 1
use 订购单
select 2
use 职工
do while .not.eof()
select 1
locate for 职工号=B->职工号.and.供应商号='S7'
IF FOUND()
LOCATE FOR 职工号=B->职工号.and.供应商号='S4'
IF FOUND()
locate for 职工号=B->职工号.and.供应商号='S6'
IF FOUND()
SELECT 3
APPEND BLANK
REPLACE 职工号 WITH B->职工号,工资 WITH B->工资
ENDIF
ENDIF
ENDIF
SELECT 2
SKIP
ENDDO
SELECT 3
LIST
SET SAFE ON
SET TALK ON
RETURN
?
