winsock应用重装后失灵了 - 编程论坛

#2

kangss2024-05-19 18:54

没搞过sock，我系统上运行也是出你一样的错误，估计跟“重装系统”无关

#3

sych2024-05-20 08:48

建议改用群友孤独王的vfpsocket.fll，非常方便

只有本站会员才能查看附件，请登录

#4

sam_jiang2024-05-20 21:01

回复 3楼 sych

感谢分享

#5

sych2024-05-22 11:13

这个是我最近的学习示例

只有本站会员才能查看附件，请登录

#6

sam_jiang2024-06-15 13:06

总算自己找到问题所在了，server的connectionrequest里有句代码被注释掉了。。。

#7

sam_jiang2024-06-15 14:06

只有本站会员才能查看附件，请登录

分别把sever和client拷贝到局域网不同的电脑，在表单client的init中设置一下remotehost和port就可以运行了。。。

#8

kangss2024-06-15 14:19

服务端发送出错，客户端发送提示没有连接。
必须要在2台电脑上运行吗？

只有本站会员才能查看附件，请登录

#9

sam_jiang2024-06-15 14:51

回复 8楼 kangss

分别在2台电脑上运行啊

#10

吹水佬2024-06-15 15:51

同一台电脑应该没问题。
广域局域网能连接就可以。
socket c/s 简单的用几个socket api 也可以实现。
示例：以典型的聊天代码为例，尝试 Scoket API 的 C/S。

只有本站会员才能查看附件，请登录

程序代码：

* 服务器端，socket_server.prg

_SCREEN.Visible = .F.
SET TALK OFF
SET SAFETY OFF
CLEAR

#DEFINE WM_SOCKET    0x400 + 100

DECLARE LONG WSAGetLastError IN "Ws2_32"
DECLARE LONG WSAStartup      IN "Ws2_32" LONG, STRING@
DECLARE LONG WSACleanup      IN "Ws2_32"
DECLARE LONG socket          IN "Ws2_32" LONG, LONG, LONG
DECLARE LONG closesocket     IN "Ws2_32" LONG
DECLARE LONG WSAAsyncSelect  IN "Ws2_32" LONG, LONG, LONG, LONG
DECLARE LONG bind            IN "Ws2_32" AS _bind LONG, STRING@, LONG
DECLARE LONG listen          IN "Ws2_32" LONG, LONG
DECLARE LONG accept          IN "Ws2_32" LONG, STRING@, LONG@
DECLARE LONG connect         IN "Ws2_32" LONG, STRING@, LONG
DECLARE LONG recv            IN "Ws2_32" LONG, STRING@, LONG, LONG
DECLARE LONG send            IN "Ws2_32" LONG, STRING@, LONG, LONG
DECLARE LONG inet_addr       IN "Ws2_32" STRING@
DECLARE LONG inet_ntoa       IN "Ws2_32" LONG
DECLARE SHORT htons          IN "Ws2_32" SHORT
DECLARE SHORT ntohs          IN "Ws2_32" SHORT

DECLARE LONG SendMessage IN User32 LONG, LONG, LONG, LONG
DECLARE LONG PostMessage IN User32 LONG, LONG, LONG, LONG

PUBLIC oForm
oForm = NEWOBJECT("Form1")
oForm.Show
READ EVENTS
CLEAR DLLS
_SCREEN.Visible = .T.
RETURN

DEFINE CLASS Form1 As Form
    Width = 600
    Height = 300
    Desktop = .T.
    ShowWindow = 2
    WindowType = 1
    AutoCenter = .T.
    AlwaysOnTop = .T.
    BorderStyle = 0
    caption = "socket_server"

    hSocket = 0

    Add Object Label1 As Label WITH Top = 10, Left = 10, AutoSize = .T.,;
        Caption = '本端: IP                  端口'
    Add Object Text1 As TextBox WITH Top = 6, Left = 60, Width = 100, Height = 20
    Add Object Text2 As TextBox WITH Top = 6, Left = 190, Width = 40, Height = 20, value = 9999
    Add Object Command1 As CommandButton WITH Top = 6, Left = 235, Width = 80, Height = 20,;
        Caption = '启动服务'

    Add Object Edit1 As EditBox WITH Top = 32, Left = 10, Width = 290, Height = 230
    Add Object Text3 As TextBox WITH Top = 270, Left = 10, Width = 300, Height = 20

    Add Object Command2 As CommandButton WITH Top = 270, Left = 310, Width = 80, Height = 20,;
        Caption = '发送'

    Add Object List1 As ListBox WITH Top = 32, Left = 300, Width = 290, Height = 230,;
        ColumnCount = 4,;
        ColumnLines = .F.,;
        ColumnWidths = '100,100,40,40'

    PROCEDURE Load
        ON ERROR _OnError(ERROR(), MESSAGE(), MESSAGE(1), PROGRAM(), LINENO())
    ENDPROC

    PROCEDURE Init
        LOCAL oIPs
        BINDEVENT(this.hWnd, WM_SOCKET, this, "_SocketMsg")

        oIPs = GETOBJECT('winmgmts:')
        oIPs = oIPs.InstancesOf('Win32_NetworkAdapterConfiguration')
        FOR EACH oIP IN oIPs
            IF oIP.IPEnabled
                this.Text1.Value = oIP.IPAddress[0]
                EXIT
            ENDIF
        ENDFOR

        this.AlwaysOnTop = .F.
    ENDPROC

    PROCEDURE Destroy
         this._CloseSocket()
    ENDPROC

    PROCEDURE Unload
        ON ERROR
        CLEAR EVENTS
    ENDPROC

    PROCEDURE Command1.Click
        LOCAL stWsaData, stSockAddr, szIP, nPort

        thisform._CloseSocket()

        thisform._WriteMsg('')
        thisform.List1.Clear

        stWsaData  = REPLICATE(0h00, 398)
        WSAStartup(0x202, @stWsaData)
        thisform.hSocket = socket(2, 1, 0)
        WSAAsyncSelect(thisform.hSocket, thisform.hWnd, WM_SOCKET, 8)

        szIP  = ALLTRIM(thisform.Text1.Value)
        nPort = thisform.Text2.Value

        stSockAddr = BINTOC(2, '2RS');                   && sin_family
                   + BINTOC(htons(nPort), '2RS');        && sin_port
                   + BINTOC(inet_addr(@szIP), '4RS');    && sin_addr
                   + REPLICATE(0h00, 8)

        IF _bind(thisform.hSocket, @stSockAddr, LEN(stSockAddr)) == -1
            thisform._WriteMsg('不能绑定到IP:' + szIP + ' 端口:' + TRANSFORM(nPort))
        ELSE
            thisform._WriteMsg('启动服务成功')
            listen(thisform.hSocket, 5)                  && 监听，队列限制5
        ENDIF
    ENDPROC

    PROCEDURE Command2.Click
        *SendMessage(thisform.HWnd, WM_SOCKET, 100, 200)
        MESSAGEBOX("这里暂不用，有需要可参考客户端示例。")
    ENDPROC

    PROCEDURE _WriteMsg
        LPARAMETERS szMsg

        IF !EMPTY(szMsg)
            IF MEMLINES(this.Edit1.Value) > 50
                this.Edit1.Value = STUFF(this.Edit1.Value, 1, LEN(MLINE(this.Edit1.Value, 1))+2, '')
            ENDIF

            this.Edit1.Value = this.Edit1.Value + szMsg + 0h0D0A
        ELSE
            this.Edit1.Value = ''
        ENDIF

        this.Edit1.SelStart = LEN(this.Edit1.Text)
        this.Edit1.SelLength = 0
    ENDPROC

    * 关闭所有Socket
    PROCEDURE _CloseSocket
        closesocket(thisform.hSocket)

        FOR i = 1 TO this.List1.ListCount
            closesocket(INT(VAL(this.List1.List(i, 4))))
        ENDFOR

        WSACleanup()
    ENDPROC

    * 添加一个客户端socket
    PROCEDURE _AddClient
        LPARAMETERS _hSocket
        LOCAL stSockAddr, nSize, nIP, szIP, nPort

        stSockAddr = REPLICATE(0h00, 16)
        nSize      = LEN(stSockAddr)

        _hSocket = accept(_hSocket, @stSockAddr, @nSize)

        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'))

        WSAAsyncSelect(_hSocket, this.hWnd, WM_SOCKET, 33)  && FD_READ or FD_CLOSE

        this.List1.AddItem('')
        this.List1.List[this.List1.NewIndex, 2] = szIP
        this.List1.List[this.List1.NewIndex, 3] = TRANSFORM(nPort)
        this.List1.List[this.List1.NewIndex, 4] = TRANSFORM(_hSocket)
    ENDPROC

    * 去掉一个客户端socket
    PROCEDURE _RemoveClient
        LPARAMETERS _hSocket
        LOCAL hSocket

        FOR i = 1 TO this.List1.ListCount
            IF INT(VAL(this.List1.List(i, 4))) == _hSocket
                closesocket(_hSocket)
                this.List1.RemoveItem(i)
                EXIT
            ENDIF
        ENDFOR

        FOR i = 1 TO this.List1.ListCount
            hSocket = INT(VAL(this.List1.List(i, 4)))
            this._SendData(hSocket, BINTOC(2, '1RS') + BINTOC(_hSocket, '4RS'))
        ENDFOR
    ENDPROC

    * 用户登录
    PROCEDURE _Login
        LPARAMETERS _hSocket, _szID
        LOCAL _szData, _szIP, _nPort, szData, hSocket, szID, szIP, nPort

        _szID   = PADR(_szID, 16, ' ')
        _szData = BINTOC(1, '1RS')

        FOR i = this.List1.ListCount TO 1 STEP -1
            IF INT(VAL(this.List1.List(i, 4))) == _hSocket
                this.List1.List[i, 1] = RTRIM(_szID)

                _szIP  = this.List1.List[i, 2]
                _nPort = INT(VAL(this.List1.List[i, 3]))

                _szData = _szData + BINTOC(inet_addr(@_szIP), '4RS');
                                  + BINTOC(_nPort, '4RS');
                                  + BINTOC(_hSocket, '4RS') + _szID
                EXIT
            ENDIF
        ENDFOR

        this._SendData(_hSocket, _szData)

        FOR i = 1 TO this.List1.ListCount
            hSocket = INT(VAL(this.List1.List(i, 4)))

            IF hSocket != _hSocket
                szID    = PADR(this.List1.List[i, 1], 16, ' ')
                szIP    = this.List1.List[i, 2]
                nPort   = INT(VAL(this.List1.List[i, 3]))

                szData  = BINTOC(1, '1RS');
                        + BINTOC(inet_addr(@szIP), '4RS');
                        + BINTOC(nPort, '4RS');
                        + BINTOC(hSocket, '4RS') + szID

                this._SendData(hSocket, _szData)
                this._SendData(_hSocket, szData)
            ENDIF
        ENDFOR
    ENDPROC

    * 聊天
    PROCEDURE _Chat
        LPARAMETERS szDate
        LOCAL hSocket

        this._WriteMsg(szDate)
        FOR i = 1 TO this.List1.ListCount
            hSocket = INT(VAL(this.List1.List(i, 4)))
            this._SendData(hSocket, BINTOC(3, '1RS') + szDate)
        ENDFOR
    ENDPROC

    * 发送数据包
    PROCEDURE _SendData
        LPARAMETERS _hSocket, szDate

        IF send(_hSocket, @szDate, LEN(szDate), 0) == -1
            IF WSAGetLastError() == 10035    && WSAEWOULDBLOCK
                this._WriteMsg('网络繁忙，请稍候发送')
            ELSE
                this._WriteMsg('发送失败')
            ENDIF
        ENDIF
    ENDPROC

    * 接收到数据包
    PROCEDURE _RecvData
        LPARAMETERS _hSocket
        LOCAL szReadBuf, nDataLen, nCMD

        szReadBuf = SPACE(32768)    && 32 * 1024
        nDataLen = recv(_hSocket, @szReadBuf, LEN(szReadBuf), 0)

        IF nDataLen > 0
            szReadBuf = LEFT(szReadBuf, nDataLen)
            nCMD      = CTOBIN(LEFT(szReadBuf, 1), '1RS')
            szReadBuf = RIGHT(szReadBuf, nDataLen-1)

            DO CASE
            CASE nCMD == 1    && 登录
                this._Login(_hSocket, szReadBuf)
                this._WriteMsg(szReadBuf + ' 登录')
            CASE nCMD == 3    && 聊天
                this._Chat(szReadBuf)
            ENDCASE
        ENDIF
    ENDPROC

    * 网络消息处理
    PROCEDURE _SocketMsg
        LPARAMETERS hWnd, Msg, wParam, lParam
*this._WriteMsg(TRANSFORM(hWnd) + ', ' + TRANSFORM(Msg) + ', ' + TRANSFORM(wParam) + ', ' + TRANSFORM(lParam))
        DO CASE
        CASE lParam == 0x0008                && FD_ACCEPT      接收将要连接的通知
            this._AddClient(wParam)
        CASE lParam == 0x0001                && FD_READ        接收读准备好的通知
            this._RecvData(wParam)
        CASE lParam == 0x0002                && FD_WRITE       接收写准备好的通知
        CASE lParam == 0x0004                && FD_OOB         接收带边数据到达的通知
        CASE lParam == 0x0010                && FD_CONNECT     接收已连接好的通知
        CASE lParam == 0x0020                && FD_CLOSE       接收套接口关闭的通知
            this._RemoveClient(wParam)
        CASE lParam == 0x274D0010
            this._WriteMsg('远程端口无响应，登录失败')
        OTHERWISE
        ENDCASE
    ENDPROC

ENDDEFINE

FUNCTION _OnError(nErrNum, szErrMsg, szErrCode, szErrProgram, nErrLineNo)
    LOCAL szMsg, nRet

    szMsg = '错误信息: ' + szErrMsg           + 0h0D0D;
          + '错误编号: ' + TRANSFORM(nErrNum) + 0h0D0D;
          + '错误代码: ' + szErrCode          + 0h0D0D;
          + '出错程序: ' + szErrProgram       + 0h0D0D;
          + '出错行号: ' + TRANSFORM(nErrLineNo)

    nRet = MESSAGEBOX(szMsg, 2+48+512, "Error")

    DO CASE
    CASE nRet == 3            && 终止
        CANCEL
    CASE nRet == 4            && 重试
        RETRY
    ENDCASE
ENDFUNC

程序代码：

* 客户器端，socket_client.prg

_SCREEN.Visible = .F.
SET TALK OFF
SET SAFETY OFF
CLEAR

#DEFINE WM_SOCKET    0x400 + 100

DECLARE LONG WSAGetLastError IN "Ws2_32"
DECLARE LONG WSAStartup      IN "Ws2_32" LONG, STRING@
DECLARE LONG WSACleanup      IN "Ws2_32"
DECLARE LONG socket          IN "Ws2_32" LONG, LONG, LONG
DECLARE LONG closesocket     IN "Ws2_32" LONG
DECLARE LONG WSAAsyncSelect  IN "Ws2_32" LONG, LONG, LONG, LONG
DECLARE LONG connect         IN "Ws2_32" LONG, STRING@, LONG
DECLARE LONG recv            IN "Ws2_32" LONG, STRING@, LONG, LONG
DECLARE LONG send            IN "Ws2_32" LONG, STRING@, LONG, LONG
DECLARE LONG inet_addr       IN "Ws2_32" STRING@
DECLARE LONG inet_ntoa       IN "Ws2_32" LONG
DECLARE SHORT htons          IN "Ws2_32" SHORT
DECLARE SHORT ntohs          IN "Ws2_32" SHORT

DECLARE LONG SendMessage IN User32 LONG, LONG, LONG, LONG
DECLARE LONG PostMessage IN User32 LONG, LONG, LONG, LONG

PUBLIC oForm
oForm = NEWOBJECT("Form1")
oForm.Show
READ EVENTS
CLEAR DLLS
_SCREEN.Visible = .T.
RETURN

DEFINE CLASS Form1 As Form
    Width = 600
    Height = 300
    Desktop = .T.
    ShowWindow = 2
    WindowType = 1
    AutoCenter = .T.
    AlwaysOnTop = .T.
    BorderStyle = 0
    caption = "socket_client"

    hSocket = 0

    Add Object Label1 As Label WITH Top = 10, Left = 10, AutoSize = .T.,;
        Caption = '远端: IP                  端口        用户ID'
    Add Object Text1 As TextBox WITH Top = 6, Left = 60, Width = 100, Height = 20, value = '192.168.0.254'
    Add Object Text2 As TextBox WITH Top = 6, Left = 190, Width = 40, Height = 20, value = 9999
    Add Object Text3 As TextBox WITH Top = 6, Left = 275, Width = 40, Height = 20, value = 'ABCD'
    Add Object Command1 As CommandButton WITH Top = 6, Left = 324, Width = 50, Height = 20,;
        Caption = '登录'

    Add Object Edit1 As EditBox WITH Top = 32, Left = 10, Width = 290, Height = 230
    Add Object Text4 As TextBox WITH Top = 270, Left = 10, Width = 300, Height = 20

    Add Object Command2 As CommandButton WITH Top = 270, Left = 310, Width = 80, Height = 20,;
        Caption = '发送'

    Add Object List1 As ListBox WITH Top = 32, Left = 300, Width = 290, Height = 230,;
        ColumnCount = 4,;
        ColumnLines = .F.,;
        ColumnWidths = '100,100,40,40'

    PROCEDURE Init
        LOCAL oIPs
        this.AlwaysOnTop = .F.
        BINDEVENT(this.hWnd, WM_SOCKET, this, "_SocketMsg")
    ENDPROC

    PROCEDURE Unload
        this._CloseSocket()
        CLEAR EVENTS
    ENDPROC

    PROCEDURE Command1.Click
        LOCAL stWsaData, stSockAddr, szIP, nPort

        thisform._WriteMsg('')
        thisform.List1.Clear
        thisform._CloseSocket()

        stWsaData  = REPLICATE(0h00, 398)
        WSAStartup(0x202, @stWsaData)
        thisform.hSocket = socket(2, 1, 0)    && AF_INET,SOCK_STREAM,0
        WSAAsyncSelect(thisform.hSocket,;
                       thisform.hWnd,;
                       WM_SOCKET,;
                       51)    && FD_CONNECT or FD_READ or FD_CLOSE or FD_WRITE

        szIP  = ALLTRIM(thisform.Text1.Value)
        nPort = thisform.Text2.Value

        stSockAddr = BINTOC(2, "2RS");                   && sin_family = AF_INET
                   + BINTOC(htons(nPort), "2RS");        && sin_port
                   + BINTOC(inet_addr(@szIP), "4RS");    && sin_addr
                   + REPLICATE(0h00, 8)

        IF connect(thisform.hSocket, @stSockAddr, LEN(stSockAddr)) == -1    && SOCKET_ERROR
            IF WSAGetLastError() != 10035    && WSAEWOULDBLOCK
                thisform._WriteMsg('不能连接到IP:' + szIP + ' 端口:' + TRANSFORM(nPort))
                thisform.Release
            ENDIF
        ENDIF
    ENDPROC

    PROCEDURE Command2.Click
        LOCAL szData
        szData = ALLTRIM(thisform.Text4.Value)
        IF !EMPTY(szData)
            IF LEN(szData) > 254
                thisform._WriteMsg('发送字符数不能超过254个字符')
            ELSE
                szData = ALLTRIM(thisform.Text3.Value) + '：' + szData
                thisform._SendData(thisform.hSocket, BINTOC(3, '1RS') + szData)
            ENDIF
        ENDIF
    ENDPROC

    PROCEDURE _WriteMsg
        LPARAMETERS szMsg

        IF !EMPTY(szMsg)
            IF MEMLINES(this.Edit1.Value) > 50
                this.Edit1.Value = STUFF(this.Edit1.Value, 1, LEN(MLINE(this.Edit1.Value, 1))+2, '')
            ENDIF

            this.Edit1.Value = this.Edit1.Value + szMsg + 0h0D0A
        ELSE
            this.Edit1.Value = ''
        ENDIF

        this.Edit1.SelStart = LEN(this.Edit1.Text)
        this.Edit1.SelLength = 0
    ENDPROC

    PROCEDURE _CloseSocket
        closesocket(this.hSocket)
        this.hSocket = 0
        WSACleanup()
    ENDPROC

    * 发送数据包
    PROCEDURE _SendData
        LPARAMETERS _hSocket, szDate

        IF send(_hSocket, @szDate, LEN(szDate), 0) == -1
            IF WSAGetLastError() == 10035    && WSAEWOULDBLOCK
                this._WriteMsg('网络繁忙，请稍候发送')
            ELSE
                this._WriteMsg('发送失败')
            ENDIF
        ENDIF
    ENDPROC

    * 用户登录
    PROCEDURE _UserLogin
        LPARAMETERS _Data
        LOCAL hSocket, szID, szIP, nIP, nPort

        nIP     = CTOBIN(SUBSTR(_Data, 1, 4), '4RS')
        szIP    = SYS(2600, inet_ntoa(nIP), 16)
        szIP    = LEFT(szIP, AT(0h00, szIP)-1)
        nPort   = CTOBIN(SUBSTR(_Data, 5, 4), '4RS')
        hSocket = CTOBIN(SUBSTR(_Data, 9, 4), '4RS')
        szID    = RTRIM(RIGHT(_Data, 16))

        this.List1.AddItem(szID)
        this.List1.List[this.List1.NewIndex, 2] = szIP
        this.List1.List[this.List1.NewIndex, 3] = TRANSFORM(nPort)
        this.List1.List[this.List1.NewIndex, 4] = TRANSFORM(hSocket)
    ENDPROC

    * 用户退出
    PROCEDURE _UserExit
        LPARAMETERS _hSocket
        FOR i = 1 TO this.List1.ListCount
            IF INT(VAL(this.List1.List(i, 4))) == _hSocket
                this.List1.RemoveItem(i)
                EXIT
            ENDIF
        ENDFOR
    ENDPROC

    * 接收到数据包
    PROCEDURE _RecvData
        LPARAMETERS _hSocket
        LOCAL szReadBuf, nDataLen, nCMD

        szReadBuf = SPACE(32768)    && 32 * 1024
        nDataLen = recv(_hSocket, @szReadBuf, LEN(szReadBuf), 0)

        IF nDataLen > 0
            szReadBuf = LEFT(szReadBuf, nDataLen)
            nCMD = CTOBIN(LEFT(szReadBuf, 1), '1RS')
            szReadBuf = RIGHT(szReadBuf, nDataLen-1)

            DO CASE
            CASE nCMD == 1    && 用户登录
                this._UserLogin(szReadBuf)
            CASE nCMD == 2    && 用户退出
                this._UserExit(CTOBIN(szReadBuf, '4RS'))
            CASE nCMD == 3    && 聊天
                this._WriteMsg(szReadBuf)
            ENDCASE
        ENDIF
    ENDPROC

    * 网络消息处理
    PROCEDURE _SocketMsg
        LPARAMETERS hWnd, Msg, wParam, lParam
*this._WriteMsg(TRANSFORM(hWnd) + ', ' + TRANSFORM(Msg) + ', ' + TRANSFORM(wParam) + ', ' + TRANSFORM(lParam))
        DO CASE
        CASE lParam == 0x0008                && FD_ACCEPT
        CASE lParam == 0x0001                && FD_READ        接收读准备好的通知
            this._RecvData(wParam)
        CASE lParam == 0x0002                && FD_WRITE       接收写准备好的通知
            this._SendData(wParam, BINTOC(1, '1RS') + ALLTRIM(this.Text3.Value))
        CASE lParam == 0x0004                && FD_OOB         接收带边数据到达的通知
        CASE lParam == 0x0008                && FD_ACCEPT      接收将要连接的通知
        CASE lParam == 0x0010                && FD_CONNECT     接收已连接好的通知
            this._WriteMsg('登录成功')
        CASE lParam == 0x0020                && FD_CLOSE       接收套接口关闭的通知
            this._WriteMsg('服务器连接断开')
        CASE lParam == 0x274D0010
            this._WriteMsg('服务器端口无响应，登录失败')
        OTHERWISE
        ENDCASE
    ENDPROC

ENDDEFINE

#11

sych2024-06-15 15:59

回复 8楼 kangss

继续测试吧，同一台电脑可以成功运行并互相通讯的，我刚测试通过

[此贴子已经被作者于2024-6-15 16:00编辑过]

#12

sam_jiang2024-06-15 17:28

回复 10楼吹水佬

哈哈，谢谢

#13

sam_jiang2024-06-15 17:32

@kangss 试着修改remotehost应该就可以在本机调试，我重新修改并测试了一下，可以。

只有本站会员才能查看附件，请登录

#14

kangss2024-06-15 17:34

以下是引用sych在2024-6-15 15:59:31的发言：

继续测试吧，同一台电脑可以成功运行并互相通讯的，我刚测试通过

明白了。端口、IP在ocx里面设置的，得改改

[此贴子已经被作者于2024-6-15 18:33编辑过]

#15

thhjx2025-05-30 01:43

回复 10楼吹水佬

服务端和客户端都用VFP非常方便，JS用WebSocket连接一直显示正在连接的状态，服务端关闭，HTML会显示连接错误。

#16

sam_jiang3 天前 00:19

回复 10楼吹水佬

你当初留了句：
*SendMessage(thisform.HWnd, WM_SOCKET, 100, 200)
*!* MESSAGEBOX("这里暂不用，有需要可参考客户端示例。")

可把我愁死了，要怎么实现双向通讯呢？按你的示例只能单向通讯，最近就一直研究你的代码，以便实现双向通讯，今天总算大功告成。。。

把更改后的server代码贴上，权当狗尾续貂。。。

程序代码：

* 服务器端，socket_server.prg

_SCREEN.Visible = .t.
SET TALK OFF
SET SAFETY OFF
CLEAR

#DEFINE WM_SOCKET    0x400 + 100

DECLARE LONG WSAGetLastError IN "Ws2_32"
DECLARE LONG WSAStartup      IN "Ws2_32" LONG, STRING@
DECLARE LONG WSACleanup      IN "Ws2_32"
DECLARE LONG socket          IN "Ws2_32" LONG, LONG, LONG
DECLARE LONG closesocket     IN "Ws2_32" LONG
DECLARE LONG WSAAsyncSelect  IN "Ws2_32" LONG, LONG, LONG, LONG
DECLARE LONG bind            IN "Ws2_32" AS _bind LONG, STRING@, LONG
DECLARE LONG listen          IN "Ws2_32" LONG, LONG
DECLARE LONG accept          IN "Ws2_32" LONG, STRING@, LONG@
DECLARE LONG connect         IN "Ws2_32" LONG, STRING@, LONG
DECLARE LONG recv            IN "Ws2_32" LONG, STRING@, LONG, LONG
DECLARE LONG send            IN "Ws2_32" LONG, STRING@, LONG, LONG
DECLARE LONG inet_addr       IN "Ws2_32" STRING@
DECLARE LONG inet_ntoa       IN "Ws2_32" LONG
DECLARE SHORT htons          IN "Ws2_32" SHORT
DECLARE SHORT ntohs          IN "Ws2_32" SHORT
DECLARE LONG SendMessage    IN User32 LONG, LONG, LONG, LONG
DECLARE LONG PostMessage     IN User32 LONG, LONG, LONG, LONG

PUBLIC oForm
oForm = NEWOBJECT("Form1")
oForm.Show
_SCREEN.Visible = .T.
RETURN

DEFINE CLASS Form1 As Form
    Width = 600
    Height = 300
    Desktop = .T.
    ShowWindow = 0 &&2
    WindowType = 0 &&1
    AutoCenter = .T.
    AlwaysOnTop = .T.
    BorderStyle = 0
    caption = "socket_server"
    hSocket = 0

    Add Object Label1 As Label WITH Top = 10, Left = 10, AutoSize = .T.,;
        Caption = '本端: IP                  端口'
    Add Object Text1 As TextBox WITH Top = 6, Left = 60, Width = 100, Height = 20
    Add Object Text2 As TextBox WITH Top = 6, Left = 190, Width = 40, Height = 20, value = 9999
    Add Object Command1 As CommandButton WITH Top = 6, Left = 235, Width = 80, Height = 20,;
        Caption = '启动服务'
    Add Object Edit1 As EditBox WITH Top = 32, Left = 10, Width = 290, Height = 230
    Add Object Text3 As TextBox WITH Top = 270, Left = 10, Width = 300, Height = 20
    Add Object Command2 As CommandButton WITH Top = 270, Left = 310, Width = 80, Height = 20,;
        Caption = '发送'
    Add Object List1 As ListBox WITH Top = 32, Left = 300, Width = 290, Height = 230,;
        ColumnCount = 4,;
        ColumnLines = .F.,;
        ColumnWidths = '100,100,40,40'

    PROCEDURE Load
        ON ERROR _OnError(ERROR(), MESSAGE(), MESSAGE(1), PROGRAM(), LINENO())
    ENDPROC

    PROCEDURE Init
        LOCAL oIPs
        BINDEVENT(this.hWnd, WM_SOCKET, this, "_SocketMsg")
        oIPs = GETOBJECT('winmgmts:')
        oIPs = oIPs.InstancesOf('Win32_NetworkAdapterConfiguration')
        FOR EACH oIP IN oIPs
            IF oIP.IPEnabled
                this.Text1.Value = oIP.IPAddress[0]
                EXIT
            ENDIF
        ENDFOR
        this.AlwaysOnTop = .F.
    ENDPROC

    PROCEDURE Destroy
         this._CloseSocket()
    ENDPROC

    PROCEDURE Unload
        ON ERROR
        CLEAR EVENTS
    ENDPROC

    PROCEDURE Command1.Click
        LOCAL stWsaData, stSockAddr, szIP, nPort
        thisform._CloseSocket()
        thisform._WriteMsg('')
        thisform.List1.Clear
        stWsaData  = REPLICATE(0h00, 398)
        WSAStartup(0x202, @stWsaData)
        thisform.hSocket = socket(2, 1, 0)
        WSAAsyncSelect(thisform.hSocket, thisform.hWnd, WM_SOCKET, 8)
        szIP  = ALLTRIM(thisform.Text1.Value)
        nPort = thisform.Text2.Value
        stSockAddr = BINTOC(2, '2RS');                   && sin_family
                   + BINTOC(htons(nPort), '2RS');        && sin_port
                   + BINTOC(inet_addr(@szIP), '4RS');    && sin_addr
                   + REPLICATE(0h00, 8)
        IF _bind(thisform.hSocket, @stSockAddr, LEN(stSockAddr)) == -1
            thisform._WriteMsg('不能绑定到IP:' + szIP + ' 端口:' + TRANSFORM(nPort))
        ELSE
            thisform._WriteMsg('启动服务成功')
            listen(thisform.hSocket, 5)                  && 监听，队列限制5
        ENDIF
    ENDPROC

    PROCEDURE Command2.Click
        *SendMessage(thisform.HWnd, WM_SOCKET, 100, 200)
*!*            MESSAGEBOX("这里暂不用，有需要可参考客户端示例。")
        LOCAL szData
        szData = ALLTRIM(thisform.Text3.Value)
           IF !EMPTY(szData)
            IF LEN(szData) > 254
                thisform._WriteMsg('发送字符数不能超过254个字符')
            ELSE
                szData = ALLTRIM(thisform.Text3.Value) + '：' + szData
                thisform._SendData(thisform.hSocket, BINTOC(3, '1RS') + szData)
                thisform._writemsg("server: "+thisform.text3.value)
            ENDIF
           ENDIF
    ENDPROC

    PROCEDURE _WriteMsg
        LPARAMETERS szMsg
        IF !EMPTY(szMsg)
            IF MEMLINES(this.Edit1.Value) > 50
                this.Edit1.Value = STUFF(this.Edit1.Value, 1, LEN(MLINE(this.Edit1.Value, 1))+2, '')
            ENDIF
            this.Edit1.Value = this.Edit1.Value + szMsg + 0h0D0A
        ELSE
            this.Edit1.Value = ''
        ENDIF
        this.Edit1.SelStart = LEN(this.Edit1.Text)
        this.Edit1.SelLength = 0
    ENDPROC

    * 关闭所有Socket
    PROCEDURE _CloseSocket
        closesocket(thisform.hSocket)
        FOR i = 1 TO this.List1.ListCount
            closesocket(INT(VAL(this.List1.List(i, 4))))
        ENDFOR
        WSACleanup()
    ENDPROC

    * 添加一个客户端socket
    PROCEDURE _AddClient
        LPARAMETERS _hSocket
        LOCAL stSockAddr, nSize, nIP, szIP, nPort
        stSockAddr = REPLICATE(0h00, 16)
        nSize      = LEN(stSockAddr)
        _hSocket=accept(_hSocket, @stSockAddr, @nSize)
        WSAAsyncSelect(_hsocket, this.hWnd, WM_SOCKET, 33)  && FD_READ or FD_CLOSE
        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.List1.AddItem('')
        this.List1.List[this.List1.NewIndex, 2] = szIP
        this.List1.List[this.List1.NewIndex, 3] = TRANSFORM(nPort)
        this.List1.List[this.List1.NewIndex, 4] = TRANSFORM(_hsocket)
        this.hsocket=_hsocket &&加了这句，否则一直报错，查了很久才查出来。。。
    ENDPROC

    * 去掉一个客户端socket
    PROCEDURE _RemoveClient
        LPARAMETERS _hSocket
        LOCAL hSocket
        FOR i = 1 TO this.List1.ListCount
            IF INT(VAL(this.List1.List(i, 4))) == _hSocket
                closesocket(_hSocket)
                this.List1.RemoveItem(i)
                EXIT
            ENDIF
        ENDFOR
        FOR i = 1 TO this.List1.ListCount
            hSocket = INT(VAL(this.List1.List(i, 4)))
            this._SendData(hSocket, BINTOC(2, '1RS') + BINTOC(_hSocket, '4RS'))
        ENDFOR
    ENDPROC

    * 用户登录
    PROCEDURE _Login
        LPARAMETERS _hSocket, _szID
        LOCAL _szData, _szIP, _nPort, szData, hSocket, szID, szIP, nPort
        _szID   = PADR(_szID, 16, ' ')
        _szData = BINTOC(1, '1RS')
        FOR i = this.List1.ListCount TO 1 STEP -1
            IF INT(VAL(this.List1.List(i, 4))) == _hSocket
                this.List1.List[i, 1] = RTRIM(_szID)
                _szIP  = this.List1.List[i, 2]
                _nPort = INT(VAL(this.List1.List[i, 3]))
                _szData = _szData + BINTOC(inet_addr(@_szIP), '4RS');
                                  + BINTOC(_nPort, '4RS');
                                  + BINTOC(_hSocket, '4RS') + _szID
                EXIT
            ENDIF
        ENDFOR
        this._SendData(_hSocket, _szData)
        FOR i = 1 TO this.List1.ListCount
            hSocket = INT(VAL(this.List1.List(i, 4)))

            IF hSocket != _hSocket
                szID    = PADR(this.List1.List[i, 1], 16, ' ')
                szIP    = this.List1.List[i, 2]
                nPort   = INT(VAL(this.List1.List[i, 3]))

                szData  = BINTOC(1, '1RS');
                        + BINTOC(inet_addr(@szIP), '4RS');
                        + BINTOC(nPort, '4RS');
                        + BINTOC(hSocket, '4RS') + szID
                  this._SendData(hSocket, _szData)
                this._SendData(_hSocket, szData)
            ENDIF
        ENDFOR
    ENDPROC

    * 聊天
    PROCEDURE _Chat
        LPARAMETERS szDate
        LOCAL hSocket
        this._WriteMsg(szDate)
        FOR i = 1 TO this.List1.ListCount
            hSocket = INT(VAL(this.List1.List(i, 4)))
            this._SendData(hSocket, BINTOC(3, '1RS') + szDate)
        ENDFOR
    ENDPROC

    * 发送数据包
    PROCEDURE _SendData
        LPARAMETERS _hSocket, szDate
        IF send(_hSocket, @szDate, LEN(szDate), 0) == -1
            nerror=WSAGetLastError()
            IF nerror== 10035    && WSAEWOULDBLOCK
                this._WriteMsg('网络繁忙，请稍候发送')
            ELSE
                this._WriteMsg('发送失败')
            ENDIF
        ENDIF
    ENDPROC

    * 接收到数据包
    PROCEDURE _RecvData
        LPARAMETERS _hSocket
        LOCAL szReadBuf, nDataLen, nCMD
        szReadBuf = SPACE(32768)    && 32 * 1024
        nDataLen = recv(_hSocket, @szReadBuf, LEN(szReadBuf), 0)
        IF nDataLen > 0
            szReadBuf = LEFT(szReadBuf, nDataLen)
            nCMD      = CTOBIN(LEFT(szReadBuf, 1), '1RS')
            szReadBuf = RIGHT(szReadBuf, nDataLen-1)
            DO CASE
            CASE nCMD == 1    && 登录
                this._Login(_hSocket, szReadBuf)
                this._WriteMsg(szReadBuf + ' 登录')
            CASE nCMD == 3    && 聊天
                this._Chat(szReadBuf)
            ENDCASE
        ENDIF
    ENDPROC

    * 网络消息处理
    PROCEDURE _SocketMsg
        LPARAMETERS hWnd, Msg, wParam, lParam
        this._WriteMsg(TRANSFORM(hWnd) + ', ' + TRANSFORM(Msg) + ', ' + TRANSFORM(wParam) + ', ' + TRANSFORM(lParam))
        DO CASE
        CASE lParam == 0x0008                && FD_ACCEPT      接收将要连接的通知
            this._AddClient(wParam)
        CASE lParam == 0x0001                && FD_READ        接收读准备好的通知
            this._RecvData(wParam)
        CASE lParam == 0x0002                && FD_WRITE       接收写准备好的通知
            this._SendData(wParam, BINTOC(1, '1RS') + ALLTRIM(this.Text3.Value))
        CASE lParam == 0x0004                && FD_OOB         接收带边数据到达的通知
        CASE lParam == 0x0010                && FD_CONNECT     接收已连接好的通知
            this.connected=.t.
        CASE lParam == 0x0020                && FD_CLOSE       接收套接口关闭的通知
            this._RemoveClient(wParam)
        CASE lParam == 0x274D0010
            this._WriteMsg('远程端口无响应，登录失败')
        OTHERWISE
        ENDCASE
    ENDPROC

ENDDEFINE

FUNCTION _OnError(nErrNum, szErrMsg, szErrCode, szErrProgram, nErrLineNo)
    LOCAL szMsg, nRet
    szMsg = '错误信息: ' + szErrMsg           + 0h0D0D;
          + '错误编号: ' + TRANSFORM(nErrNum) + 0h0D0D;
          + '错误代码: ' + szErrCode          + 0h0D0D;
          + '出错程序: ' + szErrProgram       + 0h0D0D;
          + '出错行号: ' + TRANSFORM(nErrLineNo)
    nRet = MESSAGEBOX(szMsg, 2+48+512, "Error")
    DO CASE
    CASE nRet == 3            && 终止
        CANCEL
    CASE nRet == 4            && 重试
        RETRY
    ENDCASE
ENDFUNC

#17

easyppt3 天前 08:51

一端是 web，一端是VFP 这样怎么实现？
比如买家发起客服，肯定是web端吧？
公司客服，用VFP自然更加友好。

#18

吹水佬3 天前 09:55

以下是引用easyppt在2025-8-23 08:51:24的发言：

一端是 web，一端是VFP 这样怎么实现？
比如买家发起客服，肯定是web端吧？
公司客服，用VFP自然更加友好。

以前写过一个简单的示例，VFP调用windows api写的WEB服务。
写WEB服务与HTTP协议、HTML和JS等有关，涉及面较大。

#19

sam_jiang3 天前 10:48

以下是引用easyppt在2025-8-23 08:51:24的发言：

一端是 web，一端是VFP 这样怎么实现？
比如买家发起客服，肯定是web端吧？
公司客服，用VFP自然更加友好。

买家发起客服，你可以用html收集买家信息，让foxweb来处理和你的客户端通讯。在你的服务器上部署foxweb，这是foxpro编写的cgi程序，它的脚本几乎完美匹配vfp。

吹版的示例程序非常优秀，DS评价挺高，可惜让它分析为什么不能双向通讯，以及如何解决，它没有给出正确答案，我调试跟踪了很久才发现是一个小小的问题。。。

打算根据吹版的代码，百度socket所有函数，复刻一个匹敌winsocket控件的类，嘿嘿，不知道有没有时间。。。

#20

sam_jiang3 天前 11:50

加下面一段代码，可以实现server对任选一个客户端进行回复。。。

程序代码：

    *...
    PROCEDURE list1.interactivechange
        nindex=this.listindex
        thisform.hsocket=VAL(this.list(nindex,4))
    ENDPROC
    *PROCEDURE Command1.Click &&加这句之前好了

感觉还可以增加以下功能：
1，客户端之间通过server互相通讯，岂不是有QQ的感觉了。。。
2，服务端广播功能，发公共信息所有用户都能看到，就有聊天室的感觉了。。。