PureBasic 3.94 for Windows released

[fweil]

PWS32, the modified structures I just sent work, but don"t forget to change also the SizeOf() used in IcmpSendEcho_()

This works really with these few updates.

Rgrds

[netmaestro]

I too could not run this code until the formidable fweil added his note. With his changes it works perfectly.

Seems the OptionsSize and OptionsData elements in structure IP_OPTION_INFORMATION are transposed? That would be a genuine bug all right.

[PWS32]

Hi fweil,

thanks for your help, now its work

Best regards,
Peter

[Fred]

The structure in PB3.94 seems correct (i just checked them with MSDN). Are you sure than the field OptionData shouldn't point to an allocated datazone ?

[fweil]

@Fred,

I am trying to check what went wrong, but Ping program works when changing the structure !!!

I will let you know this evening if I found something, otherwise, just wait that more information comes from somebody else.

[fweil]

@Fred,

Not sure this is the best way to debug this stuff but here is the code I updated from a formerly posted source.

The PureBasic proposed structures render a 11001 error code. Modified structures don't.

Then I am not able to go deeper inside to be sure the modifications I did are right.

Reading MSDN made me turn to update the IP_OPTION_INFORMATION structure, but I can't figure out exactly how to translate Microsoft information.

It is said that we should use a UCHAR 32 item at the end, but when using a .b[31] array the program hangs with a 11001 error code (meaning IP_BUF_TOO_SMALL).

I checked it step by step and found that this array should be [36] making a difference of 5 bytes !!! Don't know why.

Anyway, I guess I can't understand more here, so I propose you the code I used. No need to turn the debugger on at start, all results are displayed in a message box.

Code: Select all

;
; Ping tool with a small GUI
; FWeil : 20050819
;
; From original code
;
; English forum: http://purebasic.myforums.net/viewtopic.php?t=7338&highlight=
; Author: TerryHough
; Date: 16. September 2003
;
;PING2 - Sep 08, 2003 - Terry Hough based on work by
;  1) PING by Siegfried Rings (known as the 'CodeGuru' ),
;  2) URLtoIPAddress by PWS32 (from German forum), and
;  3) LocalHostName by AlphaSnd (Fred) on main forum.
;
;PING2 is a Windows GUI version of the DOS based PING available on
;Windows systems usually located as \WINDOWS\PING.EXE. PING2 add a
;Windows interface and slightly extends the capabilites, yet remains
;about 50 percent smaller.
;
;Plan to add an Error code interpretation in the future as time permits.
;
; Updates 20050819 Fweil
; Changed to PureBasic 3.94
;

;
; Change IP_OPTION_INFORMATION API structure until PB will be updated
;
Structure MyIP_OPTION_INFORMATION
  Ttl.b
  Tos.b
  Flags.b
  OptionsSize.b
  OptionsData.b[36]
EndStructure

Structure MyICMP_ECHO_REPLY
  Address.l
  Status.l
  RoundTripTime.l
  DataSize.w ; Integer
  Reserved.w ; Integer
  Data.l
  Options.MyIP_OPTION_INFORMATION
EndStructure

Enumeration
  #Window_Main
  #Gadget_Button
  #Gadget_Text_URL
  #Gadget_String_URL
  #Gadget_Text_OR
  #Gadget_Text_IP
  #Gadget_IP
EndEnumeration

;
; IP_STATUS constants
;
#IP_STATUS_BASE = 11000
#IP_SUCCESS = 0
#IP_BUF_TOO_SMALL = #IP_STATUS_BASE + 1
#IP_DEST_NET_UNREACHABLE = #IP_STATUS_BASE + 2
#IP_DEST_HOST_UNREACHABLE = #IP_STATUS_BASE + 3
#IP_DEST_PROT_UNREACHABLE = #IP_STATUS_BASE + 4
#IP_DEST_PORT_UNREACHABLE = #IP_STATUS_BASE + 5
#IP_NO_RESOURCES = #IP_STATUS_BASE + 6
#IP_BAD_OPTION = #IP_STATUS_BASE + 7
#IP_HW_ERROR = #IP_STATUS_BASE + 8
#IP_PACKET_TOO_BIG = #IP_STATUS_BASE + 9
#IP_REQ_TIMED_OUT = #IP_STATUS_BASE + 10
#IP_BAD_REQ = #IP_STATUS_BASE + 11
#IP_BAD_ROUTE = #IP_STATUS_BASE + 12
#IP_TTL_EXPIRED_TRANSIT = #IP_STATUS_BASE + 13
#IP_TTL_EXPIRED_REASSEM = #IP_STATUS_BASE + 14
#IP_PARAM_PROBLEM = #IP_STATUS_BASE + 15
#IP_SOURCE_QUENCH = #IP_STATUS_BASE + 16
#IP_OPTION_TOO_BIG = #IP_STATUS_BASE + 17
#IP_BAD_DESTINATION = #IP_STATUS_BASE + 18

;
; IP_Flag constants
;
#IP_OPT_EOL = $0 ; End of list option
#IP_OPT_NOP = $1 ; No operation
#IP_OPT_SECURITY = $82 ; Security option
#IP_OPT_LSRR = $83 ; Loose source route
#IP_OPT_SSRR = $89 ; Strict source route
#IP_OPT_RR = $7 ; Record route
#IP_OPT_TS = $44 ; Timestamp
#IP_OPT_SID = $88 ; Stream ID (obsolete)
#IP_OPT_ROUTER_ALERT = $94 ; Router Alert Option

Dim bytes.w(4)
Dim PingResult.w(6)
Dim ttls.b(4)

Global PacketCount.w
Global RecdPackets.w
Global LostPackets.w
Global LostPercent.f
Global CheckOut.s
Global Message.s
Global TechnicalInfo.s
Global Command$.s
Global TheIPAddress.s
Global MsgLen.b
Global AvgTrip.f
Global MaxTrip.w
Global MinTrip.w

Procedure.w Minimum(a.w, b1.w)
  If a < b1
      ProcedureReturn a
    Else
      ProcedureReturn b1
  EndIf
EndProcedure

Procedure.w Maximum(a.w, b1.w)
  If a > b1
      ProcedureReturn a
    Else
      ProcedureReturn b1
  EndIf
EndProcedure

Procedure.s IPStatus(IPStatus.l)
  Select IPStatus
    Case #IP_SUCCESS
      ProcedureReturn "#IP_SUCCESS"
    Case #IP_BUF_TOO_SMALL
      ProcedureReturn "#IP_BUF_TOO_SMALL"
    Case #IP_DEST_NET_UNREACHABLE
      ProcedureReturn "#IP_DEST_NET_UNREACHABLE"
    Case #IP_DEST_HOST_UNREACHABLE
      ProcedureReturn "#IP_DEST_HOST_UNREACHABLE"
    Case #IP_DEST_PROT_UNREACHABLE
      ProcedureReturn "#IP_DEST_PROT_UNREACHABLE"
    Case #IP_DEST_PORT_UNREACHABLE
      ProcedureReturn "#IP_DEST_PORT_UNREACHABLE"
    Case #IP_NO_RESOURCES
      ProcedureReturn "#IP_NO_RESOURCES"
    Case #IP_BAD_OPTION
      ProcedureReturn "#IP_BAD_OPTION"
    Case #IP_HW_ERROR
      ProcedureReturn "#IP_HW_ERROR"
    Case #IP_PACKET_TOO_BIG
      ProcedureReturn "#IP_PACKET_TOO_BIG"
    Case #IP_REQ_TIMED_OUT
      ProcedureReturn "#IP_REQ_TIMED_OUT"
    Case #IP_BAD_REQ
      ProcedureReturn "#IP_BAD_REQ"
    Case #IP_BAD_ROUTE
      ProcedureReturn "#IP_BAD_ROUTE"
    Case #IP_TTL_EXPIRED_TRANSIT
      ProcedureReturn "#IP_TTL_EXPIRED_TRANSIT"
    Case #IP_TTL_EXPIRED_REASSEM
      ProcedureReturn "#IP_TTL_EXPIRED_REASSEM"
    Case #IP_PARAM_PROBLEM
      ProcedureReturn "#IP_PARAM_PROBLEM"
    Case #IP_SOURCE_QUENCH
      ProcedureReturn "#IP_SOURCE_QUENCH"
    Case #IP_OPTION_TOO_BIG
      ProcedureReturn "#IP_OPTION_TOO_BIG"
    Case #IP_BAD_DESTINATION
      ProcedureReturn "#IP_BAD_DESTINATION"
    Default
      ProcedureReturn "#IP_STATUS unknown"
  EndSelect
EndProcedure

Procedure.s IPFlag(IPFlag.l)
  Select IPFlag
    Case #IP_OPT_EOL
      ProcedureReturn "#IP_OPT_EOL"
    Case #IP_OPT_NOP
      ProcedureReturn "#IP_OPT_NOP"
    Case #IP_OPT_SECURITY
      ProcedureReturn "#IP_OPT_SECURITY"
    Case #IP_OPT_LSRR
      ProcedureReturn "#IP_OPT_LSRR"
    Case #IP_OPT_SSRR
      ProcedureReturn "#IP_OPT_SSRR"
    Case #IP_OPT_RR
      ProcedureReturn "#IP_OPT_RR"
    Case #IP_OPT_TS
      ProcedureReturn "#IP_OPT_TS"
    Case #IP_OPT_SID
      ProcedureReturn "#IP_OPT_SID"
    Case #IP_OPT_ROUTER_ALERT
      ProcedureReturn "#IP_OPT_ROUTER_ALERT"
  EndSelect
EndProcedure

Procedure ISIPAddress(strAdd.s)
  ProcedureReturn MakeIPAddress(Val(StringField(strAdd, 1, ".")), Val(StringField(strAdd, 2, ".")), Val(StringField(strAdd, 3, ".")), Val(StringField(strAdd, 4, ".")))
EndProcedure

Procedure GetIPbyName(NameIP.s)
  TheIPAddress.s
  pHostinfo = gethostbyname_(NameIP)
  If pHostinfo = 0
      TheIPAddress = "Unable to resolve domain name"
    Else
      CopyMemory (pHostinfo, hostinfo.HOSTENT, SizeOf(HOSTENT))
      If hostinfo\h_addr <> #AF_INET
          TheIPAddress = "A non-IP address was returned."
        Else
          While PeekL(hostinfo\h_list + AdressNumber * 4)
            ipAddress = PeekL(hostinfo\h_list + AdressNumber * 4)
            TheIPAddress = StrU(PeekB(ipAddress), 0) + "." + StrU(PeekB(ipAddress + 1), 0) + "." + StrU(PeekB(ipAddress + 2), 0) + "." + StrU(PeekB(ipAddress + 3), 0)
            AdressNumber + 1
          Wend
      EndIf
  EndIf
  ProcedureReturn TheIPAddress
EndProcedure

Procedure Ping(strAdd.s)
  #PING_TIMEOUT = 255
  lngHPort.l
  lngDAddress.l
  strMessage.s
  lngResult.l
  ECHO.MyICMP_ECHO_REPLY
  
  strMessage.s = "Echo This Information Back To Me"
  MsgLen = Len(strMessage)
  Message.s="Pinging "+ CheckOut
  If Asc(Mid(strAdd, 1, 1)) < 48 Or Asc(Mid(strAdd, 1, 1)) > 57
      GetIPbyName(strAdd)  ; This is a URL instead of an IP Address, eg. www.google.com. Get the IP Address for the URL
      If Asc(Mid(TheIPAddress, 1, 1)) < 58  ; If successful, convert to numeric
          lngDAddress = IsIPAddress(TheIPAddress)
          Message.s = Message + " [" + TheIPAddress + "] with "
      EndIf
    Else
      TheIPAddress = StrAdd ; This is an IP Address in a string
      lngDAddress = IsIPAddress(strAdd) ; Convert to a numeric
      Message.s = Message + " with "
  EndIf
  If TheIPAddress = "The Network can't be initialized."
      Message = Message + Chr(10) + Chr(10) + TheIPAddress
    ElseIf TheIPAddress = "A non-IP address was returned."
      Message = Message + Chr(10) + Chr(10) + TheIPAddress
    ElseIf TheIPAddress = "Unable to resolve domain name"
      Message = Message + Chr(10) + Chr(10) + TheIPAddress
    Else
      lngHPort = IcmpCreateFile_()
      Debug "lngHPort = " + Str(lngHPort)
      Message = Message + Str(MsgLen) + " bytes of data:" + Chr(10) + Chr(10)
      For i = 1 To 4
        PacketCount + 1
        lngResult = IcmpSendEcho_(lngHPort, lngDAddress, strMessage, Len(strMessage), 0, ECHO, SizeOf(MyICMP_ECHO_REPLY), #PING_TIMEOUT)

TechnicalInfo.s = "===================" + Chr(10)
TechnicalInfo + "ECHO\Address : " + IPString(ECHO\Address) + Chr(10)
TechnicalInfo + "ECHO\Status : " + IPStatus(ECHO\Status) + Chr(10)
TechnicalInfo + "ECHO\RoundTripTime : " + Str(ECHO\RoundTripTime) + "ms" + Chr(10)
TechnicalInfo + "ECHO\DataSize : " + Str(ECHO\DataSize) + " bytes" + Chr(10)
TechnicalInfo + "ECHO\Reserved : "+ Str(ECHO\Reserved) + Chr(10)
TechnicalInfo + "ECHO\Data : "+ Str(ECHO\Data) + " " + Chr(10)
TechnicalInfo + "ECHO\Options\Ttl : " + Str(ECHO\Options\Ttl) + Chr(10)
TechnicalInfo + "ECHO\Options\Tos : " + Str(ECHO\Options\Tos) + Chr(10)
TechnicalInfo + "ECHO\Options\Flags : " + IPFlag(ECHO\Options\Flags) + Chr(10)
TechnicalInfo + "ECHO\Options\OptionsSize : " + Str(ECHO\Options\OptionsSize) + Chr(10)
TechnicalInfo + "ECHO\Options\OptionsData : " + Str(ECHO\Options\OptionsData) + Chr(10)
TechnicalInfo + "===================" + Chr(10)

        If lngResult = 0
            Message=Message + "Reply from " + TheIPAddress + ":  "
            Message= Message + "Error no: "+ IPStatus(ECHO\Status) + Chr(10)
            PingResult(i) = -1
            LostPackets + 1
          Else
            PingResult(i) = ECHO\RoundTripTime
            bytes(i) = ECHO\Datasize
            ttls(i) =  ECHO\Options
            RemoteIP.s = IPString(ECHO\Address)
            Message = Message + "Reply from " + RemoteIP + ":  bytes = " + Str(bytes(i)) + " time = " + Str(PingResult(i)) + "ms TTL = " + StrU(ttls(i), #Byte) + Chr(10)
            RecdPackets + 1
            SuccessTrip + 1
        EndIf
        Delay(100)
      Next
      Message = Message + Chr(10) + "Ping statistics for " + CheckOut + ":" + Chr(10)
      Message = Message + "   Packets: Sent = " + Str(PacketCount)
      Message = Message + ", Received = " + Str(RecdPackets)
      Message = Message + ", Lost = " + Str(LostPackets)
      If LostPackets = 0
          LostPercent = 0
        Else
          LostPercent = (LostPackets / PacketCount) * 100
      EndIf
      Message = Message + " (" + StrF(LostPercent, 0) + "% loss)" + Chr(10) + Chr(10)
      PingResult(5) = 255
      PingResult(6) = 0
      For i = 1 To 4
        If PingResult(i)> 0
            PingResult(6) = Maximum(PingResult(6), PingResult(i))
            PingResult(5) = Minimum(PingResult(5), PingResult(i))
            PingResult(0) + PingResult(i)
        EndIf
      Next
      MinTrip = PingResult(5)
      MaxTrip = PingResult(6)
      If RecdPackets
          AvgTrip = PingResult(0) / RecdPackets
        Else
          AvgTrip = PingResult(6)
      EndIf
      If AvgTrip > 0
          Message = Message + "Approximate round trip times in milli-seconds:" + Chr(10)
          Message = Message + "    Minimum = " + Str(MinTrip) + "ms,  Maximum = " + Str(MaxTrip) + ",  Average = " + StrF(AvgTrip, 2) + "ms"
      EndIf
      lngResult = IcmpCloseHandle_(lngHPort)
      Debug "PingResult = " + Str(PingResult)
      ProcedureReturn PingResult
  EndIf
EndProcedure

Procedure GoDoIt(CheckStr.s)
  CheckOut = GetGadgetText(#Gadget_String_URL)
  CheckOut = RemoveString(CheckOut, "http://")
  CheckOut = RemoveString(CheckOut, "ftp://")
  If Len(CheckOut)
      Ping(CheckOut)
    Else
      CheckOut.s = GetGadgetText(#Gadget_IP)
      Ping(CheckOut)
  EndIf
  MessageRequester("PING2", Message + Chr(10) + TechnicalInfo, #MB_ICONINFORMATION)
  SetGadgetText(#Gadget_String_URL, "")
  SetGadgetText(#Gadget_IP, "")
  ActivateGadget(#Gadget_String_URL)
EndProcedure

  Command$ = LCase(ProgramParameter())
  If Len(Command$) > 0
      If Asc(Mid(Command$, 1, 1)) < 48 Or Asc(Mid(Command$, 1, 1)) > 57
          URL$ = Command$ ; This is a URL instead of an IP Address, eg. www.google.com
          IP$ = ""
        Else
          IP$ = Command$ ; This is an IP Address in a string
          URL$ = ""
      EndIf
  EndIf
  
  DefaultIP.s = "www.purebasic.com"
  If InitNetwork()
      WindowWidth = 360
      WindowHeight = 200
      If OpenWindow(#Window_Main, 0, 0, WindowWidth, WindowHeight, #PB_Window_WindowCentered | #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered, "PING2")
          AddKeyboardShortcut(#Window_Main, #PB_Shortcut_Escape, #PB_Shortcut_Escape)
          AddKeyboardShortcut(#Window_Main, #PB_Shortcut_Return, #PB_Shortcut_Return)
          HideWindow(#Window_Main, 1)
          If CreateGadgetList(WindowID())
              Frame3DGadget(#Gadget_Text_URL, 20, 20, 320, 50, "Enter a URL") ; , #PB_Frame3D_Double)
              StringGadget(#Gadget_String_URL, 30, 37, 300, 20, URL$)
              TextGadget(#Gadget_Text_OR, 175, 80, 60, 20, "or")
              Frame3DGadget(#Gadget_Text_IP, 95, 100, 170, 50, "Enter an IP address") ; , #PB_Frame3D_Double)
              IPAddressGadget(#Gadget_IP, 105, 117, 150, 20)
              ButtonGadget(#Gadget_Button, 150, 160, 60, 20, "Proceed")
              ActivateGadget(2)
          EndIf
          If Len(DefaultIP)
              If IsIPAddress(DefaultIP)
                  Field1.w = Val(StringField(IP$, 1, "."))
                  Field2.w = Val(StringField(IP$, 2, "."))
                  Field3.w = Val(StringField(IP$, 3, "."))
                  Field4.w = Val(StringField(IP$, 4, "."))
                  SetGadgetState(#Gadget_IP, MakeIPAddress(Field1, Field2, Field3, Field4))
                Else
                  SetGadgetText(#Gadget_String_URL, DefaultIP)
              EndIf
          EndIf
          If Len(Command$)
              GoDoIt(CheckOut)
              End ; End it if running with a command tail
          EndIf
          HideWindow(#Window_Main,0)
          Repeat
;            Debug Str(GetFocus_()) + " " + Str(GadgetID(#Gadget_String_URL)) + " " + Str(GadgetID(#Gadget_IP))
            Select WaitWindowEvent()
              Case #PB_Event_CloseWindow
                Quit = #True
              Case #PB_Event_Menu
                Select EventMenuID()
                  Case #PB_Shortcut_Escape
                    Quit = #True
                  Case #PB_Shortcut_Return
                    GoDoIt(CheckOut)
                EndSelect
              Case #PB_Event_Gadget
                Select EventGadgetID()
                  Case #Gadget_Button ; Proceed button choosen
                    GoDoIt(CheckOut)
                EndSelect
            EndSelect
          Until Quit
      EndIf
      CloseWindow(#Window_Main)
    Else
      MessageRequester("Error : ", "The Network can't be initialized.", #PB_MessageRequester_Ok)
  EndIf
End

[fsw]

OptionsData is not UCHAR it's PUCHAR - POINTER TO UCHAR.

If I use this

Code: Select all

Structure MyIP_OPTION_INFORMATION
  Ttl.b
  Tos.b
  Flags.b
  OptionsSize.b
  *OptionsData.b[31]
EndStructure

it works.

[fweil]

Well fsw, but I can't figure out how to write / use this !

[fsw]

[Fred]

According to the MSDN, the buffer should be 8+, read here: http://msdn.microsoft.com/library/defau ... ndecho.asp

[fweil]

Does not help me to understand what is wrong there.

When using :

IcmpSendEcho_(lngHPort, lngDAddress, strMessage, Len(strMessage), Option_Information.IP_OPTION_INFORMATION, ECHO.ICMP_ECHO_REPLY, SizeOf(ICMP_ECHO_REPLY), #PING_TIMEOUT)

or

IcmpSendEcho_(lngHPort, lngDAddress, strMessage, Len(strMessage), Option_Information.IP_OPTION_INFORMATION, ECHO.ICMP_ECHO_REPLY, SizeOf(ICMP_ECHO_REPLY) + 8, #PING_TIMEOUT)

or any variation I get a crash.

and when using

IcmpSendEcho_(lngHPort, lngDAddress, strMessage, Len(strMessage), 0, ECHO.ICMP_ECHO_REPLY, SizeOf(MyICMP_ECHO_REPLY), #PING_TIMEOUT)

I get most of information back, except options that I don't know how to access.

IcmpSendEcho_(lngHPort, lngDAddress, strMessage, Len(strMessage), Option_Information.MyIP_OPTION_INFORMATION, ECHO.ICMP_ECHO_REPLY, SizeOf(MyICMP_ECHO_REPLY), #PING_TIMEOUT)

gives a memory access error.

Well, I let somebody else go further then.

[Fred]

Ok, got it. The reply buffer should be at least sizeof(ICMP_ECHO_REPLY)+MAX(Len(Message), 8 ). Which means than the reply buffer must be always above or equal to sizeof(sizeof(ICMP_ECHO_REPLY)+8 and if the Len(Message) is > 8, it needs to take this value. So the structure definition is correct

Code: Select all

      MessageLength = Len(strMessage)
      If MessageLength < 8
        MessageLength = 8
      EndIf
      
      DynLength = SizeOf(ICMP_ECHO_REPLY)+MessageLength
      *DynECHO.ICMP_ECHO_REPLY = AllocateMemory(DynLength)

      lngResult = IcmpSendEcho_(lngHPort, lngDAddress, strMessage, Len(strMessage), 0, *DynECHO, DynLength, #PING_TIMEOUT)

This way it works correctly, and the text message itself is replied in the structure (that's why it needs to be adjusted to it).

[oryaaaaa]

Thankyou

[fweil]

Thanks a lot Fred, it works now.

I just can't get options from IP_OPTION_INFORMATION in this sample code.

I will go back on this later.

Rgrds

[CONVERT]

Thank you very much, Fred and your team.

You are very great.

Jean.