English
KM.PRG
资源名称：jq_caiwu.ARJ [点击查看]
上传用户：hbmaozhan
上传日期：2013-01-31
资源大小：1007k
文件大小：8k
源码类别：
企业管理
开发平台：
VFP
- 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)
- pd = SUBSTR(xx, 1, 3)
- LOCA ALL FOR pd$kmdm .AND. SUBSTR(kmdm, 1, 3)=pd
- pd = slbz
- x = jhd
- GOTO BOTTOM
- REPL slbz WITH pd
- REPL jhd WITH x
- SELE 1
- REPL slbz WITH pd
- REPL kmdm WITH xx
- REPL jhd WITH x
- SELE 2
- ENDI
- DO WHILE .T.
- mc = ' '
- SET COLOR TO RB+/B
- @ 0, 0 CLEAR TO 3, 28
- @ 1, 1 SAY '请输入新增的科目名称:'
- @ 2, 1 SAY ' ' GET mc
- READ
- pd = ' '
- @ 3, 1 SAY '确认了吗? Y=是,其他=否!' GET pd
- READ
- DO qp
- IF pd='Y' .OR. pd='y'
- EXIT
- ENDI
- ENDD
- REPL kmmc WITH mc
- IF 7>=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 cwkmk%.dbf
- USE
- ERAS cwkmk.dbf
- RENA cwkmk%.dbf TO cwkmk.dbf
- USE cwkmk
- SELE 1
- DO qp
- EXIT
- ENDD
- ENDI
- ENDI
- IF a1<>0
- EXIT
- ENDI
- ENDD
- RETU
- *
