frmCollect.frm
上传用户:djzm888
上传日期:2013-02-15
资源大小:867k
文件大小:6k
源码类别:

其他数据库

开发平台:

Visual Basic

  1. VERSION 5.00
  2. Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
  3. Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
  4. Begin VB.Form frmCollect 
  5.    Caption         =   "Data Collect"
  6.    ClientHeight    =   2205
  7.    ClientLeft      =   60
  8.    ClientTop       =   345
  9.    ClientWidth     =   5490
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   2205
  12.    ScaleWidth      =   5490
  13.    StartUpPosition =   3  '窗口缺省
  14.    Begin VB.CommandButton cmdQuit 
  15.       Caption         =   "Quit"
  16.       Height          =   375
  17.       Left            =   3630
  18.       TabIndex        =   6
  19.       Top             =   1320
  20.       Width           =   1095
  21.    End
  22.    Begin VB.CommandButton cmdGetData 
  23.       Caption         =   "Start "
  24.       Height          =   375
  25.       Left            =   3630
  26.       TabIndex        =   5
  27.       Top             =   840
  28.       Width           =   1095
  29.    End
  30.    Begin ComctlLib.ProgressBar ProgressBar1 
  31.       Height          =   255
  32.       Left            =   480
  33.       TabIndex        =   4
  34.       Top             =   240
  35.       Width           =   4335
  36.       _ExtentX        =   7646
  37.       _ExtentY        =   450
  38.       _Version        =   327682
  39.       Appearance      =   1
  40.    End
  41.    Begin MSCommLib.MSComm MSComm1 
  42.       Left            =   4905
  43.       Top             =   1485
  44.       _ExtentX        =   1005
  45.       _ExtentY        =   1005
  46.       _Version        =   393216
  47.       DTREnable       =   -1  'True
  48.    End
  49.    Begin VB.Label lblRecCount 
  50.       Caption         =   "0"
  51.       ForeColor       =   &H000000FF&
  52.       Height          =   255
  53.       Left            =   2280
  54.       TabIndex        =   3
  55.       Top             =   1440
  56.       Width           =   615
  57.    End
  58.    Begin VB.Label Label1 
  59.       Caption         =   "Received:"
  60.       Height          =   375
  61.       Left            =   840
  62.       TabIndex        =   2
  63.       Top             =   1440
  64.       Width           =   975
  65.    End
  66.    Begin VB.Label lblTotalCount 
  67.       Caption         =   "0"
  68.       ForeColor       =   &H000000FF&
  69.       Height          =   255
  70.       Left            =   2280
  71.       TabIndex        =   1
  72.       Top             =   840
  73.       Width           =   615
  74.    End
  75.    Begin VB.Label Label2 
  76.       Caption         =   "Total:"
  77.       Height          =   375
  78.       Left            =   840
  79.       TabIndex        =   0
  80.       Top             =   840
  81.       Width           =   495
  82.    End
  83. End
  84. Attribute VB_Name = "frmCollect"
  85. Attribute VB_GlobalNameSpace = False
  86. Attribute VB_Creatable = False
  87. Attribute VB_PredeclaredId = True
  88. Attribute VB_Exposed = False
  89. Option Explicit
  90. 'Dim ReceStr As Variant
  91. 'Dim SendStr As Variant
  92. 'Dim SendByte(9) As Byte
  93. 'Dim i As Integer
  94. 'Dim temp As String
  95. 'Dim strTemp As String
  96. 'Dim tLastTime As Date
  97. 'Dim nRecCount, nTotalCount As Integer
  98. Private Sub cmdGetData_Click()
  99.     Dim ReceStr As Variant
  100.     Dim SendStr As Variant
  101.     Dim SendByte(9) As Byte
  102.     Dim i As Integer
  103.     Dim temp As String
  104.     Dim strTemp As String
  105.     Dim tLastTime As Date
  106.     Dim nRecCount, nTotalCount As Integer
  107.     Dim RstkqHistory As Recordset
  108.     nRecCount = 0
  109.     ProgressBar1.Value = 0
  110.     lblRecCount.Caption = 0
  111.     SendByte(0) = &H7E
  112.     SendByte(1) = &H30
  113.     SendByte(2) = &H31
  114.     SendByte(3) = &H30
  115.     SendByte(4) = &H30
  116.     SendByte(5) = &H46
  117.     SendByte(6) = &H46
  118.     SendByte(7) = &H33
  119.     SendByte(8) = &H46
  120.     SendByte(9) = &HD
  121.     MSComm1.InBufferCount = 0
  122.     SendStr = SendByte
  123.     MSComm1.Output = SendStr
  124.     Do
  125.         DoEvents
  126.     Loop Until MSComm1.InBufferCount >= 30
  127.     ReceStr = MSComm1.Input
  128.     nTotalCount = 0
  129.     nTotalCount = nTotalCount + AsciiToVal(CByte(ReceStr(5)))
  130.     nTotalCount = nTotalCount * 16
  131.     nTotalCount = nTotalCount + AsciiToVal(CByte(ReceStr(6)))
  132.     nTotalCount = nTotalCount * 16
  133.     nTotalCount = nTotalCount + AsciiToVal(CByte(ReceStr(7)))
  134.     nTotalCount = nTotalCount * 16
  135.     nTotalCount = nTotalCount + AsciiToVal(CByte(ReceStr(8)))
  136.     lblTotalCount.Caption = nTotalCount
  137.     ProgressBar1.Min = 0
  138.     If nTotalCount > 0 Then
  139.         ProgressBar1.Max = nTotalCount
  140.     Else
  141.         ProgressBar1.Max = 100
  142.     End If
  143.     Do
  144.         SendByte(0) = &H7E
  145.         SendByte(1) = &H30
  146.         SendByte(2) = &H31
  147.         SendByte(3) = &H30
  148.         SendByte(4) = &H31
  149.         SendByte(5) = &H46
  150.         SendByte(6) = &H46
  151.         SendByte(7) = &H33
  152.         SendByte(8) = &H45
  153.         SendByte(9) = &HD
  154.         MSComm1.InBufferCount = 0
  155.         SendStr = SendByte
  156.         MSComm1.Output = SendStr
  157.         Do
  158.             DoEvents
  159.         Loop Until MSComm1.InBufferCount >= 30
  160.         ReceStr = MSComm1.Input
  161.         If ReceStr(3) = &H30 And ReceStr(4) = &H32 Then
  162.             Exit Do
  163.         End If
  164.         nRecCount = nRecCount + 1
  165.         ProgressBar1.Value = nRecCount
  166.         lblRecCount.Caption = nRecCount
  167.         RstkqHistory.AddNew
  168.         strTemp = Chr(AsciiToVal(CByte(ReceStr(5))) * 16 + AsciiToVal(CByte(ReceStr(6)))) + _
  169.                 Chr(AsciiToVal(CByte(ReceStr(7))) * 16 + AsciiToVal(CByte(ReceStr(8)))) + _
  170.                 Chr(AsciiToVal(CByte(ReceStr(9))) * 16 + AsciiToVal(CByte(ReceStr(10)))) + _
  171.                 Chr(AsciiToVal(CByte(ReceStr(11))) * 16 + AsciiToVal(CByte(ReceStr(12))))
  172.         RstkqHistory!workno = strTemp
  173.         strTemp = Chr(ReceStr(13)) + Chr(ReceStr(14)) + "-" + _
  174.                   Chr(ReceStr(15)) + Chr(ReceStr(16)) + "-" + _
  175.                   Chr(ReceStr(17)) + Chr(ReceStr(18))
  176.         RstkqHistory!kqdate = Format(Trim(strTemp), "yyyy-mm-dd")
  177.         strTemp = Chr(ReceStr(19)) + Chr(ReceStr(20)) + ":" + _
  178.                   Chr(ReceStr(21)) + Chr(ReceStr(22)) + ":" + _
  179.                   Chr(ReceStr(23)) + Chr(ReceStr(24))
  180.         RstkqHistory!kqtime = Format(Trim(strTemp), "hh:mm:ss")
  181.         RstkqHistory.Update
  182.     Loop
  183.     MsgBox "Data Transfor Complete!"
  184.     Data1.Refresh
  185.     MSFlexGrid1.Refresh
  186.     MSFlexGrid1.Col = 1
  187.     MSFlexGrid1.ColSel = 2
  188.     MSFlexGrid1.Sort = 5
  189.     RstkqHistory.Close
  190.     Set RstkqHistory = Nothing
  191. End Sub
  192. Private Sub cmdQuit_Click()
  193.     Unload Me
  194. End Sub
  195. Private Sub Form_Load()
  196.     Dim X, Y As Integer
  197.     X = (Screen.Width - Me.Width) / 2
  198.     Y = (Screen.Height - Me.Height) / 2
  199.     Me.Move X, Y
  200.      
  201.     MSComm1.InputMode = comInputModeBinary
  202.     MSComm1.ParityReplace = ""
  203.     If Not MSComm1.PortOpen Then
  204.        MSComm1.PortOpen = True
  205.     End If
  206. End Sub