Dr.Zhivago
Программирование для Internet Explorer

Обсудить в форуме

    Ох уж эти иностранцы – любят за каждую мелочь деньги содрать. Это я о программе MHT Quick Saver. Не спорю, удобно – нажал на кнопку на панели и все содержимое страницы в одном файле. Но после прочтения этой статьи и вы сможете писать такие же утилиты (во всяком случае, я на это надеюсь).  В общем, тема нашего разговора – программирование для Internet Explorer… конечно же на VB!
    Итак, сначала добавим свою кнопку для вызова нашей программы на панель IE. Для этого добавим в реестр следующий раздел:

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\Extensions\{8DAE90AD-4583-4977-9DD4-4360F7A45C74}

    Хотя нет, на моем компьютере этот раздел уже забил для себя Download Master. Но номер можно изменить. Создаем в нем следующие строковые параметры:

"ButtonText"="Му programm" – надпись на кнопке программы
"Default Visible"="Yes" – сам не знаю что такое
"Icon"="C:\Program Files\My programm\Picture.ico" – иконка программы
"HotIcon"="C:\Program Files\My programm\Picture.ico" – иконка появляющаяся при наведении курсора на кнопку
"CLSID"="{1FBA04EE-3024-11d2-8F1F-0000F87ABD16}" - менять нельзя!
"Exec"="C:\Program Files\My programm\SuperProgramm.exe" - путь к программе
"MenuStatusBar"="Му programm" – надпись в строку статуса
"MenuText"="&Му programm" – пункт в разделе меню “Сервис”

    Небольшое отступление: обычно иконка, прописанная в параметре Icon, создается в градациях серого, а HotIcon – ее цветной вариант. Второй вариант (встречается в плагинах для MyIE): обе иконки почти идентичны, то есть имеют небольшие различия. Поэтому при наведении курсора происходит небольшая анимация. Да что я вам рассказываю – посмотрите на панель своего IE или MyIE.  А теперь пишем саму программу. Сначала нам нужно получить handle окна IE:

hWnd = GetForegroundWindow()
Он сейчас нам понадобится для того, чтобы получить интерфейс IHTMLDocument:
Set HTMLDoc = IEDOMFromhWnd(hWnd)
Процедура IEDOMFromhWnd приведена ниже (кстати, спасибо за помощь Comanch’у):
Public Function IEDOMFromhWnd(ByVal hWnd As Long) As IHTMLDocument
  Dim IID_IHTMLDocument As UUID
  Dim hWndChild As Long
  Dim lRes As Long
  Dim lMsg As Long
  Dim hr As Long

  If hWnd <> 0 Then
    If Not IsIEServerWindow(hWnd) Then
      EnumChildWindows hWnd, AddressOf EnumChildProc, hWnd
    End If
    If hWnd <> 0 Then
      lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
      SendMessageTimeout hWnd, lMsg, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes
      If lRes Then
        With IID_IHTMLDocument
          .Data1 = &H626FC520
          .Data2 = &HA41E
          .Data3 = &H11CF
          .Data4(0) = &HA7
          .Data4(1) = &H31
          .Data4(2) = &H0
          .Data4(3) = &HA0
          .Data4(4) = &HC9
          .Data4(5) = &H8
          .Data4(6) = &H26
          .Data4(7) = &H37
        End With
        hr = ObjectFromLresult(lRes, IID_IHTMLDocument, 0, IEDOMFromhWnd)
      End If
    End If
  End If
End Function

    И не забудьте поставить ссылку на библиотеку “Microsoft HTML Object Library”. Так же понадобятся следующие описания и процедуры:

Private Type UUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(0 To 7) As Byte
End Type

Private Const SMTO_ABORTIFHUNG = &H2

Private Declare Function ObjectFromLresult Lib "oleacc" ( _
   ByVal lResult As Long, _
   riid As UUID, _
   ByVal wParam As Long, _
   ppvObject As Any) As Long

Function EnumChildProc(ByVal hWnd As Long, lParam As Long) As Long
  If IsIEServerWindow(hWnd) Then
    lParam = hWnd
  Else
    EnumChildProc = 1
  End If
End Function

Private Function IsIEServerWindow(ByVal hWnd As Long) As Boolean
  Dim lRes As Long
  Dim sClassName As String
  sClassName = String$(100, 0)
  lRes = GetClassName(hWnd, sClassName, Len(sClassName))
  sClassName = Left$(sClassName, lRes)
  IsIEServerWindow = StrComp(sClassName, "Internet Explorer_Server", vbTextCompare) = 0
End Function

    Все, интерфейс получен! Теперь вы можете спокойно оперировать с методами и свойствами объекта HTMLDoc. Вы можете получить коллекции всех имеющихся в документе, открытом в окне IE, ссылок (свойство links), картинок (свойство images), стилей (свойство styleSheets) и многое другое. В общем, исследуйте объектную модель (а зачем вы думали на клавиатуре клавиша F2?)! А дальше используйте вашу фантазию. Например, предлагаю сохранить все картинки со страницы:

Dim i As HTMLImg
Dim sFileName As String

For Each i In HTMLDoc.images ' перебираем все картинки, ссылки на которые есть на странице
  If IsFileInCache(i.src) Then ' если файл есть в кэше то ...
    sFileName = ... ' придумываем ему имя
    ' и качаем его из кэша (dwReserved = 0&)
    If URLDownloadToFile(0&, i.src, sFileName, 0&, 0&) = ERROR_SUCCESS Then
      ' все прошло удачно и надо что-то сделать
    End If
  End If
Next
Понадобятся следующие описания и процедуры:
Private Type INTERNET_CACHE_ENTRY_INFO
  dwStructSize As Long
  lpszSourceUrlName As Long
  lpszLocalFileName As Long
  CacheEntryType As Long
  dwUseCount As Long
  dwHitRate As Long
  dwSizeLow As Long
  dwSizeHigh As Long
  LastModifiedTime As FILETIME
  ExpireTime As FILETIME
  LastAccessTime As FILETIME
  LastSyncTime As FILETIME
  lpHeaderInfo As Long
  dwHeaderInfoSize As Long
  lpszFileExtension As Long
  dwExemptDelta As Long
  szExtraMemory As String * 4016
End Type

Private Declare Function GetUrlCacheEntryInfo Lib "wininet.dll" _
  Alias "GetUrlCacheEntryInfoA" _
  (ByVal sUrlName As String, _
  lpCacheEntryInfo As Any, _
  lpdwCacheEntryInfoBufferSize As Long _
  ) As Long

Private Declare Function URLDownloadToFile Lib "urlmon.dll" _
  Alias "URLDownloadToFileA" _
 (ByVal pCaller As Long, _
  ByVal szURL As String, _
  ByVal szFileName As String, _
  ByVal dwReserved As Long, _
  ByVal lpfnCB As Long) As Long

Public Function IsFileInCache(ByVal lpszUrl As String) As Boolean
  Const ERROR_INSUFFICIENT_BUFFER = 122
  Dim Info As INTERNET_CACHE_ENTRY_INFO
  Dim dwEntrySize As Long
  IsFileInCache = False
  If GetUrlCacheEntryInfo(lpszUrl, Info, dwEntrySize) = 0 Then
    If Err.LastDllError = ERROR_INSUFFICIENT_BUFFER Then
      IsFileInCache = True
    End If
  End If
End Function

    Остальное допишите сами и вперед – грабить картинки. Если вам стало интересно, то могу продолжить тему программирования для IE ,например, рассказом о создании BHO. Только не спрашивайте что это такое, лучше спросите, как это пишется на VB.

Автор: Dr.Zhivago