<%
Option Explicit
On Error Resume Next
Dim oHttp, sTemp, iComic, iStart, iEnd, aUrls(3), aSrch(3), aComics(3), a
Set oHttp = CreateObject("Msxml2.ServerXMLHTTP.3.0")
aUrls(0) = "http://www.2600.com/"
aSrch(0) = "images/covers"
aUrls(1) = "http://www.dilbert.com/"
aSrch(1) = "TODAY'S COMIC"
aUrls(2) = "http://www.gocomics.com/thequigmans/"
aSrch(2) = "comics/tmqui"
%>
Comics page
| Comics |
<%
' loop through all of the URLs in the array
For a = 0 to Ubound(aUrls) - 1
aComics(a) = ""
' get the text from the given page
sTemp = getLink(aUrls(a), oHttp)
' if there is text
If Len(sTemp) > 0 Then
' look for the token
iComic = InStr(UCase(sTemp), UCase(aSrch(a)))
If iComic > 0 Then
' look for the image tag
iStart = InStrRev(UCase(sTemp), " 0 Then
' look for the closing > of the image tag
iEnd = InStr(iStart, sTemp, ">") + 1
If iEnd > 0 Then
' get the image tag text
aComics(a) = Mid(sTemp, iStart, iEnd - iStart)
' replace the src with one pointing to the originating website
If InStr(aComics(a), "SRC=""/") > 0 Then
aComics(a) = Replace(aComics(a), "SRC=""/", "SRC=""" & aUrls(a))
ElseIf InStr(aComics(a), "SCR='") > 0 Then
aComics(a) = Replace(aComics(a), "SRC='", "SRC='" & aUrls(a))
Else
aComics(a) = Replace(aComics(a), "SRC=""", "SRC=""" & aUrls(a))
End If
' write the image tag out with a hyperlink to the originating website
Response.Write "| " & aComics(a) & " |
" & vbcrlf
End If
End If
End If
End If
Next
%>
| |
<%
Function getLink( sUrl, oHttp )
Dim RefPage
On Error Resume Next
getLink = ""
' open the url
oHttp.Open "GET", sUrl, False
If Err.Number = 0 Then
'send the request
oHttp.Send
If Err.Number = 0 Then
' get the response
RefPage = oHttp.responseText
' return the response if the page is found
If InStr(RefPage, "NOT FOUND" ) = 0 Then getLink = RefPage
End If
End If
End Function
%>