"Michael Tillgaard" <post@fast-klan.dk> skrev i en meddelelse news:45fd4a17$0$90275$14726298@news.sunsite.dk...
> Klip
> >
> > Helt i orden her er funktionen og noget kode der kan hente siden og finde ud
> > af hvilke filer der skal hentes:
> >
> > link1 = "
http://62.141.52.152/62.141.52.152/"
> > text1 = GetHttp(link1)
> >
> Klip
>
> Hej
>
> Får desværre en fejlmelding:
>
> Microsoft VBScript runtime error '800a000d'
>
> Type mismatch: 'GetHttp'
>
> Ved du hvad der er galt?
>
Ja, du skal også bruge den funktion jeg sendte i den første besked. Her er hele scriptet med de funktioner der skal bruges, jeg har
testet det hos mig selv og her virker det, det kræver selvfølgelig at du har adgang til Socket.TCP og Scripting.FileSystemObject
ellers virker det her script ikke.
Med venlig hilsen Christoffer
<%
Server.ScriptTimeOut = 3600
response.buffer = false
response.write "Henter siden...<br>"
link1 = "
http://62.141.52.152/62.141.52.152/"
text1 = GetHttp(link1)
response.write "Siden er hentet, henter undersider...<br>"
For each link_found in Split(FindLinks(text1,link1),VbCrLf)
if link_found <> "" then
response.write "Henter: " & link_found & "<br>"
tmplink = left(link_found,Instr(link_found,Chr(9))-1)
filetype = mid(tmplink,InstrRev(tmplink,".")+1)
if lcase(filetype) = "png" then
strhttp = GetHttp(tmplink)
filedata = mid(strhttp,Instr(strhttp,VbCrLf&VbCrLf)+len(VbCrLf&VbCrLf))
filedata = StringToBinary(filedata)
FileName = mid(tmplink,InstrRev(tmplink,"/")+1)
FileName = Server.Mappath(FileName)
tmp = WriteToFile(FileName,filedata)
end if
end if
Next
response.write "Udført, alle sider er hentet..."
Function StringToBinary(S)
Dim i, ByteArray
For i=1 To Len(S)
ByteArray = ByteArray & ChrB(Asc(Mid(S,i,1)))
Next
StringToBinary = ByteArray
End Function
Function WriteToFile(strFileSpec,bstrPostData)
'det ser tilsyneladende ud til at det ved binære filer skal være
'intEndPos = len(bstrPostData)*2
'og ved tekst filer skal være
'intEndPos = len(bstrPostData)*2+1
Set fs = CreateObject("Scripting.FileSystemObject") 'Filsystem objekt
Set ts = fs.CreateTextFile(strFileSpec, True) 'Åbn outputfil, overskriv evt. eksisterende
intStartPos = 1
intEndPos = len(bstrPostData)*2+1 'for at gøre det muligt også at gemme tekst filer er der tilføjet +1
For i = intStartPos To intEndPos
if MidB(bstrPostData, i, 1) = "" then Exit For 'denne linje er tilføjet for at det både virker med tekstfiler og binære filer.
ts.Write(Chr(AscB(MidB(bstrPostData, i, 1)))) 'Skriv data eet tegn af gangen
Next
ts.Close 'Luk outputfil
End Function
Function GetHttp(strUrl)
tmpstrurl = strurl
on error resume next
if left(lcase(tmpstrurl),7) = "http://" then tmpstrurl = mid(tmpstrurl,8)
if Instr(tmpstrurl,"/") > 0 then
strHost = left(tmpstrurl,Instr(tmpstrurl,"/")-1)
strPage = mid(tmpstrurl,Instr(tmpstrurl,"/"))
else
strHost = tmpstrurl
strPage = "/"
end if
'response.write "Url: http://" & tmpstrurl & "<br>"
'response.write "Host: " & strHost & "<br>"
'response.write "Page: " & strPage & "<hr>"
'--- start * download page/file ---
'> Eksempel:
'strHost = "cht.dk"
'strPage = "/kontakt.asp"
set Socket = server.CreateObject("Socket.TCP")
socket.Host = strHost & ":80"
Socket.TimeOut = 8000
Socket.Open
Socket.SendLine("GET " & strPage & " HTTP/1.0" & Chr(13) & Chr(10) & "Host: " & strHost & Chr(13) & Chr(10))
Socket.WaitForDisconnect()
GetHttp = Socket.Buffer
Socket.Close()
Set Socket = Nothing
End Function
Function FindLinks(htmltext,pageurl)
'Information: Finder links i html tekst, skriver links, derefter evt. link-tekst og til sidst evt. title-tekst. Disse tre dele
adskilles med tab "Chr(9)".
'
'Opdateret:
'13:09 24-06-2006
'17:43 30-01-2007
'14:51 09-02-2007
response.write pageurl & "<br>"
response.write pageurl_server & "<br>"
'nb. denne version finder kun links ikke link-tekst, og evt. link-title.
'
'typer links:
'href=
'src=
'open('
'link metoder:
'http://
'https://
'mailto:
'javascript:
'ftp://
'
'find ud af hvilken form for link der er tale om:
'1. link til underside.
'2. link til side på samme domain-navn.
'3. link til ekstern side.
'3b. link indeholder domain-navn.
'4. link til ftp-server.
'5. link til javascript.
'6. link til e-mail.
'7. link til sikker side.
'0. ikke fundet (ukendt type).
links_count = 0
htmltext = replace(htmltext,"href=","href=",1,-1,1)
htmltext = replace(htmltext,"src=","src=",1,-1,1)
htmltext = replace(htmltext,"open('","open('",1,-1,1)
For each link in Split(htmltext,"href=")
links_count = links_count+1
link_adress = ""
if left(link,1) = "'" and Instr(2,link,"'",1) > 0 then
if Instr(2,link,">",1) > Instr(2,link,"'",1) or Instr(link,">") = 0 then
link_adress = mid(link,2,Instr(2,link,"'",1)-2)
else
link_adress = mid(link,2,Instr(2,link,">",1)-2)
end if
elseif left(link,1) = """" and Instr(2,link,"""",1) > 0 then
if Instr(2,link,">",1) > Instr(2,link,"""",1) or Instr(link,">") = 0 then
'link_adress = mid(link,2,Instr(2,link,"""",1)-2)
link_adress = mid(link,2,Instr(mid(link,2),"""")-1)
else
'link_adress = mid(link,2,Instr(2,link,">",1)-2)
if Instr(mid(link,2),">") > 0 then link_adress = mid(link,2,Instr(mid(link,2),">")-1)
end if
elseif Instr(2,link," ",1) > 0 or Instr(2,link,">",1) > 0 then
if Instr(link,">") > Instr(link," ") or Instr(link,">") = 0 then
link_adress = mid(link,1,Instr(1,link," ",1)-1)
else
link_adress = mid(link,1,Instr(1,link,">",1)-1)
end if
end if
link_type = "0"
link_adress_server = ""
if pageurl <> "" then
if left(lcase(link_adress),len("ftp://")) = lcase("ftp://") then
link_type = "4"
elseif left(lcase(link_adress),len("javascript:")) = lcase("javascript:") then
link_type = "5"
elseif left(lcase(link_adress),len("mailto:")) = lcase("mailto:") then
link_type = "6"
elseif left(lcase(link_adress),len("
https://")) = lcase("
https://") then
link_type = "7"
else
pageurl_server = mid(pageurl,Instr(pageurl,"//")+2)
if Instr(pageurl_server,"/") > 0 then pageurl_server = left(pageurl_server,Instr(pageurl_server,"/")-1)
if Instr(mid(pageurl,Instr(pageurl,"//")+2),"/") > 0 then
'!!! pageurl_folder virker ikke optimalt, da sidens adresse både kan være en mappe og adressen på en side
pageurl_folder = left(pageurl,InstrRev(pageurl,"/")-1)
else
pageurl_folder = pageurl
end if
if left(lcase(link_adress),len("
http://")) <> lcase("
http://") then
if left(link_adress,1) = "/" then
'undersøg om det er et link til en underside
link_type = "2"
link_adress = "http://" & pageurl_server & link_adress
else
if left(lcase(pageurl_folder),7) = "http://" then
link_adress = pageurl_folder & "/" & "" & link_adress
else
link_adress = "http://" & pageurl_server & "/" & pageurl_folder & "/" & "" & link_adress
end if
'link_adress = "http://" & pageurl_server & "/" & pageurl_folder & "/" & link_adress
end if
end if
link_adress_server = mid(link_adress,Instr(link_adress,"//")+2)
if Instr(link_adress_server,"/") > 0 then link_adress_server = left(link_adress_server,Instr(link_adress_server,"/")-1)
'!!! der er taget højde for at der kan være links hvor det kun er domainnavn der er intastet, (som ikke ender på /)
if left(lcase(link_adress),len(pageurl_folder)) = lcase(pageurl_folder) then
link_type = "1"
elseif lcase(link_adress_server) = lcase(pageurl_server) then
link_type = "2"
else
link_type = "3"
end if
end if
end if
if links_count > 1 and link_adress <> "" then
FindLinks = FindLinks & link_adress & Chr(9) & link_type & Chr(9) & link_adress_server & VbCrLf
end if
Next
if links_count = 0 then links_count = 1
FindLinks = FindLinks & "'''Antal 'href' links fundet: " & links_count-1 & VbCrLf
links_count = 0
For each link in Split(htmltext,"src=")
links_count = links_count+1
link_adress = ""
if left(link,1) = "'" and Instr(2,link,"'",1) > 0 then
if Instr(2,link,">",1) > Instr(2,link,"'",1) or Instr(link,">") = 0 then
link_adress = mid(link,2,Instr(2,link,"'",1)-2)
else
'link_adress = mid(link,2,Instr(2,link,">",1)-2)
link_adress = mid(link,2,Instr(mid(link,2),">")-1)
end if
elseif left(link,1) = """" and Instr(2,link,"""",1) > 0 then
if Instr(2,link,">",1) > Instr(2,link,"""",1) or Instr(link,">") = 0 then
'link_adress = mid(link,2,Instr(2,link,"""",1)-2)
link_adress = mid(link,2,Instr(mid(link,2),"""")-1)
else
'link_adress = mid(link,2,Instr(2,link,">",1)-2)
if Instr(mid(link,2),">") > 0 then link_adress = mid(link,2,Instr(mid(link,2),">")-1)
end if
elseif Instr(2,link," ",1) > 0 or Instr(2,link,">",1) > 0 then
if Instr(1,link,">",1) > Instr(1,link," ",1) or Instr(link,">") = 0 then
link_adress = mid(link,1,Instr(1,link," ",1)-1)
else
link_adress = mid(link,1,Instr(1,link,">",1)-1)
end if
end if
link_type = "0"
link_adress_server = ""
if pageurl <> "" then
if left(lcase(link_adress),len("ftp://")) = lcase("ftp://") then
link_type = "4"
elseif left(lcase(link_adress),len("javascript:")) = lcase("javascript:") then
link_type = "5"
elseif left(lcase(link_adress),len("mailto:")) = lcase("mailto:") then
link_type = "6"
elseif left(lcase(link_adress),len("
https://")) = lcase("
https://") then
link_type = "7"
else
pageurl_server = mid(pageurl,Instr(pageurl,"//")+2)
if Instr(pageurl_server,"/") > 0 then pageurl_server = left(pageurl_server,Instr(pageurl_server,"/")-1)
if Instr(mid(pageurl,Instr(pageurl,"//")+2),"/") > 0 then
'!!! pageurl_folder virker ikke optimalt, da sidens adresse både kan være en mappe og adressen på en side
pageurl_folder = left(pageurl,InstrRev(pageurl,"/")-1)
else
pageurl_folder = pageurl
end if
'if Instr(8,pageurl,"/") > 0 then
' 'pageurl_folder = left(pageurl,InstrRev(pageurl,"/")-1)
' tmpfolder = mid(pageurl,Instr(pageurl,"//")+2)
' pageurl_folder = "/" & mid(tmpfolder,InstrRev(tmpfolder,"/")+1)
'else
' pageurl_folder = pageurl
'end if
if left(lcase(link_adress),len("
http://")) <> lcase("
http://") then
if left(link_adress,1) = "/" then
'undersøg om det er et link til en underside
link_type = "2"
link_adress = "http://" & pageurl_server & link_adress
else
if left(lcase(pageurl_folder),7) = "http://" then
link_adress = pageurl_folder & "/" & "" & link_adress
else
link_adress = "http://" & pageurl_server & "/" & pageurl_folder & "/" & "" & link_adress
end if
'link_adress = "http://" & pageurl_server & "/" & link_adress
end if
end if
link_adress_server = mid(link_adress,Instr(link_adress,"//")+2)
if Instr(link_adress_server,"/") > 0 then link_adress_server = left(link_adress_server,Instr(link_adress_server,"/")-1)
'!!! der er taget højde for at der kan være links hvor det kun er domainnavn der er intastet, (som ikke ender på /)
if left(lcase(link_adress),len(pageurl_folder)) = lcase(pageurl_folder) then
link_type = "1"
elseif lcase(link_adress_server) = lcase(pageurl_server) then
link_type = "2"
else
link_type = "3"
end if
end if
end if
if links_count > 1 and link_adress <> "" then
FindLinks = FindLinks & link_adress & Chr(9) & link_type & Chr(9) & link_adress_server & VbCrLf
end if
Next
if links_count = 0 then links_count = 1
FindLinks = FindLinks & "'''Antal 'src' links fundet: " & links_count-1 & VbCrLf
'FindLinks = "ok"
links_count = 0
For each link in Split(htmltext,"open(")
links_count = links_count+1
link_adress = ""
if left(link,1) = "'" and Instr(2,link,"'",1) > 0 then
if Instr(2,link,">",1) > Instr(2,link,"'",1) or Instr(link,">") = 0 then
link_adress = mid(link,2,Instr(2,link,"'",1)-2)
else
'link_adress = mid(link,2,Instr(2,link,">",1)-2)
link_adress = mid(link,2,Instr(mid(link,2),">")-1)
end if
elseif left(link,1) = """" and Instr(2,link,"""",1) > 0 then
if Instr(2,link,">",1) > Instr(2,link,"""",1) or Instr(link,">") = 0 then
'link_adress = mid(link,2,Instr(2,link,"""",1)-2)
link_adress = mid(link,2,Instr(mid(link,2),"""")-1)
else
'link_adress = mid(link,2,Instr(2,link,">",1)-2)
if Instr(mid(link,2),">") > 0 then link_adress = mid(link,2,Instr(mid(link,2),">")-1)
end if
elseif Instr(2,link," ",1) > 0 or Instr(2,link,">",1) > 0 then
if Instr(1,link,">",1) > Instr(1,link," ",1) or Instr(link,">") = 0 then
link_adress = mid(link,1,Instr(1,link," ",1)-1)
else
link_adress = mid(link,1,Instr(1,link,">",1)-1)
end if
end if
link_type = "0"
link_adress_server = ""
if pageurl <> "" then
if left(lcase(link_adress),len("ftp://")) = lcase("ftp://") then
link_type = "4"
elseif left(lcase(link_adress),len("javascript:")) = lcase("javascript:") then
link_type = "5"
elseif left(lcase(link_adress),len("mailto:")) = lcase("mailto:") then
link_type = "6"
elseif left(lcase(link_adress),len("
https://")) = lcase("
https://") then
link_type = "7"
else
pageurl_server = mid(pageurl,Instr(pageurl,"//")+2)
if Instr(pageurl_server,"/") > 0 then pageurl_server = left(pageurl_server,Instr(pageurl_server,"/")-1)
if Instr(mid(pageurl,Instr(pageurl,"//")+2),"/") > 0 then
'!!! pageurl_folder virker ikke optimalt, da sidens adresse både kan være en mappe og adressen på en side
pageurl_folder = left(pageurl,InstrRev(pageurl,"/")-1)
else
pageurl_folder = pageurl
end if
'if Instr(8,pageurl,"/") > 0 then
' 'pageurl_folder = left(pageurl,InstrRev(pageurl,"/")-1)
' tmpfolder = mid(pageurl,Instr(pageurl,"//")+2)
' pageurl_folder = "/" & mid(tmpfolder,InstrRev(tmpfolder,"/")+1)
'else
' pageurl_folder = pageurl
'end if
'response.write pageurl_server & "<br>"
if left(lcase(link_adress),len("
http://")) <> lcase("
http://") then
if left(link_adress,1) = "/" then
'undersøg om det er et link til en underside
link_type = "2"
link_adress = "http://" & pageurl_server & link_adress
else
if left(lcase(pageurl_folder),7) = "http://" then
link_adress = pageurl_folder & "/" & "" & link_adress
else
link_adress = "http://" & pageurl_server & "/" & pageurl_folder & "/" & "" & link_adress
end if
'link_adress = "http://" & pageurl_server & "/" & link_adress
end if
end if
link_adress_server = mid(link_adress,Instr(link_adress,"//")+2)
if Instr(link_adress_server,"/") > 0 then link_adress_server = left(link_adress_server,Instr(link_adress_server,"/")-1)
'!!! der er taget højde for at der kan være links hvor det kun er domainnavn der er intastet, (som ikke ender på /)
if left(lcase(link_adress),len(pageurl_folder)) = lcase(pageurl_folder) then
link_type = "1"
elseif lcase(link_adress_server) = lcase(pageurl_server) then
link_type = "2"
else
link_type = "3"
end if
end if
end if
if links_count > 1 and link_adress <> "" then
FindLinks = FindLinks & link_adress & Chr(9) & link_type & Chr(9) & link_adress_server & VbCrLf
end if
Next
if links_count = 0 then links_count = 1
FindLinks = FindLinks & "'''Antal 'open' links fundet: " & links_count-1 & VbCrLf
'FindLinks = "ok"
links_count = 0
'response.write pageurl_server & "<br>" & link_adress_server
End Function
%>
- - -
Denne besked er sendt gennem
http://cht.dk... Online portal, kalender og
konferencesystem...