module1.bas

这个文件是有关系统串口通信的实例

Attribute VB_Name = "Module1"
Option Explicit

Public Const GENERIC_WRITE = &H40000000
Public Const GENERIC_READ = &H80000000

Public Const OPEN_EXISTING = 3

Public Const FILE_FLAG_OVERLAPPED = &H40000000
Public Const FILE_ATTRIBUTE_NORMAL = &H80


Public Const PURGE_RXABORT = &H2     '  Kill the pending/current reads to the comm port.
Public Const PURGE_RXCLEAR = &H8     '  Kill the typeahead buffer if there.
Public Const PURGE_TXCLEAR = &H4     '  Kill the transmit queue if there.
Public Const PURGE_TXABORT = &H1     '  Kill the pending/current writes to the comm port.

'奇偶校验设置的值
Public Const EVENPARITY = 2
Public Const ODDPARITY = 1
Public Const NOPARITY = 0
Public Const MARKPARITY = 3
Public Const SPACEPARITY = 4


'串口通信的数据结构，设备控制DCB
Public Type DCB
        DCBlength As Long       'DCB结构大小
        BaudRate As Long        '波特率
        
        '本来在该结构中没有fBitFields变量，而是另外14个变量
        '这14个变量可以包含在fBitFields变量的4个字节里，对fBitFields变量
        '执行逻辑运算（And或Or）操作可以获取原先的效果
        fBitFields As Long
        
        wReserved As Integer    '当前未用，必须置0
        XonLim As Integer       'XON阈值
        XoffLim As Integer      'XOFF阈值
        ByteSize As Byte        '字符位数，4-8
        Parity As Byte          '奇偶校验位
        StopBits As Byte        '0，1，2分别为1，1.5，2
        XonChar As Byte         'XON字符
        XoffChar As Byte        'XOFF字符
        ErrorChar As Byte       '奇偶错误替代字符
        EofChar As Byte         '结束字符
        EvtChar As Byte         '事件字符
        wReserved1 As Integer   '保留，未用
End Type

'串口当前状态的数据结构
Public Type COMSTAT

        '本来在该结构中没有fBitFields变量，而是另外8个变量
        '这8个变量可以包含在fBitFields变量的4个字节里，对fBitFields变量
        '执行逻辑运算（And或Or）操作可以获取原先的效果
        fBitFields As Long
        
        cbInQue As Long     '指出已经接收到但是没有被ReadFile操作读取的字节数
        cbOutQue As Long    '正在被所有写操作传送的用户数据
End Type

Public Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End Type

Public Type OVERLAPPED
        Internal As Long
        InternalHigh As Long
        offset As Long
        OffsetHigh As Long
        hEvent As Long
End Type

Public Type COMMTIMEOUTS
        ReadIntervalTimeout As Long
        ReadTotalTimeoutMultiplier As Long
        ReadTotalTimeoutConstant As Long
        WriteTotalTimeoutMultiplier As Long
        WriteTotalTimeoutConstant As Long
End Type

Public Type COMMCONFIG
    dwSize As Long
    wVersion As Integer
    wReserved As Integer
    dcbx As DCB
    dwProviderSubType As Long
    dwProviderOffset As Long
    dwProviderSize As Long
    wcProviderData As Byte
End Type

Public Type COMMPROP
        wPacketLength As Integer
        wPacketVersion As Integer
        dwServiceMask As Long
        dwReserved1 As Long
        dwMaxTxQueue As Long
        dwMaxRxQueue As Long
        dwMaxBaud As Long
        dwProvSubType As Long
        dwProvCapabilities As Long
        dwSettableParams As Long
        dwSettableBaud As Long
        wSettableData As Integer
        wSettableStopParity As Integer
        dwCurrentTxQueue As Long
        dwCurrentRxQueue As Long
        dwProvSpec1 As Long
        dwProvSpec2 As Long
        wcProvChar(1) As Integer
End Type


Public Declare Function CreateFile Lib "kernel32" Alias _
    "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess _
    As Long, ByVal dwShareMode As Long, ByRef lpSecurityAttributes _
    As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes _
    As Long, ByVal hTemplateFile As Long) As Long
    
Public Declare Function ReadFile Lib "kernel32" _
    (ByVal hFile As Long, ByRef lpBuffer As Any, _
    ByVal nNumberOfBytesToRead _
    As Long, ByRef lpNumberOfBytesRead As Long, _
    ByRef lpOverlapped As Any) As Long 'OVERLAPPED) As Long

Public Declare Function WriteFile Lib "kernel32" _
    (ByVal hFile As Long, ByRef lpBuffer As Any, _
    ByVal nNumberOfBytesToWrite As Long, _
    ByRef lpNumberOfBytesWritten As Long, _
    ByRef lpOverlapped As Any) As Long 'OVERLAPPED) As Long

Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long


Public Declare Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" (ByVal lpDef As String, lpDCB As DCB) As Long
Public Declare Function BuildCommDCBAndTimeouts Lib "kernel32" Alias "BuildCommDCBAndTimeoutsA" (ByVal lpDef As String, lpDCB As DCB, lpCommTimeouts As COMMTIMEOUTS) As Long
Public Declare Function ClearCommBreak Lib "kernel32" (ByVal nCid As Long) As Long
Public Declare Function ClearCommError Lib "kernel32" (ByVal hFile As Long, lpErrors As Long, lpStat As COMSTAT) As Long
Public Declare Function CommConfigDialog Lib "kernel32" Alias "CommConfigDialogA" (ByVal lpszName As String, ByVal hWnd As Long, lpcc As COMMCONFIG) As Long
Public Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, lpOverlapped As OVERLAPPED) As Long

Public Declare Function EscapeCommFunction Lib "kernel32" (ByVal nCid As Long, ByVal nFunc As Long) As Long
Public Declare Function GetCommConfig Lib "kernel32" (ByVal hCommDev As Long, lpcc As COMMCONFIG, lpdwSize As Long) As Long
Public Declare Function GetCommMask Lib "kernel32" (ByVal hFile As Long, lpEvtMask As Long) As Long
Public Declare Function GetCommModemStatus Lib "kernel32" (ByVal hFile As Long, lpModemStat As Long) As Long
Public Declare Function GetCommProperties Lib "kernel32" (ByVal hFile As Long, lpCommProp As COMMPROP) As Long
Public Declare Function GetCommState Lib "kernel32" (ByVal nCid As Long, lpDCB As DCB) As Long
Public Declare Function GetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
Public Declare Function GetDefaultCommConfig Lib "kernel32" Alias "GetDefaultCommConfigA" (ByVal lpszName As String, lpcc As COMMCONFIG, lpdwSize As Long) As Long
Public Declare Function PurgeComm Lib "kernel32" (ByVal hFile As Long, ByVal dwFlags As Long) As Long
Public Declare Function SetCommBreak Lib "kernel32" (ByVal nCid As Long) As Long
Public Declare Function SetCommConfig Lib "kernel32" (ByVal hCommDev As Long, lpcc As COMMCONFIG, ByVal dwSize As Long) As Long
Public Declare Function SetCommMask Lib "kernel32" (ByVal hFile As Long, ByVal dwEvtMask As Long) As Long
Public Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long, lpDCB As DCB) As Long
Public Declare Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
Public Declare Function SetDefaultCommConfig Lib "kernel32" Alias "SetDefaultCommConfigA" (ByVal lpszName As String, lpcc As COMMCONFIG, ByVal dwSize As Long) As Long
Public Declare Function SetupComm Lib "kernel32" (ByVal hFile As Long, ByVal dwInQueue As Long, ByVal dwOutQueue As Long) As Long
Public Declare Function TransmitCommChar Lib "kernel32" (ByVal nCid As Long, ByVal cChar As Byte) As Long
Public Declare Function WaitCommEvent Lib "kernel32" (ByVal hFile As Long, lpEvtMask As Long, lpOverlapped As OVERLAPPED) As Long
Public Declare Function GetOverlappedResult Lib "kernel32" (ByVal hFile As Long, lpOverlapped As OVERLAPPED, lpNumberOfBytesTransferred As Long, ByVal bWait As Long) As Long

'该函数用来设置延迟，在利用事件自动读取串口数据的时候使用
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Sub MoveMemory Lib "kernel32" _
    Alias "RtlMoveMemory" _
    (pDest As Any, _
    pSource As Any, _
    ByVal dwLength As Long)

'*******************************************************************
'功能： 将一个字符串拆分为单个字符的数组
'参数：
'   strInput：      String类型，用来传递要拆分的字符串
'输出：
'   strSplitChar：  String类型，字符数组。
'*******************************************************************
Public Function strSplitChar(ByVal strInput As String) As String()
    Dim sStr() As String
    Dim nLen As Long '定义变量，用来存放参数字符串的长度
    Dim i As Long
    
    If strInput = vbNullString Then
        MsgBox "该函数不操作空字符串！"
        Exit Function
    End If
    
    nLen = Len(strInput)
    '为sStr动态数组设置大小，其长度是字符串长度加1，因为要存放字符串Chr(0)
    ReDim sStr(0 To nLen)
    
    For i = 0 To nLen
        If i <> nLen Then
            '每次，提取字符的位置递增1，提取的长度总是1，单个字符
            sStr(i) = Mid$(strInput, i + 1, 1)
        Else
            sStr(i) = Chr$(0)
        End If
    Next i
    strSplitChar = sStr()
End Function