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
| 'Le principe est d'obtenir l'URL d'Internet Explorer et de pouvoir également la modifier.
'L'idée est donc de parcourrir les fenêtres Windows ouvertes, puis dès que l'on a trouvé celle de Internet Explorer, de se balader dans la hiérarchie de ses fenêtres internes pour obtenir le handle de celle ou est l'URL. Une fois ce handle obtenu, grâce à des SendMessage, on peut obtenir l'URL ou la modifier.
'On a donc besoin d'utiliser les API Windows pour une fois. Déclarons les dans une classe IEURL ainsi que quelques constantes :
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Int32
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Int32, ByVal wMsg As Int32, ByVal wParam As Int32, ByVal lParam As String) As Int32
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Int32, ByVal wMsg As Int32, ByVal wParam As Int32, ByVal lParam As Int32) As Int32
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Int32, ByVal wCmd As Int32) As Int32
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Int32, ByVal lpClassName As String, ByVal nMaxCount As Int32) As Int32
Private Const GW_CHILD As Int32 = 5
Private Const GW_HWNDNEXT As Int32 = 2
Private Const WM_GETTEXT As Int32 = &HD
Private Const WM_GETTEXTLENGTH As Int32 = &HE
Private Const WM_SETTEXT As Int32 = &HC
Private Const WM_KEYDOWN As Int32 = &H100
Private Const VK_RETURN As Int32 = &HD
Private Const MAX_PATH As Int32 = 255
'Pour obtenir l'URL d'Internet Explorer, IEURL a la méthode getURL :
Public Function GetURL() As String
Dim hwndChild As Int32 = Me.gethwndIETextBox
If hwndChild = 0 Then Throw New ArgumentException("Fenêtre introuvable")
Dim iLength As Int32 = SendMessage(hwndChild, WM_GETTEXTLENGTH, 0, 0)
Dim sURL As String = New String(" "c, iLength + 1)
SendMessage(hwndChild, WM_GETTEXT, sURL.Length, sURL)
Return sURL.Trim
End Function
Public Sub SetURL(ByVal sNewURL As String)
Dim hwndChild As Int32 = Me.gethwndIETextBox
If hwndChild = 0 Then Throw New ArgumentException("Fenêtre introuvable")
SendMessage(hwndChild, WM_SETTEXT, 0, sNewURL)
SendMessage(hwndChild, WM_KEYDOWN, VK_RETURN, 0)
End Sub
Private Function gethwndIETextBox() As Int32
Dim sIEClassName As String = "IEFrame"
Dim hIE, hwndChild As Int32 'on trouve la fenêtre de d'Internet Explorer
hIE = FindWindow(sIEClassName, vbNullString)
hIE = 0
If hIE <> 0 Then
'balade dans la hiérarchie des fenêtres internes à IE
hwndChild = hIE
hwndChild = hwndFindWindow(hwndChild, "WorkerW")
If hwndChild = 0 Then Throw New ArgumentException("Fenêtre introuvable")
hwndChild = hwndFindWindow(hwndChild, "ReBarWindow32")
If hwndChild = 0 Then Throw New ArgumentException("Fenêtre introuvable")
hwndChild = hwndFindWindow(hwndChild, "ComboBoxEx32")
If hwndChild = 0 Then Throw New ArgumentException("Fenêtre introuvable")
hwndChild = hwndFindWindow(hwndChild, "ComboBox")
If hwndChild = 0 Then Throw New ArgumentException("Fenêtre introuvable")
hwndChild = hwndFindWindow(hwndChild, "Edit")
If hwndChild = 0 Then Throw New ArgumentException("Fenêtre introuvable")
Return hwndChild
End If
Return 0
End Function
Private Function hwndFindWindow(ByVal hwndParent As Int32, ByVal sClassName As String) As Int32
Dim hwndChild As Int32
Dim sClass As String = New String(" "c, MAX_PATH)
Dim bTrouve As Boolean, iRepClassName As Int32
'on recherche la première fenêtre enfant
hwndChild = GetWindow(hwndParent, GW_CHILD)
'on regarde la classe du premier enfant
iRepClassName = GetClassName(hwndChild, sClass, MAX_PATH)
If sClass.Substring(0, iRepClassName) = sClassName Then Return hwndChild
If hwndChild = 0 Then Return 0 'il n'a pas d'enfant
bTrouve = False
Do Until bTrouve
hwndChild = GetWindow(hwndChild, GW_HWNDNEXT)
If hwndChild = 0 Then Return 0 'on a tout parcourru sans le trouver
iRepClassName = GetClassName(hwndChild, sClass, MAX_PATH)
If sClass.Substring(0, iRepClassName) = sClassName Then
Return hwndChild 'on l'a trouvé
End If
Loop
Return 0
End Function |
