ccm2.frm

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

         Width           =   615
      End
      Begin VB.Label Label1 
         Caption         =   "R"
         Height          =   375
         Left            =   600
         TabIndex        =   8
         Top             =   480
         Width           =   495
      End
   End
   Begin VB.Label Label5 
      Caption         =   "CCM2通讯例子"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   21.75
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   6000
      TabIndex        =   14
      Top             =   4920
      Width           =   3255
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'
'
'本程序是一个通过CCM2协议来和光洋PLC通讯的例子。要了解CCM2协议的详细信息可以到光洋电子（无锡）的主页上去下载。
'地址为http://www.koyoele.com.cn/kew3/download/DM%C4%A3%BF%E9CCM%D0%AD%D2%E9/ccm2.pdf
'本程序演示了读、写寄存器的操作，读、写单个线圈Q的操作。
'本程序调试时用的是计算机的COM3,若您使用的计算机端口不是COM3,请到Private Sub Form_Load()里修改相应的参数。
'再使用本程序之前还要把PLC的CCM通讯方式设定成ASCII方式。因为本程序是基于ASCII方式编写的。其他通讯参数的设置应
'和本程序中的Private Sub Form_Load()里的通讯参数设置一致。
'
'
'
'
'



Public comm_fg As Boolean
Dim w_fg, r_fg, rq_fg, setq_fg, resetq_fg As Boolean
'以上分别是写寄存器标志，读寄存器标志，读q状态标志，setQ标志，reset Q标志
Dim sentWC, sentWI As Boolean
Dim sentQRA, sentQRC, sentSQC, sentRSQC As Boolean
Public r_station, RA, RC, RD, RE, RF, RQA, RQC As String
Public w_station, WA, WB, WC, WD, WE, WF, WI As String
Public SQA, SQC, SQI As String
Public RSQA, RSQC, RSQI As String
Public t3 As String
Public w3 As String
Dim data() As Byte                    '通讯空件接收到的数据
Dim ct As Integer
Dim q0byte As String



'wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww

Private Sub Command1_Click()                                     '写入按钮
Dim temp1 As String
WA = "4E" & LTrim(Str(Hex(32 + Val("&H" & w_station)))) & "05"
WC = ToAsc(w_station & "81" & w3 & "0004") & "3031"
temp1 = Lrc((WC))                                                '注意：自变量要加个（）！！！
WC = "01" & WC & "17" & ToAsc((temp1))
WI = WI
 w_fg = True
End Sub
'wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww







'rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr
Private Sub Command4_Click()                         '读取按钮
Dim temp1 As String
RA = "4E" & LTrim(Str(Hex(32 + Val("&H" & r_station)))) & "05"
RC = ToAsc(r_station & "01" & t3 & "0004") & "3031"
temp1 = Lrc((RC))                                                '注意：自变量要加个（）！！！
RC = "01" & RC & "17" & ToAsc((temp1))
r_fg = True
End Sub
'rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr
Private Sub Command5_Click()                   'SET Q 按钮
Dim n As Integer
Dim temp1, key As String
n = Val(Text8.Text)

Select Case n
Case 0
n = 1
Case 1
n = 2
Case 2
n = 4
Case 3
n = 8
Case 4
n = 16
Case 5
n = 32
Case 6
n = 64
Case 7
n = 128
End Select

key = Right("00" & Hex(Val("&H" & q0byte) Or n), 2)
'由于CCM2协议没有针对单个线圈操作的功能码，因此若要对单个线圈进行写操作，必须先读一组Q的状态，再通过一定的算法把
'结果重新写入到原来的那组线圈。例如，要set Q0：把Q0～Q7的状态作为一个2位十六进制数或（逻辑或）上“1”再重新写入
'Q0～Q7。
         
SQA = "4E" & LTrim(Str(Hex(32 + Val("&H" & "1")))) & "05"           '默认子局是1号局
SQC = ToAsc("01" & "83" & "01010002") & "3031"
temp1 = Lrc((SQC))                                                '注意：自变量要加个（）！！！
SQC = "01" & SQC & "17" & ToAsc((temp1))
SQI = "02" & ToAsc(key) & "03" & ToAsc(Lrc(ToAsc(key)))
setq_fg = True
End Sub


Private Sub Command6_Click()                       'RESET Q 按钮
Dim n As Integer
Dim temp1, key As String
n = Val(Text8.Text)

Select Case n
Case 0
n = 1
Case 1
n = 2
Case 2
n = 4
Case 3
n = 8
Case 4
n = 16
Case 5
n = 32
Case 6
n = 64
Case 7
n = 128
End Select

key = Right("00" & Hex(Val("&H" & q0byte) And (255 - n)), 2)
RSQA = "4E" & LTrim(Str(Hex(32 + Val("&H" & "1")))) & "05"            '默认子局是1号局
RSQC = ToAsc("01" & "83" & "01010002") & "3031"
temp1 = Lrc((RSQC))                                                '注意：自变量要加个（）！！！
RSQC = "01" & RSQC & "17" & ToAsc((temp1))
RSQI = "02" & ToAsc(key) & "03" & ToAsc(Lrc(ToAsc(key)))
resetq_fg = True
End Sub

'********************************************************************************************************
                                                                                                        '*
                                                                                                         '*
Private Sub MSComm1_OnComm()                                     '接收到数据！！！！！！以后
 Dim ArriveStr, cc As String
 Dim i As Integer
 
If MSComm1.CommEvent = comEvReceive Then                         '接收到数据！！！！！！以后
    data = MSComm1.Input
    ct = UBound(data)
  For i = 0 To ct
    'Text6.Text = Text6.Text & Str(i) & ")" & Hex(data(i)) & ";"        '显示通讯过程中的数据，可以方便调试
  Next
    
    
    
If r_fg = True Then                                                   '（1）如果是读寄存器操作的请求
  If ct = 3 Then
      If data(0) = &H4E And data(1) = &H21 And data(2) = &H6 Then                 '如果读到了ACK信号
        Call sendRC
      End If
  End If
  
  If ct = 7 Then
    If data(0) = &H6 And data(1) = &HD Then                                       '显示寄存器数值！！！
    Text4.Text = Chr(data(5)) & Chr(data(6)) & Chr(data(3)) & Chr(data(4))
    End If
  End If
  
  If ct = 2 Then
    If data(2) = &HD Then Call sendRJ                                             '发送应答ack
  End If
  
  If ct = 1 Then
    If data(0) = 4 And data(1) = &HD Then
    Call sendRK
    r_fg = False                                                                 '读寄存器标志复位
    comm_fg = False                                                              '通讯标志复位
    End If
  End If
End If
  
If w_fg = True Then                                                 '（2）如果是写寄存器操作的请求
  If ct = 3 Then
      If data(0) = &H4E And data(1) = &H21 And data(2) = &H6 Then
         Call sendWC
      End If
  End If
  
  If sentWC = True And ct = 1 Then
      If data(0) = &H6 And data(1) = &HD Then
         Call sendWI
         sentWC = False
      End If
      w_fg = False                                                               '写寄存器标志复位
      comm_fg = False                                                            '通讯标志复位
  End If
     
  If sentWI = True And ct = 1 Then                             '
      If data(0) = &H6 And data(1) = &HD Then
         Call sendRK                                     '<-------
         w_fg = False
         sentWI = False
         comm_fg = False
         MsgBox " 写入成功！"
      End If
  End If

End If
  
If rq_fg = True Then                                                '（3）如果是读Q点的操作的请求
  If ct = 3 Then
    If data(2) = &H6 And data(3) = &HD Then
      Call sendQRC
    End If
  End If
  
  If ct = 7 Then
    If data(0) = &H6 And data(1) = &HD Then
      q0byte = Chr(data(3)) & Chr(data(4))
      Call sendRK
      Call checkq
    Else
    MsgBox "子局没有正确应答！"
    End If
    rq_fg = False                                                       '读Q标志复位
    comm_fg = False                                                     '通讯标志复位
  End If
End If
  
If setq_fg Then                                                     '（4）如果set Q点的操作的请求
  If ct = 3 Then
    If data(2) = &H6 And data(3) = &HD Then
     Call sendSQC
    End If
  End If
  
  If sentSQC = True Then
   If sentSQC = True And ct = 1 Then
      If data(0) = &H6 And data(1) = &HD Then
      SQI = SQI
         Call sendSQI
         sentSQC = False
      End If
      setq_fg = False                                                       'set Q标志复位
      comm_fg = False                                                       '通讯标志复位
   End If
  End If
End If
  
If resetq_fg Then                                                     '（4）如果reset Q点的操作的请求
  If ct = 3 Then
    If data(2) = &H6 And data(3) = &HD Then
     Call sendRSQC
    End If
  End If
  
  If sentRSQC = True Then
   If sentRSQC = True And ct = 1 Then
      If data(0) = &H6 And data(1) = &HD Then
         Call sendRSQI
         sentRSQC = False
      End If
      resetq_fg = False                                                     'reset Q标志复位
      comm_fg = False                                                       '通讯标志复位
   End If
  End If
End If
  
  If data(0) = &H15 Then MsgBox "子局没有正确应答！"                        '若通讯出错，则产生提示
  'Text6.Text = Text6.Text & vbCrLf



End If
End Sub
                                                                                                          '*
                                                                                                         '*
'********************************************************************************************************

Private Sub Text1_LostFocus()                             '检查写入寄存器定义号
Dim L, i As Integer
w3 = Text1.Text
L = Len(w3)
For i = 1 To L
 If Mid(w3, i, 1) <> 0 And Mid(w3, i, 1) <> 1 And Mid(w3, i, 1) <> 2 And Mid(w3, i, 1) <> 3 And Mid(w3, i, 1) <> 4 And Mid(w3, i, 1) <> 5 And Mid(w3, i, 1) <> 6 And Mid(w3, i, 1) <> 7 Then
   MsgBox "请检查寄存器定义号！"
   Exit Sub
 End If
Next
w3 = Hex(Val("&o" & w3) + 1)          '(1)oct-->hex
If Len(w3) = 1 Then w3 = "000" & w3
If Len(w3) = 2 Then w3 = "00" & w3
If Len(w3) = 3 Then w3 = "0" & w3
End Sub
Private Sub Combo1_LostFocus()                               ' 检查写入局号
w_station = Combo1.Text
w_station = Hex(Val(w_station))
If Len(w_station) = 1 Then
   w_station = "0" & w_station
End If
End Sub


Private Sub Text2_LostFocus()                         '检查写入数据
Dim i, lenth As Integer
Dim aaa, temp As String

aaa = Text2.Text
lenth = Len(aaa)
Select Case lenth
  Case 0
  MsgBox "请填入要写入的数据！"
  Exit Sub
  Case 1
  aaa = "000" & aaa
  Case 2
  aaa = "00" & aaa
  Case 3
  aaa = "0" & aaa
  Case 4
  aaa = aaa
  Case Else
  MsgBox "请检查写入的数据是否合法！"
  Exit Sub
End Select
aaa = Mid(aaa, 3, 2) & Mid(aaa, 1, 2)
For i = 1 To 4
 If Not ((Asc(Mid(aaa, i, 1)) > 47 And Asc(Mid(aaa, i, 1)) < 58) Or (Asc(Mid(aaa, i, 1)) > 64 And Asc(Mid(aaa, i, 1)) < 71) Or (Asc(Mid(aaa, i, 1)) > 96 And Asc(Mid(aaa, i, 1)) < 103)) Then
 MsgBox "请检查写入的数据是否合法！"