utilite.prg

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

 RETURN .F.
 ENDIF 
  MAIN.SHOWOBJECT(.F.)
 DO FORM limit WITH MAIN
  MAIN.SHOWOBJECT(.T.)
 RETURN 
ENDPROC
*------
PROCEDURE hptz
 IF  .NOT. SUBSTR(RIGHT006,18,1) = '1'
 = MESSAGEBOX('您无权进入本操作模块!',16,'系统提示')
 RETURN 
 ENDIF 
  MAIN.SHOWOBJECT(.F.)
 DO FORM e_goods WITH MAIN
  MAIN.SHOWOBJECT(.T.)
 RETURN 
ENDPROC
*------
PROCEDURE sjwh
 IF  .NOT. SUBSTR(RIGHT006,8,1) = '1'
 = MESSAGEBOX('您无权进入本操作模块!',16,'系统提示')
 RETURN 
 ENDIF 
 CLOSE DATABASES 
 IF PUB000 > 2
 SS = '正在进行数据整理…'
 WAIT WINDOW AT SROWS() / 2 , (SCOLS() - LEN(ALLTRIM(SS))) / 2 NOWAIT SS
  set defa to &pub005
 DO ZHENLI WITH 'data0' , '系统设置库' , .F.
 DO ZHENLI WITH 'data1' , '职员库' , .F.
 DO ZHENLI WITH 'data2' , '货品编码库' , .T.
 DO ZHENLI WITH 'data8' , '摘要库' , .T.
 DO ZHENLI WITH 'data3' , '货币库' , .F.
 DO ZHENLI WITH 'data4' , '仓位库' , .F.
 DO ZHENLI WITH 'data10' , '门市库' , .F.
 DO ZHENLI WITH 'data7' , '客户库' , .T.
 DO ZHENLI WITH 'data13' , '产品组合模板' , .T.
 DO ZHENLI WITH 'data12' , '订单打印模板' , .F.
 DO ZHENLI WITH 'data11' , '订单数据库' , .T.
 DO ZHENLI WITH 'data5' , '本期单据库' , .T.
 DO ZHENLI WITH 'data9' , '资金帐目库' , .T.
 IF FILE('data_bak.dbf')
    DO ZHENLI WITH 'data_bak' , '已结单据库' , .F.
 ENDIF 
 DO ZHENLI WITH 'data15' , '登录监察库' , .F.
 WAIT CLEAR
 = MESSAGEBOX('整理完毕。您无权进行【数据维护】!',16,'信息提示')
 CLOSE DATABASES 
 ELSE 
  MAIN.SHOWOBJECT(.F.)
 DO FORM ma_data WITH MAIN
  MAIN.SHOWOBJECT(.T.)
 ENDIF 
 RETURN 
ENDPROC
*------
PROCEDURE dljc
 IF  .NOT. SUBSTR(RIGHT006,10,1) = '1'
 = MESSAGEBOX('您无权进入本操作模块!',16,'系统提示')
 RETURN 
 ENDIF 
  MAIN.SHOWOBJECT(.F.)
 DO FORM admin WITH MAIN
 RETURN 
ENDPROC
*------
PROCEDURE ckgl
 PARAMETER M_TYPE , ISEDIT
 MAIN.M_TYPE = M_TYPE
 MAIN.ISEDIT = ISEDIT
 IF ISEDIT
 M_PRI = M_TYPE * 2
 ELSE 
 M_PRI = M_TYPE * 2 - 1
 IF  .NOT. SUBSTR(PUB003,M_PRI,1) = '1'
    = MESSAGEBOX('您无权进入本操作模块!',16,'系统提示')
    RETURN 
 ENDIF 
 ENDIF 
 IF  .NOT. ISEDIT AND M_TYPE = 3
 IF  .NOT. USED('data4')
    USE IN SELECT(1) SHARED PUB005 + 'data4' ALIAS DATA4 ORDER 1
 ENDIF 
 IF RECORDCOUNT('data4') = 1
    = MESSAGEBOX('系统仅设有一个仓库，不可进行调库 !',16,'信息提示')
    USE IN 'data4'
    RETURN 
 ELSE 
    USE IN 'data4'
 ENDIF 
 ENDIF 
 DO CASE 
 CASE M_TYPE = 1
 M_CC = '［入库单］'
 CASE M_TYPE = 2
 M_CC = '［出库单］'
 CASE M_TYPE = 3
 M_CC = '［调库单］'
 CASE M_TYPE = 4
 M_CC = '［盘点单］'
 ENDCASE 
 CLOSE DATABASES 
 USE IN SELECT(1) SHARED PUB005 + 'shop_add' ALIAS SHOP_ADD
 USE IN SELECT(1) SHARED PUB005 + 'shop_print' ALIAS SHOP_PRINT
 USE IN SELECT(1) SHARED PUB005 + 'data0' ALIAS DATA0
 USE IN SELECT(1) SHARED PUB005 + 'data1' ALIAS DATA1
 USE IN SELECT(1) SHARED PUB005 + 'data2' ALIAS DATA2
 USE IN SELECT(1) SHARED PUB005 + 'data3' ALIAS DATA3
 USE IN SELECT(1) SHARED PUB005 + 'data4' ALIAS DATA4 ORDER 1
 USE IN SELECT(1) SHARED PUB005 + 'DATA5' ALIAS DATA5
 USE IN SELECT(1) SHARED PUB005 + 'data7' ALIAS DATA7
 USE IN SELECT(1) SHARED PUB005 + 'data8' ALIAS DATA8
 USE IN SELECT(1) SHARED PUB005 + 'DATA9' ALIAS DATA9
 USE IN SELECT(1) SHARED PUB005 + 'DATA_1' ALIAS DATA_1
 USE IN SELECT(1) SHARED stru ALIAS STRU
 IF M_TYPE < 3
 IF FILE(PUB005 + 'data11.dbf') AND  .NOT. USED('DATA11')
    USE IN SELECT(1) SHARED PUB005 + 'DATA11' ALIAS DATA11 ORDER sign_u
 ENDIF 
 ENDIF 
 IF M_TYPE < 4
 IF FILE(PUB005 + 'data13.dbf') AND  .NOT. USED('DATA13')
    USE IN SELECT(1) SHARED PUB005 + 'DATA13' ALIAS DATA13
 ENDIF 
 ENDIF 
 SELECT DATA7
 SET FILTER TO  .NOT. JUDGE
 SELECT DATA5
 DO CASE 
 CASE M_TYPE = 1
 TEMP_DBF = 'data\temp_j00'
 IF  .NOT. FILE('data\temp_j00.dbf')
    COPY TO data\temp_j00 STRUCTURE 
 ENDIF 
 CASE M_TYPE = 2
 TEMP_DBF = 'data\temp_j01'
 IF  .NOT. (FILE('data\temp_j01.dbf') AND FILE('data\temp_j01.fpt'))
    COPY TO data\temp_j01 STRUCTURE 
 ENDIF 
 CASE M_TYPE = 3
 TEMP_DBF = 'data\temp_j04'
 IF  .NOT. (FILE('data\temp_j04.dbf') AND FILE('data\temp_j04.fpt'))
    COPY TO data\temp_j04 STRUCTURE 
 ENDIF 
 CASE M_TYPE = 4
 TEMP_DBF = 'data\temp_j02'
 IF  .NOT. FILE('data\temp_j02.dbf')
    SELECT STRU
    SET FILTER TO (FIELD_DATA = 'data5' AND FIELD_NAME <> 'JLMM') .OR. FIELD_NAME = 'SL'
    COPY TO ARRAY TEMP_J9
    CREATE TABLE data\temp_j02 FROM ARRAY TEMP_J9
    SELECT TEMP_J02
    USE 
    SELECT DATA5
 ENDIF 
 ENDCASE 
 IF  .NOT. MAIN.ISEDIT
  USe  &temp_dbf excl alia temp_dbf in sele(1)
 M_T = 0
 ELSE 
 SELECT STRU
 IF M_TYPE = 4
    SET FILTER TO (FIELD_DATA = 'data5' AND FIELD_NAME <> 'JLMM') .OR. FIELD_NAME = 'SL'
 ELSE 
    SET FILTER TO FIELD_DATA = 'data5' .OR. FIELD_NAME = 'SL'
 ENDIF 
 COPY TO ARRAY TEMP_J9
 USE 
 CREATE CURSOR temp_dbf FROM ARRAY TEMP_J9
 SELECT DATA5
 DO CASE 
 CASE M_TYPE = 1
    SET ORDER TO rk
 CASE M_TYPE = 2
    SET ORDER TO ck
 CASE M_TYPE = 3
    SET ORDER TO dk
 CASE M_TYPE = 4
    SET ORDER TO pd
 ENDCASE 
 COUNT TO M_T
 GO TOP
 IF M_T = 0
    = MESSAGEBOX('没有' + M_CC + '数据',48,'信息提示')
    CLOSE DATABASES 
    RETURN 
 ENDIF 
 ENDIF 
 _TALLY = M_T
  MAIN.SHOWOBJECT(.F.)
 DO FORM datainput
 RETURN 
ENDPROC
*------
PROCEDURE mssz
 IF  .NOT. SUBSTR(RIGHT002,1,1) = '1'
 = MESSAGEBOX('您无权进入本操作模块!',16,'系统提示')
 RETURN 
 ENDIF 
 DO FORM menshi
ENDPROC
*------
PROCEDURE msxs
 IF  .NOT. SUBSTR(RIGHT002,2,1) = '1'
 = MESSAGEBOX('您无权进入本操作模块!',16,'系统提示')
 RETURN 
 ENDIF 
 CLOSE DATABASES 
 SELECT 0
 USE SHARED PUB005 + 'data10'
 COUNT TO TEMP_T1
 IF TEMP_T1 = 0
 = MESSAGEBOX('请先在门市设置模块中设定好门市',32,'门市错误')
 RETURN 
 ENDIF 
 M_MS = ''
 IF FILE('data\temp_j5.dbf')
 USE IN SELECT(1) EXCLUSIVE data\temp_j5 ALIAS TEMP_J5
 SELECT TEMP_J5
 IF RECORDCOUNT() > 0
    IF MESSAGEBOX('发现上次的门市销售数据，保留并继续登录？',33,'信息提示') = 2
       ZAP 
    ENDIF 
 ENDIF 
 IF RECORDCOUNT() > 0
    GO TOP
    IF EMPTY(HPCK)
       DO FORM msxz TO M_MS
    ELSE 
       M.HPCK = ALLTRIM(HPCK)
       SELECT DATA10
       LOCATE FOR ALLTRIM(CK) == M.HPCK
       IF FOUND()
          M_MS = MS
       ELSE 
          DO FORM msxz TO M_MS
       ENDIF 
    ENDIF 
 ELSE 
    DO FORM msxz TO M_MS
 ENDIF 
 ELSE 
 DO FORM msxz TO M_MS
 ENDIF 
 IF EMPTY(M_MS)
 RETURN 
 ENDIF 
 DO FORM msxs WITH M_MS
 RETURN 
ENDPROC
*------
PROCEDURE cbhs
 IF  .NOT. SUBSTR(RIGHT003,4,1) = '1'
 = MESSAGEBOX('您无权进入本操作模块!',16,'系统提示')
 RETURN 
 ENDIF 
 ON ERROR do _error0 with message()
 SS = '正在进行货品 [编码] 校验…'
 MSG = CREATEOBJECT('msgbox',.F.,SS)
  MSG.SHOW
 CLOSE DATABASES 
 USE IN SELECT(1) SHARED PUB005 + 'data4' ALIAS DATA4 ORDER 1
 USE IN SELECT(1) SHARED PUB005 + 'data3' ALIAS DATA3
 USE IN SELECT(1) SHARED PUB005 + 'data0' ALIAS DATA0
 USE IN SELECT(1) SHARED PUB005 + 'data2' ALIAS DATA2
 USE IN SELECT(1) SHARED PUB005 + 'data5' ALIAS DATA5
 SELECT DATA5
 IF FLOCK()
 DELETE ALL FOR HPSL = 0
 UNLOCK 
 ENDIF 
 SELECT 0
 USE EXCLUSIVE data_rpt
 ZAP 
 IF FILE(PUB005 + 'data_3.dbf')
 APPEND FROM PUB005 + 'data_3.dbf'
 ENDIF 
  MSG.RELEASE
  MAIN.SHOWOBJECT(.F.)
 DO FORM cbhs
 RETURN 
ENDPROC
*------
PROCEDURE ydjz
 IF  .NOT. SUBSTR(RIGHT006,11,1) = '1'
 = MESSAGEBOX('您无权进入本操作模块!',16,'系统提示')
 RETURN 
 ENDIF 
 CLOSE DATABASES 
 USE IN SELECT(1) SHARED PUB005 + 'data4' ALIAS DATA4 ORDER 1
 USE IN SELECT(1) SHARED PUB005 + 'data0' ALIAS DATA0
 USE IN SELECT(1) SHARED PUB005 + 'data2' ALIAS DATA2
 USE IN SELECT(1) SHARED PUB005 + 'data5' ALIAS DATA5
 SS = '正在进行<仓库>校验…'
 MSG = CREATEOBJECT('msgbox',.F.,SS)
  MSG.SHOW
 SELECT DATA4
 IF FLOCK()
 SELECT DATA5.HPCK  HPCK1 , DATA4.HPCK  HPCK2 INTO CURSOR temp_ck DISTINCT FROM data5  ;
      LEFT JOIN data4 ON DATA5.HPCK = DATA4.HPCK
 SCAN 
    SCATTER MEMVAR 
    IF ISNULL(M.HPCK2)
       SELECT DATA4
       APPEND BLANK
       REPLACE HPCK WITH M.HPCK1
    ENDIF 
    SELECT TEMP_CK
 ENDSCAN 
 USE 
 SELECT DATA4
 UNLOCK 
 ENDIF 
 MSG.CAPTION = '正在进行货品 [编码] 核验，请稍侯…'
 SELECT DATA2
 IF FLOCK()
 SELECT DATA5.HPBM , DATA5.HPPM , DATA5.HPDW , DATA2.CBDJ INTO CURSOR temp_hpbm  ;
      DISTINCT FROM data5 LEFT JOIN data2 ON DATA5.HPBM = DATA2.HPBM
 SCAN 
    SCATTER MEMVAR 
    IF ISNULL(M.CBDJ)
       SELECT DATA2
       APPEND BLANK
       REPLACE HPBM WITH M.HPBM , HPPM WITH M.HPPM , HPDW WITH M.HPDW
    ENDIF 
    SELECT TEMP_HPBM
 ENDSCAN 
 USE 
 SELECT DATA2
 UNLOCK 
 ENDIF 
 MSG.CAPTION = '正在进行货品 [品名] 校验，请稍侯...'
 SELECT DATA5
 IF FLOCK()
 REPLACE HPJE WITH HPYE FOR HPYB = M.BWBDM AND HPJE <> HPYE
 SELECT RECNO()  LINENO , DATA2.HPPM , DATA2.HPDW WHERE DATA5.HPPM <> DATA2.HPPM INTO  ;
      CURSOR temp_bm FROM data5 LEFT JOIN data2 ON DATA5.HPBM = DATA2.HPBM
 SCAN 
    SCATTER MEMVAR 
    SELECT DATA5
    GO M.LINENO
    REPLACE HPPM WITH M.HPPM , HPDW WITH M.HPDW
    SELECT TEMP_BM
 ENDSCAN 
 USE 
 SELECT DATA5
 UNLOCK 
 ENDIF 
  MSG.RELEASE
 IF  .NOT. USED('data_rpt')
 USE IN SELECT(1) EXCLUSIVE data_rpt ALIAS DATA_RPT
 ENDIF 
 SELECT DATA_RPT
 ZAP 
 IF FILE(PUB005 + 'data_3.dbf')
 APPEND FROM PUB005 + 'data_3.dbf'
 ENDIF 
  MAIN.SHOWOBJECT(.F.)
 DO FORM jz WITH MAIN
 RETURN 
ENDPROC
*------
PROCEDURE ydfjz
 IF  .NOT. SUBSTR(RIGHT006,12,1) = '1'
 = MESSAGEBOX('您无权进入本操作模块!',16,'系统提示')
 RETURN 
 ENDIF 
 IF  .NOT. FILE(PUB005 + 'DATA_BAK.DBF')
 = MESSAGEBOX('系统尚未有已结转单据。',48,'信息提示')
 RETURN 
 ENDIF 
 = MESSAGEBOX('“反结转”：将上期<结转单据>逆向返回 !',64,'信息提示')
 IF TITLET0 = 2
 IF MESSAGEBOX('系统“反结转”前，须中止所有其它工作站的操作 !',33,'信息提示') = 2
    RETURN .F.
 ENDIF 
 ENDIF 
  MAIN.SHOWOBJECT(.F.)
 DO FORM fjz TO ISOK
 IF ISOK
 = MESSAGEBOX('系统“本期年月”已发生改变!',64,'系统提示')
 MAIN.SB.PANELS( 2 ).TEXT =  ;
      '本期：  ' + ALLTRIM(STR(YEAR(PUB004))) + ' 年 ' + ALLTRIM(STR(MONTH(PUB004))) +  ;
' 月'
 ENDIF 
 RETURN 
ENDPROC
*------
PROCEDURE chkbreak
 IF CHRSAW()
 T0 = INKEY()
 CLEAR TYPEAHEAD 
 IF T0 = 3 .OR. T0 = 17
    WAIT CLEAR
    IF MESSAGEBOX('是否中断 ... ?',36,'信息提示') = 6
       RETURN .T.
    ENDIF 
 ENDIF 
 ENDIF 
 RETURN .F.
ENDPROC
*------
PROCEDURE PriceWrite
 PARAMETER MYWRITEDATE
 DO CASE 
 CASE DATA0.JJFF = 1
 SS = '正在按加权平均法进行“销售成本价”计算，请稍侯…'
 MSG = CREATEOBJECT('msgbox',.T.,SS)
  MSG.SHOW
 M.NOWREC = 0
 MSG.NPER = 0
 SELECT DATA5
 SET FILTER TO JZRQ <= MYWRITEDATE
 INDEX ON HPBM + HPCK TO data\data5.idx FOR IO = 2
 GO TOP
 SELECT TEMP_DBF
 M.TOLREC = RECCOUNT()
 SCAN 
    M.NOWREC = M.NOWREC + 1
    MSG.NPER = (M.NOWREC / M.TOLREC) * 100
    SELECT DATA5
    I = 0
    SCAN REST WHILE HPBM = TEMP_DBF.HPBM AND HPCK = TEMP_DBF.HPCK
       REPLACE CBDJ WITH TEMP_DBF.JYDJ , HPCB WITH CBDJ * HPSL
       I = 1
    ENDSCAN 
    IF I = 0
       SCAN REST WHILE HPBM < TEMP_DBF.HPBM AND HPCK < TEMP_DBF.HPCK
       ENDSCAN 
    ENDIF 
    SELECT TEMP_DBF
 ENDSCAN 
 SELECT DATA5
 INDEX ON JZRQ TO data\data5.idx
 SET FILTER TO
 SET ORDER TO jzrq
  MSG.RELEASE
 RETURN 
 CASE DATA0.JJFF = 2
 SS = '正在按移动平均法进行“销售成本价”计算，请稍侯…'
 MSG = CREATEOBJECT('msgbox',.T.,SS)
  MSG.SHOW
 M.NOWREC = 0
 MSG.NPER = 0
 SELECT DATA5
 INDEX ON HPBM + HPCK + DTOC(JZRQ) TO data\data5.idx FOR  ;
      IO <> 3 AND JZRQ <= MYWRITEDATE
 GO TOP
 SELECT HPBM , HPCK , HPYJ GROUP BY HPBM , HPCK INTO TABLE data\temp_dbf1.dbf DISTINCT  ;
      FROM data5
 SELECT TEMP_DBF1
 M.TOLREC = RECCOUNT()
 SCAN 
    M.NOWREC = M.NOWREC + 1
    MSG.NPER = (M.NOWREC / M.TOLREC) * 100
    I = 0
    M.JYSL = 0
    M.JYDJ = 0
    SELECT DATA2
    SEEK TEMP_DBF1.HPBM
    IF FOUND()
       IF CBDJ < 9999999999.99
          M.JYDJ = CBDJ
       ELSE 
          M.JYDJ = 0
          = MESSAGEBOX('编码[' + ALLTRIM(HPBM) + '] 的参考成本价错误,请注意修改!',48,'信息提示')
       ENDIF 
    ENDIF 
    SELECT DATA5
    SCAN REST WHILE HPBM = TEMP_DBF1.HPBM AND HPCK = TEMP_DBF1.HPCK
       DO CASE 
       CASE TYPE = 5
          M.JYSL = M.JYSL + HPSL
       CASE IO = 1 .OR. TYPE = 4
          IF M.JYSL + HPSL <> 0
             M.JYDJ = (M.JYDJ * M.JYSL + HPJE) / (M.JYSL + HPSL)
          ENDIF 
          M.JYSL = M.JYSL + HPSL
       CASE IO = 2
          M.JYSL = M.JYSL - HPSL
          REPLACE CBDJ WITH M.JYDJ , HPCB WITH M.JYDJ * HPSL
       ENDCASE 
       I = 1
    ENDSCAN 
    IF I = 0
       SCAN REST WHILE HPBM < TEMP_DBF1.HPBM AND HPCK < TEMP_DBF1.HPCK
       ENDSCAN 
    ENDIF 
    SELECT TEMP_DBF1
    REPLACE HPYJ WITH M.JYDJ
 ENDSCAN 
 CASE DATA0.JJFF = 3 .OR. DATA0.JJFF = 4
 IF DATA0.JJFF = 3
    SS = '正在按先进先出法进行“销售成本价”计算，请稍侯…'
 ELSE 
    SS = '正在按后进先出法进行“销售成本价”计算，请稍侯…'
 ENDIF 
 MSG = CREATEOBJECT('msgbox',.T.,SS)
  MSG.SHOW
 M.NOWREC = 0
 MSG.NPER = 0
 SELECT DATA5
 SET FILTER TO JZRQ <= MYWRITEDATE
 REPLACE CBDJ WITH (HPSL) FOR TYPE = 4 .OR. TYPE = 5 .OR. IO = 1
 REPLACE CBDJ WITH 0 , HPCB WITH (0) FOR IO = 2
 INDEX ON HPBM + HPCK + DTOC(JZRQ) TO data\data5.idx FOR HPSL <> 0 AND IO <> 3
 GO TOP
 SELECT DATA2
 GO TOP
 M.HPBM = ''
 SEL