求读串口数据源代码
我想要一段读串口数据源代码，请把文件发到killuat1s@yahoo.com.cn,或加qq:20635802或msn:mustapha1207@hotmail.com 急！！调试通过即给分 问题点数：100、回复次数：6Top
1 楼DooDu（杜霖:I want,I can(开关拉)）回复于 2005-08-02 22:01:46 得分 40
Option Explicit
Global ComNum As Long
Global bRead(255) As Byte
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
Type COMMTIMEOUTS
ReadIntervalTimeout As Long
ReadTotalTimeoutMultiplier As Long
ReadTotalTimeoutConstant As Long
WriteTotalTimeoutMultiplier As Long
WriteTotalTimeoutConstant As Long
End Type
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
End Type
Type OVERLAPPED
Internal As Long
InternalHigh As Long
offset As Long
OffsetHigh As Long
hEvent As Long
End Type
Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function GetLastError Lib "kernel32" () As Long
Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Declare Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
Declare Function GetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
Declare Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" (ByVal lpDef As String, lpDCB As DCB) As Long
Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long, lpDCB As DCB) As Long
Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
Function fin_com()
fin_com = CloseHandle(ComNum)
End Function
'关闭端口
Function FlushComm()
FlushFileBuffers (ComNum)
End Function
'初始化端口
Function Init_Com(ByVal ComNumber As String, ByVal Comsettings As String) As Boolean
'On Error GoTo handelinitcom
Dim ComSetup As DCB, Answer, Stat As COMSTAT, RetBytes As Long
Dim retval As Long
Dim CtimeOut As COMMTIMEOUTS, BarDCB As DCB
' 打开通讯口读/写(&HC0000000).
' 必须指定存在的文件 (3).
ComNum = CreateFile(ComNumber, &HC0000000, 0, 0&, &H3, 0, 0)
If ComNum = -1 Then
MsgBox "端口 " & ComNumber & "无效. 请设置正确.", 48
Init_Com = False
Exit Function
End If
'超时
CtimeOut.ReadIntervalTimeout = 20
CtimeOut.ReadTotalTimeoutConstant = 1
CtimeOut.ReadTotalTimeoutMultiplier = 1
CtimeOut.WriteTotalTimeoutConstant = 10
CtimeOut.WriteTotalTimeoutMultiplier = 1
retval = SetCommTimeouts(ComNum, CtimeOut)
If retval = -1 Then
retval = GetLastError()
MsgBox "端口超时设定无效 " & ComNumber & " 错误: " & retval
retval = CloseHandle(ComNum)
Init_Com = False
Exit Function
End If
retval = BuildCommDCB(Comsettings, BarDCB)
If retval = -1 Then
retval = GetLastError()
MsgBox "无效设备 DCB 块 " & Comsettings & " 错误: " & retval
retval = CloseHandle(ComNum)
Init_Com = False
Exit Function
End If
retval = SetCommState(ComNum, BarDCB)
If retval = -1 Then
retval = GetLastError()
MsgBox "无效设备 DCB 块 " & Comsettings & " 错误: " & retval
retval = CloseHandle(ComNum)
Init_Com = False
Exit Function
End If
Init_Com = True
'handelinitcom:
' Exit Function
End Function
'从串口读取数据
Function ReadCommPure() As String
'On Error GoTo handelpurecom
Dim RetBytes As Long, i As Integer, ReadStr As String, retval As Long
Dim CheckTotal As Integer, CheckDigitLC As Integer
retval = ReadFile(ComNum, bRead(0), 255, RetBytes, 0)
If (RetBytes > 0) Then
ReadCommPure = CStr(bRead(0)) & " " & CStr(bRead(1))
Else
FlushComm
ReadCommPure = ""
End If
'handelpurecom:
' Exit Function
End Function
'向串口写数据
Public Function WriteCOM32(ByVal Byte1 As Byte, ByVal Byte2 As Byte) As Integer
'On Error GoTo handelwritelpt
Dim RetBytes As Long
Dim retval As Long
bRead(0) = Byte1
bRead(1) = Byte2
' bRead(LenVal) = 0
retval = WriteFile(ComNum, bRead(0), 2, RetBytes, 0)
' FlushComm
WriteCOM32 = RetBytes
'handelwritelpt:
' MsgBox "数据发送失败，请检查！"
' Exit Function
End Function
Top
2 楼DooDu（杜霖:I want,I can(开关拉)）回复于 2005-08-02 22:05:37 得分 0
Init_Com用于连接设置
ReadCommPure是读两个字节的例子，你改成
for i=0 to RetBytes-1
next
就行了Top
3 楼mustapha（O~U Gain）回复于 2005-08-03 07:56:59 得分 0
请问您的qq或者msn?关于这个事情我要请教。怎么源代码放在form1中，Global ComNum As Long
Global bRead(255) As Byte 是红色的？
Top
4 楼mustapha（O~U Gain）回复于 2005-08-03 08:20:27 得分 0
我把您的代码拷到模块里，然后在form1中这样调用：
Private Sub Command1_Click()
Label1.Caption = ReadCommPure()
End Sub
label1为空字符串。我看您的这段代码：
'从串口读取数据
Function ReadCommPure() As String
'On Error GoTo handelpurecom
Dim RetBytes As Long, i As Integer, ReadStr As String, retval As Long
Dim CheckTotal As Integer, CheckDigitLC As Integer
retval = ReadFile(ComNum, bRead(0), 255, RetBytes, 0)
If (RetBytes > 0) Then
ReadCommPure = CStr(bRead(0)) & " " & CStr(bRead(1))
Else
FlushComm
ReadCommPure = ""
End If
'handelpurecom:
' Exit Function
End Function
RetBytes被定义后没做什么赋值动作，肯定=0了，所以RetBytes > 0永远不可能啊；如果改成RetBytes >= 0，则CStr(bRead(0))和CStr(bRead(1))都没有赋值，显示出来是2个0Top
5 楼zlj113（·米老鼠· 学习）回复于 2005-08-03 09:01:38 得分 10
不懂，帮你UPTop
6 楼tanzsf（tan）回复于 2005-08-05 01:38:49 得分 50
直接用mscomm控件吧,很简单的,怎么用msdn中有例子Top
