pro_fun.prg

酒店IC卡 餐饮娱乐管理系统源代码使用说明

PROCEDURE check
 PARAMETER CHE
 CHE = ALLTRIM(CHE)
 PRIVATE CHE , BF , BF1 , B , B1 , B2 , I , N
 N = LEN(CHE)
 B = 0
 FOR I = 1 TO N STEP 2
    BF1 = SUBSTR(CHE,I,2)
    B1 = HEXDEC(BF1)
    B = B1 + B
    B = MOD(B,256)
 ENDFOR 
 B = 255 - B
 BF = ALLTRIM(DECHEX(B))
 IF LEN(BF) < 2
    BF = '0' + BF
 ENDIF 
 BF = RIGHT(BF,2)
 RETURN BF
ENDPROC
*------
PROCEDURE swap
 PARAMETER PT
 PT = ALLTRIM(PT)
 PRIVATE PT , SWAPF , SWAP , I
 SWAPF = ''
 FOR I = LEN(PT) - 1 TO 1 STEP -2
    SWAP = ALLTRIM(SUBSTR(PT,I,2))
    SWAPF = ALLTRIM(SWAPF + SWAP)
 ENDFOR 
 RETURN SWAPF
ENDPROC
*------
PROCEDURE netklsh
 PARAMETER DECKLSH
 PRIVATE I , LNCONT , INTDATA , MODDATA , NETKH , NETKH1 , NETKH2 , NETKH3 , NETKH4
 FOR I = 1 TO 4
    DO CASE 
    CASE I = 1
       LNCONT = 16777216
       INTDATA = INT(DECKLSH / LNCONT)
       MODDATA = MOD(DECKLSH,LNCONT)
       DECKLSH = MODDATA
       NETKH1 = CHR(INTDATA)
    CASE I = 2
       LNCONT = 65536
       INTDATA = INT(DECKLSH / LNCONT)
       MODDATA = MOD(DECKLSH,LNCONT)
       DECKLSH = MODDATA
       NETKH2 = CHR(INTDATA)
    CASE I = 3
       LNCONT = 256
       INTDATA = INT(DECKLSH / LNCONT)
       MODDATA = MOD(DECKLSH,LNCONT)
       DECKLSH = MODDATA
       NETKH3 = CHR(INTDATA)
    CASE I = 4
       LNCONT = 1
       INTDATA = INT(DECKLSH / LNCONT)
       NETKH4 = CHR(INTDATA)
    ENDCASE 
 ENDFOR 
 NETKH = NETKH4 + NETKH3 + NETKH2 + NETKH1
 RETURN NETKH
ENDPROC
*------
PROCEDURE netreturndata
 PARAMETER NETDATA
 PRIVATE I , LNCONT
 LNCONT = 0
 FOR I = 1 TO LEN(NETDATA)
    LNCONT = LNCONT + ASC(SUBSTR(NETDATA,I,1))
 ENDFOR 
 RETURN LNCONT
ENDPROC
*------
PROCEDURE hexdec
 PARAMETER HEX
 PRIVATE HEX , POWER , DEC , A , B , I
 HEX = ALLTRIM(HEX)
 POWER = 0
 DEC = 0
 FOR I = LEN(HEX) TO 1 STEP -1
    A = SUBSTR(HEX,I,1)
    B = ATC(A,'0123456789ABCDEF')
    IF B = 0
       DEC = 0
       EXIT 
    ENDIF 
    B = B - 1
    DEC = DEC + B * 16 ** POWER
    POWER = POWER + 1
 ENDFOR 
 RETURN DEC
ENDPROC
*------
PROCEDURE dechex
 PARAMETER DEC
 PRIVATE DEC , HEX , A , B , I
 HEX = ''
 IF DEC = 0
    HEX = '00'
 ENDIF 
 DO WHILE DEC > 0
    A = MOD(DEC,16) + 1
    DEC = INT(DEC / 16)
    B = ALLTRIM(SUBSTR('0123456789ABCDEF',A,1))
    HEX = ALLTRIM(B + HEX)
 ENDDO 
 RETURN HEX
ENDPROC
*------
PROCEDURE bindec
 PARAMETER BIN
 PRIVATE BIN , POWER , DEC , A , B , I
 BIN = ALLTRIM(BIN)
 POWER = 0
 DEC = 0
 FOR I = LEN(BIN) TO 1 STEP -1
    A = SUBSTR(BIN,I,1)
    B = ATC(A,'01')
    IF B = 0
       DEC = 0
       EXIT 
    ENDIF 
    B = B - 1
    DEC = DEC + B * 2 ** POWER
    POWER = POWER + 1
 ENDFOR 
 RETURN DEC
ENDPROC
*------
PROCEDURE decbin
 PARAMETER DEC
 PRIVATE DEC , BIN , A , B , I
 BIN = ''
 IF DEC = 0
    BIN = '0000'
 ENDIF 
 DO WHILE DEC > 0
    A = MOD(DEC,2) + 1
    DEC = INT(DEC / 2)
    B = ALLTRIM(SUBSTR('01',A,1))
    BIN = ALLTRIM(B + BIN)
 ENDDO 
 RETURN BIN
ENDPROC
*------
PROCEDURE hexbin
 PARAMETER HEX
 PRIVATE HEX , BIN , A , B , C , I
 HEX = ALLTRIM(HEX)
 BIN = ''
 FOR I = LEN(HEX) TO 1 STEP -1
    A = SUBSTR(HEX,I,1)
    B = ATC(A,'0123456789ABCDEF')
    B = B - 1
    DO CASE 
    CASE B = 0
       C = '0000'
    CASE B = 1
       C = '0001'
    CASE B = 2
       C = '0010'
    CASE B = 3
       C = '0011'
    CASE B = 4
       C = '0100'
    CASE B = 5
       C = '0101'
    CASE B = 6
       C = '0110'
    CASE B = 7
       C = '0111'
    CASE B = 8
       C = '1000'
    CASE B = 9
       C = '1001'
    CASE B = 10
       C = '1010'
    CASE B = 11
       C = '1011'
    CASE B = 12
       C = '1100'
    CASE B = 13
       C = '1101'
    CASE B = 14
       C = '1110'
    CASE B = 15
       C = '1111'
    OTHERWISE 
       BIN = ''
       EXIT 
    ENDCASE 
    BIN = ALLTRIM(C + BIN)
 ENDFOR 
 RETURN BIN
ENDPROC
*------
PROCEDURE binhex
 PARAMETER BIN
 PRIVATE HEX , BIN , A , B , C , I
 BIN = ALLTRIM(BIN)
 HEX = ''
 FOR I = 1 TO 4 - LEN(BIN)
    BIN = '0' + BIN
 ENDFOR 
 FOR I = LEN(BIN) - 3 TO 1 STEP -4
    A = SUBSTR(BIN,I,4)
    DO CASE 
    CASE A = '0000'
       B = '0'
    CASE A = '0001'
       B = '1'
    CASE A = '0010'
       B = '2'
    CASE A = '0011'
       B = '3'
    CASE A = '0100'
       B = '4'
    CASE A = '0101'
       B = '5'
    CASE A = '0110'
       B = '6'
    CASE A = '0111'
       B = '7'
    CASE A = '1000'
       B = '8'
    CASE A = '1001'
       B = '9'
    CASE A = '1010'
       B = 'A'
    CASE A = '1011'
       B = 'B'
    CASE A = '1100'
       B = 'C'
    CASE A = '1101'
       B = 'D'
    CASE A = '1110'
       B = 'E'
    CASE A = '1111'
       B = 'F'
    OTHERWISE 
       HEX = ''
       EXIT 
    ENDCASE 
    HEX = ALLTRIM(B + HEX)
    IF I > 1 AND I < 5
       FOR C = 1 TO 5 - I
          BIN = '0' + BIN
       ENDFOR 
       I = 5
    ENDIF 
 ENDFOR 
 RETURN HEX
ENDPROC
*------
PROCEDURE lockdb
 PARAMETER FILE_NAME
 RETURN 
ENDPROC
*------
PROCEDURE unlockdb
 PARAMETER FILE_NAME
 PRIVATE FILE_NAME , HANDLE , KEYBYTE , A , DBFDATA
 FILE_NAME = ALLTRIM(FILE_NAME)
 HANDLE = FOPEN(FILE_NAME,2)
 IF HANDLE <> -1
    = FSEEK(HANDLE,0,0)
    KEYBYTE = FREAD(HANDLE,10)
    IF KEYBYTE == REPLICATE(CHR(3),10)
       = FSEEK(HANDLE,0,0)
       A = FSEEK(HANDLE,0,2)
       = FSEEK(HANDLE,10,0)
       DBFDATA = FREAD(HANDLE,A)
       = FCHSIZE(HANDLE,0)
       = FSEEK(HANDLE,0,0)
       = FWRITE(HANDLE,DBFDATA)
    ENDIF 
    = FCLOSE(HANDLE)
 ENDIF 
 RETURN 
ENDPROC
*------
PROCEDURE xor
 PARAMETER X1 , X2
 PRIVATE X1 , X2 , F , I , A , B , C
 X1 = ALLTRIM(X1)
 X2 = ALLTRIM(X2)
 F = ''
 FOR I = 1 TO 8
    A = SUBSTR(X1,I,1)
    B = SUBSTR(X2,I,1)
    IF A == B
       C = '0'
    ELSE 
       C = '1'
    ENDIF 
    F = ALLTRIM(F + C)
 ENDFOR 
 RETURN F
ENDPROC
*------
PROCEDURE chkdbcfile
 PARAMETER GNDBC1 , GNDBC2 , GNDBC3 , GNDBC4 , GNDBC5 , GNDBC6 , GNDBC7 , GNDBC8 , GNDBC9 ,  ;
      GNDBC10 , GNDBC11 , GNDBC12 , GNDBC13 , GNDBC14 , GNDBC15 , GNDBC16 ,  ;
      GNDBC17 , GNDBC18 , GNDBC19 , GNDBC20 , GNDBC21 , GNDBC22 , GNDBC23 ,  ;
      GNDBC24 , GNDBC25 , GNDBC26 , GNDBC27 , GNDBC28 , GNDBC29 , GNDBC30 ,  ;
      GNDBC31 , GNDBC32 , GNDBC33 , GNDBC34 , GNDBC35 , GNDBC36 , GNDBC37 ,  ;
      GNDBC38 , GNDBC39 , GNDBC40 , GNDBC41 , GNDBC42 , GNDBC43 , GNDBC44 ,  ;
      GNDBC45 , GNDBC46 , GNDBC47 , GNDBC48 , GNDBC49 , GNDBC50 , GNDBC51 ,  ;
      GNDBC52 , GNDBC53 , GNDBC54 , GNDBC55 , GNDBC56 , GNDBC57 , GNDBC58 ,  ;
      GNDBC59 , GNDBC60 , GNDBC61 , GNDBC62 , GNDBC63 , GNDBC64 , GNDBC65 ,  ;
      GNDBC66 , GNDBC67 , GNDBC68 , GNDBC69 , GNDBC70
 PRIVATE I , LNCOUNT , LNFILEDBF , FILEBZ
 IF PARAMETERS() = 0
    = MESSAGEBOX('参数缺少！',64,'信息提示')
    FILEBZ = 'failed'
 ENDIF 
 LNCOUNT = PARAMETERS()
 FOR I = 1 TO LNCOUNT
    LNPARA = 'gndbc' + ALLTRIM(STR(I))
    LNFILEDBF = DBFDIRECTORY + '\' + EVALUATE(LNPARA) + '.dbf'
    IF EVALUATE(LNPARA) = 'icmsdbc'
       LNFILEDBF = DBFDIRECTORY + '\' + EVALUATE(LNPARA) + '.dbc'
    ENDIF 
    IF  .NOT. FILE(LNFILEDBF)
       = MESSAGEBOX('系统数据库缺少或不存在',64,'信息提示')
       FILEBZ = 'failed'
       EXIT 
    ENDIF 
    FILEBZ = 'succeed'
 ENDFOR 
 RETURN FILEBZ
ENDPROC
*------
PROCEDURE writedisk
 PARAMETER WRITEDIR
 PRIVATE HANDA , RESULTS
 LOOPBZ = .T.
 DO WHILE LOOPBZ = .T.
    HANDA = FCREATE(WRITEDIR + '\use.loc')
    IF HANDA = -1
       YESNO = MESSAGEBOX('磁盘不能写入数据，请检查是否写保护？',21,'信息提示')
       IF YESNO = 4
          LOOP 
       ELSE 
          = FCLOSE(HANDA)
          RESULTS = 0
       ENDIF 
    ELSE 
       = FCLOSE(HANDA)
       RESULTS = 1
    ENDIF 
    LOOPBZ = .F.
 ENDDO 
 RETURN RESULTS
ENDPROC
*------
PROCEDURE netalert
 PARAMETER CWDM
 PRIVATE CWDM , MYESNO
 DO CASE 
 CASE CWDM = 1
    MYESNO = MESSAGEBOX('通讯端口错误！',65,'信息提示')
 CASE CWDM = 2
    MYESNO = MESSAGEBOX('通讯错误！',65,'信息提示')
 CASE CWDM = 3
    MYESNO = MESSAGEBOX('区域错误！',65,'信息提示')
 CASE CWDM = 4
    MYESNO = MESSAGEBOX('数据错误！',65,'信息提示')
 CASE CWDM = 5
    MYESNO = MESSAGEBOX('通讯错误！',65,'信息提示')
 CASE CWDM = 6
    MYESNO = MESSAGEBOX('通讯错误！',65,'信息提示')
 CASE CWDM = 7
    MYESNO = MESSAGEBOX('通讯错误！',65,'信息提示')
 CASE CWDM = 8
    MYESNO = MESSAGEBOX('通讯错误！',65,'信息提示')
 CASE CWDM = 9
    MYESNO = MESSAGEBOX('通讯错误！',65,'信息提示')
 CASE CWDM = 10
    MYESNO = MESSAGEBOX('无卡！',65,'信息提示')
 CASE CWDM = 11
    MYESNO = MESSAGEBOX('卡没有上电！',65,'信息提示')
 CASE CWDM = 12
    MYESNO = MESSAGEBOX('密码错误！',65,'信息提示')
 CASE CWDM = 13
    MYESNO = MESSAGEBOX('卡片已坏！',65,'信息提示')
 CASE CWDM = 14
    MYESNO = MESSAGEBOX('函数错误！',65,'信息提示')
 OTHERWISE 
    MYESNO =  ;
         MESSAGEBOX('在读写卡因串口或连线或读写器故障系统返回不知道的错误，请检查！！！',65,'信息提示')
 ENDCASE 
 WAIT CLEAR
 RETURN MYESNO
ENDPROC
*------
PROCEDURE rfalert
 PARAMETER CWDM
 PRIVATE CWDM , MYESNO
 DO CASE 
 CASE CWDM = 1
    MYESNO =  ;
         MESSAGEBOX('端口错误，错误代码: ' + ALLTRIM(STR(CWDM)) + ' ！',65,'信息提示')
 CASE CWDM = 2
    MYESNO =  ;
         MESSAGEBOX('超时错误，错误代码: ' + ALLTRIM(STR(CWDM)) + ' ！',65,'信息提示')
 CASE CWDM = 3
    MYESNO =  ;
         MESSAGEBOX('区域错误，错误代码: ' + ALLTRIM(STR(CWDM)) + ' ！',65,'信息提示')
 CASE CWDM = 4
    MYESNO =  ;
         MESSAGEBOX('数据错误，错误代码: ' + ALLTRIM(STR(CWDM)) + ' ！',65,'信息提示')
 CASE CWDM = 5
    MYESNO =  ;
         MESSAGEBOX('通讯错误，错误代码: ' + ALLTRIM(STR(CWDM)) + ' ！',65,'信息提示')
 CASE CWDM = 6
    MYESNO =  ;
         MESSAGEBOX('通讯错误，错误代码: ' + ALLTRIM(STR(CWDM)) + ' ！',65,'信息提示')
 CASE CWDM = 7
    MYESNO =  ;
         MESSAGEBOX('通讯错误，错误代码: ' + ALLTRIM(STR(CWDM)) + ' ！',65,'信息提示')
 CASE CWDM = 8
    MYESNO =  ;
         MESSAGEBOX('通讯错误，错误代码: ' + ALLTRIM(STR(CWDM)) + ' ！',65,'信息提示')
 CASE CWDM = 9
    MYESNO =  ;
         MESSAGEBOX('通讯错误，错误代码: ' + ALLTRIM(STR(CWDM)) + ' ！',65,'信息提示')
 CASE CWDM = 10
    MYESNO =  ;
         MESSAGEBOX('无卡，错误代码: ' + ALLTRIM(STR(CWDM)) + ' ！',65,'信息提示')
 CASE CWDM = 11
    MYESNO =  ;
         MESSAGEBOX('卡没有上电，错误代码: ' + ALLTRIM(STR(CWDM)) + ' ！',65,'信息提示')
 CASE CWDM = 12
    MYESNO =  ;
         MESSAGEBOX('密码错误，错误代码: ' + ALLTRIM(STR(CWDM)) + ' ！',65,'信息提示')
 CASE CWDM = 13
    MYESNO =  ;
         MESSAGEBOX('卡片已坏，错误代码: ' + ALLTRIM(STR(CWDM)) + ' ！',65,'信息提示')
 CASE CWDM = 14
    MYESNO =  ;
         MESSAGEBOX('函数错误，错误代码: ' + ALLTRIM(STR(CWDM)) + ' ！',65,'信息提示')
 CASE CWDM = 16
    MYESNO =  ;
         MESSAGEBOX('寻卡错误，错误代码: ' + ALLTRIM(STR(CWDM)) + ' ！',65,'信息提示')
 CASE CWDM = 17
    MYESNO =  ;
         MESSAGEBOX('函数错误，错误代码: ' + ALLTRIM(STR(CWDM)) + ' ！',65,'信息提示')
 CASE CWDM = 18
    MYESNO =  ;
         MESSAGEBOX('密码错误，错误代码: ' + ALLTRIM(STR(CWDM)) + ' ！',65,'信息提示')
 CASE CWDM = 19
    MYESNO =  ;
         MESSAGEBOX('函数错误，错误代码: ' + ALLTRIM(STR(CWDM)) + ' ！',65,'信息提示')
 CASE CWDM = 20
    MYESNO =  ;
         MESSAGEBOX('函数错误，错误代码: ' + ALLTRIM(STR(CWDM)) + ' ！',65,'信息提示')
 CASE CWDM = 21
    MYESNO =  ;
         MESSAGEBOX('读写器错误，错误代码: ' + ALLTRIM(STR(CWDM)) + ' ！',65,'信息提示')
 CASE CWDM = 22
    MYESNO =  ;
         MESSAGEBOX('数据读写错误，错误代码: ' + ALLTRIM(STR(CWDM)) + ' ！',65,'信息提示')
 OTHERWISE 
    MYESNO =  ;
         MESSAGEBOX('不知道的错误，错误代码: ' + ALLTRIM(STR(CWDM)) + ' ！',65,'信息提示')
 ENDCASE 
 RETURN MYESNO
ENDPROC
*------
PROCEDURE alert
 PARAMETER CWDM
 PRIVATE CWDM , MYESNO
 DO CASE 
 CASE CWDM = 1
    MYESNO = MESSAGEBOX('数据校验错误！',65,'信息提示')
 CASE CWDM = 2
    MYESNO = MESSAGEBOX('卡片还没有插好，请重新插卡！',65,'信息提示')
 CASE CWDM = 3
    MYESNO = MESSAGEBOX('卡片未上电！',65,'信息提示')
 CASE CWDM = 4
    MYESNO = MESSAGEBOX('通讯口错误！',65,'信息提示')
 CASE CWDM = 5
    MYESNO = MESSAGEBOX('退卡错误！',65,'信息提示')
 CASE CWDM = 6
    MYESNO = MESSAGEBOX('区域错误！',65,'信息提示')
 CASE CWDM = 7
    MYESNO = MESSAGEBOX('页号错误！',65,'信息提示')