Show IP and Pingtime in Serverwindow + /ping command + client to server ping btn

[RetroX]

_Tyr made a few suggestions so i edited away. This topic contains now more snippets. Changed title also_
**Index

- IP and Pingtime shown on server
- Clientbutton to check own ping to server
- /Ping username, to check ingame pingresponses.
- treshold (when ping > 500ms the client refuses to connect) - to prevent lag.**

I got a few free days so i am trying out some stuff. Here is my very first 'snippet'. Tell me what you think of it.

disclaimer: the mainmodule (ping/icmp) is Microsofts sollution for ping commands in VB6\. The code is copied and i cleaned it a bit but probably needs some more cleaning. It works, thats the most importent part ;)

This is how it should look:

Step 1:
Open the **frmServer**  by form and Add a button (call the button **btnRefresh**)

Step 2:
Click in the form on the tab "Players" and rightclick on the field that is called **lvUsers**.
Go to the tab "Colum Headers" (see screenshot above) and use the arrows to set the index to the highest number possible (standard its 5 i think).
Click on **Insert Colum** and with text enter 'IP'.
Make second colum and call it 'Ping (ms)'

Step 3:
in **modGameLogic** find the sub: _Public Sub ShowPLR(ByVal Index As Long)_
in this sub there is a line:        _LS.SubItems(5) = GetPlayerAccess(Index)_

add the follow code under this line:
```
LS.SubItems(6) = GetPlayerIP(Index)
LS.SubItems(7) = PingPong(GetPlayerIP(Index))

```

Step 4:
Find the next Sub: _Public Sub RemovePLR(ByVal Index As Long)_
below the line: _LS.SubItems(5) = vbNullString_
add:
```
LS.SubItems(6) = vbNullString
LS.SubItems(7) = vbNullString

``` 

Step 5:
Add the follow code to **frmServer**
Doesnt matter where but i suggest at the bottem.
```
Private Sub btnRefresh_Click()          'Refresh
    Dim I As Long
    lvUsers.ListItems.Clear

    For I = 1 To MAX_PLAYERS
        Call ShowPLR(I)
    Next I
End Sub

```
step 6:
Add the following code to **modServerTCP**.
Just place it anywhere (i suggest at the bottem)

```
Function PingPong(ByVal strIPAddress As String) As Integer          'GWO - PING Routine
  Dim Reply As ICMP_ECHO_REPLY
  Dim lngSuccess As Long
  Dim T As Integer

  'Get the sockets ready.
  If Ping.SocketsInitialize() Then

    'Ping the IP that is passing the address and get a reply.
    lngSuccess = Ping.Ping(strIPAddress, Reply)

    'Display the results. (why this way, i dont know yet)
    T = Reply.RoundTripTime

    'Clean up the sockets.
    Ping.SocketsCleanup

    'Tranfer Values
    PingPong = T

  End If
End Function

```

Step 7 (Last step with a big part of code)
Add a new module (in VB go to "Project" then "Add Module")
In the project-overview (that tree thingy) rightclick and open its properties.
Name the new module:  **ping**

copy the code below into the new empty module:
```
Option Explicit

'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::
':: This class is MicroSofts basic solution for Ping commands in VB6
':: Class with Function adjusted for Eclipse by RetroX
':: - parts that felt same to remove are already removed.
'::  This part could use dome more stripping, feel free to do so!
'::
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

'Icmp constants converted from
Private Const ICMP_SUCCESS As Long = 0
Public Const WINSOCK_ERROR = "Windows Sockets not responding correctly."
Public Const INADDR_NONE As Long = &HFFFFFFFF
Public Const WSA_SUCCESS = 0
Public Const WS_VERSION_REQD As Long = &H101

'Clean up sockets.
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long

'Open the socket connection.
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long

'Create a handle on which Internet Control Message Protocol (ICMP) requests can be issued.
Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long

'Convert a string that contains an (Ipv4) Internet Protocol dotted address into a correct address.
Private Declare Function inet_addr Lib "WSOCK32.DLL" (ByVal cp As String) As Long

'Close an Internet Control Message Protocol (ICMP) handle that IcmpCreateFile opens.
Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal IcmpHandle As Long) As Long

'Information about the Windows Sockets implementation
Private Type WSADATA
  wVersion As Integer
  wHighVersion As Integer
  szDescription(0 To 256) As Byte
  szSystemStatus(0 To 128) As Byte
  iMaxSockets As Long
  iMaxUDPDG As Long
  lpVendorInfo As Long
End Type

'Send an Internet Control Message Protocol (ICMP) echo request, and then return one or more replies.
Private Declare Function IcmpSendEcho Lib "icmp.dll" _
  (ByVal IcmpHandle As Long, _
    ByVal DestinationAddress As Long, _
    ByVal RequestData As String, _
    ByVal RequestSize As Long, _
    ByVal RequestOptions As Long, _
    ReplyBuffer As ICMP_ECHO_REPLY, _
    ByVal ReplySize As Long, _
    ByVal Timeout As Long) As Long

'This structure describes the options that will be included in the header of an IP packet.
Private Type IP_OPTION_INFORMATION
  Ttl            As Byte
  Tos            As Byte
  Flags          As Byte
  OptionsSize    As Byte
  OptionsData    As Long
End Type

'This structure describes the data that is returned in response to an echo request.
Public Type ICMP_ECHO_REPLY
  address        As Long
  Status          As Long
  RoundTripTime  As Long
  DataSize        As Long
  Reserved        As Integer
  ptrData                As Long
  Options        As IP_OPTION_INFORMATION
  Data            As String * 250
End Type

'-- Ping a string representation of an IP address.
' -- Return a reply.
' -- Return long code.
Public Function Ping(sAddress As String, Reply As ICMP_ECHO_REPLY) As Long

Dim hIcmp As Long
Dim lAddress As Long
Dim lTimeOut As Long
Dim StringToSend As String

'Short string of data to send
StringToSend = "eclipse"            '::: Just for fun changed from "hello" to "eclipse"

'ICMP (ping) timeout
lTimeOut = 500 'ms                  '::: Original 1000ms - i think eventualy 250ms (=1/4 sec) should be enough

'Convert string address to a long representation.
lAddress = inet_addr(sAddress)

If (lAddress <> -1) And (lAddress <> 0) Then

    'Create the handle for ICMP requests.
    hIcmp = IcmpCreateFile()

    If hIcmp Then
        'Ping the destination IP address.
        Call IcmpSendEcho(hIcmp, lAddress, StringToSend, Len(StringToSend), 0, Reply, Len(Reply), lTimeOut)

        'Reply status
        Ping = Reply.Status

        'Close the Icmp handle.
        IcmpCloseHandle hIcmp
    Else
        Debug.Print "failure opening icmp handle."
        Ping = -1
    End If
Else
    Ping = -1
End If

End Function

'Clean up the sockets.
'http://support.microsoft.com/default.aspx?scid=kb;EN-US;q154512
Public Sub SocketsCleanup()

  WSACleanup

End Sub

'Get the sockets ready.
'http://support.microsoft.com/default.aspx?scid=kb;EN-US;q154512
Public Function SocketsInitialize() As Boolean

  Dim WSAD As WSADATA

  SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = ICMP_SUCCESS

End Function

'Convert the ping response to a message that you can read easily from constants.
'For more information about these constants, visit the following Microsoft Web site:
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wmisdk/wmi/win32_pingstatus.asp

Public Function EvaluatePingResponse(PingResponse As Long) As String

  Select Case PingResponse

  'Success
  Case ICMP_SUCCESS: EvaluatePingResponse = "Success!"

  'Unknown error occurred
  Case Else: EvaluatePingResponse = "Some error occurred"

  End Select

End Function

```

[Tyr]

Pretty nice dude :D
i tested it and it all works fine, well for me i have 0 ping :)

when i let ppl join my project i'll tell you if it fully worked!

thx!, Tyr

PS: can you make in the same way a command to show your ping in the client menu? (same mod i mean, rest i'll figure out)

EDIT: w00t 500 posts? oO

[RetroX]

Thanks.

on a additional note: Local pings and when error occur it gives a return of 0 ms.

Try this:

For client:
1\. Add the ping module (step 7) to the client
2\. Add the routine (step 6) to the client (place it in modClientTCP)
4\. Add a labelitem (call it **pingtime** to frmMainMenu
5\. Add a button next to it (call it **PingButton**)
6\. Add the following routine to the code of frmMainMenu:

```
Private Sub PingButton_Click()
      Dim ServerIP As String
      ServerIP = ReadINI("IPCONFIG", "IP", App.Path & "\config.ini")
      frmMainMenu.pingtime.caption = PingPong(ServerIP) & " ms"
End Sub

```
~~!! I did not test this so let me know if it works ;)~~
_edit: I added it to my own client and it seems to be working._
_edit2: You are right, the serverIP can be extracted from an Ini or global Var, i changed it to the Ini_

(if you need a ip to test: ServerIP = "62.58.50.202"    'its the website of nu.nl [dutch news website, is pingable]

[Godlord]

For ServerIP = "127.0.0.1" you can use the IP out of the configuration file, must have been put in some variable or global, I don't remember.

Regards,
  The Nameless One.

[Tyr]

I'll try it, and ya good remark there godlord otherwise i would have to make 2 clients, 1 for myself (intern ip) and one for the players(extern IP)

i'll try to fix that line of code and tell you then if it works :D
(later on i'm going to change the button to a command for example "/ping" but thats will not change the code :) BRB!

EDIT:
Runs perfectly (ya 0 ping ofc) i'm trying to put it in the gameloop so it constantly refreshes :)

EDIT 2:
Yop works fine, it switches between 17 and 18 ping (as i live in belgium), now i'm gonna loop it :D

EDIT 3:
I know that its possible to put it in loop() commands but i'm not that familiar with that yet… so i just putted a timer in it and added the button code to it...

But please do not put it at 1 ms because it will be hyperactive that label :D (50-100-200 is ok fine)

[RetroX]

> later on i'm going to change the button to a command for example "/ping"

Ehm, what you would like is **/ping username**  to send a pingrequst from the server to a user and displaying the result on your screen?

_edit: If so, here is the code:_

- The response* is shown in the chatwindow.
- The response* is also shown in the serverlog window.
*responsetime is the time from server to target (not from user to target)

*Client: **modGameLogic**
_just place te code below, for example the block '/party'_
```
        If LCase$(Mid$(MyText, 1, 5)) = "/ping" Then
            If Len(MyText) > 7 Then
  ChatText = Mid$(MyText, 8, Len(MyText) - 6)
  Call SendPingRequest(MyIndex, ChatText)
            Else
                Call AddText("Usage: /ping playernamehere", AlertColor)
            End If
            MyText = vbNullString
            Exit Sub
        End If

```
*Client: **modClientTCP**
_just place it anywhere, i suggest at the bottem_
```
Sub SendPingRequest(ByVal Index As Long, ByVal Name As String)
    Call SendData("pingreq" & SEP_CHAR & Index & SEP_CHAR & Name & END_CHAR)
End Sub

```
*Server: **modHandleData**
_Just place the code below the same kind of blocks (there is a whole row of similair codes)_
```
        Case "pingreq"
            Call Packet_Ping(Index, Val(Parse(1)), Parse(2))
            Exit Sub

```

*Server: **modHandleData**
_same as above, place it anywhere between other blocks that start with 'Public Sub Packet_…..'_
```
Public Sub Packet_Ping(ByVal Index As Long, ByVal OriIndex As Long, Name As String)
    Dim PingResponse As String
    Dim TargetID As Integer

    TargetID = FindPlayer(Name)

    If TargetID = 0 Then
        Call PlayerMsg(OriIndex, Name & " is not online", WHITE)
        Call TextAdd(frmServer.txtText(0), "PING: " & GetPlayerName(OriIndex) & " has sent a ping for " & Name & ". But " & Name & " was offline.", True)
    Else
        PingResponse = PingPong(GetPlayerIP(TargetID))
        Call PlayerMsg(OriIndex, "Responsetime for sending ping to " & Name & ": " & PingResponse & "ms", WHITE)
        Call TextAdd(frmServer.txtText(0), "PING: " & GetPlayerName(OriIndex) & " has sent a ping for " & Name & ". Result: " & PingResponse & "ms.", True)
    End If
End Sub

```

[Tyr]

lol not really … why would players want to know that? :D its just a command to see your own ping :)

```
'Show ping
                If LCase$(Mid$(MyText, 1, 5)) = "/ping" Then
                    If PingOn = 0 Then
                    frmMirage.tmrRefreshPing.Enabled = True
                    frmMirage.Pingtime.Visible = True
                    PingOn = 1
                    ElseIf PingOn = 1 Then
                    frmMirage.tmrRefreshPing.Enabled = False
                    frmMirage.Pingtime.Visible = False
                    PingOn = 0
                    End If
                    MyText = vbNullString
                Exit Sub
            End If
```

[RetroX]

It is indeed not very usefull for players, however, you can check /ping yourownusername  for your own ping. For admins it maybe usefull to check pings from others.

[Tyr]

i changed my idea, instead of a command just added a checkbox in the options window, simple and usefull :)

[RetroX]

Thats a good idea.
I am expanding this ping idea by working on a threshold script. When pingtimes are to high the client isn't able to connect. When i got it working i'll post the code.

[Tyr]

ya quite handy for in PvP, players with a high ping will lag that much that they are for example 5 tiles away and you are fighting nothing (you see he's in front of you)

should be to hard, just an if statement right? ;)

EDIT: I letted someone join my "project" to check if the ping worked, it doesn't…
pinging the website worked fine but when he joins and opens the label it gives Ping: 0 ms

also the server (coded as above) says he is on my server with 0 ms oO
any idea's?

[Robin]

Saves me having to read into a ping system.

steals.

[RetroX]

@Tyr: The only thing i can think of the firewall absorbs ping requests. I think a "normal ping" is used on port 80\. Maybe the code can be adjusted to ping at the specific server (and clients) ports.

I can look into this myself but that has to wait till tomorow

@Robin: Your welcome ;)

–--------------------------------------------

The ping treshold:
Server: modHandleData

look for something that looks like:
_Call JoinGame(Index)
Call TextAdd(frmServer.txtText(0), ….....
Call UpdateTOP_

replace this part with the code below:

```
        Dim PingResponse As Integer        'GWO Ping Treshold
        Dim MaxPingAllowed As Integer
        MaxPingAllowed = 500                'Max ms for Ping
        PingResponse = PingPong(GetPlayerIP(Index))
        If PingResponse > MaxPingAllowed Then
            Call TextAdd(frmServer.txtText(0), GetPlayerLogin(Index) & "/" & GetPlayerName(Index) & " is blocked from playing. To high ping. Ping " & PingResponse & "ms.", True)
            Call PlainMsg(Index, "You have a to high Ping (" & PingResponse & "ms). To prevent lag you cannot join. Try again later.", 5)
            Exit Sub
        Else
            Call JoinGame(Index)
            Call TextAdd(frmServer.txtText(0), GetPlayerLogin(Index) & "/" & GetPlayerName(Index) & " has began playing " & GAME_NAME & ". Ping " & PingResponse & "ms.", True)
            Call UpdateTOP
        End If

```

The MaxPingAllowed can also be set with some global var read from an ini but i like it hardcoded.

[Godlord]

> @Tyr: The only thing i can think of the firewall absorbs ping requests. I think a "normal ping" is used on port 80\. Maybe the code can be adjusted to ping at the specific server (and clients) ports.

Port 80 (TCP) is used for HTTP(S) not ping. Ping uses the ICMP protocol which needs no ports.

Regards,
  The Nameless One.

[Tyr]

so i'll just portforward port 80 i guess?

[Godlord]

@Tyr:

> so i'll just portforward port 80 i guess?

You don't need to portforward any port for ICMP, did you read?

Regards,
  The Nameless One.

[RetroX]

You're right, can't be port issue.

@Tyr: you can try (for a short while) to disable your firewall.

[tiggilyboo]

This could be handy.. like if the player goes over a certain ping /refresh them or d/c them. this could prevent quite a bit of map lags.  :O

[Robin]

And also lose a lot of your player base.

You'd be better to sort out your laggy packet system rather than punish players for your own mistakes ;D

[Godlord]

@Robin:

> And also lose a lot of your player base.
>
> You'd be better to sort out your laggy packet system rather than punish players for your own mistakes ;D

Agreed, there is no point in kicking a player for packet latency. It are mainly your issues not the player's. You decided to make a crappy packet system via TCP, if you want speed try UDP…

Regards,
  The Nameless One.

[RetroX]

Hey, Ho, This thread is about the Ping routine itself.

What is done with the info gained by ping is a whole other discussion.
The reason of high pings is another and the transfersystem used by eclipse a third.

If anyone has interest in a discussion about these 3 subject then please start a new thread in the appropiate subforums.

Very much appreciated.

Regards, RetroX.

[Godlord]

@RetroX:

> Hey, Ho, This thread is about the Ping routine itself.
>
> What is done with the info gained by ping is a whole other discussion.
> The reason of high pings is another and the transfersystem used by eclipse a third.
>
> If anyone has interest in a discussion about these 3 subject then please start a new thread in the appropiate subforums.
>
> Very much appreciated.
>
> Regards, RetroX.

What a nonsense, if you don't want discussions about it, then don't post it. Also don't be a copycat, for God's sake. The trans**port** **layer** is not used by Eclipse but by the library you use for your ping system. High ping and low ping have a lot to do with this topic. If you want no discussion at all, then just lock this and don't act with a behaviour such as this because it won't do you any good. If you can tell me what these three subjects don't have in common with the general subject, then I perhaps refuse my words, but as they do have a lot in common, I won't.

Regards,
  The Nameless One.

[RetroX]

Dude, dont take it as a personal offense.

Ofcource they are related due to the simple fact its all about Eclipse (or Internet or Gaming or …)

I love feedback. But I need it for the code (and not if we should or should not kick players with high pings). And i hate to say but the posts made earlier had little to do about how i should change code....

But let me get a thing straight: The method that is used for this Ping routine is based on TCP and it should be based on UDP?

(if not, can you explain a bit more what you ment. if so, what are the differences [in a bit more detail] and do you have some example code for that?)

[Godlord]

@RetroX:

> Dude, dont take it as a personal offense.
>
> Ofcource they are related due to the simple fact its all about Eclipse (or Internet or Gaming or …)
>
> I love feedback. But I need it for the code (and not if we should or should not kick players with high pings). And i hate to say but the posts made earlier had little to do about how i should change code....
>
> But let me get a thing straight: The method that is used for this Ping routine is based on TCP and it should be based on UDP?
>
> (if not, can you explain a bit more what you ment. if so, what are the differences [in a bit more detail] and do you have some example code for that?)

It's way too off-topic to answer on so, I won't answer. As in fact, it has nothing to do with this topic.

Regards,
  The Nameless One.

[Robin]

@The:

> Agreed, there is no point in kicking a player for packet latency. It are mainly your issues not the player's. You decided to make a crappy packet system via TCP, if you want speed try UDP…
>
> Regards,
>   The Nameless One.

Hell, just removing that damned string packet system would make your game as fast as a virgin's first time ;D