VFP多线程读取串口

加菲猫的VFP

发布于 2023-08-21 18:08:50

3050

发布于 2023-08-21 18:08:50

文章被收录于专栏：加菲猫的VFP

VFP读取串口的方式有四种

一、利用MSCOMM Actvie控件

二、使用MYFLL的读取控件的函数。

三、使用WIN32API来读取（只完成一半）

四、VFP低级文件函数读取。

因为我要发送的指令很多，所以当时用方案二同步去读取，结果很卡。方法一倒没有试过，但COM口只支持16个。

后面想着用多线程的方法来做，果真是不卡了，但是遇到了问题，运行一段时间就自动退出，内存也快速增长。

处理完内存增长，还是会自动退了。

于是换了一个VFPC32多线程的读取方案，经过两个晚上的修改，测试。终于不卡，不退出的。

但是却退到了串口占用不退出的问题，经我反复测试判定是MYFLL的原因导致端口无法释放。于是采用了低级文件函数来处理，果真完美稳定。WIN32 API的方案我还只写到一半。

DO decl
clear
*!*  LOCAL nIndex, cPort
*!*  FOR nIndex=1 TO 8
*!*    cPort = "COM" + TRANSFORM(nIndex)
*!*    ? "Testing port " + m.cPort + ":", TestPort(m.cPort)
*!*  ENDFOR
* end of main
?"Testing port " + ":", TestPort("com2")
SET LIBRARY TO VFP2C32.FLL

FUNCTION TestPort(cPort)
#DEFINE FILE_SHARE_READ   1
#DEFINE FILE_SHARE_WRITE  2
#DEFINE OPEN_EXISTING     3
#DEFINE GENERIC_READ      0x80000000
#DEFINE GENERIC_WRITE     0x40000000
#DEFINE FILE_FLAG_OVERLAPPED 0x40000000
#DEFINE INVALID_HANDLE_VALUE -1
#DEFINE FILE_ATTRIBUTE_NORMAL 128

  LOCAL hPort, lnErr

*  hPort = CreateFile(cPort, GENERIC_READ, 0,0,;
    OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0)

  hPort = CreateFile(cPort,;
    BITOR(GENERIC_READ,GENERIC_WRITE),;
    0,0, OPEN_EXISTING,;
    BITOR(FILE_FLAG_OVERLAPPED,FILE_ATTRIBUTE_NORMAL), 0)

  IF hPort = INVALID_HANDLE_VALUE
    lnErr = GetLastError()
    RETURN "Error " + TRANSFORM(lnErr) +;
      ". " + GetErrorMessage(lnErr)
  ELSE
    *SetupComm(hPort,1024,512 )  &&设置端口

    TRY
    dcb=SPACE(80)  
    odcb=CREATEOBJECT("dcb")
    ?"第一次"  
    GetCommState2(hPort,@dcb)   &&得到端口设置
    ?ALLTRIM(dcb),LEN(dcb)
    xxx=odcb.Address
    GetCommState(hPort,@xxx)   &&得到端口设置
    ?"第二次"
    ?odcb.StopBits 
    *?dcb
    *odcb=CREATEOBJECT("dcb",@dcb)
    *?odcb.DCBlength           
    SetCommState(hPort,odcb.Address)  &&设置端口设置
    *Wol=1
    *xxx=0h+"123567"
    WriteFile(hPort ,1,6,1,@Wol )   &&写入数据
    *?Wol,"fff"
    *Sleep(3000)   &&等待    
*        memset(myByte,0,sizeof(myByte))
       && ClearCommError(hCom,&dwErrors, &Rcs )   &&请除COM错误
 *       bResult = ReadFile(hCom,&myByte,9,NULL,&Rol,0) 
    = CloseHandle(hPort)
    CATCH TO ex
        = CloseHandle(hPort)
        ?ex.message,ex.lineno
    endtry
    RETURN "1Ok"
  ENDIF

PROCEDURE decl
  DECLARE INTEGER CreateFile IN kernel32;
    STRING lpFileName, INTEGER dwAccess, INTEGER dwShareMode,;
    INTEGER lpSecurityAttr, INTEGER dwCreationDisp,;
    INTEGER dwFlagsAndAttr, INTEGER hTemplateFile
    
    DECLARE INTEGER WriteFile IN kernel32;
      INTEGER   hFile,;
      string   lpBuffer,;
      INTEGER   nBt2Write,;
      INTEGER @ lpBtWritten,;
      INTEGER   lpOverlapped  
      
    DECLARE INTEGER ReadFile IN kernel32;
      INTEGER   hFile,;
      STRING  @ lpBuffer,;
      INTEGER   nNumberOfBytesToRead,;
      INTEGER @ lpNumberOfBytesRead,;
      INTEGER   lpOverlapped  
      
    DECLARE INTEGER GetCommState IN kernel32; 
       INTEGER hFile,INTEGER @ 

    DECLARE INTEGER GetCommState IN kernel32 as GetCommState2; 
       INTEGER hFile,string @

    DECLARE INTEGER SetCommState IN kernel32; 
       INTEGER hFile,INTEGER @

    DECLARE INTEGER PurgeComm IN kernel32; 
        INTEGER hFile,;  &&串口句柄
        string dwFlags  && 需要完成的操作 DWORD 
    
*!*  PURGE_TXABORT    中断所有写操作并立即返回，即使写操作还没有完成。
*!*  PURGE_RXABORT    中断所有读操作并立即返回，即使读操作还没有完成。
*!*  PURGE_TXCLEAR    清除输出缓冲区
*!*  PURGE_RXCLEAR    清除输入缓冲区

  DECLARE INTEGER CloseHandle IN kernel32 INTEGER hObject
  DECLARE INTEGER GetLastError IN kernel32

  DECLARE INTEGER FormatMessage IN kernel32;
    INTEGER dwFlags, INTEGER lpSource, INTEGER dwMessageId,;
    INTEGER dwLanguageId, INTEGER @lpBuffer,;
    INTEGER nSize, INTEGER Arguments

  DECLARE RtlMoveMemory IN kernel32 As CopyMemory;
    STRING @Destination, INTEGER Source, INTEGER nLength
    
    
    

FUNCTION GetErrorMessage(lnErr)
#DEFINE FORMAT_MESSAGE_ALLOCATE_BUFFER 256
#DEFINE FORMAT_MESSAGE_FROM_SYSTEM     4096
#DEFINE FORMAT_MESSAGE_IGNORE_INSERTS  512

  LOCAL dwFlags, lpBuffer, lnLength, lpResult
  dwFlags = FORMAT_MESSAGE_ALLOCATE_BUFFER +;
    FORMAT_MESSAGE_FROM_SYSTEM + FORMAT_MESSAGE_IGNORE_INSERTS

  lpBuffer = 0
  lnLength = FormatMessage(dwFlags, 0, lnErr, 0, @lpBuffer, 0,0)
  IF lnLength <> 0
    lpResult = REPLI(Chr(0), 500)
    = CopyMemory (@lpResult, lpBuffer, lnLength)
    RETURN STRTRAN(LEFT(lpResult, lnLength), Chr(13)+Chr(10), "")
  ELSE
    RETURN "[]"
  ENDIF  
  
  
  
DEFINE CLASS DCB AS Relation

  Address = 0
  SizeOf = 80
  Name = "DCB"
  && structure fields
  _MemberData = '<VFPData>' + ;
    '<memberdata name="dcblength" type="property" display="DCBlength"/>' + ;
    '<memberdata name="baudrate" type="property" display="BaudRate"/>' + ;
    '<memberdata name="fbinary" type="property" display="fBinary"/>' + ;
    '<memberdata name="fparity" type="property" display="fParity"/>' + ;
    '<memberdata name="foutxctsflow" type="property" display="fOutxCtsFlow"/>' + ;
    '<memberdata name="foutxdsrflow" type="property" display="fOutxDsrFlow"/>' + ;
    '<memberdata name="fdtrcontrol" type="property" display="fDtrControl"/>' + ;
    '<memberdata name="fdsrsensitivity" type="property" display="fDsrSensitivity"/>' + ;
    '<memberdata name="ftxcontinueonxoff" type="property" display="fTXContinueOnXoff"/>' + ;
    '<memberdata name="foutx" type="property" display="fOutX"/>' + ;
    '<memberdata name="finx" type="property" display="fInX"/>' + ;
    '<memberdata name="ferrorchar" type="property" display="fErrorChar"/>' + ;
    '<memberdata name="fnull" type="property" display="fNull"/>' + ;
    '<memberdata name="frtscontrol" type="property" display="fRtsControl"/>' + ;
    '<memberdata name="fabortonerror" type="property" display="fAbortOnError"/>' + ;
    '<memberdata name="fdummy2" type="property" display="fDummy2"/>' + ;
    '<memberdata name="wreserved" type="property" display="wReserved"/>' + ;
    '<memberdata name="xonlim" type="property" display="XonLim"/>' + ;
    '<memberdata name="xofflim" type="property" display="XoffLim"/>' + ;
    '<memberdata name="bytesize" type="property" display="ByteSize"/>' + ;
    '<memberdata name="parity" type="property" display="Parity"/>' + ;
    '<memberdata name="stopbits" type="property" display="StopBits"/>' + ;
    '<memberdata name="xonchar" type="property" display="XonChar"/>' + ;
    '<memberdata name="xoffchar" type="property" display="XoffChar"/>' + ;
    '<memberdata name="errorchar" type="property" display="ErrorChar"/>' + ;
    '<memberdata name="eofchar" type="property" display="EofChar"/>' + ;
    '<memberdata name="evtchar" type="property" display="EvtChar"/>' + ;
    '<memberdata name="wreserved1" type="property" display="wReserved1"/>' + ;
    '</VFPData>'

  DCBlength = .F.
  BaudRate = .F.
  fBinary = .F.
  fParity = .F.
  fOutxCtsFlow = .F.
  fOutxDsrFlow = .F.
  fDtrControl = .F.
  fDsrSensitivity = .F.
  fTXContinueOnXoff = .F.
  fOutX = .F.
  fInX = .F.
  fErrorChar = .F.
  fNull = .F.
  fRtsControl = .F.
  fAbortOnError = .F.
  fDummy2 = .F.
  wReserved = .F.
  XonLim = .F.
  XoffLim = .F.
  ByteSize = .F.
  Parity = .F.
  StopBits = .F.
  XonChar = .F.
  XoffChar = .F.
  ErrorChar = .F.
  EofChar = .F.
  EvtChar = .F.
  wReserved1 = .F.

  PROCEDURE Init(lnAddress)
    THIS.Address = m.lnAddress
  ENDPROC

  PROCEDURE DCBlength_Access()
    RETURN ReadUInt(THIS.Address)
  ENDPROC

  PROCEDURE DCBlength_Assign(lnNewVal)
    WriteUInt(THIS.Address, m.lnNewVal)
  ENDPROC

  PROCEDURE BaudRate_Access()
    RETURN ReadUInt(THIS.Address + 4)
  ENDPROC

  PROCEDURE BaudRate_Assign(lnNewVal)
    WriteUInt(THIS.Address + 4, m.lnNewVal)
  ENDPROC

  PROCEDURE fBinary_Access()
    RETURN ReadUInt(THIS.Address + 8)
  ENDPROC

  PROCEDURE fBinary_Assign(lnNewVal)
    WriteUInt(THIS.Address + 8, m.lnNewVal)
  ENDPROC

  PROCEDURE fParity_Access()
    RETURN ReadUInt(THIS.Address + 12)
  ENDPROC

  PROCEDURE fParity_Assign(lnNewVal)
    WriteUInt(THIS.Address + 12, m.lnNewVal)
  ENDPROC

  PROCEDURE fOutxCtsFlow_Access()
    RETURN ReadUInt(THIS.Address + 16)
  ENDPROC

  PROCEDURE fOutxCtsFlow_Assign(lnNewVal)
    WriteUInt(THIS.Address + 16, m.lnNewVal)
  ENDPROC

  PROCEDURE fOutxDsrFlow_Access()
    RETURN ReadUInt(THIS.Address + 20)
  ENDPROC

  PROCEDURE fOutxDsrFlow_Assign(lnNewVal)
    WriteUInt(THIS.Address + 20, m.lnNewVal)
  ENDPROC

  PROCEDURE fDtrControl_Access()
    RETURN ReadUInt(THIS.Address + 24)
  ENDPROC

  PROCEDURE fDtrControl_Assign(lnNewVal)
    WriteUInt(THIS.Address + 24, m.lnNewVal)
  ENDPROC

  PROCEDURE fDsrSensitivity_Access()
    RETURN ReadUInt(THIS.Address + 28)
  ENDPROC

  PROCEDURE fDsrSensitivity_Assign(lnNewVal)
    WriteUInt(THIS.Address + 28, m.lnNewVal)
  ENDPROC

  PROCEDURE fTXContinueOnXoff_Access()
    RETURN ReadUInt(THIS.Address + 32)
  ENDPROC

  PROCEDURE fTXContinueOnXoff_Assign(lnNewVal)
    WriteUInt(THIS.Address + 32, m.lnNewVal)
  ENDPROC

  PROCEDURE fOutX_Access()
    RETURN ReadUInt(THIS.Address + 36)
  ENDPROC

  PROCEDURE fOutX_Assign(lnNewVal)
    WriteUInt(THIS.Address + 36, m.lnNewVal)
  ENDPROC

  PROCEDURE fInX_Access()
    RETURN ReadUInt(THIS.Address + 40)
  ENDPROC

  PROCEDURE fInX_Assign(lnNewVal)
    WriteUInt(THIS.Address + 40, m.lnNewVal)
  ENDPROC

  PROCEDURE fErrorChar_Access()
    RETURN ReadUInt(THIS.Address + 44)
  ENDPROC

  PROCEDURE fErrorChar_Assign(lnNewVal)
    WriteUInt(THIS.Address + 44, m.lnNewVal)
  ENDPROC

  PROCEDURE fNull_Access()
    RETURN ReadUInt(THIS.Address + 48)
  ENDPROC

  PROCEDURE fNull_Assign(lnNewVal)
    WriteUInt(THIS.Address + 48, m.lnNewVal)
  ENDPROC

  PROCEDURE fRtsControl_Access()
    RETURN ReadUInt(THIS.Address + 52)
  ENDPROC

  PROCEDURE fRtsControl_Assign(lnNewVal)
    WriteUInt(THIS.Address + 52, m.lnNewVal)
  ENDPROC

  PROCEDURE fAbortOnError_Access()
    RETURN ReadUInt(THIS.Address + 56)
  ENDPROC

  PROCEDURE fAbortOnError_Assign(lnNewVal)
    WriteUInt(THIS.Address + 56, m.lnNewVal)
  ENDPROC

  PROCEDURE fDummy2_Access()
    RETURN ReadUInt(THIS.Address + 60)
  ENDPROC

  PROCEDURE fDummy2_Assign(lnNewVal)
    WriteUInt(THIS.Address + 60, m.lnNewVal)
  ENDPROC

  PROCEDURE wReserved_Access()
    RETURN ReadUShort(THIS.Address + 64)
  ENDPROC

  PROCEDURE wReserved_Assign(lnNewVal)
    WriteUShort(THIS.Address + 64, m.lnNewVal)
  ENDPROC

  PROCEDURE XonLim_Access()
    RETURN ReadUShort(THIS.Address + 66)
  ENDPROC

  PROCEDURE XonLim_Assign(lnNewVal)
    WriteUShort(THIS.Address + 66, m.lnNewVal)
  ENDPROC

  PROCEDURE XoffLim_Access()
    RETURN ReadUShort(THIS.Address + 68)
  ENDPROC

  PROCEDURE XoffLim_Assign(lnNewVal)
    WriteUShort(THIS.Address + 68, m.lnNewVal)
  ENDPROC

  PROCEDURE ByteSize_Access()
    RETURN ReadChar(THIS.Address + 70)
  ENDPROC

  PROCEDURE ByteSize_Assign(lnNewVal)
    WriteChar(THIS.Address + 70, m.lnNewVal)
  ENDPROC

  PROCEDURE Parity_Access()
    RETURN ReadChar(THIS.Address + 71)
  ENDPROC

  PROCEDURE Parity_Assign(lnNewVal)
    WriteChar(THIS.Address + 71, m.lnNewVal)
  ENDPROC

  PROCEDURE StopBits_Access()
    RETURN ReadChar(THIS.Address + 72)
  ENDPROC

  PROCEDURE StopBits_Assign(lnNewVal)
    WriteChar(THIS.Address + 72, m.lnNewVal)
  ENDPROC

  PROCEDURE XonChar_Access()
    RETURN ReadChar(THIS.Address + 73)
  ENDPROC

  PROCEDURE XonChar_Assign(lnNewVal)
    WriteChar(THIS.Address + 73, m.lnNewVal)
  ENDPROC

  PROCEDURE XoffChar_Access()
    RETURN ReadChar(THIS.Address + 74)
  ENDPROC

  PROCEDURE XoffChar_Assign(lnNewVal)
    WriteChar(THIS.Address + 74, m.lnNewVal)
  ENDPROC

  PROCEDURE ErrorChar_Access()
    RETURN ReadChar(THIS.Address + 75)
  ENDPROC

  PROCEDURE ErrorChar_Assign(lnNewVal)
    WriteChar(THIS.Address + 75, m.lnNewVal)
  ENDPROC

  PROCEDURE EofChar_Access()
    RETURN ReadChar(THIS.Address + 76)
  ENDPROC

  PROCEDURE EofChar_Assign(lnNewVal)
    WriteChar(THIS.Address + 76, m.lnNewVal)
  ENDPROC

  PROCEDURE EvtChar_Access()
    RETURN ReadChar(THIS.Address + 77)
  ENDPROC

  PROCEDURE EvtChar_Assign(lnNewVal)
    WriteChar(THIS.Address + 77, m.lnNewVal)
  ENDPROC

  PROCEDURE wReserved1_Access()
    RETURN ReadUShort(THIS.Address + 78)
  ENDPROC

  PROCEDURE wReserved1_Assign(lnNewVal)
    WriteUShort(THIS.Address + 78, m.lnNewVal)
  ENDPROC

ENDDEFINE



DEFINE CLASS COMMTIMEOUTS AS Relation

  Address = 0
  SizeOf = 20
  Name = "COMMTIMEOUTS"
  && structure fields
  _MemberData = '<VFPData>' + ;
    '<memberdata name="readintervaltimeout" type="property" display="ReadIntervalTimeout"/>' + ;
    '<memberdata name="readtotaltimeoutmultiplier" type="property" display="ReadTotalTimeoutMultiplier"/>' + ;
    '<memberdata name="readtotaltimeoutconstant" type="property" display="ReadTotalTimeoutConstant"/>' + ;
    '<memberdata name="writetotaltimeoutmultiplier" type="property" display="WriteTotalTimeoutMultiplier"/>' + ;
    '<memberdata name="writetotaltimeoutconstant" type="property" display="WriteTotalTimeoutConstant"/>' + ;
    '</VFPData>'

  ReadIntervalTimeout = .F.
  ReadTotalTimeoutMultiplier = .F.
  ReadTotalTimeoutConstant = .F.
  WriteTotalTimeoutMultiplier = .F.
  WriteTotalTimeoutConstant = .F.

  PROCEDURE Init(lnAddress)
    THIS.Address = m.lnAddress
  ENDPROC

  PROCEDURE ReadIntervalTimeout_Access()
    RETURN ReadUInt(THIS.Address)
  ENDPROC

  PROCEDURE ReadIntervalTimeout_Assign(lnNewVal)
    WriteUInt(THIS.Address, m.lnNewVal)
  ENDPROC

  PROCEDURE ReadTotalTimeoutMultiplier_Access()
    RETURN ReadUInt(THIS.Address + 4)
  ENDPROC

  PROCEDURE ReadTotalTimeoutMultiplier_Assign(lnNewVal)
    WriteUInt(THIS.Address + 4, m.lnNewVal)
  ENDPROC

  PROCEDURE ReadTotalTimeoutConstant_Access()
    RETURN ReadUInt(THIS.Address + 8)
  ENDPROC

  PROCEDURE ReadTotalTimeoutConstant_Assign(lnNewVal)
    WriteUInt(THIS.Address + 8, m.lnNewVal)
  ENDPROC

  PROCEDURE WriteTotalTimeoutMultiplier_Access()
    RETURN ReadUInt(THIS.Address + 12)
  ENDPROC

  PROCEDURE WriteTotalTimeoutMultiplier_Assign(lnNewVal)
    WriteUInt(THIS.Address + 12, m.lnNewVal)
  ENDPROC

  PROCEDURE WriteTotalTimeoutConstant_Access()
    RETURN ReadUInt(THIS.Address + 16)
  ENDPROC

  PROCEDURE WriteTotalTimeoutConstant_Assign(lnNewVal)
    WriteUInt(THIS.Address + 16, m.lnNewVal)
  ENDPROC

ENDDEFINE

本文参与腾讯云自媒体同步曝光计划，分享自微信公众号。

原始发表：2023-08-19，如有侵权请联系 cloudcommunity@tencent.com 删除

integer