1. 用SPY++取得窗口类名或窗口标题，用FindWindow取得窗口句柄
2. 用SPY++取得各级子窗口类名，用EnumChildWindow枚举各级窗口直到得到类名为Internet Explorer_Server的子窗口的句柄
3. 利用消息WM_HTML_GETOBJECT得到HtmlDocument对象

 

Option Explicit

'Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function SetActiveWindow Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

 

 

Public Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As Long, ByVal dwUser As Long, ByVal uFlags As Long) As Long

Public Declare Function timeKillEvent Lib "winmm.dll" (ByVal uID As Long) As Long

 

'

' 要求：使用本模块时需要在工程中引用 Microsoft HTML Object Library。

'

 

Private Type GUID

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 GUID, _

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 Long

 

 

Private IframeIE() As SHDocVw.WebBrowser

 

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'传入类名为Internet Explorer_Server的WebBrowser控件的句柄，取得其IHTMLDocument对象接口

Function getIHTMLDocFromIEShWND(ByVal hWnd As Long) As IHTMLDocument

Dim IID_IHTMLDocument As GUID

Dim lRes As Long

Dim lMsg As Long

Dim hr As Long

 

If hWnd <> 0 Then

' 注册消息。

lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")

' 获取对象的指针。

Call SendMessageTimeout(hWnd, lMsg, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes)

If lRes Then

' 初始化接口 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

' 利用指针 lRes 获取 IHTMLDocument 对象。

hr = ObjectFromLresult(lRes, IID_IHTMLDocument, 0, getIHTMLDocFromIEShWND)

End If

End If

 

End Function

 

''''''''''''''''''''''''''''''''''''''''''''''''''

'由父窗口句柄枚举得到类名为Internet Explorer_Server的控件的句柄

Function getIEShWND(ByVal hWnd As Long) As Long

getIEShWND = hWnd

If hWnd <> 0 Then

If Not IsIEServerWindow(hWnd) Then

' 查找一个 WebBrowser 控件。

EnumChildWindows hWnd, AddressOf EnumChildProc, getIEShWND

End If

End If

End Function

 

Private Function IsIEServerWindow(ByVal hWnd As Long) As Boolean

Dim lRes As Long

Dim sClassName As String

' 初始化缓冲区大小。

sClassName = String$(255, 0)

' 获取 hWnd 句柄拥有者的类名称。

lRes = GetClassName(hWnd, sClassName, Len(sClassName))

sClassName = Left$(sClassName, lRes)

IsIEServerWindow = StrComp(sClassName, "Internet Explorer_Server", vbTextCompare) = 0

End Function

 

Function EnumChildProc(ByVal hWnd As Long, lParam As Long) As Long

If IsIEServerWindow(hWnd) Then

lParam = hWnd

Else

EnumChildProc = 1

End If

End Function

 

'''''''''''''''''''''''''''''''''''''''''''''''

'根据类名获得顶层窗口的句柄

Function gethWNDbyClassname(Optional className As String = "Internet Explorer_TridentDlgFrame") As Long

gethWNDbyClassname = FindWindow(className, vbNullString)

End Function

 

 

 

'''''''''''''''''''''''''''''''''''''''''''''''''''''

'以下代码通过HWnd取得HTML文档，并保存于文件中

Sub test()

Dim iesDoc As IHTMLDocument3

Dim hWnd As Long

 

hWnd = gethWNDbyClassname()

hWnd = getIEShWND(hWnd)

Set iesDoc = getIHTMLDocFromIEShWND(hWnd)

Open "E:\Users\st\Desktop\A000000.txt" For Output As #1

Write #1, iesDoc.URL & vbCrLf & vbCrLf & iesDoc.DocumentElement.innerHTML & vbCrLf & vbCrLf

 

Call EnumFrames(iesDoc)

Set iesDoc = IframeIE(0).document

Write #1, iesDoc.DocumentElement.innerHTML

 

 

'iesDoc.getElementsByName("qyjcxx.dacfd")(0).Value = "jhksfljhgslhglshg"

 

 

 

Close #1

 

 

End Sub

 

 

 

'问题:

' 当 Document 对象中包含多个 frames 的时候,直接通过 IHTMLDocument2.frames 或者 IHTMLFrameBase 或者

'IHTMLWindow2 都不能访问不同不同域名下 frame 对象. 这个看起来是乎可以防止恶意的网站行为.但对我们测试也带来麻烦.

'

' 解决问题的方法其实很简单 , 如下:

'

' (这个方法来源于国外的一个开发者论坛,解答者只是给出了微软关于获得HTML文档框架的连接 (见附录),没有其他的说

'明,我找不到那个地址了,不好意思.)

'

' 我们知道通过 IHTMLDcoument2 对象可以得到 IContainer 对象, 而 IContainer 对象包含当前 HTMLDocument2 对

'象中所有子对象的 IWebBrowser2 对象,访问 IWebBrowser2 对象中 IHTMLDocument2 对象就是我们需要的 frame 对象包

'含的 IHTMLDocument2 对象. 那么对于每个子 IWebBrowser2 对象如何判断它属于哪个 frame 呢? 只需要比较 IHTMLFrameBase

'和子 IWebBrowser2 对象的 IUnknown 指针地址是否相等就可以了.

'

' 上面的叙述有些复杂,可用 C# 描述获得第一个子 IHTMLDocument2 对象,如下:

'

' 输入参数为当前 Document, 和 Document 中所有的 frame 的 IHTMLFrameBase2 对象.

 

 

 

 

 

'下面代码的核心是修改自MVP Edanmo的大作

'枚举框架，参数WB是一个webbrowser控件的名称，其中承载着我们要分析的页面

Sub EnumFrames(ByVal hd As IHTMLDocument2)

Dim j As Integer

Dim pContainer As olelib.IOleContainer

Dim pEnumerator As olelib.IEnumUnknown

Dim pUnk As olelib.IUnknown

'获得页面的Document接口，然后我们就可以对其为所欲为了

Set pContainer = hd

'很奇怪，有时候上面这段对象赋值出错，用下面这句就没有问题了

'Set pContainer = WB.Document

If pContainer.EnumObjects(OLECONTF_EMBEDDINGS, pEnumerator) = 0 Then

Set pContainer = Nothing

Do While pEnumerator.Next(1, pUnk) = 0

On Error Resume Next

If Err.Number = 0 Then

'将框架页面依次赋值到IframeIE数组中

ReDim Preserve IframeIE(0 To j)

Set IframeIE(j) = pUnk

j = j + 1

End If

Loop

Set pEnumerator = Nothing

End If

End Sub

 

附：另一种方法是经过iserviceprovider接口的queryservice查询由Ihtmldocument2得到iwebbrowser2对象。

 

 

 

''''''''''''''''''"""""""""""""""""""""""""""""

消灭对话框的问题

1. 据说在页面加载完成时，加载一段代码，可以消灭对话框于无形（未试用）
2. 获得对话框窗口句柄和其上的控件按钮句柄，对其发送消息，

   缺点，要求窗口具有焦点，故电脑不能作他用；在IE自动化代码中难以准确定位查找对话框的地方，故代码难以产生效果，结果不得不动用计时器不断查找对话框才马虎解决

'根据窗口名取得对话框，打寻子窗口，发送消息

Function clickDialog(Optional Title As String = "来自网页的消息", Optional btnValue As String = "确定") As Boolean

Const WM_LBUTTONDOWN = &H201

Const WM_LBUTTONUP = &H202

Const BM_CLICK = &HF5

Dim msghWnd As Long, hWnd As Long

 

clickDialog = False

hWnd = FindWindow(vbNullString, Title) '以标题查找对话框

 

If hWnd > 0 Then

SetForegroundWindow hWnd

msghWnd = FindWindowEx(hWnd, 0, "button", btnValue) '找到确定按钮

'SetForegroundWindow msghWnd

SetActiveWindow hWnd

SetActiveWindow msghWnd

 

'实现鼠标点击操作

' PostMessage msghWnd, WM_LBUTTONDOWN, 0, ByVal (1 + 1 * 65536)

' PostMessage msghWnd, WM_LBUTTONUP, 0, ByVal (1 + 1 * 65536)

SendMessage msghWnd, BM_CLICK, 0, 0

 

clickDialog = True

End If

 

End Function

 

 

Sub testdia()

 

Call clickDialog

 

End Sub

 

 

Sub TimeProc1(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long)

'回调函数的固定格式，不能自行更改，且只能是sub

 

Const BM_CLICK = &HF5

Dim msghWnd As Long, hWnd As Long

 

hWnd = FindWindow(vbNullString, "来自网页的消息") '以标题查找对话框

 

If hWnd > 0 Then

SetForegroundWindow hWnd

msghWnd = FindWindowEx(hWnd, 0, "button", "确定") '找到确定按钮

'SetForegroundWindow msghWnd

SetActiveWindow hWnd

SetActiveWindow msghWnd

 

'实现鼠标点击操作

' PostMessage msghWnd, WM_LBUTTONDOWN, 0, ByVal (1 + 1 * 65536)

' PostMessage msghWnd, WM_LBUTTONUP, 0, ByVal (1 + 1 * 65536)

SendMessage msghWnd, BM_CLICK, 0, 0

 

End If

 

End Sub

 

建立定显示器和消灭定时器的代码

TimerID1 = timeSetEvent(2000, 1, AddressOf TimeProc1, 1, 1) '注意定时器的时间要长于回调函数的执行时间

timeKillEvent (TimerID1)

 

 

http://s10/middle/002z94qRzy71UOIPbiF19&amp;690

 

凤凰树：取名于"叶如飞凰之羽，花若丹凤之冠"，原产于马达加斯加，为其国树，属豆科植物，以其细腻繁茂的绿叶和火爆狂野的深红而成为初夏最引人注目的风景，全株有毒。