ccm2.frm

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

 Exit Sub
 End If
 
 If Asc(Mid(aaa, i, 1)) > 96 And Asc(Mid(aaa, i, 1)) < 103 Then
   Mid(aaa, i, 1) = Chr(Asc(Mid(aaa, i, 1)) - 32)
 End If
Next

For i = 1 To 4
temp = temp & Trim(Str(Hex(Asc(Mid(aaa, i, 1)))))            '注意trim不可少
Next
WA = WA
WC = WC
WI = "02" & temp & "03" & ToAsc(Lrc(temp))

End Sub

Private Sub Text3_LostFocus()                             '检查读取寄存器定义号
'Dim t3 As String                                          这里重复定义，t3会变""
Dim L, i As Integer
t3 = Text3.Text
L = Len(t3)
If t3 = "" Then MsgBox "请检查寄存器定义号！"
For i = 1 To L
 If Mid(t3, i, 1) <> 0 And Mid(t3, i, 1) <> 1 And Mid(t3, i, 1) <> 2 And Mid(t3, i, 1) <> 3 And Mid(t3, i, 1) <> 4 And Mid(t3, i, 1) <> 5 And Mid(t3, i, 1) <> 6 And Mid(t3, i, 1) <> 7 Then
   MsgBox "请检查寄存器定义号！"
   Exit Sub
 End If
Next
t3 = Hex(Val("&o" & t3) + 1)          '(1)oct-->hex
If Len(t3) = 1 Then t3 = "000" & t3
If Len(t3) = 2 Then t3 = "00" & t3
If Len(t3) = 3 Then t3 = "0" & t3
End Sub
Private Sub Combo2_LostFocus()                           '检查读取局号
r_station = Combo2.Text
If r_station = "" Then MsgBox "请检查局号号！"
r_station = Hex(Val(r_station))
If Len(r_station) = 1 Then
   r_station = "0" & r_station
End If
End Sub

Function ToAsc(x1 As String) As String             '************\
Dim L, i As Integer                                             '\
Dim x2 As String                                                 '\
L = Len(x1)                                                'Asc变换子程序，即“01”－》“3031”
x2 = ""
For i = 1 To L                                                   '/
   x2 = x2 & Trim(Str(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
Dim d() As Variant
ReDim d(i - 1)
For j = 0 To i - 1
  d(j) = Val(Mid(s1, 2 * j + 1, 2))                 '给数组成员赋值
Next
key = d(0)
For k = 0 To i - 2
  key = Hex(Val("&H" & Str(d(k + 1))) Xor Val("&H" & key)) '后面不能用Str（key）
Next
If Len(key) = 1 Then key = "0" & key
Lrc = Trim(key)
End Function
Private Sub sendRA()
Dim i, j As Integer
Dim d() As Byte
 i = Len(RA) / 2
ReDim d(i - 1)
    For j = 0 To i - 1
        d(j) = Val("&h" & Mid(RA, j * 2 + 1, 2))           '
    Next j
    
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True     '打开端口
comm_fg = True
 MSComm1.Output = d              '发送指令！
End Sub
Private Sub sendRC()
Dim d() As Byte
Dim i As Integer
 i = Len(RC) / 2
ReDim d(i - 1)
    For j = 0 To i - 1
        d(j) = Val("&h" & Mid(RC, j * 2 + 1, 2))           ' 。
    Next j
    
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True     '打开端口
MSComm1.Output = d          '发送指令！
End Sub
Private Sub sendRJ()
Dim d(0) As Byte
d(0) = &H6
MSComm1.Output = d          '发送指令！
End Sub
Private Sub sendRK()
Dim d(0) As Byte
d(0) = &H4
MSComm1.Output = d          '读操作结束！
End Sub
Private Sub sendWA()
Dim i, j As Integer
Dim d() As Byte
i = Len(WA) / 2
ReDim d(i - 1)
    For j = 0 To i - 1
        d(j) = Val("&h" & Mid(WA, j * 2 + 1, 2))
    Next j
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True     '打开端口
comm_fg = True
MSComm1.Output = d              '发送指令！
End Sub

Private Sub sendWC()
Dim d() As Byte
Dim i As Integer
 i = Len(WC) / 2
ReDim d(i - 1)
    For j = 0 To i - 1
        d(j) = Val("&h" & Mid(WC, j * 2 + 1, 2))
    Next j
    
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True     '打开端口
MSComm1.Output = d          '发送指令！
sentWC = True
End Sub
Private Sub sendWI()
Dim d() As Byte
Dim i As Integer
 i = Len(WI) / 2
ReDim d(i - 1)
    For j = 0 To i - 1
        d(j) = Val("&h" & Mid(WI, j * 2 + 1, 2))           '
    Next j
    
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True     '打开端口
MSComm1.Output = d          '发送指令！
'sentWI = True
End Sub
Private Sub sendSQA()
Dim i, j As Integer
Dim d() As Byte
i = Len(SQA) / 2
ReDim d(i - 1)
    For j = 0 To i - 1
        d(j) = Val("&h" & Mid(SQA, j * 2 + 1, 2))
    Next j
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True     '打开端口
comm_fg = True
MSComm1.Output = d              '发送指令！
End Sub
Private Sub sendRSQA()
Dim i, j As Integer
Dim d() As Byte
i = Len(RSQA) / 2
ReDim d(i - 1)
    For j = 0 To i - 1
        d(j) = Val("&h" & Mid(RSQA, j * 2 + 1, 2))
    Next j
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True     '打开端口
comm_fg = True
MSComm1.Output = d              '发送指令！
End Sub
Private Sub sendSQC()
Dim d() As Byte
Dim i As Integer
 i = Len(SQC) / 2
ReDim d(i - 1)
    For j = 0 To i - 1
        d(j) = Val("&h" & Mid(SQC, j * 2 + 1, 2))
    Next j
    
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True     '打开端口
MSComm1.Output = d          '发送指令！
sentSQC = True
End Sub
Private Sub sendRSQC()
Dim d() As Byte
Dim i As Integer
 i = Len(RSQC) / 2
ReDim d(i - 1)
    For j = 0 To i - 1
        d(j) = Val("&h" & Mid(RSQC, j * 2 + 1, 2))
    Next j
    
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True     '打开端口
MSComm1.Output = d          '发送指令！
sentRSQC = True
End Sub
Private Sub sendSQI()
Dim d() As Byte
Dim i As Integer
 i = Len(SQI) / 2
ReDim d(i - 1)
    For j = 0 To i - 1
        d(j) = Val("&h" & Mid(SQI, j * 2 + 1, 2))           '
    Next j
    
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True     '打开端口
MSComm1.Output = d          '发送指令！
End Sub
Private Sub sendRSQI()
Dim d() As Byte
Dim i As Integer
 i = Len(RSQI) / 2
ReDim d(i - 1)
    For j = 0 To i - 1
        d(j) = Val("&h" & Mid(RSQI, j * 2 + 1, 2))           '
    Next j
    
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True     '打开端口
MSComm1.Output = d          '发送指令！
End Sub
Private Sub sendQRC()
Dim d() As Byte
Dim i As Integer
QRC = "013031303330313031303030343031173037"
 i = Len(QRC) / 2
ReDim d(i - 1)
    For j = 0 To i - 1
        d(j) = Val("&h" & Mid(QRC, j * 2 + 1, 2))           '
    Next j
    
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True     '打开端口
MSComm1.Output = d          '发送指令！
sentQRC = True
End Sub
Private Sub Form_Load()
Dim setstring As String
        If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
        setstring = "9600,o,8,1"
        MSComm1.CommPort = 3  '设置通讯口
        MSComm1.Settings = setstring '设置通讯参数
        MSComm1.InBufferCount = 0   '清空接受缓冲
        MSComm1.InputLen = 0  '使 MSComm 控件读取接收缓冲区中全部的内容
        MSComm1.DTREnable = False   'yuan wei false
        MSComm1.InputMode = comInputModeBinary  '二进制方式读取
        MSComm1.Handshaking = 0
        MSComm1.RThreshold = 1 '每收到一个数据产生一个OnComm事件
        MSComm1.SThreshold = 1
End Sub
Private Sub Form_Unload(Cancel As Integer)
If MSComm1.PortOpen = True Then
   MSComm1.PortOpen = False                              '关闭窗口时同时关闭通讯端口
End If
End Sub

'×××××××××××××××××××××××××××××××××××××××××××××××××××××××
'程序运行时通过定时器空件使之不断读取Q0～Q7的状态，若在此之前按过其他有关读写操作的按钮，则先跳到相应的子程序
'进行相应的通讯。在此同时，通讯标志置位。
Private Sub Timer1_Timer()                                '循环读Q的状态
If comm_fg = True Then                                    '若遇到正在通讯，则等待下一次timer事件
  Exit Sub
End If

If w_fg Then                                              '若已按下“写入”
   Call sendWA
   Exit Sub
End If

If r_fg Then                                              '若已按下“读取”
   Call sendRA
   Exit Sub
End If

If setq_fg Then                                            '若已按下 setQ
   Call sendSQA
   Exit Sub
End If

If resetq_fg Then                                          '若已按下 resetQ
   Call sendRSQA
   Exit Sub
End If

RQA = "4E2105"                                             '默认子局是1号局
Dim d() As Byte
Dim i As Integer
 i = Len(RQA) / 2
ReDim d(i - 1)
    For j = 0 To i - 1
        d(j) = Val("&h" & Mid(RQA, j * 2 + 1, 2))           '
    Next j
    
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True     '打开端口
comm_fg = True                                               '表示正在进行通讯
MSComm1.Output = d          '发送指令！
rq_fg = True

End Sub


Private Sub checkq()                                     '用于显示Q0~Q7的状态
Dim a, b As Integer
a = Val("&h" & Mid(q0byte, 1, 1))
b = Val("&h" & Mid(q0byte, 2, 1))

If (b And 1) = 1 Then
imgg0(0).ZOrder
Else
imgr0.ZOrder
End If

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

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

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

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

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

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

If (a And 8) = 8 Then
imgg0(7).ZOrder
Else
imgr7.ZOrder
End If


End Sub