исходный код сервера.
Option Explicit
Private strBuffer() As String
Private strClient() As String
Private Sub cmdSendAll_Click()
'
' Send the contents of txtToSend to all connected clients
' Make sure there's something to send
' Only send to those clients that are currently connected
'
Dim intI As Integer
If txtToSend.Text <> "" Then
If lstClients.ListCount > 0 Then
For intI = 1 To ws.UBound
If ws(intI).State = sckConnected Then
ws(intI).SendData txtToSend & vbCrLf
End If
Next intI
End If
End If
End Sub
Private Sub cmdSendSingle_Click()
'
' Send to one or more clients as selected from the ListBox
' Make sure there's something to send
' Only send if the client is still connected (it's possible that a given client
' may be disconnecting at the time we send something to them)
' The ItemData of the selected item is the Index of the Winsock control
'
Dim intI As Integer
If txtToSend.Text <> "" Then
If lstClients.SelCount > 0 Then
For intI = 0 To lstClients.ListCount - 1
If lstClients.Selected(intI) Then
If ws(lstClients.ItemData(intI)).State = sckConnected Then
ws(lstClients.ItemData(intI)).SendData txtToSend.Text & vbCrLf
End If
End If
Next intI
End If
End If
End Sub
Private Sub Form_Load()
Me.Caption = "Simple Server - Multiple Connections"
txtReceived.Text = ""
txtToSend.Text = ""
lstClients.Clear
ws(0).LocalPort = 40001
ws(0).Listen
End Sub
Private Sub ws_Close(Index As Integer)
'
' Client has disconnected
' Close the Socket
' Remove this client from the ListBox
'
Dim intCount As Integer
ws(Index).Close
txtReceived.Text = txtReceived.Text & "Connection to " & strClient(Index) & " has been closed" & vbCrLf
intCount = lstClients.ListCount - 1
Do
If strClient(Index) = lstClients.List(intCount) Then
lstClients.RemoveItem intCount
Else
intCount = intCount - 1
Label1.Caption = Label1.Caption - 1
End If
Loop Until intCount < 0
End Sub
Private Sub ws_ConnectionRequest(Index As Integer, ByVal requestID As Long)
'
' Something has requested connection
' Check if there's a free socket, if there is, then use the first free one
' Otherwise create a new socket, buffer and client name array for this client
' Flush the buffer and Client Name
' Accept the request
'
Dim intCount As Integer
Dim boFound As Boolean
Do
If ws(intCount).State = sckClosed Then
boFound = True
Else
intCount = intCount + 1
End If
Loop Until intCount > ws.UBound Or boFound = True
If Not boFound Then
Load ws(intCount)
ReDim Preserve strBuffer(intCount)
ReDim Preserve strClient(intCount)
End If
Label1.Caption = Label1.Caption + 1
strBuffer(intCount) = ""
strClient(intCount) = ""
ws(intCount).Accept requestID
txtReceived.Text = txtReceived.Text & "Connection to " & ws(intCount).RemoteHostIP & "Accepted" & vbCrLf
End Sub
Private Sub ws_DataArrival(Index As Integer, ByVal bytesTotal As Long)
'
' Something has sent some data (Index is the socket number)
' Read the data and append it to the buffer for this socket
' Check if a full record has been received (ie the vbCrLf)
' If it has then process the record
' If not then exit and wait for the next data from this (or any other) socket
'
Dim strData As String
Dim strReceived As String
Dim strCmd() As String
Dim intPos As Integer
Dim boComplete As Boolean
ws(Index).GetData strData
strBuffer(Index) = strBuffer(Index) & strData
Do
intPos = InStr(strBuffer(Index), vbCrLf)
If intPos > 0 Then
strReceived = Mid$(strBuffer(Index), 1, intPos - 1)
'
' Check if the Client is sending their ID (indicated by a Chr(255) as the first byte)
' If it is, then add it to the client name array and the listbox
' Save this client's winsock Index value in the ItemData
' (it will be needed when sending data to a specific client))
' Otherwise just display what's been sent to the Output textbox
'
Select Case Mid(strReceived, 1, 1)
Case Chr(255)
strCmd = Split(strReceived, ",")
strClient(Index) = strCmd(1)
lstClients.AddItem strClient(Index)
lstClients.ItemData(lstClients.NewIndex) = Index
Case Else
txtReceived.Text = txtReceived.Text & "Received from " & strClient(Index) & ":" & strReceived & vbCrLf
End Select
'
' Check if there's anything else in the buffer
' if there is then process it
' otherwise flush the buffer and exit
'
If intPos + 1 < Len(strBuffer(Index)) Then
strBuffer(Index) = Mid$(strBuffer(Index), intPos + 2)
Else
strBuffer(Index) = ""
boComplete = True
End If
Else
boComplete = True
End If
Loop Until boComplete = True
End Sub
Private Sub ws_SendComplete(Index As Integer)
'
' Update the output with the Data sent
'
If txtToSend.Text <> "" Then
txtReceived.Text = txtReceived.Text & "Sent to " & strClient(Index) & ":" & txtToSend.Text & vbCrLf
End If
End Sub
исходный код клиента
Option Explicit
Private Sub cmdClose_Click()
'
' Close the connection to the server
' set the CommandButtons so that only cmdConnect can be clicked
'
ws.Close
cmdSend.Enabled = False
cmdClose.Enabled = False
cmdConnect.Enabled = True
txtReceived.Text = txtReceived.Text & "Connection Closed by Client" & vbCrLf
End Sub
Private Sub cmdConnect_Click()
ws.Close '
' Connect to the server
'
If txtServer.Text <> "" Then
If txtPort.Text <> "" Then
If txtName.Text <> "" Then
ws.RemoteHost = txtServer.Text
ws.RemotePort = txtPort
ws.LocalPort = 0
ws.Connect
Else
MsgBox "Please enter a Client Name"
End If
Else
MsgBox "Please enter a Port Number"
End If
Else
MsgBox "Please enter a Server Name / Address"
End If
End Sub
Private Sub cmdSend_Click()
'
' Check that there's something to send, if there is then send it
'
If txtToSend.Text <> "" Then
ws.SendData txtToSend.Text & vbCrLf
End If
End Sub
Private Sub Form_Load()
Me.Caption = "Simple Client"
txtReceived.Text = ""
txtToSend.Text = ""
cmdSend.Enabled = False
cmdClose.Enabled = False
End Sub
Private Sub txtServer_DblClick()
txtServer.Text = ""
End Sub
Private Sub ws_Close()
'
' Server has closed the connection
' close the socket
'
ws.Close
txtReceived.Text = txtReceived.Text & "Connection Closed by Server" & vbCrLf
End Sub
Private Sub ws_Connect()
'
' Successfully connected to the server
' send it our ID
' disable the Connect CommandButton
' enable the Send and Close CommandButtons
'
txtReceived.Text = txtReceived.Text & "Connected to " & ws.RemoteHostIP & vbCrLf
ws.SendData Chr(255) & "," & txtName.Text & vbCrLf
cmdConnect.Enabled = False
cmdSend.Enabled = True
cmdClose.Enabled = True
End Sub
Private Sub ws_DataArrival(ByVal bytesTotal As Long)
'
' Something has arrived from the server
' Read the data and append it to the buffer
' Check if a full record has been received (ie the vbCrLf)
' If it has then process the record
' If not then exit and wait for the next portion of data
'
Static strBuffer As String
Dim strData As String
Dim strReceived As String
Dim intPos As Integer
Dim boComplete As Boolean
ws.GetData strData
strBuffer = strBuffer & strData
Do
intPos = InStr(strBuffer, vbCrLf)
If intPos > 0 Then
strReceived = Mid$(strBuffer, 1, intPos - 1)
txtReceived.Text = txtReceived.Text & "Received:" & strReceived & vbCrLf
If intPos + 1 < Len(strBuffer) Then
strBuffer = Mid(strBuffer, intPos + 2)
Else
strBuffer = ""
boComplete = True
End If
Else
boComplete = True
End If
Loop Until boComplete = True
End Sub
Private Sub ws_SendComplete()
'
' If data was sent then update the Output textbox
'
If txtToSend.Text <> "" Then
txtReceived.Text = txtReceived.Text & "Sent: " & txtToSend.Text & vbCrLf
txtToSend.Text = ""
End If
End Sub
txtServer.text = "amarz1.serveirc.com"
txtPort.text = "40001"
txtName.text = "client1"
Когда я запускаю server.exe, я могу получить друзей из сети, чтобы подключиться ко мне, используя этот noip.org или сетевой адрес, какие другие варианты мне нужно сделать? настроить сервер так, чтобы в любое время люди могли использовать клиент для входа без необходимости запуска server.exe, я новичок в этом, я действительно хочу узнать больше об этом.
я пытаюсь настроить сервер в любое времялюди могут просто использовать клиент и войти в систему и войти в чат
если я нахожусь в автономном режиме, то ни один из них не может подключиться, наоборот, я не могу подключиться к ним, если они не настроили учетную запись noip.