Hämta all text från en sida

Menar du typ såhär?

Function GetPage(strURL)
  On Error Resume Next

  Set objHTTP = Server.CreateObject("Microsoft.XMLHTTP")
  objHTTP.Open "GET", strUrl, False
  objHTTP.Send

  If Err.Code <> "" Then
    strReturn = "Sidan fanns inte"
  Else
    strReturn = Replace(Server.HTMLEncode(objHTTP.ResponseText), vbCrLf, "<br>")
  End If

  Set objHTTP = Nothing
  GetPage = strReturn
End Function

strSida = GetPage("http://www.webforum.nu")

Det retunerar allt inklusive html-taggar och allt. Jag vill vara ha texten från sidan.

[kod]
<%
Function GetPage(strURL)
'On Error Resume Next

Set objHTTP = Server.CreateObject("Microsoft.XMLHTTP")
objHTTP.Open "GET", strUrl, False
objHTTP.Send

'If Err.Code <> "" Then
'strReturn = "Sidan fanns inte"
'Else
strReturn = objHTTP.ResponseText
'End If

Set objHTTP = Nothing
GetPage = strReturn
End Function

Function RemoveStyle(ByVal sString)
Dim objRegExp
Set objRegExp = New RegExp
objRegExp.Global = True
objRegExp.Pattern = "<style[\s\S]*?</style>"
RemoveStyle = objRegExp.Replace(sString & "", "")
Set objRegExp = Nothing
End Function

Function RemoveJava(ByVal sString)
Dim objRegExp
Set objRegExp = New RegExp
objRegExp.Global = True
objRegExp.Pattern = "<script[\s\S]*?</script>"
RemoveJava = objRegExp.Replace(sString & "", "")
Set objRegExp = Nothing
End Function

Function RemoveHTML(ByVal sString)
Dim objRegExp
Set objRegExp = New RegExp
objRegExp.Global = True
objRegExp.Pattern = "<[^>]*>"
RemoveHTML = objRegExp.Replace(sString & "", "")
Set objRegExp = Nothing
End Function

strSida = GetPage("http://www.aftonbladet.se")
strSida = RemoveStyle(strSida)
strSida = RemoveJava(strSida)
strSida = RemoveHTML(strSida)

response.write strSida

%>
[kod]

Inte speciellt optimerad kod ännu men pröva den på aftonbladet.se så ser ni att den inte tar bort allt skräp. Någon som vet varför?

Någon som vet varför ovanliga tecken som åäö hämtas och blir frågetecken?

Sök en smula på XMLHTTP här på forumet så lär du hitta en o annan tråd som tar upp det...

Såhär då?

/red Vill inte funka... Det är väl jag som är trög såhär efter skolan. ;)
/red2 Nu fick jag i alla fall till det sådär! :)

Function GetPage(strURL)
  On Error Resume Next

  Set objHTTP = Server.CreateObject("Microsoft.XMLHTTP")
  objHTTP.Open "GET", strUrl, False
  objHTTP.Send

  If Err.Number > 0 Then
    strReturn = "Sidan fanns inte"
  Else
    strReturn = objHTTP.ResponseBody

    For i = 1 To LenB(strReturn)
      strTemp = strTemp & Chr(AscB(MidB(strReturn, i, 1)))
    Next

    strReturn = Replace(strTemp, vbCrLf, "<br>")
  End If

  Set objHTTP = Nothing
  GetPage = strReturn
End Function

Function RemoveStyle(ByVal sString) 
  Dim objRegExp 
  Set objRegExp = New RegExp 
  objRegExp.Global = True 
  objRegExp.Pattern = "<style[\s\S]*?</style>" 
  RemoveStyle = objRegExp.Replace(sString & "", "") 
  Set objRegExp = Nothing 
End Function 

Function RemoveJava(ByVal sString) 
  Dim objRegExp 
  Set objRegExp = New RegExp 
  objRegExp.Global = True 
  objRegExp.Pattern = "<script[\s\S]*?</script>" 
  RemoveJava = objRegExp.Replace(sString & "", "") 
  Set objRegExp = Nothing 
End Function 

Function RemoveHTML(ByVal sString) 
  Dim objRegExp 
  Set objRegExp = New RegExp 
  objRegExp.Global = True 
  objRegExp.Pattern = "<[^>]*>" 
  RemoveHTML = objRegExp.Replace(sString & "", "") 
  Set objRegExp = Nothing 
End Function 

strSida = Replace(Replace(RemoveHTML(RemoveJava(RemoveStyle(GetPage("http://www.webforum.nu")))), vbCrLf, "<br>"), Chr(10), "<br>")
Response.Write(strSida)

Finns det några fler taggar som jag inte tänkt på där det står skräp emellan. Alltså <tagg>Skräp</tagg>?