Jeg har prøvet den her hos azero, hvor det virkede ;-)
<%
' *** Get a file through HTTP ( GetHttp("
www.azero.dk/forside.asp") )
Function GetHttp(strUrl)
' Reserve variables
Dim strHost
' Start error handling
On Error Resume Next
' Strip off http://
If LCase(Left(strUrl, 7)) = "
http://" Then
strUrl = Right(strUrl, Len(strUrl) - 7)
End If
' Split server address and filename
If InStr(strUrl, "/") > 0 Then
strHost = Left(strUrl, InStr(strUrl, "/") - 1 )
strUrl = Right(strUrl, (Len(strUrl) - InStr(strUrl, "/")) + 1 )
End If
' Add port if not included
If InStr(strHost, ":") = 0 Then
strHost = strHost & ":80"
End If
' Create object
set Socket = server.CreateObject("Socket.TCP")
' Set hostadress
socket.Host = strHost
' Set timeout to 5 seconds
Socket.TimeOut = 5000
' Open connection to host
Socket.Open
' Send getline for content
Socket.SendLine("GET /" & strUrl & " HTTP/1.0" & Chr(13) & Chr(10) & "Host: " & strHost & Chr(13) & Chr(10))
' Wait until content is recieved
Socket.WaitForDisconnect()
' Insert data into function
GetHttp = Socket.Buffer
' Close object
Socket.Close()
' Error
If Err.Number <> 0 Then
Response.Write Err& ": " & Err.Description
Response.Write "<br>Host:[" & strHost & "]<br>Url:[" & strUrl & "]"
Exit function
End If
On Error Goto 0
End Function
' *** Get content within a tag (strS) ( GetHttpData("
www.azero.dk/forside.asp", "body") )
Function GetHttpData(strUrl,strS)
Dim strT
strT = GetHttp(strUrl)
strT = Mid(strT, InStr(LCase(strT), "<" & LCase(strS)))
strT = Mid(strT, InStr(LCase(strT), ">") + 1)
strT = Left(strT, InStrRev(LCase(strT), "</" & LCase(strS)) - 1)
GetHttpData = strT
End Function
' *** Get the header from a file through HTTP ( GetHttpHeader("
www.azero.dk/forside.asp") )
Function GetHttpHeader(strUrl)
Dim strT
strT = GetHttp(strUrl)
strT = Mid(strT, 1, InStr(strT, Chr(13) & Chr(10) & Chr(13) & Chr(10)))
GetHttpHeader = strT
End Function
'''''''''''''''finder beskrivelse''''''''''''''''''''''''''
strHTML = GetHttpData("eksperten.dk/", "head")
Dim strHTML, objRegExp, objMatch
strHTML = strHTML & "<title>Testside</title>" & vbCRLF
strHTML = strHTML & "<meta name=""description"" content=""Description content"">" & vbCRLF
strHTML = strHTML & "<meta name=""ignore"" content=""Ignore content"">" & vbCRLF
strHTML = strHTML & "<meta name=""keywords"" content=""Keywords content"">"
Set objRegExp = New RegExp
With objRegExp
.Pattern = "<meta\s+name=""(description|keywords)""\s+content=""([^""]*)""\s*>"
.IgnoreCase = True
.Global = True
End With
For Each objMatch In objRegExp.Execute(strHTML)
Response.Write objMatch.SubMatches(1) & "<br>"
Next
Set objMatch = Nothing
Set objRegExp = Nothing
%>
(objMatch.SubMatches(0) & "=" &
Ny bruger
Nybegynder
Opret
Preview
