form22345.frm

光洋PLC串口通讯HEX编程实例,工控上用的,有用的朋友不要留情!!下吧!

    MSComm1.Settings = setstring '设置通讯参数
    MSComm1.InBufferCount = 0   '清空接受缓冲
    MSComm1.InputLen = 0  '使 MSComm 控件读取接收缓冲区中全部的内容
    MSComm1.DTREnable = False   '
    MSComm1.InputMode = comInputModeBinary '二进制方式读取
    MSComm1.Handshaking = 0
    MSComm1.RThreshold = 1 '每收到一个数据产生一个OnComm事件
    MSComm1.SThreshold = 1
End Sub

Private Sub Command1_Click()
    Dim i, j As Integer
    Dim d() As Byte
    sbuf = "4e2105"
    'If Not realcom_fg Then
    If Not Text1.Text = "" Then
        i = Len(sbuf) / 2 - 1
        ReDim d(i)
        For j = 0 To i
            d(j) = Val("&h" & Mid(sbuf, j * 2 + 1, 2))
        Next
        If MSComm1.PortOpen = False Then MSComm1.PortOpen = True     '打开端口
        MSComm1.Output = d
    End If
    'End If
    send_fg = True
    comm_fg = False
    stop_fg = True
End Sub

Private Sub Command3_Click()
    Dim i, j As Integer
    Dim d() As Byte
    sbuf = "4e2105"
    'If Not realcom_fg Then
    If Not Text1.Text = "" Then
        i = Len(sbuf) / 2 - 1
        ReDim d(i)
        For j = 0 To i
            d(j) = Val("&h" & Mid(sbuf, j * 2 + 1, 2))
        Next
        If MSComm1.PortOpen = False Then MSComm1.PortOpen = True     '打开端口
        MSComm1.Output = d
    End If
    Text5.Text = ""
    'End If
    send_fg = False
    comm_fg = False
    stop_fg = True
End Sub


Private Sub Command4_Click()
stop_fg = False
End Sub

Private Sub Form_Load()
    a$ = InputBox("COM:", "请输入所使用的端口号", "1", 3500, 3500)
    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    setstring = "9600,o,8,1"
    Combo1.Text = a
    MSComm1.CommPort = a  '设置通讯口
    MSComm1.Settings = setstring '设置通讯参数
    MSComm1.InBufferCount = 0   '清空接受缓冲
    MSComm1.InputLen = 0  '使 MSComm 控件读取接收缓冲区中全部的内容
    MSComm1.DTREnable = False   '
    MSComm1.InputMode = comInputModeBinary '二进制方式读取
    MSComm1.Handshaking = 0
    MSComm1.RThreshold = 1 '每收到一个数据产生一个OnComm事件
    MSComm1.SThreshold = 1
    comm_fg = False
    send_fg = False
    stop_fg = False
    realcom_fg = False
End Sub

Private Sub MSComm1_OnComm()
    If MSComm1.CommEvent = comEvReceive Then                         '接收到数据后
        data = MSComm1.Input
        lg = UBound(data)
        rbuf = data
        For i = 0 To lg
            rbuf1 = Hex(data(i))
            If Len(rbuf1) = 1 Then rbuf1 = "0" & rbuf1
        Next
        If lg = 2 And send_fg = True And comm_fg = False Then
            If data(0) = &H4E And data(1) = &H21 And data(2) = &H6 Then
            stop_fg = True
            Call senddata
            End If
        End If
        If lg = 0 And send_fg = True And comm_fg = False Then
            If data(0) = &H6 Then
            stop_fg = True
            Call senddata1
            End If
        End If
        If lg = 2 And send_fg = False And comm_fg = False Then
            If data(0) = &H4E And data(1) = &H21 And data(2) = &H6 Then
            stop_fg = True
            Call readdata
            End If
        End If
        If lg = 2 And comm_fg = True And send_fg = False Then
            If data(0) = &H4E And data(1) = &H21 And data(2) = &H6 Then
            realcom_fg = True
            stop_fg = True
            Call readdata1
            End If
        End If
        If lg = 5 And comm_fg = False And stop_fg = False Then
            If data(1) = &H2 And data(4) = &H3 Then
            Dim a!, b!
            a = Val(data(2))
            b = Val(data(3))
            Text5.Text = Hex(b) & Hex(a)
            End If
        End If
        If lg = 5 And comm_fg = True Then
            If data(1) = &H2 And data(4) = &H3 Then
            a = Val(data(2))
            If (a And 1) = 1 Then
            imgg0(0).ZOrder
            Else
            imgr0.ZOrder
            End If

            If (a And 2) = 2 Then
            imgg0(1).ZOrder
            Else
            imgr1.ZOrder
            End If

            If (a And 4) = 4 Then
            imgg0(2).ZOrder
            Else
            imgr2.ZOrder
            End If

            If (a And 8) = 8 Then
            imgg0(3).ZOrder
            Else
            imgr3.ZOrder
            End If

            If (a And 16) = 16 Then
            imgg0(4).ZOrder
            Else
            imgr4.ZOrder
            End If

            If (a And 32) = 32 Then
            imgg0(5).ZOrder
            Else
            imgr5.ZOrder
            End If

            If (a And 64) = 64 Then
            imgg0(6).ZOrder
            Else
            imgr6.ZOrder
            End If

            If (a And 128) = 128 Then
            imgg0(7).ZOrder
            Else
            imgr7.ZOrder
            End If
            End If
            'realcom_fg = False
        End If
    End If
End Sub

Private Sub senddata()
    Dim i, j As Integer
    Dim d() As Byte
    sbuf = Hex(Val("&o" & Text2.Text) + 1)
    If Len(sbuf) = 1 Then sbuf = "000" & sbuf
    If Len(sbuf) = 2 Then sbuf = "00" & sbuf
    If Len(sbuf) = 3 Then sbuf = "0" & sbuf
    If Len(sbuf) > 4 Then sbuf = "0000"
    sbuf = "30313831" & ToAsc(sbuf) & "30303032" & "3031"
    sbuf1 = "01" & sbuf & "17" & Lrc(sbuf)
    
    i = Len(sbuf1) / 2 - 1
    ReDim d(i)
    For j = 0 To i
        d(j) = Val("&h" & Mid(sbuf1, j * 2 + 1, 2))
    Next j
    If MSComm1.PortOpen = False Then MSComm1.PortOpen = True     '打开端口
    MSComm1.Output = d              '发送指令
    stop_fg = False
End Sub

Private Sub senddata1()
    Dim i, j As Integer
    Dim d() As Byte
    If Len(Text1.Text) = 1 Then Text1.Text = "000" & Text1.Text
    If Len(Text1.Text) = 2 Then Text1.Text = "00" & Text1.Text
    If Len(Text1.Text) = 3 Then Text1.Text = "0" & Text1.Text
    If Len(Text1.Text) > 4 Then Text1.Text = "0000"
    sbuf = Mid(Text1.Text, 3, 2) & Mid(Text1.Text, 1, 2)
    sbuf1 = "02" & sbuf & "03" & Lrc(sbuf)
    i = Len(sbuf1) / 2 - 1
    ReDim d(i)
    For j = 0 To i
        d(j) = Val("&h" & Mid(sbuf1, j * 2 + 1, 2))
    Next j
    If MSComm1.PortOpen = False Then MSComm1.PortOpen = True     '打开端口
    MSComm1.Output = d              '发送指令
    stop_fg = False
End Sub

Private Sub readdata()
    Dim i, j As Integer
    Dim d() As Byte
    sbuf = Hex(Val("&o" & Text6.Text) + 1)
    If Len(sbuf) = 1 Then sbuf = "000" & sbuf
    If Len(sbuf) = 2 Then sbuf = "00" & sbuf
    If Len(sbuf) = 3 Then sbuf = "0" & sbuf
    If Len(sbuf) > 4 Then sbuf = "0000"
    sbuf1 = "30313031" & ToAsc(sbuf) & "30303032" & "3031"
    sbuf1 = "01" & sbuf1 & "17" & Lrc(sbuf1)
    i = Len(sbuf1) / 2 - 1
    ReDim d(i)
    For j = 0 To i
        d(j) = Val("&h" & Mid(sbuf1, j * 2 + 1, 2))
    Next j
    If MSComm1.PortOpen = False Then MSComm1.PortOpen = True     '打开端口
    MSComm1.Output = d              '发送指令
    stop_fg = False
End Sub

Function ToAsc(x1 As String) As String
Dim L, i As Integer
Dim x2 As String
L = Len(x1)                                                'Asc变换子程序
x2 = ""
For i = 1 To L
   x2 = x2 & Trim(Hex(Asc(Mid(x1, i, 1))))
Next
ToAsc = x2
End Function

Function Lrc(s1 As String) As String
Dim i, j, k As Integer
Dim s  As String
Dim key As Variant
i = Len(s1) / 2 - 1
Dim d() As Variant
ReDim d(i)
For j = 0 To i
  d(j) = Val(Mid(s1, 2 * j + 1, 2))                 '校验码计算
Next
key = d(0)
For k = 1 To i
  key = Hex(Val("&H" & Str(d(k))) Xor Val("&H" & key))
Next
If Len(key) = 1 Then key = "0" & key
Lrc = Trim(key)
End Function

Private Sub readdata1()
    Dim i, j As Integer
    Dim d() As Byte
    sbuf1 = "01" & "30313033" & "30313031" & "30303032" & "3031" & "17" & "01"
    i = Len(sbuf1) / 2 - 1
    ReDim d(i)
    For j = 0 To i
        d(j) = Val("&h" & Mid(sbuf1, j * 2 + 1, 2))
    Next j
    If MSComm1.PortOpen = False Then MSComm1.PortOpen = True     '打开端口
    MSComm1.Output = d              '发送指令
    stop_fg = False
End Sub

Private Sub Text1_Click()
stop_fg = True
End Sub

Private Sub Text2_Click()
stop_fg = True

End Sub

Private Sub Text5_Click()
stop_fg = True

End Sub

Private Sub Text6_Click()
stop_fg = True

End Sub

Private Sub Timer1_Timer()
    realcom_fg = True
    If stop_fg = True Then Exit Sub
    If stop_fg = False Then
        Dim i, j As Integer
        Dim d() As Byte
        sbuf = "4e2105"
        If Not Text1.Text = "" Then
            i = Len(sbuf) / 2 - 1
            ReDim d(i)
            For j = 0 To i
            d(j) = Val("&h" & Mid(sbuf, j * 2 + 1, 2))
            Next
            If MSComm1.PortOpen = False Then MSComm1.PortOpen = True     '打开端口
        MSComm1.Output = d
        End If
    End If
    comm_fg = True
    send_fg = False
    realcom_fg = False
End Sub