www.pudn.com > jq_caiwu.ARJ > KM.PRG
DO WHILE .T.
pd1 = kmdm
SET COLOR TO RB+/B
@ 0, 0 CLEAR TO 3, 28
@ 1, 1 SAY '请输入科目号码:' GET pd1 PICTURE '999999999'
READ
DO qp
pd = TRIM(pd1)
pd = LTRIM(pd)
IF LEN(pd)<>7 .AND. LEN(pd)<>9 .AND. LEN(pd)<>3
? CHR(7)
SET COLOR TO BG+/RB
@ 0, 0 CLEAR TO 3, 28
@ 1, 5 SAY '请输入明细科目号码!'
pd = INKEY(0)
DO qp
LOOP
ENDI
SELE 2
s = 0
pd1 = SUBSTR(pd, 1, 3)
LOCA ALL FOR pd$kmdm .AND. LEN(LTRIM(TRIM(pd)))=LEN(LTRIM(TRIM(kmdm)))
IF .NOT. EOF()
DO WHILE .T.
pd2 = kmdm
pd2 = LTRIM(TRIM(pd2))
x = LEN(pd2)
pd3 = '0000'
SKIP
IF .NOT. EOF()
pd3 = kmdm
ENDI
SKIP -1
pd3 = LTRIM(TRIM(pd3))
pd4 = SUBSTR(pd3, 1, x)
s = RECNO()
IF pd2=pd4 .AND. LEN(pd3)<>LEN(pd2)
@ 23, 40 SAY ' '
@ 23, 40 SAY pd
DO zzkm-1
SET COLOR TO
@ 23, 40 SAY pd
DO qp
@ 23, 30 SAY ' '
IF x=27
EXIT
ENDI
ELSE
EXIT
ENDI
ENDD
IF x=27
LOOP
ENDI
mc = kmmc
x = jhd
pd1 = LTRIM(TRIM(kmdm))
pd1 = SUBSTR(pd1, 1, 3)
SELE 1
REPL mxkm WITH mc
REPL kmdm WITH pd
REPL jhd WITH x
SELE 2
LOCA ALL FOR pd1$kmdm .AND. LEN(LTRIM(TRIM(pd1)))=LEN(LTRIM(TRIM(kmdm)))
mc = kmmc
SELE 1
REPL zzkm WITH mc
SELE 2
pd = slbz
IF pd='2'
SELE 1
REPL slbz WITH '2'
ENDI
EXIT
ELSE
SET COLOR TO BG+/RB
@ 0, 0 CLEAR TO 3, 28
@ 1, 3 SAY '无此科目. 按InSert=增加,'
@ 2, 3 SAY ' 其他=重输?'
pd = INKEY(0)
DO qp
IF pd<>22
LOOP
ELSE
DO WHILE .T.
pd = ' '
SET COLOR TO RB+/B
@ 0, 0 CLEAR TO 3, 28
@ 1, 0 SAY '请输入新的科目码:' GET pd PICTURE '999999999'
READ
DO qp
pd = TRIM(pd)
pd = LTRIM(pd)
xx = pd
IF 7<>LEN(pd) .AND. 9<>LEN(pd)
SET COLOR TO BG+/RB
?? CHR(7)
@ 0, 0 CLEAR TO 3, 28
@ 1, 1 SAY ' 编号不正确,应是7或9个数字'
@ 2, 5 SAY ' 按任意键继续......'
i = INKEY(0)
DO qp
LOOP
ENDI
SELE 2
IF LEN(pd)>3
pd1 = SUBSTR(pd, 1, 3)
LOCA ALL FOR pd1$kmdm .AND. LEN(LTRIM(TRIM(pd1)))=LEN(LTRIM(TRIM(kmdm)))
IF EOF()
?? CHR(7)
SET COLOR TO RB+/B
@ 0, 0 CLEAR TO 3, 28
@ 1, 7 SAY '没有上级科目!'
@ 2, 5 SAY '按任意键继续......'
i = INKEY(0)
LOOP
ENDI
IF LEN(pd)>7
pd1 = SUBSTR(pd, 1, 7)
LOCA ALL FOR pd1$kmdm .AND. LEN(LTRIM(TRIM(pd1)))=LEN(LTRIM(TRIM(kmdm)))
IF EOF()
?? CHR(7)
SET COLOR TO RB+/B
@ 0, 0 CLEAR TO 3, 28
@ 1, 7 SAY '没有上级科目!'
@ 2, 5 SAY '按任意键继续......'
i = INKEY(0)
LOOP
ENDI
ENDI
ENDI
LOCA ALL FOR pd$kmdm
a1 = 1
IF .NOT. EOF()
pd = 'F'
SET COLOR TO RB+/B
@ 0, 0 CLEAR TO 3, 28
@ 1, 5 SAY '此码科目库原已建立,'
@ 2, 5 SAY '是否输入新的号码?'
@ 3, 5 SAY ' Y=是,其他=否?' GET pd
READ
DO qp
IF pd='Y' .OR. pd='y'
LOOP
ELSE
a1 = 0
EXIT
ENDI
ENDI
APPE BLANK
GOTO BOTTOM
REPL kmdm WITH xx
REPL rq WITH rq1
IF 3=LEN(xx)
SELE 1
REPL mxkm WITH mc
pd = SUBSTR(xx, 1, 3)
SELE 2
LOCA ALL FOR pd$kmdm .AND. SUBSTR(kmdm, 1, 3)=pd
pd = kmmc
SELE 1
REPL zzkm WITH pd
ENDI
IF 3=LEN(xx)
DO km-2
SET COLOR TO RB+/B
@ 0, 0 CLEAR TO 3, 28
@ 1, 0 SAY '新增科目帐户是否数量金额式的?'
pd = ' '
@ 2, 3 SAY ' Y=是,其他=否?' GET pd
READ
DO qp
IF pd='Y' .OR. pd='y'
SELE 2
SKIP -1
REPL slbz WITH '2'
SKIP 1
REPL slbz WITH '2'
SELE 1
REPL slbz WITH '2'
ENDI
ENDI
SET COLOR TO BG+/B
@ 0, 0 CLEAR TO 3, 28
@ 1, 6 SAY '正在进行数据整理,'
@ 2, 6 SAY '请稍候 ... ... '
SELE 2
SORT ON kmdm TO \cw\kmk%.dbf
USE
ERAS \cw\kmk.dbf
RENA \cw\kmk%.dbf TO \cw\kmk.dbf
USE \cw\kmk
SELE 1
DO qp
EXIT
ENDD
ENDI
ENDI
IF a1<>0
EXIT
ENDI
ENDD
RETU
*