utilite.prg

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

 ENDIF 
 IF FILE(TEMP16 + A1 + '.dbf')
    IF  .NOT. TEMPJUDG
       = MESSAGEBOX('合并' + A2 + '的调入路径错误 !',16,'信息提示')
       ON ERROR do _error0 with message()
       USE 
       RETURN 
    ENDIF 
 ELSE 
    = MESSAGEBOX('合并' + A2 + '的原文件未找到 !',16,'信息提示')
    ON ERROR do _error0 with message()
    USE 
    RETURN 
 ENDIF 
 A4 = TEMP16 + A1
 APPEND FROM '' + A4
 ENDCASE 
 ON ERROR do _error0 with message()
 USE 
ENDPROC
*------
PROCEDURE _error2
 DO CASE 
 CASE ERROR() = 56
 = MESSAGEBOX('磁盘空间不够 !' + CHR(13) + MESSAGE(),16,'信息提示')
 CASE ERROR() = 1705
 = MESSAGEBOX('系统数据正被占用 !' + CHR(13) + MESSAGE(),16,'信息提示')
 CASE ERROR() = 202
 ERRORNUM = ERROR()
 OTHERWISE 
 = MESSAGEBOX('备份错误 !' + CHR(13) + MESSAGE(),16,'信息提示')
 ENDCASE 
 RETURN 
ENDPROC
*------
PROCEDURE tiaozhen
 PARAMETER PAS1 , PAS2 , PAS3
 TEMPJUDG = .T.
 IF PAS1 <> 'data2'
 SELECT 0
 USE (PUB005 + PAS1)
 ELSE 
 SELECT DATA2
 ENDIF 
 IF  .NOT. TEMPJUDG
 = MESSAGEBOX(PAS2 + '错误',48,'信息提示')
 RETURN 
 ENDIF 
 IF FLOCK()
 IF PAS1 = 'data2'
    IF  .NOT. TEMP_T00
       LOCATE FOR ALLTRIM(HPBM) == M.HPBM2
       IF FOUND()
          DELETE 
       ELSE 
          = MESSAGEBOX(PAS2 + '的编码错误，无法调整 !',48,'信息提示')
       ENDIF 
    ELSE 
       LOCATE FOR ALLTRIM(HPBM) == M.HPBM2
       IF FOUND()
          DO CASE 
          CASE PAS3 = 1
             REPLACE HPBM WITH M.HPBM , HPPM WITH M.HPPM , HPDW WITH M.HPDW
          CASE PAS3 = 2
             REPLACE HPBM WITH M.HPBM , HPDW WITH M.HPDW
          CASE PAS3 = 3
             REPLACE HPPM WITH M.HPPM , HPDW WITH M.HPDW
          CASE PAS3 = 4
             REPLACE HPDW WITH M.HPDW
          ENDCASE 
       ENDIF 
    ENDIF 
    UNLOCK 
    RETURN 
 ELSE 
    DO CASE 
    CASE PAS3 = 1
       REPLACE HPBM WITH M.HPBM , HPPM WITH M.HPPM , HPDW WITH (M.HPDW) FOR  ;
            ALLTRIM(HPBM) == M.HPBM2
    CASE PAS3 = 2
       REPLACE HPBM WITH M.HPBM , HPDW WITH (M.HPDW) FOR ALLTRIM(HPBM) == M.HPBM2
    CASE PAS3 = 3
       REPLACE HPPM WITH M.HPPM , HPDW WITH (M.HPDW) FOR ALLTRIM(HPBM) == M.HPBM2
    CASE PAS3 = 4
       REPLACE HPDW WITH (M.HPDW) FOR ALLTRIM(HPBM) == M.HPBM2
    ENDCASE 
 ENDIF 
 IF PAS1 = 'data13' AND M.HPBM <> M.HPBM2
    REPLACE CPBM WITH (M.HPBM) FOR ALLTRIM(CPBM) == M.HPBM2
 ENDIF 
 UNLOCK 
 ELSE 
 = MESSAGEBOX(PAS2 + '正被<系统用户>占用，暂时无法调整 !',48,'信息提示')
 ENDIF 
 IF PAS1 <> 'data2'
 USE 
 ENDIF 
 RETURN 
ENDPROC
*------
PROCEDURE main1_2
 PARAMETER HPPM
 T004 = '.t.'
 T003 = ALLTRIM(HPPM)
 DIMENSION T001( 5 )
 FOR I = 1 TO 5
 T0021 = ATC('，',T003)
 T0022 = ATC(',',T003)
 DO CASE 
 CASE T0021 = 0 AND T0022 = 0
    T001( I ) = ALLTRIM(T003)
    T004 = T004 + " and upper('" + T001(I) + "')$upper(hppm)"
    EXIT 
 CASE T0022 <> 0 AND T0021 <> 0
    IF T0022 < T0021
       T001( I ) = ALLTRIM(LEFT(T003,T0022 - 1))
       T004 = T004 + " and upper('" + T001(I) + "')$upper(hppm)"
       T003 = SUBSTR(T003,T0022 + 1,LEN(T003) - T0022)
    ELSE 
       T001( I ) = ALLTRIM(LEFT(T003,T0021 - 1))
       T004 = T004 + " and upper('" + T001(I) + "')$upper(hppm)"
       T003 = SUBSTR(T003,T0021 + 2,LEN(T003) - T0021 - 1)
    ENDIF 
 CASE T0022 <> 0
    T001( I ) = ALLTRIM(LEFT(T003,T0022 - 1))
    T004 = T004 + " and upper('" + T001(I) + "')$upper(hppm)"
    T003 = SUBSTR(T003,T0022 + 1,LEN(T003) - T0022)
 CASE T0021 <> 0
    T001( I ) = ALLTRIM(LEFT(T003,T0021 - 1))
    T004 = T004 + " and upper('" + T001(I) + "')$upper(hppm)"
    T003 = SUBSTR(T003,T0021 + 2,LEN(T003) - T0021 - 1)
 ENDCASE 
 ENDFOR 
 RETURN T004
ENDPROC
*------
PROCEDURE N_screen
 PARAMETER M_FORM
 IF SYSMETRIC(1) > 640
 WITH M_FORM  
 .LOCKSCREEN = .T.
 .HEIGHT = .HEIGHT * CHANGEHEIGHT
 .WIDTH = .WIDTH * CHANGEWIDTH
 .TOP = .TOP * CHANGEHEIGHT
 .LEFT = .LEFT * CHANGEWIDTH
 FOR I = 1 TO .CONTROLCOUNT
    WITH .CONTROLS(I)  
    .HEIGHT = .HEIGHT * CHANGEHEIGHT
    .WIDTH = .WIDTH * CHANGEWIDTH
    .TOP = .TOP * CHANGEWIDTH
    .LEFT = .LEFT * CHANGEWIDTH
    ENDWITH 
 ENDFOR 
  .REFRESH
 .LOCKSCREEN = .F.
 ENDWITH 
 ENDIF 
 RETURN 
ENDPROC
*------
PROCEDURE N_screen1
 PARAMETER M_FORM
 IF SYSMETRIC(1) > 640
 WITH M_FORM  
 .LOCKSCREEN = .T.
 .HEIGHT = .HEIGHT * CHANGEHEIGHT
 .WIDTH = .WIDTH * CHANGEWIDTH
 .TOP = .TOP * CHANGEHEIGHT
 .LEFT = .LEFT * CHANGEWIDTH
 ERR_001 = .T.
 ON ERROR ERR_001=.F.
 FOR I = 1 TO .CONTROLCOUNT
    WITH .CONTROLS(I)  
    .HEIGHT = .HEIGHT * CHANGEHEIGHT
    .WIDTH = .WIDTH * CHANGEWIDTH
    .TOP = .TOP * CHANGEWIDTH
    .LEFT = .LEFT * CHANGEWIDTH
    ENDWITH 
 ENDFOR 
 ON ERROR 
  .REFRESH
 .LOCKSCREEN = .F.
 ENDWITH 
 ENDIF 
 RETURN 
ENDPROC
*------
PROCEDURE N_Con
 PARAMETER M_CON
 IF SYSMETRIC(1) > 640
 WITH M_CON  
 FOR I = 1 TO .CONTROLCOUNT
    WITH .CONTROLS(I)  
    .HEIGHT = .HEIGHT * CHANGEHEIGHT
    .WIDTH = .WIDTH * CHANGEWIDTH
    .TOP = .TOP * CHANGEWIDTH
    .LEFT = .LEFT * CHANGEWIDTH
    ENDWITH 
 ENDFOR 
  .REFRESH
 ENDWITH 
 ENDIF 
 RETURN 
ENDPROC
*------
PROCEDURE N_grid
 PARAMETER M_GRID
 IF SYSMETRIC(1) > 640
 WITH M_GRID  
 FOR I = 1 TO .COLUMNCOUNT
    M_CC = '.column' + ALLTRIM(STR(I)) + '.width'
     &m_cc=&m_cc*changewidth
 ENDFOR 
  .REFRESH
 ENDWITH 
 ENDIF 
 RETURN 
ENDPROC
*------
PROCEDURE CheckFile
 PARAMETER FILENAME
 FILENAME = ALLTRIM(FILENAME)
 MF_CC = RIGHT(FILENAME,LEN(FILENAME) - RAT('\',FILENAME,1))
 MF_CC = LOWER(MF_CC)
 IF 'data' == LEFT(MF_CC,4) .OR. 'stru' == LEFT(MF_CC,4) .OR. 'temp_' == LEFT(MF_CC,5) .OR.  ;
'foxuser' == LEFT(MF_CC,7) .OR. 'support' == LEFT(MF_CC,7)
 = MESSAGEBOX('不能使用系统数据库做传递文件',48,'文件错误')
 RETURN .F.
 ELSE 
 RETURN .T.
 ENDIF 
 RETURN 
ENDPROC
*------
PROCEDURE deletemp
 DELETE File PUB005 + 'data_2.dbf'
 DELETE File PUB005 + 'data_3.dbf'
 DELETE File data\*.*
 RETURN 
ENDPROC
*------
PROCEDURE xtzd
 IF  .NOT. SUBSTR(RIGHT009,1,1) = '1'
 = MESSAGEBOX('您无权进行系统数据诊断修复操作.',48,'错误信息')
 RETURN 
 ENDIF 
 CLOSE DATABASES 
 M_SS = '《物资配送系统》'
 IF MESSAGEBOX('开始本操作前，确定:' + CHR(13) + CHR(13) + '1. 在' + M_SS +  ;
'［数据维护］中所有数据已备份；' +  ;
CHR(13) +  ;
'2. 所有网点用户均已退出' +  ;
M_SS +  ;
'系统模块？',33,'信息提示') =  ;
2
 RETURN 
 ENDIF 
 D_NAME2 = ' '
 D_NUM1 = 0
 D_NUM2 = 0
 D_JUDG = .T.
 USE IN SELECT(1) EXCLUSIVE stru ALIAS STRU
 IF MESSAGEBOX('开始进行系统数据的自我诊断及修复？',33,'信息提示') = 2
 RETURN 
 ENDIF 
 DO LOADIN WITH 9 , 1 , ''
 STORE 2 TO M.WID1 , M.WID2
 STORE 8 TO M.LEN1 , M.LEN2
 STORE 36 TO M.LEN3
 IF  .NOT. M0_S1_2(.T.,PUB005 + 'DATA0')
 DO _QUIT1 WITH 1
 CLOSE DATABASES 
 DO LOADQUIT WITH 9 , 1 , '中断'
 RETURN 
 ENDIF 
 D_NAME2 = PUB005 + 'data0.dbf'
 M_TEMP = M9_S1('系统设置库')
 DO CASE 
 CASE M_TEMP = 2
 D_NUM2 = D_NUM2 + 1
 DO M0_S1_1 WITH 'data0' , D_NAME2 , 'data0'
 CASE M_TEMP = 3
 CLOSE DATABASES 
 DO LOADQUIT WITH 9 , 1 , '中断'
 RETURN 
 ENDCASE 
 D_NAME2 = PUB005 + 'data1.dbf'
 M_TEMP = M9_S1('职员权限库')
 DO CASE 
 CASE M_TEMP = 2
 D_NUM2 = D_NUM2 + 1
 DO M0_S1_1 WITH 'data1' , D_NAME2 , 'data1'
 CASE M_TEMP = 3
 CLOSE DATABASES 
 DO LOADQUIT WITH 9 , 1 , '中断'
 RETURN 
 ENDCASE 
 USE PUB005 + 'data1.dbf'
 LOCATE FOR CODE = 'SYSTEM'
 IF FOUND()
 REPLACE CODE_1 WITH '111111111111111111111111111111' , CODE_2 WITH '1111111111' , CODE_3  ;
      WITH '11111111111111111111' , CODE_4 WITH '11111111111111111111' ,  ;
      CODE_5 WITH '1111111111' , CODE_6 WITH '11111111111111111111' , CODE_7  ;
      WITH '1111111111' , CODE_8 WITH '1111111111' , CODE_9 WITH '1111111111'
 ENDIF 
 USE 
 D_NAME2 = PUB005 + 'data2.dbf'
 M_TEMP = M9_S1('货品编码库')
 DO CASE 
 CASE M_TEMP = 2
 D_NUM2 = D_NUM2 + 1
 DO M0_S1_1 WITH 'data2' , D_NAME2 , 'data2'
 CASE M_TEMP = 3
 CLOSE DATABASES 
 DO LOADQUIT WITH 9 , 1 , '中断'
 RETURN 
 ENDCASE 
 IND_J = .F.
 ON ERROR ind_j=.t.
 SELECT 0
 USE EXCLUSIVE '' + D_NAME2
 SET ORDER TO Hpbm
 SET ORDER TO Hppm
 REINDEX 
 IF  .NOT. FILE(PUB005 + 'data2.cdx') .OR. IND_J
 D_NUM1 = D_NUM1 + 1
 INDEX ON HPBM TAG HPBM ADDITIVE
 INDEX ON HPPM TAG HPPM ADDITIVE
 D_NUM2 = D_NUM2 + 1
 ENDIF 
 USE 
 ON ERROR 
 D_NAME2 = PUB005 + 'data3.dbf'
 M_TEMP = M9_S1('货币库')
 DO CASE 
 CASE M_TEMP = 2
 D_NUM2 = D_NUM2 + 1
 DO M0_S1_1 WITH 'data3' , D_NAME2 , 'data3'
 CASE M_TEMP = 3
 CLOSE DATABASES 
 DO LOADQUIT WITH 9 , 1 , '中断'
 RETURN 
 ENDCASE 
 D_NAME2 = PUB005 + 'data4.dbf'
 M_TEMP = M9_S1('仓位库')
 DO CASE 
 CASE M_TEMP = 2
 D_NUM2 = D_NUM2 + 1
 DO M0_S1_1 WITH 'data4' , D_NAME2 , 'data4'
 CASE M_TEMP = 3
 CLOSE DATABASES 
 DO LOADQUIT WITH 9 , 1 , '中断'
 RETURN 
 ENDCASE 
 IND_J = .F.
 ON ERROR ind_j=.t.
 SELECT 0
 USE EXCLUSIVE '' + D_NAME2
 SET ORDER TO hpck
 REINDEX 
 IF  .NOT. FILE(PUB005 + 'data4.cdx') .OR. IND_J
 D_NUM1 = D_NUM1 + 1
 INDEX ON HPCK TAG HPCK ADDITIVE
 D_NUM2 = D_NUM2 + 1
 ENDIF 
 USE 
 ON ERROR 
 D_NAME2 = PUB005 + 'data5.dbf'
 M_TEMP = M9_S1('本期单据库')
 DO CASE 
 CASE M_TEMP = 2
 D_NUM2 = D_NUM2 + 1
 DO M0_S1_1 WITH 'data5' , D_NAME2 , 'data5'
 CASE M_TEMP = 3
 CLOSE DATABASES 
 DO LOADQUIT WITH 9 , 1 , '中断'
 RETURN 
 ENDCASE 
 IND_J = .F.
 ON ERROR ind_j=.t.
 SELECT 0
 USE EXCLUSIVE '' + D_NAME2
 SET ORDER TO Pdhm
 SET ORDER TO Jzrq
 SET ORDER TO Jzrq2
 SET ORDER TO rk
 SET ORDER TO ck
 SET ORDER TO dk
 SET ORDER TO pd
 REINDEX 
 IF  .NOT. FILE(PUB005 + 'data5.cdx') .OR. IND_J
 D_NUM1 = D_NUM1 + 1
 INDEX ON PDHM TAG PDHM UNIQUE ADDITIVE
 INDEX ON HPBM + DTOC(JZRQ) TAG JZRQ ADDITIVE
 INDEX ON HPBM + DTOC(JZRQ) TAG JZRQ2 DESCENDING ADDITIVE
 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
 D_NUM2 = D_NUM2 + 1
 ENDIF 
 USE 
 D_NAME2 = PUB005 + 'data_bak.dbf'
 IF FILE(D_NAME2)
 M_TEMP = M9_S1('已结单据库')
 DO CASE 
 CASE M_TEMP = 2
    D_NUM2 = D_NUM2 + 1
    DO M0_S1_1 WITH 'data5' , D_NAME2 , 'data_bak'
 CASE M_TEMP = 3
    CLOSE DATABASES 
    DO LOADQUIT WITH 9 , 1 , '中断'
    RETURN 
 ENDCASE 
 ENDIF 
 D_NAME2 = PUB005 + 'data6.dbf'
 M_TEMP = M9_S1('图形数据库')
 DO CASE 
 CASE M_TEMP = 2
 D_NUM2 = D_NUM2 + 1
 DO M0_S1_1 WITH 'data6' , D_NAME2 , 'data6'
 CASE M_TEMP = 3
 CLOSE DATABASES 
 DO LOADQUIT WITH 9 , 1 , '中断'
 RETURN 
 ENDCASE 
 D_NAME2 = PUB005 + 'data7.dbf'
 M_TEMP = M9_S1('客户(帐户)库')
 DO CASE 
 CASE M_TEMP = 2
 D_NUM2 = D_NUM2 + 1
 DO M0_S1_1 WITH 'data7' , D_NAME2 , 'data7'
 CASE M_TEMP = 3
 CLOSE DATABASES 
 DO LOADQUIT WITH 9 , 1 , '中断'
 RETURN 
 ENDCASE 
 IND_J = .F.
 ON ERROR ind_j=.t.
 SELECT 0
 USE EXCLUSIVE '' + D_NAME2
 SET ORDER TO Dfdw
 SET ORDER TO No
 REINDEX 
 IF  .NOT. FILE(PUB005 + 'data7.cdx') .OR. IND_J
 D_NUM1 = D_NUM1 + 1
 INDEX ON DFDW TAG DFDW ADDITIVE
 INDEX ON NO TAG NO ADDITIVE
 D_NUM2 = D_NUM2 + 1
 ENDIF 
 USE 
 ON ERROR 
 D_NAME2 = PUB005 + 'data8.dbf'
 M_TEMP = M9_S1('摘要库')
 DO CASE 
 CASE M_TEMP = 2
 D_NUM2 = D_NUM2 + 1
 DO M0_S1_1 WITH 'data8' , D_NAME2 , 'data8'
 CASE M_TEMP = 3
 CLOSE DATABASES 
 DO LOADQUIT WITH 9 , 1 , '中断'
 RETURN 
 ENDCASE 
 IND_J = .F.
 ON ERROR ind_j=.t.
 SELECT 0
 USE EXCLUSIVE '' + D_NAME2
 SET ORDER TO No
 REINDEX 
 IF  .NOT. FILE(PUB005 + 'data8.cdx') .OR. IND_J
 D_NUM1 = D_NUM1 + 1
 INDEX ON NO TAG NO ADDITIVE
 D_NUM2 = D_NUM2 + 1
 ENDIF 
 USE 
 ON ERROR 
 D_NAME2 = PUB005 + 'data13.dbf'
 M_TEMP = M9_S1('产品组合库')
 DO CASE 
 CASE M_TEMP = 2
 D_NUM2 = D_NUM2 + 1
 DO M0_S1_1 WITH 'data13' , D_NAME2 , 'data13'
 CASE M_TEMP = 3
 CLOSE DATABASES 
 DO LOADQUIT WITH 9 , 1 , '中断'
 RETURN 
 ENDCASE 
 IND_J = .F.
 ON ERROR ind_j=.t.
 SELECT 0
 USE EXCLUSIVE '' + D_NAME2
 SET ORDER TO Dh
 REINDEX 
 IF  .NOT. FILE(PUB005 + 'data13.cdx') .OR. IND_J
 D_NUM1 = D_NUM1 + 1
 INDEX ON DH TAG DH UNIQUE ADDITIVE FOR  .NOT. DELETED()
 INDEX ON STR(DH) + HPBM TAG HPBM ADDITIVE
 D_NUM2 = D_NUM2 + 1
 ENDIF 
 INDEX ON CPBM + STR(DH) TAG CPBM UNIQUE ADDITIVE FOR  .NOT. DELETED()
 USE 
 ON ERROR 
 D_NAME2 = PUB005 + 'data9.dbf'
 M_TEMP = M9_S1('资金帐目库')
 DO CASE 
 CASE M_TEMP = 2
 D_NUM2 = D_NUM2 + 1
 DO M0_S1_1 WITH 'data9' , D_NAME2 , 'data9'
 CASE M_TEMP = 3
 CLOSE DATABASES 
 DO LOADQUIT WITH 9 , 1 , '中断'
 RETURN 
 ENDCASE