frmmain.frm

PC通过转换器与PLC通讯

End Sub




Private Sub Command1_Click(Index As Integer)
  Dim strTXSend As String
  Dim i As Integer
  
  Select Case Index
         Case 0
            If CheckData() Then
            'Dim i As Integer
            For i = 0 To 7
            ' MsgBox bySend(i)
            Debug.Print bySend(i)
            Next i
            'End
             strTXSend = FormatSend()
             On Error Resume Next
               If bConnectedOK Then
                   Winsock1.SendData bySend
   '               Winsock1.SendData strTXSend           用在 Server 下
                '  intTxCount = intTxCount + 1
                  Status1.SimpleText = "成功接收: " & intRxCount & "            " & "成功发送: " & intTxCount
                Else
                MsgBox "TCP连接未建立，请先建立连接再发送数据！", vbExclamation, "警告"
                End If
            Else
              MsgBox "输入数据错误!"
              Exit Sub
            End If
          Case 1
             If Winsock1.state <> sckClosed Then Winsock1.Close
             Unload Me
    End Select

  End Sub


Private Sub Command2_Click()
    If bConnectedOK Then
        Timer2.Enabled = True
        Timer2.Interval = 1500
    Else
        MsgBox "TCP连接未建立，请先建立连接再发送数据！", vbExclamation, "警告"
    End If
End Sub

Private Sub Form_Load()
   
    XJ_LOCK
    
    strChar = txtTCPSend.Text
    Option1(0).Value = True
    txtTCPSend.Enabled = False
    Label7.Enabled = False
    Label8.Enabled = False
    blRead = True
    Timer2.Enabled = False
On Error Resume Next
    Winsock1.Protocol = sckTCPProtocol          'Winsock控件设置为TCP协议
    Winsock1.RemotePort = 4660                '此值请勿修改！！！
    Winsock1.RemoteHost = "192.168.0.25"
    txtRemotePort.Text = Winsock1.RemotePort
    txtRemoteIP.Text = Winsock1.RemoteHost
End Sub


Private Sub Form_Unload(Cancel As Integer)
    If Winsock1.state <> sckClosed Then Winsock1.Close
End Sub

Private Sub Option1_Click(Index As Integer)
Select Case Index
       Case 0
       txtTCPSend.Enabled = False
       Label7.Enabled = False
       Label8.Enabled = False
       blRead = True
       Case 1
       txtTCPSend.Enabled = True
       Label7.Enabled = True
       Label8.Enabled = True
       blRead = False
End Select
End Sub

Private Sub Timer2_Timer()
On Error Resume Next
    Call CheckData
    Winsock1.SendData bySend
    intTxCount = intTxCount + 1
    Status1.SimpleText = "成功接收: " & intRxCount & "            " & "成功发送: " & intTxCount
Exit Sub
   Winsock1.Close
End Sub

'修改Winsock的RemoteHost属性
Private Sub txtRemoteIP_LostFocus()
On Error Resume Next
    If bConnectedOK Then Winsock1.Close
    Winsock1.RemoteHost = txtRemoteIP.Text

    Winsock1.Close
    Winsock1.RemoteHost = txtRemoteIP.Text
End Sub



Private Sub txtRemotePort_LostFocus()
On Error Resume Next
    If bConnectedOK Then Winsock1.Close
    Winsock1.RemotePort = txtRemotePort.Text

    Winsock1.Close
     Winsock1.RemotePort = txtRemotePort.Text
End Sub



Private Sub txtTCPSend_KeyPress(KeyAscii As Integer)

    If Len(txtTCPSend.Text) = 0 And Chr(KeyAscii) = "\" Then
      MsgBox " 输入格式错误!"
      intsErr = True
      Exit Sub
    Else
      If KeyAscii < 48 Or KeyAscii > 57 Then
         If KeyAscii = 8 Or KeyAscii = 92 Then Exit Sub
           
         MsgBox " 输入格式错误!"
         intsErr = True
      End If
  End If
End Sub

Private Sub txtTCPSend_LostFocus()
  Dim strTmp As String
    
  strTmp = Right(txtTCPSend.Text, 1)
  If strTmp < "0" Or strTmp > "9" Then MsgBox "输入格式错误!"

End Sub
Private Sub txtTCPSend_change()

  If intsErr Then
    txtTCPSend.Text = strChar
  Else
    strChar = txtTCPSend.Text
  End If
  intsErr = False
   
End Sub
  

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim strTcpRx As String
    Dim strTmp As String
    Dim intI As Integer
    Dim bytemp() As Byte
    Dim ss As String
    Winsock1.GetData bytemp    'strTcpRx      读取接收数据，并显示载列表框
    Debug.Print bytemp
  'If UBound(bytemp) >= 14 Then
     If bytemp(0) = 2 And bytemp(1) = 3 Then 'And bytemp(2) = 10 Then
    For intI = 0 To UBound(bytemp)
       Debug.Print bytemp(intI)
       txtTCPRecv.Text = txtTCPRecv.Text & "&H" & Hex(bytemp(intI)) & " "
    Next
   End If
  'End If
   '***********************************************
  'If UBound(bytemp) >= 7 Then
    If bytemp(0) = 2 And bytemp(1) = 16 Then 'And bytemp(2) = 6 Then
    For intI = 0 To 7 'UBound(bytemp)
       Debug.Print bytemp(intI)
       txtTCPRecv.Text = txtTCPRecv.Text & "&H" & Hex(bytemp(intI)) & " "
    Next
    End If
   'End If
    intRxCount = intRxCount + 1
    Status1.SimpleText = "成功接收: " & intRxCount & "            " & "成功发送: " & intTxCount
    
End Sub

Private Sub Timer1_Timer()
    lblState.Caption = "TCP连接状态: " & tcpState(Winsock1.state)
    If Winsock1.state = 7 Then
        bConnectedOK = True
    End If
End Sub

Function tcpState(state As Integer) As String
    Dim tcpStateStr As String
    
    Select Case state
    Case 0
        tcpStateStr = "关闭"
    Case 2
        tcpStateStr = "正在侦听..."
    Case 6
        tcpStateStr = "连接中..."
    Case 7
        tcpStateStr = "连接成功！ "
    Case Else
        tcpStateStr = state
    End Select
    tcpState = tcpStateStr
    
End Function

Function CheckData() As Boolean
  Dim intI, intI1, intTmp As Integer
  Dim strTmp As String
  If blRead Then
    ReDim bySend(7) As Byte
    bySend(0) = "&H" & Hex(Text1.Text)
    bySend(1) = &H3
    bySend(2) = "&H" & Hex(Int(Val(Text2.Text) / 256))
    bySend(3) = "&h" & Hex(Val(Text2.Text) Mod 256)
    bySend(4) = &H0
    bySend(5) = "&H" & Hex(Val(Text3.Text))
    Call CRC16(bySend(0), 6)
    'bySend(6) = HiByte
    'bySend(7) = LoByte
    CheckData = True
 
  Else
    ReDim bySend(9 + Text3.Text * 2 - 1) As Byte
    bySend(0) = "&h" & Hex(Text1.Text)
    bySend(1) = &H10
    bySend(2) = "&H" & Hex(Int(Val(Text2.Text) / 256))
    bySend(3) = "&h" & Hex(Val(Text2.Text) Mod 256)
    bySend(4) = &H0
    bySend(5) = "&H" & Hex(Val(Text3.Text))
    bySend(6) = "&h" & Hex(Val(Text3.Text) * 2)
    
     intI1 = 7
     On Error GoTo GoErr
    For intI = 0 To Len(txtTCPSend.Text)
       If Mid(txtTCPSend.Text, intI + 1, 1) <> "\" Or Mid(txtTCPSend.Text, intI + 1, 1) <> Null Then
          strTmp = strTmp + Mid(txtTCPSend.Text, intI + 1, 1)
        Else
          bySend(intI1) = "&h" & Hex(Int(Val(strTmp) / 256))
          intI1 = intI1 + 1
          bySend(intI1) = "&h" & Hex(Val(strTmp) Mod 256)
          intI1 = intI1 + 1
          strTmp = ""
        End If
     Next intI
    
    bySend(intI1) = "&h" & Hex(Int(Val(strTmp) / 256))
    intI1 = intI1 + 1
    bySend(intI1) = "&h" & Hex(Val(strTmp) Mod 256)
    intI1 = intI1 + 1
         
    Call CRC16(bySend(0), 9 + Text3.Text * 2 - 2)
    'bySend(intI1) = HiByte
    'bySend(intI1 + 1) = LoByte
    CheckData = True
   
  End If
  
    Dim i As Integer
    Text4.Text = ""
    For i = 0 To UBound(bySend)
     Text4.Text = Text4.Text & "&H" & Hex(bySend(i)) & " "
    Next
            
 Exit Function

GoErr:
    Select Case Err.Number
           Case 9
           MsgBox "输入数据与设定的数据数据长度不匹配"
           Case Else
           MsgBox "发生一个意外错误(错误代码." & Err.Number & ")"
    End Select
End Function
'仅用在有Svr下
Function FormatSend() As String
  Dim intI As Integer
  Dim strTmp As String
  
  strTmp = ""
  For intI = 0 To UBound(bySend)
    strTmp = strTmp & Hex(bySend(intI)) & ","
  Next intI
FormatSend = strTmp
End Function
Private Sub Winsock1_Close()
    '关闭连接
    Winsock1.Close
    bConnectedOK = False
    
   ' Status1.SimpleText = "连接关闭"
End Sub