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

xiaodao2008 2007-12-20 09:07:45

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

...全文