utilite.prg

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

 IND_J = .F.
 ON ERROR ind_j=.t.
 SELECT 0
 USE EXCLUSIVE '' + D_NAME2
 SET ORDER TO Jzrq
 REINDEX 
 IF  .NOT. FILE(PUB005 + 'data9.cdx') .OR. IND_J
 D_NUM1 = D_NUM1 + 1
 INDEX ON DFDW + DTOC(JZRQ) TAG JZRQ ADDITIVE
 D_NUM2 = D_NUM2 + 1
 ENDIF 
 USE 
 ON ERROR 
 D_NAME2 = PUB005 + 'data10.dbf'
 M_TEMP = M9_S1('门市票据库')
 DO CASE 
 CASE M_TEMP = 2
 D_NUM2 = D_NUM2 + 1
 DO M0_S1_1 WITH 'data10' , D_NAME2 , 'data10'
 CASE M_TEMP = 3
 CLOSE DATABASES 
 DO LOADQUIT WITH 9 , 1 , '中断'
 RETURN 
 ENDCASE 
 D_NAME2 = PUB005 + 'data11.dbf'
 M_TEMP = M9_S1('订单数据库')
 DO CASE 
 CASE M_TEMP = 2
 D_NUM2 = D_NUM2 + 1
 DO M0_S1_1 WITH 'data11' , D_NAME2 , 'data11'
 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 sign
 SET ORDER TO sign_u
 SET ORDER TO hpbm_u
 REINDEX 
 IF  .NOT. FILE(PUB005 + 'data11.cdx') .OR. IND_J
 D_NUM1 = D_NUM1 + 1
 INDEX ON DTOC(RQ1) + SIGN TAG SIGN ADDITIVE
 INDEX ON SIGN TAG SIGN_U UNIQUE ADDITIVE FOR  .NOT. DELETED()
 INDEX ON HPBM + DFDW TAG HPBM_U UNIQUE DESCENDING ADDITIVE FOR  .NOT. DELETED()
 D_NUM2 = D_NUM2 + 1
 ENDIF 
 REPLACE SIGN WITH (PDHM) FOR  .NOT. EMPTY(PDHM) AND EMPTY(SIGN)
 USE 
 ON ERROR 
 D_NAME2 = PUB005 + 'data12.dbf'
 M_TEMP = M9_S1('打印模板库')
 DO CASE 
 CASE M_TEMP = 2
 D_NUM2 = D_NUM2 + 1
 DO M0_S1_1 WITH 'data12' , D_NAME2 , 'data12'
 CASE M_TEMP = 3
 CLOSE DATABASES 
 DO LOADQUIT WITH 9 , 1 , '中断'
 RETURN 
 ENDCASE 
 D_NAME2 = 'data_rpt.dbf'
 M_TEMP = M9_S1('报表统计库')
 DO CASE 
 CASE M_TEMP = 2
 D_NUM2 = D_NUM2 + 1
 DO M0_S1_1 WITH 'data_rpt' , D_NAME2 , 'data_rpt'
 CASE M_TEMP = 3
 CLOSE DATABASES 
 DO LOADQUIT WITH 9 , 1 , '中断'
 RETURN 
 ENDCASE 
 D_NAME2 = 'support.dbf'
 M_TEMP = M9_S1('经销商名录')
 DO CASE 
 CASE M_TEMP = 2
 D_NUM2 = D_NUM2 + 1
 DO M0_S1_1 WITH 'support' , D_NAME2 , 'support'
 CASE M_TEMP = 3
 CLOSE DATABASES 
 DO LOADQUIT WITH 9 , 1 , '中断'
 RETURN 
 ENDCASE 
 DO DELETEMP
 D_NAME2 = PUB005 + 'data_1.dbf'
 M_TEMP = M9_S1('库存数量库')
 DO CASE 
 CASE M_TEMP = 2
 D_NUM2 = D_NUM2 + 1
 DO M0_S1_1 WITH 'data_rpt' , D_NAME2 , 'data_1'
 CASE M_TEMP = 3
 CLOSE DATABASES 
 DO LOADQUIT WITH 9 , 1 , '中断'
 RETURN 
 ENDCASE 
 D_NAME2 = PUB005 + 'data_2.dbf'
 IF FILE(D_NAME2)
 M_TEMP = M9_S1('整体成本库')
 DO CASE 
 CASE M_TEMP = 2
     delete file &d_name2
 CASE M_TEMP = 3
    CLOSE DATABASES 
    DO LOADQUIT WITH 9 , 1 , '中断'
    RETURN 
 ENDCASE 
 ENDIF 
 D_NAME2 = PUB005 + 'data_3.dbf'
 IF FILE(D_NAME2)
 M_TEMP = M9_S1('仓库成本库')
 DO CASE 
 CASE M_TEMP = 2
     delete file &d_name2
 CASE M_TEMP = 3
    CLOSE DATABASES 
    DO LOADQUIT WITH 9 , 1 , '中断'
    RETURN 
 ENDCASE 
 ENDIF 
 ON ERROR 
 IF D_NUM1 = 0
 = MESSAGEBOX('系统自我诊断完毕。未发现任何错误！',64,'信息提示')
 ELSE 
 IF D_NUM1 = D_NUM2
    = MESSAGEBOX('系统自我诊断完毕。' + CHR(13) + '发现有' + LTRIM(STR(D_NUM1)) +  ;
   '处错误，已全部修复！',64,'信息提示')
 ELSE 
    = MESSAGEBOX('系统自我诊断完毕。' + CHR(13) + '发现有' + LTRIM(STR(D_NUM1)) + '处错误，修复' +  ;
   LTRIM(STR(D_NUM2)) +  ;
   '处！',64,'信息提示')
 ENDIF 
 ENDIF 
 DO LOADQUIT WITH 9 , 1 ,  ;
      '发现：错误' + LTRIM(STR(D_NUM1)) + '处，修复' + LTRIM(STR(D_NUM2)) + '处。'
 CLOSE DATABASES 
ENDPROC
*------
PROCEDURE _quit1
 PARAMETER PAS1
 DO CASE 
 CASE PAS1 = 1
 = MESSAGEBOX('诊断工具库错误，无法进行系统的自我修复工作！',16,'信息提示')
 CASE PAS1 = 2
 = MESSAGEBOX('中断系统数据的自我诊断及修复！',48,'信息提示')
 CASE PAS1 = 3
 = MESSAGEBOX('其他用户正在使用系统数据，“自我诊断及修复”工作暂时无法进行！',16,'信息提示')
 ENDCASE 
 CLOSE DATABASES 
 DO LOADQUIT WITH 9 , 0 , '<修复>中断'
 RETURN 
ENDPROC
*------
PROCEDURE m9_s1
 PARAMETER P1
 D_JUDG1 = .T.
 ON ERROR d_judg1=.f.
 USE IN SELECT(1) SHARED '' + D_NAME2 ALIAS D_NAME2
 USE IN 'd_name2'
 D_JUDG = .T.
 ON ERROR d_judg=.f.
 USE IN SELECT(1) EXCLUSIVE '' + D_NAME2 ALIAS D_NAME2
 USE IN 'd_name2'
 IF  .NOT. D_JUDG
 IF D_JUDG1
    DO _QUIT1 WITH 3
    RETURN 3
 ENDIF 
 IF FILE(D_NAME2)
    D_NAME3 = LEFT(D_NAME2,RAT('.',D_NAME2)) + 'old'
     copy file &d_name2 to &d_name3
 ENDIF 
 D_NUM1 = D_NUM1 + 1
 IF  .NOT. EMPTY(P1)
    T0 = MESSAGEBOX('发现(' + P1 + ')错误，是否进行系统的自我修复？',35,'信息提示')
 ENDIF 
 DO CASE 
 CASE EMPTY(P1)
    = MESSAGEBOX('发现有系统数据错误，自我修复！',48,'信息提示')
 CASE T0 = 6
 CASE T0 = 7
    D_JUDG = .T.
 CASE T0 = 2
    DO _QUIT1 WITH 2
    RETURN 3
 ENDCASE 
 ENDIF 
 ON ERROR 
 IF D_JUDG
 RETURN 1
 ELSE 
 RETURN 2
 ENDIF 
ENDPROC
*------
PROCEDURE dwztcbhs
 PARAMETER M_JZRQ
 CLEAR TYPEAHEAD 
 SS = '正在按加权平均法进行“成本统计核算”工作，请稍侯…'
 MSG = CREATEOBJECT('msgbox',.F.,SS)
  MSG.SHOW
 SELECT DATA2
 SET ORDER TO hpbm
 DECIWID = ROUND(0,M.WID1)
 SELECT HPBM , HPPM , HPDW , SUM(IIF(TYPE = 4,ROUND(HPSL,M.WID1),DECIWID))  SQSL ,  ;
      SUM(IIF(TYPE = 4,HPJE,0))  SQJE ,  ;
      SUM(IIF(TYPE = 5,ROUND(HPSL,M.WID1),DECIWID))  PDSL , SUM(IIF(IO = 1,ROUND(HPSL,M.WID1),DECIWID))  RKSL ,  ;
      SUM(IIF(IO = 1,HPJE,0))  RKJE , SUM(IIF(IO = 2,ROUND(HPSL,M.WID1),DECIWID))  ;
       CKSL , SUM(IIF(IO = 2,HPJE,0))  CKJE WHERE JZRQ <= M_JZRQ GROUP BY  ;
      HPBM ORDER BY HPBM , JZRQ INTO CURSOR temp_dbf1 FROM data5
 SELECT * , SQSL + RKSL - CKSL + PDSL  JYSL , CBDJ(HPBM,SQSL,RKSL,SQJE,RKJE,CKSL,PDSL)   ;
      JYDJ INTO CURSOR TEMP_DBF2 FROM temp_dbf1
 SELECT * , JYSL * JYDJ  JYJE , PDSL * JYDJ  PDJE , CKJE - CKSL * JYDJ  XSML INTO  ;
      CURSOR TEMP_DBF FROM TEMP_DBF2
 SELECT TEMP_DBF1
 USE 
 SELECT TEMP_DBF2
 USE 
  MSG.RELEASE
 RETURN .T.
ENDPROC
*------
PROCEDURE ckflcbhs
 PARAMETER M_JZRQ
 CLEAR TYPEAHEAD 
 SELECT DATA2
 SET ORDER TO hpbm
 IF DATA0.JJFF = 1
 IF  .NOT. JQPJF(M_JZRQ)
 ENDIF 
 SELECT DATA5
 IF FLOCK()
    = PRICEWRITE(M_JZRQ)
    SELECT DATA5
    UNLOCK 
 ELSE 
    RETURN .F.
 ENDIF 
 ELSE 
 SELECT DATA5
 IF FLOCK()
    = PRICEWRITE(M_JZRQ)
    SELECT DATA5
    UNLOCK 
 ELSE 
    RETURN .F.
 ENDIF 
 ENDIF 
 SELECT TEMP_DBF
 RETURN .T.
ENDPROC
*------
PROCEDURE CBDJ
 PARAMETER M.HPBM , M.SQSL , M.RKSL , M.SQJE , M.RKJE , M.CKSL , M.PDSL
 M.JYSL = M.SQSL + M.RKSL - M.CKSL + M.PDSL
 IF M.SQSL + M.RKSL = 0
 SELECT DATA2
 SEEK M.HPBM
 IF FOUND() AND CBDJ < 99999999999.99
    M.JYDJ = CBDJ
 ELSE 
    M.JYDJ = 0
 ENDIF 
 ELSE 
 M.JYDJ = (M.SQJE + M.RKJE) / (M.SQSL + M.RKSL)
 ENDIF 
 RETURN M.JYDJ
ENDPROC
*------
PROCEDURE jqpjf
 PARAMETER MYLIMITDATE
 SS = '正在按加权平均法进行“成本核算”工作，请稍侯…'
 MSG = CREATEOBJECT('msgbox',.T.,SS)
  MSG.SHOW
 SELECT DATA2
 SET ORDER TO hpbm
 SELECT DATA5
 SET FILTER TO
 SELECT * WHERE JZRQ <= MYLIMITDATE ORDER BY HPBM , HPCK , JZRQ INTO CURSOR tmpdata5  ;
      FROM data5
 MSG.NPER = 10
 DECIWID = ROUND(0,M.WID1)
 SELECT HPBM , HPPM , HPDW , HPCK , SUM(IIF(TYPE = 4,ROUND(HPSL,M.WID1),DECIWID))  SQSL ,  ;
      SUM(IIF(TYPE = 4,ROUND(HPJE,2),0))  SQJE ,  ;
      SUM(IIF(TYPE = 5,ROUND(HPSL,M.WID1),DECIWID))  PDSL ,  ;
      SUM(IIF(IO = 1,ROUND(HPSL,M.WID1),DECIWID))  RKSL , SUM(IIF(IO = 1,ROUND(HPJE,2),0))  RKJE ,  ;
      SUM(IIF(IO = 2,ROUND(HPSL,M.WID1),DECIWID))  CKSL , SUM(IIF(IO = 2,ROUND(HPJE,2),0))   ;
      CKJE GROUP BY HPBM , HPCK ORDER BY HPBM , HPCK , JZRQ INTO CURSOR  ;
      temp_dbf1 FROM tmpdata5
 SELECT TMPDATA5
 USE 
 MSG.NPER = 50
 SELECT * , SQSL + RKSL - CKSL + PDSL  JYSL , CBDJ(HPBM,SQSL,RKSL,SQJE,RKJE,CKSL,PDSL)   ;
      JYDJ INTO CURSOR TEMP_DBF2 FROM temp_dbf1
 SELECT TEMP_DBF1
 USE 
 MSG.NPER = 100
 SELECT * , ROUND(JYSL * JYDJ,2)  JYJE , ROUND(PDSL * JYDJ,2)  PDJE ,  ;
      CKJE - ROUND(CKSL * JYDJ,2)  XSML INTO CURSOR TEMP_DBF FROM TEMP_DBF2
 SELECT TEMP_DBF2
 USE 
  MSG.RELEASE
 RETURN .T.
ENDPROC
*------
PROCEDURE hbjs
 PARAMETER M_JZRQ
 SS = '开始进行“外币折算” …'
 MSG = CREATEOBJECT('msgbox',.F.,SS)
  MSG.SHOW
 SELECT DATA5
 IF  .NOT. FLOCK()
 = MESSAGEBOX('数据正被使用，暂停进行外币折算！',48,'信息提示')
  MSG.RELEASE
 RETURN .F.
 ENDIF 
 REPLACE HPJE WITH (HPYE) FOR HPYB = M.BWBDM AND HPJE <> HPYE
 SELECT RECNO()  LINENO , DATA5.HPYE * DATA3.HBDL  HPJE WHERE  ;
      DATA5.HPYB <> M.BWBDM AND DATA5.JZRQ <= M_JZRQ INTO CURSOR TEMP_HB FROM data5 LEFT JOIN data3 ON  ;
      DATA5.HPYB = DATA3.HBDM
 SCAN 
 SCATTER MEMVAR 
 SELECT DATA5
 GO M.LINENO
 IF ISNULL(M.HPJE)
    P3_T0 =  ;
         MESSAGEBOX('外币 (' + TRIM(DATA5.HPYB) + ') 尚未进行兑率设置，是否改为 [' + M.BWBDM + '] ？',36,'信息提示')
    DO CASE 
    CASE P3_T0 = 6
       REPLACE HPYB WITH M.BWBDM , HPJE WITH HPYE
    CASE P3_T0 = 2
       UNLOCK 
       SELECT TEMP_HB
       USE 
        MSG.RELEASE
       RETURN .F.
    ENDCASE 
 ELSE 
    REPLACE HPJE WITH M.HPJE
 ENDIF 
 SELECT TEMP_HB
 ENDSCAN 
 UNLOCK 
  MSG.RELEASE
 = MESSAGEBOX('外币兑率重新折算完毕！',64,'信息提示')
 RETURN .T.
ENDPROC
*------
PROCEDURE yhdj
 IF  .NOT. SUBSTR(RIGHT006,1,1) = '1'
 = MESSAGEBOX('您无权进入本操作模块!',16,'系统提示')
 RETURN 
 ENDIF 
  MAIN.SHOWOBJECT(.F.)
 DO FORM User WITH MAIN
 RETURN 
ENDPROC
*------
PROCEDURE qxsz
 IF  .NOT. SUBSTR(RIGHT006,2,1) = '1'
 = MESSAGEBOX('您无权进入本操作模块!',16,'系统提示')
 RETURN 
 ENDIF 
  MAIN.SHOWOBJECT(.F.)
 DO FORM right WITH MAIN
  MAIN.SHOWOBJECT(.T.)
 RETURN 
ENDPROC
*------
PROCEDURE ggmm
 IF  .NOT. SUBSTR(RIGHT006,19,1) = '1'
 = MESSAGEBOX('您无权进入本操作模块!',16,'系统提示')
 RETURN 
 ENDIF 
  MAIN.SHOWOBJECT(.F.)
 DO FORM getpass WITH MAIN
  MAIN.SHOWOBJECT(.T.)
 RETURN 
ENDPROC
*------
PROCEDURE Fasz
 IF  .NOT. SUBSTR(RIGHT006,4,1) = '1'
 = MESSAGEBOX('您无权进入本操作模块!',16,'系统提示')
 RETURN 
 ENDIF 
 TEMPJUDG = .T.
 ON ERROR tempjudg=.f.
 IF USED('data0')
 SELECT DATA0
 USE 
 ENDIF 
 SELECT 0
 USE EXCLUSIVE PUB005 + 'data0'
 ON ERROR do _error0 with message()
 IF  .NOT. TEMPJUDG
 = MESSAGEBOX('网络用户正在占用系统数据 !',16,'信息提示')
 USE 
 RETURN 
 ENDIF 
 COUNT TO M9_T0
 IF M9_T0 = 0
 USE 
 = MESSAGEBOX('系统数据错误!',16,'信息提示')
 RETURN 
 ENDIF 
 GO TOP
 SCATTER MEMVAR FIELDS JCRQ , LEN1 , LEN2 , LEN3 , WID1 , WID2
 T01 = DAY(PUB004)
 DO CASE 
 CASE T01 = 28
 IF M.JCRQ <> T01
    IF MONTH(PUB004) <> 2 AND RLOCK()
       REPLACE JCRQ WITH T01
       UNLOCK 
    ENDIF 
 ENDIF 
 CASE T01 > 28
 IF M.JCRQ < 29 AND RLOCK()
    REPLACE JCRQ WITH T01
    UNLOCK 
 ENDIF 
 CASE T01 < 28
 IF M.JCRQ <> T01 AND RLOCK()
    REPLACE JCRQ WITH T01
    UNLOCK 
 ENDIF 
 ENDCASE 
  MAIN.SHOWOBJECT(.F.)
 DO FORM scheme WITH MAIN
 RETURN 
ENDPROC
*------
PROCEDURE qcsz
 IF  .NOT. SUBSTR(RIGHT006,5,1) = '1'
 = MESSAGEBOX('您无权进入本操作模块!',16,'系统提示')
 RETURN 
 ENDIF 
 IF MESSAGEBOX('在进行[期初设置]前,请确认所有其他用户均已退出系统套帐!',33,'系统提示') =  ;
2
 RETURN 
 ENDIF 
 CLOSE DATABASES 
 TEMP_J = .F.
 ON ERROR temp_j=.T.
 USE IN SELECT(1) EXCLUSIVE PUB005 + 'data5' ALIAS DATA5
 IF TEMP_J = .T.
 = MESSAGEBOX('网络用户正在占用系统数据,[期初设置]暂时无法进行!',48,'系统提示')
 CLOSE DATABASES 
 RETURN 
 ENDIF 
 ON ERROR do _error0 with message()
 USE IN SELECT(1) SHARED PUB005 + 'data2' ALIAS DATA2 ORDER hpbm
 SELECT DATA5
 INDEX ON JZRQ TO data\data5.idx FOR TYPE = 4
 COUNT TO T0
 IF T0 > 0 AND PUB001 <> PUB002
 = MESSAGEBOX('本期已有<期初数据>，须［超级用户］方可调整 !',16,'信息提示')
 CLOSE DATABASES 
 RETURN 
 ENDIF 
 IF FILE('data\temp_j10.dbf')
 USE IN SELECT(1) EXCLUSIVE data\temp_j10 ALIAS TEMP_J10
 SELECT TEMP_J10
 PACK 
 T01 = RECCOUNT()
 USE 
 SELECT DATA5
 DO CASE 
 CASE T0 > 0 AND T01 > 0
    IF MESSAGEBOX('发现上次未存盘之<期初数据>，调入?' + CHR(13) +  ;
   '是(Y)----调入上次未存盘之<期初数据>' +  ;
   CHR(13) +  ;
   '否(N)----调入系统<期初数据>',36,'信息提示') =  ;
   7
       COPY TO data\temp_j10
    ENDIF 
 CASE T01 > 0
    IF MESSAGEBOX('发现上次未存盘之<期初数据>，是否调入?',36,'信息提示') = 7
       COPY TO data\temp_j10 STRUCTURE 
    ENDIF 
 CASE T0 > 0
    COPY TO data\temp_j10
 OTHERWISE 
    COPY TO data\temp_j10 STRUCTURE 
 ENDCASE 
 ELSE 
 COPY TO data\temp_j10
 ENDIF 
 USE IN SELECT(1) EXCLUSIVE data\temp_j10 ALIAS TEMP_J10
 SELECT TEMP_J10
 INDEX ON HPBM TO data\temp_j10.idx
 GO TOP
  MAIN.SHOWOBJECT(.F.)
 DO FORM initial WITH MAIN
 RETURN 
ENDPROC
*------
PROCEDURE xesz
 IF  .NOT. SUBSTR(RIGHT006,6,1) = '1'
 = MESSAGEBOX('您无权进入本操作模块!',16,'系统提示')
 RETURN 
 ENDIF 
 IF USED('data2')
 SELECT DATA2
 ELSE 
 SELECT 0
 USE SHARED PUB005 + 'data2' ORDER hppm
 ENDIF 
 COUNT TO J
 USE 
 IF J = 0
 = MESSAGEBOX('未有货品登录 !',48,'信息提示')