大佬帮忙:API串口通迅,电脑自身串口及USB转串口执行无有关问题,但是MOXA卡出来的串口收不到数据
大佬帮忙:API串口通迅,电脑自身串口及USB转串口执行无问题,但是MOXA卡出来的串口收不到数据
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)))
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)))