optrexpeter 2013-11-03 10:03
浏览 4649

VBA API函数实现串口自发自收:Writefile正常,但Readfile时cbInQue为0

Win7下实现一台电脑两个串口(USB转)的同步通信的自发自收功能,COM10写,COM9读,但写数据后串口读缓冲区无字节,不解,请高手帮忙解答:是串口设置问题还是写数据格式问题?代码如下(函数申明略):
Option Explicit
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const OPEN_EXISTING = 3
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_FLAG_OVERLAPPED = &H40000000
Public Const FILE_BEGIN = 0
Public Const FILE_CURRENT = 1
Public Const FILE_END = 2
Public Const INVALID_HANDLE_VALUE = -1
Public Const ERROR_IO_PENDING = &H3E5
Public Const PURGE_RXABORT = &H2
Public Const PURGE_RXCLEAR = &H8
Public Const PURGE_TXABORT = &H1
Public Const PURGE_TXCLEAR = &H4
Public Const Xon = &H11
Public Const Xoff = &H13
Public Type DCB

DCBlength As Long

BaudRate As Long

fBinary As Long

fParity As Long

fOutxCtsFlow As Long

fOutxDsrFlow As Long

fDtrControl As Long

fDsrSensitivity As Long

fTXContinueOnXoff As Long

fOutX As Long

fInX As Long

fErrorChar As Long

fNull As Long

fRtsControl As Long

fAbortOnError As Long

fDummy2 As Long

wReserved As Integer

XonLim As Integer

XoffLim As Integer

ByteSize As Byte

Parity As Byte

StopBits As Byte

XonChar As Byte

XoffChar As Byte

ErrorChar As Byte

EofChar As Byte

EvtCharas As Byte

wReserved1 As Integer
End Type

Public Type COMMTIMEOUTS

ReadIntervalTimeout As Long

ReadTotalTimeoutMultiplier As Long

ReadTotalTimeoutConstant As Long

WriteTotalTimeoutMultiplier As Long

WriteTotalTimeoutConstant As Long
End Type

Public Type Comstat

fCtsHold As Long

fDsrHold As Long

fRlsdHold As Long

fXoffHold As Long

fXoffSent As Long

fEof As Long

fTxim As Long

fReserved As Long

cbInQue As Long

cbOutQue As Long
End Type

Dim hComm As Long
Dim hComm2 As Long
Dim dcbCommSetting As DCB
Dim strText As String

Public Sub cmdRead_Click()

hComm = 0

hComm2 = 0

txtDataBox.Text = ""

strText = ""

Call Open_Com(Trim(Worksheets("RS232C communication").Range("k3").Value)) ‘COM9

Sleep 10

Call Set_Com(hComm)

Sleep 10

Call Set_Com(hComm2)

Sleep 10

Call Write_Com(hComm2, "abc")

Sleep 500

Call Read_Com(hComm)

Sleep 10

CloseHandle hComm

hComm = 0

CloseHandle hComm2

hComm2 = 0
End Sub

Public Sub Write_Com(ByVal Handle_WriteCom As Long, ByVal sData As String)

Dim Flag_Write As Long, Bytes_Wrote As Long
Dim Buf_Write() As Byte
Dim i As Integer
Dim Write_Err As Long
Dim Comstat_Write As Comstat
Dim Err_ClearCommError_Write As Long
Dim Flag_ClearCommError_Write As Long
Dim Flag_Wait_Write As Boolean

ReDim Buf_Write(1 To LenB(StrConv(sData, vbFromUnicode)))

For i = 1 To LenB(StrConv(sData, vbFromUnicode))
    Buf_Write(i) = AscB(MidB(StrConv(sData, vbFromUnicode), i, 1))
Next i

Flag_ClearCommError_Write = ClearCommError(Handle_WriteCom, Err_ClearCommError_Write, Comstat_Write)

If Flag_ClearCommError_Write = 0 Then
    MsgBox "Fail to Clear Com Error!"
    CloseHandle Handle_WriteCom
    Handle_WriteCom = 0
    End

Else
    Bytes_Wrote = 0    
    Flag_Write = WriteFile(Handle_WriteCom, Buf_Write(1), UBound(Buf_Write), Bytes_Wrote, 0)

    If Bytes_Wrote = i-1 Then
        MsgBox "Wrote" & " " & Bytes_Wrote & " " & "Bytes"
        strText = strText & "Wrote OK :" & sData & vbCrLf
        txtDataBox.Text = strText & vbCrLf
    Else
        MsgBox "Fail to Write"
    End If        
End If

End Sub

Public Sub Read_Com(ByVal Handle_ReadCom As Long)
Dim Flag_Read As Long
Dim Bytes_Read As Long
Dim Buf_Read() As Byte
Dim Read_Err As Long
Dim Comstat_Read As Comstat
Dim Err_ClearCommError_Read As Long
Dim Flag_ClearCommError_Read As Long
Dim Flag_Wait_Read As Boolean
Dim i As Integer

Flag_ClearCommError_Read = ClearCommError(Handle_ReadCom, Err_ClearCommError_Read, Comstat_Read)

If Flag_ClearCommError_Read = 0 Then

    MsgBox "Fail to Clear Com Error!"
    CloseHandle Handle_ReadCom
    Handle_ReadCom = 0
    End 
Else
    If Comstat_Read.cbInQue > 0 Then
        ReDim Buf_Read(1 To Comstat_Read.cbInQue)

        Bytes_Read = 0
        Flag_Read = ReadFile(Handle_ReadCom, Buf_Read(1), Comstat_Read.cbInQue, Bytes_Read, 0)

        If Flag_Read = 1 Then
            strText = strText & "Read OK :"
            For i = 1 To Bytes_Read
                strText = strText & Buf_Read(i) & vbCrLf
            Next
            txtDataBox.Text = strText & vbCrLf

        Else
            MsgBox "Fail to Read!"
        End If           
    Else
        MsgBox "No Bytes in the buffer"
    End If
End If

End Sub

  • 写回答

0条回答 默认 最新

    报告相同问题?

    悬赏问题

    • ¥15 求daily translation(DT)偏差订正方法的代码
    • ¥15 js调用html页面需要隐藏某个按钮
    • ¥15 ads仿真结果在圆图上是怎么读数的
    • ¥20 Cotex M3的调试和程序执行方式是什么样的?
    • ¥20 java项目连接sqlserver时报ssl相关错误
    • ¥15 一道python难题3
    • ¥15 牛顿斯科特系数表表示
    • ¥15 arduino 步进电机
    • ¥20 程序进入HardFault_Handler
    • ¥15 关于#python#的问题:自动化测试