VB5中串口查询法

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 Long
If  handle  < > 0  Then  CloseComm 
       '如串口已打开，则先关闭它
    devname = CommDeviceName
handle = CreateFile(devname,GENERIC_READ 
Or GENERIC_WRITE,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))  Then
Call  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 parameters
Call  DCB.GetCommState(Me)       
    '设置串口的通信格式
Call  SetCommMask(handle,CurrentEventMask) 
    '设置串口的通信事件掩码
    StartInput
End  Function

Private  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,"Failure on Comm device read operation"
        End  If
    End  If
End  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 = ClassBufferSizes
If  bytestosend  >
 0  Then  Call  lstrcpyToBuffer
(CurrentOutputBuffer,PendingOutput,bytestosend + 1)
    If  bytestosend = Len(PendingOutput)  Then
        PendingOutput = ""
    Else
        PendingOutput = Mid(PendingOutput,bytestosend + 1)
    End  If
res = WriteFile( handle,CurrentOutputBuffer,bytestosend,DataWritten,overlaps(1) )
    If  res < > 0  Then
        ProcessWriteComplete
        CommOutput = True
    Else
If  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,DataRead + 1)
    End  If
  End  Sub
  Private  Sub  StartEventWatch( )
    Dim  res&
If  inprogress(2)  Then  Exit  Sub  
        '已经启动一个事件监测过程，则退出
If  handle = 0  Then  DeviceNotOpenedError
    EventResults = 0
res = WaitCommEvent
( handle,EventResults,overlaps(2) )
    If  res < > 0  Then
        ProcessEventComplete
    Else
If  GetLastError( ) = ERROR_IO_PENDING  Then
            inprogress(2) = True
        Else
            Err.Raise vbObjectError + 
ERR_EVENTFAIL,"Failure on Comm device event test operation"
        End  If
    End  If
  End  Sub

Private 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  If
End  Sub

Private  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   Sub

Public Function CloseComm( ) As Long   
      ' 关闭串口的子函数
    If  handle = 0  Then  Exit  Function
    Call  CloseHandle(handle)
    handle = 0
End  Function

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

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

相关推荐