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

[Egor2014]

Необходимо вывести анкор ссылки в конце задания - это не сложно.
Проблема в том что WebClient приходится использовать 2 раза (т.к. не известна кодировка загружаемой страницы),
если UTF-8 тогда используем 2 раз WebClient
Если koi8 то как писать System.Text.Encoding... ?
Скажи пожалуйста можно ли так писать, если нет, помогите... народ считывает по заголовку...

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

  Dim SiteStr, LinkText, LinkAnkor As String
        Dim CellStroka As Integer
        Dim WebClient1 As New System.Net.WebClient
        Dim WebClient2 As New System.Net.WebClient  'Если страница UTF8
        SiteStr = WebClient1.DownloadString(TextBox1.Text)
        ' Проверка кодировки
        If InStr(1, LCase(SiteStr), "charset=utf-8") > 0 Then
            WebClient2.Encoding = System.Text.Encoding.UTF8 ' Если кодировка UTF8
            SiteStr = WebClient2.DownloadString(TextBox1.Text)
        ElseIf InStr(1, SiteStr, "windows-1251") > 0 Then   ' Если кодировка 1251
            SiteStr = WebClient2.DownloadString(TextBox1.Text)
        Else : TextBox2.Text = SiteStr
        End If
        ' Получаем текст между адресом моего сайта до тега </a>
        LinkText = GetPars(SiteStr, "http://SAIT-MOI.ru", "</a>")
        ' Получаем анкор от тега ">" до тега "</a>"
        LinkAnkor = Microsoft.VisualBasic.Strings.Mid(LinkText, InStr(LinkText, ">") + 1)
        CellStroka = DataGridView1.CurrentCell.RowIndex     ' Определяем строку в DataGridView1
        DataGridView1.Item(1, CellStroka).Value = LinkAnkor ' Вставляем анкор в DataGridView1

[Qwertiy]

Проблема в том что WebClient приходится использовать 2 раза (т.к. не известна кодировка загружаемой страницы)

Так какая разница? Сами данные же не меняются. Почему ты опять используешь DownloadString??
И вообще, так у тебя UTF-8 или KOI-8? Что-то не представляю, где это чудо (koi8) вообще используют сейчас...

[FireFenix]

Так же использовать в .NET VB6 функции извращение и кощунство!

[Egor2014]

И вообще, так у тебя UTF-8 или KOI-8? Что-то не представляю, где это чудо (koi8) вообще используют сейчас...

На русско-язычных сайтах используются в основном 3 кодировки: UTF8, 1251, koi8. А поскольку у меня сотни партнёров по обмену ссылками, то у них может быть на мой сайт ссылка со страницей, где кодировка может быть любая из этих основных трёх, поэтому при проверке ссылок нужно все кодировки учитывать. Программа должна быть универсальной и проверять любую новую ссылку, с учётом, что я не знаю заранее кодировку страницы. Но знаю адрес URL у партнёра ссылки на мой URL сайт . Если я косячу в коде, тогда помогите, пожалуйста, уважаемые гуру, (!с уважением, отношусь к любому опыту!).
Вообщем, нужно выписать все анкоры ссылок на меня с сотни страниц партнёров с известными URL вот такая задача.

[Qwertiy]

Надо получать байтовый массив и с ним уже разбираться. Правильнее было бы прям в массиве и искать, но если рассчитывать на одну из перечисленных кодировок (по крайней мере на отсутствие заведомо многобайтовых типа UTF-16 и UTF-32), то можно конвертировать в строку в однобайтовой кодировке ANSI (русский текст превратится в вопросы, но это не важно для поиска meta-тега). Так же обращаю внимание, что есть две формы записи мета-тега с кодировкой - стандартная и сокращённый html5-вариант. Кроме того, если кодировка не указана на самой странице, надо проверять наличие соответствующего http-заголовка.

После этого тот же массив надо сконвертировать в нужную кодировку, а не скачивать всё ещё раз.

Ну и действительно, лучше не использовать vb6-функции (а уж по полному пространству имён - тем более) и написание операторов в одну строку через двоеточие.

[Qwertiy]

В том и дело, у моего знакомого реализовано по этому принципу перевод в байты сделано на perl.
Но мне нужен на VB этот код. Почти неделя вылетела с программированием, чтоб освоить азы и т.д. основная работа простаивает.
Может Вы мне сделаете за оплату, только для удобства нужен скайп для связи, ок? Код на perl могу показать.

[Qwertiy]

Я тебе уде показывал код с массивом байтов:

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

Imports System.Text
Imports System.Text.RegularExpressions
Imports System.Linq
Imports System.Net

Module All

Sub DoIt(ByVal Url As String, ByVal Encoding As Encoding)
  Dim Page As String = Regex.Replace(Encoding.GetChars((New System.Net.WebClient()).DownloadData(Url)), "<!--.*?-->", "", RegexOptions.Singleline)
  Dim Title As String = WebUtility.HtmlDecode(Regex.Match(Page, "<title>\s*(.*?)\s*</title>", RegexOptions.IgnoreCase Or RegexOptions.Singleline).Groups(1).Value)
  Dim Links() As String = Regex.Matches(Page, "<a\s+.*?href\s*=\s*['""](.*?)['""]").OfType(Of Match).Select(Function(M As Match) WebUtility.HtmlDecode(M.Groups(1).Value)).ToArray()

  Console.WriteLine("{0}", Url)
  Console.WriteLine("{0}", Title)
  Console.WriteLine()
  Console.WriteLine(String.Join(vbCrLf, Links))
  Console.WriteLine()
End Sub

Sub Main()
  DoIt("http://www.cyberforum.ru/vb-net/thread984361-page2.html", Encoding.GetEncoding(1251))
  DoIt("http://bbs.vbstreets.ru/", Encoding.UTF8)
  Console.ReadKey()
End Sub

End Module

Вот это

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

(New System.Net.WebClient()).DownloadData(Url)

получение массива байтов. Дальше его надо обработать. Как вариант - через кодировку ANSI, если там заведомо не будет UTF-16 и UTF-32.

С чем конкретно проблемы? К http-заголовкам через WebClient доступ поже есть, остальное делается через регулярки.

[Egor2014]

Спасибо, отличный код в консольном приложении смог воспроизвести.
Попробовал, для определения кодировки, так написать в Dim Title As String........."charset\s*(.*?)\s*>"... результат виден, показывает кодировку!!!
Как сейчас это через кнопку вывести ?

[Qwertiy]

Метод Encoding.GetEncoding может принимать строку. Попробуй ему скормить вытащенную кодировку (только без мусора). А то по твоей регулярке там не только кодировка выбирается вроде. И да, так искать не совсем правильно. Правильно искать именно meta-тег. А ещё, его можно закрыть не только >, но и />.

[Egor2014]

Символы <meta могут присутствовать несколько раз в исходном коде страницы, наверно лучше начинать сразу с поиска charset, до >.
Не могу воспользоваться DoIt в Form1, по кнопке, чтоб вывести в TextBox1.Text = вместо вывода в консольном приложении, помогите пожалуйста, не знаю как это прописать?

[Qwertiy]

Символы <meta могут присутствовать несколько раз в исходном коде страницы, наверно лучше начинать сразу с поиска charset, до >.

Регулярки не дают гарантию, что найден именно тег. Да и вообще, по сути никаких гарантий нет для html'а. Так что надо искать как можно точнее.

Не могу воспользоваться DoIt в Form1

Не надо его использовать. Надо сделать нормальную функцию получения текста страницы.

[Qwertiy]

Некоторые косяки есть, но в целом вроде рабоатет:

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

Imports System.Text
Imports System.Text.RegularExpressions
Imports System.Net

Module Program

Private Function RemoveHtmlComments(Page As String) As String
  Return Regex.Replace(Page, "<!--.*?--!?>", " ", RegexOptions.IgnoreCase Or RegexOptions.Singleline)
End Function

Public Function DownloadPageContent(Url As String) As String
  Dim Data() As Byte, EncStr As String, Content As String, EncMatch As Match

  Using WC As New WebClient
    Data = WC.DownloadData(Url)
    EncStr = WC.ResponseHeaders(HttpResponseHeader.ContentType)
  End Using

  Content = RemoveHtmlComments(Encoding.ASCII.GetChars(Data))
  EncMatch = Regex.Match(Content, "<meta\s+.*?charset\s*=\s*[""']?([^""'\s\\]+?)[""']?\s*/?>", 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

  Try
    Return Encoding.GetEncoding(If(EncStr, "UTF-8")).GetChars(Data)
  Catch ex As ArgumentException
    Throw ' TODO: Process invalid encoding name somehow
  End Try
End Function

Private Function GetTitle(Page As String) As String
  Dim TitleMatch As Match = Regex.Match(Page, "<title>\s*(.*?)\s*</title>", RegexOptions.IgnoreCase Or RegexOptions.Singleline)
  Return If(TitleMatch.Success, WebUtility.HtmlDecode(TitleMatch.Groups(1).Value), Nothing)
End Function

Sub Main()
  Console.WriteLine(GetTitle(RemoveHtmlComments(DownloadPageContent("http://www.cyberforum.ru/vb-net/thread984361-page2.html"))))
  Console.WriteLine(GetTitle(RemoveHtmlComments(DownloadPageContent("http://bbs.vbstreets.ru/viewtopic.php?f=2&t=44733"))))
  Console.ReadKey()
End Sub

End Module

UPDATE: Возможно, Catch ловит больше чем должен, если данные невалидные... Не уверен.

[Egor2014]

Спасибо большое работает!!!
Правда есть URL не считывает (но в коде присутствует charset), думаю там админ химичит закрывает доступ, типа через .htaccess
поскольку при одной из проверок, другим способом писало в VB Net "доступ закрыт 404"

[Qwertiy]

Правда есть URL не считывает (но в коде присутствует charset), думаю там админ химичит закрывает доступ, типа через .htaccess

Бред какой-то... При чём тут вообще админ? Страница приходит или нет? Если нет, надо сравнивать запросы. Если да, но не парсится, то надо смотреть, что именно не парсится. Покажи теги с кодировкой.

[Qwertiy]

поскольку при одной из проверок, другим способом писало в VB Net "доступ закрыт 404"

Эээ.. 404 - это не найдено, а доступ закрыт - это 403.

[Egor2014]

<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />

[Qwertiy]

Посмотрел ссылку из ЛС. Они намеренно отдают страницу с кодом 404, браузеру тоже.

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

Public Function DownloadPageContent(Url As String) 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
      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

  Content = RemoveHtmlComments(Encoding.ASCII.GetChars(Data))
  EncMatch = Regex.Match(Content, "<meta\s+.*?charset\s*=\s*[""']?([^""'\s\\]+?)[""']?\s*/?>", 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]

пишет: Ошибка2 Тип "Stream" не определен.

[Qwertiy]

пишет: Ошибка2 Тип "Stream" не определен.

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

Imports System.IO

[Egor2014]

Этот URL тоже вредничает почему-то((( Выводит: <title>����...</title>
Хотя кодировка charset=windows-1251

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

TextBox2.Text = RemoveHtmlComments(DownloadPageContent("http://med-pochtoi.ru/podmor.html"))

Все разобрался, пишу так и работает:

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

Return Encoding.GetEncoding(If(EncStr, "windows-1251")).GetChars(Data)

[Qwertiy]

Этот URL тоже вредничает почему-то(((

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

TextBox2.Text = RemoveHtmlComments(DownloadPageContent("http://med-pochtoi.ru/podmor.html"))

Потому что там написано

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

<META content="text/html; charset=windows-1251" http-equiv=Content-Type>

а я такое не предусмотрел...

Исправь вот так:

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

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

и верни обратно UTF-8 для случаев когда кодировка не указана.

[Egor2014]

Большое спасибо, работает!!!

[Qwertiy]

Что-то я перевмудрил с этой регуляркой. Можно проще:

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

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

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

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

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

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

[Egor2014]

1. Спасибо за код выше Qwertiy
2. Переношу на другой комп ругается проект при открытии:
"Убедитесь, что установлено приложение для типа файлов ".vb""
Даже экспорт-импорт настроек не помогает, форма не открывается, странно, делаю вроде по правилам.
3. Анкоры уже достаю одиночно, нужно в цикле будет запустить. Как лучше сделать цикл по таймеру на 1 минуту (вдруг страница не открывается)?
4. Если анкор найден выписывает, если стоит баннер то выписывает "Баннер", бывает не то и не другое, тогда в DataGridView1 вписывать "Не найдено"? Есть несколько URL которые не считывает анкор(

[Qwertiy]

Egor2014, вообще ничего не понял из твоего последнего поста. Давай сначала подробно и понятно.

[Egor2014]

В цикле анкоры вытаскиваю и вписываю их во 2 столбец DataGridView1 (в 1 столбце ссылки).
Три варианта могут быть:
1. Стоит анкор (во 2 столбец DataGridView1 сам анкор)
2. Стоит баннер (во 2 столбец DataGridView1 слово "Баннер")
3. Если страница не читается (во 2 столбец DataGridView1 нужно вписать "Недоступно")
Сейчас 1-2 варианты работают, разбираю 3 вариант:
ругается на регулярное выражение, строка: iEnd = strSource.IndexOf(strEnd, iPos + lenStart)

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

    Public Function GetPars(ByRef strSource As String, ByRef strStart As String, ByRef strEnd As String, Optional ByRef startPos As Integer = 0) As String
        Dim iPos As Integer, iEnd As Integer, lenStart As Integer = strStart.Length
        Dim strResult As String
        strResult = String.Empty
        iPos = strSource.IndexOf(strStart, startPos)
        iEnd = strSource.IndexOf(strEnd, iPos + lenStart)
        If iPos <> -1 AndAlso iEnd <> -1 Then
            strResult = strSource.Substring(iPos + lenStart, iEnd - (iPos + lenStart))
        End If
        Return strResult
    End Function

[Qwertiy]

3. Если страница не читается (во 2 столбец DataGridView1 нужно вписать "Недоступно")

Что значит не читается?

ругается на регулярное выражение, строка: iEnd = strSource.IndexOf(strEnd, iPos + lenStart)

Тут регулярными выражениями даже не пахнет...
Что падает, какая ошибка?
И отучайся от венгерской нотации (кроме контролов) - это гадость.

[Egor2014]

Что падает, какая ошибка?

Индекс за пределами диапазона. Индекс должен быть положительным числом, а его размер не должен превышать размер коллекции.
Имя параметра: startIndex

[Qwertiy]

Индекс за пределами диапазона. Индекс должен быть положительным числом, а его размер не должен превышать размер коллекции.

Ну так и проверь что у тебя получается в iPos + lenStart.

[Egor2014]

iPos -1
lenStart 8