actzh_wei.prg

使用VFP编写的信用社系统专用会计报表系统,可上报,汇总,打印.是一款优秀的信用社会计报表系统

* -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
*  文件名: ACTZH_WEI.PRG <-- 本文件由 UnFoxAll 创建
* -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-


 IF 1 = 0
 NIAN = '1998'
 YUE = '12'
 ENDIF 
 SET TALK OFF
 SET SAFETY OFF
 DO WHILE .T.
 ACTSZ = 0
 Q_QUIT = .F.
 DO FORM src\form\actzh
 IF Q_QUIT
 RETURN 
 ENDIF 
 IF ACTSZ = 1
 DO src\prg\ACTWH
 ELSE 
 DO ACTZHP
 ENDIF 
 ENDDO 

PROCEDURE ACTZHP
 YEAR_A = INT(VAL(NIAN))
 MONTH_A = INT(VAL(YUE))
 DO FORM src\form\actrq
 CL_YEAR = RIGHT(YEAR_A,2)
 DO FORM src\form\dqxz
 TT = WEI
 N = AT('.',TT)
 M_DQDH = SUBSTR(TT,1,N - 1)
 IF LEN(ALLTRIM(M_DQDH)) = 1
 M_DQDH = '0' + LTRIM(TRIM(M_DQDH))
 ENDIF 
 PA = 'A:'
 DO FORM src\form\actdrv
 PA = LEFT(PA,1)
  IF ! FILE("&pa.:A&cl_YEAR&MONTH_A&M_DQDH..DAT")
  WAIT WINDOW "会计报表数据不存在，请拷入&pa.盘"
 ELSE 
 DO ZHSJ
 ENDIF 
ENDPROC
*------
PROCEDURE ZHSJ
  IF FILE("DAT\B01&cl_YEAR&MONTH_A..DAT") 
  USE DAT\B01&cl_YEAR&MONTH_A..DAT ALIAS B01
 SCAN FOR DQDH = VAL(M_DQDH)
 FOR I = 1 TO 6
 DAI = 'da' + ALLTRIM(STR(I))
  if &dai!=0
 MSGTTL = 'ACT数据转换'
 MESSGTXT = '目的数据已存在! 覆盖吗?'
 IF MESSAGEBOX(MESSGTXT,36,MSGTTL) = 7
 USE 
 RETURN 
 ELSE 
 PDBZ = .T.
 EXIT 
 ENDIF 
 ELSE 
 PDBZ = .F.
 ENDIF 
 ENDFOR 
 IF PDBZ
 EXIT 
 ENDIF 
 ENDSCAN 
 ELSE 
  do wj with "B01&cl_YEAR&MONTH_A","01"
 ENDIF 
 DELETE FROM B01 WHERE DQDH = VAL(M_DQDH)
 PACK 
 CREATE TABLE temp ( LOGST C ( 120 ) )
  append from &pa.:A&cl_YEAR&MONTH_A&M_DQDH..DAT delimited
 SCAN 
 A_YUE = SUBSTR(LOGST,1,2)
 A_NIAN = SUBSTR(LOGST,3,2)
 A_DQDH = VAL(SUBSTR(LOGST,5,2))
 A_BLX1 = '3'
 A_BLX2 = '0'
 A_SJDW = 0
 A_XMDH = SUBSTR(LOGST,7,4)
 A_DA1 = VAL(SUBSTR(LOGST,12,15)) / 100
 A_DA2 = VAL(SUBSTR(LOGST,28,15)) / 100
 A_DA3 = VAL(SUBSTR(LOGST,44,15)) / 100
 A_DA4 = VAL(SUBSTR(LOGST,60,15)) / 100
 A_DA5 = VAL(SUBSTR(LOGST,76,15)) / 100
 A_DA6 = VAL(SUBSTR(LOGST,92,15)) / 100
 INSERT INTO B01 VALUES ( A_DQDH , A_BLX1 , A_BLX2 , A_XMDH , A_SJDW , A_DA1 , A_DA2 ,  ;
      A_DA3 , A_DA4 , A_DA5 , A_DA6 )
 ENDSCAN 
 DELETE FROM B01 WHERE XMDH = '0000' .OR. XMDH = 'XXXX'
 PACK 
 SELECT B01
 USE 
 SELECT TEMP
 USE 
 DELETE File temp.dbf
  MESSAGEBOX('ACT转换完毕',0,'ACT转换')
ENDPROC
*------
PROCEDURE WJ2
 PARAMETER DATNAME , M_BH
 SCWJPD = 1
 IF  .NOT. USED('blk')
 USE IN 0 lib\BLK.dat
 ENDIF 
 SELECT BLK
 COPY TO t001 STRUCTURE EXTENDED 
 SELECT 0
 USE t001
 ZAP 
 SELECT FIELD_NAME , FIELD_TYPE , FIELD_LEN , FIELD_DEC WHERE BH = (M_BH) INTO TABLE tmp  ;
      FROM blk
 SELECT T001
 APPEND FROM tmp
  CREATE dat\&datname FROM t001
 USE 
  RENAME FILE DAT\&DATNAME..DBF TO DAT\&DATNAME..DAT
 SELECT BLK
 USE 
 SELECT TMP
 USE 
 RETURN 
ENDPROC
*------*