form1.frm

和 S7 200自由口进行通讯,上位机采用VB控制.

MSComm1.InBufferCount = 0                   '清空接收缓冲区
If MSComm1.PortOpen = False Then
                Command3.Caption = "打开串口"
         Else
                Command3.Caption = "关闭串口"
         End If
End Sub
Private Sub Command1_Click()
Timer1.Enabled = True
End Sub
Private Sub Command2_Click()                          '退出程序，定时器1无效
Timer1.Enabled = False
Cls
Unload Me
End Sub
Private Sub Command3_Click()
        On Error Resume Next
        If MSComm1.PortOpen = False Then
            MSComm1.PortOpen = True
        Else
               MSComm1.PortOpen = False
        End If
        If MSComm1.PortOpen Then                       '打开关闭按钮显示文字
             Command3.Caption = "关闭串口"
             
        Else
              Command3.Caption = "打开串口"
             
              End If
        
          If Err Then                                  '打开串口失败，则显示出错信息
               MsgBox Error$, 48, "错误信息"
                Exit Sub
           End If
End Sub
Private Sub Timer1_Timer()              '读V存储区数据
Dim Tempfes As String
Dim aa(32) As Byte                      '定义动态数组
      aa(0) = &H67
      
      aa(1) = &H5
      
      aa(2) = &H30
      aa(3) = &H32
      
      aa(4) = &H30
      aa(5) = &H38
      aa(6) = &H30
      aa(7) = &H30
      
      aa(8) = &H30
      aa(9) = &H31
      aa(10) = &H32
      aa(11) = &H43
     
      aa(12) = &H31
      aa(13) = &H30
      
      aa(14) = &H30
      aa(15) = &H30
      aa(16) = &H30
      aa(17) = &H30
      aa(18) = &H30
      aa(19) = &H30
      aa(20) = &H30
      aa(21) = &H30
      aa(22) = &H30
      aa(23) = &H30
      aa(24) = &H30
      aa(25) = &H30
      aa(26) = &H30
      aa(27) = &H30
      aa(28) = &H30
      aa(29) = &H30
      
      aa(30) = &H37
      aa(31) = &H45
      aa(32) = &H47
  MSComm1.OutBufferCount = 0                           '清空输出寄存器
  MSComm1.Output = aa
End Sub
Private Sub Command4_Click()           '读I状态
Dim FGetData As String
Dim Tempfes As String
Dim aa(32) As Byte                      '定义动态数组
      aa(0) = &H67
      
      aa(1) = &H5
      
      aa(2) = &H30
      aa(3) = &H32
      
      aa(4) = &H30
      aa(5) = &H30
      aa(6) = &H30
      aa(7) = &H30
      
      aa(8) = &H30
      aa(9) = &H30
      aa(10) = &H30
      aa(11) = &H30
     
      aa(12) = &H31
      aa(13) = &H30
      
      aa(14) = &H30
      aa(15) = &H30
      aa(16) = &H30
      aa(17) = &H30
      aa(18) = &H30
      aa(19) = &H30
      aa(20) = &H30
      aa(21) = &H30
      aa(22) = &H30
      aa(23) = &H30
      aa(24) = &H30
      aa(25) = &H30
      aa(26) = &H30
      aa(27) = &H30
      aa(28) = &H30
      aa(29) = &H30
      
      aa(30) = &H30
      aa(31) = &H36
      aa(32) = &H47
  MSComm1.OutBufferCount = 0                           '清空输出寄存器
  MSComm1.Output = aa
  
  FGetData = IReceiveData
  
             p31 = Chr(Val("&H" & (Mid(FGetData, 5, 2))))
             p32 = Chr(Val("&H" & Mid(FGetData, 7, 2)))
             p33 = Chr(Val("&H" & Mid(FGetData, 9, 2)))
             p34 = Chr(Val("&H" & Mid(FGetData, 11, 2)))
             
             i00 = p31 + p32
             i01 = p33 + p34

End Sub
Private Sub Command5_Click()           '读Q状态
Dim FGetData As String
Dim Tempfes As String
Dim aa(32) As Byte                      '定义动态数组
      aa(0) = &H67
      
      aa(1) = &H5
      
      aa(2) = &H30
      aa(3) = &H32
      
      aa(4) = &H30
      aa(5) = &H31
      aa(6) = &H30
      aa(7) = &H30
      
      aa(8) = &H30
      aa(9) = &H30
      aa(10) = &H30
      aa(11) = &H30
     
      aa(12) = &H31
      aa(13) = &H30
      
      aa(14) = &H30
      aa(15) = &H30
      aa(16) = &H30
      aa(17) = &H30
      aa(18) = &H30
      aa(19) = &H30
      aa(20) = &H30
      aa(21) = &H30
      aa(22) = &H30
      aa(23) = &H30
      aa(24) = &H30
      aa(25) = &H30
      aa(26) = &H30
      aa(27) = &H30
      aa(28) = &H30
      aa(29) = &H30
      
      aa(30) = &H30
      aa(31) = &H37
      aa(32) = &H47
  MSComm1.OutBufferCount = 0                           '清空输出寄存器
  MSComm1.Output = aa
  
  FGetData = QReceiveData
             p35 = Chr(Val("&H" & (Mid(FGetData, 5, 2))))
             p36 = Chr(Val("&H" & Mid(FGetData, 7, 2)))
             p37 = Chr(Val("&H" & Mid(FGetData, 9, 2)))
             p38 = Chr(Val("&H" & Mid(FGetData, 11, 2)))
             
             q00 = p35 + p36
             q01 = p37 + p38

End Sub
Private Sub MSComm1_OnComm()                               '接收数据
Dim i%, buf$
Dim hexdisp As String
Dim inByte() As Byte
Dim tmp As Variant                                         '很重要
    buf = " "
Select Case MSComm1.CommEvent
Case comEvReceive                                          '有接受事件发生
tmp = MSComm1.Input
inByte = tmp                                                '接收二进制数据
For i = LBound(inByte) To UBound(inByte)
              buf = buf + Hex(inByte(i))
        Next i
              hexdisp = hexdisp + buf
              Text5.Text = hexdisp
             p11 = Chr(Val("&H" & (Mid(hexdisp, 5, 2))))
             p12 = Chr(Val("&H" & Mid(hexdisp, 7, 2)))
             p13 = Chr(Val("&H" & Mid(hexdisp, 9, 2)))
             p14 = Chr(Val("&H" & Mid(hexdisp, 11, 2)))
             
             p15 = Chr(Val("&H" & (Mid(hexdisp, 13, 2))))
             p16 = Chr(Val("&H" & Mid(hexdisp, 15, 2)))
             p17 = Chr(Val("&H" & Mid(hexdisp, 17, 2)))
             p18 = Chr(Val("&H" & Mid(hexdisp, 19, 2)))
             
             p21 = Chr(Val("&H" & (Mid(hexdisp, 21, 2))))
             p22 = Chr(Val("&H" & Mid(hexdisp, 23, 2)))
             p23 = Chr(Val("&H" & Mid(hexdisp, 25, 2)))
             p24 = Chr(Val("&H" & Mid(hexdisp, 27, 2)))
             
             p25 = Chr(Val("&H" & (Mid(hexdisp, 29, 2))))
             p26 = Chr(Val("&H" & Mid(hexdisp, 31, 2)))
             p27 = Chr(Val("&H" & Mid(hexdisp, 33, 2)))
             p28 = Chr(Val("&H" & Mid(hexdisp, 35, 2)))
             
             
             a11 = p11 + p12 + p13 + p14
             b11 = p15 + p16 + p17 + p18
             c11 = p21 + p22 + p23 + p24
             d11 = p25 + p26 + p27 + p28
        
End Select
End Sub
Private Function IReceiveData() As String    '数据发出去以后就调用此函数
    Dim FGetData As String
    Dim t1 As Long
    Dim av As Variant
    Dim i As Integer
    Dim ReDataLen As Integer
    
    FGetData = ""
    t1 = GetTickCount()                     '取时间，做延时用
    Do                                      '循环等待接收数据
        DoEvents
        If MSComm1.InBufferCount > 0 Then          '串口有数据了
            ReDataLen = MSComm1.InBufferCount      '取数据长度
            av = MSComm1.Input                     '将串口数据取出来
                For i = 0 To ReDataLen - 1
                    FGetData = FGetData & Right("00" & Hex(av(i)), 2)
                Next i
       End If
        If Len(FGetData) >= 6 Then
        
            If Len(FGetData) > 19 Then
                IReceiveData = FGetData
                Exit Function
            End If
        End If
        If GetTickCount - t1 > 2000 Then               '2秒没收完就不收了
            IReceiveData = ""
            Exit Function
        End If
    Loop
End Function
Private Function QReceiveData() As String    '数据发出去以后就调用此函数
    Dim FGetData As String
    Dim t1 As Long
    Dim av As Variant
    Dim i As Integer
    Dim ReDataLen As Integer
    
    FGetData = ""
    t1 = GetTickCount()                     '取时间，做延时用
    Do                                      '循环等待接收数据
        DoEvents
        If MSComm1.InBufferCount > 0 Then          '串口有数据了
            ReDataLen = MSComm1.InBufferCount      '取数据长度
            av = MSComm1.Input                     '将串口数据取出来
                For i = 0 To ReDataLen - 1
                    FGetData = FGetData & Right("00" & Hex(av(i)), 2)
                Next i
       End If
        If Len(FGetData) >= 6 Then
        
            If Len(FGetData) > 19 Then
                QReceiveData = FGetData
                Exit Function
            End If
        End If
        If GetTickCount - t1 > 2000 Then               '2秒没收完就不收了
            QReceiveData = ""
            Exit Function
        End If
    Loop
End Function
Private Sub Timer2_Timer()
x1 = x1 + 1
Text10.Text = x1
Text1.Text = Val("&H" & (a11))
Text2.Text = Val("&H" & (b11))
Text3.Text = Val("&H" & (c11))
Text4.Text = Val("&H" & (d11))

Text7.Text = Val("&H" & (q00))
If Text7.Text = 1 Then Text7.BackColor = RGB(255, 0, 255)
If Text7.Text = 0 Then Text7.BackColor = RGB(0, 255, 255)
Text6.Text = Val("&H" & (q01))
If Text6.Text = 1 Then Text6.BackColor = RGB(255, 0, 255)
If Text6.Text = 0 Then Text6.BackColor = RGB(0, 255, 255)


Text9.Text = Val("&H" & (i00))
If Text9.Text = 1 Then Text9.BackColor = RGB(255, 0, 255)
If Text9.Text = 0 Then Text9.BackColor = RGB(0, 255, 255)
Text8.Text = Val("&H" & (i01))
If Text8.Text = 1 Then Text8.BackColor = RGB(255, 0, 255)
If Text8.Text = 0 Then Text8.BackColor = RGB(0, 255, 255)
End Sub