zhrmyh.prg

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

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


 SET TALK OFF
 SET SAFETY OFF
 SET PROCEDURE TO zhrmyh
 DEFINE WINDOW ZH FROM 10 , 20 TO 16 , 60 COLOR SCHEME 2 SHADOW DOUBLE
 DEFINE WINDOW WRONG FROM 19 , 15 TO 21 , 65 COLOR SCHEME 2 SHADOW DOUBLE
 XSLJ = ''
 XSBM = ''
 XSYK = ''
 XSLX = ''
 XSDQ = ''
 IF  .NOT. FILE('LIB\BZL.DAT')
 MSGTTL = '转换人民银行接口'
 MESSGTXT = '不存在表种类库, 请拷入!!!'
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 RETURN 
 ENDIF 
 IF  .NOT. FILE('LIB\DQK.DAT')
 MSGTTL = '转换人民银行接口'
 MESSGTXT = '不存在表种类库, 请拷入!!!'
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 RETURN 
 ENDIF 
 STORE '  ' TO M_BH
 STORE '0' TO M_BLX1 , M_BLX2
 STORE 0 TO M_DQDH1 , M_DQDH2
 CLNIAN = RIGHT(NIAN,2)
 DO FORM .\src\form\GONG2
 IF M_BH <> '01' AND M_BH <> '02' AND M_BH <> '03'
 CLOSE DATABASES 
 RETURN 
 ENDIF 
 MONTH_A = YUE
 M_BLX1 = '0'
 DO FORM src\form\zhywzh1
 DO CASE 
 CASE M_BLX1 = '1'
 IF MONTH_A = '03' .OR. MONTH_A = '09'
 ANSWER = MESSAGEBOX(MONTH_A - '月份应为季报,是否继续？',292,'错误信息提示')
 IF ANSWER = 6
 ELSE 
 RETURN 
 ENDIF 
 ELSE 
 IF MONTH_A = '12' .OR. MONTH_A = '06'
 ANSWER =  ;
      MESSAGEBOX(MONTH_A - '月份应为年报（半年报）,是否继续？',292,'错误信息提示')
 IF ANSWER = 6
 ELSE 
 RETURN 
 ENDIF 
 ELSE 
 ENDIF 
 ENDIF 
 CASE M_BLX1 = '2'
 IF MONTH_A = '03' .OR. MONTH_A = '09'
 ELSE 
  MESSAGEBOX(MONTH_A - '月份无季报,请检查后重新操作!',160,'错误信息提示')
 RETURN 
 ENDIF 
 CASE M_BLX1 = '3'
 IF MONTH_A = '12'
 ELSE 
  MESSAGEBOX(MONTH_A - '月份无年报,请检查后重新操作!',160,'错误信息提示')
 RETURN 
 ENDIF 
 CASE M_BLX1 = '4'
 IF MONTH_A = '06'
 ELSE 
  MESSAGEBOX(MONTH_A - '月份无半年报,请检查后重新操作!',160,'错误信息提示')
 RETURN 
 ENDIF 
 OTHERWISE 
 M_BLX1 = '1'
 ENDCASE 
 PA = ''
 ACTTC = 0
 DO FORM src\form\actdrv
 IF ACTTC = 0
 PA = LEFT(PA,1)
 ELSE 
 RETURN 
 ENDIF 
 BBMC = ''
 IF M_BH = '01'
 BBMC = '业务状况表'
 DO ZHRMYH01B
 ELSE 
 IF M_BH = '02'
 BBMC = '损益表'
 DO ZHRMYH02B
 ELSE 
 BBMC = '资产负债表'
 DO ZHRMYH03B
 ENDIF 
 ENDIF 
 CLOSE DATABASES 

PROCEDURE zhrmyh01b
 IF FILE('dat\b01rmyh.dat')
 ELSE 
 CREATE TABLE dat\b01rmyh.dat ( DQDH N ( 2 ) , XMDH C ( 6 ) , BLX1 C ( 1 ) , BLX2 C ( 2  ;
      ) , SJDW N ( 1 ) , DA1 N ( 18 , 2 ) , DA2 N ( 18 , 2 ) , DA3 N ( 18 ,  ;
      2 ) , DA4 N ( 18 , 2 ) , DA5 N ( 18 , 2 ) , DA6 N ( 18 , 2 ) )
 USE 
 ENDIF 
 USE IN 88 EXCLUSIVE dat\b01rmyh.dat ALIAS B01RMYH
 FILE01 = 'dat\b' - M_BH - CLNIAN - YUE - '.dat'
 IF FILE(FILE01)
 USE (FILE01)
 SJCZ = .F.
 SCAN FOR BLX1 = M_BLX1
 SJCZ = .T.
 ENDSCAN 
 USE 
 IF SJCZ = .T.
 ELSE 
  MESSAGEBOX(MONTH_A - '月份无表类型为 ' - M_BLX1 - ' 的报表,请检查后重新操作!',160,'错误信息提示')
 RETURN 
 ENDIF 
 ELSE 
  MESSAGEBOX(MONTH_A - '月份无业务状况报,请检查后重新操作!',160,'错误信息提示')
 RETURN 
 ENDIF 
 WAIT WINDOW NOCLEAR NOWAIT '正在转换 ' + BBMC + '表数据,请稍候。。。'
 SELECT B01RMYH
 DELETE ALL
 PACK 
  appe from dat\b&m_bh&clnian&yue..dat for blx1=m_blx1 
 IF FILE('tmp\b01.dat')
 DELETE File ('tmp\b01.dat')
 ELSE 
 ENDIF 
 SORT ON DQDH /a TO tmp\b01.dat
 USE IN 88 tmp\b01.dat
 SELECT 88
 REPLACE BLX2 WITH '01' FOR DQDH <> 0
 REPLACE XMDH WITH 'a02' FOR XMDH = '21 '
 GO TOP
 SCAN FOR XMDH = 'dpbz'
 REPLACE DQDH WITH 0 , XMDH WITH ''
 ENDSCAN 
 D01TEMP = 'tmp\d01.txt'
 IF FILE(D01TEMP)
 DELETE File (D01TEMP)
 ELSE 
 ENDIF 
 COPY TO (D01TEMP) DELIMITED 
 IF YUE = '06' .OR. YUE = '03' .OR. YUE = '09'
  filed01=("&pa.:b01002&yue..txt")	
 ELSE 
  filed01=("&pa.:b0100&m_blx1&yue..txt")	
 ENDIF 
 IF FILE(FILED01)
 DELETE File (FILED01)
 ELSE 
 ENDIF 
 LOCAL GNFILEHANDLE1 , NSIZE , GNFILEHANDLE2
 GNFILEHANDLE1 = FOPEN(D01TEMP)
 NSIZE = FSEEK(GNFILEHANDLE1,1)
 IF NSIZE <= 0
 WAIT WINDOW NOWAIT '这是个空文件!'
 ELSE 
 GNFILEHANDLE2 = FCREATE(FILED01)
 J = 1
 DO WHILE  .NOT. FEOF(GNFILEHANDLE1)
 = FSEEK(GNFILEHANDLE1,J)
 DNSJ = FREAD(GNFILEHANDLE1,1)
 IF DNSJ = '"'
 DNSJ = ''
 ELSE 
 ENDIF 
  FWRITE(GNFILEHANDLE2,DNSJ)
 J = J + 1
 ENDDO 
 ENDIF 
 = FCLOSE(GNFILEHANDLE1)
 = FCLOSE(GNFILEHANDLE2)
 CLOSE ALL
  MESSAGEBOX(MONTH_A - '月份' - BBMC - ' 转换到人民银行已完成!!',96,'完成信息提示')
 WAIT CLEAR
ENDPROC
*------
PROCEDURE zhrmyh02b
 IF FILE('dat\b02rmyh.dat')
 ELSE 
 CREATE TABLE dat\b02rmyh.dat ( DQDH N ( 2 ) , XMDH C ( 6 ) , BLX1 C ( 1 ) , BLX2 C ( 2  ;
      ) , SJDW N ( 1 ) , DA1 N ( 18 , 2 ) , DA2 N ( 18 , 2 ) )
 USE 
 ENDIF 
 USE IN 88 EXCLUSIVE dat\b02rmyh.dat ALIAS B02RMYH
 IF YUE = '06'
 M_BLX1 = '4'
 ELSE 
 ENDIF 
 FILE02 = 'dat\b' - M_BH - CLNIAN - YUE - '.dat'
 IF FILE(FILE02)
 USE (FILE02)
 SJCZ = .F.
 SCAN FOR BLX1 = M_BLX1
 SJCZ = .T.
 ENDSCAN 
 USE 
 IF SJCZ = .T.
 ELSE 
  MESSAGEBOX(MONTH_A - '月份无表类型为 ' - M_BLX1 - ' 的报表,请检查后重新操作!',160,'错误信息提示')
 RETURN 
 ENDIF 
 ELSE 
  MESSAGEBOX(MONTH_A - '月份无业务状况报,请检查后重新操作!',160,'错误信息提示')
 RETURN 
 ENDIF 
 WAIT WINDOW NOCLEAR NOWAIT '正在转换 ' + BBMC + '表数据,请稍候。。。'
 SELECT B02RMYH
 DELETE ALL
 PACK 
  appe from dat\b&m_bh&clnian&yue..dat for blx1=m_blx1 and blx2="1"
 IF FILE('tmp\b02.dat')
 DELETE File ('tmp\b02.dat')
 ELSE 
 ENDIF 
 SORT ON DQDH /a TO tmp\b02.dat
 USE IN 88 tmp\b02.dat
 SELECT 88
 REPLACE BLX2 WITH '01' FOR DQDH <> 0
 SELECT 88
 SCAN FOR  ;
      XMDH <> 'dpbz' AND XMDH <> '02 ' AND XMDH <> '0603 ' AND XMDH <> '07 ' AND  ;
XMDH <> '13 ' AND XMDH <> '17 ' AND XMDH <> '89 ' AND XMDH <> '22 ' AND XMDH <> '3402' AND  ;
XMDH <> '30 ' AND XMDH <> '35 ' AND XMDH <> '39 ' AND XMDH <> '85 ' AND  ;
XMDH <> '78 ' AND XMDH <> '97 ' AND XMDH <> '103 ' AND XMDH <> '104 ' AND  ;
XMDH <> '108 ' AND XMDH <> '110 ' AND XMDH <> '93 '
 DELETE 
 ENDSCAN 
 PACK 
 COUNT TO S
 SCAN FOR XMDH = 'dpbz'
 JLH = RECNO() + 1
 BH = DQDH
 DNSJ1 = 0
 DNSJ2 = 0
 SCAN FOR (XMDH = '02 ' .OR. XMDH = '0603') AND DQDH = BH
 DNSJ1 = DNSJ1 + DA1
 DNSJ2 = DNSJ2 + DA2
 ENDSCAN 
 SCAN FOR XMDH = '02' AND DQDH = BH
 REPLACE DA1 WITH DNSJ1 , DA2 WITH DNSJ2
 ENDSCAN 
 DNSJ1 = 0
 DNSJ2 = 0
 SCAN FOR (XMDH = '22 ' .OR. XMDH = '3402') AND DQDH = BH
 DNSJ1 = DNSJ1 + DA1
 DNSJ2 = DNSJ2 + DA2
 ENDSCAN 
 SCAN FOR XMDH = '22' AND DQDH = BH
 REPLACE DA1 WITH DNSJ1 , DA2 WITH DNSJ2
 ENDSCAN 
 IF JLH < S
 GO JLH
 ELSE 
 ENDIF 
 ENDSCAN 
 REPLACE XMDH WITH '131 ' FOR XMDH = '110 '
 REPLACE XMDH WITH '129 ' FOR XMDH = '108 '
 REPLACE XMDH WITH '123 ' FOR XMDH = '104 '
 REPLACE XMDH WITH '121 ' FOR XMDH = '103 '
 REPLACE XMDH WITH '114 ' FOR XMDH = '97 '
 REPLACE XMDH WITH '108 ' FOR XMDH = '93 '
 REPLACE XMDH WITH '103 ' FOR XMDH = '89 '
 REPLACE XMDH WITH '97 ' FOR XMDH = '85 '
 REPLACE XMDH WITH '89 ' FOR XMDH = '78 '
 REPLACE XMDH WITH '45 ' FOR XMDH = '39 '
 REPLACE XMDH WITH '41 ' FOR XMDH = '35 '
 REPLACE XMDH WITH '34 ' FOR XMDH = '30 '
 REPLACE XMDH WITH '26 ' FOR XMDH = '22 '
 REPLACE XMDH WITH '21 ' FOR XMDH = '17 '
 REPLACE XMDH WITH '17 ' FOR XMDH = '13 '
 REPLACE XMDH WITH '10 ' FOR XMDH = '07 '
 DELETE ALL FOR XMDH = '0603' .OR. XMDH = '3402'
 PACK 
 SCAN FOR XMDH = 'dpbz'
 REPLACE DQDH WITH 0 , XMDH WITH ''
 ENDSCAN 
 GO TOP
 SCAN FOR DQDH <> 0 AND VAL(XMDH) < 100
 XMDH1 = '0' - ALLTRIM(XMDH)
 REPLACE XMDH WITH XMDH1
 ENDSCAN 
 D02TEMP = 'tmp\d02.txt'
 IF FILE(D02TEMP)
 DELETE File (D02TEMP)
 ELSE 
 ENDIF 
 COPY TO (D02TEMP) DELIMITED 
 IF YUE = '06'
  filed02="&pa.:b&m_bh.002&yue..txt"
 ELSE 
  filed02=("&pa.:b&m_bh.00&m_blx1&yue..txt")	
 ENDIF 
 IF FILE(FILED02)
 DELETE File (FILED02)
 ELSE 
 ENDIF 
 LOCAL GNFILEHANDLE1 , NSIZE , GNFILEHANDLE2
 GNFILEHANDLE1 = FOPEN(D02TEMP)
 NSIZE = FSEEK(GNFILEHANDLE1,1)
 IF NSIZE <= 0
 WAIT WINDOW NOWAIT '这是个空文件!'
 ELSE 
 GNFILEHANDLE2 = FCREATE(FILED02)
 J = 1
 DO WHILE  .NOT. FEOF(GNFILEHANDLE1)
 = FSEEK(GNFILEHANDLE1,J)
 DNSJ = FREAD(GNFILEHANDLE1,1)
 IF DNSJ = '"'
 DNSJ = ''
 ELSE 
 ENDIF 
  FWRITE(GNFILEHANDLE2,DNSJ)
 J = J + 1
 ENDDO 
 ENDIF 
 = FCLOSE(GNFILEHANDLE1)
 = FCLOSE(GNFILEHANDLE2)
 CLOSE ALL
  MESSAGEBOX(MONTH_A - '月份' - BBMC - '转换到人民银行已完成!!',96,'完成信息提示')
 WAIT CLEAR
ENDPROC
*------
PROCEDURE zhrmyh03b
 IF FILE('dat\b02rmyh.dat')
 ELSE 
 CREATE TABLE dat\b02rmyh.dat ( DQDH N ( 2 ) , XMDH C ( 6 ) , BLX1 C ( 1 ) , BLX2 C ( 2  ;
      ) , SJDW N ( 1 ) , DA1 N ( 18 , 2 ) , DA2 N ( 18 , 2 ) )
 USE 
 ENDIF 
 USE IN 88 EXCLUSIVE dat\b02rmyh.dat ALIAS B02RMYH
 FILE02 = 'dat\b' - M_BH - CLNIAN - YUE - '.dat'
 IF FILE(FILE02)
 USE (FILE02)
 SJCZ = .F.
 SCAN FOR BLX1 = M_BLX1
 SJCZ = .T.
 ENDSCAN 
 USE 
 IF SJCZ = .T.
 ELSE 
  MESSAGEBOX(MONTH_A - '月份无表类型为 ' - M_BLX1 - ' 的报表,请检查后重新操作!',160,'错误信息提示')
 RETURN 
 ENDIF 
 ELSE 
  MESSAGEBOX(MONTH_A - '月份无业务状况报,请检查后重新操作!',160,'错误信息提示')
 RETURN 
 ENDIF 
 WAIT WINDOW NOCLEAR NOWAIT '正在转换 ' + BBMC + '表数据,请稍候。。。'
 SELECT B02RMYH
 DELETE ALL
 PACK 
  appe from dat\b&m_bh&clnian&yue..dat for blx1=m_blx1
 IF FILE('tmp\b02.dat')
 DELETE File ('tmp\b02.dat')
 ELSE 
 ENDIF 
 SORT ON DQDH /a TO tmp\b02.dat
 USE IN 88 tmp\b02.dat
 SELECT 88
 REPLACE BLX2 WITH '01' FOR DQDH <> 0
 GO TOP
 SCAN FOR XMDH = 'dpbz'
 REPLACE DQDH WITH 0 , XMDH WITH ''
 ENDSCAN 
 GO TOP
 SCAN FOR XMDH = '61' .OR. XMDH = '69' .OR. XMDH = '64'
 DELETE 
 ENDSCAN 
 PACK 
 SCAN FOR XMDH = '60'
 REPLACE XMDH WITH '61'
 ENDSCAN 
 SCAN FOR XMDH = '68'
 REPLACE XMDH WITH '69'
 ENDSCAN 
 SCAN FOR XMDH = '63'
 REPLACE XMDH WITH '64'
 ENDSCAN 
 SCAN FOR XMDH = '62'
 REPLACE XMDH WITH '63'
 ENDSCAN 
 GO TOP
 SCAN FOR DQDH <> 0
 XMDH1 = '0' - ALLTRIM(XMDH)
 REPLACE XMDH WITH XMDH1
 ENDSCAN 
 D02TEMP = 'tmp\d02.txt'
 IF FILE(D02TEMP)
 DELETE File (D02TEMP)
 ELSE 
 ENDIF 
 COPY TO (D02TEMP) DELIMITED 
 IF YUE = '06'
  filed02=("&pa.:b&m_bh.002&yue..txt")
 ELSE 
  filed02=("&pa.:b&m_bh.00&m_blx1&yue..txt")	
 ENDIF 
 IF FILE(FILED02)
 DELETE File (FILED02)
 ELSE 
 ENDIF 
 LOCAL GNFILEHANDLE1 , NSIZE , GNFILEHANDLE2
 GNFILEHANDLE1 = FOPEN(D02TEMP)
 NSIZE = FSEEK(GNFILEHANDLE1,1)
 IF NSIZE <= 0
 WAIT WINDOW NOWAIT '这是个空文件!'
 ELSE 
 GNFILEHANDLE2 = FCREATE(FILED02)
 J = 1
 DO WHILE  .NOT. FEOF(GNFILEHANDLE1)
 = FSEEK(GNFILEHANDLE1,J)
 DNSJ = FREAD(GNFILEHANDLE1,1)
 IF DNSJ = '"'
 DNSJ = ''
 ELSE 
 ENDIF 
  FWRITE(GNFILEHANDLE2,DNSJ)
 J = J + 1
 ENDDO 
 ENDIF 
 = FCLOSE(GNFILEHANDLE1)
 = FCLOSE(GNFILEHANDLE2)
 CLOSE ALL
  MESSAGEBOX(MONTH_A - '月份' - BBMC - '转换到人民银行已完成!!',96,'完成信息提示')
 WAIT CLEAR
ENDPROC
*------*