utilite.prg

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

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



PROCEDURE mkd
 PARAMETER M_DIR
 IF FILE(M_DIR + 'nul')
    RETURN 17
 ENDIF 
 IF RIGHT(M_DIR,1) = '\'
    M_DIR = LEFT(M_DIR,LEN(M_DIR) - 1)
 ENDIF 
 M_RETU = 1
 ON ERROR m_retu=0
  mkdir &m_dir
 ON ERROR do _error0 with message()
 RETURN M_RETU
ENDPROC
*------
PROCEDURE Wreport
 PARAMETER WTITLE , REPORTFILE , WINDOWNAME , ISSUMMARY
 DEFINE WINDOW WREPORT NAME WREPORT AT 0 , 0 SIZE 20 , 20 GROW FLOAT CLOSE ZOOM TITLE  ;
      WTITLE IN (WINDOWNAME) SYSTEM 
 ZOOM WINDOW WREPORT MAX 
 IF ISSUMMARY
     report form &reportfile noco preview window wreport in wind (windowname) summary
 ELSE 
     report form &reportfile noco preview window wreport in wind (windowname)
 ENDIF 
 RELEASE WINDOW WREPORT
 RETURN 
ENDPROC
*------
PROCEDURE addsym
 PARAMETER M_INT
 MCC = ALLTRIM(STR(M_INT))
 IF AT('.',MCC) > 0
    M_N = AT('.',MCC) - 1
 ELSE 
    M_N = LEN(MCC)
 ENDIF 
 FOR I = M_N TO 2 STEP -1
    IF MOD((M_N - I),3) = 2
       MCC = STUFF(MCC,I,0,',')
    ENDIF 
 ENDFOR 
 RETURN MCC
ENDPROC
*------
PROCEDURE autoadd
 M_CC = M_CC + 1
 RETURN M_CC
ENDPROC
*------
PROCEDURE Checkdata
 IF  .NOT. USED('data3')
    USE IN SELECT(1) SHARED PUB005 + 'data3' ALIAS DATA3
 ENDIF 
 SELECT DATA3
 IF RECORDCOUNT('data3') = 0
    APPEND BLANK
    REPLACE HBMC WITH '人民币' , HBDM WITH 'RMB' , HBDL WITH 1 , HBRQ WITH DATE()
 ENDIF 
 GO TOP
 M.BWBDM = DATA3.HBDM
 RETURN 
ENDPROC
*------
PROCEDURE _shutDown
 SS = GETMAINTITLE(TITLET0)
 IF MESSAGEBOX('退出: ' + SS + ' ?',33,'信息提示') = 1
    RELEASE ALL
    CLOSE ALL
    CLEAR EVENTS 
    CLEAR ALL
 ENDIF 
 RETURN 
ENDPROC
*------
PROCEDURE Recordcount
 PARAMETER NTABLE
 OLDDBF = ALIAS()
 IF  .NOT. EMPTY(NTABLE)
     sele &ntable
 ENDIF 
 COUNT TO ABD
 IF  .NOT. EMPTY(OLDDBF)
     sele &olddbf
 ELSE 
    SELECT 0
 ENDIF 
 RETURN ABD
ENDPROC
*------
PROCEDURE Isemptyrecord
 PARAMETER M_DATA
 DIMENSION FIELDARRAY( 1 )
 = AFIELDS(FIELDARRAY)
 FOR I = 1 TO ALEN(FIELDARRAY) / 16
    IF FIELDARRAY(I,1) $ 'HPBM,HPPM,HPSL,HPYJ'
        If !empty(&fieldarray(i,1))  
       RETURN .F.
    ENDIF 
 ENDIF 
 ENDFOR 
 RETURN .T.
ENDPROC
*------
PROCEDURE endrecord
 M_CC = .T.
 IF  .NOT. EOF()
 SKIP 1
 IF  .NOT. EOF()
    M_CC = .F.
 ENDIF 
 IF  .NOT. BOF()
    SKIP -1
 ENDIF 
 ENDIF 
 IF EOF()
 GO BOTTOM
 ENDIF 
 RETURN M_CC
ENDPROC
*------
PROCEDURE beginrecord
 M_CC = .T.
 IF  .NOT. BOF()
 SKIP -1
 IF  .NOT. BOF()
    M_CC = .F.
    IF  .NOT. EOF()
       SKIP 1
    ENDIF 
 ENDIF 
 ENDIF 
 IF EOF()
 GO BOTTOM
 ENDIF 
 RETURN M_CC
ENDPROC
*------
PROCEDURE Errorevent
 ERRORNUM = ERROR()
ENDPROC
*------
PROCEDURE _error0
 PARAMETER ERRMSG
 ON ERROR m_ccc=.T.
 DO CASE 
 CASE ERROR() = 30
 RETURN 
 CASE ERROR() = 1705
 = MESSAGEBOX('不能存取文件，请检查数据库文件的属性不是只读，然后重新启动系统！',32,'信息提示')
 CLOSE DATABASES 
 ON SHUTDOWN 
 QUIT 
 RETURN 
 ENDCASE 
 T0 = GETMAINTITLE(TITLET0)
 = MESSAGEBOX(T0 + ERRMSG + '，  ' + '错误号' + STR(ERROR()) + ' ，系统退出！',16,'信息提示')
 CLOSE DATABASES 
 IF FILE(PUB005 + 'data15')
 USE IN SELECT(1) PUB005 + 'data15' ALIAS DATA15
 SELECT DATA15
 LOCATE FOR EMPTY(OUTIME) AND  .NOT. RIGHT AND USER = PUB001
 IF FOUND() AND RLOCK()
    REPLACE OUTIME WITH TIME() , CHKMEMO WITH '错误：' + ERRMSG + ' Lineno: ' + STR(189)
 ENDIF 
 ENDIF 
 ON SHUTDOWN 
 QUIT 
ENDPROC
*------
PROCEDURE _first
 PARAMETER PUB0052
 ON ERROR return .F.
 IF  .NOT. FILE(PUB005 + 'data0.dbf') AND  .NOT. FILE(PUB005 + 'data1.dbf') AND  ;
 .NOT. FILE(PUB005 + 'data2.dbf') AND  .NOT. FILE(PUB005 + 'data3.dbf') AND  ;
 .NOT. FILE(PUB005 + 'data5.dbf') AND  .NOT. FILE(PUB005 + 'data6.dbf') AND  ;
 .NOT. FILE(PUB005 + 'data7.dbf') AND  .NOT. FILE(PUB005 + 'data8.dbf') AND  ;
 .NOT. FILE(PUB005 + 'data9.dbf') AND  .NOT. FILE(PUB005 + 'data10.dbf') AND  ;
 .NOT. FILE(PUB005 + 'data11.dbf') AND  .NOT. FILE(PUB005 + 'data12.dbf') AND  ;
 .NOT. FILE(PUB005 + 'data13.dbf') AND  .NOT. FILE(PUB005 + 'data14.dbf') AND  ;
 .NOT. FILE(PUB005 + 'data15.dbf') AND  .NOT. FILE(PUB005 + 'data16.dbf') AND  ;
 .NOT. FILE(PUB005 + 'data_1.dbf') AND  .NOT. FILE(PUB005 + 'data17.dbf')
 IF  .NOT. FILE(PUB005 + 'shop_add.dbf') AND FILE(PUB0052 + 'shop_add.dbf')
    USE PUB0052 + 'shop_add'
    COPY TO PUB005 + 'shop_add.dbf'
 ENDIF 
 IF  .NOT. FILE(PUB005 + 'shop_xh.dbf') AND FILE(PUB0052 + 'shop_xh.dbf')
    USE PUB0052 + 'shop_xh'
    COPY TO PUB005 + 'shop_xh.dbf'
 ENDIF 
 IF  .NOT. FILE(PUB005 + 'shop_print.dbf') AND FILE(PUB0052 + 'shop_print.dbf')
    USE PUB0052 + 'shop_print'
    COPY TO PUB005 + 'shop_print.dbf'
 ENDIF 
 IF  .NOT. FILE(PUB005 + 'data19.dbf') AND FILE(PUB0052 + 'data19.dbf')
    USE PUB0052 + 'data19'
    COPY TO PUB005 + 'data19.dbf'
 ENDIF 
 USE PUB0052 + 'data0'
 COPY TO PUB005 + 'data0.dbf'
 USE PUB0052 + 'data1'
 COPY TO PUB005 + 'data1.dbf'
 USE PUB0052 + 'data2'
 COPY TO PUB005 + 'data2.dbf' STRUCTURE WITH CDX 
 USE PUB0052 + 'data3'
 COPY TO PUB005 + 'data3.dbf'
 USE PUB0052 + 'data4'
 COPY TO PUB005 + 'data4.dbf' WITH CDX 
 USE PUB0052 + 'data5'
 COPY TO PUB005 + 'data5.dbf' STRUCTURE WITH CDX 
 USE PUB0052 + 'data_1'
 COPY TO PUB005 + 'data_1.dbf' STRUCTURE 
 USE PUB0052 + 'data6'
 COPY TO PUB005 + 'data6.dbf'
 USE PUB0052 + 'data7'
 COPY TO PUB005 + 'data7.dbf' STRUCTURE WITH CDX 
 USE PUB0052 + 'data8'
 COPY TO PUB005 + 'data8.dbf' STRUCTURE WITH CDX 
 USE PUB0052 + 'data9'
 COPY TO PUB005 + 'data9.dbf' STRUCTURE WITH CDX 
 USE PUB0052 + 'data10'
 COPY TO PUB005 + 'data10.dbf' STRUCTURE 
 USE PUB0052 + 'data11'
 COPY TO PUB005 + 'data11.dbf' STRUCTURE WITH CDX 
 USE PUB0052 + 'data12'
 COPY TO PUB005 + 'data12.dbf'
 USE PUB0052 + 'data13'
 COPY TO PUB005 + 'data13.dbf' STRUCTURE WITH CDX 
 USE PUB0052 + 'data14'
 COPY TO PUB005 + 'data14.dbf'
 USE PUB0052 + 'data15'
 COPY TO PUB005 + 'data15.dbf'
 USE PUB0052 + 'data17'
 COPY TO PUB005 + 'data17.dbf'
 CLOSE DATABASES 
 USE PUB005 + 'data7'
 APPEND BLANK
 M.DFDW = '现金'
 M.DWTYPE = 3
 M.JUDGE = .T.
 M.NO = 'DW-001'
 M.MEMO = '自动生成'
 GATHER MEMVAR 
 APPEND BLANK
 M.DFDW = '银行存款'
 M.DWTYPE = 3
 M.JUDGE = .T.
 M.NO = 'DW-002'
 M.MEMO = '自动生成'
 GATHER MEMVAR 
 USE PUB005 + 'data0'
 GO TOP
 REPLACE JCRQ WITH 25 , BQRQ WITH DATE() - DAY(DATE()) + 25
 IF MYCOMP = '淄博光正实业有限责任公司'
    DO CASE 
    CASE TITLET0 = 1
       REPLACE D1_2 WITH '8o-rjqo.ql47dj8'
    CASE TITLET0 = 2
       REPLACE D1_2 WITH '.s-vnusevq..jn.'
    CASE TITLET0 = 3
       REPLACE D1_2 WITH '.wmzrywj-v.cpr.'
    CASE TITLET0 = 4
       REPLACE D1_2 WITH 'd-q-v-3o-3fivvd'
    CASE TITLET0 = 7
       IF TITLEV0 = 9
          REPLACE D1_2 WITH 'tkanfmgctk-ajft'
       ELSE 
          REPLACE D1_2 WITH 'pg-jbib-oex-cbp'
       ENDIF 
    CASE TITLET0 = 9
       REPLACE D1_2 WITH 'xo-rjqlhyqdgqsr'
    ENDCASE 
 ENDIF 
 USE 
 ELSE 
 = MESSAGEBOX('<系统套帐>数据已经存在 !',64,'系统提示')
 RETURN .T.
 ENDIF 
 RETURN .T.
ENDPROC
*------
PROCEDURE secjug0
 PARAMETER M_CODE
 IF TITLET0 = 5 .OR. TITLET0 = 6
 T0_0 = JUG0_3(LEFT(M.MYCOMP,30),LOWER(M.D1_2),TITLET0)
 ELSE 
 T0_0 = JUG0_5(M_CODE,M.MYCOMP,M.D1_2,M.NETNUM,TITLET0)
 ENDIF 
 DO CASE 
 CASE T0_0 = 3
 JUDGE_M0 = .T.
 M.REGSITER = .F.
 CASE T0_0 = 2
 JUDGE_M0 = .T.
 M.REGSITER = .F.
 CASE T0_0 = 1
 M.REGSITER = .T.
 JUDGE_M0 = .T.
 CASE T0_0 = -1
 IF JUG0_4(1)
    M.REGISTER = .T.
    JUDGE_M0 = .T.
 ELSE 
    M.REGSITER = .F.
    JUDGE_M0 = .F.
 ENDIF 
 OTHERWISE 
 IF JUG0_4(0)
    JUDGE_M0 = .T.
 ELSE 
    JUDGE_M0 = .F.
 ENDIF 
 M.REGSITER = .F.
 ENDCASE 
 RETURN 
ENDPROC
*------
PROCEDURE jug0_3
 PARAMETER T1 , T2 , MYTITLET0
 IF EMPTY(T1) .OR. EMPTY(T2)
 RETURN 0
 ENDIF 
 T1 = ALLTRIM(T1)
 T5 = ''
 T6 = LEN(ALLTRIM(T1))
 T2_2 = MYTITLET0 - 1
 FOR I = 1 TO 15
 DO CASE 
 CASE I > T6
    T3 = CHR(84 + I + 2)
 CASE T6 < 17
    T3 = SUBSTR(T1,I,1)
 OTHERWISE 
    IF LEN(T1) > 2 * I - 1
       T3 = SUBSTR(T1,2 * I - 1,1)
    ELSE 
       T3 = STR(LEN(T1) - 2 * I + 1,1)
    ENDIF 
 ENDCASE 
 T4 = 48 + T2_2 + MOD(ASC(T3) + 3 + (2 + I) * I + T6,75 - T2_2)
 DO CASE 
 CASE BETWEEN(T4,58,64)
    T5 = T5 + '.'
 CASE BETWEEN(T4,91,96)
    T5 = T5 + '-'
 OTHERWISE 
    T5 = T5 + CHR(T4)
 ENDCASE 
 ENDFOR 
 T5 = LOWER(T5)
 IF  .NOT. '-' $ T5
 T5 = STUFF(T5,3,1,'-')
 ENDIF 
 ON ERROR 
 IF T5 = T2
 RETURN 1
 ELSE 
 IF T5 = LEFT(T2,13) AND SUBSTR(T2,15,1) = SUBSTR(T2,1,1) AND  ;
SUBSTR(T2,14,1) = SUBSTR(T2,5,1)
    RETURN -1
 ELSE 
    RETURN 0
 ENDIF 
 ENDIF 
 RETURN 
ENDPROC
*------
PROCEDURE jug0_4
 PARAMETER T2_0
 IF FILE(PUB005 + 'data_bak.dbf')
 IF USED('data_bak')
    SELECT DATA_BAK
 ELSE 
    SELECT 0
    USE SHARED PUB005 + 'data_bak'
 ENDIF 
 CAL_TOTLE = RECCOUNT()
 IF CAL_TOTLE > 8000
    USE 
    RETURN .F.
 ELSE 
    IF T2_0 = 0 AND CAL_TOTLE > 350
       USE 
       RETURN .F.
    ENDIF 
    IF CAL_TOTLE > 1000
       USE 
       RETURN .F.
    ENDIF 
    CALCULATE FOR  .NOT. EMPTY(JZRQ) TO T2_MIN MIN ( JZRQ )
    USE 
    IF  .NOT. EMPTY(T2_MIN) AND DATE() - T2_MIN > 40 + T2_0 * 50
       RETURN .F.
    ENDIF 
 ENDIF 
 ENDIF 
 T1_MIN = DATE()
 IF  .NOT. USED('data5')
 SELECT 0
 USE SHARED PUB005 + 'data5' ALIAS DATA5
 ELSE 
 SELECT DATA5
 ENDIF 
 CAL_TOTLE = RECCOUNT()
 IF T2_0 = 0 AND CAL_TOTLE > 350
 USE 
 RETURN .F.
 ENDIF 
 IF CAL_TOTLE > 1000
 USE 
 RETURN .F.
 ENDIF 
 CALCULATE FOR  .NOT. EMPTY(JZRQ) TO T1_MIN MIN ( JZRQ )
 USE 
 IF  .NOT. EMPTY(T1_MIN) AND DATE() - T1_MIN > 40 + T2_0 * 50
 RETURN .F.
 ENDIF 
 RETURN 
ENDPROC
*------
PROCEDURE jug0_5
 PARAMETER M_CODE , M_MYCOMP , M_D1_2 , M_NETNUM , MYTITLET0
 M_MYCOMP = ALLTRIM(M_MYCOMP)
 II = AT('|',M_MYCOMP)
 IF II = 0
 II = AT(CHR(13),M_MYCOMP)
 ENDIF 
 IF II > 0
 II1 = IIF(LEN(M_MYCOMP) > 20,20,II - 1)
 IF II1 = 20
    J = 0
    FOR I = 1 TO 20
       IF ASC(SUBSTR(M_MYCOMP,I,1)) <> ASC(SUBSTR(M_MYCOMP,I,2))
          I = I + 1
       ENDIF 
    ENDFOR 
    IF I > 21
       II1 = II1 - 1
    ENDIF 
 ENDIF 
 CODE_MYCOMP = SUBSTR(M_MYCOMP,1,II1) + SUBSTR(M_MYCOMP,II + 1,40)
 ELSE 
 CODE_MYCOMP = ALLTRIM(M_MYCOMP)
 ENDIF 
 CODE_MYCOMP = LEFT(CODE_MYCOMP,40)
 WITH M_CODE  
 .TEXT = ALLTRIM(CODE_MYCOMP)
 .OLDENCRYTEDTEXT = M_D1_2
 .MYTYPE = MYTITLET0 - 1
 .MYNET = M_NETNUM
 .MYDAY = USEDAY()
 .MYSUM = SUMRECORD()
 M_RETUCODE = .ENCRYPT()
 ENDWITH 
 RETUCODE = VAL(M_RETUCODE)
 IF RETUCODE > 0
 RETURN RETUCODE
 ELSE 
 RETURN 1
 ENDIF 
 RETURN 
ENDPROC
*------
PROCEDURE Useday
 IF FILE(PUB005 + 'data_bak.dbf')
 IF USED('data_bak')
    SELECT DATA_BAK
 ELSE 
    SELECT 0
    USE SHARED PUB005 + 'data_bak'
 ENDIF 
 CAL_TOTLE = RECCOUNT()
 IF CAL_TOTLE > 8000
    USE 
    RETURN 600
 ELSE 
    IF CAL_TOTLE > 1000
       USE 
       RETURN 120
    ENDIF 
    CALCULATE FOR  .NOT. EMPTY(JZRQ) TO T2_MIN MIN ( JZRQ )
    USE 
    IF  .NOT. EMPTY(T2_MIN)
       RETURN DATE() - T2_MIN
    ENDIF 
 ENDIF 
 ELSE 
 CAL_TOTLE = 0
 ENDIF 
 T1_MIN = DATE()
 IF  .NOT. USED('data5')
 SELECT 0
 USE SHARED PUB005 + 'data5' ALIAS DATA5
 ELSE 
 SELECT DATA5
 ENDIF 
 CAL_TOTLE = CAL_TOTLE + RECCOUNT()
 IF CAL_TOTLE > 1800
 USE 
 RETURN 120
 ENDIF 
 CALCULATE FOR  .NOT. EMPTY(JZRQ) TO T1_MIN MIN ( JZRQ )
 USE 
 IF  .NOT. EMPTY(T1_MIN)
 RETURN DATE() - T1_MIN
 ELSE 
 RETURN 0
 ENDIF