挑战超难题目：怎样用VB读取IE浏览器的内容？

Question

前提要求： 
1、必须是用IE打开网页，不能用VB控件或某些API打开网页。 
2、不能用ShellWindows对象读取，因为这个对象在普通用户登陆windows的情况下没法创建！

Answer 1

引用
Microsoft Internet Controls
Microsoft Html Object Library

Answer 2

Private Type UUID
      Data1   As Long
      Data2   As Integer
      Data3   As Integer
      Data4(0 To 7)       As Byte
End Type
  
Private Declare Function GetClassName Lib "user32" _
      Alias "GetClassNameA" ( _
      ByVal hwnd As Long, _
      ByVal lpClassName As String, _
      ByVal nMaxCount As Long) As Long
  
Private Declare Function EnumChildWindows Lib "user32" ( _
      ByVal hWndParent As Long, _
      ByVal lpEnumFunc As Long, _
      lParam As Long) As Long
  
Private Declare Function RegisterWindowMessage Lib "user32" _
      Alias "RegisterWindowMessageA" ( _
      ByVal lpString As String) As Long
  
Private Declare Function SendMessageTimeout Lib "user32" _
      Alias "SendMessageTimeoutA" ( _
      ByVal hwnd As Long, _
      ByVal msg As Long, _
      ByVal wParam As Long, _
      lParam As Any, _
      ByVal fuFlags As Long, _
      ByVal uTimeout As Long, _
      lpdwResult As Long) As Long
              
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
  
Private Declare Function FindWindow Lib "user32" _
      Alias "FindWindowA" ( _
      ByVal lpClassName As String, _
      ByVal lpWindowName As String) As LongFunction 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
                  '   Find   a   child   IE   server   window
                  EnumChildWindows hwnd, AddressOf EnumChildProc, hwnd
            End If
              
            If hwnd <> 0 Then
                  '   Register   the   message
                  lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
                  '   Get   the   object   pointer
                  Call SendMessageTimeout(hwnd, lMsg, 0, 0, _
                                  SMTO_ABORTIFHUNG, 1000, lRes)
                  If lRes Then
                        '   Initialize   the   interface   ID
                        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
                        '   Get   the   object   from   lRes
                        hr = ObjectFromLresult(lRes, IID_IHTMLDocument, _
                                          0, IEDOMFromhWnd)
                  End If
            End If
      End If
End FunctionPrivate Function IsIEServerWindow(ByVal hwnd As Long) As Boolean
Dim lRes     As Long
Dim sClassName     As String
  
      '   Initialize   the   buffer
      sClassName = String$(100, 0)
      '   Get   the   window   class   name
      lRes = GetClassName(hwnd, sClassName, Len(sClassName))
      sClassName = Left$(sClassName, lRes)
      IsIEServerWindow = StrComp(sClassName, _
                                            "Internet   Explorer_Server", _
                                            vbTextCompare) = 0
End Function
  
'
'   Copy   this   function   to   a   .bas   module
'
Function EnumChildProc(ByVal hwnd As Long, lParam As Long) As Long
      If IsIEServerWindow(hwnd) Then
            lParam = hwnd
      Else
            EnumChildProc = 1
      End If
End Function

Answer 3

取IE取柄
取webbrowser句柄
得到网页的document对象剩下来就很简单了.

Answer 4

set ie = createobject("internetexplorer.application")参见:http://gothere.512j.com/work/index.php?id=75