Sv: mission impossible xmlHTTP?
Hej,
till saker som dessa är Regular Expressions ganska bra att använda. Den här koden fungerar så som expressens sida ser ut just nu - men om de ändrar för mycket i html-koden så kommer förmodligen detta inte att fungera.
Observera också att detta endast är testat på den nuvarande sidan - det är nog en bra idé att vänta på att sidan uppdateras, och testa scriptet då igen för att se att det verkligen fungerar som det ska
<%
Function kandisar(n)
Set objHTTP = Server.CreateObject("Microsoft.XMLHTTP")
objHTTP.Open "GET", "http://expressen.se/index.jsp?d=2095", False
objHTTP.Send
str = objHTTP.responseText
Set objHTTP = Nothing
' Ta bort alla radbrytningar
str = replace(str, vbcrlf, "")
str = replace(str, vbcr, "")
str = replace(str, vblf, "")
Dim Re ' RegExp-objektet
Dim htmlBuffer ' Kommer att innehålla HTML-koden som ska returneras av funktionen
' Skapa ett reguljärt uttryck för att hämta informationen
' Vi använder två stycken här för att hämta bild, rubrik och länk
reg = "(?:<a href=""Javascript:PopWin\('(\/ego\/[^']*)',[^\)]*?\);""><img src=""([^""]+)""[^>]+><\/a><\/td>"
reg = reg & "|<td valign=""top""><a href=""Javascript:PopWin\('(\/ego\/[^']*)',[^\)]*?\);"">([\s\S]*?)</span>([\s\S]*?)<br><\/span>([\s\S]*?)<br><\/a><\/span>)" '
Set Re = New RegExp ' Skapa ett regexp objekt
Re.Pattern = reg ' Tilldela sökmönstret
Re.Global = true
Re.IgnoreCase = True
htmlBuffer = ""
i =0
set m = Re.Execute(str) ' Sök!
For Each objMatch in m ' För varje träff...
If i Mod 2 =0 then ' Hämta bildinfo (varannan träff innehåller bild+länk, varannan rubrik+länk)
imgSrc = "http://www.expressen.se" & objMatch.Submatches(1)
Else ' Hämta övrig info (rubrik och länk)
strPopupURL = "http://www.expressen.se" & objMatch.Submatches(2)
strHeader = objMatch.Submatches(4)
'** Bygg ihop den HTML-kod som ska returneras
htmlRow = "<table border=1>"
htmlRow = htmlRow & "<tr><th>Rubrik:</th><td>" & strHeader & "</td></tr>"
htmlRow = htmlRow & "<tr><th>Bild:</th><td><img src='" & imgSrc & "' /></td></tr>"
htmlRow = htmlRow & "<tr><th>URL:</th><td><a href='" & strPopupURL & "' target=_blank>" & strPopupURL & "</a></td></tr>"
htmlRow = htmlRow & "</table>"
htmlRow = htmlRow & "<hr>"
htmlBuffer = htmlBuffer & htmlRow
End If
i = i + 1
If n > 0 and n = (i/2) Then Exit For ' Hämta bara så många vi vill ha
Next
kandisar = htmlBuffer
End Function
response.write kandisar(5) ' Hämta fem st.
%>
Mvh
David