OMRON PLC的VB数据采集程序示例

这是一个简单的通讯例子。各位可以与“PLC与第三方仪表通讯”作比较，基本的东东是一样的。请指教
建立一个程序：commtest
Form1 代码：
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 Command5_Click()
 End
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

怎么都是这种回贴呢，请多多指教啊