Модераторы: Akina
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Получить исходный текст HTML-страницы, средствами VBS 
V
    Опции темы
mihanik
Дата 30.11.2009, 23:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


-=Белый Медведь=-
****


Профиль
Группа: Комодератор
Сообщений: 4054
Регистрация: 24.4.2006
Где: г. Тверь

Репутация: 11
Всего: 109



Есть в Интернете адрес



Когда по этому адресу заходишь, то открывается какая-то страница по умолчанию...

Как мне средствами VBS "посмотреть" её исходный текст.
Типа того, как можно в браузерах просмотреть "исходный код страницы".
Мне достаточно получить обычный текст.

Зачем мне это?
Там в заголовке содержится имя нужного мне файла...
Цитата

<head>
    <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
    <LINK REL="SHORTCUT ICON" HREF="http://kaspersky.ru/favicon.ico">
    <META NAME="ROBOTS" content="ALL">
    <meta name="keywords" content="Kaspersky, Virus Removal Tool, AVPTool, anti-virus, antivirus, AVZ" />
    <meta name="description" content="Kaspersky Virus Removal Tool Download" />
    <title>Kaspersky Virus Removal Tool Download</title>
    <link rel='stylesheet' type='text/css' href='http://avptool.virusinfo.info/banner/promo_2009_css.css' />

    <META HTTP-EQUIV="pragma" Content="no-cache"/>
    <meta http-equiv="refresh" content="2;url=setup_9.0.0.722_30.11.2009_21-28.exe"/>
</head>



Нужно автоматизировать скачивание утилиты "Kaspersky Virus Removal Tool 2010".
А имя файла для скачивания каждый день изменяется...

 smile 




--------------------
Программистами не рождаются, - это родовая травма...
user posted imageuser posted image
PM MAIL WWW ICQ   Вверх
diadiavova
Дата 1.12.2009, 00:15 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Доктор Зло(диагност, настоящий, с лицензией и полномочиями)
****


Профиль
Группа: Модератор
Сообщений: 5820
Регистрация: 14.8.2008
Где: В Коньфпольте

Репутация: нет
Всего: 142



Если речь о программном доступе к странице на сервере, то вот
http://ru.wikipedia.org/wiki/XMLHttpRequest



--------------------
Хочешь получить мудрый совет - читай подписи участников форумов.
Злой доктор Щасзаболит smile
PM   Вверх
mihanik
Дата 1.12.2009, 00:30 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


-=Белый Медведь=-
****


Профиль
Группа: Комодератор
Сообщений: 4054
Регистрация: 24.4.2006
Где: г. Тверь

Репутация: 11
Всего: 109



Решил так...

Код

Function GetFileName ()

Dim objHTTP, strHTML, intStart, intEnd

    Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )

    objHTTP.Open "GET", "http://devbuilds.kaspersky-labs.com/devbuilds/AVPTool/", False
    objHTTP.Send

    If objHTTP.Status = 200 Then
        strHTML = objHTTP.ResponseText
    Else 
     strHTML = ""
    End If

    Set objHTTP = Nothing

'    MsgBox strHTML
    
    intStart =  InStr(strHTML, "url=setup_") + 4
    intEnd = InStr(strHTML, ".exe""/>") + 4
    
    GetFileName = "http://devbuilds.kaspersky-labs.com/devbuilds/AVPTool/" & Mid (strHTML, intStart, intEnd - intStart )
    
End Function


Добавлено @ 00:39
Полностью решение такое...
Код

Option Explicit
On Error Resume Next

Const FOR_APPENDING = 8
Const DeleteReadOnly = True

Dim strLogFileName
Dim strHTTPFileName
Dim strFileName
Dim strScriptFolder
Dim objFSO
Dim intCount
Dim intGetResult

    strHTTPFileName = GetFileName
    strFileName = "Virus Removal Tool.exe"
    strLogFileName = "Virus Removal Tool.log"
    
    strScriptFolder = WScript.ScriptFullName
    strScriptFolder = Mid (strScriptFolder, 1, InStrRev(strScriptFolder, "\"))
    
    strLogFileName = strScriptFolder + strLogFileName
    strFileName = strScriptFolder + strFileName
    
    StrToLog strLogFileName, "Начало работы: " & CStr(Now)
    
    ' Проверим "наличие Интернета" :-)
    If Not Ping ("www.ya.ru") Then 
            StrToLog strLogFileName, "Интернета нет!!!"
            StrToLog strLogFileName, "Конец работы: " & CStr(Now) & vbCrLf
            WScript.Quit
        Else
            StrToLog strLogFileName, "www.ya.ru доступен..."
    End If
    
    ' Пишем лог в сличае ошибки
    If Err.Number <> 0 Then
        StrToLog strLogFileName, Err.Number & " - " & Err.Description
        Err.Clear
    End If
    
    ' Удаляем ненужный больше старый файл
        StrToLog strLogFileName, "Удаляем ненужный больше старый файл"
        Set objFSO = CreateObject("Scripting.FileSystemObject")
            objFSO.DeleteFile strFileName, DeleteReadOnly
        Set objFSO = Nothing
        
        ' Пишем лог в сличае ошибки
        If Err.Number <> 0 Then
            StrToLog strLogFileName, Err.Number & " - " & Err.Description
            Err.Clear
        End If
    
    ' Закачиваем нужный нам файл...
    ' В случае неудач при скачивании, сдаёмся только после 5-й попытки
    StrToLog strLogFileName, "Закачиваем нужный нам файл"
    intCount = 0
    Do
        intCount = intCount + 1
        intGetResult = HTTPFileGet (strHTTPFileName, strFileName)
        
            ' Пишем лог в сличае ошибки
            If Err.Number <> 0 Then
                StrToLog strLogFileName, Err.Number & " - " & Err.Description
                Err.Clear
            End If
        
        WScript.Sleep 1000
        
    Loop Until (intGetResult = 0) Or (intCount = 5)
    
    ' Пишем лог в сличае ошибки
    If Err.Number <> 0 Then
        StrToLog strLogFileName, Err.Number & " - " & Err.Description
        Err.Clear
    End If
    
    StrToLog strLogFileName, "Конец работы: " & CStr(Now) & vbCrLf
    ' Выходим из программы...
    
WScript.Quit

Function HTTPFileGet(strFileURL, strFileSave)
   Dim objXMLHTTP, objADOStream, objFSO
   
   HTTPFileGet = 1

   Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
   Set objADOStream = CreateObject("ADODB.Stream")
   Set objFSO = Createobject("Scripting.FileSystemObject")

   objXMLHTTP.Open "GET", strFileURL, False
   objXMLHTTP.Send()

   If objXMLHTTP.Status = 200 Then
      objADOStream.Open
      objADOStream.Type = 1

      objADOStream.Write objXMLHTTP.ResponseBody
      objADOStream.Position = 0

      If objFSO.FileExists(strFileSave) Then objFSO.DeleteFile strFileSave

      objADOStream.SaveToFile strFileSave
      objADOStream.Close

      HTTPFileGet = 0
   End If
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'#
'# Процедура StrToLog()
'# Описание: Записывает строку в лог файл
'# Вход : 
'# Выход : 
'#
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub StrToLog (ByVal strLogFileName, ByVal strS)

    Dim objFS, objTS
    
            Set objFS = CreateObject("Scripting.FileSystemObject")
            Set objTS = objFS.OpenTextFile(strLogFileName,FOR_APPENDING, True)
                objTS.Write strS & VbCrLf
            Set objTS = Nothing
        Set objFS = Nothing
        
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'#
'# Функция Ping()
'# Описание: Пингует один/несколько хостов в Интернете
'# Вход : 
'# Выход : 
'#
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Ping (ByVal strMachines)

Dim intResponseTime
Dim intResult
Dim aMachines
Dim machine
Dim objPing
Dim objStatus

' Параметры конфигурации
intResponseTime = 50    ' Максимально допустимое время отклика    
intResult = 0 ' Результат доступности/недоступности серверов

' Начало скрипта
aMachines = split(strMachines, ";")

For Each machine in aMachines
    Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}")._
        ExecQuery("select * from Win32_PingStatus where address = '"_
            & machine & "'")
    For Each objStatus in objPing
        If IsNull(objStatus.StatusCode) or objStatus.StatusCode<>0 Then 
            ' Код обработки ситуации, когда ресурс недоступен
            intResult = intResult + 1
        Else       
             
        End If
    Next
    Set objPing = Nothing
Next

If intResult = 0 Then Ping = True Else Ping = False

End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'#
'# Функция GetFileName()
'# Описание: Узнаём актуальное имя файла Virus Removal Tool для скачивания 
'# Вход : 
'# Выход : 
'#
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetFileName ()

Dim objHTTP, strHTML, intStart, intEnd

    Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )

    objHTTP.Open "GET", "http://devbuilds.kaspersky-labs.com/devbuilds/AVPTool/", False
    objHTTP.Send

    If objHTTP.Status = 200 Then
        strHTML = objHTTP.ResponseText
    Else 
     strHTML = ""
    End If

    Set objHTTP = Nothing

    If strHTML = "" Then 
        GetFileName = ""
        Exit Function
    End If

    intStart =  InStr(strHTML, "url=setup_") + 4
    intEnd = InStr(strHTML, ".exe""/>") + 4
    
    GetFileName = "http://devbuilds.kaspersky-labs.com/devbuilds/AVPTool/" & Mid (strHTML, intStart, intEnd - intStart )
    
End Function


Это сообщение отредактировал(а) mihanik - 1.12.2009, 00:39


--------------------
Программистами не рождаются, - это родовая травма...
user posted imageuser posted image
PM MAIL WWW ICQ   Вверх
tarapulka
Дата 2.12.2009, 22:37 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 2
Регистрация: 2.12.2009
Где: Псков

Репутация: нет
Всего: нет



Что то не работает код, либо я что то не так делаю!
PM MAIL WWW   Вверх
mihanik
Дата 2.12.2009, 22:48 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


-=Белый Медведь=-
****


Профиль
Группа: Комодератор
Сообщений: 4054
Регистрация: 24.4.2006
Где: г. Тверь

Репутация: 11
Всего: 109



Цитата(tarapulka @  2.12.2009,  22:37 Найти цитируемый пост)
Что то не работает код, либо я что то не так делаю! 


А у меня работает...  smile 

Во-первых, у тебя какой антивирусник на компе?
Если Каксперский, то он мой скрипт воспринимает как вирус.
Пока нужно добавлять его в список исключений.
Кстати!!!
СЕгодня утром написал по этому поводу в лабораторию касперского.
Сказали, что это ложное срабатывание и скоро всё исправят.
Жду...
Пока не исправили.
Может и другой какой антивирусник на мой скрипт косо смотрит.
NOD32, кстати, воспринимает его очень даже хорошо и не ругается.




--------------------
Программистами не рождаются, - это родовая травма...
user posted imageuser posted image
PM MAIL WWW ICQ   Вверх
mihanik
Дата 7.12.2009, 23:48 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


-=Белый Медведь=-
****


Профиль
Группа: Комодератор
Сообщений: 4054
Регистрация: 24.4.2006
Где: г. Тверь

Репутация: 11
Всего: 109



Цитата(tarapulka @  2.12.2009,  22:37 Найти цитируемый пост)
Что то не работает код, либо я что то не так делаю! 


Можно ещё так:

Код

Set oHTTP =   CreateObject("MSXML2.XMLHTTP")
Set oRS = CreateObject("ADODB.Recordset")
oHTTP.Open "GET","http://www.yandex.ru",False
oHTTP.Send
oRS.Fields.Append "ru",200,100000
oRS.Open
oRS.AddNew
oRS(0).AppendChunk oHTTP.ResponseBody
WScript.Echo oRS(0) 'Ýòî è åñòü html
Set oRS = Nothing
Set oHTTP = Nothing 



--------------------
Программистами не рождаются, - это родовая травма...
user posted imageuser posted image
PM MAIL WWW ICQ   Вверх
mihanik
Дата 8.12.2009, 21:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


-=Белый Медведь=-
****


Профиль
Группа: Комодератор
Сообщений: 4054
Регистрация: 24.4.2006
Где: г. Тверь

Репутация: 11
Всего: 109



Или даже так

Код

wscript.echo GetHTMLText ("http://www.yandex.ru/")


Function GetHTMLText ( byval strURL )

    Set MyBrowser =   CreateObject("MSXML2.XMLHTTP")
        MyBrowser.Open "GET", strURL, False
        MyBrowser.send
        If MyBrowser.status = 200 Then GetHTMLText = MyBrowser.responseText
    Set MyBrowser = Nothing 

End Function




--------------------
Программистами не рождаются, - это родовая травма...
user posted imageuser posted image
PM MAIL WWW ICQ   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "VB6"
Akina

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по VB обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • Используйте теги [code=vb][/code] для подсветки кода. Используйтe чекбокс "транслит" (возле кнопок кодов) если у Вас нет русских шрифтов.


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Akina.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | VB6 | Следующая тема »


 




[ Время генерации скрипта: 0.1371 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.