main.frm

采用Visual Basic6.0

VERSION 5.00
Begin VB.Form StepTest 
   Caption         =   "修改机号(3.0设备)"
   ClientHeight    =   3555
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6090
   Icon            =   "main.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   3555
   ScaleWidth      =   6090
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton CmdHand1 
      Caption         =   "握手"
      Height          =   435
      Left            =   3120
      TabIndex        =   15
      Top             =   1260
      Width           =   1365
   End
   Begin VB.CommandButton Command1 
      Caption         =   "清屏"
      Height          =   435
      Left            =   4620
      TabIndex        =   14
      Top             =   1260
      Width           =   1365
   End
   Begin VB.CommandButton Cmdexit 
      Caption         =   "退  出"
      Height          =   435
      Left            =   4620
      TabIndex        =   13
      Top             =   1770
      Width           =   1365
   End
   Begin VB.CommandButton CmdReadTime 
      Caption         =   "读取时间"
      Height          =   435
      Left            =   1620
      TabIndex        =   12
      Top             =   1275
      Width           =   1365
   End
   Begin VB.CommandButton CmdOPEN 
      Caption         =   "打开串口"
      Height          =   435
      Left            =   120
      TabIndex        =   11
      Top             =   1275
      Width           =   1365
   End
   Begin VB.TextBox txtreaderid 
      Height          =   375
      Left            =   1620
      TabIndex        =   6
      Top             =   810
      Width           =   1305
   End
   Begin VB.CommandButton cmdsetreaderid 
      Caption         =   "设置机号"
      Height          =   435
      Left            =   120
      TabIndex        =   5
      Top             =   780
      Width           =   1365
   End
   Begin VB.Frame Frame1 
      Caption         =   "设备选择"
      Height          =   645
      Left            =   120
      TabIndex        =   4
      Top             =   60
      Width           =   5895
      Begin VB.ComboBox ComboCom 
         Height          =   300
         Left            =   1530
         TabIndex        =   9
         Text            =   "ComboCom"
         Top             =   210
         Width           =   1275
      End
      Begin VB.TextBox txtcurrid 
         Height          =   315
         Left            =   4470
         TabIndex        =   8
         Text            =   "3000"
         Top             =   180
         Width           =   1335
      End
      Begin VB.Label Label2 
         Caption         =   "通讯口："
         Height          =   195
         Left            =   420
         TabIndex        =   10
         Top             =   270
         Width           =   735
      End
      Begin VB.Label Label1 
         Caption         =   "当前机号："
         Height          =   165
         Left            =   3180
         TabIndex        =   7
         Top             =   240
         Width           =   915
      End
   End
   Begin VB.CommandButton CmdCLOSE 
      Caption         =   "关闭串口"
      Height          =   435
      Left            =   120
      TabIndex        =   3
      Top             =   1770
      Width           =   1365
   End
   Begin VB.CommandButton cmdrec 
      Caption         =   "记录采集"
      Height          =   435
      Left            =   3090
      TabIndex        =   2
      Top             =   1770
      Width           =   1365
   End
   Begin VB.CommandButton cmdtime 
      Caption         =   "设置时间"
      Height          =   435
      Left            =   1620
      TabIndex        =   1
      Top             =   1770
      Width           =   1365
   End
   Begin VB.ListBox List1 
      Height          =   1140
      Left            =   120
      TabIndex        =   0
      Top             =   2280
      Width           =   5895
   End
End
Attribute VB_Name = "StepTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim tmpid() As String
Dim tmp() As String
Dim Cnn As ADODB.Connection
Public Arraylist As New Collection
Private Declare Function SetWindowPos& Lib "user32" (ByVal hwnd As Long, _
    ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, _
    ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
    
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    
    
Const KEYEVENTF_KEYUP = &H2


Private Sub cmdClose_Click()

    If IsLCD Then
        If icdev > 0 Then st = CloseComm(icdev)
        listPrint ("串口己关闭！")
        icdev = 0
        IsLCD = False
    Else
        listPrint ("串口尚末打开！")
    End If
    
End Sub



'Private Sub Cmdexit_Click()
'  Dim myval As Integer
'      myval = MsgBox("真的要关闭窗口吗?", vbYesNo, "关闭窗口程序")
''返回值vbYes
'  If myval = vbYes Then
''退出程序
'    Call cmdClose_Click
'    End
'  End If
'    End0011050001
'End Sub

Private Sub Cmdexit_Click()

    If icdev > 0 Then
        st = CloseComm(icdev)
        listPrint ("串口己关闭！")
        End
    End If

    End

End Sub

Private Sub CmdOPEN_Click()

    Dim myval
    myval = SetWindowPos(StepTest.hwnd, -1, 0, 0, 0, 0, 3)
    List1.Clear
    If icdev <= 0 Then
       icdev = OpenComm(ComboCom.ListIndex)
    End If
    If icdev <= 0 Then
        MsgBox ("初始化串口错误:" & st)
        IsLCD = False
    Else
        listPrint ("初始化串口成功！")
        IsLCD = True
    End If
    
End Sub

Private Sub CmdReadTime_Click()

    If IsLCD Then
        Dim DateTime1 As String * 15
        Dim tmpstr, tmp, str As String
        Dim i As Integer
        Call CmdHand_Click
        If st = 0 Then
            st = Get_NodeTime(ByVal icdev, DateTime1)
            tmpstr = Val(DateTime1)        '& tmpstr
            str = "   机号： " & txtcurrid.Text
            tmp = tmpstr & str
            listPrint ("取当前时间成功！" & tmp)
        Else
            listPrint ("握手失败:" & st & "   机号：" & txtcurrid.Text)
        End If
    Else
        listPrint ("程序在串口关闭状态下不能通讯，请打开串口！")
    End If
End Sub

Private Sub cmdrec_Click()
    
    If Not IsLCD Then
        listPrint ("程序在串口关闭状态下不能通讯，请打开串口！")
        Exit Sub
    End If
    Dim data1 As String * 20
    Dim TmpS, tmpD, cardinfo As String
    Dim str, js As Integer
    Dim readid, i As Long
    Call CmdHand_Click
    If Not handok Then
        listPrint ("握手失败！" & st)
        Exit Sub
    End If
    If st = 0 Then
        readid = Val(Trim(txtcurrid.Text))
        st = Get_Curr_Record(ByVal icdev, readid, data1)
        Debug.Print st
        Do While st = -11
            i = i + 1
            st = Get_Curr_Record(ByVal icdev, readid, data1)
            If i > 1 Then
                Exit Do
            End If
        Loop
    
        If st <> 0 Then
            If st = -9 Then
               listPrint ("当前设备：" & txtcurrid.Text & "  没有数据！")
            Else
               listPrint ("取当前记录失败:" & st)
            End If
            Exit Sub
        Else
            tmpD = Val("&h" + Mid(data1, 1, 2) + Mid(data1, 5, 2) + Mid(data1, 3, 2))
            TmpS = "20" + Mid(data1, 7, 2) + "-" + Mid(data1, 9, 2) + "-" + Mid(data1, 11, 2) + " " + Mid(data1, 13, 2) + _
            ":" + Mid(data1, 15, 2) + ":" + Mid(data1, 17, 2)
            tmpD = handelTmpD(tmpD)
            TmpS = "卡号:" & tmpD & " 时间:" & TmpS
            keyevent (tmpD)
            tmpid(UBound(tmpid)) = handelTmpD(tmpD)
            ReDim Preserve tmpid(UBound(tmpid) + 1)
            listPrint ("取当前记录成功：" & TmpS)
        End If
    
        While st <> -9
            DoEvents
            st = Get_Next_Record(ByVal icdev, readid, data1)
            If st = -3 Then
                st = Get_Curr_Record(ByVal icdev, readid, data1)
            End If
            If st <> 0 Then
    
                If st = -9 Then
                    js = UBound(tmpid)
                    listPrint ("采集完毕！" & "共刷卡" & js)
                Else
                   listPrint ("取下一记录失败:" & st)
    
                End If
            Else
                tmpD = Val("&h" + Mid(data1, 1, 2) + Mid(data1, 5, 2) + Mid(data1, 3, 2))
                TmpS = "20" + Mid(data1, 7, 2) + "-" + Mid(data1, 9, 2) + "-" + Mid(data1, 11, 2) + " " + Mid(data1, 13, 2) + _
                ":" + Mid(data1, 15, 2) + ":" + Mid(data1, 17, 2)
                tmpD = handelTmpD(tmpD)
                TmpS = "卡号:" & handelTmpD(tmpD) & " 时间:" & TmpS
                keyevent (tmpD)
                tmpid(UBound(tmpid)) = handelTmpD(tmpD)
                ReDim Preserve tmpid(UBound(tmpid) + 1)
                listPrint ("取下一记录成功:" & TmpS)
            End If
        Wend
    Else
        listPrint ("握手失败！" & st)
    End If
End Sub

Private Sub listPrint(ByVal sList As String)
    If List1.ListCount > 400 Then
        List1.Clear
    End If
    List1.AddItem sList
    List1.Selected(List1.NewIndex) = True
End Sub

Private Function handelTmpD(ByVal tmpid As String) As String
    handelTmpD = "9" & PadLeft(tmpid, 8)
End Function

Private Function keyevent(ByVal tmpid As String) As String
    Dim data() As Byte
    data = StrConv(tmpid, vbFromUnicode)
    For i = 0 To Len(tmpid) - 1
        keybd_event data(i), 0, 0, 0
        keybd_event data(i), 0, KEYEVENTF_KEYUP, 0
    Next i
End Function

Public Function PadLeft(ByVal Source As String, ByVal Length As Long) As String
    Dim sReturn As String
    
    'Check for Null Parameters.
    If IsNull(Source) Or IsNull(Length) Then
            PadLeft = False
            Exit Function
    End If
    
    'Check for the lengths
    If Length <= Len(Source) Then
            'Return the original string
            PadLeft = "0" & Source
            Exit Function
    End If
    Dim a As String
    Dim i As Integer
    a = ""
    For i = 0 To Length - Len(Source)
        a = a & "0"
    Next
    'Create the left padded string
    sReturn = a + Source
    
    PadLeft = sReturn
End Function

Private Sub cmdsetreaderid_Click()
    
    Dim oldreaderid, newreaderid As Long
    Dim myval As Integer
    myval = MsgBox("确认是否要改机号！", vbYesNo, "关闭窗口程序")
    If myval = vbNo Then '返回值vbYes
         Exit Sub
    Else
        newreaderid = Val(Trim(txtreaderid.Text))
        oldreaderid = Val(Trim(txtcurrid.Text))
        If newreaderid > 65535 Or newreaderid < 1 Then
            MsgBox "新机号必须在1~65535之间取值！"
            Exit Sub
        End If
        Call CmdHand_Click
        st = Set_ADDR(ByVal icdev, oldreaderid, newreaderid)
        If st = 0 Then
            listPrint ("设置设备号成功!")
        Else
            listPrint ("设置设备号失败!")
            GoTo endhandle
        End If
    End If
              
endhandle:
        CloseComm (icdev)

End Sub


Private Sub cmdtime_Click()

    If IsLCD Then
        Dim i As Integer
        Dim str, tmp, tmpstr As String
        Dim DateTime1 As String * 14
        Call CmdHand_Click
        DateTime1 = Format(Now, "YYYYMMDDHHMMSS")
        str = Val(DateTime1)
        tmp = "   机号：" & txtcurrid.Text
        tmpstr = str & tmp
        If st = 0 Then
            st = Set_NodeTime(ByVal icdev, DateTime1)
            listPrint ("设置时间成功！" & tmpstr)
        Else
            listPrint ("握手失败:" & st & tmp)
        End If
    Else
        listPrint ("程序在串口关闭状态下不能通讯，请打开串口！")
    End If
    
End Sub


Private Sub ComboCom_LostFocus()

    Call cmdClose_Click
    icdev = 0
    
End Sub

Private Sub CmdHand_Click()

    If IsLCD Then
        Dim readid As Long
        readid = Val(Trim(txtcurrid.Text))
        st = Hand_Shake(ByVal icdev, readid, pass)
'        st = Hand_Shake_N(ByVal icdev, readid)
        If st = 0 Then
           ' listPrint ("握手成功:" & st)
           handok = True
        Else
            Debug.Print "握手失败:" & st & "   机号: " & readid
            handok = False
        End If
    Else
        listPrint ("程序在串口关闭状态下不能通讯，请打开串口！")
    End If
End Sub

Private Sub CmdHand1_Click()
    If IsLCD Then
        Dim readid As Long
        readid = Val(Trim(txtcurrid.Text))
        st = Hand_Shake(ByVal icdev, readid, pass)
        If st = 0 Then
            listPrint ("握手成功!" & "   机号：" & txtcurrid.Text)
            handok = True
        Else
            listPrint ("握手失败:" & st & "   机号：" & txtcurrid.Text)
            handok = False
        End If
    Else
        listPrint ("程序在串口关闭状态下不能通讯，请打开串口！")
    End If
End Sub

Private Sub Command1_Click()
    
    List1.Clear
    ReDim tmpid(0)
    ReDim tmp(0)

End Sub

Private Sub Form_Load()
    If App.PrevInstance Then
         MsgBox "程序己运行！！！", vbInformation, "系统提示"
    End If
    ReDim tmpid(0)
    ReDim tmp(0)
    Dim i As Byte
    ComboCom.Clear
    For i = 0 To 4
        ComboCom.AddItem "COM" & i + 1
    Next i
    ComboCom.ListIndex = 0
    pass = "19550930"


End Sub

Private Sub Form_Unload(Cancel As Integer)
'
'    Dim myval As Integer
'         myval = MsgBox("真的要关闭窗口吗?", vbYesNo, "关闭窗口程序")
'    If myval = vbYes Then '返回值vbYes
'         Call cmdClose_Click '退出程序
'         End
'    Else
'         Cancel = 1
'    End If

    If icdev > 0 Then st = CloseComm(icdev)
    listPrint ("串口己关闭！")
    
End Sub