程序是从mndsoft.com下的,调试用没问题,编译出来就发也发不出去,收也收不到了。这个怎么回事啊??doodu这个id刚散完了分,只能用现在这个id发贴了。就这100分了。。不够以后再补~~真是急死拉,都快交东西了,才发现模块编译出来不能用,以前都是调试状态执行的,没什么问题55555555~~模块代码如下:Option ExplicitGlobal ComNum As Long
Global bRead(255) As ByteType 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 TypeType COMMTIMEOUTS
ReadIntervalTimeout As Long
ReadTotalTimeoutMultiplier As Long
ReadTotalTimeoutConstant As Long
WriteTotalTimeoutMultiplier As Long
WriteTotalTimeoutConstant As Long
End TypeType 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 TypeType 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 TypeDeclare 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, lpOverlapped As Long) As Long
Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, 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(ComNumber As String, 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)
ReadStr = ""
If (RetBytes > 0) Then
For i = 0 To RetBytes - 1
ReadStr = ReadStr & Chr(bRead(i))
Next i
Else
FlushComm
End If
ReadCommPure = ReadStr
handelpurecom:
Exit Function
End Function'向串口写数据
Function WriteCOM32(COMString As String) As Integer
On Error GoTo handelwritelpt
Dim RetBytes As Long, LenVal As Long
Dim retval As Long
If Len(COMString) > 255 Then
WriteCOM32 Left$(COMString, 255)
WriteCOM32 Right$(COMString, Len(COMString) - 255)
Exit Function
End If
For LenVal = 0 To Len(COMString) - 1
bRead(LenVal) = Asc(Mid$(COMString, LenVal + 1, 1))
Next LenVal
' bRead(LenVal) = 0
retval = WriteFile(ComNum, bRead(0), Len(COMString), RetBytes, 0)
' FlushComm
WriteCOM32 = RetBytes
handelwritelpt:
Exit Function
End Function
Global bRead(255) As ByteType 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 TypeType COMMTIMEOUTS
ReadIntervalTimeout As Long
ReadTotalTimeoutMultiplier As Long
ReadTotalTimeoutConstant As Long
WriteTotalTimeoutMultiplier As Long
WriteTotalTimeoutConstant As Long
End TypeType 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 TypeType 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 TypeDeclare 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, lpOverlapped As Long) As Long
Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, 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(ComNumber As String, 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)
ReadStr = ""
If (RetBytes > 0) Then
For i = 0 To RetBytes - 1
ReadStr = ReadStr & Chr(bRead(i))
Next i
Else
FlushComm
End If
ReadCommPure = ReadStr
handelpurecom:
Exit Function
End Function'向串口写数据
Function WriteCOM32(COMString As String) As Integer
On Error GoTo handelwritelpt
Dim RetBytes As Long, LenVal As Long
Dim retval As Long
If Len(COMString) > 255 Then
WriteCOM32 Left$(COMString, 255)
WriteCOM32 Right$(COMString, Len(COMString) - 255)
Exit Function
End If
For LenVal = 0 To Len(COMString) - 1
bRead(LenVal) = Asc(Mid$(COMString, LenVal + 1, 1))
Next LenVal
' bRead(LenVal) = 0
retval = WriteFile(ComNum, bRead(0), Len(COMString), RetBytes, 0)
' FlushComm
WriteCOM32 = RetBytes
handelwritelpt:
Exit Function
End Function
解决方案 »
- 提醒功能
- 对界面上N个输入框进行特殊字符的屏蔽,有什么快速有效的办法没?
- msdn是不是有错呀?single的变量前缀是str,大家都看一下.
- *******水晶报表*******我晕我晕我晕晕晕
- 散分征集VB朋友,相互交流VB问题.
- listview中加图标可不可以不用imagelist控件?
- VB 一个棘手的问题
- 如何用VB写一个读取第一个硬盘物理序列号来实现软件注册的注册器和注册码生成器 看清 是第一个硬盘的,普通读硬盘的在双硬盘的机器上就失效的
- 关于Microsoft Visual SourceSafe
- 我如何提高数据库数据访问效率?马上结分!
- listview如何读取文档文件??
- 把程序进程隐藏起来?
其次,你先多放几个msgbox,看看问题出在哪里
顶!
希望枕善居主人来看看.呵.
建议,调试时,将WriteCOM32中的On Error去掉,看出错在哪?
on err都去了,没有报错,就是RetBytes=0
测试时,发送的是英文指令,可不管是什么,调试状态都可以,编译出来就不行了。是系统的原因?
可惜没法帮你调试,只能猜测分析你是用本机代码编译的吗?试试P代码行不行?Function WriteCOM32(COMString As String) As Integer
改成
Function WriteCOM32(Byval COMString As String) As Integer这个函数使用了按址传参的递归调用,在编译时选中“无别名”可能会带来问题。
ReadFile与WriteFile函数的API声明肯定错了,请注意:lpOverlapped参数,这个参数要求的是一个指向Overlapped结构的指针,若不需传递此结构,应该传递Null(C中的要求),VB则应该传递地址0,可你的声明,却会让VB传递了一个指向保存临时数值0的内存地址,而这个地址肯定不会是0,所以你的声明应该改成:
Byval lpOverlapped As Long
试了你两次的答案,竟然都成功了!
一次是编译成了p代码,成功了;一次是把api的参数变成Byval lpOverlapped As Long 也成功了!
谢谢你的回答!真的不知道说什么好了,巨牛啊~~可我还是有疑问,为什么编译成p代码就可以呢?可api的声明还是错的呢!vb的调试就是把程序编译成p代码;所以,只能说明一个问题:p代码传递的就是数值为0的地址为0的那个0地址!不知道我说的对么?还有,只要机器上有串口,这个就可以测试的,
○
○
○─A
○
○─B
○
○
○
○
这个是你pc后面com口,只需要把A、B短接,然后,你发什么就回什么了~~:)
这个问题确实是因为编译选项的原因,必须编译成p代码,具体原因,我也在雾中。我另外想准备其它几套有关API通讯的示例,到时我发出来,大家研究一下。
----------------------------------------呵呵,我认为你说得不对^_^
调用API是个较复杂的问题,有时没出错,并不代表就是正确的,这也是错误代码能在网上四处传播的一个重要原因。从你反映的情况来看,引发问题的主要原因,应该就是lpOverlapped As Long 了。Byval传0,API就会得到指到内存地址为0的指针(内存地址0在系统特定为空值),放弃读取Overlapped结构的数据,可正常执行,在没有Byval时,VB按参数内存地址传递,因为0是一个实实在在的数值,其在内存中保存的位置不可能是0,所以传址的结果,会让API把0及其内存位置后的若干字节当成Overlapped结构的数据,这就造成API将在内存访问一个未知区域,带来了很多不预见性的因素,但只是不可预知,并不一定会出错。VB在调试时,因有IDE大环境保护,VB出于调试的需要,申请得到的内存空间比独立运行要大很多,空闲也较多,API读写的未知内存片段,多数还是0,引发问题可能性并不大,但编译后(尤其是本机码编译),这种保护与空闲的环境没有了,出错就极频繁了。因此,虽然该代码是错误的,但在IDE下,该程序引起出错概率不高,本机码编译后则会变得很高。P代码是解释执行,其运行环境与IDE下运行有很多相似之处,我估计出错误可能也会较小吧。
这种问题,在API调用中应该引起很多人的注意,并不一定能正确得到结果的调用就没有问题,有时只是概率与巧合所至,只有认清本质,使用正确的代码,才能将出错概率降到最低。附:前面说的递归中按址传字符串参数WriteCOM32(COMString As String),也是一个不好习惯,其中问题很复杂,一时很难说清,本机码编译后引发出错的可能也较大。你测试数据可能还不足255字节,一时还不会遇到递归。