VB5中串口查询法

来源：互联网发布：淘宝至宝比官网便宜编辑：程序博客网时间：2024/05/25 19:55

VB5中串口查询法的实现方法---- 串口查询法是一种主要工作在查询方式下的串口通信实现方法。当通信程序工作在“查询”方式时，可以不考虑Win95的进程和线程的问题。仅在串口有数据时，去读串口缓冲区就可以了。这种方法下确定串口读取的时机、握手协议及软件纠错的实现是程序员应考虑的主要问题。

---- 由于这种方法主要工作在查询方式。程序员必须完成相当一部分通信状态的检测工作，许多细节（甚至包括通信过程中的字符属性的转换）也必须通过程序代码完成。因而相比较通信控件（即利用MSCOMM.OCX控件）方法而言，这种查询方法对通信双方拟订的通信协议的依赖性较大。双方通信协议的约定对程序实现的难易程度影响很大。

---- 由于Win95的串行驱动程序和VB5本身都是“事件驱动的”，在串口查询法中可以利用这种事件驱动的特性提高程序代码的效率。具体过程如下：首先设置通信事件掩码SetCommMask以决定对哪些通信事件进行监视；侦测到一个事件后，就有必要用API函数GetCommMask判断到底是哪个事件发生了，并将那个事件清除，以便这个事件下一次能正常发生；更进一步的作法是直接用WaitCommEvent函数专门等待特定通信事件的发生并对其进行处理。这实际上就对特定的通信事件做了一个消息挂钩，充分体现了事件驱动的优点。

---- 值得注意的一点是，此方法下协议的约定必须满足以下条件：即甲方发送时，乙方必须在甲方发送动作之前进入循环接收状态，直到接收到字符后通过对串口读取函数ReadFile返回值的判断跳出循环状态。

---- VB5是一种极为灵活的高级语言，因而在这种方法下可以方便地引入汇编语言的思维，利用其GoTo转向语句方便地控制程序的流程。非常灵活方便。

四、串口查询法的程序实例

---- 以下是一段程序实例，主要完成以下功能：对串口进行初始化，并完成数据的接收和发送，程序包含一定的纠错机制。通信格式设置为2400波特率，8位数据位，1位停止位，无奇偶校验。

---- 以下是程序的部分源代码，由于篇幅限制，省去了对API函数和一些结构、类型的声明。

  Private  timeouts  As  COMMTIMEOUTS  Private  handle  As  Long       '串口的句柄  Private  devname$                Public  DCB  As  dwDCB      'dwDCB是一个自定义的类  Private  PendingOutput$  Private  CurrentEventMask&     '当前的通信事件掩码值  Private  CurrentInputBuffer&  Private  CurrentOutputBuffer&  Private  overlaps( 2 )  As  OVERLAPPED       ' 0 = read, 1 = write, 2 = waitevent  Private  inprogress(2)  As  Boolean            ' 指示当前read, write,waitevent事件的状态  Private  DataWritten&  Private  DataRead&  Private  EventResults&  '以下是打开串口的子函数Public Function OpenComm(CommDeviceName As String, Notify As Object, Optional cbInQueue, Optional cbOutQueue) As LongIf  handle  < > 0  Then  CloseComm        '如串口已打开，则先关闭它    devname = CommDeviceNamehandle = CreateFile(devname, GENERIC_READ Or GENERIC_WRITE, 0, 0, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0)If handle = INVALID_HANDLE_VALUE Then Err.Raise vbObjectError + ERR_NOCOMMACCESS, CLASS_NAME, "Unable to open communications device"    '设置串口的输入和输出缓冲区If  Not (IsMissing(cbInQueue) Or IsMissing(cbOutQueue))  ThenCall  SetupComm( handle, cbInQueue, cbOutQueue )    Else        Call  SetupComm(handle, 8192, 1024)    End  If    GetCommTimeouts           '设置超时时间    timeouts.ReadIntervalTimeout = 1    timeouts.ReadTotalTimeoutMultiplier = 0    timeouts.ReadTotalTimeoutConstant = 10    timeouts.WriteTotalTimeoutMultiplier = 1    timeouts.WriteTotalTimeoutConstant = 1    SetCommTimeouts    ' Initialize the DCB to the current device parametersCall  DCB.GetCommState(Me)           '设置串口的通信格式Call  SetCommMask(handle, CurrentEventMask)     '设置串口的通信事件掩码    StartInputEnd  FunctionPrivate  Sub  StartInput( )                        '读取串口的子过程    Dim  res&If  inprogress( 0 )  Then  Exit Sub      ' 如正在读取串口则先退出子过程If  handle = 0  Then  DeviceNotOpenedError      ' 如串口为打开，则指示错误res = ReadFile(handle, CurrentInputBuffer, ClassBufferSizes, DataRead, overlaps(0))    If  res < > 0  Then        ProcessReadComplete                      '已完成读取串口的操作    Else        If  GetLastError( ) = ERROR_IO_PENDING  Then            inprogress(0) = True         '置读取过程标志为真        Else            Err.Raise  vbObjectError + ERR_READFAIL, CLASS_NAME, "Failure on Comm device read operation"        End  If    End  IfEnd  Sub  Private  Sub  TermText_KeyPress( KeyAscii As Integer )      '发送对文本框内的字符的子过程    If  Not (Comm Is Nothing)  Then        Comm.CommOutput (Chr$(KeyAscii))    End  If    KeyAscii = 0  End  Sub  Private  Sub  Timer1_Timer( )         '在定时器事件内定时对串口状态进行检查    If  Not ( Comm  Is  Nothing )  Then  Comm.Poll  End  Sub  Public  Sub  Poll( )         ' 测试发送、接受和事件侦测是否正在进行    PollWrite    PollRead    PollEvent  End  Sub  Public  Function  CommOutput( outputdata  As  String )  As  Long    Dim  bytestosend&    Dim  res&    If  handle = 0  Then  DeviceNotOpenedError    PendingOutput = PendingOutput & outputdata    If  inprogress(1)  Then    '正在向串口发送数据        CommOutput = True        Exit Function    End  If    ' 重新开始新的数据发送操作    bytestosend = Len( PendingOutput )If  bytestosend = 0  Then         '无发送的数据则退出        CommOutput = True        Exit  Function    End  If    '防止缓冲区溢出If  bytestosend  > ClassBufferSizes  Then  bytestosend = ClassBufferSizesIf  bytestosend  > 0  Then  Call  lstrcpyToBuffer(CurrentOutputBuffer, PendingOutput, bytestosend + 1)    If  bytestosend = Len(PendingOutput)  Then        PendingOutput = ""    Else        PendingOutput = Mid(PendingOutput, bytestosend + 1)    End  Ifres = WriteFile( handle, CurrentOutputBuffer, bytestosend, DataWritten, overlaps(1) )    If  res < > 0  Then        ProcessWriteComplete        CommOutput = True    ElseIf  GetLastError( ) = ERROR_IO_PENDING  Then            inprogress(1) = True            CommOutput = True        End If    End If  End  Function  Public  Sub  PollWrite( )    Dim  res&    If  Not  inprogress(1)  Then  Exit Sub    ' 检查该事件    res = WaitForSingleObject( overlaps(1).hEvent, 0 )      If  res = WAIT_TIMEOUT  Then  Exit Sub      ProcessWriteComplete  End  Sub  Public  Sub  ProcessWriteComplete( )           '设置发送结束标志的子过程inprogress(1) = False    Call  CommOutput(" ")  End  Sub  Public  Sub  PollRead( )    Dim  res&    If  Not  inprogress(0)  Then        StartInput        Exit  Sub    End  If    '检查该事件    res = WaitForSingleObject( overlaps(0).hEvent, 0 )    If  res = WAIT_TIMEOUT  Then  Exit  Sub    ProcessReadComplete  End  Sub  Public  Sub  ProcessReadComplete( )              '设置接收结束标志的子过程    Dim  resstring$    Dim  copied&If  inprogress(0)  Then    DataRead = overlaps(0).InternalHigh        inprogress(0) = False    End  If    If  DataRead < > 0  Then        resstring$ = String$(DataRead + 1, 0)        copied = lstrcpyFromBuffer(resstring, CurrentInputBuffer, DataRead + 1)    End  If  End  Sub  Private  Sub  StartEventWatch( )    Dim  res&If  inprogress(2)  Then  Exit  Sub          '已经启动一个事件监测过程，则退出If  handle = 0  Then  DeviceNotOpenedError    EventResults = 0res = WaitCommEvent( handle, EventResults, overlaps(2) )    If  res < > 0  Then        ProcessEventComplete    ElseIf  GetLastError( ) = ERROR_IO_PENDING  Then            inprogress(2) = True        Else            Err.Raise vbObjectError + ERR_EVENTFAIL, CLASS_NAME, "Failure on Comm device event test operation"        End  If    End  If  End  SubPrivate Sub ProcessEventComplete( )          '设置侦测事件结束标志的子过程    Dim  errors&If  inprogress(2)  Then   inprogress(2) = False    End  If        If  EventResults < > 0  Then       Msgbox  "There is something wrong with the comm event !"    End  IfEnd  SubPrivate  Sub  PollEvent( )       '侦测通信事件的子过程    Dim  res&    If  Not  inprogress(2)  Then        StartEventWatch        Exit  Sub    End  If    res = WaitForSingleObject(overlaps(2).hEvent, 0)    If  res = WAIT_TIMEOUT  Then  Exit  Sub     ProcessEventComplete  End   SubPublic Function CloseComm( ) As Long         ' 关闭串口的子函数    If  handle = 0  Then  Exit  Function    Call  CloseHandle(handle)    handle = 0End  Function

---- 另外，由于32位API函数参数的数据类型的变化，所有整形参数都被换为长整型（Long）以支持32位的处理，这一点在设置返回值时尤其如此。