AspGerman Wiki

Bearbeiten

Problem

Ich brauche eine Website oder den Inhalt davon.

Bearbeiten

Lösung

Die untenstehende Function. Funktioniert ähnlich wie ASPTear. Hat weniger Macken als XMLHTTP. Funktioniert auf jedem System so ca ab Windows 2000. Dokumentation auf MSDN library

Function GetPage(sURL)
Dim objHTTP
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
objHTTP.SetTimeouts 0, 3000, 2000, 5000
' objHTTP.SetAutoLogonPolicy 0  - nur im Intranet einsetzen. Sorgt für automatische Anmeldung
objHTTP.Open "GET", sURL, false
objHTTP.Send
GetPage = objHTTP.ResponseText
End Function

Beispiel-Aufruf

response.write GetPage("http://server.com/seite.htm")

Kann direkt auch vom Windows Scripting Host (und damit auch anderen Hosts) verwendet werden. Aufruf etwa

wscript.echo GetPage("http://server.com/seite.htm")

Bearbeiten

Abwandlung - URL überprüfen

Das Thema hatten wir eben: wie kann ich einen URL überprüfen? Dazu brauche ich nicht die komplette Seite übertragen; es reicht per "head" auf das Vorhandensein der Seite zu überprüfen. Zum anderen rufe ich nur den Status-Code ab. Ist die Seite vorhanden kriege ich 200. Ansonsten 404 oder was es sonst alles gibt.

Function checkURL(sURL)
Dim objHTTP
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
objHTTP.SetTimeouts 0, 3000, 2000, 5000
objHTTP.Open "HEAD", sURL, false
objHTTP.Send
checkURL = objHTTP.Status
End Function
Beispiel-Aufruf

response.write checkURL("GetPage("http://server.com/seite.htm")
Oder noch simpler, wenn mich wirklich nur 200er Statuscode interessiert

If checkURL("GetPage("http://server.com/seite.htm") = "200" Then
  ' code für URL ok
Else
  ' code für URL bad
End If

Bearbeiten

WSH Beispiele

Weil mehrmals diskutiert hier gesammelte Beispiele für die gleichen Funktionen im Windows Scripting Host (WSH) verwendet. Gleicher code, läuft lokal auf dem Rechner, nicht auf dem Webserver. Den folgenden Code in eine Datei HOLESEITEN.VBS packen und doppelklicken.

Dim objHTTP, fso, URL, URLArray
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
Set fso = CreateObject("Scripting.FileSystemObject")

URLArray = Array(_
"http://aspgerman.com/Wiki/default.aspx/AspGerman.GetWebFile", _
"http://www.aspgerman.com/wiki/default.aspx/AspGerman.CodeSchnipsel", _
"http://aspgerman.com/aspgerman/")
' ---- working loop
For each URL in URLArray
Dim a, b
a = GetPage(URL)
b = StoreFile(a, URL)
Next
MsgBox "Done"

' ---- Functions
Function GetPage(sURL)
       objHTTP.SetTimeouts 0, 3000, 2000, 5000
       ' objHTTP.SetAutoLogonPolicy 0  - nur im Intranet einsetzen. Sorgt für automatische Anmeldung
       objHTTP.Open "GET", sURL, false
       objHTTP.Send
       GetPage = objHTTP.ResponseText
End Function

Function StoreFile(sText, sPath)
	Dim datei
	Set datei = fso.CreateTextFile(Replace(Replace(Replace(sPath, "http://", ""), "/", "_"), ":", "") & ".htm")
	datei.writeline sText
	datei.close
End Function

Und hier der Umkehrfall, ich will Daten an den Server schicken, grade so, also ob sie über ein Formular gesendet worden wären.

Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
Set fso = CreateObject("Scripting.FileSystemObject")

sPostURL = "http://www.neusob.de/ak-inhalt/reflektor.asp"
sPostData = "vname=hans&nname=meier"

a = PutPage(sPostURL, sPostData)
b = StoreFile(a, sPostURL)
MsgBox "Done"

' ---- Functions
Function PutPage(sURL, sData)
       objHTTP.SetTimeouts 0, 3000, 2000, 5000
       objHTTP.SetAutoLogonPolicy 0  ' - nur im Intranet einsetzen. Sorgt für automatische Anmeldung
       objHTTP.Open "POST", sURL, false
objHTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
       objHTTP.Send sData
       PutPage = objHTTP.ResponseText
End Function
' * hier noch die Funktion StoreFile vom oberen Beispiel einfügen

ScrewTurn Wiki version 2.0.33. Some of the icons created by FamFamFam.