📄 readernet.frm

📁 TCP/IP考勤读卡器的VB例程
💻 FRM
📖 第 1 页 / 共 3 页
字号:
上一页 1 23

Private Sub LocalIpText_Change()
Dim i, j, n, m, l As Integer
Dim Char As Byte
Dim TempStr As String
j = 0
l = 0
m = LocalIpText.SelStart
n = Len(LocalIpText.Text)
For i = 1 To n
    Char = Asc(Mid(LocalIpText.Text, i, 1))
    If Char < 48 Or Char > 57 Then
        If Char = 46 Then
            TempStr = TempStr + Chr(Char)
            j = 0
            l = 0
        End If
    Else
        j = j + 1
        If j = 4 Then
            If i < n Then
                If Asc(Mid(LocalIpText.Text, i + 1, 1)) <> 46 Then
                    m = m + 1
                    TempStr = TempStr + "."
                    j = 0
                    l = 0
                End If
            Else
                m = m + 1
                TempStr = TempStr + "."
                j = 0
                l = 0
            End If
        Else
            l = l * 10 + Char - 48
            If l > 255 Then
                m = m + 1
                TempStr = TempStr + "."
                j = 0
                l = 0
            End If
        End If
        TempStr = TempStr + Chr(Char)
    End If
Next i
n = Len(TempStr)
j = 0
l = 0
For i = 1 To n
    Char = Asc(Mid(TempStr, i, 1))
    If Char > 47 And Char < 58 Then
        l = l * 10 + Char - 48
        If l > 255 Then
            j = 4
        End If
    End If
    If Char = 46 Then
        j = j + 1
        l = 0
    End If
Next i
If j > 3 Then TempStr = OldLocalIp
LocalIpText.Text = TempStr
LocalIpText.SelStart = m
OldLocalIp = LocalIpText.Text
End Sub


Private Sub MaskText_Change()
Dim i, j, n, m, l As Integer
Dim Char As Byte
Dim TempStr As String
j = 0
l = 0
m = MaskText.SelStart
n = Len(MaskText.Text)
For i = 1 To n
    Char = Asc(Mid(MaskText.Text, i, 1))
    If Char < 48 Or Char > 57 Then
        If Char = 46 Then
            TempStr = TempStr + Chr(Char)
            j = 0
            l = 0
        End If
    Else
        j = j + 1
        If j = 4 Then
            If i < n Then
                If Asc(Mid(MaskText.Text, i + 1, 1)) <> 46 Then
                    m = m + 1
                    TempStr = TempStr + "."
                    j = 0
                    l = 0
                End If
            Else
                m = m + 1
                TempStr = TempStr + "."
                j = 0
                l = 0
            End If
        Else
            l = l * 10 + Char - 48
            If l > 255 Then
                m = m + 1
                TempStr = TempStr + "."
                j = 0
                l = 0
            End If
        End If
        TempStr = TempStr + Chr(Char)
    End If
Next i
n = Len(TempStr)
j = 0
l = 0
For i = 1 To n
    Char = Asc(Mid(TempStr, i, 1))
    If Char > 47 And Char < 58 Then
        l = l * 10 + Char - 48
        If l > 255 Then
            j = 4
        End If
    End If
    If Char = 46 Then
        j = j + 1
        l = 0
    End If
Next i
If j > 3 Then TempStr = OldMask
MaskText.Text = TempStr
MaskText.SelStart = m
OldMask = MaskText.Text

End Sub

Private Sub RemoteIpText_Change()
Dim i, j, n, m, l As Integer
Dim Char As Byte
Dim TempStr As String
j = 0
l = 0
m = RemoteIpText.SelStart
n = Len(RemoteIpText.Text)
For i = 1 To n
    Char = Asc(Mid(RemoteIpText.Text, i, 1))
    If Char < 48 Or Char > 57 Then
        If Char = 46 Then
            TempStr = TempStr + Chr(Char)
            j = 0
            l = 0
        End If
    Else
        j = j + 1
        If j = 4 Then
            If i < n Then
                If Asc(Mid(RemoteIpText.Text, i + 1, 1)) <> 46 Then
                    m = m + 1
                    TempStr = TempStr + "."
                    j = 0
                    l = 0
                End If
            Else
                m = m + 1
                TempStr = TempStr + "."
                j = 0
                l = 0
            End If
        Else
            l = l * 10 + Char - 48
            If l > 255 Then
                m = m + 1
                TempStr = TempStr + "."
                j = 0
                l = 0
            End If
        End If
        TempStr = TempStr + Chr(Char)
    End If
Next i
n = Len(TempStr)
j = 0
l = 0
For i = 1 To n
    Char = Asc(Mid(TempStr, i, 1))
    If Char > 47 And Char < 58 Then
        l = l * 10 + Char - 48
        If l > 255 Then
            j = 4
        End If
    End If
    If Char = 46 Then
        j = j + 1
        l = 0
    End If
Next i
If j > 3 Then TempStr = OldRemoteIp
RemoteIpText.Text = TempStr
RemoteIpText.SelStart = m
OldRemoteIp = RemoteIpText.Text
End Sub

Private Sub SearCommand_Click()
    Dim OutData(4) As Byte
    Dim i As Integer
    OutData(0) = 25
    OutData(1) = 118
    OutData(2) = 5
    OutData(3) = 6
    OutData(4) = 85
    i = 1
    With Winsock1
        While Mid(.LocalIP, i, 1) <> "."
            i = i + 1
        Wend
        i = i + 1
        While Mid(.LocalIP, i, 1) <> "."
            i = i + 1
        Wend
        i = i + 1
        While Mid(.LocalIP, i, 1) <> "."
            i = i + 1
        Wend
        s = Left(.LocalIP, i)
        s = s + "255"
        .RemoteHost = s
        .RemotePort = 3002
    End With
    With Winsock1
        .SendData OutData
    End With
    InfList.ListItems.Clear
'发送的数据包计数器增一
    SendPack = SendPack + 1
    Label7.Caption = Str(SendPack)
End Sub

Private Sub inflist_ColumnClick(ByVal ColumnHeaders As ColumnHeader)
   '单击 ColumnHeader 对象时，将根据
   '那一列的子项目把 ListView 控件排序。
   '设置 SortKey 为 ColumnHeader 的索引值减 1
   InfList.SortKey = ColumnHeaders.Index - 1
   InfList.SortOrder = 1 - InfList.SortOrder
   '设置 Sorted 为 True 以将列表排序。
   InfList.Sorted = True
End Sub

Private Sub SetCommand_Click()
Dim OutStr(32) As Byte
Dim i As Integer
Dim Chr As Byte
Dim TempStr As String
If ReaderIDText.Text <> "" Then
    OutStr(0) = 25
    OutStr(1) = 118
    OutStr(2) = 5
    OutStr(3) = 6
    OutStr(4) = 84
'转换读卡器设置数据
    For i = 1 To 12
        OutStr(i + 4) = Asc(Mid(ReaderIDText.Text, i, 1))
    Next i
    i = StrToByte(LocalIpText.Text)
    For i = 0 To 3
        OutStr(i + 17) = TempArray(i)
    Next i
    i = StrToByte(RemoteIpText.Text)
    For i = 0 To 3
        OutStr(i + 21) = TempArray(i)
    Next i
    i = StrToByte(GateIpText.Text)
    For i = 0 To 3
        OutStr(i + 25) = TempArray(i)
    Next i
    i = StrToByte(MaskText.Text)
    For i = 0 To 3
        OutStr(i + 29) = TempArray(i)
    Next i
    i = 1
    With Winsock1
        While Mid(.LocalIP, i, 1) <> "."
            i = i + 1
        Wend
        i = i + 1
        While Mid(.LocalIP, i, 1) <> "."
            i = i + 1
        Wend
        i = i + 1
        While Mid(.LocalIP, i, 1) <> "."
            i = i + 1
        Wend
        s = Left(.LocalIP, i)
        s = s + "255"
        .RemoteHost = s
        .RemotePort = 3002
    End With
'发送设置包
    Winsock1.SendData OutStr
'发送的数据包计数器增一
    SendPack = SendPack + 1
    Label7.Caption = Str(SendPack)
End If
End Sub

'接收到网络数据触发该事件
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim InData() As Byte
    Dim i, j As Integer
    Dim TempStr() As String
    Dim itmX As ListItem
    Dim l As Long
'接收的数据包计数器增一,并显示
    RecePack = RecePack + 1
    Label9.Caption = Str(RecePack)
'接收数据
    Winsock1.GetData InData
'判断是否是返回的应答数据
    If InData(0) = 188 Then
        i = MsgBox("设置正确!", vbOKOnly)
'判断是否返回设置数据
    ElseIf InData(0) = Asc("R") And InData(1) = Asc("N") And InData(2) = Asc("N") Then
'添加数据到列表
        With InfList
            Set itmX = .ListItems.Add(, , Chr(InData(0)) + Chr(InData(1)) + Chr(InData(2)) + Chr(InData(3)) + Chr(InData(4)) + Chr(InData(5)) + Chr(InData(6)) + Chr(InData(7)) + Chr(InData(8)) + Chr(InData(9)) + Chr(InData(10)) + Chr(InData(11)))
            itmX.ListSubItems.Add , , ByteToStr(InData(22), 10, True) + "." + ByteToStr(InData(23), 10, True) + "." + ByteToStr(InData(24), 10, True) + "." + ByteToStr(InData(25), 10, True)
            itmX.ListSubItems.Add , , ByteToStr(InData(12), 16, False) + "." + ByteToStr(InData(13), 16, False) + "." + ByteToStr(InData(14), 16, False) + "." + ByteToStr(InData(15), 16, False) + "." + ByteToStr(InData(16), 16, False) + "." + ByteToStr(InData(17), 16, False)
            itmX.ListSubItems.Add , , ByteToStr(InData(26), 10, True) + "." + ByteToStr(InData(27), 10, True) + "." + ByteToStr(InData(28), 10, True) + "." + ByteToStr(InData(29), 10, True)
            itmX.ListSubItems.Add , , ByteToStr(InData(30), 10, True) + "." + ByteToStr(InData(31), 10, True) + "." + ByteToStr(InData(32), 10, True) + "." + ByteToStr(InData(33), 10, True)
            itmX.ListSubItems.Add , , ByteToStr(InData(34), 10, True) + "." + ByteToStr(InData(35), 10, True) + "." + ByteToStr(InData(36), 10, True) + "." + ByteToStr(InData(37), 10, True)
            j = InData(18) * 256 + InData(19)
            itmX.ListSubItems.Add , , IntToStr(j, 10, True)
            j = InData(20) * 256 + InData(21)
            itmX.ListSubItems.Add , , IntToStr(j, 10, True)
        End With
'判断是否返回卡号
    ElseIf InData(0) = 25 And InData(1) = 118 And InData(2) = 5 And InData(3) = 6 And InData(4) = 87 Then
        LocalIpText.Text = Winsock1.RemoteHostIP
        RemoteIpText.Text = ""
        MaskText.Text = ""
        GateIpText.Text = ""
        ReaderIDText.Text = Chr(InData(5)) + Chr(InData(6)) + Chr(InData(7)) + Chr(InData(8)) + Chr(InData(9)) + Chr(InData(10)) + Chr(InData(11)) + Chr(InData(12)) + Chr(InData(13)) + Chr(InData(14)) + Chr(InData(15)) + Chr(InData(16))
        l = CLng(InData(18)) * 65536
        l = l + CLng(InData(19)) * 256 + CLng(InData(20))
        CardNumberText.Text = Str(l)
'应答
        If AckCheck.Value = 1 Then
            ReDim InData(0)
            InData(0) = 188
            Winsock1.SendData InData
'发送的数据包计数器增一
            SendPack = SendPack + 1
            Label7.Caption = Str(SendPack)
        End If
    End If
    
End Sub
上一页 1 23
💿 文件大小 108 K
👤 上传用户 yangw1027
📂 所属分类单片机开发
🏷️ 相关标签

#TCP #IP #读卡器
⌨️ 快捷键说明

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