Используя классический ASP, как получить или отсканировать мета-теги HTML-страницы?

Question

Используя следующий код, я могу добраться до сайта, получить данные, но не могу получить метатег заголовка. Удивительно, но я искал методы получения мета-тегов во время скрининга на классическом ASP и нашел только пару примеров, ни один из которых я не смог заставить работать.

Любая помощь?

rss_url = "https://www.nationalgeographic.com/science/2019/06/opal-fossils-reveal-new-species-dinosaur-australia-fostoria/"

Set objHTTP = CreateObject("Microsoft.XMLHTTP")
objHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/74.0.3729.169 Safari/537.36"
objHTTP.Open "GET", rss_url, False
objHTTP.Send

if objHTTP.Status = 200 Then sdata = BinaryToString(objHTTP.ResponseBody)

Set objHTTP = Nothing      

Set regEx = New RegExp
regEx.Pattern = "<meta.*property=""og:image"".*content=""(.*)"".*\/>"
regEx.IgnoreCase = True
Set matches = regEx.Execute(sdata)
if matches.Count > 0 then
KeywordAl = matches(0).SubMatches(0)
response.write "Image = " & KeywordAl&"<hr>"
end if

Я включил функцию BinaryToString только для завершения:

Function BinaryToString(byVal Binary)
    '--- Converts the binary content to text using ADODB Stream

    '--- Set the return value in case of error
    BinaryToString = ""

    '--- Creates ADODB Stream
    Dim BinaryStream
    Set BinaryStream = CreateObject("ADODB.Stream")

    '--- Specify stream type.
    BinaryStream.Type = 1 '--- adTypeBinary

    '--- Open the stream And write text/string data To the object
    BinaryStream.Open
    BinaryStream.Write Binary

    '--- Change stream type to text
    BinaryStream.Position = 0
    BinaryStream.Type = 2 '--- adTypeText

    '--- Specify charset for the source text (unicode) data.
    BinaryStream.CharSet = "UTF-8"

    '--- Return converted text from the object
    BinaryToString = BinaryStream.ReadText
End Function 

Answer 1

Попробуйте это:

Function GetTextFromUrl(url)
  Dim oXMLHTTP
  Dim strStatusTest
  Set oXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.3.0")
  oXMLHTTP.Open "GET", url, False
  oXMLHTTP.Send
  If oXMLHTTP.Status = 200 Then
    GetTextFromUrl = oXMLHTTP.responseText
  End If
End Function

Dim sResult : sResult = GetTextFromUrl("https://www.nationalgeographic.com/science/2019/06/opal-fossils-reveal-new-species-dinosaur-australia-fostoria/")

Set regEx = New RegExp
regEx.Pattern = "<meta.*property=""og:image"".*content=""(.*)"".*\/>"
regEx.IgnoreCase = True
Set matches = regEx.Execute(sResult)
if matches.Count > 0 then
  KeywordAl = matches(0).SubMatches(0)
  response.write "Image = " & KeywordAl&"<hr>"
end if

Для меня это вывод для этой страницы:

Изображение = https://www.nationalgeographic.com/content/dam/science/2019/05/22/gemstone-dino/og-fostoria_final.ngsversion.1559624211907.adapt.1900.1.jpg

edit: здесь добавлена ​​информация об отладке. Попробуйте этот фрагмент и посмотрите, что он говорит о вашей версии TLS - возможно, этот сайт отклоняет соединения ниже определенного уровня TLS.

Set objHttp = Server.CreateObject("WinHTTP.WinHTTPRequest.5.1") 
objHttp.open "GET", "https://howsmyssl.com/a/check", False 
objHttp.Send 
Response.Write objHttp.responseText 
Set objHttp = Nothing 
Response.End