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 = '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    ''


  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 = '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    '' + ;
    ''


  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

猫猫的心里话

加菲猫的VFP|狐友会社群接收投稿啦

加菲猫的VFP，用VFP不局限VFP，用VFP混合一切。无论是VFP，还是JS，还是C，只要能混合起来，都可以发表。

商业模式，销售技巧、需求规划、产品设计的知识通通可以发表。

暂定千字50元红包，，优秀的文章红包更大，一经发表，红包到手。

如何帮助使用VFP的人？

用VFP的人，有专业的，有非专业了，很多人其实是小白，问出的问题是小白，如果问题不对，我们引导他们问正确的问题。无论如何请不要嘲笑他们说帮助都不看，这么简单的问题都不会，嘲笑别人不行，而无法提出建设性答案，是很low的。

我们无论工作需要，还是有自己的软件，都是是需要真正的知识，如何让更多人学习真正的VFP知识呢，只需要点赞，在看，能转发朋友圈就更好了。

加菲猫的vfp倡导用"VFP极简混合开发，少写代码、快速出活，用VFP，但不局限于VFP，各种语言混合开发"。

我已经带领一百多名会员成功掌到VFP的黑科技，进入了移动互联网时代，接下来我们要进入物联网领域。

2023年狐友会社群会员继续招募中

社群会员获取的权益有：

祺佑三层开发框架商业版（猫框），终身免费升级，终身技术支持。

开放的录播课程有：

微信小程序，微信公众号开发，H5 APP开发，Extjs BS开发，VFP面向对象进阶，VFP中间层开发。

源码类资源有：

支付组件源码，短信源码，权限组件源码，一些完整系统的源码。这个可以单独出售的，需要的可以联系我。

会员也可以实现群内资源对接，可以接分包，合作等各项商业或技术业务