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

Язык Visual Basic на платформе .NET.

Модераторы: Ramzes, Sebas

Egor2014
Новичок
Новичок
 
Сообщения: 25
Зарегистрирован: 25.10.2013 (Пт) 13:54
Откуда: Ижевск

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

Сообщение Egor2014 » 26.10.2013 (Сб) 13:36

Необходимо вывести анкор ссылки в конце задания - это не сложно.
Проблема в том что 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
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 26.10.2013 (Сб) 22:30

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

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

FireFenix
Продвинутый гуру
Продвинутый гуру
Аватара пользователя
 
Сообщения: 1640
Зарегистрирован: 25.05.2007 (Пт) 10:24
Откуда: Mugen no Sora

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

Сообщение FireFenix » 26.10.2013 (Сб) 23:39

Так же использовать в .NET VB6 функции извращение и кощунство!
Птицей Гермеса меня называют, свои крылья пожирая... сам себя я укрощаю
私はヘルメスの鳥 私は自らの羽根を喰らい 飼い慣らされる

Egor2014
Новичок
Новичок
 
Сообщения: 25
Зарегистрирован: 25.10.2013 (Пт) 13:54
Откуда: Ижевск

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

Сообщение Egor2014 » 27.10.2013 (Вс) 10:46

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

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

Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 27.10.2013 (Вс) 11:30

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

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

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

Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 27.10.2013 (Вс) 21:27

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

Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 27.10.2013 (Вс) 21:30

Я тебе уде показывал код с массивом байтов:
Код: Выделить всё
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
Новичок
Новичок
 
Сообщения: 25
Зарегистрирован: 25.10.2013 (Пт) 13:54
Откуда: Ижевск

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

Сообщение Egor2014 » 27.10.2013 (Вс) 23:15

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

Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 27.10.2013 (Вс) 23:45

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

Egor2014
Новичок
Новичок
 
Сообщения: 25
Зарегистрирован: 25.10.2013 (Пт) 13:54
Откуда: Ижевск

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

Сообщение Egor2014 » 28.10.2013 (Пн) 9:53

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

Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 28.10.2013 (Пн) 15:22

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

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

Egor2014 писал(а):Не могу воспользоваться DoIt в Form1

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

Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 28.10.2013 (Пн) 15:59

Некоторые косяки есть, но в целом вроде рабоатет:
Код: Выделить всё
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
Новичок
Новичок
 
Сообщения: 25
Зарегистрирован: 25.10.2013 (Пт) 13:54
Откуда: Ижевск

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

Сообщение Egor2014 » 28.10.2013 (Пн) 16:31

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

Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 28.10.2013 (Пн) 16:36

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

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

Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 28.10.2013 (Пн) 16:37

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

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

Egor2014
Новичок
Новичок
 
Сообщения: 25
Зарегистрирован: 25.10.2013 (Пт) 13:54
Откуда: Ижевск

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

Сообщение Egor2014 » 28.10.2013 (Пн) 16:38

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

Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 28.10.2013 (Пн) 20:43

Посмотрел ссылку из ЛС. Они намеренно отдают страницу с кодом 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
Новичок
Новичок
 
Сообщения: 25
Зарегистрирован: 25.10.2013 (Пт) 13:54
Откуда: Ижевск

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

Сообщение Egor2014 » 28.10.2013 (Пн) 21:11

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

Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

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

Сообщение Qwertiy » 28.10.2013 (Пн) 21:14

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

Код: Выделить всё
Imports System.IO

Egor2014
Новичок
Новичок
 
Сообщения: 25
Зарегистрирован: 25.10.2013 (Пт) 13:54
Откуда: Ижевск

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

Сообщение Egor2014 » 29.10.2013 (Вт) 9:34

Этот 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
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 29.10.2013 (Вт) 10:07

Egor2014 писал(а):Этот 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
Новичок
Новичок
 
Сообщения: 25
Зарегистрирован: 25.10.2013 (Пт) 13:54
Откуда: Ижевск

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

Сообщение Egor2014 » 29.10.2013 (Вт) 10:16

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

Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 29.10.2013 (Вт) 10:36

Что-то я перевмудрил с этой регуляркой. Можно проще:
Код: Выделить всё
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
Новичок
Новичок
 
Сообщения: 25
Зарегистрирован: 25.10.2013 (Пт) 13:54
Откуда: Ижевск

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

Сообщение Egor2014 » 30.10.2013 (Ср) 9:56

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

Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 30.10.2013 (Ср) 11:51

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

Egor2014
Новичок
Новичок
 
Сообщения: 25
Зарегистрирован: 25.10.2013 (Пт) 13:54
Откуда: Ижевск

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

Сообщение Egor2014 » 30.10.2013 (Ср) 15:59

В цикле анкоры вытаскиваю и вписываю их во 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
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 30.10.2013 (Ср) 16:17

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

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

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

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

Egor2014
Новичок
Новичок
 
Сообщения: 25
Зарегистрирован: 25.10.2013 (Пт) 13:54
Откуда: Ижевск

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

Сообщение Egor2014 » 30.10.2013 (Ср) 16:27

Qwertiy писал(а):Что падает, какая ошибка?

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

Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 30.10.2013 (Ср) 16:36

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

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

Egor2014
Новичок
Новичок
 
Сообщения: 25
Зарегистрирован: 25.10.2013 (Пт) 13:54
Откуда: Ижевск

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

Сообщение Egor2014 » 30.10.2013 (Ср) 16:51

iPos -1
lenStart 8

След.

Вернуться в Visual Basic .NET

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 10

    TopList