重写的仿winsock类,目前仅支持tcp协议
重写了前几天丢失的winsock类,迫不及待拿出来分享,欢迎下载试错~~代码如下:

************************************************** *-- 类: socket (d:\documents\visual foxpro 项目\myclass.vcx) *-- 父类: custom *-- 基类: custom *-- 时间戳: 10/02/25 11:11:12 PM * DEFINE CLASS socket AS custom *-- 套接字 sockethandle = 0 *-- 负责监听的套接字 listensocket = 0 *-- 接收到的字符数 bytesreceived = 0 *-- 本地主机名 localhostname = "" *-- 本地ip地址 localip = 0.0.0.0 *-- 本地端口 localport = 0 *-- 套接字连接协议:1, TCP协议 2,UDP 协议 protocol = 1 *-- 远端ip地址 remotehostip = 127.0.0.1 *-- 远端套接字端口 remoteport = 0 *-- 当前套接字连接状态 state = 0 binded = .F. *-- 拥有此对象的表单 PROTECTED ohost ohost = .NULL. Name = "socket" *-- api函数声明 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 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 ENDPROC PROCEDURE Init #define WM_SOCKET 0x400+100 LOCAL nResult this.declare() nResult = WSAStartup(0x202, THIS.WSADATA) this.sockethandle=socket(2,1,0) &&tcp协议 IF TYPE("thisform")="O" this.ohost=thisform BINDEVENT(this.ohost.hwnd, WM_SOCKET, this, "Msghandler") ENDIF this.state=1 RETURN (nResult = 0) ENDPROC *-- 当连接关闭时发生 PROCEDURE close LPARAMETERS hsocket *!* close带参数时为方法,不带参数时为事件 IF PCOUNT()=1 closesocket(hSocket) this.sockethandle=0 this.state=0 IF !this.binded &&没有绑定考虑是客户端 WSACleanup() ENDIF ENDIF ENDPROC *-- 当建立连接时发生 PROCEDURE connect LPARAMETERS romotehost,remoteport *!* connect带参数时为方法,不带参数时为事件 IF PCOUNT()=2 &&带参数则发出连接请求 LOCAL n,stsockaddr IF !ISNULL(this.ohost) WSAAsyncSelect(this.Sockethandle,; this.ohost.hwnd,; 0x400+100,; 51) && FD_CONNECT or FD_READ or FD_CLOSE or FD_WRITE ENDIF stSockAddr = BINTOC(2, "2RS"); && sin_family = AF_INET + BINTOC(htons(remotePort), "2RS"); && sin_port + BINTOC(inet_addr(@remoteIP), "4RS"); && sin_addr + REPLICATE(0h00, 8) n=connect(thisform.hSocket, @stSockAddr, LEN(stSockAddr)) && SOCKET_ERROR IF n#-1 this.state=6 ENDIF RETURN n#-1 ENDIF ENDPROC *-- 当远方客户端企图连接时发生 PROCEDURE connectionrequest LPARAMETERS requestid *!* 收到连接请求时自动产生requestid,同意请求则调用accept()并传递requestid *!* 若要拒绝连接,只需传递参数0给accept()方法 ENDPROC *-- 当收到远方电脑发送的数据时发生 PROCEDURE dataarrival LPARAMETERS bytestotal *!* dataarrival带参数时为方法,不带参数时为事件 *!* 可以在这个方法中调用getdata()方法来获取数据 ENDPROC *-- 发送数据期间发生 PROCEDURE sendprogress LPARAMETERS bytessent,bytesremaining ENDPROC *-- 接收一个连接请求 PROCEDURE accept LPARAMETERS requestid *!* 在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.listensocket=this.sockethandle &&设置为监听套接字 this.sockethandle =accept(this.sockethandle, @stSockAddr, @nSize) &&新套接字用于通讯 IF ISNULL(this.ohost) WSAAsyncSelect(this.sockethandle, this.ohost.hwnd, 0x400+100, 33) && FD_READ + FD_CLOSE=33 ENDIF *****也可以采用不响应connectionrequest请求的方式来拒绝连接,即请求端超时,但会造成客户端堵塞,不建议 IF n-requestid<3000 &&3秒内响应connectionrequest请求 nIP = CTOBIN(SUBSTR(stSockAddr, 5, 4), '4RS') szIP = SYS(2600, inet_ntoa(nIP), 16) szIP = LEFT(szIP, AT(0h00, szIP)-1) nPort = ntohs(CTOBIN(SUBSTR(stSockAddr, 3, 2), '2RS')) this.remotehostip=szip this.remoteport=nport this.state=7 ELSE this.close(this.sockethandle) &&拒绝连接 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(thisform.hSocket, @stSockAddr, LEN(stSockAddr)) IF n#-1 this.binded=.t. ENDIF RETURN n#-1 ENDPROC *-- 检索来自远方计算机的数据 PROCEDURE getdata LPARAMETERS cdata,nbytes &&cdata为输出型参数 IF PCOUNT()=1 nbytes=this.bytesreceived ENDIF RETURN recv(this.Sockethandle, @cdata, nbytes, 0) ENDPROC *-- 监听远方计算机的连接请求 PROCEDURE listen #define WM_SOCKET 0x400 + 100 #define FD_ACCEPT 8 IF this.binded listen(thisform.hSocket, 5) IF !ISNULL(this.ohost) WSAAsyncSelect(this.sockethandle, this.ohost.hWnd, WM_SOCKET, FD_ACCEPT) &&FD_ACCEPT=8 ENDIF this.state=2 ENDIF 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(_hSocket, @cdata, LEN(szDate), 0) *!* IF n == -1 *!* nerror=WSAGetLastError() *!* IF nerror== 10035 && WSAEWOULDBLOCK *!* MESSAGEBOX('网络繁忙,请稍候发送') *!* ELSE *!* MESSAGEBOX('发送失败') *!* ENDIF *!* ENDIF RETURN n#-1 ENDPROC PROCEDURE Destroy this.ohost=.null. ENDPROC *-- 建立对拥有此对象的表单的引用 PROCEDURE setohost LPARAMETERS oform *!* 当你用createobject实例化本类时,需要在合适的时机调用本方法,建立对表单的引用 IF TYPE("ofrm")="O" AND UPPER(oform.baseclass)="FORM" this.ohost=oform BINDEVENT(this.ohost.hwnd, 0x400+100, this, "Msghandler") ENDIF ENDPROC *-- 处理windows消息 PROCEDURE msghandler LPARAMETERS hWnd, Msg, wParam, lParam IF this.sockethandle#wparam this.sockethandle=wparam ENDIF DO CASE CASE lParam == 0x0008 && FD_ACCEPT 接收将要连接的通知 oldset=SET("Decimals") SET DECIMALS TO 0 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 szReadBuf = REPLICATE(0h00,navail) recv(this.sockethandle, @szReadBuf, nAvail, 0) ENDIF this.bytesreceived=nAvail this.dataarrival(nAvail) CASE lParam == 0x0002 && FD_WRITE 接收写准备好的通知 &&可以发送数据时会产生此事件,没想好这里需要写什么代码 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 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") CANCEL ENDPROC *-- 当发送操作完成后发生 PROCEDURE sendcomplete ENDPROC ENDDEFINE * *-- EndDefine: socket **************************************************