Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > VB6 > Еще про скачивание из интернета

Автор: Эд 20.6.2005, 11:24

Мне понадобилось сделать себе инструмент-"гляделку" в Нете, и я использовал способ скачивания, указанный вот здесь http://forum.vingrad.ru/index.php?showtopic=30379 Спасибо большое -Mikle- !

Дополнительный вопрос: какова функция "обновления страницы"? А то после первой скачки, последующие разы берутся из кэша, невзирая на изменившееся состояние сайта.

Как принудительно обновить кэш, используя VB?

Автор: Voldemar2004 4.7.2005, 18:35

Цитата

последующие разы берутся из кэша, невзирая на изменившееся состояние сайта.

Ну, по логике вещей, надо обновлять кэш, на то он и нужен - временная своп-память... smile

Автор: Voldemar2004 4.7.2005, 19:02

Короче если по-нормальному, то: проверяешь, отличается ли предыдущая страница от текущей, Если Да, То Стираешь Кэш, пишешь в него то, что тебе надо, Иначе Оставляешь Кэш в покое. В качестве сравнения можно взять 2 файла кэшей - предыдущую страничку и текущую, причем обе они находятся в одной папке - геммора меньше.

Короче все крутится возле операторов циклов: For Next, Do ...... Loop While и нижеследующего кода, который и сравнивает два файла по нескольким принципам: атрибутам, датам создания, датам изменения, по бинарным данным:

Модуль:

Код


Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long

Type FILETIME
  LowDateTime As Long
  HighDateTime As Long
End Type

Type SYSTEMTIME
  wYear As Integer
  wMonth As Integer
  wDayOfWeek As Integer
  wDay As Integer
  wHour As Integer
  wMinute As Integer
  wSecond As Integer
  wMilliseconds As Integer
End Type

Type WIN32_FIND_DATA
  dwFileAttributes As Long
  ftCreationTime As FILETIME
  ftLastAccessTime As FILETIME
  ftLastWriteTime As FILETIME
  nFileSizeHigh As Long
  nFileSizeLow As Long
  dwReserved0 As Long
  dwReserved1 As Long
  cFileName As String * 260
  cAlternate As String * 14
End Type

Public Function GetFileAttributes(sFileName As String) As WIN32_FIND_DATA
    Dim Win32Data As WIN32_FIND_DATA, hFile As Long, RetVal As Long

    hFile = FindFirstFile(sFileName, Win32Data)
    GetFileAttributes = Win32Data
    
    RetVal = FindClose(hFile)
End Function

Public Function CompareBin(sFileName1 As String, sFileName2 As String) As Boolean
    Dim strBlock1 As String, strBlock2 As String
    On Error GoTo ErLine
    Open sFileName1 For Binary As #1
    Open sFileName2 For Binary As #2
    
    If LOF(1) <> LOF(2) Then
    CompareBin = False
    Else
        
    strBlock1 = String$(10000, 0)
    strBlock2 = String$(10000, 0)
    
    Do While EOF(1) = False
    Get #1, , strBlock1
    Get #2, , strBlock2
    DoEvents
    
    If strBlock1 <> strBlock2 Then
        CompareBin = False
        Close #1
        Close #2
        Exit Function
    End If
    
    Loop
    
    CompareBin = True
    End If
    
    Close #1
    Close #2
    Exit Function
ErLine:
    Close #1
    Close #2
    MsgBox Err.Description, vbCritical, "Ошибка"
End Function

Форма, кнопка, 2 textbox'a и несколько Label'ов:

Код


Private Sub cmdCompare_Click()
    Dim Fd1 As WIN32_FIND_DATA, Fd2 As WIN32_FIND_DATA
    Dim Ft1 As SYSTEMTIME, Ft2 As SYSTEMTIME, dCreate1 As String, dCreate2 As String, dWrite1 As String, dWrite2 As String
    Dim RetVal As Long
    
    lblRes1.Caption = ""
    lblRes2.Caption = ""
    lblRes3.Caption = ""
    lblRes4.Caption = ""
    
    If CBool(PathFileExists(txtFile1.Text)) = False Then
    MsgBox "Указанный файл " & txtFile1.Text & " не существует!", vbCritical, "ошибка"
    Exit Sub
    End If
    
    If CBool(PathFileExists(txtFile2.Text)) = False Then
    MsgBox "Указанный файл " & txtFile2.Text & " не существует!", vbCritical, "ошибка"
    Exit Sub
    End If
    
    Fd1 = GetFileAttributes(txtFile1.Text)
    Fd2 = GetFileAttributes(txtFile2.Text)
    
    
    If Fd1.dwFileAttributes = Fd2.dwFileAttributes Then
    lblRes1.Caption = "одинаковые"
    Else
    lblRes1.Caption = "разные"
    End If
    
    RetVal = FileTimeToSystemTime(Fd1.ftCreationTime, Ft1)
    RetVal = FileTimeToSystemTime(Fd2.ftCreationTime, Ft2)
    
    dCreate1 = Ft1.wDay & "." & Ft1.wMonth & "." & Ft1.wYear
    dCreate2 = Ft2.wDay & "." & Ft2.wMonth & "." & Ft2.wYear
    
    If dCreate1 = dCreate2 Then
    lblRes2.Caption = "одинаковые"
    Else
    lblRes2.Caption = "разные"
    End If
    
    RetVal = FileTimeToSystemTime(Fd1.ftLastWriteTime, Ft1)
    RetVal = FileTimeToSystemTime(Fd2.ftLastWriteTime, Ft2)
    
    dWrite1 = Ft1.wDay & "." & Ft1.wMonth & "." & Ft1.wYear
    dWrite2 = Ft2.wDay & "." & Ft2.wMonth & "." & Ft2.wYear
    
    If dWrite1 = dWrite2 Then
    lblRes3.Caption = "одинаковые"
    Else
    lblRes3.Caption = "разные"
    End If
    
    If CompareBin(txtFile1.Text, txtFile2.Text) = True Then
    lblRes4.Caption = "одинаковые"
    Else
    lblRes4.Caption = "разные"
    End If
    
End Sub


Private Sub txtFile1_Change()
    If Len(txtFile1) < 4 Or Len(txtFile2) < 4 Then
    cmdCompare.Enabled = False
    Else
    cmdCompare.Enabled = True
    End If
End Sub

Private Sub txtFile2_Change()
    If Len(txtFile1) < 4 Or Len(txtFile2) < 4 Then
    cmdCompare.Enabled = False
    Else
    cmdCompare.Enabled = True
    End If
End Sub

Успехов!

Цитата

Мне понадобилось сделать себе инструмент-"гляделку" в Нете

Так ты делаешь свою версию Oper'ы ? Или ACDSee для инета?

Цитата

и я использовал способ скачивания

, ну, я думаю, немного осталось доделать.

Автор: Эд 7.7.2005, 16:36

Цитата(Voldemar2004)

Короче если по-нормальному, то: проверяешь, отличается ли предыдущая страница от текущей, Если Да, То...

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

Листинг хотя и громоздкий, но сам по себе полезный, - на тему "как сравнить атрибуты файлов в VB". Жаль что без единого комментария и не по теме вопроса.
Потому что вопрос-то - как запретить использование кэша во время скачки с интернета, а не алгоритм сравнения. Так что проблема осталась не проясненной!

Цитата(Voldemar2004)

Так ты делаешь свою версию Oper'ы ? Или ACDSee для инета?

До Оперного искусства мне далековато ;) просто приспособу для работы с одним форумом.

Кстати: как принять файл - это хотя бы в принципе ясно, а вот как отправить заполненную форму? - вот за это время возник такой вопрос. В браузере два метода есть: GET и POST. А как через VB их сделать?

Автор: bom 12.7.2005, 19:25

Привет! Как раз недавно озадачивался тем же вопросом. Не мудрствуя особо, остановился на более простом решении.
Как оказалось, файлы берутся из кеша, когда они там есть и когда в настройках IE выставлена опция "Проверять обновления сохраненных страниц: никогда".
Перед скачкой запоминаем сначала значение ключа
"HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings", "SyncMode5"(dword),
затем меняем его на "3", после успешной или неуспешной скачки - возвращаем прежнее значение ключу.

Автор: bom 12.7.2005, 19:45

Цитата

GET и POST. А как через VB их сделать?

На счет Post сам не знаю, а про Get в отрывке статьи Демина Антона:

Каждый элемент формы имеет свои свойства, двумя из которых являются имя и значение. Например у текстового поля может быть имя "e_mail_text", а значение "your@e-mail.ru". У CheckBox'а имя может быть "Check1", а значение "1" (в отличии от VB в HTML "галочка" может принимать значение не только "1", но и любоё другое, например "yes"). Также у всех объектов есть свой тип. Например, кнопка - button, текстовое поле - text, кнопка для отправки - submit, а кнопка для очистки полей - reset. Также существуют объекты типа hidden, которые не видны на странице, но также имеют имя и значение.
Так вот после того, как пользователь нажмёт на кнопку отправки, браузер генерирует адрес страницы, на которую потом переходит пользователь. Вначале строки идёт адрес до CGI скрипта с вопросительным знаком на конце, например:

http://www.someserver.ru/cgi-bin/cgi_script.cgi?

Затем идёт имя первого элемента формы, после чего ставиться "=" и пишется его значение, потом "&" и имя второго элемента и т.д. В случае с отправкой сообщения в службу поддержки строка будет иметь вид:

http://www.someserver.ru/cgi-bin/cgi_script.cgi?author=Some%20User&e-mail=user_email%40domen.ru&message=Some%20Message

Здесь "Some User" - имя автора, "user_mail@domen.ru" - обратный e-mail, а "Some Message" - сообщение. Из-за того, что в адресе не могут быть пробелы и другие специфические символы (к которым относятся и буквы русского алфавита), их заменяют на символ "%", после которого идёт номер ASCII символа в 16ти разрядном виде.

Для этого можно разобрать пример на самой простой программе, например для поиска на Яndex'е. Для этого создаёте новый проект и поместите на него текстовое поле с кнопкой.

Теперь напишем код для кнопки:

Код


Private Sub Command1_Click()
'Объявляем переменную для хранения сгенерированной строки
Dim SearchString As String
'Переменная для текущего символа
Dim Char As Byte
'Для цикла For
Dim I As Integer

'Путь до CGI файла и имя параметера - начальное
'значение переменной SearchString
SearchString = "http://www.yandex.ru/yandsearch?text="

'Перебираем все символы и, в зависимости от того, с каким
'символом работаем, добавляем его к строке поиска
For I = 1 To Len(Text1)
    Char = Asc(Mid(Text1, I, 1))
    If Char > 96 And Char < 123 Then
        SearchString = SearchString + Mid(Text1, I, 1)
    ElseIf Char > 64 And Char < 91 Then
        SearchString = SearchString + Mid(Text1, I, 1)
    ElseIf Char = 32 Then
        SearchString = SearchString + "+"
    Else
        SearchString = SearchString + "%" + Hex(Asc(Mid(Text1, I, 1)))
    End If
Next I

'Вызываем функцию ExecuteFile и передаём ей строку поиска.
ExecuteFile Me.hWnd, SearchString, 1
End Sub

Про Post смотри здесь: http://bbs.vbstreets.ru/viewtopic.php?t=7726

Автор: Plamenk 18.7.2005, 16:46

Добавляй в конце запроса "?". Например "mail.ru?"

Автор: Эд 18.7.2005, 18:06

bom, спасибо за разъяснения, и особенно за ссылочку на bbs.vbstreets. Толково описана.
Хотел попробовать загрузку как там сказано, но там требуется WinSock Control, а где взять этот контрол? Я так и не нашел. Так что ничего пока не получилось smile

Автор: cardinal 18.7.2005, 19:46

Заходишь в проект, нажимаешь Ctrl-T, в списке выбираешь Microsoft Winsock Control и готово...

Автор: bom 18.7.2005, 19:52

Посмотри в своей %System% директории MSWINSCK.OCX
Поставляется с VB, если почему то нет, то поиск на Яндексе поможет.

Автор: Эд 19.7.2005, 15:35

Всем спасибо, но весь список просмотрел - нету там его у меня почему-то (VB6.0) и файла такого на винте тоже, вообще нет smile

Так что, когда раздобуду - напишу, чё получилось.

Автор: bom 31.7.2005, 18:36

Способ без обращения к реестру. Чтоб заставить функцию URLDownloadToFile качать свежую версию файла, не зависимо от наличия того в кеше IE надо присвоить параметру dwReserved значение 1 при вызове: "dwReserved=1&".
Всего хорошего.

Автор: Гость_KEKC 15.9.2005, 21:35

Что бы страница качалась заново, надо передавать странице параметры.
Т. е. не опять скачивать файл "http://abc.lv/somepage.html", а, якобы, другой "http://abc.lv/somepage.html?abcdefg123".
Только, параметры должны быть каждый раз разные.
Когда, я делал чат на ВБ, я создавал рандомную переменную при старте проги int(rnd*1000000), а потом, каждый раз, при скачивании, увеличивал её на 1. Ещё я буквы разные добавлял, но можно и без них. smile