重写的仿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
**************************************************
