fb:porticula NoPaste

Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen
Dateidownload
[Ex|In]terne IP anzeigen

Uploader:	ytwinky
Datum/Zeit:	11.07.2011 22:32:47
#include "vbcompat.bi"

#include once "windows.bi"

#include once "win\shellapi.bi"

#include once "win\wininet.bi"

#define maxBuf 1024

#define IPspc 20

'+-----------------------------------------------------------------------------------+

'|    Header: Bestimmen der Übergabeparameter                                        |

'|    AnzeigeCheck:|Il1 sind Alt-0124, Großes i, kleines L, Eins „ä”öüáßŽÄ™ÖšÜñ±ø°¸©|

Const Author="ExtIP.Bas v0.22.0 ¸2011 by ytwinky, MD"'                               |

'|           (Tastenkombination: keine)                                              |

'|                                                                                   |

'|    Zweck : externe IP anzeigen(via WGet), falls offLine lokale IP anzeigen        |

'+-----------------------------------------------------------------------------------+

'(Anmerkung zu den Sonderzeichen: zuerst steht das DOS-Zeichen, danach das Windowszeichen)

Declare Function GetExternIP() As String

Declare Function ChkOnline(HostIP As String, Gateway As String, SubNetMask As String) As Integer

Declare Function GetPipe(Cmd As String) As String

Declare Sub String2Array(byRef StringRef As String, byRef Separator As String, IPArray() As Integer)



Const Lf=!"\n"

Var SysPfad=Environ("windir") &"\System32\", s="", i=0, online=0, HostIP="", Gateway="", SubNetMask=""

Dim As String z(5)

s=GetPipe(SysPfad &"IPConfig.Exe")

i=InStr(InStr(InStr(s, "LAN-Verbindung"), s, "dress"), s, ":")+2

HostIP=Mid(s, i, InStr(i, s, Lf)-i)

i=InStr(InStr(i, s, "mask"), s, ":")+2

SubNetMask=Mid(s, i, InStr(i, s, Lf)-i)

i=InStr(InStr(i, s, "ateway"), s, ":")+2

Gateway=Mid(s, i, InStr(i, s, Lf)-i)

online=ChkOnline(HostIP, Gateway, SubNetMask)

If online Then HostIP=GetExternIP()

Print Format(Now, "yyyy.mm.dd hh:mm:ss") & *IIf(online, @" extern ", @" lokal ") & HostIP

If Command(1)="" Then GetKey

End



Function ChkOnline(HostIP As String, Gateway As String, SubNetMask As String) As Integer

  Dim As Integer aIP(4), aGW(4), aSub(4)

  Var okay=0, i=0

  String2Array(SubNetMask, ".", aSub())

  String2Array(HostIP, ".", aIP())

  String2Array(Gateway, ".", aGW())

  For i=0 To 3

    okay Or=(.aIP(i) And .aSub(i))-(.aGW(i) And .aSub(i))

  Next

  Erase aIP, aGW, aSub

  Return okay=0

End Function



Function GetPipe(Cmd As String) As String

  Var s="", z="", FNo=FreeFile

  Open Pipe Cmd For Input As #FNo 'Dateinummer an Konsolenausgabe zuweisen..

  While Not Eof(FNo) 'Lesen anfangen..

    Line Input #FNo, z 'sollten Kommata in der Zeile sein einfach ignorieren..

    If z<>"" Then s &=z &Lf 'leere Zeilen nicht beachten..

  Wend 'Konsolenausgabe zuende

  Close #FNo 'Konsolenausgabe schließen

  Return s '..und zurückgeben

End Function



'Originally by agamemnus, search english fb-forum for split

Sub String2Array(byRef StringRef As String, byRef Separator As String, IPArray() As Integer)

  Var m=1, n=0, i=0, lenStringRef=Len(StringRef)

  Do

    n=InStr(m, stringRef, Separator)

    If n=0 Then n=lenStringRef+1

    IPArray(i)=Val(Trim(Mid(StringRef, m, n-m)))

    If n=lenStringRef+1 Then Exit Do

    m=n+1

    i+=1

  Loop

End Sub



Function GetExternIP() As String 'Original von oldirty

  'Source, returns only external IP-Address as String

  Dim As String sURL="http://automation.whatismyip.com/n09230945.asp" 'Beware:Address has changed!!

  Dim As HINTERNET hOpen, hFile

  Dim As Integer nRet, tbSize=32, x

  Dim As String tBuff=Space(tbSize), scUserAgent="Zippy"

  Dim As String*IPspc ExternIP=Space(IPspc)

  Dim As Byte Ptr myBuff

  myBuff=Allocate(maxBuf)

  hOpen=InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, NULL, NULL, 0) 'Create an internet connection

  If hOpen=0 Then Return "error -1"

  hFile=InternetOpenUrl(hOpen, sURL, NULL, 0, INTERNET_FLAG_RELOAD, 0) 'Open the url

  If hFile=0 Then Return "error -2"

  'Let's get the file size, I think this requires IE 4.0 engine, not 3.0

  x=HttpQueryInfo(hFile, HTTP_QUERY_CONTENT_LENGTH, StrPtr(tBuff), @tbSize, NULL)

  x=InternetReadFile(hFile, myBuff, maxBuf, @nRet)

  If nRet>0 Then

    For x=0 To nRet-1

      ExternIP[x]=myBuff[x]

    Next

  End If

  InternetCloseHandle(hFile)

  InternetCloseHandle(hOpen)

  DeAllocate myBuff

  Return ExternIP

End Function