frmCollect.frm
资源名称:考勤6.rar [点击查看]
上传用户:djzm888
上传日期:2013-02-15
资源大小:867k
文件大小:6k
源码类别:
其他数据库
开发平台:
Visual Basic
- 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