Routine_Error:
lngStatus = Err.Number With udtCommError
.lngErrorCode = lngStatus .strFunction = \
.strErrorMessage = Err.Description End With
Resume Routine_Exit End Function
'------------------------------------------------------------------------------- ' CommClose - Close the serial port. '
' Parameters:
' intPortID - Port ID used when port was opened. '
' Returns:
' Error Code - 0 = No Error.
'------------------------------------------------------------------------------- Public Function CommClose(intPortID As Integer) As Long
Dim lngStatus As Long
On Error GoTo Routine_Error
If udtPorts(intPortID).blnPortOpen Then
lngStatus = CloseHandle(udtPorts(intPortID).lngHandle)
If lngStatus = 0 Then
lngStatus = SetCommError(\ GoTo Routine_Exit End If
udtPorts(intPortID).blnPortOpen = False End If
lngStatus = 0
Routine_Exit:
CommClose = lngStatus Exit Function
Routine_Error:
lngStatus = Err.Number With udtCommError
.lngErrorCode = lngStatus .strFunction = \
.strErrorMessage = Err.Description End With
Resume Routine_Exit End Function
'------------------------------------------------------------------------------- ' CommFlush - Flush the send and receive serial port buffers. '
' Parameters:
' intPortID - Port ID used when port was opened. '
' Returns:
' Error Code - 0 = No Error.
'------------------------------------------------------------------------------- Public Function CommFlush(intPortID As Integer) As Long
Dim lngStatus As Long
On Error GoTo Routine_Error
lngStatus = PurgeComm(udtPorts(intPortID).lngHandle, PURGE_TXABORT Or _ PURGE_RXABORT Or PURGE_TXCLEAR Or PURGE_RXCLEAR)
If lngStatus = 0 Then
lngStatus = SetCommError(\ GoTo Routine_Exit End If
lngStatus = 0
Routine_Exit:
CommFlush = lngStatus Exit Function
Routine_Error:
lngStatus = Err.Number With udtCommError
.lngErrorCode = lngStatus .strFunction = \
.strErrorMessage = Err.Description End With
Resume Routine_Exit End Function
'------------------------------------------------------------------------------- ' CommRead - Read serial port input buffer. '
' Parameters:
' intPortID - Port ID used when port was opened. ' strData - Data buffer.
' lngSize - Maximum number of bytes to be read.
'
' Returns:
' Error Code - 0 = No Error.
'------------------------------------------------------------------------------- Public Function CommRead(intPortID As Integer, strData As String, _ lngSize As Long) As Long
Dim lngStatus As Long
Dim lngRdSize As Long, lngBytesRead As Long
Dim lngRdStatus As Long, strRdBuffer As String * 1024 Dim lngErrorFlags As Long, udtCommStat As COMSTAT
On Error GoTo Routine_Error
strData = \ lngBytesRead = 0 DoEvents
' Clear any previous errors and get current status.
lngStatus = ClearCommError(udtPorts(intPortID).lngHandle, lngErrorFlags, _ udtCommStat)
If lngStatus = 0 Then lngBytesRead = -1
lngStatus = SetCommError(\ GoTo Routine_Exit End If
If udtCommStat.cbInQue > 0 Then
If udtCommStat.cbInQue > lngSize Then lngRdSize = udtCommStat.cbInQue Else
lngRdSize = lngSize End If Else
lngRdSize = 0 End If
If lngRdSize Then
lngRdStatus = ReadFile(udtPorts(intPortID).lngHandle, strRdBuffer, _ lngRdSize, lngBytesRead, udtCommOverlap)
If lngRdStatus = 0 Then
lngStatus = GetLastError
If lngStatus = ERROR_IO_PENDING Then ' Wait for read to complete.
' This function will timeout according to the ' COMMTIMEOUTS.ReadTotalTimeoutConstant variable. ' Every time it times out, check for port errors.
' Loop until operation is complete.
While GetOverlappedResult(udtPorts(intPortID).lngHandle, _ udtCommOverlap, lngBytesRead, True) = 0
lngStatus = GetLastError
If lngStatus ERROR_IO_INCOMPLETE Then lngBytesRead = -1
lngStatus = SetCommErrorEx( _
\ udtPorts(intPortID).lngHandle) GoTo Routine_Exit End If Wend Else
' Some other error occurred. lngBytesRead = -1
lngStatus = SetCommErrorEx(\ udtPorts(intPortID).lngHandle) GoTo Routine_Exit
End If End If
strData = Left$(strRdBuffer, lngBytesRead) End If
Routine_Exit:
CommRead = lngBytesRead Exit Function
Routine_Error:
lngBytesRead = -1
lngStatus = Err.Number With udtCommError
.lngErrorCode = lngStatus .strFunction = \
.strErrorMessage = Err.Description End With
Resume Routine_Exit End Function
'------------------------------------------------------------------------------- ' CommWrite - Output data to the serial port. '
' Parameters:
' intPortID - Port ID used when port was opened. ' strData - Data to be transmitted.
'
' Returns:
' Error Code - 0 = No Error.
'------------------------------------------------------------------------------- Public Function CommWrite(intPortID As Integer, strData As String) As Long
Dim i As Integer
Dim lngStatus As Long, lngSize As Long
Dim lngWrSize As Long, lngWrStatus As Long
On Error GoTo Routine_Error
' Get the length of the data. lngSize = Len(strData)
' Output the data.
lngWrStatus = WriteFile(udtPorts(intPortID).lngHandle, strData, lngSize, _ lngWrSize, udtCommOverlap)
' Note that normally the following code will not execute because the driver ' caches write operations. Small I/O requests (up to several thousand bytes) ' will normally be accepted immediately and WriteFile will return true even ' though an overlapped operation was specified. DoEvents
If lngWrStatus = 0 Then
lngStatus = GetLastError If lngStatus = 0 Then GoTo Routine_Exit
ElseIf lngStatus = ERROR_IO_PENDING Then
' We should wait for the completion of the write operation so we know ' if it worked or not. '
' This is only one way to do this. It might be beneficial to place the ' writing operation in a separate thread so that blocking on completion ' will not negatively affect the responsiveness of the UI. '
' If the write takes long enough to complete, this function will timeout ' according to the CommTimeOuts.WriteTotalTimeoutConstant variable. ' At that time we can check for errors and then wait some more.
' Loop until operation is complete.
While GetOverlappedResult(udtPorts(intPortID).lngHandle, _ udtCommOverlap, lngWrSize, True) = 0
lngStatus = GetLastError
If lngStatus ERROR_IO_INCOMPLETE Then