程序是从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

解决方案 »

  1.   

    首先把所有GetLastError都换成Err.LastDllError
    其次,你先多放几个msgbox,看看问题出在哪里
      

  2.   

    Mark!
    顶!
    希望枕善居主人来看看.呵.
      

  3.   

    从代码可见,这个程序不能处理中文。是不是你测试时没用中文?
    建议,调试时,将WriteCOM32中的On Error去掉,看出错在哪?
      

  4.   

    to homezj(小吉):
    on err都去了,没有报错,就是RetBytes=0
    测试时,发送的是英文指令,可不管是什么,调试状态都可以,编译出来就不行了。是系统的原因?
      

  5.   

    星星级别的来求救,真是少见,用readfile来做通讯的真是少见,帮不到你啦,帮你顶一下啦
      

  6.   

    可不可以让程序在执行过程中写日志文件,看看到底哪一步出的问题,看看CreateFile和writeFile的返回值,和ReadFile的返回值。
      

  7.   

    这样分析,像是API调用中出错,或编译中出现问题。
    可惜没法帮你调试,只能猜测分析你是用本机代码编译的吗?试试P代码行不行?Function WriteCOM32(COMString As String) As Integer
    改成
    Function WriteCOM32(Byval COMString As String) As Integer这个函数使用了按址传参的递归调用,在编译时选中“无别名”可能会带来问题。
      

  8.   

    一觉醒来,再看此贴,无意中又发现一个问题:
    ReadFile与WriteFile函数的API声明肯定错了,请注意:lpOverlapped参数,这个参数要求的是一个指向Overlapped结构的指针,若不需传递此结构,应该传递Null(C中的要求),VB则应该传递地址0,可你的声明,却会让VB传递了一个指向保存临时数值0的内存地址,而这个地址肯定不会是0,所以你的声明应该改成:
    Byval lpOverlapped As Long
      

  9.   

    to 小吉:
    试了你两次的答案,竟然都成功了!
    一次是编译成了p代码,成功了;一次是把api的参数变成Byval lpOverlapped As Long 也成功了!
    谢谢你的回答!真的不知道说什么好了,巨牛啊~~可我还是有疑问,为什么编译成p代码就可以呢?可api的声明还是错的呢!vb的调试就是把程序编译成p代码;所以,只能说明一个问题:p代码传递的就是数值为0的地址为0的那个0地址!不知道我说的对么?还有,只要机器上有串口,这个就可以测试的,
     ○

      ○─A

      ○─B

      ○

      ○
    这个是你pc后面com口,只需要把A、B短接,然后,你发什么就回什么了~~:)
      

  10.   

    来晚了,本来楼主可以自己在我网站上留言的,问题可能解决的早些,呵呵,CSDN我来得较少。
    这个问题确实是因为编译选项的原因,必须编译成p代码,具体原因,我也在雾中。我另外想准备其它几套有关API通讯的示例,到时我发出来,大家研究一下。
      

  11.   

    p代码传递的就是数值为0的地址为0的那个0地址!
    ----------------------------------------呵呵,我认为你说得不对^_^
    调用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字节,一时还不会遇到递归。
      

  12.   

    才看到mndsoft的留言,试试Byval lpOverlapped As Long 后,再编译成本机码。我感觉不是P代码的问题。