增强版的foxsocket来了
											上次网友@easyppt 问:“能和网页客户端 通讯吗,这样,买家 网页发起客服,卖家VFP受理”今天给你答案,可以!
为了完成网页版和客户端通讯,我去网上搜索了一大堆资料,看得头晕目眩,发现我的foxsocket类无法在网页版运行,只能用web编程中常用的websocket。。。
也就是说vfp服务端用foxsocket,客户端用网页,为了能给接收websocket的讯息,得了解它的通讯规范,foxsocket必须要做适应性改进。。。
经过2天的不断尝试,终于成功,现在分享给大家~~~
有一个遗憾,没考虑中文解码的问题,网页版向服务端发中文的时候会乱码,只有下次改进了。。。
10/25 解决不能接收中文的问题!
vfp服务端截图:
网页端截图
主要的类foxsocket代码如下:
 程序代码:
程序代码:
**************************************************
*-- 类:           foxsocket (d:\documents\visual foxpro 项目\foxweb.vcx)
*-- 父类:  custom
*-- 基类:    custom
*-- 时间戳:   10/18/25 01:56:02 PM
*
DEFINE CLASS foxsocket AS custom
    Height = 15
    Width = 68
    *-- 版本号
    ver = ""
    *-- 描述
    description = ""
    *-- 负责监听的套接字
    listensocket = 0
    *-- 当前套接字句柄
    sockethandle = 0
    *-- 收到的字节数
    bytesreceived = 0
    *-- 远程主机
    remotehost = ""
    *-- 远程ip地址
    remoteip = ""
    *-- 远程端口
    remoteport = 0
    *-- 本地主机名
    localhost = ""
    *-- 本地ip地址
    localip = ""
    *-- 本机端口
    localport = 0
    *-- 套接字连接协议。1表示TCP,2表示UDP,其他待开发
    protocol = 1
    *-- 当前连接状态
    state = 0
    Name = "foxsocket"
    *-- 连接远方主机方法及连接事件
    PROCEDURE connect
        LPARAMETERS remotehost,remoteport
        *!*    connect带参数时为方法,不带参数时为事件
        *********************************************
        *子类connect事件中调用父类的方法:
        *if PCOUNT()=0 &&定义没有参数时的行为
        *    input your code here
        *ELSE
        *    DODEFAULT(remotehost,remoteport) &&不能漏掉参数
        *ENDIF  
        *********************************************
        IF PCOUNT()=2 &&带参数则发出连接请求
            LOCAL n,stsockaddr
            WSAAsyncSelect(this.Sockethandle,thisform.hwnd,1124,51)    && FD_CONNECT or FD_READ or FD_CLOSE or FD_WRITE
            stSockAddr = BINTOC(2, "2RS");                   && sin_family = AF_INET
                       + BINTOC(htons(remotePort), "2RS");        && sin_port
                       + BINTOC(inet_addr(remotehost), "4RS");    && sin_addr
                       + REPLICATE(0h00, 8)
            n=connect(this.Sockethandle, @stSockAddr, LEN(stSockAddr))    && SOCKET_ERROR
            IF n#-1
                this.state=6
            ENDIF 
            RETURN n#-1
        ENDIF
    ENDPROC
    *-- winapi函数申明
    PROTECTED PROCEDURE declare
        * Socket初始化相关
        DECLARE INTEGER WSAGetLastError IN ws2_32
        DECLARE INTEGER WSAStartup         IN ws2_32 INTEGER wVersionRequested, STRING @lpWSAData
        DECLARE INTEGER WSACleanup         IN ws2_32
        * 基础Socket函数
        DECLARE INTEGER socket         IN ws2_32 INTEGER af, INTEGER type, INTEGER protocol
        DECLARE INTEGER closesocket IN ws2_32 INTEGER s
        DECLARE INTEGER bind         IN ws2_32 as _bind INTEGER s, STRING @name, INTEGER namelen
        DECLARE INTEGER listen         IN ws2_32 INTEGER s, INTEGER backlog
        DECLARE INTEGER accept         IN ws2_32 INTEGER s, STRING @addr, INTEGER @addrlen
        DECLARE INTEGER connect     IN ws2_32 INTEGER s, STRING @name, INTEGER namelen
        * 数据传输函数
        DECLARE INTEGER send         IN ws2_32 INTEGER s, STRING @buf, INTEGER len, INTEGER flags
        DECLARE INTEGER recv         IN ws2_32 INTEGER s, STRING @buf, INTEGER len, INTEGER flags
        DECLARE INTEGER sendto         IN ws2_32 INTEGER s, STRING @buf, INTEGER len, INTEGER flags, STRING @to, INTEGER tolen
        DECLARE INTEGER recvfrom     IN ws2_32 INTEGER s, STRING @buf, INTEGER len, INTEGER flags, STRING @from, INTEGER @fromlen
        * 地址转换函数
        DECLARE INTEGER inet_addr     IN ws2_32 STRING cp
        DECLARE STRING inet_ntoa     IN ws2_32 INTEGER in
        * 主机信息函数
        DECLARE INTEGER gethostname     IN ws2_32 STRING @name, INTEGER namelen
        DECLARE INTEGER gethostbyname     IN ws2_32 STRING name
        DECLARE INTEGER gethostbyaddr     IN ws2_32 STRING @addr, INTEGER len, INTEGER type
        * Socket选项控制
        DECLARE INTEGER getsockopt IN ws2_32 INTEGER s, INTEGER level, INTEGER optname, STRING @optval, INTEGER @optlen
        DECLARE INTEGER setsockopt IN ws2_32 INTEGER s, INTEGER level, INTEGER optname, STRING @optval, INTEGER optlen
        * IO控制函数
        DECLARE INTEGER ioctlsocket IN ws2_32 INTEGER s, INTEGER cmd, INTEGER @argp
        * 异步Socket函数
        DECLARE INTEGER WSAAsyncSelect IN ws2_32 INTEGER s, INTEGER hWnd, INTEGER wMsg, INTEGER lEvent
        * 其他实用函数
        DECLARE SHORT htons IN ws2_32 SHORT hostshort
        DECLARE SHORT ntohs IN ws2_32 SHORT netshort
        DECLARE INTEGER htonl IN ws2_32 INTEGER hostlong
        DECLARE INTEGER ntohl IN ws2_32 INTEGER netlong
        DECLARE INTEGER RtlMoveMemory IN kernel32 AS CopyMemory STRING @Dest, INTEGER Src, INTEGER nLength
        * 使用Windows CryptoAPI计算SHA1    
        DECLARE INTEGER CryptAcquireContext IN advapi32 ;        
                INTEGER @hProv, STRING cContainer, STRING cProvider, ;        
                INTEGER dwProvType, INTEGER dwFlags        
        DECLARE INTEGER CryptCreateHash IN advapi32 ;        
                INTEGER hProv, INTEGER Algid, INTEGER hKey, ;        
                INTEGER dwFlags, INTEGER @hHash        
        DECLARE INTEGER CryptHashData IN advapi32 ;        
                INTEGER hHash, STRING @pbData, INTEGER dwDataLen, ;        
                INTEGER dwFlags        
        DECLARE INTEGER CryptGetHashParam IN advapi32 ;        
                INTEGER hHash, INTEGER dwParam, STRING @pbData, ;        
                INTEGER @pdwDataLen, INTEGER dwFlags        
        DECLARE INTEGER CryptDestroyHash IN advapi32 INTEGER hHash    
        DECLARE INTEGER CryptReleaseContext IN advapi32 INTEGER hProv, INTEGER dwFlags    
        DECLARE INTEGER CryptBinaryToString IN crypt32 ;       
                STRING pbBinary, INTEGER cbBinary, INTEGER dwFlags, ;        
                STRING @pszString, INTEGER @pcchString
    ENDPROC
    *-- 关闭套接字方法及事件
    PROCEDURE close
        LPARAMETERS hsocket
        *!*    close带参数时为方法,不带参数时为事件
        IF PCOUNT()=1
            closesocket(hSocket)
            this.sockethandle=0
            this.state=0
        ENDIF
    ENDPROC
    *-- 当远方客户端企图连接时发生
    PROCEDURE connectionrequest
        LPARAMETERS requestid
        *!* 收到连接请求时自动产生requestid,同意请求则调用accept()并传递requestid
        *!* 若要拒绝连接,只需传递参数0给accept()方法
        this.accept(requestid)
    ENDPROC
    *-- 当收到远方电脑发送的数据时发生
    PROCEDURE dataarrival
        LPARAMETERS bytestotal
        *!*    dataarrival带参数时为方法,不带参数时为事件
        *!*    可以在这个方法中调用getdata()方法来获取数据
    ENDPROC
    *-- 发送数据期间发生
    PROCEDURE sendprocess
        LPARAMETERS bytessent,bytesremaining
    ENDPROC
    *-- 接收一个连接请求
    PROCEDURE accept
        LPARAMETERS requestid
        #DEFINE NACCEPT 6
        #DEFINE NTIMEOUT -1
        *!* 在connectionrequest中调用本方法,根据条件判断是否接受连接请求
        LOCAL stSockAddr, nSize, nIP, szIP, nPort,n
        *!*    n=(DATE()-{^1970-01-01})*24*3600*1000+INT(SECONDS()*1000)-8*3600*1000 &&唯一时间戳
        *****winsock没有拒绝连接的函数,我们采用先接受再关闭以达到关闭效果*****
        stSockAddr = REPLICATE(0h00, 16)
        nSize      = LEN(stSockAddr)
        this.sockethandle =accept(this.sockethandle, @stSockAddr, @nSize) &&新套接字用于通讯
        WSAAsyncSelect(this.sockethandle, thisform.hwnd, 1124, 33)  && FD_READ + FD_CLOSE=33 0x400+100=1124
        *WSAAsyncSelect(this.sockethandle, thisform.hwnd, 1124, 59)  && FD_READ + FD_CLOSE=33 0x400+100=1124
        *****也可以采用不响应connectionrequest请求的方式来拒绝连接,即请求端超时,但会造成客户端堵塞,不建议
        nIP   = CTOBIN(SUBSTR(stSockAddr, 5, 4), '4RS')
        *!*    SET MESSAGE TO TRANSFORM(nip)
        *szIP  = SYS(2600, inet_ntoa(nIP), 16)
        szip = inet_ntoa(nIP)
        szIP  = LEFT(szIP, AT(0h00, szIP)-1)
        nPort = ntohs(CTOBIN(SUBSTR(stSockAddr, 3, 2), '2RS'))
        this.remoteip=szip
        this.remoteport=nport
        this.state=7
        nAvail = 0
        ioctlsocket(this.sockethandle, 0x4004667F, @nAvail)
        this.bytesreceived=navail
        lcbuffer=REPLICATE(CHR(0),navail)
        this.getData(@lcbuffer,navail)
        ****************************************************
        *!*    ACTIVATE SCREEN && 激活屏幕,查看缓冲内容,调试用
        *!*    CLEAR
        *!*    ?this.getdata(@lcbuffer)
        *!*    ?lcbuffer
        ****************************************************
        IF this.bytesreceived>0
            * 检查是否为WebSocket升级请求        
            IF "Upgrade: websocket" $ lcbuffer AND "Connection: Upgrade" $ lcbuffer            
                * 提取Sec-WebSocket-Key            
                nPos = AT("Sec-WebSocket-Key:", lcbuffer)            
                IF nPos > 0                
                    cKey = SUBSTR(lcbuffer, nPos + 18)                
                    cKey = ALLTRIM(LEFT(cKey, AT(CHR(13), cKey)-1))                                
                    * 计算响应密钥                
                    cResponseKey = this.ws_accept_key(cKey)                                
                    * 发送HTTP 101响应                
                    cResponse = "HTTP/1.1 101 Switching Protocols" + CHR(13) + CHR(10) + ;                            
                    "Upgrade: websocket" + CHR(13) + CHR(10) + ;                            
                    "Connection: Upgrade" + CHR(13) + CHR(10) + ;                            
                    "Sec-WebSocket-Accept: " + cResponseKey + CHR(13) + CHR(10) + ;                            
                    CHR(13) + CHR(10)                                
                    nSent = send(this.sockethandle, @cResponse, LEN(cResponse), 0)                                
                    IF nSent > 0                    
                        *MESSAGEBOX("WebSocket连接已建立")                    
                        SET MESSAGE TO "WebSocket连接已建立..."
                        thisform.Edit1.value=thisform.edit1.value+"WebSocket发送连接报文如下..."+CHR(13)
                        thisform.Edit1.value=thisform.edit1.value+lcbuffer+CHR(13)
                        * 这里可以添加WebSocket消息处理逻辑 
                        thisform.Edit1.value=thisform.edit1.value+"WebSocket连接已建立..."+CHR(13)               
                    ENDIF            
                ENDIF        
            ELSE            
                * 不是WebSocket请求,返回普通HTTP响应            
                cResponse = "HTTP/1.1 200 OK" + CHR(13) + CHR(10) + ;                        
                "Content-Type: text/html" + CHR(13) + CHR(10) + ;                        
                "Connection: close" + CHR(13) + CHR(10) + ;                        
                CHR(13) + CHR(10) + ;                        
                "<html><body><h1>This is a WebSocket server</h1></body></html>"                        
                nSent = send(this.sockethandle, @cResponse, LEN(cResponse), 0)        
            ENDIF    
        ENDIF
    ENDPROC
    *-- 绑定套接字到指定的IP地址和端口
    PROCEDURE bind
        LPARAMETERS localip,localport
        LOCAL n,stsockaddr
        stSockAddr = BINTOC(2, '2RS');                   && sin_family ipv4
                   + BINTOC(htons(localPort), '2RS');        && sin_port
                   + BINTOC(inet_addr(@localip), '4RS');    && sin_addr
                   + REPLICATE(0h00, 8)
        n=_bind(this.Sockethandle, @stSockAddr, LEN(stSockAddr)) 
        RETURN n#-1
    ENDPROC
    *-- 检索来自远方计算机的数据
    PROCEDURE getdata
        LPARAMETERS cdata,nbytes &&cdata为输出型参数
        IF PCOUNT()=1
            nbytes=this.bytesreceived
        ENDIF
            n=recv(this.Sockethandle, @cdata, nbytes, 0)
        RETURN n 
    ENDPROC
    *-- 监听远方计算机的连接请求
    PROCEDURE listen
        #define        WM_SOCKET        0x400 + 100
        #define        FD_ACCEPT        8
        listen(this.Sockethandle, 5)
        WSAAsyncSelect(this.sockethandle, thisform.hWnd, WM_SOCKET, FD_ACCEPT) &&FD_ACCEPT=8
        this.state=2
        this.listensocket=this.sockethandle
    ENDPROC
    *-- 查看接收到的数据但不清空缓存
    PROCEDURE peekdata
        LPARAMETERS cdata,nbytes &&cdata为输出型参数
        *!*    本方法等同于getdata方法,但是不清除缓存。
        IF PCOUNT()=1
            nbytes=this.bytesreceived
        ENDIF
        RETURN  recv(this.Sockethandle, @cdata, nbytes, 2) &&MSG_PEEK    2
    ENDPROC
    *-- 向远方计算机发送数据
    PROCEDURE senddata
        LPARAMETERS cdata
        LOCAL n
            n=send(this.Sockethandle, @cdata, LEN(cdata), 0)
        RETURN n#-1
    ENDPROC
    *-- 处理自定义socket消息
    PROCEDURE msghandler
         LPARAMETERS hWnd, Msg, wParam, lParam
                IF this.sockethandle#wparam
                    this.sockethandle=wparam
                ENDIF 
                DO CASE
                    CASE lParam == 0x0008                && FD_ACCEPT      接收将要连接的通知
                        SET MESSAGE TO "远方电脑连接请求。。。"
                        requestid=(DATE()-{^1970-01-01})*24*3600*1000+INT(SECONDS()*1000)-8*3600*1000
                        this.connectionrequest(requestid) &&决定是否接受连接请求
                    
                    CASE lParam == 0x0001                && FD_READ        接收读准备好的通知   
                        nAvail = 0
                        ioctlsocket(this.sockethandle, 0x4004667F, @nAvail)  && 查询可读字节数
                        IF nAvail > 0
                            this.bytesreceived=nAvail
                            this.dataarrival(nAvail)                
                        ENDIF
                    
                    CASE lParam == 0x0002                && FD_WRITE       接收写准备好的通知 
                        this.readytosend()
                        &&可以发送数据时会产生此事件,没想好这里需要写什么代码
                    
                    CASE lParam == 0x0004                && FD_OOB         接收带边数据到达的通知
                        *MESSAGEBOX("待开发功能!") &&紧急通知,常用于终止,取消,比如下载
                    
                    CASE lParam == 0x0010                && FD_CONNECT     接收已连接好的通知
                        this.state=7
                        this.connect() &&当服务端接受连接时执行用户自定义连接事件
                    
                    CASE lParam == 0x0020                && FD_CLOSE       接收套接口关闭的通知
                        this.state=8
                        this.close(this.sockethandle) &&关闭套接字连接
                        this.close() &&执行用户响应的close事件
                    CASE lParam == 0x274D0010
                        *MESSAGEBOX('远程端口无响应')
                    OTHERWISE
                ENDCASE
    ENDPROC
    *-- 当发送操作完成后发生
    PROCEDURE sendcomplete
        *自定义发送完成事件
    ENDPROC
    *-- 获得本机名
    PROCEDURE getlocalhost
        RETURN STREXTRACT(SYS(0),"",SPACE(1))
    ENDPROC
    *-- 获得指定主机的ip地址
    PROCEDURE getipadress
        LPARAMETERS lchostname
        IF PCOUNT()=0 
            IF EMPTY(this.localhost)
                this.localhost=this.getlocalhost()
            ENDIF 
            lchostname=this.localhost
        ENDIF 
        * VFP示例:使用gethostbyname解析域名
        #DEFINE HOSTENT_SIZE 16
        * 解析域名
        lnHostEnt = gethostbyname(lcHostName)
        IF lnHostEnt = 0
            MESSAGEBOX("无法解析主机名" + lcHostName)
            lcip=""
        ENDIF
        * 读取hostent结构体
        lcHostEnt = REPLICATE(CHR(0), HOSTENT_SIZE)
        = CopyMemory(@lcHostEnt, lnHostEnt, HOSTENT_SIZE)
        * 获取IP地址
        lnIPAddr = CTOBIN(SUBSTR(lcHostEnt, 13, 4), "4rs")
        lcIPAddr = REPLICATE(CHR(0), 4)
        = CopyMemory(@lcIPAddr, lnIPAddr, 4)
        lnFirstIP = CTOBIN(SUBSTR(lcIPaddr, 1, 4), "4rs")
        lcIPAddr = REPLICATE(CHR(0), 4)
        = CopyMemory(@lcIPAddr, lnFirstIP, 4)
        * 转换为点分十进制
        lcIP = TRANSFORM(ASC(SUBSTR(lcIPAddr, 1, 1))) + "." + ;
               TRANSFORM(ASC(SUBSTR(lcIPAddr, 2, 1))) + "." + ;
               TRANSFORM(ASC(SUBSTR(lcIPAddr, 3, 1))) + "." + ;
               TRANSFORM(ASC(SUBSTR(lcIPAddr, 4, 1)))
        RETURN lcip
    ENDPROC
    *-- 建立一个套接字
    PROCEDURE createsocket
        LPARAMETERS nprotocol
        IF PCOUNT()=0 
            nprotocol=this.protocol
        ENDIF 
        this.sockethandle=socket(2,nprotocol,0) &&1,tcp协议;2,UDP协议
        BINDEVENT(thisform.hwnd, WM_SOCKET, this, "Msghandler")
        this.state=1
        RETURN this.sockethandle#0
    ENDPROC
    *-- 准备发送数据
    PROCEDURE readytosend
        *!* 准备发送数据,在此方法中调用senddata方法
    ENDPROC
    *-- 计算响应密钥,和websocket通讯专用
    PROCEDURE ws_accept_key
        PARAMETERS ckey
        LOCAL cMagic, cConcat, cSHA1, cBase64,nlen,hprov,hhash,nresult   
        cMagic = "258EAFA5-E914-47DA-95CA-C5AB0DC85B11"    
        cConcat = cKey + cMagic        
        hProv = 0    
        hHash = 0    
        nResult = CryptAcquireContext(@hProv, 0, 0, 1, 0xF0000000)        
        IF nResult = 0        
            RETURN ""    
        ENDIF        
        nResult = CryptCreateHash(hProv, 0x8004, 0, 0, @hHash)        
        IF nResult = 0        
            CryptReleaseContext(hProv, 0)        
            RETURN ""    
        ENDIF        
        nResult = CryptHashData(hHash, cConcat, LEN(cConcat), 0)        
        IF nResult = 0        
            CryptDestroyHash(hHash)        
            CryptReleaseContext(hProv, 0)        
            RETURN ""    
        ENDIF        
        nLen = 20    
        cSHA1 = SPACE(nLen)    
        nResult = CryptGetHashParam(hHash, 2, @cSHA1, @nLen, 0)        
        CryptDestroyHash(hHash)    
        CryptReleaseContext(hProv, 0)        
        IF nResult = 0        
            RETURN ""    
        ENDIF        
        * Base64编码    
             
        nLen = 0    
        nResult = CryptBinaryToString(cSHA1, 20, 1, 0, @nLen)        
        IF nResult = 0        
            RETURN ""    
        ENDIF        
        cBase64 = SPACE(nLen)    
        nResult = CryptBinaryToString(cSHA1, 20, 1, @cBase64, @nLen)        
        IF nResult = 0        
            RETURN ""    
        ENDIF        
        cBase64 = LEFT(cBase64, nLen-1)  && 去掉末尾的null字符        
        RETURN cBase64
    ENDPROC
    PROCEDURE Error
        LPARAMETERS nError, cMethod, nLine
        LOCAL cprogram,cmsg,ccode
            cprogram=PROGRAM()
            cmsg=MESSAGE()
            ccode=MESSAGE(1)
            szMsg = '错误信息: ' + cMsg                  + 0h0D0D;
                  + '错误编号: ' + TRANSFORM(nError)     + 0h0D0D;
                  + '错误代码: ' + ccode                 + 0h0D0D;
                  + '出错程序: ' + cProgram              + 0h0D0D;
                  + '出错方法: ' + cMethod               + 0h0D0D;      
                  + '出错行号: ' + TRANSFORM(nLine)
            *MESSAGEBOX(szMsg, 2+48+512, "Error")
            =STRTOFILE(TRANSFORM(DATETIME())+ 0h0D0D+szmsg++ 0h0D0D,"foxsocket_error.log",1)
            MODIFY FILE foxsocket_error.log NOWAIT 
    ENDPROC
    PROCEDURE Init
        #define        WM_SOCKET    0x400+100
        LOCAL nResult
        IF TYPE("thisform")#"O"
            *MESSAGEBOX("foxsocket只能在表单中实例化!")
            RETURN .f.
        ELSE 
            this.declare()
            WSADATA=REPLICATE(CHR(0),398)
            nResult = WSAStartup(0x202, @WSADATA)
            this.ver=TRANSFORM(ASC(SUBSTR(wsadata,2,1)))+"."+TRANSFORM(ASC(SUBSTR(wsadata,1,1)))
            this.description=STRTRAN(SUBSTR(wsadata,5,257),CHR(0),"")
        ENDIF 
        RETURN (nResult = 0)
    ENDPROC
    PROCEDURE Destroy
        IF this.sockethandle>0
            *事实上可能有多个客户端连接存在,应
            this.close(this.sockethandle)
        ENDIF
        IF this.listensocket>0
            this.close(this.listensocket)
            *监听情况下,可能有多个客户端连接存在,应逐一关闭连接
            *可以在socket类里设置一个数组用来保存所有客户端的连接
        ENDIF 
        =wsacleanup()
    ENDPROC
ENDDEFINE
*
*-- EndDefine: foxsocket
**************************************************
[此贴子已经被作者于2025-10-25 09:53编辑过]



 
											






 
	    

 
	
 
											

 
											

 
										
					
	
 cResponse = CHR(0x81)+CHR(nConvStr)+cConvStr
 cResponse = CHR(0x81)+CHR(nConvStr)+cConvStr