<% @LANGUAGE=VBSCRIPT %> <% Server.ScriptTimeout = 7200 %> <% response.buffer=false %> <% dim objHTTP, stext const Request_GET = 2 nurls=0 'Set objHTTP = Server.CreateObject("Microsoft.XMLHTTP") Set objHTTP = CreateObject("SOFTWING.ASPtear") objHTTP.ConnectionTimeout = 100 objHTTP.ForceReload = True objHTTP.UserAgent = "Mozilla/4.0 (compatible; MSIE 5.0b2; Windows NT)" On Error Resume Next Set Connection = Server.CreateObject("ADODB.Connection") Connection.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=D:\Webs\ericae\db0\ft\ft1c.mdb;" SQLStmt = "SELECT ID, url FROM ft3;" Set RS = Connection.Execute(SQLStmt) response.write "FT Lib Check

FT Lib Check

" while NOT RS.EOF ' and nurls<40 url=RS("URL") ID= RS("ID") nurls=nurls+1 response.write nurls & vbTab & ""+url+"" objHTTP.Reset() objHTTP.ConnectionTimeout = 50 ' objHTTP.ForceReload = True objHTTP.UserAgent = "Mozilla/4.0 (compatible; MSIE 5.0b2; Windows NT)" stext = objHTTP.Retrieve(url, Request_GET, "", "", "") isok=1 if Err.Number>=400 then isok=0 ' response.write id & vbTab & ""+url+""+vbTAB & ERR.Description &"
" & vbCRLF response.write vbTAB & cstr(err.Number) &"
" & vbCRLF ' response.write vbTAB & err.description &"
" & vbCRLF SQL = "Update ft3 set URLok = " & isok & " WHERE ID= " & ID & ";" ' response.write sql & "

" Set RS2 = Connection.Execute(SQL) err.number=0 RS.MoveNext set stext=nothing wend response.write "

Sitemap 1 - Sitemap 2 - Sitemap 3 - Sitemap 4 - Sitemape 5 - Sitemap 6

" set objHTTP=nothing set sText=Nothing set RS=nothing set RS2= nothing connection.close set connection=nothing response.end %>