📄 frmbusunpack.frm
字号:
VERSION 5.00
Begin VB.Form frmbusunpack
BorderStyle = 3 'Fixed Dialog
Caption = "数据解包"
ClientHeight = 4800
ClientLeft = 30
ClientTop = 450
ClientWidth = 8370
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4800
ScaleWidth = 8370
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton Command2
Caption = "解包(&U)"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 6960
TabIndex = 8
Top = 600
Width = 1215
End
Begin VB.FileListBox File
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3870
Left = 240
TabIndex = 7
Top = 600
Width = 4212
End
Begin VB.Frame Frame3
Caption = "数据类型"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1896
Left = 4680
TabIndex = 4
Top = 480
Width = 2052
Begin VB.OptionButton Option4
Caption = "历史数据"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 480
TabIndex = 6
Top = 960
Visible = 0 'False
Width = 1305
End
Begin VB.OptionButton Option3
Caption = "当前数据"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 480
TabIndex = 5
Top = 480
Value = -1 'True
Width = 1305
End
End
Begin VB.Frame Frame1
Caption = "操作方式"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1692
Left = 4680
TabIndex = 1
Top = 2760
Width = 2052
Begin VB.OptionButton Option1
Caption = "单个解包"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 360
TabIndex = 3
Top = 600
Width = 1212
End
Begin VB.OptionButton Option2
Caption = "全部解包"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 360
TabIndex = 2
Top = 1080
Value = -1 'True
Width = 1212
End
End
Begin VB.CommandButton Command3
Caption = "退出(&X)"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 6960
TabIndex = 0
Top = 1320
Width = 1215
End
Begin VB.Timer Timer1
Interval = 5
Left = 7320
Top = 3600
End
Begin VB.Label Label1
Caption = "数据文件列表："
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 372
Left = 240
TabIndex = 9
Top = 120
Width = 3492
End
End
Attribute VB_Name = "frmbusunpack"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mbFalg As Boolean
Dim msPCName As String
Dim pspubilcPackPathFile As String
Dim iboolean As Boolean
Dim predatetime, strlinecode, strlinecentcode As String
Dim psBusNO1 As String
Dim psLineNO As String
Dim cur_tod_snt_path As String
Dim cur_his_sh_path As String
Dim bf_tod_snt_path As String
Dim bf_his_sh_path As String
Dim rs As New ADODB.Recordset
Private Function BusUnpackToDB(psPackPathFile As String) As Boolean
Dim pbIn(0 To 31) As Byte '每条交易记录
Dim psRecordData As String
Dim piRet As Boolean
Dim psIn As String
Dim psTempPathFile As String
Dim plFileEof As Long
Dim i23boolean As Boolean
Dim i26boolean As Boolean
Dim plL As Long
Dim ssCardNO As String
Dim ssCardOrderID As String
Dim ssCardType As String
Dim ssDo As String
Dim ssBalance As Currency
Dim ssBusinessMoney As Currency
Dim ssDateTime As String
Dim ssDeviceNO As String
Dim ssBM As String
Dim ssEmpName As String
Dim ssDoType As String
Dim L As Long '字节进制
L = 256
psTempPathFile = Left(psPackPathFile, Len(psPackPathFile) - 4) + ".txt"
pspubilcPackPathFile = File.FileName
Open psPackPathFile For Binary As #1
Open psTempPathFile For Output As #2
Do While Not EOF(1)
Get #1, , pbIn
plL = 1
plFileEof = pbIn(0) * plL + pbIn(1) * plL + pbIn(2) * plL + pbIn(3) * plL + pbIn(4) * plL + pbIn(5) * plL + pbIn(6) * plL + pbIn(7) * plL
If plFileEof = 0 Then Exit Do
piRet = Hex_To_Asc(pbIn(0), psIn, 32)
Select Case pbIn(9)
Case 1, 2 '卡号（4）+卡交易流水（4）+卡类（1）+交易类型（1）+操作员编号（4）+余额（4）+交易金额（3）+交易时间（7）+设备号（3）
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
' ssBalance = Val(Mid(psIn, 27, 8)) / 100
ssBalance = pbIn(14) + pbIn(15) * L + pbIn(16) * L * L + pbIn(17) * L * L * L
' ssBusinessMoney = Val(Mid(psIn, 35, 6)) / 100
ssBusinessMoney = pbIn(18) + pbIn(19) * L + pbIn(20) * L * L
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)
ssDoType = "扣次"
If pbIn(9) = 2 Then
ssBalance = ssBalance / 100
ssBusinessMoney = ssBusinessMoney / 100
ssDoType = "扣钱"
End If
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('" & ssCardNO & "','" & ssCardType & "','" & ssEmpName & "','" _
& ssDeviceNO & "'," & ssBusinessMoney & "," & ssBalance & ",'" & ssDateTime & "','" _
& ssBM & "','" & ssDo & "','" & ssDoType & "')"
End If
Print #2, psRecordData
Case 3 '卡号（4）+卡流水（4）+卡类（1）+交易类型（1）+操作员编号（4）+保留（7，补0）+交易时间（7）+设备号（3）
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
ssBalance = 0
ssBusinessMoney = 0
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)
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('" & ssCardNO & "','" & ssCardType & "','" & ssEmpName & "','" _
& ssDeviceNO & "'," & ssBusinessMoney & "," & ssBalance & ",'" & ssDateTime & "','" _
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -