zb_comm.txt

vb与plc通信 vb 使用mscomm1 控件与三菱plc通信程序

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ComOpt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'                      COM口操作模块
Option Explicit
Dim ShareV As New ShareC
Dim Flag_go As Integer, VMsg As String

Public Function WaitPort(DevV As Object, RetC() As Byte) As Integer
'功能：
'     每10秒内须接收字符
'入口: DevV As object = COM口控件
'      RetC() As Byte 须定义好长度为所要读的字符个数
'出口：
'      RetC() As Byte 已收到的字符
'返回:
'      出错码:=1  收到要求数量的字符
'            =-1  收不到任何字符
'            =-2  用户中断
'            =-3  字符不够
 Dim WaitV As Double, i As Integer, j As Integer
 Dim sS() As Byte, k As Integer

'计算所要读出的长度
    j = 0
    k = LBound(RetC)
    i = UBound(RetC) - k + 1
With DevV
    Do While j < i
        WaitV = Timer + 8   '10秒内应有字符
        Do While Timer < WaitV And .InBufferCount < i
           DoEvents
           If Flag_go = True Then
             WaitPort = RetF(-2, "用户中断")
             GoTo Exit00
           End If
        Loop
        '10秒收不到,出错码=-1,RetC(0)=已收到的字符个数,退出
        If .InBufferCount = 0 Then
          WaitPort = RetF(-1, "收不到字符")
          Exit Function
        End If
        If j = .InBufferCount Then Exit Do  '该10秒内无字符到,结束等待
        j = .InBufferCount
    Loop    'j
    If j < i Then
        WaitPort = RetF(-3, "字数不够")
    Else
        j = i '读出长度不能超过要求的个数
        WaitPort = RetF(1, "完成")
    End If
    .InputLen = j
    ReDim sS(j - 1)
    sS = .Input '接收J个字符
'拷到用户的数组中
    For i = 0 To j - 1
        RetC(i + k) = sS(i)
    Next i
End With
    Exit Function
'====================================
    DevV.InputLen = 1                   '一次读一个
'记录收到的字符

    For i = LBound(RetC) To UBound(RetC)      '共要读NumS个
'等一个字符
      WaitV = Timer + 10   '10秒内应有字符
      Do While Timer < WaitV And DevV.InBufferCount = 0
       If Flag_go = True Then
         WaitPort = RetF(-2, "用户中断")
         GoTo Exit00
       End If
       DoEvents
      Loop
'10秒收不到,出错码=-1,RetC(0)=已收到的字符个数,退出
      If DevV.InBufferCount = 0 Then
        WaitPort = RetF(-1, "收不到字符")
        GoTo Exit00
      End If
'字符存入RetC()
      sS = DevV.Input
      RetC(i) = sS(0)
    Next i
'收到字符，Waitport =1
    WaitPort = RetF(1, "收到要求数量的字符")
Exit00:
End Function

Public Function Feb90(DevV As Object) As Integer
'功能：
'     追同步字
'入口：
'     DevV as object  = COM 口控件
'出口：
'
'返回：
'     Feb90 = 1  已追到同步字
'           =-1  一个字符都收不到
'           =-2  追不到同步字
'           =-3  用户中断
 Dim sS(0) As Byte, WaitV As Double, flag As Integer, i As Integer
 DevV.InputMode = comInputModeBinary

'设总时间为60秒
    i = 0
    WaitV = Timer + 60
    Do While Timer < WaitV
'读一个字符
        flag = WaitPort(DevV, sS)
        If flag < 0 Then
'10秒读不到1个字符，Feb90 = -2
          Feb90 = RetF(-2, "追不到同步字")
'10秒连1个字符都读不到, Feb90=-1,退出
          If i = 0 Then Feb90 = RetF(-1, "一个字符都收不到")
          If Flag_go = True Then Feb90 = RetF(-3, "用户中断")
          Exit Function
        End If
        i = i + 1
'是&HEB了
        Do While sS(0) = &HEB And Timer < WaitV
            flag = WaitPort(DevV, sS)
'10秒读不到1个字符, Feb90=-2,退出
            If flag < 0 Then
                Feb90 = RetF(-2, "追不到同步字")
                If Flag_go = True Then Feb90 = RetF(-3, "用户中断")
                Exit Function
            End If
            i = i + 1
'紧接是&H90,Feb90=1,退出
            If sS(0) = &H90 Then
                Feb90 = RetF(1, "已追到同步字")
                Exit Function
            End If
        Loop
    Loop

'到时间,Feb90=-2,退出
    Feb90 = RetF(-2, "追不到同步字,超时")
    
End Function
Public Function SearchF(DevV As Object, DataV() As Byte) As Integer
'功能:
'    查找一串数据。
'入口：
'     DevV as object  = COM 口控件
'     DataV() as Byte = 要查找的一串数据
'出口：
'     无
'返回：
'     SearchF = 1  已找到要求数据
'             =-1  找不到要求数据
'             =-2  用户中断
'
Dim sS(0) As Byte, flag As Integer, WaitV As Double, work As Integer
Dim i As Integer
    DevV.InputMode = comInputModeBinary
'work 是成功标志，1=成功；-1=失败。
    work = 0

'设总时间为60秒
    WaitV = Timer + 60
    Do While Timer < WaitV And work <> 1
        If Flag_go Then
            SearchF = RetF(-2, "用户中断")
            Exit Function
        End If
        work = 1
        For i = LBound(DataV) To UBound(DataV)
            flag = WaitPort(DevV, sS)
            If flag < 0 Then   '超十秒
                SearchF = RetF(-1, "追不到要求数据")
                Exit Function
            End If
            
            If sS(0) <> DataV(i) Then
                work = -1    '不是要求数据
                Exit For
            End If
        Next i
    DoEvents
    Loop
    
    If work = 1 Then
        SearchF = RetF(1, "追到要求数据")
    Else
        SearchF = RetF(-1, "追不到要求数据")
    End If
        
End Function
Public Function Setting(DevV As Object, portV As Integer, BaudV As Integer) As I
nteger
'功能：
'     COM 口设置
'入口：
'     DevV as object  = COM 口控件
'     PortV as integer= 串口号
'     BaudV as integer= 波特率
'出口：
'     无
'返回：
'     Setting = 1  串口设置成功
'             =-1  串口错误

On Err GoTo Err1:
   If DevV.PortOpen Then DevV.PortOpen = False
   DevV.CommPort = portV
   DevV.Settings = Str(BaudV) + ",n,8,1"
   DevV.PortOpen = True
   Setting = RetF(1, "串口设置成功")
   Exit Function
Err1:
   Setting = RetF(-1, "串口错误")
End Function
Public Property Get breakV() As Boolean
    breakV = Flag_go
End Property

Public Property Let breakV(ByVal vNewValue As Boolean)
    Flag_go = vNewValue
End Property

Public Function RetF(RetNV As Integer, MsgV As String) As Integer
'功能==设置功能返回信息
      RetF = RetNV
      VMsg = MsgV
End Function

Public Property Get MessageV() As String
      MessageV = VMsg
End Property