重写的仿winsock类，目前仅支持tcp协议

**************************************************
*-- 类:           foxsocket (d:\documents\visual foxpro 项目\myclass.vcx)
*-- 父类:  custom
*-- 基类:    custom
*-- 时间戳:   10/04/25 11:45:03 PM
*
DEFINE CLASS foxsocket AS custom


    *-- 版本号
    ver = ""
    *-- 描述
    description = ""
    *-- 复制监听的套接字
    listensocket = 0
    *-- 当前套接字句柄
    sockethandle = ""
    *-- 收到的字节数
    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带参数时为方法，不带参数时为事件
        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
    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()方法
    ENDPROC


    *-- 当收到远方电脑发送的数据时发生
    PROCEDURE dataarrival
        LPARAMETERS bytestotal
        *!*    dataarrival带参数时为方法，不带参数时为事件
        *!*    可以在这个方法中调用getdata()方法来获取数据
    ENDPROC


    *-- 发送数据期间发生
    PROCEDURE sendprocess
        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) &&新套接字用于通讯

        WSAAsyncSelect(this.sockethandle, thisform.hwnd, 1124, 33)  && FD_READ + FD_CLOSE=33 0x400+100=1124

        *****也可以采用不响应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(this.Sockethandle, @stSockAddr, LEN(stSockAddr))

        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

        listen(this.Sockethandle, 5)
        WSAAsyncSelect(this.sockethandle, thisform.hWnd, WM_SOCKET, FD_ACCEPT) &&FD_ACCEPT=8
        this.state=2
    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)
        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      接收将要连接的通知
                        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       接收写准备好的通知
                        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


    PROCEDURE Destroy
        wsacleanup()
    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 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


ENDDEFINE
*
*-- EndDefine: foxsocket
**************************************************