form3.frm

21世纪的一个重要标志就是人类社会从后工业时代过渡到信息时代。随着计算机技术的发展和成熟

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form3 
   Caption         =   "Form3"
   ClientHeight    =   4650
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6405
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   15.75
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form3"
   ScaleHeight     =   4650
   ScaleWidth      =   6405
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   4320
      TabIndex        =   7
      Top             =   840
      Width           =   1215
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   4800
      Top             =   1800
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
   Begin VB.Timer Timer2 
      Left            =   5280
      Top             =   840
   End
   Begin VB.Timer Timer1 
      Left            =   4440
      Top             =   960
   End
   Begin VB.TextBox Text1 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   720
      TabIndex        =   6
      Text            =   "Text1"
      Top             =   3840
      Width           =   4215
   End
   Begin VB.Label Label6 
      Caption         =   "Label6"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1200
      TabIndex        =   8
      Top             =   120
      Width           =   3735
   End
   Begin VB.Label lblclock 
      Caption         =   "0"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1560
      TabIndex        =   5
      Top             =   720
      Width           =   1215
   End
   Begin VB.Label Label5 
      Caption         =   "Label5"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1440
      TabIndex        =   4
      Top             =   2160
      Width           =   1215
   End
   Begin VB.Label Label4 
      Caption         =   "Label4"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   0
      TabIndex        =   3
      Top             =   2160
      Width           =   1215
   End
   Begin VB.Label Label3 
      Caption         =   "Label3"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1440
      TabIndex        =   2
      Top             =   1320
      Width           =   1215
   End
   Begin VB.Label Label2 
      Caption         =   "Label2"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   120
      TabIndex        =   1
      Top             =   720
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "Label1"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   120
      TabIndex        =   0
      Top             =   1440
      Width           =   1215
   End
End
Attribute VB_Name = "Form3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public summ As Single
Public flag As Integer
Dim bytes() As Byte
Dim rebytes() As Byte
Dim shar As Integer
Public biaodizhi As Single

Private Sub Command1_Click()
If shar = 0 Then
 Timer1.Interval = 1000
 Timer2.Interval = 1000
 Command1.Caption = "开截门"
 shar = 1
Else
    Timer1.Interval = 0
    Timer2.Interval = 0
    Command1.Caption = "截门关"
  shar = 0
End If
End Sub

Private Sub Form_Load()

flag = 1
Timer1.Interval = 0
Timer2.Interval = 0
Label1.Caption = "日期"
Label2.Caption = "时间"
Label4.Caption = "用量"
Label5.Caption = summ
Label6.Caption = "NO  2"
Command1.Caption = "截门关"
 MSComm1.RThreshold = 1
 MSComm1.InputMode = comInputModeText
 MSComm1.CommPort = 2
 MSComm1.Settings = "9600,n,8,1"
 MSComm1.PortOpen = True

End Sub



Private Sub MSComm1_OnComm()
Dim a As String
Dim l As Integer
Dim ln As Integer
Dim s As Integer
Dim c(16) As String * 1
Dim nian As Date
Dim yue As Date
Dim ri As Date
Dim shi As Date
Dim fen As Date
Dim miao As Date
Dim endtime As Long
If (MSComm1.CommEvent = comEvReceive) Then
 jiaoyanhe = 0
 endtime = 10 + Timer
       If flag = 2 Then
       Timer2.Interval = 0
     '加沿时
     
      End If
Do
     b = b + MSComm1.Input
begin = InStr(1, b, "*~1")
begin2 = InStr(1, b, "*~2")
bend = InStr(1, b, "#")
If begin <> 0 And bend <> 0 And bend - begin > 0 Then  '1
 a = Mid(b, begin, bend - begin + 1)
 l = Len(a)
 Exit Do
 ElseIf begin2 <> 0 And bend <> 0 And bend - begin2 > 0 Then
 a = Mid(b, begin2, bend - begin2 + 1)
 l = Len(a)
 Exit Do
End If

If Time > endtime Then
   Exit Do
  End If
Loop
'拆包
   ReDim bytes(l)
   For i = 0 To l - 1
   bytes(i) = 0
   Next i
           Text1 = a
           
          
           
           For i = 0 To l - 1
             bytes(i) = Asc(Mid(a, i + 1, 1))
           Next i
 '校验
      
            For i = 0 To l - 3
               jiaoyanhe = jiaoyanhe Xor bytes(i)
            Next i
 If Asc(jiaoyanhe) = bytes(l - 2) Then '2
 '****************************************************
 If bytes(3) = Asc("a") And bytes(4) = Asc("q") And bytes(6) = Asc("#") Then '3
        ' For i = 0 To 1000
        ' Next i
        ReDim rebytes(7)
       
         rebytes(0) = Asc("*")
         rebytes(1) = Asc("~")
         rebytes(2) = Asc("2")
         rebytes(3) = Asc("a")
         rebytes(4) = Asc("f")
         jiaoyanhe = 0
           For i = 0 To 4
             jiaoyanhe = jiaoyanhe Xor rebytes(i)
           Next i
         rebytes(5) = Asc(jiaoyanhe)
         rebytes(6) = Asc("#")
        'MsgBox ("yyyyyyyy")
        MSComm1.Output = rebytes
        MSComm1.InBufferCount = 0
    ElseIf bytes(3) = Asc("a") And bytes(4) = Asc("f") And bytes(l - 1) = Asc("#") And bytes(5) <> Asc("#") Then '3
         ' For i = 0 To 1000
        ' Next i
         
                                 s = Val(Chr(bytes(5)))
                                  For i = 0 To s - 1
                                     k = k + Chr(bytes(6 + i))
                                  Next i
                                   summ = summ + Val(k)
                                  Label5.Caption = summ
         ReDim rebytes(7)
      
         rebytes(0) = Asc("*")
         rebytes(1) = Asc("~")
         rebytes(2) = Asc("2")
         rebytes(3) = Asc("a")
         rebytes(4) = Asc("o")
         jiaoyanhe = 0
         For i = 0 To 4
         jiaoyanhe = jiaoyanhe Xor rebytes(i)
         Next i
         rebytes(5) = Asc(jiaoyanhe)
         rebytes(6) = Asc("#")
       
       
      ' MsgBox ("llllllll")
       MSComm1.Output = rebytes
            
        MSComm1.OutBufferCount = 0
    
    End If '3
 
 
 '****************************************************
     If bytes(3) = Asc("b") And bytes(4) = Asc("q") And bytes(6) = Asc("#") Then '3
        ' For i = 0 To 1000
        ' Next i
        ReDim rebytes(7)
       
         rebytes(0) = Asc("*")
         rebytes(1) = Asc("~")
         rebytes(2) = Asc("2")
         rebytes(3) = Asc("b")
         rebytes(4) = Asc("f")
         jiaoyanhe = 0
         For i = 0 To 4
         jiaoyanhe = jiaoyanhe Xor rebytes(i)
         Next i
         rebytes(5) = Asc(jiaoyanhe)
         rebytes(6) = Asc("#")
       ' MsgBox ("yyyyyyyy")
        MSComm1.Output = rebytes
        MSComm1.InBufferCount = 0
    ElseIf bytes(3) = Asc("b") And bytes(4) = Asc("f") And bytes(l - 1) = Asc("#") And bytes(5) <> Asc("#") Then '3
         ' For i = 0 To 1000
        ' Next i
         
                                 sw = Val(Chr(bytes(5)))
                                 gw = Val(Chr(bytes(6)))
                                 s = sw * 10 + gw
                                 j = 0
                                  For i = 0 To s - 1
                                     c(j) = Chr(bytes(7 + i))
                                     j = j + 1
                                  Next i
                                  
                               summ0 = DateAdd("yyyy", Val(c(0) + c(1)), #1/1/2000#)
                               summ0 = DateAdd("m", Val(c(3) + c(4)) - 1, summ0)
                               summ0 = DateAdd("d", Val(c(6) + c(7)) - 1, summ0)
                                summ1 = DateAdd("h", Val(c(8) + c(9)), #12:00:00 AM#)
                               summ1 = DateAdd("n", Val(c(11) + c(12)), summ1)
                               summ1 = DateAdd("s", Val(c(14) + c(15)), summ1)
                               tt = DateDiff("n", summ1, Time)
                               ty = DateDiff("d", summ0, Date)
        
                        Date = DateAdd("d", -ty, Date)
        
                        Time = DateAdd("n", -tt, Time)
        
        
        
        '反回信息码
        ReDim rebytes(7)
      
         rebytes(0) = Asc("*")
         rebytes(1) = Asc("~")
         rebytes(2) = Asc("2")
         rebytes(3) = Asc("b")
         rebytes(4) = Asc("o")
         jiaoyanhe = 0
         For i = 0 To 4
         jiaoyanhe = jiaoyanhe Xor rebytes(i)
         Next i
         rebytes(5) = Asc(jiaoyanhe)
         rebytes(6) = Asc("#")
       
       
      ' MsgBox ("llllllll")
       
       MSComm1.Output = rebytes
            
        MSComm1.OutBufferCount = 0
    
    End If '3
    '*******************************************************
    If bytes(3) = Asc("c") And bytes(4) = Asc("q") And bytes(6) = Asc("#") Then '3
        ' For i = 0 To 1000
        ' Next i
        ReDim rebytes(7)
       
         rebytes(0) = Asc("*")
         rebytes(1) = Asc("~")
         rebytes(2) = Asc("1")
         rebytes(3) = Asc("c")
         rebytes(4) = Asc("f")
         jiaoyanhe = 0
           For i = 0 To 4
             jiaoyanhe = jiaoyanhe Xor rebytes(i)
           Next i
         rebytes(5) = Asc(jiaoyanhe)
         rebytes(6) = Asc("#")
        'MsgBox ("yyyyyyaa")
        MSComm1.Output = rebytes
        MSComm1.InBufferCount = 0
   ElseIf bytes(3) = Asc("c") And bytes(4) = Asc("o") And bytes(6) = Asc("#") Then  '3
         ' For i = 0 To 1000
        ' Next i
          st = CStr(biaodizhi)
          s = Len(CStr(biaodizhi))
                                 ' For i = 0 To s - 1
                                 '    k = k + Chr(bytes(6 + i))
                                 ' Next i
                                 '  summ = summ + Val(k)
                                 ' Label5.Caption = summ
         ReDim rebytes(s + 7)
      
         rebytes(0) = Asc("*")
         rebytes(1) = Asc("~")
         rebytes(2) = Asc("1")
         rebytes(3) = Asc("c")
         rebytes(4) = Asc("o")
               
         rebytes(5) = Asc(s)
          For i = 1 To s
             rebytes(5 + i) = Asc(Mid(st, i, 1))
          Next i
          '校验
         jiaoyanhe1 = 0
         For i = 0 To s + 5
           jiaoyanhe1 = jiaoyanhe1 Xor rebytes(i)
        Next i
          
         rebytes(s + 6) = Asc(jiaoyanhe)
         rebytes(s + 7) = Asc("#")
       
        MSComm1.InputLen = s + 6
        MSComm1.Output = rebytes
       
 
       
       
       'MsgBox ("llllllll")
      
            
        MSComm1.OutBufferCount = 0
    
    End If '3
    
    
    
    
 End If '2


Else '1
MSComm1.InBufferCount = 0
End If '1

      
  flag = 5
  'End If
  
End Sub

Private Sub Timer1_Timer()
Dim a As Integer
lblclock.Caption = Time$
Label3.Caption = Date$
If flag <> 0 Then
MSComm1.PortOpen = False
flag = 0
Else
 MSComm1.PortOpen = True
  flag = 2
   
  End If
 
End Sub

Private Sub Timer2_Timer()
Dim summ1 As String
Randomize
summ = summ + (Rnd() * 1) / 2 + (Rnd() * 1) Mod 2
Label5.Caption = Format(summ, "####.###")
summ1 = Format(Date, "yy.mm.dd") + Format(Time$, "hh:mm:ss") + Format(summ, "####.###")
If flag <> 0 Then MSComm1.Output = summ1
End Sub