📄 frmdemo.frm
字号:
'发送报文处理
Private Function DoSendDatagram1(ByRef HD8583 As HD8583STRUCT) As Boolean
m_BufferLength = Len(m_Buffer)
m_bResult = SendHD8583(HD8583, m_Buffer, m_BufferLength, True) ' 转换报文
If m_bResult Then
ReDim m_bSendData(0 To m_BufferLength - 1) As Byte
Call CopyMemory(m_bSendData(0), m_Buffer, m_BufferLength)
MSComm.InBufferCount = 0
MSComm.OutBufferCount = 0
MSComm.Output = m_bSendData
frmMain.sbStatus.Panels(2).Text = "发送报文成功"
DoSendDatagram1 = True
Else
frmMain.sbStatus.Panels(2).Text = "发送报文失败"
DoSendDatagram1 = False
End If
End Function
Private Sub MSComm_OnComm()
Dim bRecvData() As Byte
Dim nLength As Long
Dim nCommand As Long
Select Case MSComm.CommEvent
Case comEvReceive
' Sleep (10) '等待接收完数据
nLength = MSComm.InBufferCount
bRecvData = MSComm.Input '接收数据
m_BufferLength = Len(m_Buffer)
Call CopyMemory(m_Buffer, bRecvData(0), nLength)
m_Message = UnPackHD8583A(m_Buffer, m_BufferLength, nLength)
If m_Message <> -1 Then
Call DoRecvDatagram(nLength)
End If
End Select
End Sub
'接收报文处理
Private Sub DoRecvDatagram(ByVal Length As Long)
Dim DateTime As MYDATETIMESTRUCT
'响应报文清零
Call MemSet_HD(m_RspHd8583, &H0, Len(m_HD8583))
'Len(hd8583_Request) = 10076 / len(hd8583_Request) = Len(m_HD8583)
'获取请求报文
Call GetHD8583(m_Buffer, Length, m_ReqHd8583)
'校验MAC值
If IsMACValid(m_bWK(0)) Then
frmMain.sbStatus.Panels(2).Text = "MAC值正确"
Else
frmMain.sbStatus.Panels(2).Text = "MAC值错误"
Exit Sub
End If
'是终端响应报文则显示响应码
If (m_ReqHd8583.Message_Type Mod 2) = HDA_REQMESSAGEOFBACKGROUND Then
frmMain.sbStatus.Panels(2).Text = "响应码: " + CStr(m_ReqHd8583.Response_Code) + _
", 等待: " + CStr(TimerOff()) + "毫秒"
'响应码不等于RC_SUCCESS则直接退出
If m_ReqHd8583.Response_Code <> RC_SUCCESS Then
Exit Sub
End If
End If
m_RspHd8583.Message_Type = m_ReqHd8583.Message_Type
DateTime = GetDateTime
'根据信息码对报文做不同的处理
Select Case m_ReqHd8583.Message_Type
Case MT_REECHO1 '回响测试
m_RspHd8583.TerminalSN = m_ReqHd8583.TerminalSN
m_RspHd8583.Address = m_ReqHd8583.Address
m_RspHd8583.Response_Code = RC_SUCCESS
Case MT_REECHO2
Case MT_ONLINENOTICE1, MT_ONLINENOTICE2
m_RspHd8583.TerminalSN = m_ReqHd8583.TerminalSN
m_RspHd8583.Address = m_ReqHd8583.Address
m_RspHd8583.DateTime = DateTime
m_RspHd8583.Response_Code = RC_SUCCESS
m_RspHd8583.VerOfList = m_ReqHd8583.VerOfList
If CKBlistMode.Value = 1 Then
CurrentVersion = m_ReqHd8583.VerOfList '黑名单
Else
IDWCListVersion = m_ReqHd8583.VerOfList '白名单
End If
txtAddress.Text = CStr(m_ReqHd8583.Address Mod 256)
txtTerSN.Text = CStr(m_ReqHd8583.TerminalSN)
Textblist.Text = CStr(m_ReqHd8583.VerOfList)
Case MT_SETUSERDEFNUMBER2 '获取用户自定义编号
m_RspHd8583.TerminalSN = m_ReqHd8583.TerminalSN
m_RspHd8583.Address = m_ReqHd8583.Address
m_RspHd8583.Response_Code = RC_SUCCESS
Case MT_CONFIGPARA2 '获取终端参数
m_RspHd8583.TerminalSN = m_ReqHd8583.TerminalSN
m_RspHd8583.Address = m_ReqHd8583.Address
TextTermilID.Text = CStr(m_ReqHd8583.TerminalID)
txtAddress.Text = CStr(m_ReqHd8583.Address)
txtTerSN.Text = CStr(m_ReqHd8583.TerminalSN)
m_RspHd8583.Response_Code = RC_SUCCESS
If m_ReqHd8583.AdditionalData1(11) > 0 Then
CKBlistMode.Value = 1
LbVersion.Caption = "黑名单版本"
Else
CKBlistMode.Value = 0
LbVersion.Caption = "白名单版本"
End If
'脱机模式处理
If m_ReqHd8583.AdditionalData1(13) > 0 Then
chkOfflineMode.Value = 1
Else
chkOfflineMode.Value = 0
End If
Case MT_BATCHSENDRECORD2
If DealRecvRecord = RC_SUCCESS Then
'进行下次采集，先删除已采集的数据
m_nTryTimes = 4
'2006-05-22 调试时加入
If nCount > 0 Then
m_RspHd8583.Response_Code = RC_SUCCESS
m_RspHd8583.Message_Type = MT_DELETERECORD2
m_RspHd8583.Address = m_ReqHd8583.Address
m_RspHd8583.TerminalID = m_ReqHd8583.TerminalID
m_RspHd8583.LenOfAdditionalData1 = 1
m_RspHd8583.AdditionalData1(0) = nCount
m_RspHd8583.WorkKey(1) = &HFF
m_RspHd8583.WorkKey(2) = &HFF
m_RspHd8583.WorkKey(3) = &HFF
m_RspHd8583.WorkKey(4) = &HFF
m_RspHd8583.WorkKey(5) = &HFF
m_RspHd8583.WorkKey(6) = &HFF
m_RspHd8583.WorkKey(7) = &HFF
m_RspHd8583.WorkKey(0) = &HFF
Call DoSendDatagram(m_RspHd8583) '发送报文
Sleep (300) '没有翻译
If (TimerOn(frmMain.btnCollectRec, 5000)) Then
Call DoSendDatagram(m_HD8583_Bak) '发送报文
End If
End If
Else
m_nTryTimes = m_nTryTimes - 1
If (m_nTryTimes) > 0 Then
If (TimerOn(frmMain.btnCollectRec, 5000)) Then
Call DoSendDatagram(m_HD8583_Bak) '发送报文
End If
End If
End If
Case MT_UPDATELIST2 '更新黑名单
If m_ReqHd8583.VerOfList < (CurrentVersion + 10) Then
m_RspHd8583.Address = m_ReqHd8583.Address
m_RspHd8583.TerminalID = m_ReqHd8583.TerminalID
m_RspHd8583.WorkKey(1) = &HFF
m_RspHd8583.WorkKey(2) = &HFF
m_RspHd8583.WorkKey(3) = &HFF
m_RspHd8583.WorkKey(4) = &HFF
m_RspHd8583.WorkKey(5) = &HFF
m_RspHd8583.WorkKey(6) = &HFF
m_RspHd8583.WorkKey(7) = &HFF
m_RspHd8583.WorkKey(0) = &HFF
Dim Count As Long
Dim Rsend As Long
Dim CardNO As Long
Rsend = CurrentVersion - m_ReqHd8583.VerOfList + 10
For Count = 1 To Rsend Step 1
CardNO = Count + m_ReqHd8583.VerOfList
Call CopyMemory(m_HD8583.AdditionalData2(Count * 4), CardNO, 4)
Next Count
m_RspHd8583.LenOfAdditionalData3 = 1 '结束标志
If (TimerOn(btnUpdateBCList, 3500)) Then
Call DoSendDatagram(m_RspHd8583)
End If
CurrentVersion = m_ReqHd8583.VerOfList
Textblist.Text = CStr(m_ReqHd8583.VerOfList)
End If
Case MT_UPDATEIDLIST2 '更新ID黑名单
If m_ReqHd8583.VerOfList < (CurrentVersion + 10) Then
m_RspHd8583.Address = m_ReqHd8583.Address
m_RspHd8583.TerminalID = m_ReqHd8583.TerminalID
m_RspHd8583.WorkKey(1) = &HFF
m_RspHd8583.WorkKey(2) = &HFF
m_RspHd8583.WorkKey(3) = &HFF
m_RspHd8583.WorkKey(4) = &HFF
m_RspHd8583.WorkKey(5) = &HFF
m_RspHd8583.WorkKey(6) = &HFF
m_RspHd8583.WorkKey(7) = &HFF
m_RspHd8583.WorkKey(0) = &HFF
m_RspHd8583.LenOfAdditionalData3 = 1 ' 结束标志
Dim SerialNum As Long
SerialNum = 1
m_RspHd8583.LenOfAdditionalData1 = Len(SerialNum)
Call CopyMemory(m_RspHd8583.AdditionalData1(0), SerialNum, Len(SerialNum))
'Dim Count As Long
'Dim Rsend As Long
'Dim CardNO As Long
Rsend = CurrentVersion - m_ReqHd8583.VerOfList + 10
For Count = 1 To Rsend Step 1
CardNO = Count + m_ReqHd8583.VerOfList
Call CopyMemory(m_HD8583.AdditionalData2(Count * 4), CardNO, 4)
Next Count
m_RspHd8583.LenOfAdditionalData3 = 1 '结束标志
If (TimerOn(btnUpdateBCList, 3500)) Then
Call DoSendDatagram(m_RspHd8583)
End If
CurrentVersion = m_ReqHd8583.VerOfList
Textblist.Text = CStr(m_ReqHd8583.VerOfList)
End If
' Case MT_SIGNIN1 ' 签到
' m_RspHd8583.TerminalSN = m_ReqHd8583.TerminalSN
' m_RspHd8583.Address = m_ReqHd8583.Address
' Call CopyMemory(m_RspHd8583.DateTime, DateTime, Len(DateTime))
' m_RspHd8583.Response_Code = RC_SUCCESS
' m_RspHd8583.TerminalID = m_ReqHd8583.TerminalID ' 终端号
' m_RspHd8583.TERMINALTYPE = m_ReqHd8583.TERMINALTYPE ' 终端类型
' m_RspHd8583.WorkMode = m_ReqHd8583.WorkMode ' 终端工作模式
' WordMode = m_ReqHd8583.WorkMode
' m_RspHd8583.VerOfList = CurrentVersion ' 黑名单版本
' If (m_ReqHd8583.OperatorID <> 0) Then ' 操作员卡签到否
' Dim k As Integer
' For k = 0 To 7 Step 1
' m_RspHd8583.WorkKey(k) = 255
' Next k
' ' m_SignInType = SIGNINTYPE_OPRCARD
' Else
' '如果m_ReqHd8583.OperatorID 是系统操作员
' If (m_ReqHd8583.OperatorID > 10000) Then '可自定义 系统卡签到否
' ' m_SignInType = SIGNINTYPE_SYSCARD
' Else
' ' m_RspHd8583.RESPONSECODE = RC_INVALIDCARDNO
' End If
' End If
Case MT_UPDATEIDWCLIST2 ' 更新白名单
'如果没有下完，请继续.结构可以参考黑名单的处理方式
Case MT_SENDATTENDEVENT1
m_RspHd8583.TerminalSN = m_ReqHd8583.TerminalSN
m_RspHd8583.Address = m_ReqHd8583.Address
m_RspHd8583.Response_Code = RC_SUCCESS
m_RspHd8583.VerOfList = m_ReqHd8583.VerOfList
'从报文中获取卡号
TextCardNo.Text = m_ReqHd8583.CardNumber
'm_RspHd8583.DateTime
'组织日期和时间
TextDateTime.Text = CStr(m_ReqHd8583.DateTime.Year + 2000) + "-" + CStr(m_ReqHd8583.DateTime.Month) + "-" + CStr(m_ReqHd8583.DateTime.Day) + " " + CStr(m_ReqHd8583.DateTime.Hour) + ":" + CStr(m_ReqHd8583.DateTime.Minute) + ":" + CStr(m_ReqHd8583.DateTime.Second)
'从报文中获取终端地址（报文发送的机器地址）
TextID.Text = CStr(m_ReqHd8583.Address Mod 256)
txtAddress.Text = CStr(m_ReqHd8583.Address Mod 256)
Case MT_QUERY1
m_RspHd8583.TerminalSN = m_ReqHd8583.TerminalSN
m_RspHd8583.Address = m_ReqHd8583.Address
m_RspHd8583.TERMINALTYPE = m_ReqHd8583.TERMINALTYPE
'写金额
m_RspHd8583.AdditionalAmount = 12350
Dim MyName As String * 6
MyName = "张三风"
m_RspHd8583.AdditionalData4 = MyName
m_RspHd8583.LenOfAdditionalData4 = Len(MyName)
'写余额
m_RspHd8583.Response_Code = RC_SUCCESS
Case MT_TRADE1
m_RspHd8583.TerminalSN = m_ReqHd8583.TerminalSN
m_RspHd8583.Address = m_ReqHd8583.Address
'写金额
m_RspHd8583.AdditionalAmount = 2450
m_RspHd8583.Amount = m_ReqHd8583.Amount
Dim MyName1 As String * 12
MyName1 = "张三风"
m_RspHd8583.AdditionalData4 = MyName1
m_RspHd8583.LenOfAdditionalData4 = Len(MyName1)
'写余额
m_RspHd8583.Response_Code = RC_SUCCESS
End Select
'是终端请求报文则发送响应报文
If (m_ReqHd8583.Message_Type Mod 2) = HDA_REQMESSAGEOFTERMINAL Then
Call DoSendDatagram(m_RspHd8583)
End If
End Sub
Function DealRecvRecord() As Long
Dim rback As Long
Dim strFileName As String '文件名
Dim lngHandle As Long '句柄
Dim strWrite As String '要写入的文本内容
strFileName = App.Path
strFileName = strFileName + "\AttRecord.txt"
lngHandle = FreeFile() '取得句柄
'准备要写入的内容
rback = 0
nCount = 0
Select Case (m_ReqHd8583.TERMINALTYPE)
Case TERMINALTYPE_POS, TERMINALTYPE_IDPOS = &H41 'POS消费 ID卡消费终端
Dim traderecord As TRADERECORDSTRUCT
If (m_ReqHd8583.LenOfAdditionalData1 Mod Len(traderecord)) = 0 Then
'可以处理相关记录
Dim nCountPos As Integer
Dim trade As TRADERECORDSTRUCT
nCount = m_ReqHd8583.LenOfAdditionalData1 / Len(trade)
Else
DealRecvRecord = RC_DATAGRAMERROR
End If
Case TERMINALTYPE_ATTEND, TERMINALTYPE_IDATTEND '考勤
Dim attendrecord(0 To 100) As ATTENDRECORDSTRUCT
If (m_ReqHd8583.LenOfAdditionalData1 Mod Len(attendrecord(0))) = 0 Then
Dim nCountAtt As Integer
nCount = m_ReqHd8583.LenOfAdditionalData1 / Len(attendrecord(0))
Call CopyMemory(attendrecord(0), m_ReqHd8583.AdditionalData1(0), m_ReqHd8583.LenOfAdditionalData1)
strWrite = ""
For nCountAtt = 0 To nCount - 1 Step 1
strWrite = strWrite + CStr(attendrecord(nCountAtt).CardNumber) + ","
strWrite = strWrite + CStr(attendrecord(nCountAtt).TerminalID) + ","
strWrite = strWrite + CStr(attendrecord(nCountAtt).Year + 2000) + "-" + CStr(attendrecord(nCountAtt).Month) + "-" + CStr(attendrecord(nCountAtt).Day)
strWrite = strWrite + " " + CStr(attendrecord(nCountAtt).Hour) + ":" + CStr(attendrecord(nCountAtt).Minute) + ":" + CStr(attendrecord(nCountAtt).Second)
strWrite = strWrite + Chr(13) + Chr(10)
Next nCountAtt
If nCount > 0 Then
strWrite = Mid(strWrite, 1, Len(strWrite) - 2)
Open strFileName For Append As lngHandle '打开文件
Print #lngHandle, strWrite '写入文本
Close lngHandle '关闭文件
End If
Else
DealRecvRecord = RC_DATAGRAMERROR
End If
Case TERMINALTYPE_ACCESS '门禁
Dim access As ACCESSRECORDSTRUCT
If (m_ReqHd8583.LenOfAdditionalData1 Mod Len(access)) = 0 Then
Dim nCountAcc As Integer
nCount = m_ReqHd8583.LenOfAdditionalData1 / Len(access)
Else
DealRecvRecord = RC_DATAGRAMERROR
End If
End Select
DealRecvRecord = RC_SUCCESS
End Function
Function GetTerminalID() As Integer
GetTerminalID = CInt(TextTermilID.Text)
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -