📄 pro_fun.prg

📁 酒店IC卡餐饮娱乐管理系统源代码使用说明
💻 PRG
📖 第 1 页 / 共 5 页
字号:
12 3 4 5 下一页
* -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
*  文件名: PRO_FUN.PRG <-- 本文件由 UnFoxAll 创建
* -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-



PROCEDURE windowdll
 DECLARE INTEGER GetPrivateProfileString IN Win32API AS GetPrivStr STRING , STRING ,  ;
      STRING , STRING @ , INTEGER , STRING 
 DECLARE INTEGER WritePrivateProfileString IN Win32API AS WritePrivStr STRING , STRING ,  ;
      STRING , STRING 
 DECLARE INTEGER RegOpenKeyEx IN Win32API INTEGER , STRING @ , INTEGER , INTEGER ,  ;
      INTEGER @
 DECLARE INTEGER RegQueryValueEx IN Win32API INTEGER , STRING , INTEGER , INTEGER @ ,  ;
      STRING @ , INTEGER @
 DECLARE INTEGER RegCloseKey IN Win32API INTEGER 
 DECLARE INTEGER GetProfileString IN Win32API AS GetProStr STRING , STRING , STRING ,  ;
      STRING @ , INTEGER 
ENDPROC
*------
PROCEDURE rw_mach_com
 DECLARE INTEGER mif_selecom IN rfwrcom32 INTEGER , INTEGER 
 DECLARE INTEGER mif_shake IN rfwrcom32
 DECLARE INTEGER mif_chkcom IN rfwrcom32 INTEGER 
 DECLARE INTEGER mif_selecard IN rfwrcom32 INTEGER 
 DECLARE INTEGER mif_stop IN rfwrcom32
 DECLARE INTEGER mif_init IN rfwrcom32
 DECLARE INTEGER mif_load_key IN rfwrcom32 INTEGER , STRING @ , STRING @
 DECLARE INTEGER mif_fdcard IN rfwrcom32 STRING @
 DECLARE INTEGER mif_auth IN rfwrcom32 INTEGER 
 DECLARE INTEGER mif_read IN rfwrcom32 INTEGER , STRING @
 DECLARE INTEGER mif_write IN rfwrcom32 INTEGER , STRING @
 DECLARE INTEGER mif_halt IN rfwrcom32
 DECLARE INTEGER mif_closecom IN rfwrcom32
ENDPROC
*------
PROCEDURE kq_mach_com
 DECLARE INTEGER sele_com IN lcic32 INTEGER , INTEGER 
 DECLARE INTEGER relase_com IN lcic32
 DECLARE INTEGER handshake IN lcic32 INTEGER , STRING @ , STRING @
 DECLARE INTEGER relase_hs IN lcic32
 DECLARE INTEGER modifytime IN lcic32 STRING @ , STRING @
 DECLARE INTEGER nicc_rm IN lcic32 STRING @ , STRING @
 DECLARE INTEGER nicc_rl IN lcic32 STRING @
 DECLARE INTEGER nicc_rlr IN lcic32 STRING @
 DECLARE INTEGER read_attendance IN lcic32 INTEGER @ , STRING @
 DECLARE INTEGER read_block IN lcic32 INTEGER  to 
ENDPROC
*------
PROCEDURE mif_r_card16
 PARAMETER COM , BAUD , SER_NR , BLOCK
 PRIVATE COM , BAUD , SER_NR , BLOCK , LOOPBZ1 , ERR , YESNO , AZK , NEWK , MIFKEYF ,  ;
      R_DATA , DATAF , FDDATA , FND_CARD_SER
 DO RW_MACH_COM
 = MIF_CLOSECOM()
 BAUD = 9600
 ERR = MIF_SELECOM(COM,BAUD)
 IF ERR <> 0
    RETURN ERR
 ENDIF 
 LOOPBZ1 = .T.
 DO WHILE LOOPBZ1 = .T.
    ERR = MIF_SHAKE()
    IF ERR <> 0
       YESNO = RFALERT(ERR)
       IF YESNO = 2
          = MIF_CLOSECOM()
          RETURN ERR
       ENDIF 
       LOOP 
    ENDIF 
    ERR = MIF_INIT()
    IF ERR <> 0
       YESNO = RFALERT(ERR)
       IF YESNO = 2
          = MIF_CLOSECOM()
          RETURN ERR
       ENDIF 
       LOOP 
    ENDIF 
    = MIF_SELECARD(0)
    DATEF = REPLICATE('F',16)
    ERR = MIF_FDCARD(@DATEF)
    IF ERR <> 0
       YESNO = RFALERT(ERR)
       IF YESNO = 2
          = MIF_CLOSECOM()
          RETURN ERR
       ENDIF 
       LOOP 
    ENDIF 
    ERR = MIF_AUTH(SER_NR)
    IF ERR <> 0
       YESNO = RFALERT(ERR)
       IF YESNO = 2
          = MIF_CLOSECOM()
          RETURN ERR
       ENDIF 
       LOOP 
    ENDIF 
    DATAF = REPLICATE('F',16)
    ERR = MIF_READ(BLOCK,@DATAF)
    IF ERR <> 0
       YESNO = RFALERT(ERR)
       IF YESNO = 2
          = MIF_CLOSECOM()
          RETURN ERR
       ENDIF 
       LOOP 
    ENDIF 
    R_DATA = DATAF
    R_DATA = ASCHEX(R_DATA)
    LOOPBZ1 = .F.
 ENDDO 
 = MIF_CLOSECOM()
 RETURN R_DATA
ENDPROC
*------
PROCEDURE mif_w_card16
 PARAMETER COM , BAUD , SER_NR , BLOCK , DATAF , CHANGEKEY
 PRIVATE COM , BAUD , SER_NR , KFLBZ , BLOCK , LOOPBZ1 , ERR , YESNO , DATAF , WDATA ,  ;
      FDDATA , AZKDATA , AZKBZ , FND_CARD_SER
 DO RW_MACH_COM
 WDATA = ALLTRIM(DATAF)
 WDATA = HEXCHR(WDATA)
 = MIF_CLOSECOM()
 BAUD = 9600
 ERR = MIF_SELECOM(COM,BAUD)
 IF ERR <> 0
    RETURN ERR
 ENDIF 
 LOOPBZ = .T.
 DO WHILE LOOPBZ = .T.
    ERR = MIF_SHAKE()
    IF ERR <> 0
       YESNO = RFALERT(ERR)
       IF YESNO = 2
          = MIF_CLOSECOM()
          RETURN ERR
       ENDIF 
       LOOP 
    ENDIF 
    ERR = MIF_INIT()
    IF ERR <> 0
       YESNO = RFALERT(ERR)
       IF YESNO = 2
          = MIF_CLOSECOM()
          RETURN ERR
       ENDIF 
       LOOP 
    ENDIF 
    = MIF_SELECARD(0)
    FDDATA = REPLICATE('F',16)
    ERR = MIF_FDCARD(@FDDATA)
    IF ERR <> 0
       YESNO = RFALERT(ERR)
       IF YESNO = 2
          = MIF_CLOSECOM()
          RETURN ERR
       ENDIF 
       LOOP 
    ENDIF 
    FND_CARD_SER = FDDATA
    ERR = MIF_AUTH(SER_NR)
    IF ERR <> 0
       YESNO = RFALERT(ERR)
       IF YESNO = 2
          = MIF_CLOSECOM()
          RETURN ERR
       ENDIF 
       LOOP 
    ENDIF 
    ERR = MIF_WRITE(BLOCK,@WDATA)
    IF ERR <> 0
       YESNO = RFALERT(ERR)
       IF YESNO = 2
          = MIF_CLOSECOM()
          RETURN ERR
       ENDIF 
       LOOP 
    ENDIF 
    IF CHANGEKEY = 1
       SELECT MSC
       LOCATE FOR ALLTRIM(CONT) == 'passwordA'
       KEYA = ALLTRIM(DATA)
       KEYA1 = SUBSTR(KEYA,1,8)
       KEYA1F = HEXCHR(KEYA1)
       KEYA2 = SUBSTR(KEYA,9,4) + 'FF00'
       KEYA2F = HEXCHR(KEYA2)
       KEYB1F = KEYA1F
       KEYB2F = KEYA2F
       FDDATA = REPLICATE('F',16)
       ERR = MIF_FDCARD(@FDDATA)
       IF ERR <> 0
          YESNO = RFALERT(ERR)
          IF YESNO = 2
             = MIF_CLOSECOM()
             RETURN ERR
          ENDIF 
          LOOP 
       ENDIF 
       ERR = MIF_AUTH(SER)
       IF ERR <> 0
          YESNO = RFALERT(ERR)
          IF YESNO = 2
             = MIF_CLOSECOM()
             RETURN ERR
          ENDIF 
          LOOP 
       ENDIF 
       ERR = MIF_WRITE(6,@KEYA1F)
       IF ERR <> 0
          YESNO = RFALERT(ERR)
          IF YESNO = 2
             = MIF_CLOSECOM()
             RETURN ERR
          ENDIF 
          LOOP 
       ENDIF 
       ERR = MIF_WRITE(7,@KEYA2F)
       IF ERR <> 0
          YESNO = RFALERT(ERR)
          IF YESNO = 2
             = MIF_CLOSECOM()
             RETURN ERR
          ENDIF 
          LOOP 
       ENDIF 
       FDDATA = REPLICATE('F',16)
       ERR = MIF_FDCARD(@FDDATA)
       IF ERR <> 0
          YESNO = RFALERT(ERR)
          IF YESNO = 2
             = MIF_CLOSECOM()
             RETURN ERR
          ENDIF 
          LOOP 
       ENDIF 
       DO CASE 
       CASE SER = 0
          SER_KEYB = 64
       CASE SER = 16
          SER_KEYB = 80
       CASE SER = 32
          SER_KEYB = 96
       ENDCASE 
       ERR = MIF_AUTH(SER_KEYB)
       IF ERR <> 0
          YESNO = RFALERT(ERR)
          IF YESNO = 2
             = MIF_CLOSECOM()
             RETURN ERR
          ENDIF 
          LOOP 
       ENDIF 
       ERR = MIF_WRITE(8,@KEYB1F)
       IF ERR <> 0
          YESNO = RFALERT(ERR)
          IF YESNO = 2
             = MIF_CLOSECOM()
             RETURN ERR
          ENDIF 
          LOOP 
       ENDIF 
       ERR = MIF_WRITE(9,@KEYB2F)
       IF ERR <> 0
          YESNO = RFALERT(ERR)
          IF YESNO = 2
             = MIF_CLOSECOM()
             RETURN ERR
          ENDIF 
          LOOP 
       ENDIF 
    ENDIF 
    LOOPBZ = .F.
 ENDDO 
 = MIF_CLOSECOM()
 RETURN ERR
ENDPROC
*------
PROCEDURE hexchr
 PARAMETER DATAF
 PRIVATE I , DATEF , TDATAF , RDATA , DATAM
 TDATAF = ALLTRIM(DATAF)
 RDATA = ''
 FOR I = 1 TO LEN(TDATAF) STEP 2
    DATAM = CHR(HEXDEC(SUBSTR(TDATAF,I,2)))
    RDATA = RDATA + DATAM
 ENDFOR 
 RETURN RDATA
ENDPROC
*------
PROCEDURE aschex
 PARAMETER DATAF
 PRIVATE I , DATEF , TDATAF , RDATA , DATAM
 TDATAF = ALLTRIM(DATAF)
 RDATA = ''
 FOR I = 1 TO LEN(TDATAF)
    DATAM = DECHEX(ASC(SUBSTR(TDATAF,I,1)))
    IF LEN(DATAM) < 2
       DATAM = '0' + DATAM
    ENDIF 
    RDATA = RDATA + DATAM
 ENDFOR 
 RETURN RDATA
ENDPROC
*------
PROCEDURE Init_LoadKey
 PARAMETER COM , BAUD
 PRIVATE ERR , YESNO , COM , BAUD , KEYA , KEYB
 DO RW_MACH_COM
 = MIF_CLOSECOM()
 BAUD = 9600
 ERR = MIF_SELECOM(COM,BAUD)
 IF ERR <> 0
    RETURN ERR
 ENDIF 
 ERR = MIF_SHAKE()
 IF ERR <> 0
    = MIF_CLOSECOM()
    RETURN ERR
 ENDIF 
 ERR = MIF_INIT()
 IF ERR <> 0
    = MIF_CLOSECOM()
    RETURN ERR
 ENDIF 
 CHKNUM = 9
 ERR = MIF_CHKCOM(CHKNUM)
 IF ERR <> 0
    = MIF_CLOSECOM()
    RETURN ERR
 ENDIF 
 KEYA = '407012000206'
 KEYA = HEXCHR(KEYA)
 KEYB = KEYA
 ERR = MIF_LOAD_KEY(0,@KEYA,@KEYB)
 IF ERR <> 0
    RETURN ERR
 ENDIF 
 SELECT MSC
 LOCATE FOR ALLTRIM(CONT) == 'newpasswordA'
 KEYA = ALLTRIM(DATA)
 KEYA = HEXCHR(KEYA)
 KEYB = KEYA
 ERR = MIF_LOAD_KEY(16,@KEYA,@KEYB)
 IF ERR <> 0
    RETURN ERR
 ENDIF 
 LOCATE FOR ALLTRIM(CONT) == 'passwordA'
 KEYA = ALLTRIM(DATA)
 KEYA = HEXCHR(KEYA)
 KEYB = KEYA
 ERR = MIF_LOAD_KEY(32,@KEYA,@KEYB)
 IF ERR <> 0
    = MIF_CLOSECOM()
    RETURN ERR
 ENDIF 
 = MIF_CLOSECOM()
 RETURN ERR
ENDPROC
*------
PROCEDURE single_LoadKey
 PARAMETER SER_NR
 PRIVATE ERR , KEYA , KEYB , YESNO
 DO CASE 
 CASE SER_NR = 0
    KEYA = '407012000206'
    KEYA = HEXCHR(KEYA)
    KEYB = KEYA
    ERR = MIF_LOAD_KEY(0,@KEYA,@KEYB)
    IF ERR <> 0
       RETURN ERR
    ENDIF 
 CASE SER_NR = 16
    SELECT MSC
    LOCATE FOR ALLTRIM(CONT) == 'newpasswordA'
    KEYA = ALLTRIM(DATA)
    KEYA = HEXCHR(KEYA)
    KEYB = KEYA
    ERR = MIF_LOAD_KEY(16,@KEYA,@KEYB)
    IF ERR <> 0
       RETURN ERR
    ENDIF 
 CASE SER_NR = 32
    SELECT MSC
    LOCATE FOR ALLTRIM(CONT) == 'passwordA'
    KEYA = ALLTRIM(DATA)
    KEYA = HEXCHR(KEYA)
    KEYB = KEYA
    ERR = MIF_LOAD_KEY(32,@KEYA,@KEYB)
    IF ERR <> 0
       RETURN ERR
    ENDIF 
 ENDCASE 
 RETURN ERR
ENDPROC
*------
PROCEDURE mif_stopcom
 PRIVATE LOOPBZ , ERR , YESNO
 DO RW_MACH_COM
 LOOPBZ = .T.
 DO WHILE LOOPBZ = .T.
    ERR = MIF_STOP()
    IF ERR <> 0
       YESNO = RFALERT(ERR)
       IF YESNO = 2
          RETURN 
       ENDIF 
       LOOP 
    ENDIF 
    LOOPBZ = .F.
 ENDDO 
 RETURN ERR
ENDPROC
*------
PROCEDURE mif_card_serial
 PARAMETER COM , BAUD
 PRIVATE COM , BAUD , LOOPBZ , ERR , YESNO , FDDATA , SERIAL_DATA
 DO RW_MACH_COM
 = MIF_CLOSECOM()
 BAUD = 9600
 ERR = MIF_SELECOM(COM,BAUD)
 IF ERR <> 0
    RETURN ERR
 ENDIF 
 ERR = MIF_SHAKE()
 IF ERR <> 0
    = MIF_CLOSECOM()
    RETURN ERR
 ENDIF 
 = MIF_SELECARD(0)
 FDDATA = REPLICATE('F',16)
 ERR = MIF_FDCARD(@FDDATA)
 IF ERR <> 0
    = MIF_CLOSECOM()
    RETURN ERR
 ENDIF 
 FDDATA = SUBSTR(FDDATA,1,4)
 SERIAL_DATA = ASCHEX(FDDATA)
 = MIF_CLOSECOM()
 RETURN SERIAL_DATA
ENDPROC
*------
PROCEDURE check_com
 PARAMETER COM , BAUD
 PRIVATE LOOPBZ1 , ERR , YESNO , COM , BAUD , CHKNUM , LOOPBZ2
 DO RW_MACH_COM
 = MIF_CLOSECOM()
 BAUD = 9600
 ERR = MIF_SELECOM(COM,BAUD)
 IF ERR <> 0
    RETURN ERR
 ENDIF 
 ERR = MIF_SHAKE()
 IF ERR <> 0
    = MIF_CLOSECOM()
    RETURN ERR
 ENDIF 
 ERR = MIF_INIT()
 IF ERR <> 0
    = MIF_CLOSECOM()
    RETURN ERR
 ENDIF 
 CHKNUM = 9
 ERR = MIF_CHKCOM(CHKNUM)
 IF ERR <> 0
    = MIF_CLOSECOM()
    RETURN ERR
 ENDIF 
 = MIF_CLOSECOM()
 RETURN ERR
ENDPROC
*------
PROCEDURE check_netkq_mach
 PARAMETER COM , BAUD , SLA , UC , SC
 PRIVATE SLA , US , SC , ERR , LOOPBZ , YESNO , I
 DO KQ_MACH_COM
 LOCX = _SCREEN.CURRENTX + 13
 LOCY = _SCREEN.CURRENTY + 43
 WAIT CLEAR
 WAIT WINDOW AT LOCX , LOCY NOCLEAR NOWAIT  ;
      '正在测试第 ' + ALLTRIM(STR(SLA)) + ' 台考勤机，请稍候...'
 = RELASE_HS()
 = RELASE_COM()
 ERR = SELE_COM(COM,BAUD)
 IF ERR <> 0
    WAIT CLEAR
    RETURN ERR
 ENDIF 
 FOR I = 1 TO 3
12 3 4 5 下一页
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -