pbfsj.prg

一个非常好用的财务软件源程序

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


 BSY = .F.
 BQD = .T.
 BZDRJ = ''
 DO FORM sjbf
 IF  .NOT. BQD
    RETURN 
 ENDIF 
 CLOSE DATABASES ALL
 ON ERROR do pjc
 BERR = .F.
 IF MESSAGEBOX('数据备份时要确保没有其它操作员使用,按确定后继续',65,'提示信息') <> 1
    RETURN 
 ENDIF 
 IF  .NOT. EMPTY(BZDRJ)
    ERASE BZDRJ + 'zwsj.arj'
 ENDIF 
 ERASE zwsj.arj
 FOR I = 1 TO 99
    BNAME = IIF(I > 9,'zwsj.a' + STR(I,2),'zwsj.a0' + STR(I,1))
     erase &bname
 ENDFOR 
 _COMMAND =  ;
      'arj a ' + IIF(EMPTY(BZDRJ),'zwsj.arj ',BZDRJ + 'zwsj.arj ') +  ;
IIF(BSY,BSJWZ,BSJWZ1) + '\.' + IIF(EMPTY(BZDRJ),' -r -v1200 -y',' -r -y')
 J = 1
 _FILE = FCREATE('comper.bat')
 = FPUTS(_FILE,_COMMAND)
 = FPUTS(_FILE,'echo 12345 > id.txt')
 = FCLOSE(_FILE)
 DO PTSXX
 MOVE WINDOW WTSXX TO 1 , 85
 DELETE File id.txt
 RUN /n2 comper.pif
 DO WHILE  .NOT. FILE('id.txt')
 ENDDO 
 DELETE File id.txt
 RELEASE WINDOW WTSXX
 IF BERR
    = MESSAGEBOX('备份不成功！',64,'提示信息')
    RETURN 
 ENDIF 
 IF EMPTY(BZDRJ)
    K = 2
    DIMENSION BNAME( 99 )
    BNAME( 1 ) = 'zwsj.arj'
    BNAME( 2 ) = 'zwsj.a01'
    DO WHILE FILE(BNAME(K))
       K = K + 1
       BNAME( K ) = IIF(K - 1 > 9,'zwsj.a' + STR(K - 1,2),'zwsj.a0' + STR(K - 1,1))
    ENDDO 
    SET COMPATIBLE ON
    BCXPATH = SYS(5) + CURDIR()
    FOR P = 1 TO K - 1
       BMC0 = ALLTRIM(BNAME(P))
       BMC1 = 'a:\' + BMC0
       IF MESSAGEBOX('请打开软盘写保护插入第' + ALLTRIM(STR(P,2)) + '张软盘到A:驱动器,按确定后继续',65,'提示信息') <>  ;
      1
          = MESSAGEBOX('数据备份未完成!',64,'提示信息')
          RETURN 
       ENDIF 
       DO WHILE .T.
          BERR = .F.
          SET DEFAULT TO a:
           erase &bmc1
          AA = DISKSPACE()
           set defa to &bcxpath
          IF BERR
             IF MESSAGEBOX('是否换盘重试',33,'提示信息') <> 1
                = MESSAGEBOX('数据备份未完成!',64,'提示信息')
                RETURN 
             ENDIF 
             LOOP 
          ENDIF 
          IF AA > FSIZE(BMC0) + 340
              copy file &bmc0 to &bmc1
             IF P = 1
                CREATE TABLE kcount ( FCOUNT N ( 2 ) , FNAME C ( 15 ) )
                INSERT INTO kcount ( FCOUNT , FNAME ) VALUES ( K - 1 , IIF(BSY,'',BSJWZ1) )
                USE 
                COPY File kcount.dbf TO a:\kcount.dbf
             ENDIF 
             IF BERR
                IF MESSAGEBOX('是否换盘重试',33,'提示信息') <> 1
                   = MESSAGEBOX('数据备份未完成!',64,'提示信息')
                   RETURN 
                ENDIF 
                LOOP 
             ENDIF 
             EXIT 
          ELSE 
             IF MESSAGEBOX('该软盘剩余空间不够,是否换空白盘重试',33,'提示信息') <> 1
                = MESSAGEBOX('数据备份未完成!',64,'提示信息')
                RETURN 
             ENDIF 
          ENDIF 
       ENDDO 
    ENDFOR 
 ELSE 
    CREATE TABLE kcount ( FCOUNT N ( 2 ) , FNAME C ( 15 ) )
    INSERT INTO kcount ( FCOUNT , FNAME ) VALUES ( 1 , IIF(BSY,'',BSJWZ1) )
    USE 
    BBB = BZDRJ + 'kcount.dbf'
     copy file kcount.dbf to &bbb
 ENDIF 
 = MESSAGEBOX('数据备份完毕，请妥善保存好您的数据备份盘！',64,'提示信息')
 SET COMPATIBLE OFF
 RETURN 

PROCEDURE pjc
 IF  .NOT. BERR
    DO CASE 
    CASE ERROR() = 1002 .OR. ERROR() = 202 .OR. ERROR() = 108
       = MESSAGEBOX('A盘没有软盘、软盘损坏或写保护未打开!',64,'提示信息')
    ENDCASE 
 ENDIF 
 BERR = .T.
 RETURN 
ENDPROC
*------*