dim Const ACK = 6
dim T as long
dim Const AskConnect = "~~~"
MSComm1.InputLen = 1
Dim ask000
ask000 = 0
Do
Success = False
If Not MSComm1.PortOpen Then MSComm1.PortOpen = True
MSComm1.InputLen = 0
inBUF = MSComm1.Input
MSComm1.InputLen = 1
MSComm1.Output = AskConnect & vbCrLf
ask000 = ask000 + 1
Debug.Print ask000
T = Timer + 1
Do Until Timer > T
If MSComm1.InBufferCount > 0 Then
inBUF = ""
inBUF = MSComm1.Input
If inBUF = ChrB(ACK) Then
Success = True
Exit Do
End If
End If
Ret = DoEvents()
Loop
If Success Then Exit Do
Loop Until UserCancel
疑难点:MSComm1.Output = AskConnect & vbCrLf是什么意思,ChrB(ACK)值又是多少?请帮忙,万分感谢!解决马上给分,决不食言!(最好能给出具体每一行的解释)
dim T as long
dim Const AskConnect = "~~~"
MSComm1.InputLen = 1
Dim ask000
ask000 = 0
Do
Success = False
If Not MSComm1.PortOpen Then MSComm1.PortOpen = True
MSComm1.InputLen = 0
inBUF = MSComm1.Input
MSComm1.InputLen = 1
MSComm1.Output = AskConnect & vbCrLf
ask000 = ask000 + 1
Debug.Print ask000
T = Timer + 1
Do Until Timer > T
If MSComm1.InBufferCount > 0 Then
inBUF = ""
inBUF = MSComm1.Input
If inBUF = ChrB(ACK) Then
Success = True
Exit Do
End If
End If
Ret = DoEvents()
Loop
If Success Then Exit Do
Loop Until UserCancel
疑难点:MSComm1.Output = AskConnect & vbCrLf是什么意思,ChrB(ACK)值又是多少?请帮忙,万分感谢!解决马上给分,决不食言!(最好能给出具体每一行的解释)
解决方案 »
- 新手求助!随机问题!
- 用HTML Help Workshop开发的帮助文件文字能看到,图片看不到?为什么?救命啊!!
- 高分请教:怎样用VB关闭一个端口,如80,8000端口?
- 如何用ADO执行ORACLE诸如 DESC TABLE1 之类的SQL语句?
- 哪位大侠有符合国情的报表控件,本人付费求购!
- 如何将EXCEL中的数据转化为DBF文件?
- 程序调试中有这样的内容提示:Run-time error '3315':Field 'test.setplace' can't be a zero-length string-----可能会是什么原因
- 如何在vb6.0中屏蔽win2000的热键!
- *****************一个关于从一个数据库向另一个数据库导数据的小问题,请诸位大侠多多帮忙啊!小弟先谢了*****************
- 请问如何改变inputbox中显示信息的默认的字体字型?
- vb控件打包问题
- 请问怎么用程序控制发出“当”的一声?
向串口写"~~~"并最后带有回车。2)ChrB always returns a single byte
Dim T As Long
dim Const AskConnect = "~~~" '定义请求连接的命令
MSComm1.InputLen = 1 '设置串口接受长度为1,即接到1个字符就产生oncomm事件
Dim ask000 '调试用变量,看多少次成功
ask000 = 0
Do
Success = False '初始化成功标志为False
'以下为设置串口的工作模式和打开串口
If Not MSComm1.PortOpen Then MSComm1.PortOpen = True
MSComm1.InputLen = 0
inBUF = MSComm1.Input
MSComm1.InputLen = 1
'串口设置结束
MSComm1.Output = AskConnect & vbCrLf '发送连接请求命令
ask000 = ask000 + 1
Debug.Print ask000
T = Timer + 1 '设置一个超时时间,即过了此时间未接到正确的数据,则认为本次通信失败
Do Until Timer > T '是否超过了预期的时间
If MSComm1.InBufferCount > 0 Then '串口的接受缓冲区中是否有数
inBUF = ""
inBUF = MSComm1.Input '接受数据
If inBUF = ChrB(ACK) Then '判断接受到的是否为ACK信号
Success = True '正确接受到则设置成功标志并退出
Exit Do
End If
End If
Ret = DoEvents()
Loop
If Success Then Exit Do '判断成功标志并退出
Loop Until UserCancel '根据外部的取消标志判断是否继续。
do until...loop 和 do ...loop until有什么区别啊?
1,另一台电脑中,你运行了接受到“~~~”后可以发送一些数据,比如ACK的程序了吗?
如果没有,请运行;如果有,请看2。
2,两边的端口设置是否正确,其中除了端口号可以不一样以外,速率、奇偶校验位、停止位等应该都一样。确定正确到3,否则请设置正确。
3,另一台电脑的串口是否损坏,串口不能支持热插拔,如果带电插拔的话,很容易损坏。检验的办法,连上modem,看看是否可以正常拨号上网。没有损坏到4,否则换个串口或换个机子。
4,连接用串口线是否正确?正确的串口线,应该使用2、3、5线(好像是,3、4年没碰串口了,记不清了),其中2、3线是数据线,电脑与电脑之间连接的,应该是2、3交叉、5直接联通。串口线正确到5,否则换根串口线。
5,~~~~~把程序发给我吧,我帮你调。发的话请留回复帖子告诉,否则~~~就这样吧。呵呵,我能想到的就这些了,不行就只有5了。
Dim FileName As String * 20
Dim FileLenth As String * 10
Dim FileCreateTime As String * 20
Dim FilePath As String * 64
Dim T As Long
Dim Success As Boolean
Dim inBUF As Variant
Dim OutBUF() As Byte
Dim ASKTimes As Integer
Dim Ret As Long
Dim HSend As Long
On Error Resume Next
sendFile = ""
FileName = Space(20)
FileLenth = Space(10)
FileCreateTime = Space(20)
FilePath = (64) FileName = Dir(FName)
FilePath = Left(FName, Len(FName) - Len(Dir(FName)) - 1)
FileLenth = CStr(FileLen(FName))
FileCreateTime = Format(FileDateTime(FName), "YYYY/MM/DD HH:NN:SS")
'请求发送
SEND0:
UserCancel = False
MSComm1.InputLen = 1
Dim ask000
ask000 = 0
Do
Success = False
If Not MSComm1.PortOpen Then MSComm1.PortOpen = True
MSComm1.InputLen = 0
inBUF = MSComm1.Input
MSComm1.InputLen = 1
MSComm1.Output = AskConnect & vbCrLf
ask000 = ask000 + 1
Debug.Print ask000
T = Timer + 1
Do Until Timer > T
If MSComm1.InBufferCount > 0 Then
inBUF = ""
inBUF = MSComm1.Input
If inBUF = ChrB(ACK) Then
Success = True
Exit Do
End If
End If
Ret = DoEvents()
Loop
If Success Then Exit Do
Loop Until UserCancel
If UserCancel Then Exit Function
'请求成功,发送文件头
ReDim OutBUF(127)
OutBUF = StrConv(Space(128), vbFromUnicode)
OutBUF = StrConv("~~~~~", vbFromUnicode) & _
StrConv(FileName, vbFromUnicode) & _
StrConv(FileLenth, vbFromUnicode) & _
StrConv(FileCreateTime, vbFromUnicode) & _
StrConv(FilePath, vbFromUnicode) & StrConv(Space(9), vbFromUnicode)
Send1:
Success = False
T = Timer + 5
MSComm1.InBufferCount = 0
MSComm1.Output = OutBUF
Do
If MSComm1.InBufferCount > 0 Then
inBUF = MSComm1.Input
Select Case inBUF
Case ChrB(ACK)
Success = True: Exit Do
Case ChrB(NAK)
GoTo Send1
End Select
End If
Ret = DoEvents
ASKTimes = ASKTimes - 1
Loop Until Timer > T
If Not Success Then Exit Function
'发送文件内容
' 打开文件。
HSend& = FreeFile
Err.Clear
Open FName For Binary Access Read As HSend
If Err Then
ShowData txtTerm, vbCrLf & "文件: " & FileName & "打开失败!"
Exit Function
End If
Dim BSize
' 把文件读到传输缓冲区尺寸的块中。
BSize = MSComm1.OutBufferSize
Dim LF&
LF& = LOF(HSend)
ShowData txtTerm, vbCr & "文件: " & FileName & "正在发送!"
Success = False
MSComm1.InBufferCount = 0
Do Until Loc(HSend) >= LF Or UserCancel
' 计算结尾处数据。
If LF& - Loc(HSend) <= BSize Then
BSize = LF& - Loc(HSend)
End If
' 读数据块。
ReDim OutBUF(BSize - 1)
Get HSend, , OutBUF
' 传输此块。
Err.Clear
MSComm1.Output = OutBUF
sbrStatus.Panels(1).Text = "状态: 已发送 " & CStr(Loc(HSend)) & "字节"
If Err Then
ShowData txtTerm, vbCr & "文件: " & FileName & "Error: " & Error$
Exit Do
End If
' 等待所有数据被发送。
Do
Ret = DoEvents()
Loop Until MSComm1.OutBufferCount = 0
Loop
T = Timer + 5
MSComm1.InputLen = 1
inBUF = ""
Do
If MSComm1.InBufferCount > 0 Then
inBUF = MSComm1.Input
If AscB(inBUF) = AscB("C") Then
ShowData txtTerm, ".......失败!"
Dim tmpFile As String
tmpFile = Right$(FName, 10)
Name FName As errPath & "\" & tmpFile
GoTo SEND0
ElseIf AscB(inBUF) = AscB("B") Then
ShowData txtTerm, ".......完成!时间:" & Format(Now, "yyyy-mm-dd hh:mm:ss")
sendFile = "s_send"
Exit Do
ElseIf AscB(inBUF) = AscB("A") Then
ShowData txtTerm, ".......完成!时间:" & Format(Now, "yyyy-mm-dd hh:mm:ss")
sendFile = "s_recieve"
Exit Do
End If' If inBUF = ChrB(CAN) Then
' ShowData txtTerm, ".......失败!"
' GoTo SEND0
' ElseIf inBUF = ChrB(ACK) Then
' ShowData txtTerm, ".......完成! 继续发送"
' sendFile = "s_send"
'
' Exit Do
' ElseIf inBUF = ChrB(SND) Then
' ShowData txtTerm, ".......完成! 转为接收状态"
' sendFile = "s_recieve"
' Exit Do
' End If
End If
Loop Until Timer > T
Close #HSend
On Error GoTo 0
End Function
Dim inBUF As Variant
Dim Ret As Long
Dim p1 As Integer, p2 As Integer
Dim LocalPath$
Dim rfName As String
Dim rfLen As String
Dim rfDate As String
Dim rfPath As String
Dim rfHand As Long
Dim TMP As String
Dim i, T 'Open the log file to record run status and errors
On Error Resume Next
MSComm1.InputMode = comInputModeBinary
MSComm1.RThreshold = 0
If Not MSComm1.PortOpen Then MSComm1.PortOpen = True
If Err Then
ShowData txtTerm, vbCr & Err.Description
'Call initproc
Exit Function
End IfWaiting_Connect:
UserCancel = False
inBUF = "": MSComm1.InBufferCount = 0
Do
sbrStatus.Panels(1).Text = "状态: 接收已启动, 等待连接......"
If MSComm1.InBufferCount > 0 Then
inBUF = inBUF & StrConv(MSComm1.Input, vbUnicode)
End If
If InStrB(inBUF, AskConnect) > 0 Then
'有连接请求
sbrStatus.Panels(1).Text = "状态: 收到连接请求......"
Exit DoEnd If
Ret = DoEvents
Loop Until UserCancel
If UserCancel Then Exit Function
inBUF = ""
Err.Clear
MSComm1.InBufferCount = 0
MSComm1.Output = ChrB(ACK) & ChrB(ACK) & ChrB(ACK) & vbCr
T = Timer + 5
Do
If MSComm1.InBufferCount > 0 Then GoTo Rev1
DoEvents
Loop Until Timer > T
MSComm1.Output = ChrB(CAN) & vbCrLf
GoTo Waiting_Connect
Rev1:
'接收文件信息块
MSComm1.InputLen = 0
For i = 1 To 3
Ret = False
T = Timer + 100
Do '信息块长度128
DoEvents
If MSComm1.InBufferCount > 0 Then inBUF = inBUF & MSComm1.Input
If LenB(inBUF) >= 128 Then
Exit Do
End If
Loop Until Timer > T
If LenB(inBUF) >= 128 Then
inBUF = StrConv(inBUF, vbUnicode)
p1 = InStr(1, inBUF, "~~~~~")
If p1 > 0 And p1 < 4 Then
rfName = Trim$(Mid(inBUF, p1 + 5, 20))
rfLen = Trim$(Mid(inBUF, p1 + 25, 10))
rfDate = Trim$(Mid(inBUF, p1 + 35, 20))
rfPath = Trim$(Mid(inBUF, p1 + 55, 64))
Ret = True
Exit For
Else
inBUF = MSComm1.Input
inBUF = ""
MSComm1.Output = ChrB(NAK)
End If
Else
Exit For
End If
Next i
'MSComm1.InputLen = 1
If Not Ret Then MSComm1.Output = CAN: GoTo Waiting_Connect
'判定是否使用对方指定的文件路径
If RemotePath Then
'使用对方指定的目录
If Dir(rfPath, vbDirectory) = "" Then
'对方指定的目录不存在,试图创建
Err.Clear
MkDir rfPath
If Err Then
'不能创建指定目录, 使用临时目录
rfPath = App.Path & "\temp"
ShowData txtTerm, vbCr & "不能创建文件" & rfName & "指定的目录, 使用临时目录"
End If
End If
Else
'不使用对方指定的目录,
'检查文件类型
LocalPath$ = ""
For i = 0 To TypeNum - 1
If UCase(Right(Trim(rfPath), 5)) = "PHOTO" Then
If UCase(Right(rfName, 3)) = FileType(i) Then LocalPath = FilePath(i) & "\Photo"
Else
If UCase(Right(rfName, 3)) = FileType(i) Then LocalPath = FilePath(i)
End If
Next i
If LocalPath = "" Then
'类型不符, 使用临时目录
ShowData txtTerm, vbCr & rfName & "类型本地无定义, 使用临时目录!"
rfPath = App.Path & "\temp"
Else
rfPath = LocalPath
End If
End If
rfHand = FreeFile
TMP = rfPath & "\" & rfName
Err.Clear
If Dir(TMP) <> "" Then
Kill TMP
If Err Then
ShowData txtTerm, vbCr & "文件:" & rfName & "存在且不能覆盖,文件被放弃!"
MSComm1.Output = ChrB(CAN) & vbCr
GoTo Waiting_Connect
End If
End If
Open TMP For Binary Access Write As #rfHand
If Err Then
ShowData txtTerm, vbCr & "文件" & rfName & "不能打开,文件被放弃!"
MSComm1.Output = ChrB(CAN) & vbCr
GoTo Waiting_Connect
End If
inBUF = ""
MSComm1.InputLen = 0
Ret = False
ShowData txtTerm, vbCrLf & "正在接收文件:" & rfName & " 总长度:" & rfLen & "bytes"
inBUF = MSComm1.Input
MSComm1.Output = ChrB(ACK) & vbCr
inBUF = ""
'对方5秒内必须发送过来
T = Timer + 5
Do
If MSComm1.InBufferCount > 0 Then GoTo RevContens
DoEvents
Loop Until Timer > T
MSComm1.Output = ChrB(CAN) & vbCrLf
Close #rfHand
GoTo Waiting_Connect
Dim BK As Long
BK = 0
RevContens:
T = Timer + (CLng(rfLen) / 1024)
Do
If MSComm1.InBufferCount > 0 Then
BK = MSComm1.InBufferCount
ReDim BuffByte(BK - 1)
MSComm1.InputLen = BK
BuffByte = MSComm1.Input
Put #rfHand, , BuffByte
sbrStatus.Panels(1).Text = "状态: 收到 " & CStr(Loc(rfHand)) & "字节 "
If Loc(rfHand) >= CLng(rfLen) - 1 Then
'接收完成,关闭文件
Ret = True
Exit Do
End If
End If
DoEvents
Loop Until Timer > T
Close #rfHand
'============================================================
If Ret Then
ShowData txtTerm, "......接收完成!时间:" & Format(Now, "yyyy-mm-dd hh:mm:ss")
If Trim$(Dir(CodePath & "\*." & CodeType)) <> "" Then 'Dir("c:\test\*.txt") 我有文件要发
MSComm1.Output = "A" ' ChrB(SND) & ChrB(SND) & ChrB(SND) & vbCr ' ChrB(CAN) & vbCr ' "K" 'ChrB(SND) & ChrB(SND) & ChrB(SND) & vbCr
recieveFile = "r_send"
File2.Refresh
Exit Function
Else '请发下一个
MSComm1.Output = "B" ' ChrB(ACK) & ChrB(ACK) & ChrB(ACK) & vbCr
recieveFile = "r_recieve"
'ShowData txtTerm, "......send ACK to !"
Exit Function
End If
Else
ShowData txtTerm, "......接收失败!时间:" & Format(Now, "yyyy-mm-dd hh:mm:ss")
Kill TMP
MSComm1.Output = "C" ' ChrB(CAN) & vbCr
recieveFile = "r_fail"
GoTo Waiting_Connect
End If
On Error GoTo 0
'============================================================
' If Ret Then
' ShowData txtTerm, "......接收完成!"
' MSComm1.Output = ChrB(99) & ChrB(99) & ChrB(99) & vbCr
'
'' MSComm1.Output = ChrB(ACK) & ChrB(ACK) & ChrB(ACK) & vbCr
' Else
' ShowData txtTerm, "......接收失败!"
' Kill TMP
' MSComm1.Output = ChrB(CAN) & vbCr
' End If
' GoTo Waiting_Connect
End Function
仔细看了一遍两边的connect部分,没有原则性的错误。你可以再这么试一下:
1,加大第一段程序等待连接部分的t=timer+1的值,比如把1改成2、甚至3、4试试;
2,在接受方,就是第二段程序中的等待连接部分这部分
sbrStatus.Panels(1).Text = "状态: 接收已启动, 等待连接......"
If MSComm1.InBufferCount > 0 Then
在这里加上debug,看看到底接受到数据没有,或者接收到的是什么东西。
3,你的串口的波特率率是多少,降低一些,比如9600。
如果两端都可用用moden,但彼此却无法通信,那我怀疑有几个情况,
1,还是链路的问题,无论是哪端,接受到的数据可能是非法的,这可能是由端口设置不匹配、波特率过高、线路不好有干扰等各种原因造成的;
2,时序不匹配,接受端的反应迟缓,总是造成发送端超时。
你先试一下,有测试环境的朋友也可以帮忙调一下,我没有串口线,只能帮你读程序了。
唉~~~几年前的程序都丢光了,否则直接给你一个了。
顺便说一句,一般计算机都有两个串口,我以前调这种通信程序都是在一台机子上调。
按楼上说的在试试,如果串口没有问题的话,是不是你的串口线有毛病?