PureBoard

; 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.
;

Global Dim bytes.w(4)
Global Dim PingResult.w(6)
Global Dim ttls.b(4)
;
Global PacketCount.w
Global RecdPackets.w
Global LostPackets.w
Global LostPercent.f
Global CheckOut.s
Global message.s
Global Command$
Global TheIPAddress.s
Global MsgLen.b
Global AvgTrip.f     : AvgTrip = 0
Global MaxTrip.w     : MaxTrip = 0
Global MinTrip.w     : MinTrip = 0
;
Declare lngNewAddress(strAdd.s)
Declare Ping(strAdd.s)
Declare.s GetIPbyName(NameIP.s)
Declare.w Minimum(a.w,b1.w)
Declare.w Maximum(a.w,b1.w)
Declare GoDoIt(CheckStr.s)
;
If Not InitNetwork()
    MessageRequester("InitNetwork()", "Can't initialize the network !", #PB_MessageRequester_Ok|#MB_ICONSTOP)     
    End
EndIf
Command$ = ""
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

If OpenWindow(0, 1, 1, 600, 409, "PING2", #PB_Window_WindowCentered|#PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar)
  HideWindow(0,1)
  CreateGadgetList(WindowID(0))
  TextGadget(1, 10, 30,160, 20, "Enter a URL", #PB_Text_Right)
  StringGadget(2, 180, 30, 300, 20, url$)
  TextGadget(1, 490, 30, 60, 20, "or")
  TextGadget(1, 10, 60,160, 20, "Enter an IP Address", #PB_Text_Right)
  IPAddressGadget(4, 180, 60, 150, 20)
  If Len(IP$)
    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(4,MakeIPAddress(Field1,Field2,Field3,Field4))
  EndIf   
  ButtonGadget(6, 270, 90, 60, 30, "Proceed")
  SetActiveGadget(2)
  While WindowEvent():Wend
EndIf
  ; ---------------- This is the main processing loop ----------------------
  If Len(Command$)
    GoDoIt(CheckOut)
    End                                 ; End it if running with a command tail
  EndIf

  HideWindow(0,0)   
  Repeat
    EventID = WaitWindowEvent()
     
    ; ------------------ Process the gadget events -------------------------

    Select EventGadget()
        Case 6    ; Proceed button chosen
        GoDoIt(CheckOut)
       
    EndSelect
     
    If EventID =  #WM_CLOSE ;  #PB_EventCloseWindow
      Quit = 1     
    EndIf

  ; ------------ Insure changes are saved when quit received ---------------
  If Quit = 1
  EndIf 

  Until Quit = 1
  ; -------------------End of the main processing loop ---------------------

; ---------------------------------------------------------------------
; End of Main program code
; ---------------------------------------------------------------------

; Procedures
Procedure lngNewAddress(strAdd.s)
  sDummy.s=strAdd
  Position = FindString(sDummy, ".",1)
  If Position>0
    a1=Val(Left(sDummy,Position-1))
    sDummy=Right(sDummy,Len(sDummy)-Position)
    Position = FindString(sDummy, ".",1)
    If Position>0
      A2=Val(Left(sDummy,Position-1))
      sDummy=Right(sDummy,Len(sDummy)-Position)
      Position = FindString(sDummy, ".",1)
      If Position>0
        A3=Val(Left(sDummy,Position-1))
        sDummy=Right(sDummy,Len(sDummy)-Position)
        A4=Val(sDummy)
        dummy.l=0
        PokeB(@dummy,a1)
        PokeB(@dummy+1,A2)
        PokeB(@dummy+2,A3)
        PokeB(@dummy+3,A4)
        ProcedureReturn dummy
      EndIf
    EndIf
  EndIf
EndProcedure

Procedure Ping(strAdd.s)
  #PING_TIMEOUT = 1000
  lngHPort.l
  lngDAddress.l
  strMessage.s
  lngResult.l
  ECHO.ICMP_ECHO_REPLY
 
  PacketCount=0
  LostPackets=0
  RecdPackets=0
  PingResult(0)=0
 
  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
    ; This is a URL instead of an IP Address, eg. www.google.com
    GetIPbyName(strAdd)                 ; Get the IP Address for the URL
    If Asc(Mid(TheIPAddress,1,1)) < 58  ; If successful, convert to numeric
      lngDAddress = lngNewAddress(TheIPAddress)
      message.s= message + " ["+TheIPAddress+"] with "
    EndIf   
  Else
    ; This is an IP Address in a string
    TheIPAddress = strAdd
    lngDAddress = lngNewAddress(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_()

  message = message + Str(MsgLen)+" bytes of data:"+Chr(10)+Chr(10)
  *buffer=AllocateMemory(SizeOf(ICMP_ECHO_REPLY)+MsgLen)
  For i = 1 To 4
    PacketCount+1
    lngResult = IcmpSendEcho_(lngHPort, lngDAddress, @strMessage, MsgLen , #Null,*buffer, SizeOf(ICMP_ECHO_REPLY)+MsgLen,#PING_TIMEOUT)

    If lngResult = 0
      message=message + "Reply from "+TheIPAddress+":  "
      message= message + "Error no: "+ StrQ(GetLastError_()) + Chr(10)
      PingResult(i) = -1
      LostPackets+1
    Else
      CopyMemory(*buffer,@ECHO,SizeOf(ICMP_ECHO_REPLY))
      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
  FreeMemory(*buffer)
  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)
  ProcedureReturn PingResult
EndIf
EndProcedure

Procedure.s 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_addrtype <> #AF_INET
        TheIPAddress = "A non-IP address was returned."
      Else
        While PeekL(hostinfo\h_addr_list+AdressNumber*4)
          ipAddress = PeekL(hostinfo\h_addr_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.w Minimum(a.w,b1.w)
  If a < b1
    c1.w = a
  Else
    c1.w = b1
  EndIf
  ProcedureReturn c1
EndProcedure

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

Procedure GoDoIt(CheckStr.s)
  CheckOut = GetGadgetText(2)
  CheckOut = RemoveString(CheckOut, "http://")
  CheckOut = RemoveString(CheckOut, "ftp://")
  If Len(CheckOut) 
    Ping(CheckOut)
  Else
    CheckOut.s = GetGadgetText(4)
    Ping(CheckOut)
  EndIf   
  MessageRequester("PING2", message, #MB_ICONINFORMATION)
  ;SetGadgetText(2,"")
  ;SetGadgetText(4,"")
  SetActiveGadget(2)
EndProcedure

; ExecutableFormat=Windows
; FirstLine=1
; EnableXP
; EOF

; English forum:
; Author: Berikco
; Date: 22. September 2002


; HTTP file download
; 09/22/2002
; By Berikco
; v1.1
;
Global filenaam$

; zum Beispiel:
; http://mesh.dl.sourceforge.net/sourceforge/sevenzip/7z442.exe
server$="mesh.dl.sourceforge.net"
Port = 80
url$="/sourceforge/sevenzip/"
filenaam$="7z442.exe"

If InitNetwork() = 0
  MessageRequester("Error", "Can't initialize the network !", 0)
  End
EndIf

#bufferlengte=10240
Global Buffer
Buffer = AllocateMemory(#bufferlengte)
Global buf$
Global EOL$
EOL$ = Chr(13)+Chr(10)

Global Size
Global oldsize
Global rate
Global ratetel
Global buf$
Global Header
Global startReceive
Global hwnd
Global ConnectionID
Global filesize
Global timeout
Global aniwin
Global h
Global einde
;
h=LoadLibrary_("Shell32.dll")

Procedure incoming(result)
  b.b=0
  b$=""
  rest=0
  Select Header
  Case 0
    SendMessage_(aniwin,#ACM_OPEN,h,160)
    i=0
   
    Repeat
      If PeekB(Buffer+i)=13 And PeekB(Buffer+i+1)=10 And PeekB(Buffer+i+2)=13 And PeekB(Buffer+i+3)=10
        b$=Space(i+4)
        CopyMemory(Buffer,@b$,i+4)
        rest=i+4
        Break
      EndIf
      i+1
    Until i=result
    If i=result
        b$=EOL$
        startReceive=1
    EndIf
    ;
    Repeat
        ;
        If Left(b$,2)=EOL$
            b$=Mid(b$,3,Len(b$)-3)
            If startReceive=1
                If CreateFile(1,filenaam$)
                    WriteData(1,Buffer+rest, result-rest)
                    Header=1
                    Size=result-rest
                    SetGadgetText(4,"Received "+Str(Size)+" of "+Str(filesize)+" bytes")
                Else
                    Header=2
                EndIf     
                Break
            EndIf
        Else
            search=FindString(b$, EOL$ , 1)
            If search>0
                l$=Left(b$,search-1)
                b$=Mid(b$,search+2,Len(b$))
                pos=FindString(l$,"200 " , 1)
                If pos
                    startReceive=1  ; ok
                Else
                    pos=FindString(l$,"404 " , 1)
                    If pos
                        ;error 404 not founf
                    Else
                        pos=FindString(LCase(l$),"content-length:" , 1)
                        If pos
                            pos=FindString(l$," " , 1)
                            filesize=Val(Mid(l$,pos+1,Len(l$)))
                        EndIf
                    EndIf
                EndIf
                Debug l$
            Else
                l$=""
                b$=EOL$
                search=1
                startReceive=1
            EndIf
        EndIf ;
    Until search=0
  Case 1
    timeout=0
    WriteData(1,Buffer, result)
    Size+result
    If filesize
        FileSize$=Str(filesize)
        stap=100*Size/filesize
    Else
        FileSize$="??"
        stap=0
    EndIf
    SetGadgetText(4,"Received "+Str(Size)+" of "+Str(filesize)+" bytes")
    SetGadgetState(2, stap)
    If filesize=Size
      Debug "File Received"
      Header=2
      Debug Str(Size)+" of "+Str(filesize)+" bytes"
    EndIf 
  Case 2
    CloseFile(1)
    CloseNetworkConnection(ConnectionID)
    Debug "Connection Closed"
    Header=3
    DestroyWindow_(aniwin)
    einde=1
  EndSelect
EndProcedure
;
Procedure MyWindowCallback(WindowID, message, wParam, lParam)
  result = #PB_ProcessPureBasicEvents
  Select WindowID
  Case hwnd
    Select message
    Case #WM_TIMER
      result=0
      Select wParam
      Case 1 ; timer
        result=ReceiveNetworkData(ConnectionID, Buffer, #bufferlengte)
        If result=0
            filesize=Size
        EndIf
        incoming(result)
      Case 2  ; timeout
        timeout+1
        If timeout>10
          CloseFile(1)
          Header=2
          Debug "Timeout"     
        EndIf
      Case 3
        ratetel+500
        If ratetel>0
          rate=Size/ratetel
        EndIf
        SetGadgetText(3,"Download speed..."+Str(rate)+" KB/s.  Time "+Str(ratetel/1000)+" s.")
      EndSelect
    EndSelect
  EndSelect
  ProcedureReturn result
EndProcedure
;
hwnd=OpenWindow(0,100,450,335,160,"Downloading "+filenaam$+" from "+server$,#PB_Window_SystemMenu)
;
If hwnd
  If CreateGadgetList(WindowID(0))
    ButtonGadget(1, 250, 128,  72, 20, "Cancel")
    ProgressBarGadget(2, 10, 100, 313, 20, 0, 100)
    TextGadget(3, 20, 80,  280, 15, "")
    TextGadget(4, 20, 65,  280, 15, "")
    ;
    aniwin=CreateWindowEx_(0,"SysAnimate32","",#ACS_AUTOPLAY|#ACS_CENTER|#ACS_TRANSPARENT|#WS_CHILD|#WS_VISIBLE|#WS_CLIPCHILDREN|#WS_CLIPSIBLINGS,25,10,280,50, hwnd,0,GetModuleHandle_(0),0)
    ;
    ConnectionID = OpenNetworkConnection(server$, Port)
    ;
    If ConnectionID
      SendNetworkString(ConnectionID, "GET "+url$+filenaam$+" HTTP/1.0"+EOL$)
      SendNetworkString(ConnectionID, "Host: "+server$+EOL$)
      SendNetworkString(ConnectionID, "Accept: */*"+EOL$)
      SendNetworkString(ConnectionID, EOL$)
    ;
    SetWindowCallback(@MyWindowCallback())
    ; -------------- timers ----------------
    SetTimer_(hwnd,1,20,0) ; 20 milisecond timer
    SetTimer_(hwnd,2,1000,0) ; 1 sec timer
    SetTimer_(hwnd,3,500,0) ; 500 msec timer   
    ;
    Repeat
      EventID=WaitWindowEvent()
        Select EventGadget()
        Case 1
            Header=2
        EndSelect
    Until einde=1
    EndIf
  EndIf
EndIf
FreeLibrary_(h)
Delay(4000)
;
End
; ExecutableFormat=
; CursorPosition=4
; FirstLine=1
; EOF

; English forum: http://purebasic.myforums.net/viewtopic.php?t=6719
; Author: eddy (updated for PB3.93 by ts-soft)
; Date: 25. June 2003

;- Procedure-Code
Global WINDOW_Requester
; /////////////////////
; Set position
; /////////////////////


Procedure SetRequesterPosition(x,y,ParentWin)
  ;create the invisible window which defines the position of requester
  If WINDOW_Requester = 0
    WINDOW_Requester =  OpenWindow(#PB_Any,x,y,0,0,"Temp Hidden Window",#PB_Window_BorderLess,WindowID(ParentWin))
  EndIf
 
  If WindowID(WINDOW_Requester)       
    ResizeWindow(WINDOW_Requester,x,y,#PB_Ignore,#PB_Ignore)   
  EndIf
EndProcedure 


;- Example-Code
GetCursorPos_(@pt.POINT)
SetRequesterPosition(pt\x,pt\y,ParentWin)
c = ColorRequester()

; ExecutableFormat=Windows
; FirstLine=1
; EOF

; German forum:
; Author: CyberRun8
; Date: 03. April 2003

;Beispiel von CyberRun8
;für PureBasic 3.62
;März 2003

;-Konstanten setzen
#Window = 0

#Gadget1 = 0
#Gadget2 = 1
#Gadget3 = 2

;-Fenster mit Gadgets darstellen
If OpenWindow(#Window, 100, 150, 240, 90, "AdvancedGadgetEvents", #PB_Window_MinimizeGadget)
  If CreateGadgetList(WindowID(#Window))
    ;AdvancedGadgetEvents(#True) ; <----
    ButtonGadget(#Gadget1, 5, 5, 230, 20, "Doppelklick-Button")
    ButtonGadget(#Gadget2, 5, 35, 230, 20, "Einfachklick-Button")
    ;AdvancedGadgetEvents(#False); <----
    ButtonGadget(#Gadget3, 5, 65, 230, 20, "Gadget ohne Advanced-Funktion")
  EndIf
EndIf

Debug "Focusangabe:"
;-Schleife
Repeat
  EventID.l = WaitWindowEvent()
 
  If EventID = #PB_Event_Gadget   
    Select EventGadget()
      Case #Gadget1
        If EventType() = #PB_EventType_Focus
          Debug "Focus auf Doppelklick-Button gesetzt"               
        ElseIf EventType() = #PB_EventType_LeftDoubleClick
          MessageRequester("Info", "Linksdoppelklick", 0)
        ElseIf EventType() = #PB_EventType_RightDoubleClick
          MessageRequester("Info", "Rechtsdoppelklick", 0)             
        EndIf
      Case #Gadget2
        If EventType() = #PB_EventType_LeftClick         
          MessageRequester("Info", "Linksklick auf Einfachklick-Button", 0)
        ElseIf EventType() = #PB_EventType_RightClick         
          MessageRequester("Info", "Rechtsklick auf Einfachklick-Button", 0)
        ElseIf EventType() = #PB_EventType_Focus
          Debug "Focus auf Einfachklick-Button gesetzt"
        EndIf
      Case #Gadget3
        ;Folgende Abfrage ist ohne Funkton weil für Gadget3 die fortgeschrittene Ereignisangabe
        ;abgeschaltet wurde.
        If EventType() = #PB_EventType_Focus
          Debug "Focus auf Doppelklick-Button gesetzt"               
        ElseIf EventType() = #PB_EventType_LeftDoubleClick
          MessageRequester("Info", "Linksdoppelklick", 0)
        ElseIf EventType() = #PB_EventType_RightDoubleClick
          MessageRequester("Info", "Rechtsdoppelklick", 0)             
        EndIf         
    EndSelect
  EndIf       
Until EventID = #PB_Event_CloseWindow
End

;English forum: http://purebasic.myforums.net/viewtopic.php?t=6719
; Author: eddy (updated for PB3.93 by ts-soft)
; Date: 25. June 2003

;- Procedure-Code
Global WINDOW_Requester
; /////////////////////
; Set position
; /////////////////////

ParentWin=OpenWindow(#PB_Any,100,100,500,500,"Test Window")

Procedure SetRequesterPosition(x,y,ParentWin)
  ;create the invisible window which defines the position of requester
  If WINDOW_Requester = 0
    WINDOW_Requester =  OpenWindow(#PB_Any,x,y,0,0,"Temp Hidden Window",#PB_Window_BorderLess,WindowID(ParentWin))
  EndIf
 
  If WindowID(WINDOW_Requester)       
    ResizeWindow(WINDOW_Requester,x,y,#PB_Ignore,#PB_Ignore)   
  EndIf
EndProcedure


;- Example-Code
GetCursorPos_(@pt.POINT)
SetRequesterPosition(pt\x,pt\y,ParentWin)
c = ColorRequester()

; ExecutableFormat=Windows
; FirstLine=1
; EOF

; English forum: http://purebasic.myforums.net/viewtopic.php?t=6719
; Author: eddy (updated for PB3.93 by ts-soft)
; Date: 25. June 2003

;- Procedure-Code
Global WINDOW_Requester
; /////////////////////
; Set position
; /////////////////////

Procedure SetRequesterPosition(x,y, ParentID=#PB_Ignore)
  ;create the invisible window which defines the position of requester
  If WINDOW_Requester = 0
    If ParentID=#PB_Ignore
      WINDOW_Requester =  OpenWindow(#PB_Any,x,y,0,0,"Temp Hidden Window",#PB_Window_BorderLess|#PB_Window_Invisible)
    Else
      WINDOW_Requester =  OpenWindow(#PB_Any,x,y,0,0,"Temp Hidden Window",#PB_Window_BorderLess|#PB_Window_Invisible,ParentID)
    EndIf
  EndIf
 
  If WindowID(WINDOW_Requester)
    ResizeWindow(WINDOW_Requester,x,y,#PB_Ignore,#PB_Ignore)
  EndIf
EndProcedure 


;- Example-Code
GetCursorPos_(@pt.POINT)
SetRequesterPosition(pt\x,pt\y)
c = ColorRequester()

; ExecutableFormat=Windows
; FirstLine=1
; EOF