增强版的foxsocket来了
上次网友@easyppt 问:“能和网页客户端 通讯吗,这样,买家 网页发起客服,卖家VFP受理”今天给你答案,可以!
为了完成网页版和客户端通讯,我去网上搜索了一大堆资料,看得头晕目眩,发现我的foxsocket类无法在网页版运行,只能用web编程中常用的websocket。。。
也就是说vfp服务端用foxsocket,客户端用网页,为了能给接收websocket的讯息,得了解它的通讯规范,foxsocket必须要做适应性改进。。。
经过2天的不断尝试,终于成功,现在分享给大家~~~
有一个遗憾,没考虑中文解码的问题,网页版向服务端发中文的时候会乱码,只有下次改进了。。。
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-18 14:30编辑过]