1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
| Public lngProcessID_Close As Long
'Part 1 --- Locate IES
Private strHwndIES As String
Private lngHwndIndex As Long
Private Declare Function EnumWindows Lib "user32" ( _
ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function EnumChildWindows Lib "user32" ( _
ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" ( _
ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
'Part 2 --- Get HTMLDocument from IES
Private Const SMTO_ABORTIFHUNG = &H2
Private Const GUID_IHTMLDocument2 = "{332C4425-26CB-11D0-B483-00C04FD90119}"
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 Declare Function IIDFromString Lib "ole32" ( _
lpsz As Any, lpiid As Any) As Long
Private Declare Function ObjectFromLresult Lib "oleacc" ( _
ByVal lResult As Long, _
riid As Any, _
ByVal wParam As Long, _
ppvObject As Any) As Long
'Part 3 --- Check Process Name
Private Declare Function GetWindowThreadProcessId Lib "user32" ( _
ByVal hWnd As Long, lpdwProcessId As Long) As Long
Public Function findEdgeDOM(Title As String, URL As String) As Object
'Find criteria-hitting Edge page in IE mode
Dim hwndIES As Long
Do
hwndIES = enumHwndIES
If hwndIES Then
Set findEdgeDOM = getHTMLDocumentFromIES(hwndIES)
If Not findEdgeDOM Is Nothing Then
If InStr(findEdgeDOM.Title, Title) * InStr(findEdgeDOM.URL, URL) Then
Do
hwndIES = enumHwndIES
Loop While hwndIES
Exit Function
Else
Set findEdgeDOM = Nothing
End If
End If
End If
Loop While hwndIES
End Function
Public Function enumHwndIES() As Long
'Get all hwnds of IES
If Len(strHwndIES) = 0 Then
EnumWindows AddressOf EnumWindowsProc, 0
lngHwndIndex = 0
End If
'Exit function when overflow
If lngHwndIndex + 1 > (Len(strHwndIES) - Len(Replace(strHwndIES, ",", ""))) Then
enumHwndIES = 0
strHwndIES = ""
Exit Function
End If
'Return IES hwnd one by one
enumHwndIES = CLng(Split(Left(strHwndIES, Len(strHwndIES) - 1), ",")(lngHwndIndex))
lngHwndIndex = lngHwndIndex + 1
End Function
Private Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Boolean
Dim lngProcessID As Long
GetWindowThreadProcessId hWnd, lngProcessID
EnumChildWindows hWnd, AddressOf EnumChildProc, lngProcessID
EnumWindowsProc = True
End Function
Public Function EnumChildProc(ByVal hWnd As Long, ByVal lParam As Long) As Boolean
Dim strTargetClass As String, strClassName As String
strTargetClass = "Internet Explorer_Server"
strClassName = getClass(hWnd)
If strClassName = strTargetClass Then
If GetObject("winmgmts:").ExecQuery("Select Name from Win32_Process WHERE ProcessId='" & lParam & "' AND Name='msedge.exe'").Count Then
strHwndIES = strHwndIES & hWnd & ","
lngProcessID_Close = lParam
EnumChildProc = False
Exit Function
End If
End If
EnumChildProc = True
End Function
Private Function getClass(hWnd As Long) As String
Dim strClassName As String
Dim lngRetLen As Long
strClassName = Space(255)
lngRetLen = GetClassName(hWnd, strClassName, Len(strClassName))
getClass = Left(strClassName, lngRetLen)
End Function
Public Function getHTMLDocumentFromIES(ByVal hWnd As Long) As Object
Dim iid(0 To 3) As Long
Dim lMsg As Long, lRes As Long
lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
SendMessageTimeout hWnd, lMsg, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes
If lRes Then
IIDFromString StrPtr(GUID_IHTMLDocument2), iid(0)
ObjectFromLresult lRes, iid(0), 0, getHTMLDocumentFromIES
End If
End Function
Public Sub closeEdge(Title As String, URL As String)
'Close a Edge browser (the last one in EnumWindows order) with criteria-hitting webpage
lngProcessID_Close = 0
Dim findEdgeDOM As Object
Dim hwndIES As Long
Do
hwndIES = enumHwndIES
If hwndIES Then
Set findEdgeDOM = getHTMLDocumentFromIES(hwndIES)
If InStr(findEdgeDOM.Title, Title) * InStr(findEdgeDOM.URL, URL) Then
Shell "TaskKill /pid " & lngProcessID_Close
Do
hwndIES = enumHwndIES
Loop While hwndIES
Exit Sub
End If
End If
Loop While hwndIES
End Sub |
vba automatisation de EDGE
Répondre avec citation
Partager