habe das PING 2 Beispiel aus PureArea bei mir im einsatz und habe jetzt erst bemerkt das es nicht unter 3.94 läuft, ich habe einige Zeilen geändert die B3.94 anmekert (die mit ***) aber trotzdem funktioniert das Programm nicht richtig kann jemand helfen ?
Gruss Peter
Code: Alles auswählen
; *** this lines are edit
; 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.
;
;*** Structure HOSTENT
;*** h_name.l
;*** h_aliases.l
;*** h_addrtype.w
;*** h_length.w
;*** h_addr_list.l
;*** EndStructure
;
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 Command$.s
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 GetIPbyName(NameIP.s)
Declare Minimum(a.w,b1.w)
Declare Maximum(a.w,b1.w)
Declare GoDoIt(CheckStr.s)
;
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, #PB_Window_WindowCentered|#PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar , "PING2")
HideWindow(0,1)
CreateGadgetList(WindowID())
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")
ActivateGadget(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 -------------------------
If EventID = #PB_EventGadget
Select EventGadgetID()
Case 6 ; Proceed button chosen
GoDoIt(CheckOut)
EndSelect
EndIf
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 = 255
lngHPort.l
lngDAddress.l
strMessage.s
lngResult.l
ECHO.ICMP_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
; 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)
For i = 1 To 4
PacketCount+1
lngResult = IcmpSendEcho_(lngHPort, lngDAddress, strMessage, Len(strMessage), 0, ECHO, SizeOf(ICMP_ECHO_REPLY), PING_TIMEOUT)
If lngResult = 0
Message=Message + "Reply from "+TheIPAddress+": "
Message= Message + "Error no: "+ Str(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)
ProcedureReturn PingResult
EndIf
EndProcedure
Procedure GetIPbyName(NameIP.s)
TheIPAddress.s
If InitNetwork()
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;*** If hostinfo\h_addrtype <> #AF_INET
TheIPAddress = "A non-IP address was returned."
Else
While PeekL(hostinfo\h_list+AdressNumber*4);*** While PeekL(hostinfo\h_addr_list+AdressNumber*4)
ipAddress = PeekL(hostinfo\h_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
Else
TheIPAddress = "The Network can't be initialized."
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,"")
ActivateGadget(2)
EndProcedure
; ExecutableFormat=Windows
; FirstLine=1
; EnableXP
; EOF