注册 登录
编程论坛 → VFP论坛

仿winsock控件功能的vfp类foxsocket 测试成功

sam_jiang 发布于 5 天前 22:59， 276 次点击
前些天我上传了foxsocket类，没有调试试错。。。今天建立了2个表单用来测试，果然发现一些小问题，已经修复，赶紧复制去吧。。。

感兴趣的可以复制代码运行试试看，不过调试期间可能会频繁切换设计模式和运行模式，每次要换个端口，因为端口通常会被锁定5分钟左右。

服务端代码：
10/15 更新互动后的UI界面，以及演示如何触发同名事件或方法

程序代码：

**************************************************
*-- Form:         form1 (d:\documents\visual foxpro 项目\foxsocket_server.scx)
*-- 父类:  form
*-- 基类:    form
*-- 时间戳:   10/14/25 11:33:13 PM
*
DEFINE CLASS form1 AS form


    Height = 417
    Width = 590
    DoCreate = .T.
    AutoCenter = .T.
    Caption = "Foxsocket 服务端演示demo"
    Name = "Form1"


    ADD OBJECT foxsocket1 AS foxsocket WITH ;
        Top = 49, ;
        Left = 552, ;
        Height = 17, ;
        Width = 24, ;
        Name = "Foxsocket1"


    ADD OBJECT label1 AS label WITH ;
        AutoSize = .T., ;
        Caption = "IP 地址：", ;
        Height = 16, ;
        Left = 13, ;
        Top = 47, ;
        Width = 56, ;
        Name = "Label1"


    ADD OBJECT label2 AS label WITH ;
        AutoSize = .T., ;
        Caption = "端 口： ", ;
        Height = 16, ;
        Left = 199, ;
        Top = 47, ;
        Width = 50, ;
        Name = "Label2"


    ADD OBJECT text1 AS textbox WITH ;
        Alignment = 3, ;
        Value = 8888, ;
        Height = 20, ;
        InputMask = "9999", ;
        Left = 249, ;
        Top = 45, ;
        Width = 50, ;
        Name = "Text1"


    ADD OBJECT command1 AS commandbutton WITH ;
        AutoSize = .T., ;
        Top = 43, ;
        Left = 379, ;
        Height = 25, ;
        Width = 60, ;
        Caption = "启动服务", ;
        Name = "Command1"


    ADD OBJECT edit1 AS editbox WITH ;
        Height = 288, ;
        Left = 12, ;
        Top = 72, ;
        Width = 564, ;
        Name = "Edit1"


    ADD OBJECT edit2 AS editbox WITH ;
        Height = 50, ;
        Left = 12, ;
        Top = 365, ;
        Width = 504, ;
        Name = "Edit2"


    ADD OBJECT command2 AS commandbutton WITH ;
        Top = 388, ;
        Left = 516, ;
        Height = 25, ;
        Width = 60, ;
        Caption = "发  送", ;
        Name = "Command2"


    ADD OBJECT txt_ip1 AS txt_ip WITH ;
        Left = 73, ;
        Top = 44, ;
        Name = "Txt_ip1"


    ADD OBJECT label3 AS label WITH ;
        Caption = (chr(13)+ "这是一个Foxsocket 服务端的演示程序..."), ;
        Height = 37, ;
        Left = 12, ;
        Top = 0, ;
        Width = 565, ;
        Name = "Label3"


    PROCEDURE foxsocket1.connectionrequest
        LPARAMETERS requestid
        MESSAGEBOX("检测到连接请求！",0+64,"通知",2)
        this.accept(requestid)
        IF this.state=7
            thisform.edit1.Value=thisform.edit1.Value+"客户端已连接。。。"+CHR(13)
        ELSE
            thisform.edit1.Value=thisform.edit1.Value+"你已拒绝连接请求。。。"+CHR(13)
        ENDIF
    ENDPROC


    PROCEDURE foxsocket1.close
        LPARAMETERS hsocket
        *********************************************
        *子类close事件中调用父类的方法：
        *if PCOUNT()=0 &&定义没有参数时的行为
        *    input your code here
        *ELSE
        *    DODEFAULT(hsocket) &&不能漏掉参数
        *ENDIF  
        *********************************************
        IF PCOUNT()=0
            MESSAGEBOX("远方主机关闭连接")
            SET MESSAGE TO "远方主机已关闭连接。。。"
            thisform.edit1.Value=thisform.edit1.Value+"远方主机已关闭连接。。"+CHR(13)
        ELSE
            DODEFAULT(hsocket)
        ENDIF
    ENDPROC


    PROCEDURE foxsocket1.dataarrival
        LPARAMETERS bytestotal
        IF PCOUNT()=1
            lcbuffer=REPLICATE(CHR(0),bytestotal)
            thisform.foxsocket1.getData(@lcbuffer)
            thisform.edit1.Value=thisform.edit1.Value+lcbuffer+CHR(13)
        ENDIF
    ENDPROC


    PROCEDURE command1.Click
        thisform.edit1.Value=thisform.edit1.Value+"初始化foxsocket..."+CHR(13)
        thisform.foxsocket1.createsocket()
        thisform.edit1.Value=thisform.edit1.Value+"正在绑定"+TRANSFORM(thisform.text1.Value)+"端口..."+CHR(13)
        thisform.foxsocket1.bind(thisform.txt_ip1.Value,thisform.text1.Value)
        thisform.edit1.Value=thisform.edit1.Value+"进入监听状态..."+CHR(13)
        thisform.foxsocket1.listen()
        IF thisform.foxsocket1.state=2
            SET MESSAGE TO "服务已就绪。。。"
        ENDIF
        ="已启动"
        =.f.
    ENDPROC


    PROCEDURE command2.Click
        IF !EMPTY(thisform.edit2.value)
            thisform.foxsocket1.senddata(thisform.edit2.Value)
            thisform.edit2.Value=""
        ENDIF
    ENDPROC


    PROCEDURE txt_ip1.Init
        lchostname=thisform.foxsocket1.getlocalhost()
        this.Value=thisform.foxsocket1.getipadress(lchostname)
    ENDPROC


ENDDEFINE
*
*-- EndDefine: form1
**************************************************



[此贴子已经被作者于2025-10-15 08:57编辑过]

9 回复
#2
sam_jiang5 天前 23:01
接上楼

客户端代码：
10/15 更新互动后的UI界面，以及演示如何触发同名事件或方法

程序代码：

**************************************************
*-- Form:         form1 (d:\documents\visual foxpro 项目\foxsocket_client.scx)
*-- 父类:  form
*-- 基类:    form
*-- 时间戳:   10/14/25 11:35:03 PM
*
DEFINE CLASS form1 AS form


    Height = 417
    Width = 590
    DoCreate = .T.
    AutoCenter = .T.
    Caption = "Foxsocket 客户端演示demo"
    Name = "Form1"


    ADD OBJECT foxsocket1 AS foxsocket WITH ;
        Top = 49, ;
        Left = 552, ;
        Height = 17, ;
        Width = 24, ;
        Name = "Foxsocket1"


    ADD OBJECT label1 AS label WITH ;
        AutoSize = .T., ;
        Caption = "IP 地址：", ;
        Height = 16, ;
        Left = 13, ;
        Top = 47, ;
        Width = 56, ;
        Name = "Label1"


    ADD OBJECT label2 AS label WITH ;
        AutoSize = .T., ;
        Caption = "端 口： ", ;
        Height = 16, ;
        Left = 199, ;
        Top = 47, ;
        Width = 50, ;
        Name = "Label2"


    ADD OBJECT text1 AS textbox WITH ;
        Alignment = 3, ;
        Value = 8888, ;
        Height = 20, ;
        InputMask = "9999", ;
        Left = 249, ;
        Top = 45, ;
        Width = 50, ;
        Name = "Text1"


    ADD OBJECT command1 AS commandbutton WITH ;
        AutoSize = .T., ;
        Top = 43, ;
        Left = 379, ;
        Height = 25, ;
        Width = 72, ;
        Caption = "连接服务器", ;
        Name = "Command1"


    ADD OBJECT edit1 AS editbox WITH ;
        Height = 288, ;
        Left = 12, ;
        Top = 72, ;
        Width = 564, ;
        Name = "Edit1"


    ADD OBJECT edit2 AS editbox WITH ;
        Height = 50, ;
        Left = 12, ;
        Top = 365, ;
        Width = 504, ;
        Name = "Edit2"


    ADD OBJECT command2 AS commandbutton WITH ;
        Top = 388, ;
        Left = 516, ;
        Height = 25, ;
        Width = 60, ;
        Caption = "发  送", ;
        Name = "Command2"


    ADD OBJECT txt_ip1 AS txt_ip WITH ;
        Left = 73, ;
        Top = 44, ;
        Name = "Txt_ip1"


    ADD OBJECT label3 AS label WITH ;
        Caption = (chr(13)+ "这是一个Foxsocket 客户端的演示程序..."), ;
        Height = 37, ;
        Left = 12, ;
        Top = 0, ;
        Width = 565, ;
        Name = "Label3"


    PROCEDURE foxsocket1.connect
        LPARAMETERS remotehost,remoteport
        *********************************************
        *子类connect事件中调用父类的方法：
        *if PCOUNT()=0 &&定义没有参数时的行为
        *    input your code here
        *    ......
        *ELSE
        *    DODEFAULT(remotehost,remoteport) &&不能漏掉参数
        *ENDIF  
        *********************************************
        IF PCOUNT()=0
            SET MESSAGE TO "服务器已接受连接请求，可以通讯。。。"
            ="已连接"
            thisform.edit1.Value=thisform.edit1.Value+"服务器已接受连接请求。。。"+CHR(13)
        ELSE
            DODEFAULT(remotehost,remoteport) &&调用父类代码
        ENDIF

    ENDPROC


    PROCEDURE foxsocket1.dataarrival
        LPARAMETERS bytestotal
        IF PCOUNT()=1
            lcbuffer=REPLICATE(CHR(0),bytestotal)
            thisform.foxsocket1.getData(@lcbuffer)
            thisform.edit1.Value=thisform.edit1.Value+lcbuffer+CHR(13)
        ENDIF
    ENDPROC


    PROCEDURE foxsocket1.close
        LPARAMETERS hsocket
        IF PCOUNT()=0
            MESSAGEBOX("远方主机关闭连接")
            SET MESSAGE TO "远方主机关闭连接。。。"
            ="等待连接服务器"
        ELSE
            DODEFAULT(hsocket)
        ENDIF
    ENDPROC


    PROCEDURE foxsocket1.connectionrequest
        LPARAMETERS requestid
    ENDPROC


    PROCEDURE command1.Click
        thisform.edit1.Value=thisform.edit1.Value+"初始化foxsocket..."+CHR(13)
        thisform.foxsocket1.createsocket()
        thisform.edit1.Value=thisform.edit1.Value+"正在连接远方ip:";
                            +thisform.txt_ip1.value+SPACE(2)+;
                            TRANSFORM(thisform.text1.Value)+"端口..."+CHR(13)
        thisform.foxsocket1.connect(thisform.txt_ip1.Value,thisform.text1.Value)

    ENDPROC


    PROCEDURE command2.Click
        IF !EMPTY(thisform.edit2.value)
            thisform.foxsocket1.senddata(thisform.edit2.Value)
            thisform.edit2.Value=""
        ENDIF
    ENDPROC


    PROCEDURE txt_ip1.Init
        lchostname=thisform.foxsocket1.getlocalhost()
        this.Value=thisform.foxsocket1.getipadress(lchostname)
    ENDPROC


ENDDEFINE
*
*-- EndDefine: form1
**************************************************



[此贴子已经被作者于2025-10-15 08:59编辑过]
#3
sam_jiang5 天前 23:03
修改后的foxsocket类代码：
10/15 修改accept函数的逻辑，destroy中关闭打开的socket套接字，避免内存泄露。
程序代码：

**************************************************
*-- 类:           foxsocket (d:\documents\visual foxpro 项目\backup.vcx)
*-- 父类:  custom
*-- 基类:    custom
*-- 时间戳:   10/15/25 08:41:03 AM
*
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
    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
        #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
        *****也可以采用不响应connectionrequest请求的方式来拒绝连接，即请求端超时，但会造成客户端堵塞，不建议

        nchoice=MESSAGEBOX("远方电脑申请连接，是否接受？",4+32+0,"连接申请",3000)
        IF nchoice=NACCEPT OR nchoice=NTIMEOUT &&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.remoteip=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
            n=recv(this.Sockethandle, @cdata, nbytes, 0)
            IF n>0
                MESSAGEBOX("收到"+TRANSFORM(n)+"字节")
            ELSE
                MESSAGEBOX("获得数据失败")
            ENDIF
        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      接收将要连接的通知
                        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


    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 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-15 09:03编辑过]
#4
sam_jiang5 天前 23:10
运行效果图：
只有本站会员才能查看附件，请 登录

只有本站会员才能查看附件，请 登录
#5
sych4 天前 19:06
谢谢分享，给大佬点赞
#6
ykxby0013 天前 08:07
酷
#7
easyppt3 天前 08:18
能和网页客户端 通讯吗，这样，买家 网页发起客服，卖家VFP受理
#8
sam_jiang3 天前 08:52
感谢两位关注~
已更新调试其他功能，代码更新在1楼，2楼，和三楼。
#9
sam_jiang3 天前 17:03
回复 7楼 easyppt
理论上可以，改天尝试看看。。。
#10
schtg3 天前 18:05
1
©2025, BC-CN.NET
电脑版