#include "win\wininet.bi"
'+-----------------------------------------------------------------------------------+
'|    Header: Bestimmen der �bergabeparameter                                        |
'|    AnzeigeCheck:|Il1 sind Alt-0124, Gro�es i, kleines L, Eins ������ߎę֚������|
Const Author="ChkLan.Bas v0.23.0 �08.04.2008 by ytwinky, MD"'                        |
'|           (Tastenkombination: keine)                                              |
'|                                                                                   |
'|    Zweck : �berpr�fung der lokalen IP-Konfiguration                               |
'+-----------------------------------------------------------------------------------+
'(Anmerkung zu den Sonderzeichen: zuerst steht das DOS-Zeichen, danach das Windowszeichen)
Const Schwarz=0, Gruen=2, Rot=4, Weiss=7, Hell=8
Dim Shared As Integer Fehler, Okay

'Originally by agamemnus, search english fb-forum for split
Sub StringToArray (byRef IPString As String, byRef Separator As String, IPArray() As Integer)
	Var m=1, n=0, i=0, LenIP=Len(IPString)
	Do
  	n=InStr(m, IPString, Separator)
  	If n=0 Then n=LenIP+1
  	IPArray(i)=Val(Trim(Mid(IPString, m, n-m)))
  	If n>LenIP Then Exit Do
  	m=n+1
  	i+=1
	Loop
End Sub

Function GetNetAdr(IP As String, Mask As String) As String
	Static As Integer aIP(4), aMask(4)
	Var NetAdr="", i=0
	StringToArray(IP, ".", aIP())
	StringToArray(Mask, ".", aMask())
	For i=0 To 3
		NetAdr &= Str(aIP(i) And aMask(i)) &*IIf(i=3, @"", @".")
	Next
	Return NetAdr
End Function

Function GetGW(Host As String, byRef SubMask As String) As String ' needs declaration of Submask in main..
	Var DNr=FreeFile, z="", gw=""
	Open Pipe "IPConfig.exe" For Input As #DNr 'get ip-config..
	  Do While Not Eof(DNr)
	    Input #DNr, z
	  	If InStr(z, Host) Then
	  		Input #DNr, z
	  		SubMask=Mid(z, InStr(z, ":")+2) '..we now need subnetmask..
	  		Input #DNr, z
	  		gw=Mid(z, InStr(z, ":")+2) '..and defaultipgateway
	  		Exit Do
	  	EndIf
	  Loop
	Close DNr 'close pipe
	Return gw
End Function

Function PingIt(byVal Horst As String, _
	              byRef Anfang As String, _
	              byRef Ende As String) As String
	Static As String s
	s="\" &Space(14) &"\"
  Var ttl=0, DNr=FreeFile, i=0, j=0, c="   *   "
  Dim As String z, m
  Print Using s; Horst;
  Open Pipe "Ping -a -n 1 " & Horst For Input As #DNr
  Do While Not Eof(DNr)
    Line Input #DNr, m
    If m<>"" Then z+=m &!"\n"
    ttl=InStr(lcase(z), "ttl")
    Okay-=ttl>0
    If ttl Then
    	Color Gruen
    	Print c;
    	i=InStr(z, Anfang)+Len(Anfang)'+(Ende="]")
    	z=Mid(z, i, InStr(i, z, Ende)-i)
    	Exit Do
    End If
  Loop
  Close DNr
  If ttl=0 Then
  	Color Hell+Rot
  	Print c;
  	Fehler+=1
  	z=Left(z, InStr(z, "]")) &" dauert zu lange.."
  EndIf
  Color Weiss, Schwarz
  Print z
  Return z
End Function
'253
Var p="127.0.0.1", Lan="", Gateway="", SubnetMask="", HostIP=""
Print Author &!"\nPingZiel";Spc(8);"Status Bemerkung"
p=PingIt(p, " ", "[") 'ist 'ne Netzkarte da?
p=PingIt(p, " ", "[") 'kann localhost aufgel�st werden?
p=PingIt(p, "[", "]") 'hat der Netzwerkrechner ne IP ?
HostIP=p
Gateway=GetGw(HostIP, SubnetMask)
p=PingIt(p, " ", "[") 'Kann die IP zum Computernamen aufgel�st werden?
Color Weiss, Schwarz
Print Okay &"*OK(und " &Fehler &" Fehler)==>";
If Okay<4 Then
  Color Hell+Rot, Weiss
Else
	LAN=GetNetAdr(HostIP, SubnetMask)
End If
Print *IIf(Okay=4, @"OKAY!!!!", @"Ooops, Fehler..")
Color Weiss, Schwarz
If Okay<2 Then LAN=""
Print "Jetzt das LAN(" &LAN &") testen.."
Do
  Input "Host:", p
  If Val(p)>0 And Val(p)<256 Then p=Left(LAN, InStrRev(LAN, ".")) &p
  If p="" Then Exit Do
  p=PingIt(p, *IIf(InStr(p, "."), @" ", @"["), *IIf(InStr(p, "."), @"[", @"]"))
Loop

If Lan=GetNetAdr(Gateway, SubnetMask) Then
	Print "Jetzt das Internet testen.."
	Do
	  Input "Domain:", p
	  If p="" Then Exit Do
	  p=PingIt(p, *IIf(InStr(p, "."), @" ", @"["), *IIf(InStr(p, "."), @"[", @"]"))
	Loop
Else
	Print !"InternetVerbindung geht nicht!\nDefaultGateway ist nicht im aktuellen Netz:\n" &_
	      String(8, " ") &!"HostIP:" & HostIP &!"\nDefaultGateway:" & Gateway &!"\n    SubnetMask:" & SubnetMask;
End If
GetKey