phfsj.prg

来自「一个非常好用的财务软件源程序」· PRG 代码 · 共 175 行

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


 BQD = .T.
 BZDRJ = ''
 CLOSE DATABASES ALL
 DO FORM hfsj
 IF  .NOT. BQD
    RETURN 
 ENDIF 
 SET COMPATIBLE ON
 BERR = .F.
 ON ERROR do pjc1
 IF EMPTY(BZDRJ)
    IF MESSAGEBOX('恢复时要确保没有其它操作员使用,插入第一张数据盘后继续',65,'提示信息') <>  ;
   1
       RETURN 
    ENDIF 
    I = 1
    DO WHILE I = 1
       IF  .NOT. FILE('a:\zwsj.arj') .OR.  .NOT. FILE('a:\kcount.dbf')
          IF MESSAGEBOX('A:驱动器没有第一张数据盘,是否插入盘后重试',33,'提示信息') <> 1
             = MESSAGEBOX('恢复未完成',64,'提示信息')
             RETURN 
          ENDIF 
       ELSE 
          I = 0
       ENDIF 
    ENDDO 
    BNAME = CURDIR() + '\zwsj.arj'
    DO WHILE .T.
        copy file a:\zwsj.arj to &bname
       USE a:\kcount
       BCOUNT = FCOUNT
       IF TYPE('fname') = 'U'
          BSY = .T.
       ELSE 
          BSY = IIF(EMPTY(FNAME),.T.,.F.)
          BZTH = ALLTRIM(SUBSTR(FNAME,3,15))
       ENDIF 
       USE 
       IF BERR
          IF MESSAGEBOX('是否换盘重试',33,'提示信息') <> 1
             = MESSAGEBOX('数据恢复未完成!',64,'提示信息')
             RETURN 
          ENDIF 
          LOOP 
       ENDIF 
       EXIT 
    ENDDO 
    FOR P = 2 TO BCOUNT
       IF MESSAGEBOX('请插入第' + ALLTRIM(STR(P,2)) + '张盘',64,'提示信息') <> 1
          = MESSAGEBOX('恢复未完成',64,'提示信息')
          RETURN 
       ENDIF 
       KK = ALLTRIM(STR(P - 1,2))
       KK = IIF(LEN(KK) = 1,'0' + KK,KK)
       BNAME0 = 'a:\zwsj.a' + KK
       BNAME1 = CURDIR() + 'zwsj.a' + KK
       DO WHILE .T.
          BERR = .F.
          DO WHILE  .NOT. FILE(BNAME0)
             IF MESSAGEBOX('第' + ALLTRIM(STR(P,2)) + '张盘不存在,是否换盘后重试',33,'提示信息') <>  ;
            1
                = MESSAGEBOX('恢复未完成',64,'提示信息')
                RETURN 
             ENDIF 
          ENDDO 
           copy file &bname0 to &bname1
          IF BERR
             IF MESSAGEBOX('是否换盘重试',33,'提示信息') <> 1
                = MESSAGEBOX('数据恢复未完成!',64,'提示信息')
                RETURN 
             ENDIF 
             LOOP 
          ENDIF 
          EXIT 
       ENDDO 
    ENDFOR 
 ELSE 
    IF MESSAGEBOX('恢复时要确保没有其它操作员使用,是否继续',65,'提示信息') <> 1
       RETURN 
    ENDIF 
    BBB = BZDRJ + 'kcount'
     use &bbb
    BCOUNT = FCOUNT
    IF TYPE('fname') = 'U'
       BSY = .T.
    ELSE 
       BSY = IIF(EMPTY(FNAME),.T.,.F.)
       BZTH = ALLTRIM(SUBSTR(FNAME,3,15))
    ENDIF 
    USE 
    BNAME = BZDRJ + '\zwsj.arj'
 ENDIF 
 BNAME0 = IIF(EMPTY(BZDRJ),CURDIR() + 'zwsj.a*',BZDRJ + 'zwsj.a*')
 BNAME1 = SUBSTR(BSJWZ,1,3)
 DDD = FDATE(BNAME)
 IF MESSAGEBOX('该数据为' + DTOC(DDD) + '备份,是否使用该数据恢复?',65,'提示信息') <> 1
    = MESSAGEBOX('数据恢复未完成!',64,'提示信息')
    RETURN 
 ENDIF 
 DO PTSXX
 MOVE WINDOW WTSXX TO 1 , 85
 IF BSY
    IF MESSAGEBOX('请仔细检查备份盘数据是否确实为本机多帐套数据，使用本功能后本机所有帐套数据将被覆盖？',33,'提示信息') <>  ;
   1
       RETURN 
    ENDIF 
    IF MESSAGEBOX('请再次确认，覆盖后数据将不可恢复？',33,'提示信息') <> 1
       RETURN 
    ENDIF 
    _COMMAND = 'arj x ' + BNAME0 + ' ' + BNAME1 + ' -y'
    _FILE = FCREATE('comper.bat')
    = FPUTS(_FILE,_COMMAND)
    = FPUTS(_FILE,'echo 12345 > id.txt')
    = FCLOSE(_FILE)
    RUN /n2 comper.pif
    DO WHILE  .NOT. FILE('id.txt')
    ENDDO 
    DELETE File id.txt
 ELSE 
    _COMMAND = 'arj x ' + BNAME0 + ' -y'
    _FILE = FCREATE('comper.bat')
    = FPUTS(_FILE,_COMMAND)
    = FPUTS(_FILE,'echo 12345 > id.txt')
    = FCLOSE(_FILE)
    DELETE File id.txt
    RUN /n2 comper.pif
    DO WHILE  .NOT. FILE('id.txt')
    ENDDO 
    DELETE File id.txt
    BFILE = CURDIR() + BZTH + '\kuser'
    SELECT 0
     use &bfile
    BCOMPANY1 = ALLTRIM(FNAME)
    USE 
    IF BCOMPANY <> BCOMPANY1
       IF MESSAGEBOX("备份盘中不是'" + BCOMPANY + "'数据,是否继续进行数据恢复操作？",33,'提示信息') <>  ;
      1
          RETURN 
       ENDIF 
       IF MESSAGEBOX("请再次确认，原有'" + BCOMPANY + "'帐套将被'" + BCOMPANY1 + "'帐套覆盖！",33,'提示信息') <>  ;
      1
          RETURN 
       ENDIF 
    ENDIF 
    _COMMAND = 'arj e ' + BNAME0 + ' ' + BSJWZ1 + ' -y'
    _FILE = FCREATE('comper.bat')
    = FPUTS(_FILE,_COMMAND)
    = FPUTS(_FILE,'echo 12345 > id.txt')
    = FCLOSE(_FILE)
    RUN /n2 comper.pif
    DO WHILE  .NOT. FILE('id.txt')
    ENDDO 
    DELETE File id.txt
 ENDIF 
 RELEASE WINDOW WTSXX
 = MESSAGEBOX('数据恢复完成',64,'提示信息')
 RETURN 

PROCEDURE pjc1
 IF  .NOT. BERR
    DO CASE 
    CASE ERROR() = 1002 .OR. ERROR() = 202 .OR. ERROR() = 108
       = MESSAGEBOX('A盘没有软盘或软盘损坏',64,'提示信息')
    ENDCASE 
 ENDIF 
 BERR = .T.
 RETURN 
ENDPROC
*------*