Looking to build a tool which
1. Ping and save ms to certain list of IPs.
2. Measure jitter ms
Any network library or dll I can hook into that anyone knows of?
Just wanting some diagnostic data and thought it might be something which I can use to learn more PB!
Thanks!
Windows platform - network diagnostic app
-
lesserpanda
- User
- Posts: 65
- Joined: Tue Feb 11, 2020 7:50 am
Re: Windows platform - network diagnostic app
This help?
Code: Select all
; Author: TerryHough (modified by celtic88)
DeclareModule pi
Declare ng(Address.s,PING_TIMEOUT=1000,strMessage.s = "Echo This Information Back To Me")
EndDeclareModule
Module pi
Global Ping_Port = IcmpCreateFile_()
Procedure.q lngNewAddress(strAdd.s)
Protected sDummy.s=strAdd
Protected Position = FindString(sDummy, ".",1)
If Position>0
Protected a1=Val(Left(sDummy,Position-1))
sDummy=Right(sDummy,Len(sDummy)-Position)
Position = FindString(sDummy, ".",1)
If Position>0
Protected A2=Val(Left(sDummy,Position-1))
sDummy=Right(sDummy,Len(sDummy)-Position)
Position = FindString(sDummy, ".",1)
If Position>0
Protected A3=Val(Left(sDummy,Position-1))
sDummy=Right(sDummy,Len(sDummy)-Position)
Protected A4=Val(sDummy)
Protected dummy.q=0
PokeB(@dummy,a1)
PokeB(@dummy+1,A2)
PokeB(@dummy+2,A3)
PokeB(@dummy+3,A4)
ProcedureReturn dummy
EndIf
EndIf
EndIf
EndProcedure
Procedure ng(Address.s,PING_TIMEOUT=1000,strMessage.s = "Echo This Information Back To Me")
If Ping_Port
Protected MsgLen = Len(strMessage)
Protected ECHO.ICMP_ECHO_REPLY
Protected IPAddressNumber.q = lngNewAddress(Address.s)
Protected *buffer=AllocateMemory(SizeOf(ICMP_ECHO_REPLY)+MsgLen)
Protected lngResult = IcmpSendEcho_(Ping_Port, IPAddressNumber, @strMessage, MsgLen , #Null,*buffer, SizeOf(ICMP_ECHO_REPLY)+MsgLen,PING_TIMEOUT)
If lngResult
CopyMemory(*buffer,@ECHO,SizeOf(ICMP_ECHO_REPLY))
EndIf
FreeMemory(*buffer)
If lngResult
ProcedureReturn ECHO\RoundTripTime
Else
ProcedureReturn -1
EndIf
EndIf
EndProcedure
EndModule
Debug Pi::ng("74.125.136.188")
-
Michael Vogel
- Addict
- Posts: 2797
- Joined: Thu Feb 09, 2006 11:27 pm
- Contact:
Re: Windows platform - network diagnostic app
Hi, maybe also a starter, did write the following more than ten years ago...
...so it's far from perfect - and the program need's a very specific preference file, here's an example which includes a default set (*) and another set (Academy) of devices. To choose a set you'd have to start the program while keeping pressed the shift key.
I know the program is confusing (I did write the program "offline" while on a train) but maybe the ICMP and SNMP parts can be interesting.
...so it's far from perfect - and the program need's a very specific preference file, here's an example which includes a default set (*) and another set (Academy) of devices. To choose a set you'd have to start the program while keeping pressed the shift key.
I know the program is confusing (I did write the program "offline" while on a train) but maybe the ICMP and SNMP parts can be interesting.
Code: Select all
;[VPing Konfiguration]
;S=16 window size (8..32)
;H=20 header size (8..32)
;M=0 shrink font (0..32)
;N=5 shrink header (0..32)
;W=14 enlarge window width (0..32)
;Z=4 line gap (0..10)
;I=250 ping intervall (ms)
;T=200 Ping timeout (ms)
;P=0 Packet size (-Data / +Total Bytes)
;D=0 History (0:off / 1:dots)
;F=0 indicators (0:fix / 1:off)
;V=1 video buffer (0 / 1:no flicker)
;B=2 bar color (0:off / 1:light / 2:dark)
;O=0 On top (0:off / 1:on)
;U=0 Update DNS/local addresses (secs)
;G=0 Log file
;.=1 127.0.0.1 (0:off / 1:on, global, must be before "L")
;L=0 show local IP interfaces (0..5, global)
;A=1 Font
;§=10 max Threads
;C=public ;SNMP Community
[*] ;Default-Set
;G=0
;i=1000
;t=60
VOIP-Client=1.1.1.240
VOIP-Server=1.1.1.1
Switches=2.0.0.1-5
[Academy]
;i=500
A.MLS=10.51.16.1
A.SWI=10.51.16.2
A.POE=10.51.16.3
A.RTR=10.51.16.254
B.MLS=10.52.16.1
DUDE=10.51.16.223
EDV=172.16.250.254
FW=172.16.0.231
INT=1.1.1.1Code: Select all
; Define-Section
EnableExplicit
#Version="Free PB-Version"
#DefaultSet="*"
#AuswahlSet="?"
Global DateiName.s="VPing.ini" ; Konfigurationsdatei
Global Callback.i=0 ; Rückgabewert des Callbacks (für On-Top-Knopf)
Global Timeout.i=200 ; Ping-Timeout
Global Intervall.i=500 ; Abstand zwischen Ping-Durchlauf
Global Packetsize.i=60 ; Packetgröße
Global Packet.s ; Packetinhalt
Global PingTTL.i ; TTL-Rückgabewert
Global FlickerFree.i=0 ; Flackern reduzieren
Global ShowHistory.i=0 ; History anzeigen
Global Y_Height.i=16 ; Höhe Balken
Global Y_Title.i=22 ; Höhe Überschrift
Global Mshrink.i=7 ; Schriftverkleinerung
Global Nshrink.i=14 ; Schriftverkleinerung
Global Y_Width.i=2 ; Fensterbreite
Global Y_Gap.i=4 ; Zwischenraum Überschrift/Balkenteil
Global Y_Minigap.i=2 ; Zwischenraum Balken
Global pollcount.i=0 ; Anzahl der Ping-Durchläufe
Global pollzeit.i=0 ; Zeitmesser
Global fade.i=0 ; Ausblenden
Global bargraphics.i=0 ; Balkengraphik
Global hellerbalken.i=$fff4f4 ; -"-
Global dunklerbalken.i=$f4e8e8 ; -"-
Global punkt.i=$c0b0b0 ; -"-
Global OnTop.i=0 ; Fenster im Vordergrund
Global ShowLocal.i=0 ; Lokale IP-Adresse(n) inkludieren
Global StartLocal.i ; Erstes lokales Interface (1 oder 2)
Global TotalLocals.i=0 ; Anzahl der angezeigten lokalen Interfaces
Global AdressUpdate.i=0 ; Update der IP-Adressen (in sec)
Global AdressUpdateTime.i=0 ; Nächstes Update
Global AdressUpdateActive.i=#False
Global NoNetInit.i=#True ; Initialisierung
Global GlobalSetting.i=#True ; zur Unterscheidung von 'X=' Einstellungen
Global WsaVersion.i=$101 ; WinSock-Version 1.1
Global Community.s="public" ; SNMP Community
Global Logging.i; ; Flag für Log-Datei
Global NeverLogged.i=1; ; Flag für Log-Datei (es wurde noch kein Eintrag geschrieben)
Global LoggingReady.i=0; ; Log-Datei geöffnet
Global Zeit.SYSTEMTIME; ; genaue Zeitangabe (in ms)
Global WindowsTitle.s=" VPing "+#Version
Global StartZeit
Global smallfont.i
Global normalfont.i
Global xborder
Global yborder
Global pausedebugmode.i
Global hintergrund
#Information="S"+#TAB$+"Fenstergröße (8..32)"+#CR$+"H"+#TAB$+"Überschrift (8..32)"+#CR$+"W"+#TAB$+"Fensterverbreiterung (0..32)"+#CR$+"M/N"+#TAB$+"Fontverkleinerung (0..32)"+#CR$+"F"+#TAB$+"Indikatoren (0:fix / 1:ausblenden)"+#CR$+"B"+#TAB$+"Balkengraphik (0:aus / 1:hell / 2:dunkel)"+#CR$+"D"+#TAB$+"Historydiagramm (0:aus / 1:Punkte)"+#CR$+"V"+#TAB$+"Videobuffer (0 / 1:kein Flackern)"+#CR$+"O"+#TAB$+"On top (0:aus / 1:an)"+#CR$+"T"+#TAB$+"Ping-Timeout (ms)"+#CR$+"I"+#TAB$+"Intervall zwischen Pings (ms)"+#CR$+ "P"+#TAB$+"Packetgröße (-Data / +Total Bytes)"+#CR$+"U"+#TAB$+"Update der DNS/Lokal-Adressen (s)"+#CR$+"G"+#TAB$+"Ergebnisse mitloggen (0..2)"+#CR$+"L"+#TAB$+"lokale IP-Interfaces anzeigen (0..5, global)"
Structure IPAdresse
Name.s
IPname.s
SNMPScan.i
DeviceName.s
DeviceType.s
IPchange.i
IP.i
alivenow.i
alivesum.i
TTL.i
timenow.i
timesum.i
timemin.i
timemax.i
alivecount.i
alivecolorfade.i
aliveseq.i
deadcount.i
deadcolorfade.i
deadseq.i
DNSUpdate.i
EndStructure
Enumeration
#Alive_Down
#Alive_Up
#Alive_Undefined
EndEnumeration
#max=100 ; maximale Anzahl der Ini-Konfigurationen
Global Abschnitt.s ; Mehrfach-Konfigurationen
Global AbschnittAktiv.i=#True ; während des Einlesens wichtig
Global Dim Abschnitte.s(#max) ; Namen der Abschnitte (für Parameter '*')
#MaxIP=100
Global Dim Adresse.IPAdresse(#MaxIP)
Global Dim ThreadIDs(#MaxIP) ; Anzahl der Threads
Global Anzahl.i=1 ; Anzahl der tatsächlichen IP-Adressen
Global Dim Workaround(#MaxIP)
Global Dim tab(19)
tab(1) = 10 ; IP
tab(2) = 180 ; Status
tab(3) = 250 ; Leerraum
tab(4) = 260 ; #Ok
tab(5) = 300 ; %Ok
tab(6) = 380 ; Leerraum
tab(7) = 390 ; TTL
tab(8) = 430 ; Leerraum
tab(9) = 440 ; akt
tab(10) = 500 ; durchschn
tab(11) = 560 ; max
tab(12) = 620 ; Leerraum
tab(13) = 630 ; alive
tab(14) = 690 ; Leerraum
tab(15) = 700 ; dead
tab(16) = 750 ; Leerraum
tab(17) = 760 ; name
tab(18) = 870 ; rechter Rand
tab(19) = 880 ; Fensterrand
Declare.i Min(a.i,b.i)
Declare.i Max(a.i,b.i)
Declare.i Y(zeile)
; EndDefine
; Define SNMP-Informationen
Enumeration
#SNMP_Unknown; kein Icon
#SNMP_Successful; (i)
#SNMP_WrongCommunity; /!\
#SNMP_NoReply; (×)
EndEnumeration
Global InfoText.s
Global InfoID
Global InfoMessage.MSG
Global *InfoStruct.NMHDR
Global *InfoText.TOOLTIPTEXT
#GET=$A0
#Field_Variable=10
#SNMP_MaxPacketSize=548
Structure Reference
value.i
EndStructure
Global Dim SNMP_Message.s(#SNMP_NoReply)
SNMP_Message(#SNMP_Unknown)="Keine Ping-Adresse"
SNMP_Message(#SNMP_Successful)="SNMP Informationen"
SNMP_Message(#SNMP_WrongCommunity)="Ungültige SNMP-Informationen"
SNMP_Message(#SNMP_NoReply)="Keine SNMP-Antwort"
; EndDefine
; Logging
Procedure.s ExactTime()
GetSystemTime_(@Zeit.SYSTEMTIME)
ProcedureReturn "'"+RSet(Str((Zeit\wYear)%100),2,"0")+"/"+RSet(Str(Zeit\wMonth),2,"0")+"/"+RSet(Str(Zeit\wDay),2,"0")+" "+RSet(Str(Zeit\wHour),2,"0")+":"+RSet(Str(Zeit\wMinute),2,"0")+":"+RSet(Str(Zeit\wSecond),2,"0")+"."+RSet(Str(Zeit\wMilliseconds),3,"0")
EndProcedure
Procedure MakeLogFile()
If LoggingReady=0
If Logging>0
If OpenFile(0,"Vping.log")
FileSeek(0,Lof(0))
LoggingReady=#True
EndIf
ElseIf Logging=0
Logging=-1
EndIf
EndIf
NeverLogged=#True
EndProcedure
Procedure CloseLogFile()
If LoggingReady
CloseFile(0)
EndIf
EndProcedure
Procedure LogAll()
Protected z
#LoggingResponseTime=1; Anwortzeit in Millisekunden oder "-", falls nicht erreichbar
#LoggingReachableCounter=2; +1,+2,... falls erreichbar, -1,-2,... falls nicht*
;*) je nach gewählten Zeitintervallen können wir auch Ergebnisse, wie "-0, -0, -0, -3, -3, -3, -6,..." erhalten
; das könnte am ICMP selbst liegen. welches möglicherweise unnötig lange wartet und dann plötzlich einen
; Schwung von Negativ-Antworten liefert.
; Könnte evtl. behoben werden, in dem zu lange laufende Threads gekillt werden, z.Zt. per "Workaround"
If Logging>0
If NeverLogged
NeverLogged=0
WriteStringN(0,"")
If Len(Abschnitt)
WriteString(0,Abschnitt)
Else
WriteString(0,ExactTime())
EndIf
z=0
While z<Anzahl
z+1
WriteString(0,#TAB$+Adresse(z)\IPname)
Wend
WriteString(0,#CRLF$)
EndIf
WriteString(0,ExactTime())
z=0
While z<Anzahl
z+1
If Logging=#LoggingResponseTime
If Adresse(z)\Alivenow=#Alive_Up
WriteString(0,#TAB$+Str(Adresse(z)\timenow))
Else
WriteString(0,#TAB$+"-")
EndIf
Else; #LoggingReachableCounter
If Adresse(z)\Alivenow=#Alive_Up
WriteString(0,#TAB$+"+"+Str(Adresse(z)\alivecount))
Workaround(z)=0
Else
If Workaround(z)<Adresse(z)\deadcount
Workaround(z)=Adresse(z)\deadcount
Else
Workaround(z)+1
EndIf
WriteString(0,#TAB$+"-"+Str(Workaround(z)))
EndIf
EndIf
Wend
WriteString(0,#CRLF$)
;FlushFileBuffers(0)
EndIf
EndProcedure
; Ping-Routinen
Procedure GetIPAddress(IPName.s)
If Len(IPName) > 3 ; "n/a" aussparen
ProcedureReturn MakeIPAddress(Val(StringField(IPName,1,".")),Val(StringField(IPName,2,".")),Val(StringField(IPName,3,".")),Val(StringField(IPName,4,".")))
Else
ProcedureReturn 0
EndIf
EndProcedure
Procedure HostnameToIP(n)
Protected ResultIP.s
Protected wsa.wSAData
Protected *host.HOSTENT
Protected AdressNumber.i
Protected IpAddress.i
If Len(Adresse(n)\Name) > 0
ResultIP.s="n/a"
If WSAStartup_(WsaVersion, wsa) = #NOERROR
*host = gethostbyname_(Adresse(n)\Name)
If *host<>#Null
; wozu alle Adressen einlesen???
AdressNumber=0
While PeekL(*host\h_addr_list+AdressNumber)
IpAddress=PeekL(*host\h_addr_list+AdressNumber)
ResultIP=StrU(PeekB(IpAddress),0)+"."+StrU(PeekB(IpAddress+1),0)+"."+StrU(PeekB(IpAddress+2),0)+"."+StrU(PeekB(IpAddress+3),0)
AdressNumber+4
Wend
EndIf
WSACleanup_() ; Close Windows sockets stuff...
EndIf
Adresse(n)\IPName=ResultIP
Adresse(n)\IP=GetIPAddress(ResultIP)
EndIf
EndProcedure
Procedure DNSHostnameToIP(n)
Protected DNSThreadID.i
Protected wait.i=500; 250ms
DNSThreadID=CreateThread(@HostnameToIP(),n)
While wait>0
Delay(10)
If IsThread(DNSThreadID)
wait-1
If wait=0
KillThread(DNSThreadID)
Delay(50)
Adresse(n)\IPName="n/a"
Adresse(n)\IP=0
EndIf
Else
wait=0
EndIf
Wend
EndProcedure
Procedure Ping(IPAddress); Timeout und Message (durch Packet ersetzt) sind nun global
; -2 Namensauflösung fehlgeschlagen // -1 Host nicht erreichbar // 0.. ms
Protected ResultSize
Protected *Result
Protected *Echo.ICMP_ECHO_REPLY
Protected hFile.i
Protected Ergebnis.i
ResultSize = SizeOf(ICMP_ECHO_REPLY)+Len(Packet); anstelle von Len(Message)
*Result = AllocateMemory(ResultSize)
*Echo.ICMP_ECHO_REPLY = *Result
If IpAddress <> 0
hFile = IcmpCreateFile_()
Ergebnis=IcmpSendEcho_(hFile, IpAddress, Packet, Len(Packet), 0, *Result, ResultSize, Timeout+100)
If Ergebnis>0
Ergebnis=*Echo\RoundTripTime
If Ergebnis>Timeout
Ergebnis=-3
Else
PingTTL=*Echo\Options\Ttl & $000000FF
EndIf
Else
Ergebnis=-1
EndIf
IcmpCloseHandle_(hFile)
Else
Ergebnis=-2
EndIf
FreeMemory(*Result)
ProcedureReturn Ergebnis
EndProcedure
; Tools
Procedure.i Min(a.i,b.i)
; Function: returns smaller of two numbers
If a<b
ProcedureReturn a
Else
ProcedureReturn b
EndIf
EndProcedure
Procedure.i Max(a.i,b.i)
; Function: returns smaller of two numbers
If a>b
ProcedureReturn a
Else
ProcedureReturn b
EndIf
EndProcedure
; Allgemeine Routinen
Procedure.i GetParam(a.s,b.s,Defaultwert.i,min.i,max.i)
Protected value.i
Protected search.i
value=Defaultwert
search=FindString(a,";"+b+"=",1)
If search
value=Val(Mid(a,search+3,9)); 3 Zeichen überspringen (";X=")
EndIf
value=min(value,max)
value=max(value,min)
;Debug value
ProcedureReturn Value
EndProcedure
Procedure AdressenEinlesen()
Protected FileHandle.i
Protected Count.i
Protected quit.i
Protected start.i,rumpf.s,anfang.i,ende.i
Protected pos.i
Protected Line.s
Protected TempAdresse.i
Define Fehler.i=#True
If FileSize(DateiName)
FileHandle=ReadFile(#PB_Any,"VPing.ini")
If FileHandle
Fehler=#False
If CountProgramParameters()
Abschnitt=ProgramParameter()
If Abschnitt<>"" ; wegen Compiler-Fehlers...
AbschnittAktiv=#False
EndIf
Else
Abschnitt=#DefaultSet
EndIf
If (Abschnitt=#AuswahlSet) Or (GetKeyState_(#VK_SHIFT) & 128)
OpenWindow(1, 0, 0, 200, 200," VPing Set auswählen...",#PB_Window_ScreenCentered | #PB_Window_SystemMenu)
;CreateGadgetList(WindowID(1))
;ListViewGadget(1, 5, 5, 190, 190) ; kann zwischen Tastatur- und Mausselektion nicht unterscheiden
ListIconGadget(1, 5, 5, 190, 190,"VPing-Sets",186)
;AddGadgetItem(1, -1, "",)
AddGadgetItem(1, -1, "Default-Set")
count.i=0
Abschnitte(0)=#DefaultSet
While Not(Eof(FileHandle)) And count<#max
Line=Trim(ReadString(filehandle))
quit=FindString(Line,"]",2)
If (quit>0)
If (FindString(Line,"[",1)=1) And (LCase(Mid(Line,2,quit-2))<>#DefaultSet)
count+1
Abschnitte(count)=Mid(line,2,quit-2)
AddGadgetItem(1, -1, Abschnitte(count))
EndIf
EndIf
Wend
; anderen Fensterrahmen...
SetWindowLong_(WindowID(1),#GWL_EXSTYLE,GetWindowLong_(WindowID(1),#GWL_EXSTYLE)| #WS_EX_TOOLWINDOW)
SetWindowPos_(WindowID(1),#HWND_TOPMOST,0,0,0,0,#SWP_NOMOVE|#SWP_NOSIZE|#SWP_FRAMECHANGED);#SWP_NOZORDER
FileSeek(FileHandle,0)
SetGadgetState(1, 0)
SetActiveGadget(1)
; ...und in den Vordergrund
SetForegroundWindow_(WindowID(1)); geht nicht bei UPXten Files?
quit.i=-1
Repeat
Define wait.i
wait=WaitWindowEvent()
Select Wait
Case #PB_Event_Gadget
If EventType()=0
quit=GetGadgetState(1)
EndIf
Case #WM_CHAR
Select EventwParam()
Case 27
quit=999
Case 13,32
quit=GetGadgetState(1)
EndSelect
Case #PB_Event_CloseWindow
quit=999
EndSelect
Until quit>=0
CloseWindow(1)
Select quit
Case 0
Abschnitt=Abschnitte(quit)
AbschnittAktiv=#True
Case 1 To count
Abschnitt=Abschnitte(quit)
AbschnittAktiv=#False
Case 1000
Abschnitt=""
AbschnittAktiv=#True
Default
End
EndSelect
EndIf
EndIf
;Else
; entwerde eine Fehlermeldung...
; MessageBox_(0,"'VPing.ini' nicht gefunden!","VPing Fehler", #MB_ICONERROR | #MB_OK)
; End
EndIf
;MessageBox_(0,abschnitt,Str(AbschnittAktiv), icon | #MB_OK)
Adresse(1)\Name="Localhost"
Adresse(1)\IPName="127.0.0.1"
Adresse(1)\IP=GetIPAddress(Adresse(1)\IPName)
Adresse(1)\Timemin=9999
Adresse(1)\alivenow=#Alive_Undefined
If Fehler=0
;MessageRequester("Fehler","Datei ''VPing.lst'' nicht gefunden...",0)
;Else
While Not(Eof(FileHandle))
Line.s=Trim(ReadString(filehandle))
; Parametereinstrellungen...
If FindString(Line,";",1)=1 And (GlobalSetting Or AbschnittAktiv)
quit=FindString(UCase(line),"C=",1)
If quit
Community=Trim(PeekS(@line+quit+1))
quit=FindString(Community," ",1)
If quit : Community=Left(Community,quit-1) : EndIf
quit=FindString(Community,#TAB$,1)
If quit : Community=Left(Community,quit-1) : EndIf
Else
line=UCase(line)
Y_Height=GetParam(line,"S",Y_Height,8,32)
Y_Title=GetParam(line,"H",Y_Height,8,32)
Y_Width=GetParam(line,"W",Y_Width,0,32)
Y_Minigap=GetParam(line,"Z",Y_Minigap,0,10)
timeout=GetParam(line,"T",timeout,10,3000)
intervall=GetParam(line,"I",intervall,10,5000)
packetsize=GetParam(line,"P",packetsize,-10000,10000)
fade=GetParam(line,"F",fade,0,1)
Mshrink=GetParam(line,"M",Mshrink,4,32)
Nshrink=GetParam(line,"N",Nshrink,4,32)
flickerfree=GetParam(line,"V",flickerfree,0,1)
bargraphics=GetParam(line,"B",bargraphics,0,2)
ShowHistory=GetParam(line,"D",ShowHistory,0,1)
OnTop=GetParam(line,"O",OnTop,0,1)
ShowLocal=GetParam(line,"L",Showlocal,-5,5)
Logging=GetParam(line,"G",Logging,-2,2)
AdressUpdate=GetParam(line,"U",AdressUpdate,0,100)
;die Zeile ";.=0" muss vor der Zeile ";L=" stehen, sonst werden alle Loop-Adressen ausgeblendet...
If (GetParam(line,".",1,0,1)=0) And (Anzahl=1) And (Adresse(1)\IPName="127.0.0.1")
Anzahl=0
EndIf
If ShowLocal And NoNetInit; "L=" nur einmal (global) ausführen...
If ShowLocal<0 ; negativ?
ShowLocal=-ShowLocal
If Anzahl=1 ; Localhostzeile (127.0.0.1) streichen...
Anzahl=0
EndIf
EndIf
InitNetwork()
NoNetInit=#False
StartLocal=Anzahl ; erste Lokaladresse (1:nach oder 0:anstelle von 127.0.0.1)
If ExamineIPAddresses()
While ShowLocal
ShowLocal-1
TempAdresse=NextIPAddress()
If TempAdresse
Anzahl+1
TotalLocals+1
Adresse(Anzahl)\Name="Local #"+Str(TotalLocals)
Adresse(Anzahl)\IPName=IPString(TempAdresse)
Adresse(Anzahl)\IP=GetIPAddress(Adresse(Anzahl)\IPName)
Adresse(Anzahl)\Timemin=9999
Adresse(Anzahl)\alivenow=#Alive_Undefined
Adresse(Anzahl)\DNSUpdate=#True ;nur für Bildschirmausgabe...
Adresse(Anzahl)\SNMPScan=#SNMP_Unknown
Else
ShowLocal=0
EndIf
Wend
EndIf
;Debug zeit.l-GetTickCount_()
ShowLocal=0
EndIf
EndIf
ElseIf FindString(Line,"[",1)=1
GlobalSetting=#False
If FindString(LCase(Line),LCase(Abschnitt)+"]",2)=2 ; falls notwendig: CharLower_(@Line)
AbschnittAktiv=#True
Else
AbschnittAktiv=#False
EndIf
ElseIf Len(Line) And AbschnittAktiv
If Anzahl<#MaxIP
pos=FindString(Line,"=",1)
If pos
; Name für IP-Adresse angegeben, z.B.: Server=1.2.3.4
Anzahl+1
Adresse(Anzahl)\alivenow=#Alive_Undefined
Adresse(Anzahl)\Name=Left(line,pos-1)
Adresse(Anzahl)\IPName=Mid(line,pos+1,999)
Adresse(Anzahl)\IP=GetIPAddress(Adresse(Anzahl)\IPName)
Adresse(Anzahl)\SNMPScan=#SNMP_Unknown
ElseIf (Asc(line)>47) And (Asc(line)<58)
; auf IP-Bereich überprüfen, z.B.: 127.0.0.1-10
pos=FindString(Line,"-",1)
If pos>7 ; Minus-Symbol darf nicht weiter links sein (1.2.3.4-5)
start=pos-2
While start>5 ; letzter IP-Trenner darf nicht weiter links sein (1.2.3.4-5)
If Mid(line,start,1)="."
Break
EndIf
start-1
Wend
If start>5
rumpf.s=Left(line,start) ; 1.2.3.
anfang.i=Val(Mid(line,start+1,pos-start-1)) ; 4
ende.i=Val(Mid(line,pos+1,999)) ; 5
; jeden IP-Eintrag nun "anlegen"...
While (anfang<=Ende) And (anfang<256) And (anzahl<#MaxIP)
anzahl+1
Adresse(Anzahl)\alivenow=#Alive_Undefined
Adresse(Anzahl)\Name=rumpf+Str(anfang)
Adresse(Anzahl)\IPName=rumpf+Str(anfang)
Adresse(Anzahl)\IP=GetIPAddress(Adresse(Anzahl)\IPName)
Adresse(Anzahl)\SNMPScan=#SNMP_Unknown
anfang+1
Wend
EndIf
Else
; normale IP-Adresse
Anzahl+1
Adresse(Anzahl)\alivenow=#Alive_Undefined
Adresse(Anzahl)\Name=Line
Adresse(Anzahl)\IPName=Line
Adresse(Anzahl)\IP=GetIPAddress(Adresse(Anzahl)\IPName)
Adresse(Anzahl)\SNMPScan=#SNMP_Unknown
EndIf
Else
; Versuch, per Namensauflösung eine IP-Adresse zu bekommen...
Anzahl+1
Adresse(Anzahl)\alivenow=#Alive_Undefined
Adresse(Anzahl)\Name=Line
CreateThread(@DNSHostnameToIP(),Anzahl)
Adresse(Anzahl)\DNSUpdate=#True
Adresse(Anzahl)\SNMPScan=#SNMP_Unknown
EndIf
EndIf
;Debug Line
EndIf
Wend
CloseFile(FileHandle)
Timeout=min(Intervall,Timeout) ; Timeout limitieren...
If Packetsize<0
Packetsize=-Packetsize+42 ; 14(Ethernet) + 20(IP) + 8(ICMP) Byte // evtl. noch + 4 (CRC) Byte
EndIf
Packet=LSet("<- VPing "+#Version+" - (c) 2012 by Michael Vogel -",Packetsize-42,">")
;CreateFile(1,"f:\Debug.log")
;WriteStringN(1,Packet)
;WriteStringN(1,Str(Packetsize))
;CloseFile(1)
If bargraphics=2
hellerbalken=$ffe0e0
dunklerbalken=$ffd0d0
EndIf
EndIf
EndProcedure
Procedure Callback(WindowID,Message,wParam,lParam)
Select Message
Case #WM_SYSCOMMAND
If wParam=#SC_MAXIMIZE
Callback=1
ProcedureReturn 0
EndIf
Case #WM_MOUSEMOVE
InfoMessage\hwnd=WindowID
InfoMessage\message=Message
InfoMessage\wParam=wParam
InfoMessage\lParam=lParam
SendMessage_(InfoID,#TTM_RELAYEVENT,0,InfoMessage)
Case #WM_NOTIFY
*InfoStruct=lParam
If *InfoStruct\code=#TTN_NEEDTEXT
*InfoText=lParam
With Adresse(*InfoText\hdr\idFrom)
SendMessage_(InfoID,#TTM_SETTITLE,\SNMPScan,SNMP_Message(\SNMPScan))
InfoText=\IPName+ " ("+\Name+")";+Str(*InfoText\hdr\idFrom)
If \SNMPScan=#SNMP_Successful
InfoText+#CR$+\DeviceName+#CR$+\DeviceType
EndIf
EndWith
*InfoText\lpszText=@InfoText
EndIf
EndSelect
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
; GUI
Procedure Init()
Define i.i
Define xsize.i,ysize.i
AdressenEinlesen()
If Len(Abschnitt)
If Abschnitt=#DefaultSet
Abschnitt="Default-Set"
EndIf
WindowsTitle+" • "+Abschnitt
Abschnitt="["+Abschnitt+"]"
EndIf
i=Year(Date())
Y_Height=Max(Y_Height,4)
Mshrink=Min(Mshrink,Y_Height-1);
Y_Title=Max(Y_Title,4)
Nshrink=Min(Nshrink,Y_Title-1);
; Abstand zwischen Hauptfenster und Über/Unterschriftsbereich leicht anpassen
Y_Gap+Y_Minigap>>1
StartZeit=0
For i=1 To 19
tab(i) = (tab(i)*Y_Height)>>5+Y_Width*i
If i>17
tab(i)+Y_Width
EndIf
Next i
Global Dim Alive.s(2)
Alive(0)="Dead"
Alive(1)="Alive"
Alive(2)="n/a"
;Fontname.s="MS Sans"
;Global Small=CreateFont_(height-sub-add,0,0,0,500,0,0,0,#ANSI_CHARSET,#OUT_DEFAULT_PRECIS,#CLIP_DEFAULT_PRECIS,#DEFAULT_QUALITY,#DEFAULT_PITCH,*Fontname)
;Global Font=CreateFont_(height-sub,0,0,0,500,0,0,0,#ANSI_CHARSET,#OUT_DEFAULT_PRECIS,#CLIP_DEFAULT_PRECIS,#PROOF_QUALITY,#DEFAULT_PITCH,*Fontname)
smallfont=LoadFont(#PB_Any,"MS Sans",Y_Title-Nshrink)
normalfont=LoadFont(#PB_Any,"MS Sans",Y_Height-Mshrink)
xborder=GetSystemMetrics_(#SM_CXBORDER)<<1
yborder=GetSystemMetrics_(#SM_CYBORDER)<<1;+GetSystemMetrics_(#SM_CYCAPTION)
tab(19)+xborder
xsize=tab(19)
ysize=y(anzahl+1)+yborder+Y_Title
;d_& = tab(7) - tab(6) // Spaltenbreite für Zeitbalken
; History
Global Dim HistoryNow(Anzahl,Y_Height)
Global Dim HistoryMed(Anzahl,Y_Height)
Global Dim HistoryMax(Anzahl,Y_Height)
OpenWindow(0,40,40,xsize,ysize,WindowsTitle,#PB_Window_SystemMenu | #PB_Window_MinimizeGadget |#PB_Window_MaximizeGadget)
;SetWindowLong_(WindowID(0),#GWL_EXSTYLE,GetWindowLong_(WindowID(0),#GWL_EXSTYLE)|#WS_EX_CONTEXTHELP)
;SetWindowPos_(WindowID(0),0,0,0,0,0,#SWP_NOMOVE|#SWP_NOSIZE|#SWP_FRAMECHANGED|#SWP_NOZORDER)
;SetWindowLong_(WindowID(0),#GWL_EXSTYLE,GetWindowLong_(WindowID(0),#GWL_EXSTYLE)|#WS_EX_LAYERED|#WS_EX_TOOLWINDOW)
;SetLayeredWindowAttributes_(WindowID(0),0,99,#LWA_ALPHA)
#TTS_NOFADE=$20
#TTS_NOANIMATE=$10
InfoID=CreateWindowEx_(0,"Tooltips_Class32","",#TTS_ALWAYSTIP|#TTS_NOFADE|#TTS_NOANIMATE|#WS_EX_TOPMOST,0,0,0,0,0,0,0,0);#TTS_BALLOON
SendMessage_(InfoID,#TTM_SETTITLE,2,"Keine Informationen vorhanden")
SendMessage_(InfoID,#TTM_SETMAXTIPWIDTH,0,240)
;SendMessage_(InfoID,#TTM_SETTITLE,1,"SNMP Informationen")
Protected InfoTool.TOOLINFO
InfoTool\cbSize=SizeOf(TOOLINFO)
InfoTool\uFlags=#TTF_CENTERTIP
InfoTool\hwnd=WindowID(0)
InfoTool\lpszText=#LPSTR_TEXTCALLBACK
For i=1 To Anzahl
InfoTool\uId=i
SetRect_(@InfoTool\rect,0,Y(i),tab(2),Y(i)+Y_Height)
SendMessage_(InfoID,#TTM_ADDTOOL,0,InfoTool)
Next i
StickyWindow(0,OnTop)
SetWindowPos_(InfoID,#HWND_TOPMOST,0,0,0,0,#SWP_NOREDRAW|#SWP_NOMOVE|#SWP_NOSIZE); ****
If flickerfree
InitSprite()
OpenWindowedScreen(WindowID(0), 0,0, xsize,ysize, 0,0,0)
EndIf
SetWindowCallback(@callback(),0)
pausedebugmode.i=0
hintergrund=GetSysColor_(#COLOR_BTNFACE)
EndProcedure
Procedure Balken(n.i,z,y,wert.i)
Define color.i
If bargraphics
If z&1
color=hellerbalken; $ffe8e8
Else
color=dunklerbalken; $ffe0e0
EndIf
Box(tab(n)+1,y+1,max(1,(tab(n+1)-tab(n)-2)*min(wert,Timeout)/Timeout),Y_Height-2,color)
EndIf
EndProcedure
Procedure.s Strich(n)
If n
ProcedureReturn Str(n)
Else
ProcedureReturn "-"
EndIf
EndProcedure
Procedure.i Y(zeile)
Select zeile
Case 0
ProcedureReturn 0
Case Anzahl+1
ProcedureReturn Anzahl*(Y_Height+Y_Minigap)-Y_Minigap+Y_Title+Y_Gap<<1
Case -1
ProcedureReturn Y_Title+Y_Gap>>1
Case -2
ProcedureReturn Y_Title+Anzahl*(Y_Height+Y_Minigap)-Y_Minigap+Y_Gap+Y_Gap>>1
Default
ProcedureReturn (zeile-1)*(Y_Height+Y_Minigap)+Y_Title+Y_Gap
EndSelect
EndProcedure
Procedure.i Z(zeile)
Select zeile
Case 0,Anzahl+1
ProcedureReturn Y(zeile)+Nshrink>>1-(Y_Title-Nshrink)>>2
Default
; Schrift in die Mitte rücken (+ Verkleinerung - Schriftversatz von Arial)
ProcedureReturn Y(zeile)+Mshrink>>1-(Y_Height-Mshrink)>>2
EndSelect
EndProcedure
; SNMP (auf Minimum reduziert)
Procedure.i BE_Length(*memory,*pos.Reference)
; Calculates length of actual field...
Protected byte
Protected length
Protected n
byte=PeekB(*memory+*pos\Value)
*pos\Value+1
If byte&$80; multi-byte length
byte&$3; number of bytes for length information
While byte
length<<8
length+(PeekB(*memory+*pos\Value)&$ff)
byte-1
*pos\Value+1
Wend
Else
length=byte&$7f
EndIf
;Debug "Len: "+Str(length)
ProcedureReturn length
EndProcedure
Procedure.i BM_Integer(value.i,*memory,*pos.Reference)
; Writes integer value into memory, starting at position *pos
; Returns number of used Bytes...
If (value<$80)
PokeB(*memory+*pos\Value,value)
value=1
Else
PokeB(*memory+*pos\Value,(value>>8)&$ff)
PokeB(*memory+*pos\Value+1,value&$ff)
value=2
EndIf
*pos\Value+value
ProcedureReturn value
EndProcedure
Procedure.i BM_Value(value.i,*memory,*pos.Reference)
; should use quads, but because of pures poor quad handling limited to long for now ;(
; Writes integer value into memory, starting at position *pos
; Returns number of used Bytes...
If (value>=0) And (value<128)
PokeB(*memory+*pos\Value,value)
value=1
Else
value=0
EndIf
*pos\Value+value
ProcedureReturn value
EndProcedure
Procedure.i BM_String(value.s,*memory,*pos.Reference)
; Writes string value into memory, starting at position *pos
; Returns number of used Bytes...
Protected length=Len(value)
If length
PokeS(*memory+*pos\Value,value,length)
*pos\Value+length
EndIf
ProcedureReturn length
EndProcedure
Procedure.i BM_Object(OID.s,*memory,*pos.Reference)
; Writes OID object into memory starting at position *pos
; Returns number of used bytes
Protected i
Protected length=0
length+BM_Value(43,*memory,*pos)
For i=1 To 7
length+BM_Value(Val(StringField(OID,i,".")),*memory,*pos)
Next
ProcedureReturn length
EndProcedure
Procedure.i BM_Move(value.i,length.i,*memory,*pos.Reference)
; Insert byte value into memory block...
; Returns total length
; Auf Anregung von "Infratec" habe ich CopyMemory gegen MoveMemory getauscht...
MoveMemory(*memory+*pos\Value-length,*memory+*pos\Value-length+2,length)
PokeB(*memory+*pos\Value-length,value)
PokeB(*memory+*pos\Value-length+1,length)
*pos\Value+2
ProcedureReturn length+2
EndProcedure
Procedure.i BM_Null(value.i,*memory,*pos.Reference)
; Writes byte value into memory address...
; Returns length (=2)
PokeB(*memory+*pos\Value,value)
PokeB(*memory+*pos\Value+1,0)
*pos\Value+2
ProcedureReturn 2
EndProcedure
Procedure.i PDU_Check(n,*memory)
Protected byte
Protected length
Protected pos
Protected field
Protected Value.s
pos=0
Repeat
byte=PeekB(*memory+pos)&$ff
pos+1
length=BE_Length(*memory,@pos);
If byte&$e0=0
If (byte=4) And (field=#Field_Variable)
Value=PeekS(*memory+pos,length)
If n>Anzahl
n-Anzahl
Adresse(n)\DeviceName=Value
Else
Adresse(n)\DeviceType=Value
EndIf
If Len(Value)
; "gültige" SNMP-Antwort...
Adresse(n)\SNMPScan=#SNMP_Successful
EndIf
EndIf
pos+length
EndIf
field+1
Until field>#Field_Variable
ProcedureReturn 0
EndProcedure
Procedure.i PDU_Make(n,*memory)
; compose SNMP packet into reserved memory (548 bytes)
; n = Request number
; Returns packet length
Protected length
Protected pos
Protected PositionA,PositionB
; SNMPv1
length=BM_Value($00,*memory,@pos)
length=BM_Move($02,length,*memory,@pos)
; Community
length=BM_String(Community,*memory,@pos)
length=BM_Move($04,length,*memory,@pos)
PositionA=pos
; Request ID
length=BM_Integer(n,*memory,@pos)
length=BM_Move($02,length,*memory,@pos)
; Error-Status
length=BM_Value(0,*memory,@pos)
length=BM_Move($02,length,*memory,@pos)
; Error-Index
length=BM_Value(0,*memory,@pos)
length=BM_Move($02,length,*memory,@pos)
PositionB=pos
; OID
length=BM_Object("6.1.2.1.1."+Chr('1'+((n-1)/Anzahl)<<2)+".0",*memory,@pos); 1 oder 5
length=BM_Move($06,length,*memory,@pos)
; NULL
length=BM_Null($05,*memory,@pos)
; Envelope OID and Null-field (two times)
length=BM_Move($30,pos-PositionB,*memory,@pos)
length=BM_Move($30,pos-PositionB,*memory,@pos)
; Envelope Request-ID, Error Information and OID-Envelope
length=BM_Move(#GET,pos-PositionA,*memory,@pos)
; Envelope all SNMP fields
length=BM_Move($30,pos,*memory,@pos)
ProcedureReturn pos
EndProcedure
Procedure.i SNMP_Get(n)
Protected *pointer
Protected *Buffer
Protected Status
Protected Start
Protected SockInfo.sockaddr_in
Protected SockIdent
With Adresse(1+(n-1)%Anzahl)
If \IP
*pointer=Sockinfo
sockinfo\sin_family=#AF_INET
sockinfo\sin_port=htons_(161)
sockinfo\sin_addr=\IP
SockIdent=SOCKET_(#AF_INET,2,0)
If SockIdent<>#INVALID_SOCKET
*Buffer=AllocateMemory(#SNMP_MaxPacketSize)
If *Buffer
Status=PDU_Make(n,*Buffer)
If Status
If sendto_(SockIdent,*Buffer,Status,0,*pointer,SizeOf(sockaddr_in)) <> #SOCKET_ERROR
; SNMP-Anfrage geschickt... (noch keine Antwort)
If \SNMPscan=#SNMP_Unknown : \SNMPscan=#SNMP_NoReply : EndIf
;Status=0
Start=Date()
Repeat
Delay(1)
Status=recv_(SockIdent,*Buffer,#SNMP_MaxPacketSize,2)
If Date()-Start>5
Status=#SOCKET_ERROR
EndIf
Until Status<>0
If Status<>#SOCKET_ERROR
;ReAllocateMemory(*Buffer,Status)
; SNMP-Antwort erhalten... (aber nicht unbedingt eine gültige Antwort)
If \SNMPscan%#SNMP_NoReply=#SNMP_Unknown : \SNMPscan=#SNMP_WrongCommunity : EndIf
Status=PDU_Check(n,*Buffer)
Else
Status=0
EndIf
EndIf
EndIf
FreeMemory(*Buffer)
EndIf
EndIf
EndIf
EndWith
ProcedureReturn Status
EndProcedure
; Ping & Co
Procedure Write(spalte,zeile,text.s)
Define x.i
x=tab(spalte)
Select spalte
Case 2 To 16
x=(tab(spalte+1)+tab(spalte)-TextWidth(text))/2
EndSelect
DrawText(x,z(zeile),text,#Black)
EndProcedure
Procedure WriteAll()
Protected i,n
Define y.i
Define z.i
Define color.i
Define wert.i
Define Sekunden.i
If flickerfree
ClearScreen(hintergrund)
StartDrawing(ScreenOutput())
Else
StartDrawing(WindowOutput(0))
EndIf
DrawingFont(FontID(smallfont))
BackColor(hintergrund)
;DrawingMode(1)
write(1,0,"Adresse")
write(2,0,"Status")
write(4,0,"#Ok")
write(5,0,"%Ok")
write(7,0,"TTL")
write(9,0,"akt.")
write(10,0,"Ø")
write(11,0,"max.")
write(13,0,"Alive")
write(15,0,"Dead")
write(17,0,"Name")
Sekunden=(GetTickCount_()-StartZeit)/1000
write(1,Anzahl+1,"Ping-Statistik: ")
write(2,Anzahl+1," "+Str(-pollzeit)+"ms ")
write(4,Anzahl+1," "+Str(pollcount)+"x ")
write(5,Anzahl+1," "+Str(Sekunden)+"s ")
;
;write(2,Anzahl+1," Zeit: "+Str((GetTickCount_()-StartZeit)/1000)+"s ")
;write(4,Anzahl+1," Ping: "+Str(pollcount)+" ")
;write(5,Anzahl+1," =100%")
write(10,Anzahl+1,"Intervall: "+Str(intervall)+"ms / Timeout: "+Str(Timeout)+"ms")
Select PauseDebugMode
Case 0
If pollcount<2 ; eigentlich =1, kann aber manchmal auch noch 0 sein...
AdressUpdateTime=Sekunden+AdressUpdate
BackColor($ffffff)
write(17,Anzahl+1," Restart... ")
ElseIf AdressUpdate And (Sekunden>=AdressUpdateTime)
AdressUpdateTime=Sekunden+AdressUpdate
AdressUpdateActive=#True
BackColor($40c0f0)
write(17,Anzahl+1," Adressen ")
ElseIf Logging>0
BackColor($BAE2FE)
write(17,Anzahl+1," Logging ")
Else
BackColor(hintergrund)
write(17,Anzahl+1," Running ")
EndIf
Case 1
BackColor($00ffff)
write(17,Anzahl+1," P A U S E ")
Case 2
BackColor($00ffff)
write(17,Anzahl+1," D E B U G ")
EndSelect
For z=-2 To -1
y=y(z) ;*(height+add)-add-1
FrontColor($fff0f0)
LineXY(0,y,tab(19),y)
FrontColor($D0c0c0)
LineXY(0,y-1,tab(19),y-1)
FrontColor(0)
Next z
z=0
While z<Anzahl
z+1
y=y(z)
If z&1
color=$fff8f8
Else
color=$ffe8e8
EndIf
Box(0,y,tab(19),Y_Height,color)
DrawingFont(FontID(normalfont))
DrawingMode(1)
;With Adresse()
Select Adresse(z)\Alivenow
Case #Alive_Down
color=$4040f0
Case #Alive_Up
color=$40f000
Case #Alive_Undefined
color=$40f0f0
EndSelect
Box(tab(2),y,tab(3)-tab(2),Y_Height,color)
If Adresse(z)\IPchange>0
If fade
Adresse(z)\IPchange-1
color=$a0d8f8-$180a02*Adresse(z)\IPchange
Else
Adresse(z)\IPchange=0
color=$40c0f0
EndIf
Box(tab(1)/2,y,tab(2)-tab(1),Y_Height,color)
EndIf
If AdressUpdateActive And Adresse(z)\DNSupdate
write(1,z,Adresse(z)\IPName+"*")
Else
write(1,z,Adresse(z)\IPName)
EndIf
write(1,z,Adresse(z)\IPName)
write(2,z,alive(Adresse(z)\Alivenow))
write(4,z,Str(Adresse(z)\Alivesum))
If Adresse(z)\Alivesum>0
If Adresse(z)\Alivenow
write(7,z,Str(Adresse(z)\TTL))
balken(9,z,y,Adresse(z)\timenow)
EndIf
If ShowHistory
n=tab(10)-tab(9)-2
For i=1 To Y_Height-2
If HistoryNow(z,i)>=0
Plot(tab(9)+max(1,n*min(HistoryNow(z,i),Timeout)/Timeout),y+i,punkt)
EndIf
Next i
EndIf
If Adresse(z)\Alivenow
write(9,z,Str(Adresse(z)\timenow))
Else
write(7,z,"-")
write(9,z,"-")
EndIf
write(5,z,StrF(100.0*Adresse(z)\Alivesum/(pollcount),1))
wert=Adresse(z)\timesum/Adresse(z)\Alivesum
balken(10,z,y,wert)
If ShowHistory
HistoryMed(z,Y_Height-1)=wert
n=tab(11)-tab(10)-2
For i=1 To Y_Height-2
HistoryMed(z,i)=HistoryMed(z,i+1)
Plot(tab(10)+max(1,n*min(HistoryMed(z,i),Timeout)/Timeout),y+i,punkt)
Next i
EndIf
write(10,z,Str(wert))
wert=Adresse(z)\timemax
balken(11,z,y,wert)
If ShowHistory
HistoryMax(z,Y_Height-1)=wert
n=tab(12)-tab(11)-2
For i=1 To Y_Height-2
HistoryMax(z,i)=HistoryMax(z,i+1)
Plot(tab(11)+max(1,n*min(HistoryMax(z,i),Timeout)/Timeout),y+i,punkt)
Next i
EndIf
write(11,z,Str(wert))
If Adresse(z)\aliveseq>0 And Adresse(z)\aliveseq=Adresse(z)\alivecount
Box(tab(13),y,tab(14)-tab(13),Y_Height,$40f040)
If fade : Adresse(z)\Alivecolorfade=3 : EndIf
ElseIf Adresse(z)\Alivecolorfade
Adresse(z)\Alivecolorfade-1
Box(tab(13),y,tab(14)-tab(13),Y_Height,$d0f0d0-$100010*Adresse(z)\alivecolorfade)
EndIf
write(13,z,Strich(Adresse(z)\aliveseq))
If Adresse(z)\deadseq>0 And Adresse(z)\deadseq=Adresse(z)\deadcount
Box(tab(15),y,tab(16)-tab(15),Y_Height,$4040f0)
If fade : Adresse(z)\Deadcolorfade=3 : EndIf
ElseIf Adresse(z)\Deadcolorfade
Adresse(z)\Deadcolorfade-1
Box(tab(15),y,tab(16)-tab(15),Y_Height,$d0d0f0-$101000*Adresse(z)\deadcolorfade)
EndIf
write(15,z,Strich(Adresse(z)\deadseq))
Else
write(5,z,"n/a")
write(7,z,"n/a")
write(9,z,"n/a")
write(10,z,"n/a")
write(11,z,"n/a")
write(13,z,"n/a")
write(15,z,"n/a")
EndIf
write(17,z,Adresse(z)\Name)
Wend
StopDrawing()
If flickerfree
FlipBuffers()
EndIf
EndProcedure
Procedure PollOne(record.i)
Protected result.i
Protected i
;SelectElement(Adresse(), test)
With Adresse(record)
If pausedebugmode
Result=Random(3)-1
If result>0 : Result=Random(Timeout) : EndIf
Else
Result=Ping(\IP)
Debug Hex(\IP)+": "+Str(result)+" !"
;Delay(Random(100+20))
EndIf
If Result<0
\Alivenow=#Alive_Down
\Alivecount=0
\Deadcount+1
\Deadseq=Max(\Deadcount,\Deadseq)
;DrawText(10,y,\Name+" = "+\IP+" dead "+Str(128-PingGetTTL())+" Hop")
Else
\Alivenow=#Alive_Up
\Alivesum+1
\Alivecount+1
\Deadcount=0
\Timenow=Result
\Timesum+Result
\Timemin=Min(Result,\Timemin)
\Timemax=Max(Result,\Timemax)
\Aliveseq=Max(\Alivecount,\Aliveseq)
\TTL=PingTTL
; bei gültiger IP-Adresse ein einziges Mal SNMP-Infos holen...
If \SNMPScan=#SNMP_Unknown
SNMP_Get(record); Geräte-Typ
SNMP_Get(record+Anzahl); Geräte-Name
EndIf
EndIf
If ShowHistory
For i=1 To Y_Height-3
HistoryNow(record,i)=HistoryNow(record,i+1)
Next i
HistoryNow(record,Y_Height-2)=result
EndIf
EndWith
EndProcedure
Procedure PollAll()
Define zeiger.i
Define delay.i
Define ActiveThreads.i
Define i.i
Define TempAdresse.i
pollzeit=GetTickCount_()
pollcount+1
zeiger=0
While zeiger<Anzahl
zeiger+1
ThreadIDs(zeiger)=CreateThread(@PollOne(),zeiger)
Wend
; Adress-Updates (lokale IP-Ports und DNS-Namen)...
If AdressUpdateActive
i=0
If TotalLocals; lokale Adressen überprüfen (DHCP)
If ExamineIPAddresses()
While i<TotalLocals
i+1
TempAdresse=NextIPAddress()
If TempAdresse<>Adresse(StartLocal+i)\IP; Or Random(2)=0; fürs Testen...
Adresse(StartLocal+i)\IPchange=5
If TempAdresse
Adresse(StartLocal+i)\Name="Local #"+Str(i)
Adresse(StartLocal+i)\IPName=IPString(TempAdresse)
Adresse(StartLocal+i)\IP=TempAdresse
Else
Adresse(StartLocal+i)\Name="n/a"
Adresse(StartLocal+i)\IPName="n/a"
Adresse(StartLocal+i)\IP=0
EndIf
EndIf
Wend
EndIf
EndIf
i+StartLocal; Zähler auf Absolutwert bringen
While i<Anzahl; DNS-Updates durchführen
i+1
If Adresse(i)\DNSUpdate
CreateThread(@DNSHostnameToIP(),i)
TempAdresse=GetIPAddress(Adresse(i)\IPName)
If TempAdresse<>Adresse(i)\IP; Or Random(3)=0; fürs Testen...
Adresse(i)\IP=TempAdresse
Adresse(i)\IPchange=5
EndIf
EndIf
Wend
AdressUpdateActive=#False
EndIf
; so, jetzt geben wir allen Threads ein wenig Zeit zum fertig werden...
delay=0
Repeat
delay+1
Delay(Timeout>>2)
ActiveThreads=0
zeiger=0
While zeiger<Anzahl
zeiger+1
activethreads+IsThread(ThreadIDs(zeiger))
Wend
; Debug Str(delay)+": "+Str(ActiveThreads)
Until (Activethreads=0) Or (delay=5)
pollzeit-GetTickCount_()
EndProcedure
Procedure ResetAll()
Define y.i
Define z.i
pollcount=0
StartZeit=GetTickCount_()-intervall
z=0
While z<=Anzahl
y+1
Adresse(z)\SNMPScan=#SNMP_NoReply
Adresse(z)\DeviceType=""
Adresse(z)\DeviceName=""
Adresse(z)\IPchange=0
Adresse(z)\Alivenow=#Alive_Undefined
Adresse(z)\Alivesum=0
Adresse(z)\TTL=0
Adresse(z)\Alivecount=0
Adresse(z)\Deadcount=0
Adresse(z)\Timenow=0
Adresse(z)\Timesum=0
Adresse(z)\Timemin=0
Adresse(z)\Timemax=0
Adresse(z)\Aliveseq=0
Adresse(z)\Deadseq=0
Adresse(z)\Alivecolorfade=0
Adresse(z)\Deadcolorfade=0
z+1
Wend
EndProcedure
Procedure Ende()
;DeleteObject_(small)
;DeleteObject_(font)
FreeFont(smallfont)
FreeFont(normalfont)
CloseLogFile()
CloseWindow(0)
If flickerfree
CloseScreen()
EndIf
EndProcedure
; Hauptprogramm
Procedure Main()
Define exit.i
Init()
;PollOne(1)
;ttlvalue=PingGetTTL()
exit=0
StartZeit=GetTickCount_()-intervall
AddWindowTimer(0,1,intervall)
MakeLogfile()
WriteAll()
PollAll()
LogAll()
WriteAll()
Define event.i
Repeat
Event=WaitWindowEvent()
Select Event
Case #PB_Event_CloseWindow
exit=99
Case #WM_CHAR
Select EventwParam()
Case #ESC
exit=99
Case ' '
pausedebugmode=pausedebugmode!1&1
Case '@'
pausedebugmode=pausedebugmode!2&2
Case '!'
ShowHistory=1-ShowHistory
Case '0',13
ResetAll()
Case 'l','L'
Logging=-Logging
If Logging>0
MakeLogFile()
EndIf
Case '?'
MessageRequester(" Übersicht der Ini-Befehle",#Information);,#MB_ICONASTERISK)
EndSelect
Case #PB_Event_Timer
If EventTimer()=1; Timer-Nummer (da es durch ToolTip auch plötzlich andere Events gibt)...
If pausedebugmode=1
StartZeit+intervall
Else
PollAll()
LogAll()
EndIf
WriteAll()
EndIf
Case #WM_PAINT
WriteAll()
EndSelect
If Callback
Callback=0
OnTop=1-OnTop
StickyWindow(0,OnTop); ****
EndIf
Until exit
Ende()
EndProcedure
Main()
-
lesserpanda
- User
- Posts: 65
- Joined: Tue Feb 11, 2020 7:50 am
Re: Windows platform - network diagnostic app
Thank you everyone! I will work out code.