Optimering af linkchecker

Jeg har klippet noget kode sammen som checker om de links jeg har i en database fungerer. Men Det tager vildt lang tid for serveren at gennemgå dem alle. Hvordan kan man optimere det her script?



<%
Server.ScriptTimeout = 500

Set rs = Server.CreateObject("ADODB.Recordset")
Query = "SELECT * FROM Links ORDER by Title desc;"
rs.Open Query, Connect, 1, 2
title = rs("Title")
id = rs("id")
url = rs("url")


' Array med URL'er, som skal chekkes
arrURLS = "http://www.exp.dk"
do until rs.EOF
  arrURLS = arrURLS & ",url"
loop
movenext

arrURLS = Split(arrURLS,",")

' Array med HTTP headerkoder
arrHTTPcode = Array("100", "101", "200", "201", "202", "203", "204", "205", "206", "300", "301", "302", "303", "304", "305", "307", "400", "401", "402", "403", "404", "405", "406", "407", "408", "409", "410", "411", "412", "413", "414", "415", "416", "417", "500", "501", "502", "503", "504", "505")
' Array med HTTP header kodernesforklaringer
arrHTTPtext = Array("Continue", "Switching Protocols", "OK", "Created", "Accepted", "Non-Authoritative Information", "No Content", "Reset Content", "Partial Content", "Multiple Choices", "Moved Permanently", "Found", "See Other", "Not Modified", "Use Proxy", "Temporary Redirect", "Bad Request", "Unauthorized", "Payment Required", "Forbidden", "Not Found", "Method Not Allowed", "Not Acceptable", "Proxy Authentication Required", "Request Time-out", "Conflict", "Gone", "Length Required", "Precondition Failed", "Request Entity Too Large", "Request-URI Too Large", "Unsupported Media Type", "Requested range not satisfiable", "Expectation Failed", "Internal Server Error", "Not Implemented", "Bad Gateway", "Service Unavailable", "Gateway Time-out", "HTTP Version not supported")
' Gennemløb Array med URL'er
For intURL = 0 to Ubound(arrURLS)
  Set HttpObj = Server.CreateObject("AspHTTP.Conn")
  HTTPObj.Url = arrURLS(intURL)
  HTTPObj.GetURL

  For intCode = 0 to Ubound(arrHTTPcode)
    If Instr(HttpObj.Response,arrHTTPcode(intCode)) Then
      strResponse = arrHTTPtext(intCode)
      Exit For
    End if
  Next
  Response.Write "<p>" & arrURLS(intURL) & " - " & strResponse & "</p>"
  strResponse = ""
Next
%>