VB 获取 Internet Explorer_Server 里面的内容

  1  Option  Explicit
  2  '
  3  '  要求：使用本模块时需要在工程中引用 Microsoft HTML Object Library。
  4  '
  5  Private Type GUID
  6     Data1  As  Long
  7     Data2  As  Integer
  8     Data3  As  Integer
  9     Data4( 0  To  7)  As  Byte
 10  End Type
 11  Private Declare  Function GetClassName Lib  " user32 " _
 12         Alias  " GetClassNameA " ( _
 13         ByVal hWND  As  Long, _
 14         ByVal lpClassName  As  String, _
 15         ByVal nMaxCount  As  Long)  As  Long
 16  Private Declare  Function EnumChildWindows Lib  " user32 " ( _
 17         ByVal hWndParent  As  Long, _
 18         ByVal lpEnumFunc  As  Long, _
 19         lParam  As  Long)  As  Long
 20  Private Declare  Function RegisterWindowMessage Lib  " user32 " _
 21         Alias  " RegisterWindowMessageA " ( _
 22         ByVal lpString  As  String)  As  Long
 23  Private Declare  Function SendMessageTimeout Lib  " user32 " _
 24         Alias  " SendMessageTimeoutA " ( _
 25         ByVal hWND  As  Long, _
 26         ByVal msg  As  Long, _
 27         ByVal wParam  As  Long, _
 28         lParam  As Any, _
 29         ByVal fuFlags  As  Long, _
 30         ByVal uTimeout  As  Long, _
 31         lpdwResult  As  Long)  As  Long
 32  Private  Const SMTO_ABORTIFHUNG = &H2
 33  Private Declare  Function ObjectFromLresult Lib  " oleacc " ( _
 34         ByVal lResult  As  Long, _
 35         riid  As GUID, _
 36         ByVal wParam  As  Long, _
 37         ppvObject  As Any)  As  Long
 38  Private Declare  Function FindWindow Lib  " user32 " _
 39         Alias  " FindWindowA " ( _
 40         ByVal lpClassName  As  String, _
 41         ByVal lpWindowName  As  String)  As  Long
 42  '
 43  '  函数：IEDOMFromhWnd。
 44  '
 45  '  返回：一个 WebBrowser 窗口的 IHTMLDocument 对象接口。
 46  '
 47  '  hWnd 参数：WebBrowser 控件的句柄或 WebBrowser 控件所在窗口的句柄。
 48  '
 49  Function IEDOMFromhWnd(ByVal hWND  As  Long)  As IHTMLDocument
 50      Dim IID_IHTMLDocument  As GUID
 51      Dim hWndChild  As  Long
 52      Dim lRes  As  Long
 53      Dim lMsg  As  Long
 54      Dim hr  As  Long
 55      If hWND <>  0  Then
 56          If  Not IsIEServerWindow(hWND)  Then
 57              '  查找一个 WebBrowser 控件。
 58              EnumChildWindows hWND, AddressOf EnumChildProc, hWND
 59          End  If
 60          If hWND <>  0  Then
 61              '  注册消息。
 62              lMsg = RegisterWindowMessage( " WM_HTML_GETOBJECT ")
 63              '  获取对象的指针。
 64               Call SendMessageTimeout(hWND, lMsg,  0,  0, _
 65                     SMTO_ABORTIFHUNG,  1000, lRes)
 66              If lRes  Then
 67                  '  初始化接口 ID。
 68                   With IID_IHTMLDocument
 69                     .Data1 = &H626FC520
 70                     .Data2 = &HA41E
 71                     .Data3 = &H11CF
 72                     .Data4( 0) = &HA7
 73                     .Data4( 1) = &H31
 74                     .Data4( 2) = &H0
 75                     .Data4( 3) = &HA0
 76                     .Data4( 4) = &HC9
 77                     .Data4( 5) = &H8
 78                     .Data4( 6) = &H26
 79                     .Data4( 7) = &H37
 80                  End  With
 81                  '  利用指针 lRes 获取 IHTMLDocument 对象。
 82                  hr = ObjectFromLresult(lRes, IID_IHTMLDocument, _
 83                          0, IEDOMFromhWnd)
 84              End  If
 85          End  If
 86      End  If
 87  End Function
 88  Private  Function IsIEServerWindow(ByVal hWND  As  Long)  As  Boolean
 89      Dim lRes  As  Long
 90      Dim sClassName  As  String
 91      '  初始化缓冲区大小。
 92      sClassName =  String$( 255,  0)
 93      '  获取 hWnd 句柄拥有者的类名称。
 94      lRes = GetClassName(hWND, sClassName,  Len(sClassName))
 95     sClassName =  Left$(sClassName, lRes)
 96     IsIEServerWindow =  StrComp(sClassName, _
 97              " Internet Explorer_Server ", _
 98             vbTextCompare) =  0
 99  End Function
100  Function EnumChildProc(ByVal hWND  As  Long, lParam  As  Long)  As  Long
101      If IsIEServerWindow(hWND)  Then
102         lParam = hWND
103      Else
104         EnumChildProc =  1
105      End  If
106  End Function
107 
108  ' 以下早得到微软UC的聊天记录
109 
110  Option  Explicit
111  Private  Sub Command1_Click()
112      Dim hWND  As  Long
113      Dim s  As  String *  255
114      Dim l  As  Long
115     hWND = FindWindow( " IMWindowClass ", vbNullString)
116     GETTEXT hWND
117  End Sub
118  Private  Sub GETTEXT(hWND  As  Long)
119      ' 创建一个 IHTMLDocument 对象。
120       Dim objIES  As  New HTMLDocument
121      Set objIES = IEDOMFromhWnd(hWND)  ' hWnd 这个东西你肯定有 N 种办法得到。
122       ' 应用。
123       ' 例如下面是获得一个 WebBrowser 控件当前浏览网页的地址和该网页的 HTML 源码。
124      Text1.Text = objIES.url & vbCrLf & vbCrLf & objIES.documentElement.innerHTML
125  End Sub