frmcollect.frm

一个用VB开发的考勤管理系统... 希望大家来看看..提出见意.. 谢谢.

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmCollect 
   Caption         =   "Data Collect"
   ClientHeight    =   2205
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5490
   LinkTopic       =   "Form1"
   ScaleHeight     =   2205
   ScaleWidth      =   5490
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton cmdQuit 
      Caption         =   "Quit"
      Height          =   375
      Left            =   3630
      TabIndex        =   6
      Top             =   1320
      Width           =   1095
   End
   Begin VB.CommandButton cmdGetData 
      Caption         =   "Start "
      Height          =   375
      Left            =   3630
      TabIndex        =   5
      Top             =   840
      Width           =   1095
   End
   Begin ComctlLib.ProgressBar ProgressBar1 
      Height          =   255
      Left            =   480
      TabIndex        =   4
      Top             =   240
      Width           =   4335
      _ExtentX        =   7646
      _ExtentY        =   450
      _Version        =   327682
      Appearance      =   1
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   4905
      Top             =   1485
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
   Begin VB.Label lblRecCount 
      Caption         =   "0"
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   2280
      TabIndex        =   3
      Top             =   1440
      Width           =   615
   End
   Begin VB.Label Label1 
      Caption         =   "Received:"
      Height          =   375
      Left            =   840
      TabIndex        =   2
      Top             =   1440
      Width           =   975
   End
   Begin VB.Label lblTotalCount 
      Caption         =   "0"
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   2280
      TabIndex        =   1
      Top             =   840
      Width           =   615
   End
   Begin VB.Label Label2 
      Caption         =   "Total:"
      Height          =   375
      Left            =   840
      TabIndex        =   0
      Top             =   840
      Width           =   495
   End
End
Attribute VB_Name = "frmCollect"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'Dim ReceStr As Variant
'Dim SendStr As Variant
'Dim SendByte(9) As Byte
'Dim i As Integer
'Dim temp As String
'Dim strTemp As String
'Dim tLastTime As Date
'Dim nRecCount, nTotalCount As Integer
Private Sub cmdGetData_Click()
    Dim ReceStr As Variant
    Dim SendStr As Variant
    Dim SendByte(9) As Byte
    Dim i As Integer
    Dim temp As String
    Dim strTemp As String
    Dim tLastTime As Date
    Dim nRecCount, nTotalCount As Integer
    Dim RstkqHistory As Recordset
    nRecCount = 0
    ProgressBar1.Value = 0
    lblRecCount.Caption = 0
    SendByte(0) = &H7E
    SendByte(1) = &H30
    SendByte(2) = &H31
    SendByte(3) = &H30
    SendByte(4) = &H30
    SendByte(5) = &H46
    SendByte(6) = &H46
    SendByte(7) = &H33
    SendByte(8) = &H46
    SendByte(9) = &HD
    MSComm1.InBufferCount = 0
    SendStr = SendByte
    MSComm1.Output = SendStr
    Do
        DoEvents
    Loop Until MSComm1.InBufferCount >= 30
    ReceStr = MSComm1.Input
    nTotalCount = 0
    nTotalCount = nTotalCount + AsciiToVal(CByte(ReceStr(5)))
    nTotalCount = nTotalCount * 16
    nTotalCount = nTotalCount + AsciiToVal(CByte(ReceStr(6)))
    nTotalCount = nTotalCount * 16
    nTotalCount = nTotalCount + AsciiToVal(CByte(ReceStr(7)))
    nTotalCount = nTotalCount * 16
    nTotalCount = nTotalCount + AsciiToVal(CByte(ReceStr(8)))
    lblTotalCount.Caption = nTotalCount
    ProgressBar1.Min = 0
    If nTotalCount > 0 Then
        ProgressBar1.Max = nTotalCount
    Else
        ProgressBar1.Max = 100
    End If
    Do
        SendByte(0) = &H7E
        SendByte(1) = &H30
        SendByte(2) = &H31
        SendByte(3) = &H30
        SendByte(4) = &H31
        SendByte(5) = &H46
        SendByte(6) = &H46
        SendByte(7) = &H33
        SendByte(8) = &H45
        SendByte(9) = &HD
        MSComm1.InBufferCount = 0
        SendStr = SendByte
        MSComm1.Output = SendStr
        Do
            DoEvents
        Loop Until MSComm1.InBufferCount >= 30
        ReceStr = MSComm1.Input
        If ReceStr(3) = &H30 And ReceStr(4) = &H32 Then
            Exit Do
        End If
        nRecCount = nRecCount + 1
        ProgressBar1.Value = nRecCount
        lblRecCount.Caption = nRecCount
        RstkqHistory.AddNew
        strTemp = Chr(AsciiToVal(CByte(ReceStr(5))) * 16 + AsciiToVal(CByte(ReceStr(6)))) + _
                Chr(AsciiToVal(CByte(ReceStr(7))) * 16 + AsciiToVal(CByte(ReceStr(8)))) + _
                Chr(AsciiToVal(CByte(ReceStr(9))) * 16 + AsciiToVal(CByte(ReceStr(10)))) + _
                Chr(AsciiToVal(CByte(ReceStr(11))) * 16 + AsciiToVal(CByte(ReceStr(12))))
        RstkqHistory!workno = strTemp
        strTemp = Chr(ReceStr(13)) + Chr(ReceStr(14)) + "-" + _
                  Chr(ReceStr(15)) + Chr(ReceStr(16)) + "-" + _
                  Chr(ReceStr(17)) + Chr(ReceStr(18))
        RstkqHistory!kqdate = Format(Trim(strTemp), "yyyy-mm-dd")
        strTemp = Chr(ReceStr(19)) + Chr(ReceStr(20)) + ":" + _
                  Chr(ReceStr(21)) + Chr(ReceStr(22)) + ":" + _
                  Chr(ReceStr(23)) + Chr(ReceStr(24))
        RstkqHistory!kqtime = Format(Trim(strTemp), "hh:mm:ss")
        RstkqHistory.Update
    Loop
    MsgBox "Data Transfor Complete!"
    Data1.Refresh
    MSFlexGrid1.Refresh
    MSFlexGrid1.Col = 1
    MSFlexGrid1.ColSel = 2
    MSFlexGrid1.Sort = 5
    RstkqHistory.Close
    Set RstkqHistory = Nothing
End Sub
Private Sub cmdQuit_Click()
    Unload Me
End Sub
Private Sub Form_Load()
    Dim X, Y As Integer
    X = (Screen.Width - Me.Width) / 2
    Y = (Screen.Height - Me.Height) / 2
    Me.Move X, Y
     
    MSComm1.InputMode = comInputModeBinary
    MSComm1.ParityReplace = ""
    If Not MSComm1.PortOpen Then
       MSComm1.PortOpen = True
    End If
End Sub