OK, her har du koden (der er også lidt andre funktioner, som du måske kan bruge)
<%
url = "cht.dk"
header = ConvertGetOnlyHeaders(GetHttp(url))
if left(header,len("HTTP/1.1 200 OK")) = "HTTP/1.1 200 OK" then
response.write "Sinden blev fundet!"
else
response.write "Sinden blev ikke fundet!"
end if
'Visning af siden:
'response.write ConvertGetHTML(GetHttp("cht.dk"))
'*************************************************************************************
' GetHttp("cht.dk") *** Get a file through HTTP
' GetHttpData("
www.azero.dk/forside.asp","body") *** Get content within a tag (strS)
' ConvertOnlyGetHead(text) *** Få det der står mellem <head> og </head>
' CovertGetDescription(fstr) Retunere ???? i: <meta name="description" content="????">
' CovertGetTitle(fstr) Retunere ???? i: <meta name="title" content="????"> , hvis ikke findes fås mellem <title> og <title>
' CovertGetKeywords(fstr) Retunere ???? i: <meta name="keywords" content="????">
' ConvertGetOnlyHeaders() Få kun informarionerne om serveren
' ConvertGetHTML(data) Få kun html koden
' Enc(text) Server.HTMLEncode(text)
'*************************************************************************************
' *** Get a file through HTTP ( GetHttp("cht.dk/information.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
'if InStr(strUrl,"/") = 0 then
' strUrl = strUrl & "/"
'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 )
else
strHost = strUrl
strUrl = ""
End If
' Add port if not included
If InStr(strHost, ":") = 0 Then
strHost = strHost & ":80"
End If
'§response.write "<b>File: </b>" & strurl & "<br><b>Host: </b>" & strhost & "<br>"
' Create object
set Socket = server.CreateObject("Socket.TCP")
' Set hostadress
socket.Host = strHost
' Set timeout to 5 seconds
Socket.TimeOut = 8000
' Open connection to host
Socket.Open
sendline = "Accept: image/gif,image/x-xbitmap,image/jpeg, image/pjpeg, */*" & VbCrLf
sendline = sendline & "Accept-Language: da" & VbCrLf
sendline = sendline & "User-Agent: Mozilla/4.0 (compatible; CHT.DK; Windows NT)" & VbCrLf
sendline = sendline & "REFERER:
http://www.cht.dk/" & VbCrLf
sendline = sendline & "Comment:
HTTP://CHT.DK" & VbCrLf
'sendline = sendline & "Range: bytes=10-" & VbCrLf 'Partial content
'sendline = sendline & "Cache-Control: no-cache" & VbCrLf
'sendline = sendline & "Connection: close" & VbCrLf
strHost = left(strHost,len(strHost)-3)
strUrl = mid(strUrl,2)
' Send getline for content
Socket.SendLine("GET /" & strUrl & " HTTP/1.0" & Chr(13) & Chr(10) & "Host: " & strHost & Chr(13) & Chr(10) & sendline)
'§response.write "<pre>GET /" & strUrl & " HTTP/1.0" & Chr(13) & Chr(10) & "Host: " & strHost & Chr(13) & Chr(10) & sendline & "</pre>"
' 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 ConvertGetHttpHead(data,strS)
strT = data
strT = Mid(strT, InStr(LCase(strT), "<" & LCase(strS)))
strT = Mid(strT, InStr(LCase(strT), ">") + 1)
strT = Left(strT, InStrRev(LCase(strT), "</" & LCase(strS)) - 1)
ConvertGetHttpHead = strT
End Function
Function ConvertOnlyGetHead(data)
startpos = InStr(lcase(data),"<head>")+6
endpos = InStr(mid(lcase(data),startpos),"</head>")-1
if startpos > 6 and endpos > 0 then
ConvertOnlyGetHead = (mid(data,startpos,endpos))
else
ConvertOnlyGetHead = ""
end if
End Function
Function Enc(data)
Enc = Server.HTMLEncode(data)
End Function
Function ConvertGetHTML(data)
ConvertGetHTML = mid(data,InStr(data,VbCrLf&VbCrLf)+4)
End Function
Function ConvertGetOnlyHeaders(data)
ConvertGetOnlyHeaders = Server.HTMLEncode(left(data,InStr(data,VbCrLf&VbCrLf))) & VbCrLf
End Function
' Mine funktioner til at få title, description & keywords *** start ***
' CovertGetDescription(fstr)
' CovertGetTitle(fstr)
' CovertGetKeywords(fstr)
Function CovertGetTitle(fstr)
start = InStr(LCase(fstr),"<meta name=""title")+28
if Start > 28 then
slut = InStr(mid(fstr,start),">")
if slut > 4 then
CovertGetTitle = mid(fstr,start,slut-2)
else
CovertGetTitle = "_"
end if
'response.write start & " " & slut & VbCrLf
elseif InStr(LCase(fstr),"<meta name=title") > 0 then
start = InStr(LCase(fstr),"<meta name=title")+26
slut = InStr(mid(fstr,start),">")
if slut > 4 then
CovertGetTitle = mid(fstr,start,slut-2)
else
CovertGetTitle = "_"
end if
else
start = InStr(lcase(fstr),"<title>")+7
lenght = InStr(lcase(mid(fstr,start)),"</title>")
if start > 7 and lenght > 0 then
CovertGetTitle = mid(fstr,start,lenght-1)
else
CovertGetTitle = "_"
end if
end if
End Function
Function CovertGetKeywords(fstr)
start = InStr(LCase(fstr),"<meta name=""keywords")+31
if Start > 31 then
slut = InStr(mid(fstr,start),">")
if slut > 4 then
CovertGetKeywords = mid(fstr,start,slut-2)
else
CovertGetKeywords = "_"
end if
'response.write start & " " & slut & VbCrLf
elseif InStr(LCase(fstr),"<meta name=keywords") > 0 then
start = InStr(LCase(fstr),"<meta name=keywords")+29
slut = InStr(mid(fstr,start),">")
if slut > 4 then
CovertGetKeywords = mid(fstr,start,slut-2)
else
CovertGetKeywords = "_"
end if
else
CovertGetKeywords = "_"
end if
End Function
Function CovertGetDescription(fstr)
start = InStr(LCase(fstr),"<meta name=""description")+34
if Start > 34 then
slut = InStr(mid(fstr,start),">")
'undgå at næste html-kode kommer med hvis der er glemt at afslutte med >
if InStr(mid(fstr,start),"<") < slut then slut = InStr(mid(fstr,start),"<")-2
if slut > 4 then
CovertGetDescription = mid(fstr,start,slut-2)
else
CovertGetDescription = "_"
end if
'response.write start & " " & slut & VbCrLf
elseif InStr(LCase(fstr),"<meta name=description") > 0 then
start = InStr(LCase(fstr),"<meta name=description")+32
slut = InStr(mid(fstr,start),">")
'undgå at næste html-kode kommer med hvis der er glemt at afslutte med >
if InStr(mid(fstr,start),"<") < slut then slut = InStr(mid(fstr,start),"<")-2
if slut > 4 then
CovertGetDescription = mid(fstr,start,slut-2)
else
CovertGetDescription = "_"
end if
else
CovertGetDescription = "_"
end if
End Function
' Mine funktioner til at få title, description & keywords *** slut ***
%>
Ny bruger
Nybegynder
Opret
Preview
