用API实现串口异步读写

VB的MSCOMM控件虽然很好用，但是在没有装VB的机器上用该控件总觉得有些累赘，网上的VB API代码大部分都基于是同步方式，处理复杂的通信模式不是太理想，所以用了一些时间，把VC项目中的异步串口读写代码翻译为VB格式。

在VB新建一个类，把下面的代码复制后即可使用

'*************************************************************************
'**模块名：SerialPort
'**说明：YFsoft版权所有2006-2007(C)
'**创建人：叶帆
'**日期：2006-08-1714:32:29
'**修改人：
'**日期：
'**描述：串口异步读写(API)
'**版本：V1.0.0
'*************************************************************************
OptionExplicit

PrivateTypeComStat
fCtsHoldAsLong
fDsrHoldAsLong
fRlsdHoldAsLong
fXoffHoldAsLong
fXoffSentAsLong
fEofAsLong
fTximAsLong
fReservedAsLong
cbInQueAsLong
cbOutQueAsLong
EndType

PrivateTypeCOMMTIMEOUTS
ReadIntervalTimeoutAsLong
ReadTotalTimeoutMultiplierAsLong
ReadTotalTimeoutConstantAsLong
WriteTotalTimeoutMultiplierAsLong
WriteTotalTimeoutConstantAsLong
EndType

PrivateTypeDCB
DCBlengthAsLong
BaudRateAsLong
'DWORDDCBlength;/*sizeof(DCB)*/
'DWORDBaudRate;/*Baudrateatwhichrunning*/
'DWORDfBinary:1;/*BinaryMode(skipEOFcheck)*/
'DWORDfParity:1;/*Enableparitychecking*/
'DWORDfOutxCtsFlow:1;/*CTShandshakingonoutput*/
'DWORDfOutxDsrFlow:1;/*DSRhandshakingonoutput*/
'DWORDfDtrControl:2;/*DTRFlowcontrol*/
'DWORDfDsrSensitivity:1;/*DSRSensitivity*/
'DWORDfTXContinueOnXoff:1;/*ContinueTXwhenXoffsent*/
'DWORDfOutX:1;/*EnableoutputX-ON/X-OFF*/
'DWORDfInX:1;/*EnableinputX-ON/X-OFF*/
'DWORDfErrorChar:1;/*EnableErrReplacement*/
'DWORDfNull:1;/*EnableNullstripping*/
'DWORDfRtsControl:2;/*RtsFlowcontrol*/
'DWORDfAbortOnError:1;/*AbortallreadsandwritesonError*/
'DWORDfDummy2:17;/*Reserved*/
fBitFieldsAsLong'SeeCommentsinWin32API.Txt
wReservedAsInteger
XonLimAsInteger
XoffLimAsInteger
ByteSizeAsByte
ParityAsByte
StopBitsAsByte
XonCharAsByte
XoffCharAsByte
ErrorCharAsByte
EofCharAsByte
EvtCharAsByte
wReserved1AsInteger'Reserved;DoNotUse
EndType

PrivateTypeOVERLAPPED
InternalAsLong
InternalHighAsLong
offsetAsLong
OffsetHighAsLong
hEventAsLong
EndType

PrivateTypeSECURITY_ATTRIBUTES
nLengthAsLong
lpSecurityDescriptorAsLong
bInheritHandleAsLong
EndType

PrivateDeclareFunctionCloseHandleLib"kernel32"(ByValhObjectAsLong)AsLong
PrivateDeclareFunctionGetLastErrorLib"kernel32"()AsLong
PrivateDeclareFunctionReadFileLib"kernel32"(ByValhFileAsLong,lpBufferAsAny,ByValnNumberOfBytesToReadAsLong,lpNumberOfBytesReadAsLong,lpOverlappedAsOVERLAPPED)AsLong
PrivateDeclareFunctionWriteFileLib"kernel32"(ByValhFileAsLong,lpBufferAsAny,ByValnNumberOfBytesToWriteAsLong,lpNumberOfBytesWrittenAsLong,lpOverlappedAsOVERLAPPED)AsLong'OVERLAPPED
PrivateDeclareFunctionSetCommTimeoutsLib"kernel32"(ByValhFileAsLong,lpCommTimeoutsAsCOMMTIMEOUTS)AsLong
PrivateDeclareFunctionGetCommTimeoutsLib"kernel32"(ByValhFileAsLong,lpCommTimeoutsAsCOMMTIMEOUTS)AsLong
PrivateDeclareFunctionBuildCommDCBLib"kernel32"Alias"BuildCommDCBA"(ByVallpDefAsString,lpDCBAsDCB)AsLong
PrivateDeclareFunctionSetCommStateLib"kernel32"(ByValhCommDevAsLong,lpDCBAsDCB)AsLong
PrivateDeclareFunctionGetCommStateLib"kernel32"(ByValnCidAsLong,lpDCBAsDCB)AsLong
PrivateDeclareFunctionCreateFileLib"kernel32"Alias"CreateFileA"(ByVallpFileNameAsString,ByValdwDesiredAccessAsLong,ByValdwShareModeAsLong,ByVallpSecurityAttributesAsLong,ByValdwCreationDispositionAsLong,ByValdwFlagsAndAttributesAsLong,ByValhTemplateFileAsLong)AsLong
PrivateDeclareFunctionFlushFileBuffersLib"kernel32"(ByValhFileAsLong)AsLong
PrivateDeclareFunctionCreateEventLib"kernel32"Alias"CreateEventA"(lpEventAttributesAsSECURITY_ATTRIBUTES,ByValbManualResetAsLong,ByValbInitialStateAsLong,ByVallpNameAsString)AsLong
PrivateDeclareFunctionSetCommMaskLib"kernel32"(ByValhFileAsLong,ByValdwEvtMaskAsLong)AsLong
PrivateDeclareFunctionSetEventLib"kernel32"(ByValhEventAsLong)AsLong
PrivateDeclareFunctionPurgeCommLib"kernel32"(ByValhFileAsLong,ByValdwFlagsAsLong)AsLong
PrivateDeclareFunctionClearCommErrorLib"kernel32"(ByValhFileAsLong,lpErrorsAsLong,lpStatAsComStat)AsLong
PrivateDeclareFunctionGetOverlappedResultLib"kernel32"(ByValhFileAsLong,lpOverlappedAsOVERLAPPED,lpNumberOfBytesTransferredAsLong,ByValbWaitAsLong)AsLong
PrivateDeclareFunctionWaitForSingleObjectLib"kernel32"(ByValhHandleAsLong,ByValdwMillisecondsAsLong)AsLong
PrivateDeclareFunctionSetupCommLib"kernel32"(ByValhFileAsLong,ByValdwInQueueAsLong,ByValdwOutQueueAsLong)AsLong

PrivateConstGENERIC_WRITE=&H40000000
PrivateConstGENERIC_READ=&H80000000
PrivateConstOPEN_EXISTING=3
PrivateConstFILE_ATTRIBUTE_NORMAL=&H80
PrivateConstFILE_FLAG_OVERLAPPED=&H40000000
PrivateConstDTR_CONTROL_DISABLE=&H0
PrivateConstRTS_CONTROL_ENABLE=&H1
PrivateConstPURGE_RXABORT=&H2
PrivateConstPURGE_RXCLEAR=&H8
PrivateConstPURGE_TXABORT=&H1
PrivateConstPURGE_TXCLEAR=&H4
PrivateConstERROR_IO_PENDING=997
PrivateConstSTATUS_WAIT_0=&H0
PrivateConstWAIT_OBJECT_0=(STATUS_WAIT_0+0)
PrivateConstWAIT_TIMEOUT=258&

Privatem_HandleAsLong
Privatem_OverlappedReadAsOVERLAPPED
Privatem_OverlappedWriteAsOVERLAPPED

'*************************************************************************
'**函数名：OpenPort
'**输入：ComNumber(Long)-串口号
'**：Comsettings(String)-配置信息
'**输出：(Long)-0成功非0失败
'**功能描述：打开串口
'**全局变量：
'**调用模块：
'**作者：叶帆
'**日期：2006-08-1714:40:14
'**修改人：
'**日期：
'**版本：V1.0.0
'*************************************************************************
PublicFunctionOpenPort(ComNumberAsLong,ComsettingsAsString,OptionallngInSizeAsLong=1024,OptionallngOutSizeAsLong=512)AsLong
OnErrorGoTohandelinitcom
DimretvalAsLong
DimCtimeOutAsCOMMTIMEOUTS,dcbsAsDCB
DimstrCOMAsString,strConfigAsString

strCOM="/.COM"&Format(ComNumber,"0")
m_Handle=CreateFile(strCOM,GENERIC_READOrGENERIC_WRITE,0,0&,OPEN_EXISTING,FILE_ATTRIBUTE_NORMALOrFILE_FLAG_OVERLAPPED,0)
Ifm_Handle=-1Then
OpenPort=-1
ExitFunction
EndIf

'设置dcb块
dcbs.DCBlength=Len(dcbs)'长度
CallGetCommState(m_Handle,dcbs)

'波特率,奇偶校验,数据位,停止位如：9600,n,8,1
strConfig="COM"&Format(ComNumber,"0")&":"&Comsettings
CallBuildCommDCB(strConfig,dcbs)

'------------------------------
'dcbs.fBinary=1'二进制方式
'dcbs.fOutxCtsFlow=0'不用CTS检测发送流控制
'dcbs.fOutxDsrFlow=0'不用DSR检测发送流控制
'dcbs.fDtrControl=DTR_CONTROL_DISABLE'禁止DTR流量控制
'dcbs.fDsrSensitivity=0'对DTR信号线不敏感
'dcbs.fTXContinueOnXoff=1'检测接收缓冲区
'dcbs.fOutX=0'不做发送字符控制
'dcbs.fInX=0'不做接收控制
'dcbs.fErrorChar=0'是否用指定字符替换校验错的字符
'dcbs.fNull=0'保留NULL字符
'dcbs.fRtsControl=RTS_CONTROL_ENABLE'允许RTS流量控制
'dcbs.fAbortOnError=0'发送错误后，继续进行下面的读写操作
'dcbs.fDummy2=0'保留
dcbs.fBitFields=1*2^0OrDTR_CONTROL_DISABLE*2^4Or1*2^7OrRTS_CONTROL_ENABLE*2^12

dcbs.wReserved=0'没有使用，必须为0
dcbs.XonLim=0'指定在XOFF字符发送之前接收到缓冲区中可允许的最小字节数
dcbs.XoffLim=0'指定在XOFF字符发送之前缓冲区中可允许的最小可用字节数
dcbs.XonChar=0'发送和接收的XON字符
dcbs.XoffChar=0'发送和接收的XOFF字符
dcbs.ErrorChar=0'代替接收到奇偶校验错误的字符
dcbs.EofChar=0'用来表示数据的结束
dcbs.EvtChar=0'事件字符，接收到此字符时，会产生一个事件
'dcbs.wReserved1=0'没有使用
'dcbs.BaudRate=9600'波特率
'dcbs.Parity=0'奇偶校验
'dcbs.ByteSize=8'数据位
'dcbs.StopBits=0'停止位
'------------------------------

Ifdcbs.Parity=0Then'0-4=None,Odd,Even,Mark,Space
dcbs.fBitFields=dcbs.fBitFieldsAnd&HFFFD'dcbs.fParity=0'奇偶校验无效
Else
dcbs.fBitFields=dcbs.fBitFieldsOr&H2'dcbs.fParity=1'奇偶校验有效
EndIf

'超时设置
CtimeOut.ReadIntervalTimeout=20'0
CtimeOut.ReadTotalTimeoutConstant=1'2500
CtimeOut.ReadTotalTimeoutMultiplier=1'0
CtimeOut.WriteTotalTimeoutConstant=10'2500
CtimeOut.WriteTotalTimeoutMultiplier=1'0

retval=SetCommTimeouts(m_Handle,CtimeOut)

Ifretval=-1Then
retval=GetLastError()
OpenPort=retval
retval=CloseHandle(m_Handle)
ExitFunction
EndIf

'获取信号句柄
DimlpEventAttributes1AsSECURITY_ATTRIBUTES
DimlpEventAttributes2AsSECURITY_ATTRIBUTES

m_OverlappedRead.hEvent=CreateEvent(lpEventAttributes1,1,0,0)
m_OverlappedWrite.hEvent=CreateEvent(lpEventAttributes2,1,0,0)

'判断设置参数是否成功设置输入和输出缓冲区是否成功
IfSetCommState(m_Handle,dcbs)=-1OrSetupComm(m_Handle,lngInSize,lngOutSize)=-1Orm_OverlappedRead.hEvent=0Orm_OverlappedWrite.hEvent=0Then
retval=GetLastError()
OpenPort=retval
If(m_OverlappedRead.hEvent<>0)ThenCloseHandle(m_OverlappedRead.hEvent)
If(m_OverlappedWrite.hEvent<>0)ThenCloseHandle(m_OverlappedWrite.hEvent)
CallCloseHandle(m_Handle)
m_Handle=0
ExitFunction
EndIf

OpenPort=0
ExitFunction
handelinitcom:
CallCloseHandle(m_Handle)
m_Handle=0
OpenPort=-2
ExitFunction
EndFunction

'*************************************************************************
'**函数名：ClosePort
'**输入：无
'**输出：(Long)-0成功-1失败
'**功能描述：关闭串口
'**全局变量：
'**调用模块：
'**作者：叶帆
'**日期：2006-08-1714:56:13
'**修改人：
'**日期：
'**版本：V1.0.0
'*************************************************************************
PublicFunctionClosePort()AsLong
If(m_Handle=0)Then
ClosePort=1
ExitFunction
EndIf

CallSetCommMask(m_Handle,0)
CallSetEvent(m_OverlappedRead.hEvent)
CallSetEvent(m_OverlappedWrite.hEvent)

If(m_OverlappedRead.hEvent<>0)ThenCloseHandle(m_OverlappedRead.hEvent)
If(m_OverlappedWrite.hEvent<>0)ThenCloseHandle(m_OverlappedWrite.hEvent)

IfCloseHandle(m_Handle)<>0Then
ClosePort=0
Else
ClosePort=-1
EndIf

m_Handle=0
EndFunction

'*************************************************************************
'**函数名：ClearInBuf
'**输入：无
'**输出：无
'**功能描述：清空输入缓冲区
'**全局变量：
'**调用模块：
'**作者：叶帆
'**日期：2006-08-1714:57:26
'**修改人：
'**日期：
'**版本：V1.0.0
'*************************************************************************
PublicFunctionClearInBuf()AsLong
If(m_Handle=0)Then
ClearInBuf=1
ExitFunction
EndIf
CallPurgeComm(m_Handle,PURGE_RXABORTOrPURGE_RXCLEAR)
ClearInBuf=0
EndFunction

'*************************************************************************
'**函数名：ClearOutBuf
'**输入：无
'**输出：(Long)-
'**功能描述：清空输出缓冲区
'**全局变量：
'**调用模块：
'**作者：叶帆
'**日期：2006-08-1715:40:38
'**修改人：
'**日期：
'**版本：V1.0.0
'*************************************************************************
PublicFunctionClearOutBuf()AsLong
If(m_Handle=0)Then
ClearOutBuf=1
ExitFunction
EndIf
CallPurgeComm(m_Handle,PURGE_TXABORTOrPURGE_TXCLEAR)
ClearOutBuf=0
EndFunction

'*************************************************************************
'**函数名：SendData
'**输入：bytBuffer()(Byte)-数据
'**：lngSize(Long)-数据长度
'**输出：(Long)-
'**功能描述：发送数据
'**全局变量：
'**调用模块：
'**作者：叶帆
'**日期：2006-08-1715:43:42
'**修改人：
'**日期：
'**版本：V1.0.0
'*************************************************************************
PublicFunctionSendData(bytBuffer()AsByte,lngSizeAsLong)AsLong
OnErrorGoToToExit'打开错误陷阱
'------------------------------------------------
If(m_Handle=0)Then
SendData=1
ExitFunction
EndIf

DimdwBytesWrittenAsLong
DimbWriteStatAsLong
DimComStatsAsComStat
DimdwErrorFlagsAsLong

dwBytesWritten=lngSize

CallClearCommError(m_Handle,dwErrorFlags,ComStats)
bWriteStat=WriteFile(m_Handle,bytBuffer(0),lngSize,dwBytesWritten,m_OverlappedWrite)

IfbWriteStat=0Then
IfGetLastError()=ERROR_IO_PENDINGThen
CallGetOverlappedResult(m_Handle,m_OverlappedWrite,dwBytesWritten,1)'等待直到发送完毕
EndIf
Else
dwBytesWritten=0
EndIf

SendData=dwBytesWritten
'------------------------------------------------
ExitFunction
'----------------
ToExit:
SendData=-1
EndFunction

'*************************************************************************
'**函数名：ReadData
'**输入：bytBuffer()(Byte)-数据
'**：lngSize(Long)-数据长度
'**输出：(Long)-
'**功能描述：读取数据
'**全局变量：
'**调用模块：
'**作者：叶帆
'**日期：2006-08-1716:04:38
'**修改人：
'**日期：
'**版本：V1.0.0
'*************************************************************************
PublicFunctionReadData(bytBuffer()AsByte,lngSizeAsLong,OptionalOvertimeAsLong=3000)AsLong
OnErrorGoToToExit'打开错误陷阱
'------------------------------------------------
If(m_Handle=0)Then
ReadData=1
ExitFunction
EndIf

DimlngBytesReadAsLong
DimfReadStatAsLong
DimdwResAsLong

lngBytesRead=lngSize

'读数据
fReadStat=ReadFile(m_Handle,bytBuffer(0),lngSize,lngBytesRead,m_OverlappedRead)
IffReadStat=0Then
IfGetLastError()=ERROR_IO_PENDINGThen'重叠I/O操作在进行中
dwRes=WaitForSingleObject(m_OverlappedRead.hEvent,Overtime)'等待，直到超时
SelectCasedwRes
CaseWAIT_OBJECT_0:'读完成
IfGetOverlappedResult(m_Handle,m_OverlappedRead,lngBytesRead,0)=0Then
'错误
ReadData=-2
ExitFunction
EndIf
CaseWAIT_TIMEOUT:'超时
ReadData=-1
ExitFunction
CaseElse:'WaitForSingleObject错误
EndSelect
EndIf
EndIf
ReadData=lngBytesRead
'------------------------------------------------
ExitFunction
'----------------
ToExit:
ReadData=-1
EndFunction

'*************************************************************************
'**函数名：Class_Terminate
'**输入：无
'**输出：无
'**功能描述：
'**全局变量：
'**调用模块：
'**作者：叶帆
'**日期：2006-08-1716:36:21
'**修改人：
'**日期：
'**版本：V1.0.0
'*************************************************************************
PrivateSubClass_Terminate()
CallClosePort
EndSub