www.pudn.com > 考勤管理系统源码(VB含串口接口程序).zip > frmCollect.frm

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