Проверка анкора по известному URL

[Qwertiy]

Фикс для ссылки из ЛС:

Код: Выделить всё

    Try
      WC.Headers.Add(HttpRequestHeader.UserAgent, "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.31 (KHTML, like Gecko) Chrome/26.2.9999.797 Safari/537.31")
      Data = WC.DownloadData(Url)
      EncStr = WC.ResponseHeaders(HttpResponseHeader.ContentType)

сервер требует указывать user agent, иначе присылает 0 байт.

[Qwertiy]

Код: Выделить всё

iPos        -1
lenStart   8

И зачем мне это? Бери и дебажь.

[Egor2014]

Проблемный url даже страница код не даёт: DownloadPageContent("sait.com")
url скинул в личку, что можно сделать?

[Qwertiy]

url скинул в личку, что можно сделать?

Я тебе ещё полчаса назад ответил, что сделать. Не пропускай посты.

[Egor2014]

И ещё одно исправление:

Код: Выделить всё

    Catch ex As WebException
      If ex.Response Is Nothing Then Throw
      Using Response As WebResponse = ex.Response

это для случая, когда ничего не получено (например, не разресолвился адрес).

Появился недоступный временно сайт, но код выше не помог, указывает на эту строку, последнее слово выделяет жёлтым:
If ex.Response Is Nothing Then Throw
Ниже: "Невозможно соединиться с удаленным сервером". Проверка в цикле по всем url вылетает,помогите отловить временно недоступные сайты, как исправить, помогите пожалуйста?

[Qwertiy]

Обернуть вызов получаения страницы (который в цикле) в Try - Catch. Что именно делать в Catch - решай сам. Возможно, надо поставить какой-нибудь статус ошибки вместо информации о ссылке?

[Qwertiy]

Сайтов с ироглифами 7 штук

Исправил регулярное выражение для выбра meta-тега с кодировкой:

Код: Выделить всё

  'EncMatch = Regex.Match(Content, "<meta\s+.*?charset\s*=\s*[""']?([-\w]+)", RegexOptions.IgnoreCase Or RegexOptions.Singleline)
  EncMatch = Regex.Match(Content, "<meta\s+[^>]*?charset\s*=\s*[""']?([-\w]+)", RegexOptions.IgnoreCase Or RegexOptions.Singleline)

Это поможет в 3 случаях.
Ещё 2 сайта просто не пересылают кодировку и используют при этом 1251.
Ещё 1 передаёт неверную кодировку в meta-теге.
Ну и оставшийся - там всё нормально должно быть, если используется раскодирование html-сущностей.

Исправленный код загрузки страницы с возможностью передать кодировку:

Код: Выделить всё

Public Function DownloadPageContent(ByVal Url As String, Optional ByVal PageEncoding As Encoding = Nothing) As String
  Dim Data() As Byte, EncStr As String, Content As String, EncMatch As Match

  Using WC As New WebClient
    Try
      Data = WC.DownloadData(Url)
      EncStr = WC.ResponseHeaders(HttpResponseHeader.ContentType)
    Catch ex As WebException
      If ex.Response Is Nothing Then Throw
      Using Response As WebResponse = ex.Response
        EncStr = Response.Headers(HttpResponseHeader.ContentType)
        Using Stream As Stream = Response.GetResponseStream()
          Using Reader As New BinaryReader(Stream)
            Data = Reader.ReadBytes(Stream.Length)
          End Using
        End Using
      End Using
    End Try
  End Using

  If PageEncoding IsNot Nothing Then Return PageEncoding.GetChars(Data)

  Content = RemoveHtmlComments(Encoding.ASCII.GetChars(Data))
  EncMatch = Regex.Match(Content, "<meta\s+[^>]*?charset\s*=\s*[""']?([-\w]+)", RegexOptions.IgnoreCase Or RegexOptions.Singleline)

  If EncMatch.Success Then
    EncStr = EncMatch.Groups(1).Value
  ElseIf EncStr IsNot Nothing Then
    EncMatch = Regex.Match(EncStr, "charset\s*=\s*([^,;\s]+)", RegexOptions.IgnoreCase)
    EncStr = If(EncMatch.Success, EncMatch.Groups(1).Value, Nothing)
  End If

  Return Encoding.GetEncoding(If(EncStr, "UTF-8")).GetChars(Data)
End Function

[Egor2014]

Спасибо, несколько URL стало отдавать анкор.
Выкладываю свой код, проверка не в цикле, лишь одного анкора по нескольким параметрам, все почти закоментировано, думаю будет всё понятно.
У меня реализовано не через функцию, поэтому WebUtility.HtmlDecode как использовать здесь не знаю((( Может быть поможете внедрить здесь.
Ранее WebUtility.HtmlDecode использовались при получении title страницы в функции.

Код: Выделить всё

Private Sub ToolStripButton2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles АнкорОдин.Click
        ' Находим анкор для одной активной ячейки DataGridView1
        Dim i, simvolleft As Integer
        Dim exlinks As New Regex("(<a)(.*?)(</a>)", RegexOptions.Singleline Or RegexOptions.IgnoreCase)
        Dim exankor As New System.Text.RegularExpressions.Regex("<(?:.*?)>\s*")
        Dim html, Ankor, CellStroka As String
        Dim m As MatchCollection
        ' В активной ячейке DataGridView1 находится URL, заносим в CellStroka
        CellStroka = DataGridView1.Item(0, DataGridView1.CurrentCell.RowIndex).Value
        Try
            html = DownloadPageContent(CellStroka)  ' В html весь код проверяемой страницы
        Catch ex As Exception
            DataGridView1.Item(1, DataGridView1.CurrentCell.RowIndex).Value = "Ошибка 404"
            DataGridView1.Item(1, DataGridView1.CurrentCell.RowIndex).Style.BackColor = Color.Red  ' Закрашиваем ячейку
            TextBox3.Text = "Ошибка 404"
            Exit Sub
        End Try
        ' Проверяем ссылку между <noindex> и </noindex>
        Dim Pozition As Integer = 1
        ' В simvolleft находятся символы от начала до ссылки
        simvolleft = InStr(Pozition, LCase(html), LCase(Trim(Label1.Text)))
        ' Провеяем количество noindex слева, тоесть чётно или нечётное количество
        If UBound(Split(Strings.Left(html, simvolleft), "noindex>")) Mod 2 = 0 Then
            ' Если noindex слева от ссылки чётное число, то ссылка открыта для индексации
        Else
            ' Если noindex слева от ссылки нечётное число, то ссылка наша закрыта
            DataGridView1.Item(2, DataGridView1.CurrentCell.RowIndex).Value = DataGridView1.Item(2, DataGridView1.CurrentCell.RowIndex).Value & "NoI" & " "
            DataGridView1.Item(2, DataGridView1.CurrentCell.RowIndex).Style.BackColor = Color.Red
        End If

        m = exlinks.Matches(html)
        Ankor = ""
        For i = 0 To m.Count - 1
            If InStr(m.Item(i).Value, Label1.Text) Then Ankor = Ankor + m.Item(i).Value ' В Ankor весь код ссылки
        Next

        ' Если в ссылке rel="nofollow"
        If InStr(Ankor, "nofollow") > 0 Then
            DataGridView1.Item(2, DataGridView1.CurrentCell.RowIndex).Value = DataGridView1.Item(2, DataGridView1.CurrentCell.RowIndex).Value & "F" & " "
            DataGridView1.Item(2, DataGridView1.CurrentCell.RowIndex).Style.BackColor = Color.Red
        End If

        ' Если в ссылке "javascript"
        If InStr(Ankor, "javascript") > 0 Then
            DataGridView1.Item(2, DataGridView1.CurrentCell.RowIndex).Value = DataGridView1.Item(2, DataGridView1.CurrentCell.RowIndex).Value & "J" & " "
            DataGridView1.Item(2, DataGridView1.CurrentCell.RowIndex).Style.BackColor = Color.Red
        End If

        ' Находим анкор
        If InStr(Ankor, "<img") > 0 Then                    ' Если вместо анкора стоит баннер
            DataGridView1.Item(1, DataGridView1.CurrentCell.RowIndex).Value = "Баннер"   ' Баннер вписываем в ячеёку 2 столбца DataGridView1
            DataGridView1.Item(1, DataGridView1.CurrentCell.RowIndex).Style.BackColor = Color.Aquamarine 'Ячейку DataGridView1 закрашиваем синим
        Else
            ' Чистим анкор от мусора: табуляция, пробелы, пропус строки. Анкор вставляем в таблицу
            DataGridView1.Item(1, DataGridView1.CurrentCell.RowIndex).Value = exankor.Replace(Ankor, "", RegexOptions.Singleline)
        End If
        ' Если страница открывается, но нет ссылки
        If Len(Ankor) = 0 Then DataGridView1.Item(1, DataGridView1.CurrentCell.RowIndex).Value = "Нет ссылки"
        Me.DataGridView1.Refresh()            ' Обновляем данные в DataGridView1       
        Me.Label3.Refresh()
    End Sub

[Qwertiy]

Выкладываю свой код

Кончай писать в стиле VB6...

поэтому WebUtility.HtmlDecode как использовать здесь не знаю(((

Ну где строки извлекаешь, там и используй.

Ранее WebUtility.HtmlDecode использовались при получении title страницы в функции.

Я в курсе. Я же его писал. И в этой теме он есть.

"Ошибка 404"

Это с какого перепуга? Там никак не 404.

[Egor2014]

Я уже WebUtility.HtmlDecode пытался вставить не получилось. В интернете только на MSDN написано и то примера нет. Помогите пожалуйста.
"Ошибка 404" знаю, что не верно, но здесь не принципиально, а средствами VB узнать код ошибки разве можно?

[Qwertiy]

а средствами VB узнать код ошибки разве можно?

Во-первых, да, если ловить то ли WebException, то ли HttpException. Во-вторых, весьма вероятно, что здесь вообще другого плана ошибка, поскольку единственный вид WebException'ов, пробрасываемых дальше из получения страницы не облалает ответом. Т. е. всякие 404, 403 и им подобные спокойно себе сжираются и дальше ты парсишь страницу с информацией об ошибке.

В интернете только на MSDN написано и то примера нет.

А чем мой код не пример??

Я уже WebUtility.HtmlDecode пытался вставить не получилось.

Вставлять надо в те места, где ты уже извлёк некоторую строку и пытаешься её проверять.
Если честно, я вообще не вижу работы с чем-то кроме тегов в твоём коде...