frmdetectmac.frm

自动回传考勤数据程序,小程序!大作用!可供大家参考一下!

VERSION 5.00
Begin VB.Form frmDetectMac 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "搜索设备"
   ClientHeight    =   2790
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4950
   ControlBox      =   0   'False
   Icon            =   "frmDetectMac.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2790
   ScaleWidth      =   4950
   StartUpPosition =   3  '窗口缺省
   WhatsThisHelp   =   -1  'True
   Begin VB.TextBox Msg 
      ForeColor       =   &H000000FF&
      Height          =   690
      Left            =   90
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   14
      Text            =   "frmDetectMac.frx":08CA
      Top             =   2025
      Width           =   4740
   End
   Begin VB.CommandButton btnCancle 
      Caption         =   "退出"
      Height          =   375
      Left            =   3555
      TabIndex        =   13
      Top             =   1530
      Width           =   1005
   End
   Begin VB.CommandButton btnOK 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   375
      Left            =   2205
      TabIndex        =   12
      Top             =   1530
      Width           =   1005
   End
   Begin VB.TextBox txtOverTime 
      Height          =   330
      Left            =   3780
      TabIndex        =   7
      Text            =   "0"
      Top             =   1035
      Width           =   600
   End
   Begin VB.TextBox txtMacTo 
      Height          =   330
      Left            =   1665
      TabIndex        =   6
      Text            =   "50"
      Top             =   1035
      Width           =   510
   End
   Begin VB.TextBox txtMacFrom 
      Height          =   330
      Left            =   765
      TabIndex        =   5
      Text            =   "0"
      Top             =   1035
      Width           =   510
   End
   Begin VB.CheckBox ChkAll 
      Caption         =   "查找所有端口"
      Height          =   330
      Left            =   3420
      TabIndex        =   2
      Top             =   495
      Width           =   1410
   End
   Begin VB.ComboBox ComboSpeed 
      Height          =   300
      ItemData        =   "frmDetectMac.frx":096B
      Left            =   1755
      List            =   "frmDetectMac.frx":097E
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   495
      Width           =   1500
   End
   Begin VB.ComboBox ComboPort 
      Height          =   300
      ItemData        =   "frmDetectMac.frx":09A5
      Left            =   360
      List            =   "frmDetectMac.frx":09CD
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   495
      Width           =   1275
   End
   Begin VB.Label Label6 
      Caption         =   "毫秒"
      Height          =   285
      Left            =   4410
      TabIndex        =   11
      Top             =   1080
      Width           =   555
   End
   Begin VB.Label Label5 
      Caption         =   "每机搜索间隔:"
      Height          =   285
      Left            =   2610
      TabIndex        =   10
      Top             =   1080
      Width           =   1185
   End
   Begin VB.Label Label4 
      Caption         =   "到:"
      Height          =   285
      Left            =   1350
      TabIndex        =   9
      Top             =   1080
      Width           =   375
   End
   Begin VB.Label Label3 
      Caption         =   "机号由:"
      Height          =   330
      Left            =   45
      TabIndex        =   8
      Top             =   1080
      Width           =   645
   End
   Begin VB.Label Label2 
      Caption         =   "通信速率"
      Height          =   285
      Left            =   1800
      TabIndex        =   4
      Top             =   180
      Width           =   1365
   End
   Begin VB.Label Label1 
      Caption         =   "查找端口"
      Height          =   240
      Left            =   360
      TabIndex        =   3
      Top             =   180
      Width           =   1230
   End
End
Attribute VB_Name = "frmDetectMac"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Dim OriMacList() As Integer
Dim FoundMac As Boolean
'Dim SechMac As Nanben.SetMachine
Dim SechMac As Object
Private Sub btnCancle_Click()
    On Error GoTo ErrorHandler

    Unload Me
    If frmMacMain.Visible = False Then
        End
    End If
   Exit Sub
ErrorHandler:
MsgBox Err.Number & ":" & Err.Description, vbOKOnly + vbCritical


End Sub

Private Sub btnOK_Click()
On Error GoTo ErrLab

Dim ReturnNo As Integer
'Set SechMac = New Nanben.SetMachine
Set SechMac = CreateObject("Nanben.SetMachine")
Dim Newflag As Boolean

If Trim(txtMacFrom) = "" Or Trim(txtMacTo) = "" Then
    MsgBox "机号不能为空！", vbOKOnly + vbExclamation
    Exit Sub
End If

Dim TestTime
Dim SechOk As Boolean

''*****用于测试搜索速度，TestTime为总共用时****
''TestTime = Timer
''For i = 0 To MaxMachineNo
''    zif = SechMac.SearchMachine(1, 19200, (i))
''    If zif = 8 Then
''        SechOk = True
''    End If
''Next
''TestTime = Timer - TestTime

ComNo = CInt(Right(ComboPort.List(ComboPort.ListIndex), 1))
ComSpeed = ComboSpeed.List(ComboSpeed.ListIndex)
frmMacMain.lvClocks.ListItems.Clear     '搜机前先清掉旧的记录。
frmMacMain.ListMac.ListItems.Clear      '搜机前先清掉旧的记录。
''With frmMacMain.lvClocks
''    If .ListItems.Count <> 0 Then
''        ReDim OriMacList(.ListItems.Count - 1, 1)
''        For i = 0 To frmMacMain.lvClocks.ListItems.Count - 1
''            OriMacList(i, 0) = CInt(Trim(.ListItems(i + 1)))
''            OriMacList(i, 1) = CInt(Trim(.ListItems(i + 1).SubItems(2)))
''        Next
''    Else
''        ReDim OriMacList(0, 1)
''    End If
''End With
    If Val(txtMacFrom) > MaxMachineNo Or Val(txtMacTo) > MaxMachineNo Then
        MsgBox "卡钟号不能大于" & MaxMachineNo & "！", vbOKOnly + vbExclamation
        Exit Sub
    End If
    If Val(txtMacFrom) > Val(txtMacTo) Then
        MsgBox "从卡钟号不能大于到卡钟号", vbOKOnly + vbExclamation
        Exit Sub
    End If
    

btnOK.Enabled = False
    
      FoundMac = False
    If ChkAll.Value = 1 Then
        For i = 1 To 4
            SearchMac (i)
        Next
    Else
         SearchMac Right(ComboPort.List(ComboPort.ListIndex), 1)
    End If
    
    If FoundMac = False Then
        Unload Me
        MsgBox "没有找到新设备!", vbOKOnly + vbInformation
    End If
Msg.Text = "搜索完毕！ 请检查'设备列表' " & Chr(13) & Chr(10)
Msg.SelStart = Len(Msg.Text)

Set SechMac = Nothing
btnOK.Enabled = True
Unload Me

frmMacMain.Show
frmMacMain.ZOrder

Exit Sub
ErrLab:
    MsgBox Err.Number & ":" & Err.Description, vbOKOnly + vbCritical


End Sub

 
Private Sub Form_Load()
    On Error GoTo ErrorHandler

    ComboPort.ListIndex = 0
    ComboSpeed.ListIndex = 1
    Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2

   Exit Sub
ErrorHandler:
MsgBox Err.Number & ":" & Err.Description, vbOKOnly + vbCritical


End Sub
Private Function SearchMac(ComPortNo As Integer)
On Error GoTo ErrorHandler
Dim Newflag As Boolean
Dim MacType As Integer
Dim strMacType As String

          Msg.Text = Msg.Text & "正在检查连接...COM" & ComPortNo & Chr(13) & Chr(10)
          Msg.SelStart = Len(Msg.Text)
            For j = txtMacFrom.Text To txtMacTo.Text
                Msg.Text = Msg.Text & Trim(Str(j)) & ".."
                Msg.SelStart = Len(Msg.Text)
                Newflag = True
''                For k = 0 To UBound(OriMacList)
''                    If Format(OriMacList(k, 1), "000") = Format(ComPortNo, "000") And OriMacList(k, 0) = j Then
''                        Newflag = False
''                        Exit For
''                    End If
''                Next
                ReturnNo = 0
                ReturnNo = SechMac.SearchMachine((ComPortNo), Trim(ComboSpeed.Text), (j), MacType)
                Select Case MacType
                    Case 0
                        strMacType = "考勤"
                    Case 1
                        strMacType = "门禁"
                    Case 2
                        strMacType = "考勤门禁"
                    Case 3
                        strMacType = "份饭"
                End Select
                If ReturnNo = 8 Then
                    FoundMac = True
                End If
'                If Newflag = True Then
                        Select Case ReturnNo
                                Case 1
                                    Msg.Text = Msg.Text & "通信口" & ComPortNo & "连接超时！ 请检查" & Chr(13) & Chr(10)
                                    Msg.SelStart = Len(Msg.Text)
                                Case 2
                                
                                Case 8
                                    FoundMac = True
                                    With frmMacMain.lvClocks
                                        .Sorted = False
                                        .ListItems.Add , , Format(j, "000")
                                        .ListItems(.ListItems.Count).SubItems(2) = ComPortNo
                                        .ListItems(.ListItems.Count).SubItems(3) = ComboSpeed.List(ComboSpeed.ListIndex)
                                        .ListItems(.ListItems.Count).SubItems(4) = strMacType
                                    End With
                                    With frmMacMain.ListMac
                                        .Sorted = False
                                        .ListItems.Add , , Format(j, "000")
                                        .ListItems(.ListItems.Count).SubItems(1) = ComPortNo
                                        .ListItems(.ListItems.Count).SubItems(2) = ComboSpeed.List(ComboSpeed.ListIndex)
                                        .ListItems(.ListItems.Count).SubItems(3) = strMacType
                                    End With
                        End Select
                        DoEvents
'                End If
                If Val(txtOverTime.Text) > 0 Then
                    Sleep (Val(txtOverTime.Text))
                End If
                If ReturnNo = 8 Then
                    For k = 1 To frmMacMain.ListMac.ListItems.Count
                        If frmMacMain.ListMac.ListItems(k).SubItems(1) = ComPortNo And frmMacMain.ListMac.ListItems(k) = Format(j, "000") Then
                            frmMacMain.ListMac.ListItems(k).Checked = True
                        End If
                    Next
                End If
            Next
            
Msg.Text = Msg.Text & Chr(13) & Chr(10)
Msg.SelStart = Len(Msg.Text)


   Exit Function
ErrorHandler:
MsgBox Err.Number & ":" & Err.Description, vbOKOnly + vbCritical

End Function

Private Sub txtMacFrom_KeyPress(KeyAscii As Integer)
    If KeyAscii < 48 Or KeyAscii > 57 Then
        If KeyAscii <> 8 Then
            KeyAscii = 0
        End If
    End If
End Sub