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

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

哈哈，谢谢

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

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

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

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

你当初留了句：
        *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

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

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

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

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

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

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

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

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