OMRON PLC 串口通讯控制程序 200分相赠解决问题后再开帖给分

nishiyitouniu 2007-12-20 21:07 楼主

OMRON CPM1A PLC通讯控制程序有没有人有能正常工作的，能否告诉我如何实现？

我在网上下载了一个OMRON PLC 串口通讯程序，可是总是报说：格式错误！
或者:我该在Text2中输入什么命令呢?

Private Sub Command1_Click()
  Call read_db("00", "rd", Text2.Text, 1, value1())  '读取DM中数
  Text1(0).Text = value1(0)
End Sub
Private Sub Command2_Click()
  value5(J) = Val(Text1(1).Text) '(set_v(J))为程序中设置值的变量
  Call Write_db("00", "wd", Text2.Text, 1, value5()) '向DM中写数据
End Sub

Private Sub Form_Load()       '初始化
  Call INIT_comm
End Sub
Public Function read_db(ByVal pntNumber As String, _
  ByVal Order As String, ByVal startAddress As String, _
  ByVal Lengh As Integer, ByRef value() As Single)
  Dim outstring As String
  MSComm1.InBufferCount = 0 'clear off  inbuffer
  Order = UCase(Order)    '命令大写
  keyorder = startAddress '首地址
  If Lengh > 20 Then
Lengh = 20
  End If
outstring = "@" + pntNumber + Order + keyorder + "00" + Trim(Str(Lengh))
fcdd$ = XORR(outstring)
outstring = outstring + fcdd$ + "*" + Chr$(13)
MSComm1.Output = outstring
Time_out = Timer

'判断通讯错误
Do
   If Timer > (Time_out + 1) Then
      ERROR_COM = True
   Else
      ERROR_COM = False
   End If
      DoEvents
Loop Until ((MSComm1.InBufferCount >= 11 + 4 * Lengh) Or (ERROR_COM = True))
Instring = MSComm1.Input
order1 = Mid(Instring, 6, 2)  '结束码
Call ErrMessage(order1)
For I = 0 To Lengh - 1
   zhancun = Mid(Instring, 8 + I * 4, 4)  '取出数据位
   value(I) = Revert(zhancun)
Next
End Function
Public Function Write_db(ByVal pntNumber As String, _
ByVal Order As String, ByVal startAddress As String, _
ByVal Lengh As Integer, ByRef value() As Single)
Dim value1(19) As String

MSComm1.InBufferCount = 0
If Lengh > 8 Then
   Lengh = 8
End If
Order = UCase(Order)
   outstring = "@" + pntNumber + Order + "0" + startAddress
   For J = 0 To 19
   If an_set(J) = True Then
      value1(J) = four_bit(value5(J))
      outstring = outstring + value1(J)
   End If
Next
   fcdd$ = XORR(outstring)
   outstring = outstring + fcdd$ + "*" + Chr$(13)
   MSComm1.Output = outstring
   Time_out = Timer
   Do
   If Timer > (Time_out + 1) Then
      ERROR_COM = True
   Else
      ERROR_COM = False
   End If
   DoEvents
   Loop Until ((MSComm1.InBufferCount >= 11) Or (ERROR_COM = True))
   Instring = MSComm1.Input
   endcode = Mid(Instring, 6, 2)
   Call ErrMessage(endcode)
End Function
Public Sub INIT_comm()
  'Buffer to hold input string
  Dim Instring, outstring As String
MSComm1.CommPort = 1 'Use COM1.
MSComm1.Settings = "9600,e,7,2"  '9600 baud, e parity, 7 data, and 2 stop bit.
MSComm1.InputLen = 0 'Tell the control to read entire buffer when Input
MSComm1.PortOpen = True 'Open the port.
End Sub

模块Module1代码：
Public ERR0R_COM As Boolean
Public an_set(19) As Boolean
Public alarm(19) As Boolean
Public set_v(19) As String
Public value1(19) As Single
Public value3(3) As Single
Public value4(19) As Integer
Public value5(255) As Single
Public value6(1) As Single
Public value7(1) As Single
Public n(1) As String
Public DIGIT_IN(5, 15) As Boolean
Public Function ErrMessage(ByVal X As String)
  Select Case X
Case "13"
   MsgBox "校验错误"
Case "14"
   MsgBox "格式错误"
Case "15"
   MsgBox "入口码错误"
Case "18"
   MsgBox "帧长度错误"
Case "A3"
   MsgBox "传送数据时因FCS错误引起终止"
Case "A8"
   MsgBox "传送数据时因长度错误引起在终止"
  End Select
End Function
Public Function Revert(ByVal X As String) As Long  '16进制转换10进制
K = 0
For I = 1 To 4
   F$ = Mid$(X, I, 1)
   If F$ = "A" Then
      J = 10
   ElseIf F$ = "B" Then
      J = 11
   ElseIf F$ = "C" Then
      J = 12
   ElseIf F$ = "D" Then
      J = 13
   ElseIf F$ = "E" Then
      J = 14
   ElseIf F$ = "F" Then
      J = 15
   Else
      J = Val(F$)
   End If
   K = K * 16 + J
Next
Revert = K
K = 0
End Function
Public Function four_bit(ByVal X As Single) As String '位数处理
  b = Trim(Hex(X))
  A = Len(b)
  Select Case A
Case 1
   four_bit = "000" + b
Case 2
   four_bit = "00" + b
Case 3
   four_bit = "0" + b
Case 4
   four_bit = b
  End Select
End Function
Function XORR(ByVal STRI As String) As String '校验码的异或处理
Dim I, J, K As Integer
J = Len(STRI)
K = 0
For I = 1 To J
  K = Asc(Mid$(STRI, I, 1)) Xor K
Next I
fcdd$ = Hex$(K)
If Len(fcdd$) = 1 Then
  XORR = "0" + fcdd$
End If
  XORR = fcdd$
End Function