Liren Large Software Subsidy 6/06.iso/b/b007/2.ddi/AMISG/DBFLHZ.PRG

Text File | 1990-09-04 | 3.8 KB | 250 lines

****** DBFLHZ.PRG ******
****** DO DBFLHZ  ******
****** PARA FN  ******
IF TYPE('FN')='U'
@ 0,0 SAY '╤í╘±╥¬╖╓└α╗π╫▄╡─╬─╝■......'
FN=''
FNO=''
CFN=''
DO SELEF
IF LEN(FN)=0
RETU
ENDIF
ENDIF
EXP1='.T.'
EXP='.T.'
@ 0,0 SAY '╔·│╔╜°╨╨╖╓└α╗π╫▄╡─╝╟┬╝╙ª┬·╫π╡─╠⌡╝■......'
A=INKEY(5)
DO DBFEXP
FD=''
CFD=''
FDN=''
@ 0,0
@ 0,0 SAY '╤í╘±╖╓└α╣╪╝ⁿ╫╓╢╬ . . . '
DO SELEFD
*/╗π╫▄╫╓╢╬╬≈╬─├√▒φ/*
FL=''
*/╗π╫▄╫╓╢╬║║╫╓├√▒φ/*
FL1=''
*/╗π╫▄╫╓╢╬╕÷╩²/*
FLN=0
*/╗π╫▄╫╓╢╬╨≥║┼▒φ/*
LM0=''
DO DBFL WITH FN,FL,FL1,FLN,LM0
IF LEN(FL)=0
RETU
ENDIF
K=1
FL3=''
FL2=''
DO WHILE K<=FLN
IF K<10
I=STR(K,1)
ELSE
I=STR(K,2)
ENDIF
FL3=FL3+'PJ&I'+','
FL2=FL2+"ZH&I"+","
K=K+1
ENDDO
FL2=SUBSTR(FL2,1,LEN(FL2)-1)
FL3=SUBSTR(FL3,1,LEN(FL3)-1)
USE &FN
SUM &FL TO &FL2 FOR &EXP
AVER &FL TO &FL3 FOR &EXP
COUN TO NUM FOR &EXP
INDE ON &FD TO A_B_C
TOTAL ON &FD FIELDS &FL TO A_B_C FOR &EXP
USE A_B_C
INDE ON &FD TO A_B_C
USE
IF FILE('A_B_C.1')
ERAS A_B_C.1
ENDIF
RENA &FN..DBF TO A_B_C.1
RENA A_B_C.DBF TO &FN..DBF
CLEAR
N=6
DO WHILE .T.
? "┬·╫π╠⌡╝■:&EXP1 ╡─╝╟┬╝╩²╬¬"+STR(NUM,4)
CF=FL1+'  '
LN=FLN
M=1
DO WHILE .T.
L1='⌐░⌐ñ⌐ñ⌐ñ'
L2='⌐ª═│╝╞└╕'
L3='⌐└⌐ñ⌐ñ⌐ñ'
L4='⌐ª ╫▄║═ '
L6='⌐ª ╞╜╛∙ '
L5='⌐╕⌐ñ⌐ñ⌐ñ'
IF LN<N
N1=LN
ELSE
N1=N
ENDIF
LN=LN-N
J=1
DO WHILE J<=N1
IF M<10
I=STR(M,1)
ELSE
I=STR(M,2)
ENDIF
CC=SUBSTR(CF,1,14)
N2=LEN(TRIM(CC))
K=0
NN=ZH&I
DO WHILE NN>1
NN=NN/10
K=K+1
ENDDO
IF N2<=8
N2=8
ENDIF
N3=0
IF N2<K+3
N3=K+3-N2
ENDIF
IF N2/2<>INT(N2/2)
N2=N2+1
ENDIF
N3=0
IF N2<K+3
N3=K+3-N2
ENDIF
IF N3/2#INT(N3/2)
N3=N3+1
ENDIF
L1=L1+SUBS('⌐╨⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ',1,N2+N3+2)
L2=L2+'⌐ª'+SPACE(N3)+SUBSTR(CF,1,N2)
L3=L3+SUBS('⌐α⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ',1,N2+N3+2)
L4=L4+'⌐ª'+STR(ZH&I,N2+N3,2)
L5=L5+SUBS('⌐╪⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ',1,N2+N3+2)
L6=L6+'⌐ª'+STR(PJ&I,N2+N3,2)
IF LEN(CF)=11
CF=''
ELSE
CF=SUBSTR(CF,16)
ENDIF
M=M+1
J=J+1
ENDDO
? L1+'⌐┤'
? L2+'⌐ª'
? L3+'⌐╚'
? L4+'⌐ª'
? L3+'⌐╚'
? L6+'⌐ª'
? L5+'⌐╝'
IF LN<=0
EXIT
ENDIF
ENDDO
? ' '
SET CONS ON
SET PRINT OFF
@ 0,2 PROM '0-═╦│÷.'
@ 0,COL()+2 PROM '1-┤≥╙í.'
@ 0,COL()+2 PROM '2-╧╘╩╛.'
MENU TO Y
IF Y=1
EXIT
ENDIF
IF Y=3
CLEAR
? CFD,FL1
SELE 1
USE &FN
? FD,FL
DISP &FD,'  ',&FL OFF ALL
SELE 0
LOOP
ENDIF
USE IDX INDE IDX
SEEK FNO
NDX=''
IF .NOT.EOF()
NDX=TRIM(IDX_NAME)
IF FILE('A_B_C.2')
ERAS A_B_C.2
ENDIF
RENA &NDX..IDX TO A_B_C.2
RENA A_B_C.IDX TO &NDX..IDX
ENDIF
USE
SAVE TO 0_S
DO DBPRINT WITH FN,'.T.',1,CFN+'░┤'+CFD+'╗π╫▄▒φ',FDN+','+LM0,20,1
REST FROM 0_S
IF LEN(NDX)<>0
RENA &NDX..IDX TO A_B_C.IDX
RENA A_B_C.2 TO &NDX..IDX
ENDIF
SET PRINT ON
N=16
ENDDO
SET PRINT OFF
CLOSE DATA
I=0
FNA=SUBS(FN,1,6)+'HZ'
DO WHILE .T.
IF .NOT.(FILE('&FNA..DBF').AND.I<25)
EXIT
ENDIF
I=I+1
FNA=SUBS(FN,1,6)+'H'+CHR(64+I)
ENDDO
IF I>=25.AND.FILE('&FNA..DBF')
FNA=SYS(3)
ENDIF
CFNA=CFN+'░┤'+CFD+'╗π╫▄'
CFNA=CFNA+SPACE(30-LEN(CFNA))
@ 3,10,6,60 BOX '+-+|+-+|'
SELE 1
USE FILE INDE FILE
DO WHILE .T.
FNA=FNA+SPACE(8-LEN(FNA))
@ 3,10 CLEAR TO 6,60
@ 3,10 TO 6,60 DOUB
@ 4,12 SAY '╗π╫▄╬─╝■├√╬¬:' GET FNA
@ 5,12 SAY '    ║║╙∩├√╬¬:' GET CFNA
READ
FNA=TRIM(FNA)
SEEK FNA
IF EOF()
EXIT
ENDIF
@ 7,12 SAY ' **╬─╝■├√&FNA..DBF╥╤╩╣╙├!!!╟δ╓╪╨┬╩Σ╚δ . . . '
ENDDO
SELE 1
USE FILE INDE FILE
SEEK FN
SCAT TO HZ11
SET INDE TO
GO TOP
LOCA FOR VAL(F_NO)<>RECNO()
HZNO=SUBS(STR(RECNO()+1000,4),2)
INSE BEFO BLAN
GATH FROM HZ11
REPL F_NO WITH HZNO,C_FNAME WITH CFNA,F_NAME WITH FNA,F_DEC WITH CFN+'░┤&CFD.╗π╫▄',IDX_NUM WITH 0,F_FMT WITH FNA
SET INDE TO FILE
REIN
USE
USE DBD INDE DBD
COPY TO HZ_1_1 FOR F_NO=FNO
SELE 2
USE HZ_1_1
REPL ALL F_NO WITH HZNO
USE
SELE 1
APPE FROM HZ_1_1
USE
ERAS HZ_1_1.DBF
RENA  &FN..DBF TO &FNA..DBF
RENA A_B_C.1 TO &FN..DBF
IF FILE('A_B_C.IDX')
ERAS A_B_C.IDX
ENDIF
RETU
** END OF DBFLHZ.PRG **