externe ip abfrage per vbs mit wget unter windows

[david255]

hallo
ich habe folgendes problem:
ich brauche ein vbs script das meine externe ip abfragt und bei änderungen ein bestimmtes vbsscript startet.
nach möglichkeit sollte es solange aktiv sein wie der rechner läuft.
die abfrage sollte über externe webseiten wie zum beispiel "http://whatismyip.org" laufen. ich hoffe mir kann jemand helfen.

 

[Pikachu]

Sorry, Ich kann dir nicht sagen wie man den Code hier:

' PB/CC 5.00
'--------------------------------------------------------------
' Query checkip.dyndns.org for WAN IP address
'--------------------------------------------------------------
FUNCTION GetIPAddress() AS STRING
 DIM szBuffer AS STRING
 DIM szHost   AS STRING
 DIM szData   AS STRING
 DIM hSock    AS LONG
 DIM lIndex   AS LONG
 DIM lCount   AS LONG
'
 HOST NAME TO szHost
 TRY 'Open socket
  hSock = FREEFILE
'  TCP OPEN PORT 80 AT "checkip.dyndns.org" AS hSock TIMEOUT 60000
  TCP OPEN PORT 8245 AT "checkip.dyndns.com" AS hSock TIMEOUT 60000 ' http://checkip.dyndns.com:8245/
   'Send request
   TCP PRINT hSock, "GET / HTTP/1.0"
   TCP PRINT hSock, "Host: " & szHost
   TCP PRINT hSock, "Connection: Keep-Alive"
   TCP PRINT hSock, ""
   'Read response
   DO
    TCP LINE hSock, szBuffer
    IF szBuffer = "" THEN EXIT LOOP
   LOOP
   'Read page data
   DO
    TCP RECV hSock, 256, szBuffer
    IF LEN(szBuffer) = 0 OR ERR THEN EXIT LOOP
    szData = (szData & szBuffer)
   LOOP
   'Extract IP address from HTML
   REGEXPR "([0-9\.]*)" IN szData TO lIndex, lCount
   'Return IP address string
   IF lIndex THEN
    FUNCTION = MID$(szData, lIndex, lCount)
   ELSE
    FUNCTION = "Unknown"
   END IF
 CATCH
  FUNCTION = ERROR$
 FINALLY
  TCP CLOSE hSock
 END TRY
END FUNCTION
'
'
FUNCTION PBMAIN() AS LONG
 DIM sA AS STRING
' PRINT GetIPAddress
 STDOUT GetIPAddress
 sA = WAITKEY$
END FUNCTION
'

mit dem Ich über die Seite http://checkip.dyndns.com:8245/ die Externe IP abfrage
in VBS erstellen kann.

Gruß Erwin

 

[david255]

also ich habe ein script für die fritzbox gefunden und es versucht anzupassen da ich aber wenig erfahrung im scripten von vbs habe bin ich noch nicht weitergekommen.
hier der orginalcode:

#!/bin/sh
sleep 60
voipd -s
sleep 30
voipd -P 5061
sleep 30
syslogd -C
{
new_ip="$(wget -q -O - http://whatismyip.org)"
logger "VoIP auf folgender Adresse registriert: $new_ip"
eventadd 1 "VoIP auf folgender Adresse registriert: $new_ip"
old_ip="$new_ip"
while true; do
  if [ "$old_ip" != "$new_ip" ] ; then
        logger "Neue IP-Adresse: $new_ip => VoIP neu registriert"
        eventadd 1 "Neue IP-Adresse: $new_ip => VoIP neu registriert"
        voipd -R
    fi
    sleep 600
    old_ip="$new_ip"
    new_ip="$(wget -q -O - http://whatismyip.org)"
done
}&

und hier meine anpassung:

new_ip="$(wget -q -O - http://whatismyip.org)"
old_ip="$new_ip"
while true
  if [ "$old_ip" != "$new_ip" ] then
        dim shell
        set shell = CreateObject("WScript.Shell")
        shell.run "C:\Program Files\DNS-Updater\start.vbs"
    sleep 600
    old_ip="$new_ip"
    new_ip="$(wget -q -O - http://whatismyip.org)"
	end if
wend

das script läuft schonmal als schleife aber die wget abfrage funktioniert nicht.

 

[Pikachu]

Hallo,

Habe hier:

' 04.11.2011
' Wan-IP.vbs 
' wscript.exe muss zum Beenden wegen Endlosschleife im Taskmanager gekillt werden
'
 Option Explicit
'
 Dim WshShell, http, page, host, post
 Dim old_ip, new_ip
'
 host = "checkip.dyndns.com" ' "http://checkip.dyndns.com:8245/"
 page = "http://" + host ' + ":8245"
 post = ":8245" ' ":8245"
'
'
 Set WshShell = CreateObject("WScript.Shell")
'
'
 Set http = Nothing
 Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
'
 If http Is Nothing Then Set http = CreateObject("WinHttp.WinHttpRequest.5")
 If http Is Nothing Then Set http = CreateObject("WinHttp.WinHttpRequest")
 If http Is Nothing Then Set http = CreateObject("MSXML2.ServerXMLHTTP")
 If http Is Nothing Then Set http = CreateObject("Microsoft.XMLHTTP")
'
 If http Is Nothing Then
  MsgBox "Kein HTTP-Objekt verfügbar!", 16, "Fehler:"
 Else
'
'  SendPost http, page, host, post
  new_ip = SendPost(http, page, host, post)
'
 END IF
'
'
' new_ip = http.responseText
'
 old_ip = new_ip
'
' WScript.Echo "Alte IP-Adresse: " + old_ip ' http.responseText
'
 While True
'
  If old_ip <> new_ip Then
   WScript.Echo "Alte IP-Adresse: " + old_ip
'   WshShell.run "C:\Program Files\DNS-Updater\start.vbs" 
   old_ip = new_ip
   WScript.Echo "Neue IP-Adresse: " + old_ip
  Else
   WScript.Sleep 15000
   new_ip = SendPost(http, page, host, post)
  End If
'
 Wend
'
 Set WshShell = nothing
'
 WScript.Quit
'
'
Public Function SendPost(http, page, host, post)
 With http
  .Open "POST", page, false
  .setRequestHeader "HOST", host
  .setRequestHeader "Connection", "Keep-Alive"
  .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  .setRequestHeader "Content-Length", Len(post)
  .Send post
 End With
 SendPost = http.responseText
End Function
'
'

mal etwas getestet, wenn das das ist was du suchst, es geht zwar
beim Testen, aber wenn man WScript.Sleep zu klein macht gibts Probleme
in der Endlosschleife, die IP wird aus dem Link nicht gefiltert,
da der String immer gleich ist und sich nur die IP ändert beim wechsel der IP Adresse

<html><head><title>Current IP Check</title></head><body>Current IP Address: 17.229.120.10</body></html>

Gruß Erwin

 

[david255]

die ip abfrage funktioniert aber statt das script "start.vbs" zu starten gibt er nur die textmeldungen aus.
also besser wäre textmeldungen weg und dafür scriptstart.
endlosschleife ist gut da es nach ip wechsel weiterlaufen soll.

 

[Pikachu]

aber statt das script "start.vbs" zu starten gibt er nur die textmeldungen aus.

Ich hatte gedacht du kennst dich mit VBS aus dann sollte es kein Problem sein,
entferne hier:

'
 While True
'
  If old_ip <> new_ip Then
   WScript.Echo "Alte IP-Adresse: " + old_ip
[COLOR="red"]'[/COLOR]   WshShell.run "C:\Program Files\DNS-Updater\start.vbs" 
   old_ip = new_ip
   WScript.Echo "Neue IP-Adresse: " + old_ip
  Else
   WScript.Sleep 15000
   new_ip = SendPost(http, page, host, post)
  End If
'
 Wend
'

das REM

und füge hier:

'
 While True
'
  If old_ip <> new_ip Then
[COLOR="red"]'[/COLOR]   WScript.Echo "Alte IP-Adresse: " + old_ip
   WshShell.run "C:\Program Files\DNS-Updater\start.vbs" 
   old_ip = new_ip
[COLOR="red"]'[/COLOR]   WScript.Echo "Neue IP-Adresse: " + old_ip
  Else
   WScript.Sleep 15000
   new_ip = SendPost(http, page, host, post)
  End If
'
 Wend
'

zwei REM's ein, dann müsste es gehen, und die Textmeldung für den Test kommt nicht mehr.

 

[david255]

Ich hatte gedacht du kennst dich mit VBS aus dann sollte es kein Problem sein

nein leider nicht, bin seit drei tagen dabei es zu lernen.

 

[david255]

hallo,
der scriptstart funktioniert allerdings verhält sich das gestartete script anders als beim manuellen start und zwar wie folgt:
manueller start:
script verarbeitet die in der settings.ini eingetragenen daten zb. domainname und passwort
automatischer start über das hier erwähnte script:
script fordert manuelle eingaben der oben genannte daten aus der settings.ini
dadurch würde natürlich der sinn des scriptes zum starten von start.vbs wegfallen.
ich hoffe es gibt eine lösung dafür.
hier mal das script start.vbs:

' VB Script Document
option explicit

Dim sDomain
Dim sDomainPassword
Dim sSettingsFile
Dim sPidFile

Dim oFileObject

Set oFileObject      	= WScript.CreateObject("Scripting.FileSystemObject")
sSettingsFile		= "settings.ini"
sPidFile		= "pid.ini"

If oFileObject.FileExists(sSettingsFile) Then
	Dim oTextObject
	Dim sMessage
	Dim sLine
	Dim iConfigError
	Set oTextObject		= oFileObject.OpenTextFile(sSettingsFile, 1)
	Do Until oTextObject.AtEndOfStream
		sLine = oTextObject.ReadLine
		If InStr(sLine, "domainpassword") Then
			sDomainPassword	= Replace(sLine, "domainpassword=", "")
			sMessage	= "Passwort gefunden: " & sDomainPassword
			'MsgBox sMessage, 0, "DNS Updater"
		ElseIf InStr(sLine, "domain") Then
			sDomain		= Replace(sLine, "domain=", "")
			sMessage	= "Domain gefunden: " & sDomain
			'MsgBox sMessage, 0, "DNS Updater"
		End If
	Loop
	If (sDomain = "") Then
		iConfigError	= 1
	ElseIf (sDomainPassword = "") Then
		iConfigError	= 1
	End If
	If (iConfigError > 0) Then
		MsgBox "Domain und/oder Passwort ungültig", 0, "Fehler: Fehlerhafte Konfiguration"
		WScript.Quit 1
	End If
Else
	Dim sFileContent
	sDomain		= InputBox("Bitte geben Sie Ihre Domain ein:")
	sDomainPassword = InputBox("Bitte geben Sie Ihr Domain-Passwort ein:")
	sFileContent	= "domain=" & sDomain & vbCrLf & "domainpassword=" & sDomainPassword
	CreateObject("Scripting.FileSystemObject").CreateTextFile(sSettingsFile).Write sFileContent
End If


'Button-Types
'0=OK-Fenster
'1=OK-/Abbrechen-Fenster
'2=Abbrechen-/Wiederholen-/Ignorieren-Fenster
'3=Ja-/Nein-/Abbrechen-Fenster
'4=Ja-/Nein-Fenster
'5=Wiederholen-/Abbrechen-Fenster
'16=Anzeigen des Stopp-Symbols
'32=Anzeigen des Fragezeichen-Symbols
'48=Anzeigen des Symbols Warnung
'64=Anzeigen des Symbols Information
'Answer-Types
'1 = vbOK - OK was clicked
'2 = vbCancel - Cancel was clicked
'3 = vbAbort - Abort was clicked
'4 = vbRetry - Retry was clicked
'5 = vbIgnore - Ignore was clicked
'6 = vbYes - Yes was clicked
'7 = vbNo - No was clicked

Dim iShowButton
Dim iButtonAnswer
Dim sProgramMessageHeadline
Dim sProgramMessageText
Dim oSubprogramProcess
Dim sProgramUpdater

Dim objHttp
Dim sUpdateUrl

iButtonAnswer		= 0
iShowButton		= 1
sProgramUpdater		= "dns-updater.vbs"
sProgramMessageText	= "Update für " & sDomain & " gestartet," & vbCrLf & "klicken Sie auf OK um das Programm zu schliessen"
sProgramMessageHeadline	= "DNS Updater"

CreateObject("Scripting.FileSystemObject").CreateTextFile(sPidFile).Write "1"

Dim fso		: Set fso       = WScript.CreateObject("Scripting.FileSystemObject")
WScript.CreateObject("WScript.Shell").Run """" & sProgramUpdater & """"

MsgBox sProgramMessageText, 16, sProgramMessageHeadline 

Dim sCommandLine
Dim objWMIService
Dim objItem
Dim aColumnItems
Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
Set aColumnItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE CommandLine LIKE '%wscript.exe%'")
For Each objItem in aColumnItems
	sCommandLine	= objItem.CommandLine
	If InStr(sCommandLine, sProgramUpdater) Then
		objItem.Terminate
	End If
Next

oFileObject.DeleteFile(sPidFile)

und hier das script dns-updater.vbs:

Dim sUpdateUrl
Dim sDomain
Dim sDomainPassword

Dim objHttp
Dim blnExit

sUpdateUrl		= "http://www.vroute.de/index.php/api/dyndns/updater/"

Dim sCurrentTime
Dim sLastTime
Dim iTimeDifference
Dim iMinDifference

' Aendern Sie KEINESFALLS diesen Wert da bei JEDEM Update GLEICHZEITIG ein DEAKTIVIERUNGS-Befehl
' ausgefuehrt wird welcher Ihren Host DEAKTIVIERT wenn Sie die Update-Zeit unterschreiten!
' Nach einer DEAKTIVIERUNG ist Ihr Host nicht mehr fuer den DNS-Service nutzbar!
' Eine Reaktivierung kann nur durch den Support gegen eine Bearbeitungsgebuehr erfolgen!
iMinDifference	= 900

Dim oFileObject
Dim oTextObject
Dim sDebugMessage
Dim sReadLine

Set oFileObject  = WScript.CreateObject("Scripting.FileSystemObject")

If oFileObject.FileExists("pid.ini") Then
	'Alles okay, Pid-File existiert
Else
	MsgBox "Diese Datei darf nicht direkt aufgerufen werden", 0, "DNS Updater"
	WScript.Quit 1
End If

If oFileObject.FileExists("settings.ini") Then
	Set oTextObject = oFileObject.OpenTextFile("settings.ini", 1)
	Do Until oTextObject.AtEndOfStream
		sReadLine = oTextObject.ReadLine
		If InStr(sReadLine, "domainpassword") Then
			sDomainPassword	= Replace(sReadLine, "domainpassword=", "")
			sDebugMessage	= "Passwort gefunden: " & sDomainPassword
			'MsgBox sDebugMessage, 0, "DNS Updater"
		ElseIf InStr(sReadLine, "domain") Then
			sDomain		= Replace(sReadLine, "domain=", "")
			sDebugMessage	= "Domain gefunden: " & sDomain
			'MsgBox sDebugMessage, 0, "DNS Updater"
		End If
	Loop
Else
	MsgBox "Update abgebrochen, Datei settings.ini nicht gefunden", 0, "DNS Updater"
	WScript.Quit 1
End If

Set objHttp		= WScript.CreateObject("WinHttp.WinHttpRequest.5.1")
If objHttp Is Nothing Then Set objHttp = WScript.CreateObject("WinHttp.WinHttpRequest")
objHttp.Option(4)	= 256 + 512 + 4096 + 8192
objHttp.SetTimeouts 0, 5000, 10000, 10000

Do
	sCurrentTime	= Now()
	If oFileObject.FileExists("last.ini") Then
		Set oTextObject = oFileObject.OpenTextFile("last.ini", 1)
		Do Until oTextObject.AtEndOfStream
			sLastTime = oTextObject.ReadLine
		Loop
		iTimeDifference	= DateDiff("s", sLastTime, sCurrentTime)
	Else
		iTimeDifference	= 9000
	End If

	If iTimeDifference >= iMinDifference Then
		CreateObject("Scripting.FileSystemObject").CreateTextFile("last.ini").Write sCurrentTime
		objHttp.Open "GET", sUpdateUrl & "?domain=" & sDomain & "&domainpassword=" &sDomainPassword, FALSE
		objHttp.setRequestHeader "User-Agent", WScript.ScriptName
		objHttp.Send ""
		If Not (objHttp.statusText = "OK") Then
		  'WScript.Echo "Error: " & objHttp.statusText
		  MsgBox "Update abgebrochen, Fehler bei Aktualisierung"
		  WScript.Quit 1
		Else
			If Not (objHttp.ResponseText = "updated") Then
				MsgBox "Fehler beim Update, Server meldet: " & objHttp.ResponseText, 0, "DNS Updater Fehler"
				WScript.Quit 1
			End If
		End If
	Else
		'MsgBox iTimeDifference
	End If

	'60 * 1000	= 1 Minute (60000)
	'900000		= 15 Minuten
	WScript.Sleep 60000
Loop

und settings.vbs:

' VB Script Document
option explicit

Dim sDomain
Dim sDomainPassword
Dim sSettingsFile

Dim oFileObject

Set oFileObject      	= WScript.CreateObject("Scripting.FileSystemObject")
sSettingsFile		= "settings.ini"
sDomain			= ""
sDomainPassword		= ""

If oFileObject.FileExists(sSettingsFile) Then
	Dim oTextObject
	Dim sMessage
	Dim sLine
	Set oTextObject = oFileObject.OpenTextFile(sSettingsFile, 1)
	Do Until oTextObject.AtEndOfStream
		sLine = oTextObject.ReadLine
		If InStr(sLine, "domainpassword") Then
			sDomainPassword	= Replace(sLine, "domainpassword=", "")
		ElseIf InStr(sLine, "domain") Then
			sDomain		= Replace(sLine, "domain=", "")
		End If
	Loop
End If

Dim sFileContent
Dim sNewDomain
Dim sNewPassword

sNewDomain		= InputBox("Bitte geben Sie Ihre Domain ein:", "DNS Settings", sDomain)
sNewPassword 		= InputBox("Bitte geben Sie Ihr Domain-Passwort ein:", "DNS Settings", sDomainPassword)
sFileContent	= "domain=" & sNewDomain & vbCrLf & "domainpassword=" & sNewPassword
CreateObject("Scripting.FileSystemObject").CreateTextFile(sSettingsFile).Write sFileContent

mit settings.vbs und dns-updater.vbs arbeitet das script start.vbs.
also wäre es möglich das die daten aus der vorhandenen settings.ini verwendet werden ohne manuelle eingabe ?