大佬帮忙：API串口通迅，电脑自身串口及USB转串口执行无问题，但是MOXA卡出来的串口收不到数据

[蓝人(mycls)]

Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim gRevstr As String
Private Sub Command1_Click()
Dim i As Integer
Dim j As Integer
Dim ii As Long
Dim temp As String

i = Val(Text1.Text)
j = Val(Text2.Text)
List1.Clear

For ii = i To j
temp = send(3, 2400, "68AAAAAAAAAAAA68110434373337B616", 2000)
List1.AddItem CStr(Now) + " " + CStr(ii) + "次 " + temp
Next ii
MsgBox "完毕"

End Sub
Function send(iCom As Long, iBadu As Integer, sSendStr As String, WaitTime As Integer) As String
Dim i, ilen As Integer
Dim j As Long
Dim sendbyte() As Byte
Dim sendstr1 As String
Dim str1 As String
Dim temp As String
Dim StrStr As String
sendstr1 = sSendStr
j = 0
ilen = Len(sendstr1) \ 2
For i = 1 To ilen
ReDim Preserve sendbyte(j)
sendbyte(j) = Val("&H" + Mid(sendstr1, i * 2 - 1, 2))
j = j + 1
Next i
'Debug.Print "开" + CStr(iCom)
'm_Handle = OpenPort(17, "2400,E,8,1")
StrStr = (CStr(iBadu) & ",E,8,1")
Call OpenPort(iCom, StrStr)
gRevstr = ""
Call SendData(sendbyte, j)
DoEvents
'MsgBox revdata(2000)
send = (revdata(WaitTime))
Debug.Print "关" + CStr(iCom)
Debug.Print ClosePort()

End Function
Function revdata(WaitTime As Integer) As String
Dim str1 As String
Dim temp As String
Dim revbyte(1024) As Byte
Dim i As Integer
Dim SaveTime As Long, NewTime As Long
Dim ljlj As Boolean
SaveTime = GetTickCount()
ljlj = True
Do While (ljlj)
'delay (120)
DoEvents
NewTime = GetTickCount()
idelay = NewTime - SaveTime
Debug.Print idelay
If (idelay >= WaitTime) Then
revdata = ""
Debug.Print "超时退出.."
Exit Do
End If

Call ReadData(revbyte, 1024)
str1 = ""
For i = 0 To 1023
temp = Hex(revbyte(i))
revbyte(i) = 0
While Len(temp) < 2
temp = "0" + temp
Wend
str1 = str1 + temp
Next i
While (Right(str1, 2) = "00")
str1 = Left(str1, Len(str1) - 2)
Wend
'Debug.Print str1
gRevstr = gRevstr + str1
' Debug.Print gRevstr
' Debug.Print CalcCRC(gRevstr)
If Len(gRevstr) >= 18 Then
ljlj = Not CalcCRC(gRevstr)
revdata = gRevstr
Else
ljlj = True
revdata = ""
End If
Loop
End Function


Function CalcCRC(Command1 As String) As Boolean '计算字符串校验是否正确
Dim ilen As Integer
Dim Scrc As String
Dim i As Integer
Dim ipos1 As Integer
Dim temp As String
Dim CRC1 As String


'找68
DoEvents
ipos1 = InStr(1, Command1, "68")
ilen = Len(Command1)
If ((ipos1 <= 0) Or (ilen <= 16)) Then
CalcCRC = False
Else
DoEvents
'Debug.Print "算校验"
Command1 = Mid(Command1, ipos1, Len(Command1))
'Debug.Print Command1
Scrc = (Left(Right(Command1, 4), 2))
temp = Left(Command1, IIf(Len(Command1) < 5, 2, (Len(Command1) - 4)))
'Debug.Print Scrc
'Debug.Print CStr(Len(temp)) + " " + temp
CRC1 = CRC(temp)
'Debug.Print "命令CRC:" + Scrc + " 算出的CRC:" + CRC1
If Scrc = CRC1 Then
CalcCRC = True
Else
CalcCRC = False
Debug.Print "校验码不对"
End If
End If
End Function

Function CRC(str1 As String) As String
Dim ilen As Integer
Dim i As Integer
Dim icrc As Integer
Dim temp As String
Dim ii As Integer
Dim j As Integer
Dim tempstr As String
DoEvents
ilen = Len(str1) \ 2
icrc = 0
For i = 1 To ilen
j = i * 2 - 1

tempstr = Mid(str1, j, 2)

ii = Val("&H" + tempstr)
'Debug.Print CStr(j) + " " + tempstr + " " + CStr(ii)
icrc = icrc + ii
Next i
icrc = icrc Mod 256
temp = Hex(icrc)
While Len(temp) < 2
temp = "0" + temp
Wend
CRC = temp
End Function

Function delay(delaytime As Integer) As Boolean
Dim SaveTime As Long
SaveTime = GetTickCount()
While GetTickCount() < SaveTime + delaytime
DoEvents
Wend
End Function

[worldy]

MOXA卡? 装了驱动程序了没有？检查设备管理器，是否有出现相应的串口

[蓝人(mycls)]

引用 1 楼 worldy 的回复:

MOXA卡? 装了驱动程序了没有？检查设备管理器，是否有出现相应的串口

驱动无问题，串口能发现，用串口调试工具，可以正常收发数据

[worldy]

那就检查baud率，校验方式，停止位等参数设置是否和下位机一致，使用低的波特率进行测试

[蓝人(mycls)]

引用 3 楼 worldy 的回复:

那就检查baud率，校验方式，停止位等参数设置是否和下位机一致，使用低的波特率进行测试

设置全部正常，用电脑自带的串口和USB转232线，都可以正常通讯

[蓝人(mycls)]

源码下载地址http://download.csdn.net/detail/vmycls/5955447

[worldy]

你给源码没有用，又没有设备可以帮你测试 你自己确认几个问题： 你的代码除端口外，其它不能改变的情况下 确实在机子原配的串口上通信成功 确实是否使用串口调试软件上，在板卡上测试成功？（串口测试软件的参数测试必须和前面一样）

[蓝人(mycls)]

引用 6 楼 worldy 的回复:

你给源码没有用，又没有设备可以帮你测试 你自己确认几个问题： 你的代码除端口外，其它不能改变的情况下 确实在机子原配的串口上通信成功 确实是否使用串口调试软件上，在板卡上测试成功？（串口测试软件的参数测试必须和前面一样）

我用串口监控看到，使用MOXA卡通讯的时候 不知道为什么，所有串口参数都被改变了，【用电脑自身串口没有这个问题】 1 [00000000] IRP_MJ_CREATE Port Opened - vb6.exe 2 [00000096] IOCTL_SERIAL_SET_BAUD_RATE Baud Rate: 2400 3 [00000096] IOCTL_SERIAL_SET_LINE_CONTROL StopBits: 1, Parity: Even, DataBits: 8 4 [00000096] IOCTL_SERIAL_SET_BAUD_RATE Baud Rate: 1200 5 [00000096] IOCTL_SERIAL_SET_LINE_CONTROL StopBits: 1, Parity: No, DataBits: 7 监控到改变这些数据的是 SetCommState(m_Handle, dcbs) 这条API语句，请指导 一下

[worldy]

上述哪些参数什么意思？ 看起来是调试软件正在扫描下位机的通信参数设置 不知道你说的使用串口调试软件能正常通过你的板卡，你的判断依据是什么？

[蓝人(mycls)]

引用 8 楼 worldy 的回复:

上述哪些参数什么意思？ 看起来是调试软件正在扫描下位机的通信参数设置 不知道你说的使用串口调试软件能正常通过你的板卡，你的判断依据是什么？

就是说我刚刚把波特率改为2400停止位 1校验 Even数据位 8 这条API在此之后又把波特率改为1200停止位 1校验 None 数据位 7 在电脑自带串口没有发现有此问题

[worldy]

这条API在此之后又把波特率改为1200停止位 1校验 None 数据位 7 这个设置能正常通信？ 如果能，那你将mscomm的setting参数设置和它一样，试试 1200，n，7，1

[蓝人(mycls)]

谢谢各位，我已经解决该问题 出现问题的原因是，模块的DCB结构体定义有问题 模块是从CSDN下载的，估计没有测试过MOXA卡的环境， 如下定义后，正常 Private 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 EvtChar As Byte wReserved1 As Integer End Type

[贝隆]

http://download.csdn.net/detail/veron_04/1339593

[蓝人(mycls)]

引用 10 楼 worldy 的回复:

这条API在此之后又把波特率改为1200停止位 1校验 None 数据位 7 这个设置能正常通信？ 如果能，那你将mscomm的setting参数设置和它一样，试试 1200，n，7，1

我的意思是我的本意要把波特率改为2400，E，8，1 但是我改完之后，波特率又变回1200，n，7，1 了， 电脑自带串口不会变，USB转232，也不会变 MOXA卡通讯就会变了 -----------------------打开串口的源码如下 Public Function OpenPort(ComNumber As Long, Comsettings As String, Optional lngInSize As Long = 1024, Optional lngOutSize As Long = 512) As Long On Error GoTo handelinitcom Dim retval As Long Dim CtimeOut As COMMTIMEOUTS, dcbs As DCB Dim strCOM As String, strConfig As String If ComNumber > 9 Then strCOM = "\\.\\COM" & Format(ComNumber, "00") Else strCOM = "COM" & Format(ComNumber, "0") End If strCOM = Trim(strCOM) m_Handle = CreateFile(strCOM, GENERIC_READ Or GENERIC_WRITE, 0, 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL Or FILE_FLAG_OVERLAPPED, 0) ' m_Handle = CreateFile("COM1", &HC0000000, 0, 0&, &H3, 0, 0) Debug.Print "开" + CStr(ComNumber) + "句柄" + CStr(m_Handle) If m_Handle = -1 Then OpenPort = -1 Exit Function End If '设置dcb块 dcbs.DCBlength = Len(dcbs) '长度 Call GetCommState(m_Handle, dcbs) '波特率,奇偶校验,数据位,停止位 如：9600,n,8,1 strConfig = "COM" & Format(ComNumber, "0") & ":" & Comsettings Call BuildCommDCB(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 ^ 0 Or DTR_CONTROL_DISABLE * 2 ^ 4 Or 1 * 2 ^ 7 Or RTS_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 '停止位 'dcbs.BaudRate =9600 '波特率 'dcbs.Parity=0 '奇偶校验 'dcbs.ByteSize=8 '数据位 'dcbs.StopBits=0 '停止位 '------------------------------ If dcbs.Parity = 0 Then ' 0-4=None,Odd,Even,Mark,Space dcbs.fBitFields = dcbs.fBitFields And &HFFFD 'dcbs.fParity = 0 '奇偶校验无效 Else dcbs.fBitFields = dcbs.fBitFields Or &H2 'dcbs.fParity = 1 '奇偶校验有效 End If '超时设置 CtimeOut.ReadIntervalTimeout = 2 '0 CtimeOut.ReadTotalTimeoutConstant = 2 '2500 CtimeOut.ReadTotalTimeoutMultiplier = 2 '0 CtimeOut.WriteTotalTimeoutConstant = 3 '2500 CtimeOut.WriteTotalTimeoutMultiplier = 3 '0 retval = SetCommTimeouts(m_Handle, CtimeOut) If retval = -1 Then retval = GetLastError() OpenPort = retval retval = CloseHandle(m_Handle) Exit Function End If '获取信号句柄 Dim lpEventAttributes1 As SECURITY_ATTRIBUTES Dim lpEventAttributes2 As SECURITY_ATTRIBUTES m_OverlappedRead.hEvent = CreateEvent(lpEventAttributes1, 1, 0, 0) m_OverlappedWrite.hEvent = CreateEvent(lpEventAttributes2, 1, 0, 0) '判断设置参数是否成功 设置输入和输出缓冲区是否成功 If SetCommState(m_Handle, dcbs) = -1 Or SetupComm(m_Handle, lngInSize, lngOutSize) = -1 Or m_OverlappedRead.hEvent = 0 Or m_OverlappedWrite.hEvent = 0 Then retval = GetLastError() OpenPort = retval If (m_OverlappedRead.hEvent <> 0) Then CloseHandle (m_OverlappedRead.hEvent) If (m_OverlappedWrite.hEvent <> 0) Then CloseHandle (m_OverlappedWrite.hEvent) Call CloseHandle(m_Handle) m_Handle = 0 Exit Function End If OpenPort = 0 Exit Function handelinitcom: Call CloseHandle(m_Handle) m_Handle = 0 OpenPort = -2 Exit Function End Function

[zdingyun]

那就换块MOXA卡通讯，试下如何？

[蓝人(mycls)]

引用 12 楼 zdingyun 的回复:

那就换块MOXA卡通讯，试下如何？

同样的问题

[贝隆]

我想问个问题，不用API编写通信程序，Moxa卡的串口是否通信正常？

[贝隆]

我的意思是用Mscomm编写的串口通信程序