vb6 multiplayer server using playit.gg kindly assist - vb6

I am new to this. am not sure if anybody used game ranger before and I am trying to create something more simple.
client and server connection, the client connects to the server pc over the internet using the
playit.gg provided ip:port and it connects ok.
now I wonder if there is anything else needed for the game to detect other ips in-game multiplayer screen?.
I have a multi-connection server and IP vb6 source. simple using Winsock.
were you see the server:port is inputted from
.RemoteHost = "write-mechanical.at.playit.gg"
.RemotePort = "55224"
chat client side to connect
Option Explicit
Private Sub cmdConnect_Click()
'Check input.
txtServer.Text = Trim$(txtServer.Text)
txtPort.Text = Trim$(txtPort.Text)
txtNickname.Text = Trim$(txtNickname.Text)
If Len(txtServer.Text) = 0 Or Len(txtPort.Text) = 0 Or _
Len(txtNickname.Text) = 0 Then
MsgBox "Please fill in all fields!", vbCritical
Exit Sub
ElseIf Not IsNumeric(txtPort.Text) Then
MsgBox "Invalid port value!", vbCritical
Exit Sub
End If
'Done with that...
strMyNickname = txtNickname.Text
With frmChat.sckClient
.Close
bolRecon = False
.RemoteHost = txtServer.Text
.RemotePort = txtPort.Text
.Connect
End With
Me.Hide
frmChat.Show
AddStatusMessage frmChat.rtbChat, RGB(128, 128, 128), "> Connecting to " & txtServer.Text & ":" & txtPort.Text & "..."
End Sub
Private Sub txtPort_KeyPress(KeyAscii As Integer)
'Number only.
If Not IsNumeric(Chr$(KeyAscii)) And Not KeyAscii = 8 Then KeyAscii = 0
End Sub
and server-side to accept
With frmChat
.sckServer(0).Close
.sckServer(0).LocalPort = CInt(txtPort.Text)
.sckServer(0).Listen 'Opens the winsock control.
End With
Dim strNotify
Dim strPacket As String
Option Explicit
'JUST USED FOR FORM RESIZING.
Private Type RECT
rctLeft As Long
rctTop As Long
rctRight As Long
rctBottom As Long
End Type
'JUST USED FOR FORM RESIZING.
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
'JUST USED FOR FORM RESIZING.
Private udtMyRect As RECT
Private Sub sckServer_Close(Index As Integer)
sckServer(Index).Close
Dim strPacket As String
strPacket = "LEA" & Chr$(2) & udtUsers(Index).strNickname & Chr$(4)
SendGlobalData strPacket
AddUserEntersLeaves rtbChat, udtUsers(Index).strNickname, False
RemoveListItem lstUsers, udtUsers(Index).strNickname
With udtUsers(Index)
.strBuffer = vbNullString
.strIP = vbNullString
.strNickname = vbNullString
End With
End Sub
'A client is attempting to connect.
'----------------------------------
'Another computer is trying to connect to the server.
'Find a socket we can use to handle the connection.
'Then load a slot in the udtUsers() array for this user.
Private Sub sckServer_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Dim intNext As Integer
intNext = ModChat.NextOpenSocket
If intNext > 0 Then
'Found a socket to use; accept connection.
sckServer(intNext).Accept requestID
'Check if there is a slot open for this connection
'in the users array.
If UBUsers < intNext Then
'There isn't, load one.
ReDim Preserve udtUsers(intNext) As CHAT_USER
End If
'(Re)set this client's info.
With udtUsers(intNext)
.strIP = sckServer(intNext).RemoteHostIP
.strNickname = vbNullString
End With
'We haven't received the user's nickname yet.
'That will happen in the DataArrival event :)
'Once it does, we will need to let everyone know that this person joined the room.
AddStatusMessage rtbChat, RGB(0, 0, 128), "> " & sckServer(intNext).RemoteHostIP & " connected!"
End If
End Sub
Private Sub sckServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim strData As String, strPackets() As String
Dim strTrunc As String, bolTrunc As Boolean
Dim lonLoop As Long, lonTruncStart As Long
Dim lonUB As Long
'Get the received data.
sckServer(Index).GetData strData, vbString, bytesTotal
With udtUsers(Index)
'Append it to the buffer.
.strBuffer = .strBuffer & strData
strData = vbNullString
'Check if the last byte is the packet delimiter (Chr$(4)).
'If it is, there are no truncated packets.
'If it isn't, the last packet got split up. >:(
If Right$(.strBuffer, 1) <> Chr$(4) Then
'Get all data to the right of the last Chr$(4) which is the truncated packet.
bolTrunc = True
'Find position of last packet delimiter.
lonTruncStart = InStrRev(.strBuffer, Chr$(4))
'Check if it was found.
If lonTruncStart > 0 Then
'Extract out the truncated part.
strTrunc = Mid$(.strBuffer, lonTruncStart + 1)
End If
End If
'We checked if the data was truncated.
'If it was, we put that part away for now and set the Truncated flag to TRUE (bolTrunc).
'Split up the data buffer into individual packets
'in case we received more than 1 at a time.
'Process them individually.
If InStr(1, .strBuffer, Chr$(4)) > 0 Then
strPackets() = Split(.strBuffer, Chr$(4))
'Now all of the individual packets are in strPackets().
'Loop through all of them.
lonUB = UBound(strPackets) 'Get number of packets.
'If the data is truncated, don't process the last one
'because it isn't complete.
If bolTrunc Then lonUB = lonUB - 1
'Start looping through all packets.
For lonLoop = 0 To lonUB
'Check length of packet.
'Each packet has a command/header,
'the packet must be at least that length.
'In this example, all headers are 3 bytes/characters long.
If Len(strPackets(lonLoop)) > 3 Then
'Look at the header and process the packet accordingly.
Select Case Left$(strPackets(lonLoop), 3)
'Packet is a chat message.
Case "MSG"
'Process message.
ParseChatMessage Index, strPackets(lonLoop)
'User is connecting (sending nickname).
Case "CON"
'Process connection.
ParseConnection Index, strPackets(lonLoop)
'Add your own here! :)
'Case "XXX"
'Do something.
'Case "YYY"
'Do something.
End Select
End If
Next lonLoop
End If
'We're done processing all packets.
Erase strPackets
'Now we can erase all the data we just processed from the buffer.
'Otherwise, it will just keep growing in size and the same data
'will be processed over and over (which might actually be kinda cool?).
.strBuffer = vbNullString
If bolTrunc Then
'Still have a piece of a packet left over because the data was truncated.
'Erase the buffer then put just the truncated part back in.
.strBuffer = strTrunc
End If
strTrunc = vbNullString
End With
End Sub
just a quote from my comment laying out what I want to do.
the server is in my computer running and they connect to me from
another house over the internet using the ip and port provided by
playitt.gg ok so now that i know they are connected to my machine via
the server app. now i want to know is will multiplayer games be able
to detect those ips even we got same game same version installed

Related

VB6 winsock server and multiple arduino clients issue

Right now i am developing a tool that will allow me to measure the delay between network connections using VB6 and a arduino UNO with ethernet shield.
Now i am facing some issues with the Server code (the VB6 program).
I have 2 winsocks with both different ports and they are both listening for the arduino client to connect. Now if i have only one active connection nothing goes wrong and everything works fine, but as soon as the second client connects the entire server starts going crazy. Suddenly it reports that the first client that connected lost it connection, so in short the server just doesn't want 2 clients connected at a time but i really do need it :/ What is going wrong?
I'll quickly explain what sertain command do that are send over the winsock to or from the server.
"SERVER_SLEEP" Is a command that the server sends to all clients that will tell them to enter a power saving mode.
"SERVER_REQUESTS_DATA" Is a command that the server sends to a specific client and forces the client to send information like Device name and firmware version.
"RESPOND_MESSAGE" Is a command that the server sends to all clients and the client is forced to respond to see if we still have an connection.
"DEVICE_NAME=" Is a command that the client sends to the server when it just connects, It is required before we show that we have an connection by putting it into the listbox. (after the = comes the device name)
"DEVICE_NAME_REP=" Is a command that the client sends to the server when the server requests information about the client, the reason i have 2 of them is because i couldn't reuse the previous one since then it would become way to complicated. (after the = comes the device name)
"DEVICE_FIRMWARE=" Is a command that the client sends to the server when the server requests information about the client. (after the = comes the device firmware version)
"DEVICE_OK=" Is a command that the client sends to the server when the server requests an answer to check if we still have an connection. (after the = comes the device name)
"DEVICE_REBOOTING" Is a command that the client sends to the server when it goes out of sleep mode (it goes out of that mode when the server comes back online again after it was closed) After the client send that message it immediately closes the connection again and the device is forced to reboot to make sure nothing goes wrong.
My code:
Dim DeviceIP1 As String
Dim DeviceIP2 As String
Dim UpdateListStatus As Integer
Private Sub Command1_Click()
MsgBox Socket1.State
MsgBox Socket2.State
End Sub
Private Sub Command3_Click()
If Dir(App.Path & "\TH.exe") <> "" Then 'Traceroute Helper application i wrote before, Works 100% and is not relevant for the issue i am facing
Shell App.Path & "\TH.exe " & DeviceIP, vbNormalFocus
Else
MsgBox "Missing file!" & vbNewLine & "File TH.exe is required for the requested operation!", vbCritical + vbSystemModal, "Missing file"
End If
End Sub
Private Sub Form_Load()
Socket1.Listen
Socket2.Listen
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim msg As VbMsgBoxResult
msg = MsgBox("Are you sure you want to exit?" & vbNewLine & "All the clients will be put into sleep mode.", vbYesNo + vbQuestion + vbSystemModal, "Quit")
If msg = vbYes Then
Form3.Show
Cancel = True
Form1.Visible = False
Else
Cancel = True
End If
End Sub
Private Sub List1_Click()
On Error GoTo errhandler
Dim ClientFound As Boolean
DeviceIP = Mid(List1.Text, InStr(List1.Text, "-") + 1)
DeviceIP = LTrim(DeviceIP)
DeviceIPLabel.Caption = "Device IP: " & DeviceIP
Form2.Show
If Socket1.RemoteHostIP = DeviceIP Then
Socket1.SendData ("SERVER_REQUESTS_DATA")
ElseIf Socket2.RemoteHostIP = DeviceIP Then
Socket2.SendData ("SERVER_REQUESTS_DATA")
End If
Exit Sub
errhandler:
If Err.Number = 40006 Then
MsgBox "Socket error!" & vbNewLine & "The requested device might be offline.", vbCritical + vbSystemModal, "Socket error"
Unload Form2
End If
End Sub
Private Sub UpdateList_Timer()
On Error Resume Next
If List1.ListCount > 0 Then
If UpdateListStatus = 0 Then
TempList.Clear
Socket1.SendData ("RESPOND_MESSAGE")
Socket2.SendData ("RESPOND_MESSAGE")
UpdateListStatus = 1
UpdateList.Interval = 5000
ElseIf UpdateListStatus = 1 Then
List1.Clear
For x = 0 To TempList.ListCount
List1.AddItem (TempList.List(x))
Next x
For X2 = 0 To List1.ListCount
If List1.List(X2) = "" Then 'Check if we have any items that are nothing
List1.RemoveItem (X2)
End If
Next X2
Label1.Caption = "Connected clients: " & List1.ListCount
UpdateListStatus = 0
UpdateList.Interval = 10000
End If
End If
End Sub
Private Sub Socket1_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
Dim TempString As String
Dim TempString2 As String
Dim position As Integer
Socket1.GetData TempString, vbString
position = InStr(1, TempString, "DEVICE_NAME=")
If position > 0 Then 'It is a device name command from a client
TempString2 = Mid(TempString, InStr(TempString, "=") + 1)
List1.AddItem (TempString2 + " - " + Socket1.RemoteHostIP)
Label1.Caption = "Connected clients: " & List1.ListCount
TempString2 = ""
End If
position = 0
position = InStr(1, TempString, "DEVICE_NAME_REP=")
If position > 0 Then 'It is a device name command from a client
TempString2 = Mid(TempString, InStr(TempString, "=") + 1)
DeviceNameLabel.Caption = "Device name: " & TempString2
TempString2 = ""
End If
position = 0
position = InStr(1, TempString, "DEVICE_FIRMWARE=")
If position > 0 Then 'It is a device firmware command from a client
TempString2 = Mid(TempString, InStr(TempString, "=") + 1)
DeviceFirmwareLabel.Caption = "Firmware version: " & TempString2
Unload Form2 'Since this is the last piece we will be receiving we can close this window
TempString2 = ""
End If
position = 0
position = InStr(1, TempString, "DEVICE_OK=")
If position > 0 Then 'It is a device respond command from a client
TempString2 = Mid(TempString, InStr(TempString, "=") + 1)
TempList.AddItem (TempString2 + " - " + Socket1.RemoteHostIP)
Label1.Caption = "Connected clients: " & List1.ListCount
TempString2 = ""
End If
position = 0
position = InStr(1, TempString, "DEVICE_REBOOTING")
If position > 0 Then 'It is a device respond command from a client
Socket1.Close
TempString2 = ""
End If
Text1.Text = Text1.Text & TempString & vbNewLine
TempString = ""
position = 0
TempString2 = ""
End Sub
Private Sub Socket2_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
Dim TempString As String
Dim TempString2 As String
Dim position As Integer
Socket2.GetData TempString, vbString
position = InStr(1, TempString, "DEVICE_NAME=")
If position > 0 Then 'It is a device name command from a client
TempString2 = Mid(TempString, InStr(TempString, "=") + 1)
List1.AddItem (TempString2 + " - " + Socket2.RemoteHostIP)
Label1.Caption = "Connected clients: " & List1.ListCount
TempString2 = ""
End If
position = 0
position = InStr(1, TempString, "DEVICE_NAME_REP=")
If position > 0 Then 'It is a device name command from a client
TempString2 = Mid(TempString, InStr(TempString, "=") + 1)
DeviceNameLabel.Caption = "Device name: " & TempString2
TempString2 = ""
End If
position = 0
position = InStr(1, TempString, "DEVICE_FIRMWARE=")
If position > 0 Then 'It is a device firmware command from a client
TempString2 = Mid(TempString, InStr(TempString, "=") + 1)
DeviceFirmwareLabel.Caption = "Firmware version: " & TempString2
Unload Form2 'Since this is the last piece we will be receiving we can close this window
TempString2 = ""
End If
position = 0
position = InStr(1, TempString, "DEVICE_OK=")
If position > 0 Then 'It is a device respond command from a client
TempString2 = Mid(TempString, InStr(TempString, "=") + 1)
TempList.AddItem (TempString2 + " - " + Socket2.RemoteHostIP)
Label1.Caption = "Connected clients: " & List1.ListCount
TempString2 = ""
End If
position = 0
position = InStr(1, TempString, "DEVICE_REBOOTING")
If position > 0 Then 'It is a device respond command from a client
Socket2.Close
TempString2 = ""
End If
Text1.Text = Text1.Text & TempString & vbNewLine
TempString = ""
position = 0
TempString2 = ""
End Sub
Private Sub Socket1_ConnectionRequest(ByVal requestID As Long)
If Socket1.State <> sckClosed Then
Socket1.Close
' Accept the request with the requestID
' parameter.
Socket1.Accept requestID
End If
End Sub
Private Sub Socket2_ConnectionRequest(ByVal requestID As Long)
If Socket2.State <> sckClosed Then
Socket2.Close
Socket2.Accept requestID 'Allow the connection
End If
End Sub
`
There's a lot there to dig through (You probably want to try to create a MCVE of the problem just to make your own debugging easier), but at first glance those ConnectionRequest event handlers seem suspect to me. The Winsock Control ConnectionRequest Event documentation says to "Use the Accept method (on a new control instance) to accept an incoming connection." You're trying to somehow use the same control instance, which maybe there's a way to do but isn't the standard approach.
If memory serves (it's been forever since I've dealt with this), you want to create a Control Array of Winsock Controls, and load a new instance at run time to handle each new connection (and unload it when the connection is complete). The "listening" control and the "handling a current connection" control need to be different instances. That way, each instance handles its own connection with its own state, and the listener is available to handle any new incoming connections.
Okay so i was able to find a very good example code for a multi-client server
And also i was able to figure out that the time out delay i created was WAY too short so that was why it was disappearing from the list. Sometimes it takes 10 seconds to receive a response and the time out was set to only 5 seconds MAX.
But still thanks for trying to help me :)
The link to the example code :LINK

Warn before sending Outlook message

My Outlook Address book by default storing e-mail addresses in the combination of upper and lower case letters, in that case below code is not working for me. Please advise.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim Recipients As Outlook.Recipients
Dim recip As Outlook.Recipient
Dim i
Dim prompt As String
On Error Resume Next
' use lower case for the address
' LCase converts all addresses in the To field to lower case
Checklist = "firstname.lastname#domain.com"
Set Recipients = Item.Recipients
For i = Recipients.Count To 1 Step -1
Set recip = Recipients.Item(i)
If InStr(LCase(recip), LCase(Checklist)) Then
prompt$ = "You sending this to this messgae to Treasurer " & Item.To & ". Are you sure you want to send it?"
If MsgBox(prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check Address") = vbNo Then
Cancel = True
End If
End If
Next i
End Sub

Sending data to device via MS Comm VB6

I need to send a file to some electronic device and execute it.
I couldn't find any information online regarding MS Comms and I didn't find Documentation on the Microsoft (https://msdn.microsoft.com/en-us/library/aa231237(v=vs.60).aspx) any useful :
' Send Byte array data
MSComm1.Output = Out
Would be great if you guys could give me some pointers and help me to solve my problem. The problem that I am experiencing is an infinite loop at Loop Until MSComm1.OutBufferCount = 0, when I return "MSComm1.OutBufferCount" between Do and Loop "MSComm1.OutBufferCount" is 0 and files dont seem to be sent over to the device.
Closest function I got to at the present moment is below:
Function SendFile(tmp$)
Dim temp$
Dim hsend, bsize, LF&
' Open file
Open tmp$ For Binary Access Read As #2
' Check size on Mscomm1 OutBuffer
bsize = MSComm1.OutBufferSize
' Check file length
LF& = LOF(2)
' This code makes tiny pieces of data (Buffer sized)
' And send's it
Do Until EOF(2)
If LF& - Loc(2) <= bsize Then
bsize = LF& - Loc(2) + 1
End If
' Make room for some data
temp$ = Space$(bsize)
' Put the data piece in the Temp$ string
Get #2, , temp$
MSComm1.Output = temp$
Do
' Wait until the buffer is empty
Loop Until MSComm1.OutBufferCount = 0
Loop
' close file
Close #2
End Function
Have a look at the RThreshold and SThreshold properties
Below is a simple example project :
'1 form with :
' 1 label control : name=Label1
' 1 textbox control : name=Text1
' 1 command button : name=Command1
Option Explicit
Private Sub Command1_Click()
'send command
MSComm1.Output = Text1.Text & vbCr
End Sub
Private Sub Form_Load()
'config mscomm control and open connection
With MSComm1
.Settings = "9600,N,8,1"
.RThreshold = 1
.SThreshold = 0
.CommPort = 1
.PortOpen = True
End With 'MSComm1
End Sub
Private Sub Form_Resize()
'position controls
Dim sngWidth As Single, sngHeight As Single
Dim sngCmdWidth As Single, sngCmdHeight As Single
Dim sngTxtWidth As Single
Dim sngLblHeight As Single
sngWidth = ScaleWidth
sngHeight = ScaleHeight
sngCmdWidth = 1215
sngCmdHeight = 495
sngLblHeight = sngHeight - sngCmdHeight
sngTxtWidth = sngWidth - sngCmdWidth
Label1.Move 0, 0, sngWidth, sngLblHeight
Text1.Move 0, sngLblHeight, sngTxtWidth, sngCmdHeight
Command1.Move sngTxtWidth, sngLblHeight, sngCmdWidth, sngCmdHeight
End Sub
Private Sub MSComm1_OnComm()
'process received data
Dim strInput As String
Select Case MSComm1.CommEvent
Case comEvReceive
strInput = MSComm1.Input
Label1.Caption = Label1.Caption & strInput
End Select
End Sub
In Command1_Click I add a carriage return to the command from Text1 as most devices require the command to be finished by that
In MSComm1_OnComm I just print the received data to the label, but you might want to add the received data to a global variable, and then process the contents of that variable, as all data might not be received at once

Not receiving reply from syringe pump via rs232 using MSComm1.Input

I am trying to communicate with the syringe pump from PC through rs232.
I want to send a string "02DC;50803" to the pump for establishing the communication and pump should reply "C".
I am using MSComm1.Output="02DC;50803" to send the command and Text1.Text=Text1.Text+MSComm1.Input for receiving. When MSComm1.Output executes I am able to see a LED blinking on the end device but there is no reply using MSComm1.input.
Please help me out with this problem and if I put these instruction under MSComm() control, it seems to be dead.
There could be a number of problems here.
For example:
your cable could be broken
your serial port may not be functioning - I see that a lot
Your command is malformed
the pump simply doesn't expect to reply to the command you are sending
Those last 2 might be unlikely, the pump will probably reply to everything you fire at it - all the ones I have here sure answer back.
Really need a lot more information to help you.
What make/model pump?
Manual for the pump so that your commands can be checked.
Have you connected to the pump with an existing software package? - if there is one.
P.S. My software won't support your pump; I don't recognize those commands.
To continue the list from timb:
Are you using the correct baudrate?
What are the settings of .RThreshold and .SThreshold?
Are the other comport settings correct (usually N,8,1 but there are exceptions)?
Did you try the command using hyperterminal and get the expected reply?
Where in your code do you read MSComm1.Input? in Which event?
Does the device have a led as well which blinks it is when sending data? does it blink?
Does the command need an end-char like vbCrLf or vbCr of anything else?
Please post the complete code of the function/sub where you send the command, and please post the complete code of the function/sub where you read MSCOmm1.Input
Have a look at the following testproject in which I send the "AT" command to my modem which is connected to commport 1 and with which I communicate at baudrate 9600:
'1 form with:
' 1 textbox control : name=Text1
' 1 command button : name=Command1
' 1 MSComm control : name=MSComm1
Option Explicit
Private Sub Command1_Click()
MSComm1.Output = "at" & vbCrLf
End Sub
Private Sub Form_Load()
With MSComm1
If .PortOpen Then .PortOpen = False
.Settings = "9600,n,8,1"
.CommPort = 1
.RThreshold = 1 'read data per char
.SThreshold = 0 'send all data at once
.PortOpen = True
End With 'MSComm1
End Sub
Private Sub Form_Resize()
Dim sngWidth As Single
Dim sngCmdHeight As Single
Dim sngTxtHeight As Single
sngWidth = ScaleWidth
sngCmdHeight = 315
sngTxtHeight = ScaleHeight - sngCmdHeight
Text1.Move 0, 0, sngWidth, sngTxtHeight
Command1.Move 0, sngTxtHeight, sngWidth, sngCmdHeight
End Sub
Private Sub MSComm1_OnComm()
Dim strData As String
With MSComm1
Select Case .CommEvent
Case comEvReceive
strData = .Input
ShowData strData
End Select
End With 'MSComm1
End Sub
Private Sub ShowData(strData As String)
With Text1
.SelStart = Len(.Text)
.SelText = strData
End With 'Text1
End Sub
When I click on Command1 it will send "AT" & vbCrLf and the modem replies with "OK" which is shown in Text1.

Need to add functionality in winsock control

I'm creating a application which include client & proxy server application.Both application uses winsock control.I 'm connecting client to the server by using IP address.I'm having problem with server application.It only shows the internal IP address which I don't want,what I want is external IP address i.e.Wan IP address.Is it possible with winsock?If you have a sample code please provide.Also I need one functionality server which will choose client connected to the server in list box & it will disconnect that client from the server..Please provide code.Also Once Connected to Server, If user use Internet, or any other programs, IP will show as Server's IP (Like Proxy Server).
Here is the code for the server.
Option Explicit
Dim iSockets As Integer
Dim sServerMsg As String
Dim sRequestID As String
Private Sub Form_Load()
Form1.Show
lblHostID.Caption = Socket(0).LocalHostName
lblAddress.Caption = Socket(0).LocalIP
Socket(0).LocalPort = 1007
sServerMsg = "Listening to port: " & Socket(0).LocalPort
List1.AddItem (sServerMsg)
Socket(0).Listen
End Sub
Private Sub socket_Close(Index As Integer)
sServerMsg = "Connection closed: " & Socket(Index).RemoteHostIP
List1.AddItem (sServerMsg)
Socket(Index).Close
Unload Socket(Index)
iSockets = iSockets - 1
lblConnections.Caption = iSockets
End Sub
Private Sub socket_ConnectionRequest(Index As Integer, ByVal requestID As Long)
sServerMsg = "Connection request id " & requestID & " from " & Socket(Index).RemoteHostIP
If Index = 0 Then
List1.AddItem (sServerMsg)
sRequestID = requestID
iSockets = iSockets + 1
lblConnections.Caption = iSockets
Load Socket(iSockets)
Socket(iSockets).LocalPort = 1007
Socket(iSockets).Accept requestID
End If
End Sub
I use the following code to show which clients are connected to my server
Private Sub wskServer_ConnectionRequest(ByVal requestID As Long)
With wskServer
If .State <> sckClosed Then
.Close
End If
.Accept requestID
ShowData "Connection from " & .RemoteHostIP & vbCrLf, True, vbBlack
End With 'wskServer
End Sub
In my case the showdata function shows the text in a monitoring form, but you might write the text to file or a simple msgbox

Resources