Private Sub Form_Load()
Comm1.PortOpen = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
Comm1.PortOpen = False
End Sub


Private Sub CalcCRC(mes$)
Dim byt%, res&
'对消息进行crc校验，然后将结果添加到消息的结尾。
byt% = 3
Do
res& = res& Xor Asc(Mid(mes$, byt%, 1))
rotate res&
If Asc(Mid(mes$, byt%, 1)) = 16 Then
mes$ = Left$(mes$, byt%) + Chr(16) + Right$(mes$, Len(mes$) - byt%)
byt% = byt% + 1
End If
byt% = byt% + 1
Loop While (byt% <= Len(mes$) - 2)
res& = res& Xor 3
rotate res&
mes$ = mes$ + Chr(res& Mod 256) + Chr(Int(res& / 256))
End Sub

Function ReadTable(start, n%())
Dim st, com$
'从PLC CIF数据表中读取数据, Micrologix=N7 SLC500=N9
If comunicating Then Exit Function
comunicating = True
Form1.Comm1.InputLen = 0 '清缓冲区
com$ = Form1.Comm1.Input
'构建消息
com$ = Chr(16) + Chr(2) + Chr(0) + Chr(0)
com$ = com$ + Chr(1) + Chr(0) + Chr(tns%) + Chr(0)
com$ = com$ + Chr(start) + Chr(0) + Chr(UBound(n%) * 2)
com$ = com$ + Chr(16) + Chr(3)
'进行crc计算并附加到结尾。
CalcCRC com$
tns% = tns% + 1
If tns% = 256 Then tns% = 0
'发送命令
Form1.Comm1.Output = com$
'等待确认
st = Timer
Do
DoEvents
Loop While st + 3 > Timer And Form1.Comm1.InBufferCount < 2
'从缓冲中移除确认
Form1.Comm1.InputLen = 2
com$ = Form1.Comm1.Input
If com$ <> Chr(16) + Chr(6) Then
comunicating = False
Exit Function
End If
st = Timer '等待应答
Do
DoEvents
Loop While st + 3 > Timer And Form1.Comm1.InBufferCount < 12 + (UBound(n%) * 2)
'超时则退出
If Form1.Comm1.InBufferCount < 12 + (UBound(n%) * 2) Then
comunicating = False
Exit Function
End If
'发送确认
Form1.Comm1.Output = Chr(16) + Chr(6)
'得到应答
Form1.Comm1.InputLen = 0
com$ = Form1.Comm1.Input
st = 3
Do
If Mid(com$, st, 1) = Chr(16) Then
com$ = Left(com$, st) + Right(com$, Len(com$) - 1 - st)
End If
st = st + 1
Loop While st < Len(com$) - 4
'保存结果
For st = 0 To UBound(n%) - 1
n%(st) = 256 * Asc(Mid(com$, 2 * st + 10, 1)) + Asc(Mid(com$, 2 * st + 9, 1))
Next st
ReadTable = True
comunicating = False
End Function

Private Sub rotate(res&)
Dim bitout%, shift%
For shift% = 1 To 8
bitout% = res& Mod 2
res& = Int(res& / 2)
If bitout% Then
res& = res& Xor &H1000A001
res& = res& - &H10000000
End If
Next shift%
End Sub

Function WriteTable(start, n%())
Dim st, com$
'写到 PLC CIF数据表, Micrologix=N7 SLC500=N9
If comunicating Then Exit Function
comunicating = True
Form1.Comm1.InputLen = 0
com$ = Form1.Comm1.Input
com$ = Chr(16) + Chr(2) + Chr(0) + Chr(0)
com$ = com$ + Chr(8) + Chr(0) + Chr(tns%) + Chr(0)
com$ = com$ + Chr(start) + Chr(0)
For st = 0 To UBound(n%)
com$ = com$ + Chr(n%(st) Mod 256) + Chr(Int(n%(st) / 256))
Next st
com$ = com$ + Chr(16) + Chr(3)
tns% = tns% + 1
If tns% = 256 Then tns% = 0
CalcCRC com$
Form1.Comm1.Output = com$
st = Timer
Do
DoEvents
Loop While st + 3 > Timer And Form1.Comm1.InBufferCount < 2
Form1.Comm1.InputLen = 2
com$ = Form1.Comm1.Input
If com$ <> Chr(16) + Chr(6) Then
comunicating = False
Exit Function
End If
st = Timer
Do
DoEvents
Loop While st + 3 > Timer And Form1.Comm1.InBufferCount < 12
Form1.Comm1.Output = Chr(16) + Chr(6)
If Form1.Comm1.InBufferCount < 12 Then
comunicating = False
Exit Function
End If
Form1.Comm1.Output = Chr(16) + Chr(6)
WriteTable = True
comunicating = False
End Function


我以前做AB的,呵呵``大家一起研究,要是你有疑问的话可以给我电话:13518124089   QQ:27026521.我现在是做OPTO22成都办的技术支持,多指教.

要是在成都的话,可以直接来我们公司:
公   司：北京奥普图科技有限公司成都办事处
地   址：成都市西大街一号1#新城市广场D2-30-537#
           (4、7、37、56、57、62、64、98八宝街下车）
电   话: 028-8625-4216   13518124089
传   真: 028-8625-4236
网   址：http://www.opto22.cn 
Email : rwhuang@opto-tech.com.cn ( 收发邮件专用 ）
Windows Messenger 在线交流Email： boyhrw@hotmail.com ( 不用于收发邮件 ）
成都技术支持QQ:27026521

挺有技术含量的帖子!!!

ASCII模式----用LRC检测
RTU模式------用CRC检测

rwhuang高手呀！佩服