www.pudn.com > gdqj1a302.zip > Comm.bas

Attribute VB_Name = "mdComm" 
'******************************************************************************************* 
' mdComm.bas  串口通讯模块 
'******************************************************************************************* 
 
Public Const SLF = 10 
Public Const SCR = 13 
Public Const SOH = &H1 
Public Const STX = &H2 
Public Const BOF = &H3 
Public Const EOT = &H4 
Public Const ACK = &H6 
Public Const NAK = &H15 
Public Const CAN = &H18 
 
'建立串口通讯方式 
Sub CommInit(o As Object, iport As Integer, ss As String) 
'Sub Comm_Init(o As Object, iport As Integer, ss As String) 
    On Error Resume Next 
    If o.PortOpen Then 
        o.PortOpen = False 
    End If 
    o.CommPort = iport 
    o.Settings = ss 
    o.PortOpen = True 
    o.DTREnable = True 
End Sub 
 
'发送串行字串 
'Function SioTxString(o As Object, ss As String) As Boolean 
Function SioTxString(o As Object, ss As String) As Boolean 
    If Not o.PortOpen Then 
        SioTxString = False 
        Exit Function 
    End If 
    o.InBufferCount = 0 
    o.OutBufferCount = 0 
    o.Output = ss 
End Function 
 
'接收串口通讯行 
Function SioRxLine(o As Object, ss As String, Eos As Integer, tmo As Long) As Integer 
    If Not o.PortOpen Then 
        SioRxLine = -2 
        Exit Function 
    End If 
    t1& = GetTickCount() 
    ss = "" 
    s$ = " " 
    o.InputLen = 1 
    Do 
        DoEvents 
        If o.InBufferCount > 0 Then 
            s$ = o.Input 
            If Chr(Eos) = s$ Then 
                n% = Len(ss) 
                If n% > 0 Then 
                    SioRxLine = n% 
                    Exit Function 
                End If 
            Else 
                ss = ss & s$ 
            End If 
        End If 
    Loop Until GetTickCount() - t1& > tmo 
    SioRxLine = -1 
End Function 
 
Function SioRxString0(o As Object, ss As String, n As Integer, tmo As Long) As Integer 
    If Not o.PortOpen Then 
        SioRxString0 = -2 
        Exit Function 
    End If 
    o.InputLen = n 
    t1& = GetTickCount() 
    Do 
        DoEvents 
        If o.InBufferCount > n Then 
            ss = o.Input 
            SioRxString0 = Len(ss) 
            Exit Function 
        End If 
    Loop Until GetTickCount() - t1& > tmo 
    SioRxString0 = -1 
End Function 
 
Function SioRxString(o As Object, ss As String, n As Integer, tmo As Long) As Integer 
    If Not o.PortOpen Then 
        SioRxString = -2 
        Exit Function 
    End If 
    o.InputLen = n 
    t1& = GetTickCount() 
    Do 
        DoEvents 
        If o.InBufferCount >= n Then 
            ss = o.Input 
            SioRxString = Len(ss) 
            Exit Function 
        End If 
    Loop Until GetTickCount() - t1& > tmo 
    SioRxString = -1 
End Function 
 
'接收串口通讯数据 
Function SioRxData(o As Object, SByte() As Byte, n As Integer, tmo As Long) As Integer 
    Dim n1 As Integer 
    If Not o.PortOpen Then 
        SioRxData = -2 
        Exit Function 
    End If 
    t1& = GetTickCount() 
    o.InputLen = n 
    Do 
        DoEvents 
        n1 = o.InBufferCount 
        If n1 >= n Then 
            SByte = o.Input 
            SioRxData = n 
            Exit Function 
        End If 
    Loop Until GetTickCount() - t1& > tmo 
    SioRxData = -1 
End Function 
 
'串口缓冲清除 
Sub SioFlush(o As Object) 
    If Not o.PortOpen Then 
        Exit Sub 
    End If 
    o.InBufferCount = 0 
    o.OutBufferCount = 0 
End Sub 
 
 
'Public Function UpdateCRC(crc As Long, data As Byte) 
'    Dim i1, i2 
'    i1 = crc * 256 
'    i2 = ((crc \ 256) And 255) Xor data 
'    i3 = (i1 Xor tbCrc(i2)) & 65535 
'    UpdateCRC i3 
     
    '    WORD i1, i2; 
    'i1 = crc << 8; 
    'i2 = ((crc >> 8) & 255) ^ data; 
    'return (WORD) (i1 ^ tbCRC[i2]); 
'End Function