Check om link eksisterer (dødt link)

Jeg har lige skrevet et indlæg på http://www.eksperten.dk/spm/387473
Her er indlægget:

<%
'Timeout values in milliseconds
lngResolveTimeout = 500
lngConnectTimeout = 500
lngSendTimeout = 500
lngReceiveTimeout = 500

strTestUrl = "http://www.microsoft.com/nonexistingpage.html"

Set objHttpRequest = CreateObject("MSXML2.ServerXMLHTTP")
With objHttpRequest
  .SetTimeouts lngResolveTimeout, lngConnectTimeout, lngSendTimeout,
lngReceiveTimeout
  .Open "GET", strTestUrl
  .Send
  Select Case .Status
      Case 200 'No problem!
        Response.Write strTestUrl & " is a valid, available URL"
      Case 404 'Not found
        Response.Write strTestUrl & " could not be found (404 Error)"
      Case Else 'Some other problem
        Response.Write "An unexpected HTTP Status value was returned: " &
.Status
  End Select
End With
Set objHttpRequest = Nothing
%>

skal det her stå i en linie ?

With objHttpRequest
  .SetTimeouts lngResolveTimeout, lngConnectTimeout, lngSendTimeout, lngReceiveTimeout
  .Open "GET", strTestUrl
    .Send

Nej, det skal stå som det står.. på flere linier..

jeg får den her fejl ?

msxml3.dll eror
The server name or adress could not be resolved

Skal det her være en linie ?

                Response.Write "An unexpected HTTP Status value was returned: " &        
.Status

ja det skal det..

mht til fejlen "msxml3.dll eror The server name or adress could not be resolved", så er det vist fordi du ikke har filen msxml3.dll installeret..

Prøv at erstatte:
MSXML2.ServerXMLHTTP

med:
Microsoft.XMLHTTP

jeg får nu fejlen

object doesent support this poperthy or method
'settimeouts'

hmm.. jeg bliver lige nød til at lave den om..

Prøv det her.. gem koden i en fil, og skriv adressen på filen, plus:
?url=http://www.jubii.dk (her checkes om http://www.jubii.dk eksisterer)

Se om det virker hos dig:

<%
if request.querystring("url") <> "" then

dim objXMLHTTP, resultat, html, url
url = request.querystring("url")

Set objXMLHTTP = Server.CreateObject("Microsoft.XMLHTTP")

objXMLHTTP.Open "GET", url, false 
On Error Resume Next
objXMLHTTP.Send

With objXMLHTTP
  Select Case .Status
      Case 200 'No problem!
        Response.Write url & " is a valid, available URL"
      Case 404 'Not found
        Response.Write url & " could not be found (404 Error)"
      Case Else 'Some other problem
        Response.Write "An unexpected HTTP Status value was returned: " & .Status
  End Select
End With

Set objXMLHTTP = Nothing
else
  response.write "Skriv venligst en adresse i 'url='-delen af adressen."
end if
%>

Den går død ? - er der fejl i functionen ?

Function CheckLink(Url)

If Url<>"" Then
    dim objXMLHTTP, resultat, html

    Set objXMLHTTP = Server.CreateObject("Microsoft.XMLHTTP")

    objXMLHTTP.Open "GET", url, false 
    On Error Resume Next
    objXMLHTTP.Send

    With objXMLHTTP
      Select Case .Status
          Case 200 'No problem!
            Response.Write url & " is a valid, available URL"
          Case 404 'Not found
            Response.Write url & " could not be found (404 Error)"
          Case Else 'Some other problem
            Response.Write "An unexpected HTTP Status value was returned: " & .Status
      End Select
    End With

    Set objXMLHTTP = Nothing
else
  response.write "Skriv venligst en adresse i 'url='-delen af adressen."
end if
end function

Du mangler noget..
erstat:
If Url<>"" Then
    dim objXMLHTTP, resultat, html

med:
if request.querystring("url") <> "" then

dim objXMLHTTP, resultat, html, url
url = request.querystring("url")


Men vent.. jeg tror at du blander 2 ting sammen.. mit eksempel er et selv stændigt eksempel, som du skulle teste.. hvis det virker, skal det rettes til..
Hvordan kalder du på funktionen CheckLink ?

Jeg kører det ikke som selvstændig - det er en function i samme program hvor det bliver kaldt.

<font  face="Verdana" size="1" color="#0000FF"><%=CheckLink(weblink)%></font></a></td>

Vis mig koden.

Jeg går ud fra at "weblink" er en variabel der indeholdet urlen?

Det jeg oplever er at den hænger meget langt tid i en adresse som ikke eksisterer ? - hvis så har 60 link på en side virker som den fryser ?

<% Option Explicit
%><!-- #include file="..\DBFilnavn.asp" --><%
    Session.LCID=1030
    dim afd,Hjfunk,Datasaet,Datakilde,sqlsaetning,id,kode,website,weblink,email,counter,mynum,hjfunknavn

    afd=Request.QueryString("afd")
%>

<html>

<head>
<meta name="Generator" content="Stone's WebWriter 4">
<meta http-equiv="Content-Language" content="da">
<!-- Minus AutoDato -->
<title>WebList</title>

<meta http-equiv="Page-Enter" content="blendTrans(Duration=0.5)">

<link rel="stylesheet" type="text/css" href="../_themes/sumipntg/sumi1011.css"><meta name="Microsoft Theme" content="sumipntg 1011, default">

<style type="text/css"><!--
A:link { text-decoration: none; color: blue;}
A:visited { text-decoration: none; color:blue;}
A:active { text-decoration: none; color: red;}
A:hover { text-decoration: underline; color: red;font-weight: bold}//-->
</style>


</head>

<body topmargin="0">

<table border="0" cellpadding="0" cellspacing="0" style="border-collapse: collapse" width="100%" id="AutoNumber1" height="81">
  <tr>
    <td width="56%" height="81"><b><font face="Verdana" size="4">Webtavle</font></b>

    <p><font size="4"><u><b><i><%=Afd%>:</b></i></u>&nbsp; &nbsp; &nbsp;
    <a href="java script:self.print()"><font size="2"><b>Print</b></font>&nbsp;&nbsp;&nbsp</a>

    <a href="WebRamme.asp?Afd=<%=afd%>"  target="_self" >
    <font size="2"><b>Opret</b></font></a></font></p>
    </td>

    <td width="19%" height="81">
      <p align="right">
      <font face="Verdana">
      <img border="0" src=<%=Logofil%> width="110" height="77"></font></td>
   
  </tr>

</table>


<table border="1" cellpadding="0" cellspacing="0" style="border-collapse: collapse" width="100%" id="AutoNumber2">
  <tr>
    <td width="10%" height="2"><b><font size="2"></font></b></td>
    <td width="30%" height="2"><font size="2"><b>Website</b></font></td>
    <td width="40%" align="center" height="2"><b><font size="2">Weblink    (URL)</font></b></td>
    <td width="20%" align="center" height="2"><b><font size="2">Email        </font></b></td>
  </tr>


<%
Function CheckLink(Url)

If Url<>"" Then
    dim objXMLHTTP, resultat, html

    Set objXMLHTTP = Server.CreateObject("Microsoft.XMLHTTP")

    objXMLHTTP.Open "GET", url, false 
    On Error Resume Next
    objXMLHTTP.Send

    With objXMLHTTP
      Select Case .Status
          Case 200 'No problem!
            Response.Write url & " is a valid, available URL"
          Case 404 'Not found
            Response.Write url & " could not be found (404 Error)"
          Case Else 'Some other problem
            Response.Write "An unexpected HTTP Status value was returned: " & .Status
      End Select
    End With

    Set objXMLHTTP = Nothing
else
  response.write "Skriv venligst en adresse i 'url='-delen af adressen."
end if
end function

    response.expires=0
    Hjfunk=""

    set datasaet=server.Createobject("adodb.Recordset")
    datakilde=DBfilnavn
    sqlsaetning="SELECT  *  from Weblinks  Where Afd = '" & afd & "' order by kode  asc"
    datasaet.open  sqlsaetning, datakilde

    do until datasaet.eof

    ID=    datasaet("id")
    afd=    datasaet("afd")
    kode = datasaet("kode")
    Website = datasaet("website")
    Weblink = datasaet("weblink")
    email = datasaet("email")
%>
<%if Not Hjfunk=Kode Then%>
      <tr>
        <td width="10%" height="2">&nbsp;</td>
        <td width="30%" height="2">&nbsp;</td>
        <td width="40%" height="2">&nbsp;</td>
        <td width="20%" align="center" height="2">&nbsp;</td>
      </tr>
  <%Hjfunk=Kode
            counter = 0
            myNum = Len(kode)
          Do While Counter < 2
                myNum = myNum - 1
                counter = counter + 1
            Loop
            HjFunkNavn=Right(kode,myNum)
          else
            HjFunkNavn="" 
        end if%>

  <tr>
    <td width="10%" height="2"><font size="2"><b><I><%=hjfunkNavn%></I></b></font></td>
    <td width="30%" height="2">
          <a href="WebRamme.asp?afd=<%=afd%>&id=<%=id%>"  target="_self" >
          <font size="2"><%=website%></font>
    </td>
    <td width="40%" align="left" height="2"><a href="url:<%=Weblink%>" target="_self">
    <font  face="Verdana" size="1" color="#0000FF"><%=CheckLink(weblink)%></font></a></td>
    <td width="20%" align="center" height="2"><a href="mailto:<%=email%>">
    <font face="Verdana" size="1" color="#0000FF"><%=email%></font></a></td>
  </tr>

<%
  datasaet.movenext
  loop
  datasaet.close
%>
 
</table>


</body>



</html>

Den her er forkert: <a href="url:<%=Weblink%>" target="_self">
Du mener sikkert ?url=: <a href="?url=<%=Weblink%>" target="_self">

Nej den jeg har lavet virker rigtigt nok !

På virker det sådan at jo flere døde links der returneres går functionen
fuldstændig fast ?

hmm.. MSXML2.ServerXMLHTTP havde en timeout, hvilket x ikke har.. men den burde ikke sætte sig fast..
Prøv at skrive Response.Buffer = False lige ned under Option Explicit.. dvs:

<%
Option Explicit
Response.Buffer = False
%>
<!-- #include file="..\DBFilnavn.asp" -->
<%
    Session.LCID=1030
' osv.....

x = Microsoft.XMLHTTP

x = Microsoft.XMLHTTP
Hvor skal den stå ?

Den skal ikke stå nogen steder.. det var bare en rettelse til mit indlæg:
hmm.. MSXML2.ServerXMLHTTP havde en timeout, hvilket x ikke har..

der skulle have stået "Microsoft.XMLHTTP" i stedet for "x".. glemte at lave det om..

Alternativet virker ikke !

Tilbage hvor vi startede - den her virker indtil vi har et dødt link ?

Function  CheckL(Url)
    'Timeout values in milliseconds

    Dim lngResolveTimeout ,lngConnectTimeout,lngSendTimeout,lngReceiveTimeout,objHttpRequest

    lngResolveTimeout = 00
    lngConnectTimeout = 00
    lngSendTimeout = 00
    lngReceiveTimeout = 00

    Set objHttpRequest = CreateObject("MSXML2.ServerXMLHTTP")
    With objHttpRequest
      .SetTimeouts lngResolveTimeout, lngConnectTimeout, lngSendTimeout,lngReceiveTimeout
      .Open "GET", Url
      .Send
      Select Case .Status
          Case 200 'No problem!
            Response.Write Url & " is a valid, available URL"
          Case 404 'Not found
            Response.Write tUrl & " could not be found (404 Error)"
          Case Else 'Some other problem
            Response.Write "An unexpected HTTP Status value was returned: " &.Status
      End Select
    End With
    Set objHttpRequest = Nothing
end function

Da melder den fejl

msxml3.dll error
The server name or adress could not be resolved

MSXML2.ServerXMLHTTP kræver at msxml3.dll er installeret.

Som jeg skrev i mit indlæg (04/01-2004 14:33:47):
mht til fejlen "msxml3.dll eror The server name or adress could not be resolved", så er det vist fordi du ikke har filen msxml3.dll installeret..

Og det var derfor at jeg skiftede til Microsoft.XMLHTTP, som ikke har brug for yderligere filer.

Microsoft.XMLHTTP - men den fryser jo helt fast - kan man finde filen msxml3.dll og installer ?

Jeg ser lige om jeg kan finde den..

Jeg tror at du kan downloade den her:
http://www.microsoft.com/downloads/details.aspx?FamilyId=C0F86022-2D4C-4162-8FB8-66BFC12F32B0&displaylang=en

Jeg tror det er "msxml3cab.EXE" (629 KB):
http://www.microsoft.com/downloads/details.aspx?FamilyId=C0F86022-2D4C-4162-8FB8-66BFC12F32B0&displaylang=en#filelist

Nej det gør ingen forskel - det virker temelig håbeløs lige nu ?

Problemet kan være, at den prøver på at check flere urls på én gang.. men jeg ved ikke hvorfor..
Hvilken Windows kører du med? Win98? For XP har allerede msxml3.dll driveren..

Windows 2000 server IIS 5.0

Er du sikker på at du har installeret filen korrekt? Du skal muligivs også genstarte..

ja det er sikkert - også genstartet.

hmm.. så ved jeg ikke have der er galt..

Er der mulighed for at du kan sende mig dine filer inklusiv databasen? Hvis ja, så kan jeg kigge på det senere..

Skriv venligst ikke din email adresse her, pga spambots.

Jeg tror vi skal lede efter problemet et andet sted - se jeg læsser
i en access database med en odbc forbindelse - da jeg checker på
ca 30 links fra databasen går der for langt tid fra jeg åbner til jeg er færdig med at læse i databasen - hvis jeg husker ret lukker den automatisk forbindelsen efter et bestemt antal sekunder - det må være årsagen ? - jeg er forlangt tid om at validerer hver links ?

set datasaet=server.Createobject("adodb.Recordset")
    datakilde=DBfilnavn
    sqlsaetning="SELECT  *  from Weblinks  Where Afd = '" & afd & "' order by kode  asc"
    datasaet.open  sqlsaetning, datakilde

    do until datasaet.eof

    ID=    datasaet("id")
    afd=    datasaet("afd")
    kode = datasaet("kode")
    Website = datasaet("website")
    Weblink = datasaet("weblink")
    email = datasaet("email")


  datasaet.movenext
  loop
  datasaet.close

Hvis jeg laver et kald til CheckLink inden for denne løkke går det galt ?

Hvis jeg laver kald udenfor løkken som læser i database kan lave ligså mange kald jeg vil ? uden fejl.

Tyder på at samenfald mellen åbning  at dataseat samt kald til checklink går galt ?

Der er nogle at de link som jeg tester på som er alt for langsomme
til at svare tilbage - kan man rette functionen checklink til at
returner hvis ikke der er svaret inderfor feks 3 - 4 sec ?

lukket

Et spørgsmål er først lukket, når der er accepteret et svar :)

Et alternativ til databasen-lukke-ned-problemet..
Man kunne jo hive alle data ud på én gang, og smide dem ind i flere streng, hvor værdierne er separeret af f.eks. "," eller ";".
Derefter kan lukke forbindelsen til database, og stille og roligt teste dine links.
Så kan du lave en opdatering af strengene, hvor de links der eksisterer på nettet, enten fjenes fra strengene (sammen med deres respektive værdier), eller også fjerner du linksne (og deres respektive værdier) der ikke eksisterer på nettet.
Når alle links er checket, kan opdatere databasen med de links der eksisterer på nette.

Derved har du kun de links der er 'gyldige' i din database. Hvad siger du til det?