200分■求VB串口通讯的类或模块之二（不是mscomm）■收到就结贴

Question

哪位大虾有？200送，谢谢了！
收到就结贴
我的email：[email protected]
另外，本人级别低，请到另外贴里领分。
http://community.csdn.net/Expert/topic/4047/4047004.xml?temp=5.739993E-02

Answer 1

呵呵，找不到人，贴出来吧。
'****************************************************************************
'人人为我，我为人人
'枕善居
'发布日期：05/05/29
'描  述：API串口读写模块
'网  站：http://www.mndsoft.com/
'e-mail：[email protected]
'OICQ  : 88382850
'****************************************************************************
Option ExplicitGlobal ComNum As Long
Global bRead(255) As ByteType COMSTAT
        fCtsHold As Long
        fDsrHold As Long
        fRlsdHold As Long
        fXoffHold As Long
        fXoffSent As Long
        fEof As Long
        fTxim As Long
        fReserved As Long
        cbInQue As Long
        cbOutQue As Long
End TypeType COMMTIMEOUTS
        ReadIntervalTimeout As Long
        ReadTotalTimeoutMultiplier As Long
        ReadTotalTimeoutConstant As Long
        WriteTotalTimeoutMultiplier As Long
        WriteTotalTimeoutConstant As Long
End TypeType DCB
        DCBlength As Long
        BaudRate As Long
        fBinary As Long
        fParity As Long
        fOutxCtsFlow As Long
        fOutxDsrFlow As Long
        fDtrControl As Long
        fDsrSensitivity As Long
        fTXContinueOnXoff As Long
        fOutX As Long
        fInX As Long
        fErrorChar As Long
        fNull As Long
        fRtsControl As Long
        fAbortOnError As Long
        fDummy2 As Long
        wReserved As Integer
        XonLim As Integer
        XoffLim As Integer
        ByteSize As Byte
        Parity As Byte
        StopBits As Byte
        XonChar As Byte
        XoffChar As Byte
        ErrorChar As Byte
        EofChar As Byte
        EvtChar As Byte
End TypeType OVERLAPPED
        Internal As Long
        InternalHigh As Long
        offset As Long
        OffsetHigh As Long
        hEvent As Long
End Type
Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End TypeDeclare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function GetLastError Lib "kernel32" () As Long
Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Long) As Long
Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Long) As Long
Declare Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
Declare Function GetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
Declare Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" (ByVal lpDef As String, lpDCB As DCB) As Long
Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long, lpDCB As DCB) As Long
Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
Function fin_com()
    fin_com = CloseHandle(ComNum)
End Function'关闭端口
Function FlushComm()
    FlushFileBuffers (ComNum)
End Function'初始化端口
Function Init_Com(ComNumber As String, Comsettings As String) As Boolean
On Error GoTo handelinitcom
    Dim ComSetup As DCB, Answer, Stat As COMSTAT, RetBytes As Long
    Dim retval As Long
    Dim CtimeOut As COMMTIMEOUTS, BarDCB As DCB
    ' 打开通讯口读/写(&HC0000000).
    ' 必须指定存在的文件 (3).
    ComNum = CreateFile(ComNumber, &HC0000000, 0, 0&, &H3, 0, 0)
    If ComNum = -1 Then
        MsgBox "端口 " & ComNumber & "无效. 请设置正确.", 48
        Init_Com = False
        Exit Function
    End If
    '超时
    CtimeOut.ReadIntervalTimeout = 20
    CtimeOut.ReadTotalTimeoutConstant = 1
    CtimeOut.ReadTotalTimeoutMultiplier = 1
    CtimeOut.WriteTotalTimeoutConstant = 10
    CtimeOut.WriteTotalTimeoutMultiplier = 1
    retval = SetCommTimeouts(ComNum, CtimeOut)
    If retval = -1 Then
        retval = GetLastError()
        MsgBox "端口超时设定无效 " & ComNumber & " 错误: " & retval
        retval = CloseHandle(ComNum)
        Init_Com = False
        Exit Function
    End If
    retval = BuildCommDCB(Comsettings, BarDCB)
    If retval = -1 Then
        retval = GetLastError()
        MsgBox "无效设备 DCB 块 " & Comsettings & " 错误: " & retval
        retval = CloseHandle(ComNum)
        Init_Com = False
        Exit Function
    End If
    retval = SetCommState(ComNum, BarDCB)
    If retval = -1 Then
        retval = GetLastError()
        MsgBox "无效设备 DCB 块 " & Comsettings & " 错误: " & retval
        retval = CloseHandle(ComNum)
        Init_Com = False
        Exit Function
    End If
    
    Init_Com = True
handelinitcom:
    Exit Function
End Function'从串口读取数据
Function ReadCommPure() As String
On Error GoTo handelpurecom
    Dim RetBytes As Long, i As Integer, ReadStr As String, retval As Long
    Dim CheckTotal As Integer, CheckDigitLC As Integer
    retval = ReadFile(ComNum, bRead(0), 255, RetBytes, 0)
    ReadStr = ""
    If (RetBytes > 0) Then
        For i = 0 To RetBytes - 1
            ReadStr = ReadStr & Chr(bRead(i))
        Next i
       Else
        FlushComm
    End If
    ReadCommPure = ReadStr
handelpurecom:
    Exit Function
End Function'向串口写数据
Function WriteCOM32(COMString As String) As Integer
On Error GoTo handelwritelpt
    Dim RetBytes As Long, LenVal As Long
    Dim retval As Long
    
    If Len(COMString) > 255 Then
        WriteCOM32 Left$(COMString, 255)
        WriteCOM32 Right$(COMString, Len(COMString) - 255)
        Exit Function
    End If
    
    For LenVal = 0 To Len(COMString) - 1
        bRead(LenVal) = Asc(Mid$(COMString, LenVal + 1, 1))
    Next LenVal
'    bRead(LenVal) = 0
    retval = WriteFile(ComNum, bRead(0), Len(COMString), RetBytes, 0)
'    FlushComm
    WriteCOM32 = RetBytes
    
handelwritelpt:
    Exit Function
End Function

Answer 2

谢谢 mndsoft(枕善居(http://www.mndsoft.com/)！
发现有个问题，该模块无法产生串口中断，类似mscomm的oncome事件，只能通过timer控件+doevents轮询的方法，如果设置的频率快了，会出现机器运行速度变慢的现象，还有更完善的模块么？