utilite.prg

非常不错的仓库管理源代码

ENDPROC
*------
PROCEDURE Sumrecord
 IF FILE(PUB005 + 'data_bak.dbf')
 IF USED('data_bak')
    SELECT DATA_BAK
 ELSE 
    SELECT 0
    USE SHARED PUB005 + 'data_bak'
 ENDIF 
 M_CCC = RECCOUNT()
 USE 
 ELSE 
 M_CCC = 0
 ENDIF 
 IF USED('data5')
 SELECT DATA5
 ELSE 
 SELECT 0
 USE SHARED PUB005 + 'data5'
 ENDIF 
 M_CCC = M_CCC + RECCOUNT()
 USE 
 RETURN M_CCC
ENDPROC
*------
PROCEDURE loadin
 PARAMETER PASS_M1 , PASS_M2 , PASS_M3
 ON ERROR titlew0="01"
 TITLEW0 = UPPER(TITLEW0)
 PASS_M4 = SELECT()
 MY_AREA = .F.
 IF USED('data15')
 SELECT DATA15
 STORE FILTER('data15') TO GCOLDFILTER
 SET FILTER TO RIGHT
 MY_AREA = .T.
 ELSE 
 SELECT 0
 IF FILE(PUB005 + 'data15.dbf')
    USE SHARED PUB005 + 'data15'
 ELSE 
    ON ERROR do _error0 with message()
    RETURN 
 ENDIF 
 ENDIF 
 ON ERROR do _error0 with message()
 IF PASS_M2 > 0
 LOCATE FOR VAL(LEFT(MODEL1,2)) = PASS_M1 AND VAL(LEFT(MODEL2,2)) = PASS_M2 AND RIGHT
 IF FOUND()
    M.MODEL1 = SUBSTR(MODEL1,4,12)
    M.MODEL2 = SUBSTR(MODEL2,4,15)
    APPEND BLANK
    REPLACE MACHINE WITH TITLEW0 , USER WITH PUB001 , MODEL1 WITH M.MODEL1 , MODEL2 WITH  ;
         M.MODEL2 , INDATE WITH DATE() , INTIME WITH TIME() , CHKMEMO WITH  ;
         PASS_M3
    IF  .NOT. MY_AREA
       USE 
       SELECT (PASS_M4)
    ELSE 
        SET FILTER TO &gcOldFilter    
    ENDIF 
    RETURN 
 ENDIF 
 ENDIF 
 LOCATE FOR VAL(LEFT(MODEL1,2)) = PASS_M1 AND RIGHT
 IF FOUND()
 M.MODEL1 = SUBSTR(MODEL1,4,12)
 APPEND BLANK
 REPLACE MACHINE WITH TITLEW0 , USER WITH PUB001 , MODEL1 WITH M.MODEL1 , MODEL2 WITH  ;
      '???????' , INDATE WITH DATE() , INTIME WITH TIME() , CHKMEMO WITH  ;
      PASS_M3
 ELSE 
 APPEND BLANK
 REPLACE MACHINE WITH TITLEW0 , USER WITH PUB001 , MODEL1 WITH '???????' , MODEL2 WITH  ;
      '???????' , INDATE WITH DATE() , INTIME WITH TIME() , CHKMEMO WITH  ;
      '系统主模块未找到!'
 ENDIF 
 IF  .NOT. MY_AREA
 USE 
 SELECT (PASS_M4)
 ELSE 
  SET FILTER TO &gcOldFilter    
 ENDIF 
ENDPROC
*------
PROCEDURE loadChg
 PARAMETER PASS_M1 , PASS_M2 , PASS_M3
 IF  .NOT. FILE(PUB005 + 'data15.dbf')
 RETURN 
 ENDIF 
 PASS_M4 = SELECT()
 IF USED('data15')
 SELECT DATA15
 ELSE 
 SELECT 0
 IF FILE(PUB005 + 'data15.dbf')
    USE SHARED PUB005 + 'data15'
 ELSE 
    RETURN 
 ENDIF 
 ENDIF 
 IF PASS_M2 = 0
 LOCATE FOR VAL(LEFT(MODEL1,2)) = PASS_M1 AND RIGHT
 M.MODEL1 = SUBSTR(MODEL1,4,12)
 M.MODEL2 = ''
 LOCATE FOR EMPTY(OUTIME) AND  .NOT. RIGHT AND USER = PUB001 AND MODEL1 = M.MODEL1
 ELSE 
 LOCATE FOR VAL(LEFT(MODEL1,2)) = PASS_M1 AND VAL(LEFT(MODEL2,2)) = PASS_M2 AND RIGHT
 M.MODEL1 = SUBSTR(MODEL1,4,12)
 M.MODEL2 = SUBSTR(MODEL2,4,12)
 LOCATE FOR  ;
      EMPTY(OUTIME) AND  .NOT. RIGHT AND USER = PUB001 AND MODEL1 = M.MODEL1 AND  ;
MODEL2 = M.MODEL2
 ENDIF 
 IF FOUND()
 IF RLOCK()
    IF  .NOT. EMPTY(PASS_M3)
       REPLACE CHKMEMO WITH ALLTRIM(CHKMEMO) + PASS_M3
    ENDIF 
 ENDIF 
 ENDIF 
 USE 
 SELECT (PASS_M4)
ENDPROC
*------
PROCEDURE loadquit
 PARAMETER PASS_M1 , PASS_M2 , PASS_M3
 ON ERROR titlew0="01"
 TITLEW0 = UPPER(TITLEW0)
 ON ERROR do _error0 with message()
 IF  .NOT. FILE(PUB005 + 'data15.dbf')
 RETURN 
 ENDIF 
 PASS_M4 = SELECT()
 IF USED('data15')
 SELECT DATA15
 ELSE 
 SELECT 0
 IF FILE(PUB005 + 'data15.dbf')
    USE SHARED PUB005 + 'data15'
 ELSE 
    RETURN 
 ENDIF 
 ENDIF 
 IF PASS_M2 = 0
 LOCATE FOR VAL(LEFT(MODEL1,2)) = PASS_M1 AND RIGHT
 M.MODEL1 = SUBSTR(MODEL1,4,12)
 M.MODEL2 = ''
 LOCATE FOR EMPTY(OUTIME) AND  .NOT. RIGHT AND USER = PUB001 AND MODEL1 = M.MODEL1
 ELSE 
 LOCATE FOR VAL(LEFT(MODEL1,2)) = PASS_M1 AND VAL(LEFT(MODEL2,2)) = PASS_M2 AND RIGHT
 M.MODEL1 = SUBSTR(MODEL1,4,12)
 M.MODEL2 = SUBSTR(MODEL2,4,12)
 LOCATE FOR  ;
      EMPTY(OUTIME) AND  .NOT. RIGHT AND USER = PUB001 AND MODEL1 = M.MODEL1 AND  ;
MODEL2 = M.MODEL2
 ENDIF 
 IF FOUND()
 IF RLOCK()
    REPLACE OUTIME WITH TIME()
    IF  .NOT. EMPTY(PASS_M3)
       REPLACE CHKMEMO WITH PASS_M3
    ENDIF 
 ENDIF 
 ELSE 
 APPEND BLANK
 REPLACE MACHINE WITH TITLEW0 , USER WITH PUB001 , MODEL1 WITH M.MODEL1 , MODEL2 WITH  ;
      M.MODEL2 , INDATE WITH DATE() , OUTIME WITH TIME() , CHKMEMO WITH  ;
      '<进入时间>未知!'
 ENDIF 
 USE 
 SELECT (PASS_M4)
ENDPROC
*------
PROCEDURE ZHENLI
 PARAMETER A1 , A2 , A3
 ISERROR = .F.
 ON ERROR Iserror=.T. 
 IF USED(A1)
  SELECT &A1
 ELSE 
 SELECT 0
 A5 = PUB005 + A1
 USE EXCLUSIVE '' + A5
 ENDIF 
 IF ISERROR
 = MESSAGEBOX(A2 + '数据正被使用 !',48,'信息提示')
 ELSE 
 IF A3
    REINDEX 
 ELSE 
    PACK 
 ENDIF 
 ENDIF 
 USE 
 ON ERROR do _error0 with message() 
 RETURN 
ENDPROC
*------
PROCEDURE m0_s1_2
 PARAMETER PAS4 , PAS5
 IF PAS4
 TEMPJUDG = .T.
 ON ERROR tempjudg=.f.
 IF USED('data0')
    SELECT DATA0
    USE 
 ENDIF 
 SELECT 0
 USE SHARED '' + PAS5
 GO TOP
 ON ERROR do _error0 with message()
 IF TEMPJUDG AND  .NOT. EOF() AND RLOCK()
    COUNT TO T0
    IF T0 = 0
       = MESSAGEBOX('系统参数设置库有误，操作无法进行！',16,'信息提示')
       USE 
       RETURN .F.
    ELSE 
       GO TOP
       IF LEN1 <= 0 .OR. LEN2 <= 0 .OR. LEN3 = 0
          REPLACE LEN1 WITH 8 , WID1 WITH 2 , LEN2 WITH 10 , WID2 WITH 2 , LEN3 WITH 36
          IF MESSAGEBOX('系统设置库结构错误，系统自我调整？',33,'信息提示') = 2
             USE 
             RETURN .F.
          ELSE 
             SCATTER MEMVAR FIELDS LEN1 , LEN2 , LEN3 , WID1 , WID2
          ENDIF 
       ELSE 
          SCATTER MEMVAR FIELDS LEN1 , LEN2 , LEN3 , WID1 , WID2
       ENDIF 
       USE 
    ENDIF 
 ELSE 
    = MESSAGEBOX('网络其他用户正在占用系统数据，操作无法进行！',16,'信息提示')
    USE 
    RETURN .F.
 ENDIF 
 ENDIF 
 SS = '正在调整系统参数及数据结构…'
 MSG = CREATEOBJECT('msgbox',.F.,SS)
  MSG.SHOW
 TEMP_T0 = SYS(2001,'excl')
 TEMPJUDG = .T.
 ON ERROR tempjudg=.f.
 IF USED('stru')
 SELECT STRU
 USE 
 ENDIF 
 SELECT 0
 USE EXCLUSIVE stru
 ON ERROR do _error0 with message()
 IF  .NOT. TEMPJUDG
 = MESSAGEBOX('网络其他用户正在占用系统数据，操作无法进行！',16,'信息提示')
 RETURN .F.
 ENDIF 
 REPLACE FIELD_LEN WITH M.LEN1 , FIELD_DEC WITH (M.WID1) FOR  ;
      FIELD_NAME = 'HPSL ' .OR. FIELD_NAME = 'HPYS ' .OR. FIELD_NAME = 'SL '
 REPLACE FIELD_LEN WITH M.LEN1 + 2 , FIELD_DEC WITH (M.WID1) FOR  ;
      FIELD_NAME = 'HPSL ' AND FIELD_DATA = 'data2'
 REPLACE FIELD_LEN WITH M.LEN1 + 2 , FIELD_DEC WITH (M.WID1) FOR  ;
      FIELD_NAME = 'SQSL' .OR. FIELD_NAME = 'RKSL' .OR. FIELD_NAME = 'CKSL' .OR.  ;
FIELD_NAME = 'PDSL' .OR. FIELD_NAME = 'JYSL'
 REPLACE FIELD_LEN WITH M.LEN2 , FIELD_DEC WITH (M.WID2) FOR  ;
      FIELD_NAME = 'HPYJ ' .OR. FIELD_NAME = 'HPBJ ' .OR. FIELD_NAME = 'CBDJ ' .OR.  ;
FIELD_NAME = 'JYDJ '
 T0 = MAX(M.WID1,M.WID2)
 REPLACE FIELD_LEN WITH  ;
      MAX(M.LEN1 - IIF(M.WID1 = 0,0,M.WID1 + 1),M.LEN2 - IIF(M.WID2 = 0,0,M.WID2 + 1)) +  ;
IIF(T0 = 0,0,T0 + 1) , FIELD_DEC WITH (T0) FOR  ;
      FIELD_NAME = 'CBDJ ' AND FIELD_DATA = 'data5'
 USE 
  MSG.RELEASE
 RETURN 
ENDPROC
*------
PROCEDURE m0_s1_3
 SS = '正在调整系统结构…'
 MSG = CREATEOBJECT('msgbox',.T.,SS)
  MSG.SHOW
 MSG.CAPTION = SS
 M_NUM = 6.25
 MSG.CAPTION = '请稍等，正在调整单据库...'
 DO M0_S1_1 WITH 'data5' , PUB005 + 'data5.dbf' , 'data5'
 MSG.NPER = M_NUM
 SELECT 0
 USE EXCLUSIVE PUB005 + 'data5.dbf'
 INDEX ON PDHM TAG PDHM UNIQUE ADDITIVE FOR  .NOT. DELETED()
 MSG.NPER = M_NUM * 2
 INDEX ON HPBM + DTOC(JZRQ) TAG JZRQ ADDITIVE
 MSG.NPER = M_NUM * 3
 INDEX ON HPBM + DTOC(JZRQ) TAG JZRQ2 DESCENDING ADDITIVE
 MSG.NPER = M_NUM * 4
 INDEX ON JZRQ TAG RK FOR TYPE = 1
 INDEX ON JZRQ TAG CK FOR TYPE = 2
 INDEX ON JZRQ TAG DK FOR IO = 3
 INDEX ON JZRQ TAG PD FOR TYPE = 5
 INDEX ON JZRQ TAG KHZK FOR TYPE < 3
 USE 
 IF FILE(PUB005 + 'data_bak.dbf')
 MSG.CAPTION = '请稍等，正在调整已结单据库...'
 DO M0_S1_1 WITH 'data5' , PUB005 + 'data_bak.dbf' , 'data_bak'
 MSG.NPER = M_NUM * 5
 ENDIF 
 MSG.CAPTION = '请稍等，正在调整货品编码单据库...'
 DO M0_S1_1 WITH 'data2' , PUB005 + 'data2.dbf' , 'data2'
 MSG.NPER = M_NUM * 6
 SELECT 0
 USE EXCLUSIVE PUB005 + 'data2.dbf'
 INDEX ON HPBM TAG HPBM ADDITIVE
 MSG.NPER = M_NUM * 7
 INDEX ON HPPM TAG HPPM ADDITIVE
 MSG.NPER = M_NUM * 8
 USE 
 MSG.CAPTION = '请稍等，正在调整定单单据库...'
 DO M0_S1_1 WITH 'data11' , PUB005 + 'data11.dbf' , 'data11'
 MSG.NPER = M_NUM * 9
 SELECT 0
 USE EXCLUSIVE PUB005 + 'data11.dbf'
 INDEX ON DTOC(RQ1) + SIGN TAG SIGN ADDITIVE
 MSG.NPER = M_NUM * 10
 INDEX ON SIGN TAG SIGN_U UNIQUE ADDITIVE FOR  .NOT. DELETED()
 MSG.NPER = M_NUM * 11
 INDEX ON HPBM + DFDW TAG HPBM_U UNIQUE DESCENDING ADDITIVE FOR  .NOT. DELETED()
 MSG.NPER = M_NUM * 12
 USE 
 MSG.CAPTION = '请稍等，正在调整报表统计库...'
 DO M0_S1_1 WITH 'data_rpt' , 'data_rpt.dbf' , 'data_rpt'
 MSG.NPER = M_NUM * 13
 MSG.CAPTION = '请稍等，正在调整套件组合库...'
 DO M0_S1_1 WITH 'data13' , PUB005 + 'data13.dbf' , 'data13'
 MSG.NPER = M_NUM * 14
 SELECT 0
 USE EXCLUSIVE PUB005 + 'data13.dbf'
 INDEX ON DH TAG DH UNIQUE ADDITIVE FOR  .NOT. DELETED()
 INDEX ON STR(DH) + HPBM TAG HPBM ADDITIVE
 INDEX ON CPBM + STR(DH) TAG CPBM UNIQUE ADDITIVE FOR  .NOT. DELETED()
 MSG.NPER = M_NUM * 15
 USE 
 MSG.CAPTION = '请稍等，正在调整计划采购表...'
 DO M0_S1_1 WITH 'data19' , PUB005 + 'data19.dbf' , 'data19'
 MSG.CAPTION = '请稍等，正在清理临时文件...'
 DO DELETEMP
 MSG.NPER = M_NUM * 15
  MSG.RELEASE
 RETURN 
ENDPROC
*------
PROCEDURE m0_s1_1
 PARAMETER P1 , P2 , P3
 IF USED(P3)
  select &p3
 USE 
 ENDIF 
 IF USED('stru')
 SELECT STRU
 ELSE 
 SELECT 0
 USE SHARED 'stru'
 ENDIF 
 SET FILTER TO FIELD_DATA = P1
 COPY TO ARRAY TEMP_J9
 USE 
 CREATE TABLE temp_j92 FROM ARRAY TEMP_J9
 ON ERROR =messagebox("数据库丢失错误，系统自行增补！",48,"信息提示")
 APPEND FROM '' + P2
 ON ERROR =messagebox("网络数据正在使用，无法调整库结构！",16,"信息提示")
 COPY TO '' + P2
 USE 
 ON ERROR do _error0 with message()
 ERASE temp_j92.dbf
 RETURN 
ENDPROC
*------
PROCEDURE QINGXI
 PARAMETER A1 , A2 , A3
 TEMP_1 = MESSAGEBOX('清洗' + A2 + ' ？',35,'信息提示')
 DO CASE 
 CASE TEMP_1 = 2
 RETURN .F.
 CASE TEMP_1 = 7
 RETURN .T.
 OTHERWISE 
 TEMPJUDG = .T.
 ON ERROR tempjudg=.f.
 IF USED(A1)
     SELECT &A1
 ELSE 
    SELECT 0
    A5 = PUB005 + A1
    USE EXCLUSIVE '' + A5
 ENDIF 
 ON ERROR do _error0 with message()
 IF  .NOT. TEMPJUDG
    = MESSAGEBOX(A2 + '数据正被使用 !',48,'信息提示')
 ELSE 
    ZAP 
 ENDIF 
 ENDCASE 
 RETURN .T.
ENDPROC
*------
PROCEDURE BEIFENG
 PARAMETER A1 , A2 , A3
 TEMP_1 = MESSAGEBOX('备份' + A2 + ' ？',35,'信息提示')
 IF TEMP_1 = 2
 RETURN .F.
 ENDIF 
 IF TEMP_1 = 7
 RETURN .T.
 ENDIF 
 IF FILE(TEMP16 + A1 + '.dbf')
 IF MESSAGEBOX('该路径下已有备份' + A2 + '，覆盖 ？',33,'信息提示') = 2
    RETURN .T.
 ENDIF 
 ENDIF 
 IF  .NOT. USED(A1)
 A5 = PUB005 + A1
 USE IN SELECT(0) SHARED '' + A5 ALIAS TEMP_DBF
 ENDIF 
 SELECT TEMP_DBF
 A4 = TEMP16 + A1
 ON ERROR do _error2 
 IF A3
 COPY TO '' + A4 WITH CDX TYPE FOX2X 
 ELSE 
 COPY TO '' + A4 TYPE FOX2X 
 ENDIF 
 USE 
 ON ERROR do _error0 with message()
 RETURN 
ENDPROC
*------
PROCEDURE DIAORU
 PARAMETER A1 , A2 , A3
 TEMP_1 = MESSAGEBOX('调入' + A2 + ' ？',35,'信息提示')
 DO CASE 
 CASE TEMP_1 = 2
 RETURN .F.
 CASE TEMP_1 = 7
 RETURN .T.
 OTHERWISE 
 IF USED(A1)
     SELECT &A1
    USE 
 ENDIF 
 TEMPJUDG = .T.
 ON ERROR tempjudg=.f.
 A5 = PUB005 + A1
 IF  .NOT. FILE(A5 + '.dbf')
    = MESSAGEBOX(A2 + '不存在 !',16,'信息提示')
    ON ERROR do _error0 with message()
    RETURN 
 ENDIF 
 USE EXCLUSIVE '' + A5
 IF  .NOT. TEMPJUDG
    = MESSAGEBOX(A2 + '正被使用 !',16,'信息提示')
    ON ERROR do _error0 with message()
    RETURN 
 ENDIF 
 PACK 
 IF  .NOT. FILE(TEMP16 + A1 + '.dbf')
    = MESSAGEBOX(A2 + '调入路径错误或者原文件未找到!',16,'信息提示')
    ON ERROR do _error0 with message()
    USE 
    RETURN 
 ENDIF 
 DELETE ALL
 A4 = TEMP16 + A1
 APPEND FROM '' + A4
 IF  .NOT. TEMPJUDG
    = MESSAGEBOX(A2 + '数据调入错误，恢复原数据 !',48,'信息提示')
    GO TOP
    STORE RECNO() TO TEMP
    RECALL ALL
    DELETE ALL FOR RECNO() >= TEMP
    PACK 
    = MESSAGEBOX('原有' + A2 + '数据恢复完毕 !',64,'信息提示')
 ELSE 
    PACK 
    IF A3
       REINDEX 
    ENDIF 
 ENDIF 
 ENDCASE 
 ON ERROR do _error0 with message()
 USE 
 RETURN 
ENDPROC
*------
PROCEDURE HEBIN
 PARAMETER A1 , A2 , A3
 TEMP_1 = MESSAGEBOX('合并' + A2 + ' ？',35,'信息提示')
 DO CASE 
 CASE TEMP_1 = 2
 RETURN .F.
 CASE TEMP_1 = 7
 RETURN .T.
 OTHERWISE 
 TEMPJUDG = .T.
 ON ERROR tempjudg=.f.
 IF  .NOT. FILE(PUB005 + A1 + '.dbf')
    = MESSAGEBOX(A2 + '不存在 !',16,'信息提示')
    ON ERROR do _error0 with message()
    RETURN 
 ENDIF 
 IF USED(A1)
     SELECT &A1
    SET ORDER TO
 ELSE 
    SELECT 0
    A5 = PUB005 + A1
    USE EXCLUSIVE '' + A5