ZHANGYL1981

我用VB编的程序与欧姆龙的PLC CPM1A通信，目的读取DM存储区的数据，我用了6个TIMER时钟，但是在我运行时总是出错提示：实时错误13 ，类型不匹配。我怀疑是这6个时钟的循环时间设置的问题，有没有高手告诉我问题在哪啊！我的邮箱zhangyongliangaaa@126.com
程序如下：
Dim tim As Integer
Private Sub Command1_Click()
Dim outstring As String
MSComm1.InBufferCount = 0
outstring = "@" + "00" + "SC" + "03"
fcdd$ = XORR(outstring)
outstring = outstring + fcdd$ + "*" + Chr$(13)
MSComm1.Output = outstring

Time_out = tim
Do
If tim > (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 Sub
Private Sub Command2_Click()
Dim outstring As String

MSComm1.InBufferCount = 0
outstring = "@" + "00" + "SC" + "00"
fcdd$ = XORR(outstring)
outstring = outstring + fcdd$ + "*" + Chr$(13)
MSComm1.Output = outstring

Time_out = tim
Do
If tim > (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 Sub
Private Sub Command3_Click()
Dim outstring As String
MSComm1.InBufferCount = 0
outstring = "@" + "00" + "WD" + "0012" + Text2.Text
fcdd$ = XORR(outstring)
outstring = outstring + fcdd$ + "*" + Chr$(13)
MSComm1.Output = outstring

Time_out = tim
Do
If tim > (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 Sub
Private Sub Command4_Click()
Dim outstring As String
MSComm1.InBufferCount = 0
outstring = "@" + "00" + "WD" + "0036" + (Text2.Text / 0.099695)
fcdd$ = XORR(outstring)
outstring = outstring + fcdd$ + "*" + Chr$(13)
MSComm1.Output = outstring

Time_out = tim
Do
If tim > (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 Sub
Private Sub Command5_Click()
End
End Sub
Private Sub Form_Load() '初始化
Caption = "Form1"
ClientHeight = 4095
ClientLeft = 60
ClientTop = 345
ClientWidth = 4275
LinkTopic = "Form1"
ScaleHeight = 4095
ScaleWidth = 4275
tim = 0
Call INIT_comm
End Sub
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
Private Sub Timer1_Timer()
Dim outstring As String

MSComm1.InBufferCount = 0 'clear off inbuffer
outstring = "@" + "00" + "RD" + "0010" + "0011"
fcdd$ = XORR(outstring)
outstring = outstring + fcdd$ + "*" + Chr$(13)
MSComm1.Output = outstring
Time_out = tim

'判断通讯错误
Do
If tim > (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)
Text1.Text = Mid(Instring, 8, 4) * 0.099695 '取出数据位
End Sub
Private Sub Timer2_Timer()
tim = tim + 1
End Sub
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
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$
Else
XORR = fcdd$
End If
End Function
Private Sub Timer3_Timer()
Dim outstring As String

MSComm1.InBufferCount = 0 'clear off inbuffer
outstring = "@" + "00" + "RD" + "0034"
fcdd$ = XORR(outstring)
outstring = outstring + fcdd$ + "*" + Chr$(13)
MSComm1.Output = outstring
Time_out = tim

'判断通讯错误
Do
If tim > (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)
Text3.Text = Mid(Instring, 8, 4) * 0.099695 '取出数据位
End Sub
Private Sub Timer4_Timer()
Dim outstring As String

MSComm1.InBufferCount = 0 'clear off inbuffer
outstring = "@" + "00" + "RD" + "0038"
fcdd$ = XORR(outstring)
outstring = outstring + fcdd$ + "*" + Chr$(13)
MSComm1.Output = outstring
Time_out = tim

'判断通讯错误
Do
If tim > (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)
Text5.Text = Mid(Instring, 8, 4) * 0.099695 '取出数据位
End Sub
Private Sub Timer5_Timer()
Text6.Text = Time
End Sub

07-10-24 17:44

1楼

编辑引用管理