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位的处理，这一点在设置返回值时尤其如此。
原文链接：https://www.f2er.com/vb/262050.html