同一台电脑应该没问题。
广域局域网能连接就可以。
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
2024-05-19 18:02
SocketFLL20141126.rar
(129.02 KB)
winsocktest.zip