formone.frm

控制mg500读卡器进行卡片号码的筛选

            MultiLine       =   -1  'True
            ScrollBars      =   3  'Both
            TabIndex        =   28
            Top             =   240
            Width           =   2535
         End
      End
   End
   Begin VB.Frame F1 
      Caption         =   "读卡器操作"
      Height          =   7935
      Left            =   2400
      TabIndex        =   5
      Top             =   240
      Visible         =   0   'False
      Width           =   9255
      Begin VB.Frame Frame3 
         Caption         =   "操作状态"
         Height          =   3135
         Left            =   3360
         TabIndex        =   13
         Top             =   360
         Width           =   5655
         Begin VB.TextBox TextStatus 
            Height          =   2775
            Left            =   120
            MultiLine       =   -1  'True
            TabIndex        =   14
            Top             =   240
            Width           =   5415
         End
      End
      Begin VB.Frame Frame2 
         Caption         =   "控制"
         Height          =   3135
         Left            =   240
         TabIndex        =   8
         Top             =   360
         Width           =   2895
         Begin VB.CommandButton M1_exit 
            BackColor       =   &H00E0E0E0&
            Caption         =   "断开读卡器"
            Height          =   375
            Left            =   480
            MaskColor       =   &H00E0E0E0&
            TabIndex        =   11
            Top             =   2280
            Visible         =   0   'False
            Width           =   1935
         End
         Begin VB.CommandButton M1_init 
            Caption         =   "连接读卡器"
            Height          =   375
            Left            =   480
            TabIndex        =   10
            Top             =   1560
            Width           =   1935
         End
         Begin VB.ComboBox CbCom 
            Height          =   300
            Left            =   480
            TabIndex        =   9
            Text            =   "3"
            Top             =   840
            Width           =   1935
         End
         Begin VB.Label Label1 
            Caption         =   "请选择串口"
            Height          =   255
            Left            =   480
            TabIndex        =   12
            Top             =   480
            Width           =   975
         End
      End
   End
   Begin VB.Label Lb 
      Height          =   375
      Index           =   1
      Left            =   6840
      TabIndex        =   34
      Top             =   5040
      Width           =   3495
   End
End
Attribute VB_Name = "FormOne"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim akey(6) As Byte
Dim bkey(6) As Byte
Dim hexkey As String * 12
Dim displaydata(8) As Byte
Dim eepromdata As String * 32
Dim hardver As String * 20
Dim libver As String * 16
Dim ser As String * 16
Dim Snr As Long
Dim Snr1 As Long
Dim Snr2 As Long
Dim Rsnr As Long
Dim data16 As String * 16
Dim data32 As String * 32
Dim databuff32 As String * 32
Dim DataBuu As String
Dim DataBuu1 As String
Dim ReaderStatus As Boolean
Dim datasnr(16) As String
Dim databuff16 As String * 16
Dim rvalue As Long
Dim wvalue As Long
Dim mlrvalue As Integer
Dim mlwvalue As Integer
Dim cardmode As Integer
Dim loadmode As Integer
Dim sector As Integer
Dim address As Integer
Dim ptrdest As String * 16
Dim ptrsource As String * 16
Dim time As String * 14
Dim timebuff As String * 14
Dim ComLoop As Integer
Dim CardSum As Integer
Dim CardMun As Integer


Private Sub CmdChange_Click()
    Dim abc()     As String
    Dim rowabc()     As String
    Dim abcd As String
    Dim i As Integer
    Dim j As Integer
    Dim h As Integer
    
'On Error GoTo FileErr

    If Data1.Recordset.BOF Then '清空会议签到表中的数据
    Else
    Data1.Recordset.MoveFirst
        If Data1.Recordset.EOF Then
        Else
            Do Until Data1.Recordset.EOF
                Data1.Recordset.Delete
                Data1.Recordset.MoveNext
            Loop
        End If
    End If
    
    abc = Split(RTB1.Text, vbCrLf) '这样就将每一行信息附到数组里了.
    
    For i = 0 To UBound(abc)
        rowabc = Split(abc(i), vbTab) '这样就将第N行的信息附到数组里
        Data1.Recordset.AddNew
        For j = 0 To UBound(rowabc)
            Data1.Recordset(j + 1) = rowabc(j)
        Next j
        Data1.Recordset.Update
    Next i
    
    Data1.Recordset.MoveFirst
    
    Text1(1).Text = "数据录入" & Data1.Recordset.RecordCount & vbCrLf & Text1(1).Text
    
    MsgBox "批量输入完毕！"
    Exit Sub
FileErr:
    Text1(1).Text = "数据录入" & Data1.Recordset.RecordCount & vbCrLf & Text1(1).Text
End Sub

Private Sub CmdOpenText_Click()

On Error GoTo ErrFile
    CD1.ShowOpen
    RTB1.LoadFile CD1.FileName
    MsgBox "打开成功！"
    Exit Sub
ErrFile:
    MsgBox "打开失败！"
End Sub

Private Sub ComCheck_Click(Index As Integer)

    Dim ii As Double
    
On Error GoTo FileErr

    Select Case Index
    
        Case 0
            If T(4).Text > Data1.Recordset(2) Then
                Do Until Data1.Recordset.EOF Or T(4).Text <= Data1.Recordset(2)
                    Data1.Recordset.MoveNext
                Loop
                If T(4).Text = Data1.Recordset(2) Then
                    T(5).Text = Data1.Recordset(1)
                    T(4).Text = Data1.Recordset(2)
                    T(3).Text = Data1.Recordset(3)
                    Text1(0).Text = "数据已经找到！" & vbCrLf & Text1(0).Text
                Else
                    T(5).Text = ""
                    T(4).Text = Data1.Recordset(2)
                    T(3).Text = "" 'Data1.Recordset(3)
                    Text1(0).Text = "数据没有找到！" & vbCrLf & Text1(0).Text
                End If
            Else
                Do Until Data1.Recordset.BOF Or T(4).Text >= Data1.Recordset(2)
                    Data1.Recordset.MovePrevious
                Loop
                If T(4).Text = Data1.Recordset(2) Then
                    T(5).Text = Data1.Recordset(1)
                    T(4).Text = Data1.Recordset(2)
                    T(3).Text = Data1.Recordset(3)
                    Text1(0).Text = "数据已经找到！" & vbCrLf & Text1(0).Text
                Else
                    T(5).Text = ""
                    T(4).Text = Data1.Recordset(2)
                    T(3).Text = "" 'Data1.Recordset(3)
                    Text1(0).Text = "数据没有找到！" & vbCrLf & Text1(0).Text
                End If
            End If
            
        Case 1
            If T(3).Text > Data1.Recordset(3) Then
                Do Until Data1.Recordset.EOF Or T(3).Text <= Data1.Recordset(3)
                    Data1.Recordset.MoveNext
                Loop
                If T(3).Text = Data1.Recordset(3) Then
                    T(5).Text = Data1.Recordset(1)
                    T(4).Text = Data1.Recordset(2)
                    T(3).Text = Data1.Recordset(3)
                    Text1(0).Text = "数据已经找到！" & vbCrLf & Text1(0).Text
                Else
                    T(5).Text = ""
                    T(4).Text = "" 'Data1.Recordset(2)
                    T(3).Text = Data1.Recordset(3)
                    Text1(0).Text = "数据没有找到！" & vbCrLf & Text1(0).Text
                End If
            Else
                Do Until Data1.Recordset.BOF Or T(3).Text >= Data1.Recordset(3)
                    Data1.Recordset.MovePrevious
                Loop
                If T(3).Text = Data1.Recordset(3) Then
                    T(5).Text = Data1.Recordset(1)
                    T(4).Text = Data1.Recordset(2)
                    T(3).Text = Data1.Recordset(3)
                    Text1(0).Text = "数据已经找到！" & vbCrLf & Text1(0).Text
                Else
                    T(5).Text = ""
                    T(4).Text = "" 'Data1.Recordset(2)
                    T(3).Text = Data1.Recordset(3)
                    Text1(0).Text = "数据没有找到！" & vbCrLf & Text1(0).Text
                End If
            End If
    End Select
    Exit Sub
FileErr:
    T(5).Text = ""
    T(4).Text = "" 'Data1.Recordset(2)
    T(3).Text = "" 'Data1.Recordset(3)

    Text1(0).Text = "数据没有找到！" & vbCrLf & Text1(0).Text

End Sub

Private Sub Command1_Click(Index As Integer)
    Select Case Index
        Case 0
            Frame_No
            CbCom.AddItem ("1")
            CbCom.AddItem ("2")
            CbCom.AddItem ("3")
            CbCom.AddItem ("4")
            CbCom.AddItem ("5")
            CbCom.AddItem ("6")
            CbCom.AddItem ("7")
            ComLoop = CbCom.Text
            F1.Visible = True
        Case 1
            Frame_No
            F2.Visible = True
        Case 2
            Frame_No
            F3.Visible = True
        Case 4
            Frame_No
            F4.Visible = True
        Case 3
            quit
            Frame_No
            End
    End Select
    status
End Sub
Private Sub Frame_No()
    F1.Visible = False
    F2.Visible = False
    F3.Visible = False
    F4.Visible = False
End Sub
Private Sub status()
    If ReaderStatus = True Then
        SBar1.Panels(1).Text = "读写器已经连接"
    Else
        SBar1.Panels(1).Text = "读写器没有连接"
    End If
    If Timer2.Enabled = True Then
        SBar1.Panels(2).Text = "初始化进行状态"
'        ComSample.Enabled = False
    Else
        SBar1.Panels(2).Text = "初始化停止状态"
'        ComSample.Enabled = True
    End If
    
End Sub

Private Sub Command2_Click(Index As Integer)
    Select Case Index
        Case 0
            Text1(0).Text = ""
        Case 1
            Text1(1).Text = ""
        Case 2
            If Len(TextMima(0).Text) <> 12 Then
                MsgBox "装载密码长度不够6个字节！"
                Exit Sub
            End If
            Text1(0).Text = "读卡器开始工作，进入写数据状态！" & vbCrLf & Text1(0).Text
            Timer2.Enabled = True
    End Select
    status
End Sub

Private Sub Command3_Click()

    Dim i As Double
    Dim ii As Double
    Dim j As Double
    Dim k As Double
    Dim DataLen As Double
    Dim PhotoYes As String
    Dim PhotoNo As String
    Dim Yes As String
    Dim NoNo As Integer
    
    If Data1.Recordset.BOF Then
    Else
        Data1.Recordset.MoveFirst
        If Data1.Recordset.EOF Then
        Else
            Data1.Recordset.MoveFirst
        End If
    End If
    
    Do Until Data1.Recordset.EOF
        For k = 0 To 4
            PhotoYes = PhotoYes & Data1.Recordset(k) & vbTab
        Next k
        PhotoYes = PhotoYes & vbCrLf
        Data1.Recordset.MoveNext
    Loop
    
    Open "d:\photodata\photoyes.txt" For Output As #1
    Print #1, PhotoYes
    Close #1
    RTB2.LoadFile "d:\photodata\photoyes.txt"

End Sub

Private Sub Command4_Click()
    Dim FileSystemObject, FileObject As Object
    Dim a As String
    
On Error GoTo FileErr

    Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
    
    CD1.ShowSave
    Set FileObject = FileSystemObject.GetFile("d:\photodata\photoyes.txt")
    FileObject.Copy CD1.FileName
    
FileErr:


End Sub

Private Sub Command5_Click()
    Timer2.Enabled = False
    Text1(0).Text = "连续初始化停止！" & vbCrLf & Text1(0).Text
    status
End Sub

Private Sub Command6_Click(Index As Integer)

    Dim ii As Double
    
On Error GoTo DataMove

    Select Case Index
        Case 0
            If Data1.Recordset.BOF Then
            Else
                Data1.Recordset.MoveFirst
            End If
            If Data1.Recordset.BOF Then
                Data1.Recordset.MoveNext
            End If
            T(0).Text = Data1.Recordset(1)
            T(1).Text = Data1.Recordset(2)
            T(2).Text = Data1.Recordset(3)
            Text1(1).Text = "数据已经移动到首位" & vbCrLf & Text1(1).Text
        Case 1
            If Data1.Recordset.BOF Then '往前10个数据
            Else
                If Data1.Recordset.BOF Then
                Else
                    ii = 0
                    Do Until Data1.Recordset.BOF Or ii = 10
                        Data1.Recordset.MovePrevious
                        ii = ii + 1
                    Loop
                End If
            End If
            If Data1.Recordset.BOF Then
                Data1.Recordset.MoveNext
            End If
'            T(0).Text = Data1.Recordset(1)
'            T(1).Text = Data1.Recordset(2)
            T(2).Text = Data1.Recordset(1)
            Text1(1).Text = "数据已经向前移动10个" & vbCrLf & Text1(1).Text
        Case 2
            If Data1.Recordset.BOF Then '往前10个数据
            Else
                If Data1.Recordset.BOF Then
                Else
                    Data1.Recordset.MovePrevious
                End If
            End If
            
            If Data1.Recordset.BOF Then
                Data1.Recordset.MoveNext
            End If

'            T(0).Text = Data1.Recordset(1)
'            T(1).Text = Data1.Recordset(2)
            T(2).Text = Data1.Recordset(1)
            Text1(1).Text = "数据已经向前移动1个" & vbCrLf & Text1(1).Text
        Case 3
            If Data1.Recordset.EOF Then
            Else
                If Data1.Recordset.EOF Then
                Else
                    Data1.Recordset.MoveNext
                End If
            End If
            If Data1.Recordset.EOF Then
                Data1.Recordset.MovePrevious
            End If

'            T(0).Text = Data1.Recordset(1)
'            T(1).Text = Data1.Recordset(2)
            T(2).Text = Data1.Recordset(1)
            Text1(1).Text = "数据已经往后移动1个" & vbCrLf & Text1(1).Text
        Case 4