frmbusunpack.frm

一个完整的非接触IC卡会员管理系统

                        & ssBM & "','" & ssDo & "')"
            End If
            'Print #2, psRecordData
            
        Case 144, 147 '充值，充次
           
            psRecordData = psIn
            ssCardNO = Mid(psIn, 1, 8) '根据卡号查询持卡人姓名，持卡人部门
            Set rs = GetRecordset(maSys_db, "select * from 员工信息临时表 where IC卡号='" & ssCardNO & "'")
            If Not rs.EOF Then
                 ssBM = rs.Fields("部门")
                 ssEmpName = rs.Fields("员工姓名")
            Else
                 ssBM = "未知"
                 ssEmpName = "未知"
            End If
            ssCardOrderID = Mid(psIn, 9, 8)
            ssCardType = Mid(psIn, 17, 2)
            ssDo = Mid(psIn, 21, 8) '根据卡号查询司机名称
            Set rs = GetRecordset(maSys_db, "select * from 充值积分明细表 where IC卡号='" & ssDo & "'")
            If Not rs.EOF Then
                 ssDo = rs.Fields("员工编号")
            Else
                 ssDo = "未知"
            End If
            ssDateTime = Mid(psIn, 43, 4) & "-" & Mid(psIn, 47, 2) & "-" & Mid(psIn, 49, 2) & " " & Mid(psIn, 51, 2) & ":" & Mid(psIn, 53, 2) & ":" & Mid(psIn, 55, 2)
            ssDeviceNO = Mid(psIn, 57, 6)
            If pbIn(9) = 144 Then '充值
                ssBalance = pbIn(14) + pbIn(15) * L + pbIn(16) * L * L + pbIn(17) * L * L * L
                ssBusinessMoney = pbIn(18) + pbIn(19) * L + pbIn(20) * L * L
                ssBalance = ssBalance / 100
                ssBusinessMoney = ssBusinessMoney / 100
                ssDoType = "充值"
                Set rs = GetRecordset(maSys_db, "select * from 充值积分明细表 where IC卡号='" & ssCardNO & "' and 操作时间='" & ssDateTime & "' and 卡上余额=" & ssBalance)
                If rs.RecordCount = 0 Then
                    maSys_db.Execute "insert into 充值积分明细表(IC卡号,卡上余额,卡上积分,充值金额,赠送积分,操作员,操作时间,操作类型,员工编号,IC卡类)" _
                        & "values('" & Format(ssCardNO, "00000000") & "'," & ssBalance & ",0," _
                        & ssBusinessMoney & ",0,'" & ssDo & "'," & "'" & Format(ssDateTime, "yyyy-mm-dd hh:mm:ss") & "'," _
                        & "'" & ssDoType & "','" & Trim(ssEmpName) & "','" & Format(ssCardType, "00") & "')"
                End If
            Else
               Dim saddMonth As String
               saddMonth = Mid(psIn, 29, 6)
               ssBusinessMoney = pbIn(18)
               ssDoType = "充次"
               Set rs = GetRecordset(maSys_db, "select * from 充值积分明细表 where IC卡号='" & ssCardNO & "' and 操作时间='" & ssDateTime & "' and 赠送积分=" & ssBusinessMoney & " and 月份='" & saddMonth & "'")
               If rs.RecordCount = 0 Then
                    maSys_db.Execute "insert into 充值积分明细表(IC卡号,卡上余额,卡上积分,充值金额,赠送积分,操作员,操作时间,操作类型,员工编号,IC卡类,月份)" _
                        & "values('" & Format(ssCardNO, "00000000") & "'," & "0,0," _
                        & "0," & Val(ssBusinessMoney) & ",'" & ssDo & "'," & "'" & Format(ssDateTime, "yyyy-mm-dd hh:mm:ss") & "'," _
                        & "'" & ssDoType & "','" & Trim(ssEmpName) & "','" & Format(ssCardType, "00") & "','" & saddMonth & "')"
               End If
           End If
    End Select
Loop
Close #1
Close #2
BusUnpackToDB = True
End Function

'交易类型为02的记录 储值交易
Private Function RecordData2(pbIn() As Byte, psIn As String, psReturnData As String) As Boolean
                                   
Dim plCardNO As Long                 '4 hex 发行卡流水号(0-3)
Dim plOrderId  As Long               '4 bcd 卡片交易流水(4-7)
Dim piCardType As Integer            '1 hex 卡类(8)
Dim piBusinessType As Integer        '1 hex 交易类型(9)
Dim plTotalBusinessTimes As Long     '2 hex 钱包累计交易次数/线路号(10-11)
Dim plOldMoney As Long               '4 hex 原额(12-15)
Dim plBusinessMoney As Long          '3 hex 交易金额(16-18)
Dim pdDatetime  As String            '7 bcd 交易日期、交易时间(19-25)
                                     '4 MAC/设备号(26-29)
                                     '2 CRC(30-31)
Dim L As Long                        '字节进制

L = 256                              '
RecordData2 = True
If pbIn(3) > 127 Then
    RecordData2 = False
    Exit Function
End If
 
If (pbIn(0) + pbIn(1) * L + pbIn(2) * L * L + pbIn(3) * L * L * L) < 2147483647 Then '检查卡号是否大于long类型的最大值.
    plCardNO = pbIn(0) + pbIn(1) * L + pbIn(2) * L * L + pbIn(3) * L * L * L
Else
    Exit Function '如卡号出错，则记录不参与解包
End If
  
If pbIn(7) > 127 Then pbIn(7) = 0 '检查流水号是否大于long类型的最大值.
If (pbIn(4) + pbIn(5) * L + pbIn(6) * L * L + pbIn(7) * L * L * L) < 2147483647 Then
    plOrderId = pbIn(4) + pbIn(5) * L + pbIn(6) * L * L + pbIn(7) * L * L * L
Else
    plOrderId = 65535 '如卡交易流水号出错，则流水号为65535
End If
    
If pbIn(8) < 150 Then '检查卡类是否出错如出错则根据卡号取对应的卡类.
    piCardType = pbIn(8)
Else
    piCardType = getmotoristinfo(4, plCardNO)
End If
   
piBusinessType = pbIn(9) '如交易类型出错则取对应的交易类型
     
If (pbIn(10) + pbIn(11) * L) < 65535 Then '检查钱包累计交易次数是否大于FF的最大值如大于则为零.
    plTotalBusinessTimes = pbIn(10) + pbIn(11) * L
Else
    plTotalBusinessTimes = 0
End If
    
If pbIn(15) > 127 Then '卡的余额大于5000则根据该卡号在RIDE表中取最后一次交易的记录的余额否则就取合法记录
     plOldMoney = getmotoristinfo(1, plCardNO) * 100
Else
    If (pbIn(12) + pbIn(13) * L + pbIn(14) * L * L + pbIn(15) * L * L * L) < 500000 Then
        plOldMoney = pbIn(12) + pbIn(13) * L + pbIn(14) * L * L + pbIn(15) * L * L * L
    Else
        plOldMoney = getmotoristinfo(1, plCardNO) * 100
        iboolean = inserterrorlog(Now, pspubilcPackPathFile, psIn, plCardNO, 2)
    End If
End If
   
If (pbIn(16) + pbIn(17) * L + pbIn(18) * L * L) < 20000 Then '卡的交易金额不能大于2000则根据该卡号在RIDE表中取扣款记录
    plBusinessMoney = pbIn(16) + pbIn(17) * L + pbIn(18) * L * L
Else
    plBusinessMoney = getmotoristinfo(2, plCardNO) * 100
    iboolean = inserterrorlog(Now, pspubilcPackPathFile, psIn, plCardNO, 1)
End If
  
pdDatetime = Mid(psIn, 39, 4) + "-" + Mid(psIn, 43, 2) + "-" + Mid(psIn, 45, 2) + " " + Mid(psIn, 47, 2) + ":" + Mid(psIn, 49, 2) + ":" + Mid(psIn, 51, 2) '检查日期是否合法,如不合法则取上一次刷卡的交易记录
If Isdatavalues(pdDatetime) = True Then
    Isdata (pdDatetime)
    g_consumedate = pdDatetime
Else
    '取上次的交易时间
    pdDatetime = g_consumedate
    iboolean = inserterrorlog(Now, pspubilcPackPathFile, psIn, plCardNO, 0)
End If
If predatetime <> "" Then
    If pdDatetime > predatetime Then
        predatetime = pdDatetime
    End If
Else
    predatetime = pdDatetime
End If
'001036339|000000522|001|002|00002|000000240|000000040|2003-09-30 06:32:54
'33D00F00 0A020000 01 02 0200 F0000000 280000 20030930063254 0081 47569551
psReturnData = Format(plCardNO, String(9, "0")) + "|" _
             + Format(plOrderId, String(9, "0")) + "|" _
             + Format(piCardType, String(3, "0")) + "|" _
             + Format(piBusinessType, String(3, "0")) + "|" _
             + Format(plTotalBusinessTimes, String(5, "0")) + "|" _
             + Format(plOldMoney, String(9, "0")) + "|" _
             + Format(plBusinessMoney, String(9, "0")) + "|" _
             + pdDatetime
End Function

Private Function hex_to_char(pbIn() As Byte, piBeginAddr As Integer, piLen As Integer) As String
'函数功能：1字节BYTE类型的数转变成可见的字符
Dim i As Integer
For i = piBeginAddr To piBeginAddr + piLen - 1
    If pbIn(i) < 47 Or pbIn(i) > 58 Then
        hex_to_char = hex_to_char + Chr(48)
    Else
       hex_to_char = hex_to_char + Chr(pbIn(i))
    End If
Next i
End Function

Private Sub Command3_Click()
Unload Me
End Sub

Private Sub Form_Load()
On Error GoTo E

Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2

cur_tod_snt_path = App.Path & "\bakup\cur\tod\"
cur_his_sh_path = App.Path & "\bakup\cur\his\"
bf_tod_snt_path = App.Path & "\bakup\bf\tod\"
bf_his_sh_path = App.Path & "\bakup\bf\his\"
File.Path = cur_tod_snt_path
File.Pattern = "*.sct"
Exit Sub
E:
    MsgBox "系统错误:" & Error(err), vbCritical, "操作提示"
End Sub

Private Sub Command2_Click()
Dim psPathFile As String
Dim pbRet As Boolean
Dim pbTotalRet As Boolean
Dim i As Integer
If File.ListCount = 0 Then Exit Sub
Dim psR As String
pbTotalRet = True
If Option1 Then
    If File.FileName = "" Then
        MsgBox "请先点击文件名,按[确定]按钮开始解包", vbCritical, "系统信息"
        Me.MousePointer = 0
        Exit Sub
    End If
    Me.MousePointer = 11
    pbRet = Unpack
    pbTotalRet = pbTotalRet And pbRet
    Me.MousePointer = 0
End If
If Option2 Then
    Do While i < File.ListCount
        File.ListIndex = i
        Me.MousePointer = 11
        pbRet = Unpack
        pbTotalRet = pbTotalRet And pbRet
        Me.MousePointer = 0
        i = i + 1
    Loop
End If
File.Refresh
If pbTotalRet Then
    MsgBox "数据解包完成", vbInformation, "中芯德立提示信息"
End If
Exit Sub
E:
    Me.MousePointer = vbDefault
    MsgBox "系统错误:" & Error(err), vbCritical, "中芯德立提示信息"
End Sub

Private Sub Option3_Click()
File.Path = cur_tod_snt_path
File.Pattern = "*.sct"
End Sub

Private Sub Option4_Click()
File.Path = cur_his_sh_path
File.Pattern = "*.sht"
End Sub

Private Function Unpack() As Boolean
Dim psPathFile As String
Dim psBFPathFile As String
If Option3 Then
    psPathFile = cur_tod_snt_path + File.FileName
    psBFPathFile = bf_tod_snt_path + File.FileName
End If
If Option4 Then
    psPathFile = cur_his_sh_path + File.FileName
    psBFPathFile = bf_his_sh_path + File.FileName
End If

pbRet = BusUnpackToDB(psPathFile)
If Not pbRet Then MsgBox "数据解密错误", vbInformation, "中芯德立提示信息": Exit Function

FileCopy psPathFile, psBFPathFile
Kill psPathFile
Kill Left(psPathFile, Len(psPathFile) - 4) + ".txt"
Unpack = True
End Function

Private Sub Timer1_Timer()
File.Pattern = "*.dat"

For i = 0 To File.ListCount - 1
    If File.ListCount <> 0 Then
        psPCPathFile = cur_tod_snt_path + File.List(i)
        psBFPathFile = bf_tod_snt_path + File.List(i)
        Remove (psPCPathFile)
        FileCopy psPCPathFile, psBFPathFile
        Kill psPCPathFile
        File.Refresh
        i = -1
    Else
        Exit For
    End If
Next
'File.Pattern = "*.sct"
File.Pattern = "*.*"
Timer1.Enabled = False
End Sub

Private Function GetPath(psPathFile As String) As String
'取出psPathFile路径
Dim piPos As Integer
Dim piPosTemp As Integer
piPos = 1
Do While piPos <> 0
    piPosTemp = piPos
    piPos = InStr(piPos + 1, psPathFile, "\")
Loop
GetPath = Mid(psPathFile, 1, piPosTemp)
End Function

'函数功能：红外线采集的一个DAT文件分成多个数据文件
Private Function Remove(psPathFile As String)
Dim pbOut(0 To 31) As Byte
Dim plL As Long
Dim psPath As String
Dim psFile As String
Dim psSubFileName As String
Dim plSubFileLen As Double
Dim psNewFlag As String
plL = 256
psPath = GetPath(psPathFile)
psFile = LCase(Mid(psPathFile, piPosTemp + 1)) '取出psPathFile文件名
Open psPathFile For Binary As #1
Do While Not EOF(1) '分成多个文件
    psSubFileName = ""
    Get #1, , pbOut
    If pbOut(0) * plL + pbOut(1) * plL + pbOut(2) * plL + pbOut(3) * plL = 0 Then Exit Do
    psSubFileName = psSubFileName + hex_to_char(pbOut(), 0, 28)
    If InStr(psFile, "current") <> 0 Then
        psSubFileName = Trim(psSubFileName) + ".sct"
    Else
        psSubFileName = Trim(psSubFileName) + ".sht"
    End If
    plSubFileLen = pbOut(28) + pbOut(29) * plL + pbOut(30) * plL * plL + pbOut(31) * plL * plL * plL
    Open psPath + psSubFileName For Binary As #2
    For i = 1 To plSubFileLen / 32
        Get #1, , pbOut
        Put #2, , pbOut
    Next i
    Close #2
    Get #1, , pbOut
Loop
Close #1
End Function