modcommbas.bas

非常好的串口控件

Attribute VB_Name = "modCommBas"
Option Explicit

Public Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long)
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Public Declare Sub CopyMemoryA Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, ByVal pSrc As String, ByVal ByteLen As Long)

Public Function ChangeBytes(ByVal str As String, Bytes() As Byte) As Long
    
    'Changes a VB unicode $ to an byte array Returns True if it truncates str
    
    Dim lenBs As Long   'length of the byte array
    Dim lenStr As Long  'length of the string
    ChangeBytes = 0
    lenBs = UBound(Bytes) - LBound(Bytes)
    lenStr = LenB(VBA.StrConv(str, vbFromUnicode))
    
    If lenBs > lenStr Then
        CopyMemoryA Bytes(0), str, lenStr
        ZeroMemory Bytes(lenStr), lenBs - lenStr
        ChangeBytes = lenStr
    ElseIf lenBs = lenStr Then
        CopyMemoryA Bytes(0), str, lenStr
        ChangeBytes = lenStr
    Else
        CopyMemoryA Bytes(0), str, lenBs
        ChangeBytes = lenBs
    End If
End Function

Public Function Cstr2bytes(ByVal str As String) As Byte()
    Dim nI As Integer
    Dim nCount As Integer
    Dim nAscw As Long
    Dim sTemp As String
    Dim Bytes(0 To 1023) As Byte
    Dim buf() As Byte
    nCount = LBound(Bytes)
    For nI = 1 To Len(str)
        nAscw = AscW(Mid$(str, nI, 1))
        If nAscw > 255 Or nAscw < 0 Then
            sTemp = Right$("0000" & Hex(nAscw), 4)
            Bytes(nCount) = Val("&H" & Left$(sTemp, 2))
            nCount = nCount + 1
            If nCount > UBound(Bytes) Then Exit Function
            Bytes(nCount) = Val("&H" & Right$(sTemp, 2))
            nCount = nCount + 1
            If nCount > UBound(Bytes) Then Exit Function
        Else
            Bytes(nCount) = 0
            nCount = nCount + 1
            If nCount > UBound(Bytes) Then Exit Function
            Bytes(nCount) = nAscw
            nCount = nCount + 1
            If nCount > UBound(Bytes) Then Exit Function
        End If
    Next nI
    If nCount > 0 Then
        ReDim buf(0 To nCount - 1) As Byte
        For nI = 0 To nCount - 1
            buf(nI) = Bytes(nI)
        Next nI
        Cstr2bytes = buf
    End If
End Function

Public Sub AddBytes(ByRef sDst() As Byte, ByRef sSrc() As Byte, ByVal nPos As Long)
    Dim nUbDst As Long
    Dim nLenDst As Long
    Dim nLenSrc As Long
    Dim nI As Long
    nUbDst = UBound(sDst)
    nLenDst = nUbDst - LBound(sDst) + 1
    nLenSrc = UBound(sSrc) - LBound(sSrc) + 1
    If nPos < LBound(sDst) Then nPos = LBound(sDst)
    If nPos > nUbDst Then
        Exit Sub
    ElseIf nPos + nLenSrc <= nUbDst + 1 Then
        CopyMemory sDst(nPos), sSrc(LBound(sSrc)), nLenSrc
    Else
        CopyMemory sDst(nPos), sSrc(LBound(sSrc)), nLenDst - nPos
    End If
End Sub