Evènement OnClick sur élément HTML en TWebBrowser

**KlausGunther** · 10/11/2014, 13h10

Je suis sous W8.1, avec Delphi 6 Personal Edition.
Je réalise une grosse DLL en Delphi avec des centaines de fonctions, destinée à étendre les possibilités d'un langage de programmation freeware.

Dans ce cadre ce ce travail, j'ai créé un ensemble de fonctions permettant de créer dynamiquement un objet TWebBrowser et de l'injecter dans une form du programme application, puis de piloter cet objet. Mais maintenant, je veux y ajouter la possibilité d'intercepter l'évènement OnClick sur n'importe quel élément HTML, et je n'y arrive pas. Pourtant, j'ai réussi à gérer l'évènement WebBrowser_OnNavigateComplete2 du WebBrowser, sans problème. Mais le compilateur refuse de prendre mes lignes. J'ai essayé des dizaines de variantes, j'ai passé des jours à chercher sur le net. Mais au final, pas de solution. Voici le fragment de code qui pose problème:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
// installation de l'évènement OnClick sur un élément HTML quelconque
function WBOnClick():integer; stdcall; export;
var
  myDoc: IHTMLDocument2;
begin
  myDoc := WB.Document as IHTMLDocument2;
  // Ligne suivente; erreur:
  // Types incompatibles: 'OleVariant' et 'procedure, untyped pointer or untyped parameter'
  myDoc.onclick := TDummy.DocumentOnClick;    // <== erreur ici !
  //  je n'ai pas non plus réussi à utliliser la méthode AttachEvent...
  result := 0;
end;

avec la fonction étant déclarée comme suit:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
type
  TDummy = class
    class procedure WebBrowser_OnNavigateComplete2(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant);  // pour WB_Create
    class procedure DocumentOnClick();
  end;
 
// procédure évènement OnClick d'un élément HTML quelconque
class procedure TDummy.DocumentOnClick();
begin
  showmessage('Clic sur élément HTML');
end;

En pièce jointe, je mets un fichier test_WB.zip. Ce fichier contient 2 projets Delphi 6 Personal Edition:
- test_WB.dpr <--- c'est un extrait fonctionnel de ma DLL
- demo_WB.dbr <--- c'est un programme de démo utilisant les fonctions de la DLL
Il y a les sources complètes (ce n'est pas grand...), ainsi que les binaires test_WB.dll et demo_WB.exe. C'est donc exécutable directement. Le mode d'emploi est simple: on lance demo_WB.exe. On obtient une fenêtre avec 5 boutons, dont les libellés décrivent la fonction et contiennent un numéro d'ordre. Actuellement, le bouton "4 - créer OnClick" est inactif, car la fonction correspondante de la DLL ne passe justement pas en compilation.

Je précise que je veux pouvoir établir un évènement OnClick agissant sur l'ensemble des éléments HTML de la page chargée, sans modifier le code HTML de la page et sans recourir au JavaScript, uniquement par les moyens de Delphi 6. Je suis sûr que c'est possible, mais je bute à l'évidence sur un problème de compréhension. Pouvez-vous m'aider ?

**ShaiLeTroll** · 10/11/2014, 13h45

le OnClick est en réalité un callback, c'est un objet complet qu'il faut fournir
Ton DocumentOnClick est loin de satisfaire la déclaration IHTMLDocument2::onclick Property

VARIANT of type VT_DISPATCH that specifies the IDispatch interface of an object with a default method that is invoked when the event occurs.

Cela implique d'implémenter complètement IDispatch (compteur de ref, dispatch de méthode ...)

vu ton code, tu as mal recopié la gestion du TMSHTMLHTMLDocumentEvents fourni ici
Cette classe est déclaré soit dans WebBrowserEx ou dans MSHTMLEvents qui a été créé par l'import du TLB (si tu as coché support des evenements)

Par les listeners et attachEvent ou addEventListener

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

myDoc.attachEvent('onclick', TEventObject.Create(DocumentOnClick) as IDispatch);

Soit par le OnClick directement (source original)
Faudra lire, c'est risque de perdre la chaine de traitement (en gros ton code pourrait remplacer un OnClick JS par exemple)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

myDoc.OnClick := TEventObject.Create(DocumentOnClick) as IDispatch

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
type
  TEventObject = class(TInterfacedObject, IDispatch)
  private
    FOnEvent: TProcedure; // si ça existe c'est dans  System.SysUtils !
  protected
    function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
    function GetIDsOfNames(const IID: TGUID; Names: Pointer;
      NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  public
    constructor Create(const OnEvent: TProcedure);
    property OnEvent: TProcedure read FOnEvent write FOnEvent;
  end;
 
implementation
 
uses Windows, ActiveX;
 
{ TEventObject }
 
constructor TEventObject.Create(const OnEvent: TProcedure);
begin
  inherited Create;
  FOnEvent := OnEvent;
end;
 
function TEventObject.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
  Result := E_NOTIMPL;
end;
 
function TEventObject.GetTypeInfo(Index, LocaleID: Integer;
  out TypeInfo): HResult;
begin
  Result := E_NOTIMPL;
end;
 
function TEventObject.GetTypeInfoCount(out Count: Integer): HResult;
begin
  Result := E_NOTIMPL;
end;
 
function TEventObject.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  ArgErr: Pointer): HResult;
begin
  if (Dispid = DISPID_VALUE) then
  begin
    if Assigned(FOnEvent) then
      FOnEvent;
    Result := S_OK;
  end
  else Result := E_NOTIMPL;
end;

**KlausGunther** · 10/11/2014, 15h45

Merci beaucoup pour ton aide. Je pensais bien que j'avais mal digéré quelque chose.

Donc, j'ai intégré dans ma DLL ce que tu as posté. Voici le code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
library test_WB;
 
uses
  SysUtils,
  Dialogs,
  Windows,
  Classes,
  ActiveX,
  SHDocVw_TLB,
  mshtml,
  Forms;
 
type
  TDummy = class
    class procedure WebBrowser_OnNavigateComplete2(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant);  // pour WB_Create
    class procedure DocumentOnClick();
  end;
 
type
  TEventObject = class(TInterfacedObject, IDispatch)
  private
    FOnEvent: TProcedure; // si ça existe c'est dans  System.SysUtils !
  protected
    function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
    function GetIDsOfNames(const IID: TGUID; Names: Pointer;
      NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  public
    constructor Create(const OnEvent: TProcedure);
    property OnEvent: TProcedure read FOnEvent write FOnEvent;
  end;
 
{ TEventObject }
 
constructor TEventObject.Create(const OnEvent: TProcedure);
begin
  inherited Create;
  FOnEvent := OnEvent;
end;
 
function TEventObject.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
  Result := E_NOTIMPL;
end;
 
function TEventObject.GetTypeInfo(Index, LocaleID: Integer;
  out TypeInfo): HResult;
begin
  Result := E_NOTIMPL;
end;
 
function TEventObject.GetTypeInfoCount(out Count: Integer): HResult;
begin
  Result := E_NOTIMPL;
end;
 
function TEventObject.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  ArgErr: Pointer): HResult;
begin
  if (Dispid = DISPID_VALUE) then
  begin
    if Assigned(FOnEvent) then
      FOnEvent;
    Result := S_OK;
  end
  else Result := E_NOTIMPL;
end;
 
var
  frm3DllForm: TForm;
  WB: TWebBrowser;
 
 
{$R *.res}
 
// procédure pour une attente non bloquante de MSecs milli-secondes
procedure Delay(MSecs: Cardinal);
var
  iStop : cardinal;
begin
  iStop := GetTickCount + Msecs;
  while GetTickCount < iStop do
  begin
    Application.ProcessMessages;
    sleep(1);
  end
end;
 
// procédure évènement OnClick d'un élément HTML quelconque
class procedure TDummy.DocumentOnClick();
begin
  showmessage('Clic sur élément HTML');
end;
 
// procédure évènement de fin de chargement d'une form
class procedure TDummy.WebBrowser_OnNavigateComplete2(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant);
begin
  try
    if ( (pDisp as IWebBrowser) = (Sender as TWebBrowser).DefaultInterface ) then (Sender as TWebBrowser).Tag := 0;
  finally
  end;
end;
 
// création dynamique d'un WB
function WBCreate(xhand: integer):integer; stdcall; export;
begin
  try
//        if not assigned(GetInfoParams) then GetInfoParams := TStringList.Create
//                                       else GetInfoParams.Clear;
        WB := TWebBrowser.Create(Frm3DllForm);
        WB.ParentWindow := xhand;
        WB.Resizable := true;
        WB.Silent := true;
        WB.OnNavigateComplete2 := TDummy.WebBrowser_OnNavigateComplete2;
        WB.Tag := 0;
  finally
  end;
  result := 0;
end;
 
// géométrie d'un WB
function WBLocate(xleft,xtop,xwidth,xheight: integer): integer; stdcall; export;
begin
  try
        WB.Top := xtop;
        WB.Left := xleft;
        WB.Width := xwidth;
        WB.Height := xheight;
  finally
  end;
  result := 0;
end;
 
// chargement d'une URL dans un WB
function WBUrl(xurl: pstring): integer; stdcall; export;
var
  zurl: WideString;
begin
  try
    zurl := xurl^;
    WB.Tag := 1;
    WB.Navigate(zurl);
    while WB.tag=1 do delay(100);
  finally
  end;
  result := 0;
end;
 
// supprimer le WB
function WBDelete: integer; stdcall; export;
begin
  try
        WB.Free;
  finally
  end;
  result := 0;
end;
 
 
// installation de l'évènement OnClick sur un élément HTML quelconque
function WBOnClick():integer; stdcall; export;
var
  myDoc: IHTMLDocument2;
begin
  myDoc := WB.Document as IHTMLDocument2;
  myDoc.attachEvent('onclick', TEventObject.Create(DocumentOnClick) as IDispatch);
  result := 0;
end;
 
exports
  WBCreate,
  WBLocate,
  WBUrl,
  WBOnClick,
  WBDelete;
 
begin
end.

et voici le résultat à la compilation:
Nom : aa1.png
Affichages : 1334
Taille : 17,7 Ko

Donc, j'ai encore une anomalie...

**KlausGunther** · 10/11/2014, 15h55

Et, à tout hasard, voici le contenu de mon fichier SHDocVw.pas, en pièce jointe. (trop gros pour être copié ici).

**KlausGunther** · 11/11/2014, 02h29

J'ai avancé un petit peu. J'ai pu remédier à une des deux erreurs signalées:
Identificateur non déclaré: 'DocumentOnClick'
J'ai changé la façon de déclarer cette procédure - au lieu d'en faire une procédure de classe, j'ai fait une procédure simple.
Cependant, l'autre erreur persiste, et je n'arrive pas à y remédier:
Identificateur non déclaré: 'attachEvent'

Voici la DLL telle qu'elle est maintenant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
library test_WB;
 
uses
  SysUtils,
  Dialogs,
  Windows,
  Classes,
  ActiveX,
  SHDocVw_TLB,
  mshtml,
  Forms;
 
type
  TDummy = class
    class procedure WebBrowser_OnNavigateComplete2(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant);  // pour WB_Create
//    class procedure DocumentOnClick();
  end;
 
type
  TEventObject = class(TInterfacedObject, IDispatch)
  private
    FOnEvent: TProcedure; // si ça existe c'est dans  System.SysUtils !
  protected
    function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
    function GetIDsOfNames(const IID: TGUID; Names: Pointer;
      NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  public
    constructor Create(const OnEvent: TProcedure);
    property OnEvent: TProcedure read FOnEvent write FOnEvent;
  end;
 
{ TEventObject }
 
constructor TEventObject.Create(const OnEvent: TProcedure);
begin
  inherited Create;
  FOnEvent := OnEvent;
end;
 
function TEventObject.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
  Result := E_NOTIMPL;
end;
 
function TEventObject.GetTypeInfo(Index, LocaleID: Integer;
  out TypeInfo): HResult;
begin
  Result := E_NOTIMPL;
end;
 
function TEventObject.GetTypeInfoCount(out Count: Integer): HResult;
begin
  Result := E_NOTIMPL;
end;
 
function TEventObject.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  ArgErr: Pointer): HResult;
begin
  if (Dispid = DISPID_VALUE) then
  begin
    if Assigned(FOnEvent) then
      FOnEvent;
    Result := S_OK;
  end
  else Result := E_NOTIMPL;
end;
 
var
  frm3DllForm: TForm;
  WB: TWebBrowser;
 
 
{$R *.res}
 
// procédure pour une attente non bloquante de MSecs milli-secondes
procedure Delay(MSecs: Cardinal);
var
  iStop : cardinal;
begin
  iStop := GetTickCount + Msecs;
  while GetTickCount < iStop do
  begin
    Application.ProcessMessages;
    sleep(1);
  end
end;
 
// procédure évènement OnClick d'un élément HTML quelconque
//class procedure TDummy.DocumentOnClick();
procedure DocumentOnClick();
begin
  showmessage('Clic sur élément HTML');
end;
 
// procédure évènement de fin de chargement d'une form
class procedure TDummy.WebBrowser_OnNavigateComplete2(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant);
begin
  try
    if ( (pDisp as IWebBrowser) = (Sender as TWebBrowser).DefaultInterface ) then (Sender as TWebBrowser).Tag := 0;
  finally
  end;
end;
 
// création dynamique d'un WB
function WBCreate(xhand: integer):integer; stdcall; export;
begin
  try
//        if not assigned(GetInfoParams) then GetInfoParams := TStringList.Create
//                                       else GetInfoParams.Clear;
        WB := TWebBrowser.Create(Frm3DllForm);
        WB.ParentWindow := xhand;
        WB.Resizable := true;
        WB.Silent := true;
        WB.OnNavigateComplete2 := TDummy.WebBrowser_OnNavigateComplete2;
        WB.Tag := 0;
  finally
  end;
  result := 0;
end;
 
// géométrie d'un WB
function WBLocate(xleft,xtop,xwidth,xheight: integer): integer; stdcall; export;
begin
  try
        WB.Top := xtop;
        WB.Left := xleft;
        WB.Width := xwidth;
        WB.Height := xheight;
  finally
  end;
  result := 0;
end;
 
// chargement d'une URL dans un WB
function WBUrl(xurl: pstring): integer; stdcall; export;
var
  zurl: WideString;
begin
  try
    zurl := xurl^;
    WB.Tag := 1;
    WB.Navigate(zurl);
    while WB.tag=1 do delay(100);
  finally
  end;
  result := 0;
end;
 
// supprimer le WB
function WBDelete: integer; stdcall; export;
begin
  try
        WB.Free;
  finally
  end;
  result := 0;
end;
 
 
// installation de l'évènement OnClick sur un élément HTML quelconque
function WBOnClick():integer; stdcall; export;
var
  myDoc: IHTMLDocument2;
begin
  myDoc := WB.Document as IHTMLDocument2;
  myDoc.attachEvent('onclick', TEventObject.Create(DocumentOnClick) as IDispatch);
  result := 0;
end;
 
exports
  WBCreate,
  WBLocate,
  WBUrl,
  WBOnClick,
  WBDelete;
 
begin
end.

En pièce jointe, il y a à nouveau le ZIP avec les sources complètes.

**exoseven** · 11/11/2014, 08h31

tu dois ajouter l'unité MSHTML (ou MSHTML_tlb )

**KlausGunther** · 11/11/2014, 10h27

Ben... MSHTML y est déjà en ligne 10. Et j'ai ajouté en plus MHHTPL_TLB, mais ce ne change rien:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
uses
  SysUtils,
  Dialogs,
  Windows,
  Classes,
  ActiveX,
  SHDocVw_TLB,
  mshtml,
  MSHTML_tlb,
  Forms;

Il doit y avoir autre chose...

**exoseven** · 11/11/2014, 10h42

ouvre ton MSHTML et regarde où est déclaré attachEvent

**exoseven** · 11/11/2014, 10h45

ok depuis IE11 attachEvent n'est plus supporté, il faut utiliser addEventListener http://msdn.microsoft.com/en-us/libr...=vs.85%29.aspx

donc regarde dans MSHTML si tu as addEventListener

**KlausGunther** · 11/11/2014, 11h21

D'accord, exoseven. J'ai vu que ce n'est plus supporté. Mais le lien vers la doc MS concerne les attributs d'un objet HTML, gérés en JavaScript. J'ai pris le code source de la page de démo et je vois l'usage de addEventListener, en JavaScript.

Mais malheureusement, ça ne résoud pas mon problème, pour deux raisons:
1. je veux pouvoir intercepter un clic sans avoir à modifier le code source de la page HTML (et donc sans avoir à injecter du JavaScript)
2. ni mon MSHTML ni mon MSHTML_TLB ne contiennent addEventListener

Et je pense que c'est ce second point qui bloque ma compilation.

**exoseven** · 11/11/2014, 11h33

refais peut-être une importation de Microsoft HTML object library si tu as une ancienne version

**exoseven** · 11/11/2014, 11h57

sinon va voir cela

cela attache un OnClick pour tout ton Document, après tu détermine dans ta procédure OnClick l'élément cliqué

**KlausGunther** · 11/11/2014, 13h08

J'avais vu cette page, mais j'espérais sincèrement qu'une façon plus simple ou plus directe ait été possible. Mais c'est exactement ce que je veux: attacher un évènement OnClick pour tout le document.

J'ai téléchargé le logiciel et je l'ai installé.

J'ai tout d'abord fait un essai, directement avec la démo pour IE4 dont le lien est dans la page. Mais je ne peux pas installer les composants contenus dans SHDocVwEvents.pas fourni dans cet exemple - probablement parce qu'il a été généré pour une version trop ancienne.

J'ai donc lancé EventSinkImp.exe, mais je n'arrive pas à déterminer quelle bibliothèque je dois sélectionner. Est-ce celle-ci ?

Nom : aa1.png
Affichages : 1298
Taille : 12,9 Ko

Nom : aa1.png
Affichages : 1298
Taille : 12,9 Ko

**exoseven** · 11/11/2014, 14h48

je sais pas, tu peux sinon le prendre ici https://code.google.com/p/exodus/sou...nts.pas?r=2636

**KlausGunther** · 11/11/2014, 17h48

J'ai essayé ce module. Mais ça ne passe toujours pas à ma compilation (le module lui-même compile sans problème, cependant) parce qu'il ne contient pas l'identifiant recherché. En en y regardant de plus près, c'est un module justement généré par EventSinkImp à partir d'une bibliothèque que je ne semble pas avoir. Ce module contient par contre une série de propriétés xxxOnClick pour toute une série d'objets, mais là, ne ne sais vraiment pas quoi prendre ni comment l'utiliser. Le site indiqué ne semble pas fournir de documentation spécifique à ce niveau.

Résultat: je suis toujours coincé, malgré tous ces bons conseils...

EDIT

L'utilitaire EventSinkImp.exe a besoin du programme TLibImp.exe qui fait partie de la distribution Delphi de Borland. En principe. Sauf que ça ne fait pas partie de Delphi 6 Personal Edition, et je n'ai trouvé aucun lien pour le télécharger.

Alors, un EventSink opérationnel pour Delphi 6 Personal Edition, ou une autre manière de définir un OnClick sur un document HTML sans EventSint, est-ce possible ? Est-ce que ça existe ?

**KlausGunther** · 15/11/2014, 13h31

En attendant une éventuelle solution pour le problème signalé dans mon message précédent, j'ai essayé d'avancer par un autre biais.

J'ai choisi de hooker la fenêtre du TWebBrowser en remplaçant sa WndProc. J'intercepte un seul message: WM_PARENTNOTIFY, j'analyse le motif du message et je ne retiens que WM_LBUTTONDOWN. Dans tous les autres cas, je passe le message à la WndProc d'origine.

L'interception marche parfaitement, y compris la reconnaissance du WM_LBUTTONDOWN. A ce moment, je retourne un texte dans le programme appelant, avec le handle du browser ainsi que les coordonnées x et y de l'évènement. Cela se passe bien.

Maintenant, je veux savoir sur quel élément HTML l'évènement a eu lieu. Donc, j'essaie de récupérer le document contenu dans le browser sous forme de IHTMLDocument2, par les lignes:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Document:IHTMLDocument2;
...
Document := (WB as  IWebbrowser2).Document AS IHTMLDocument2;

Or, cette ligne provoque le plantage suivant:
Nom : aa1.png
Affichages : 1256
Taille : 8,4 Ko

Je sais que cette ligne est responsable car j'affiche un message juste avant et un autre juste après, et ce second message ne se produit pas.

En pièce jointe, il y a un fichier ZIP avec l'ensemble des sources et binaires. La DLL est test_WB.dpr (test_WB.dll), et le programme de démo est demo_WB.dpr (demo_WB.exe). Il suffit le lancer demo_WB.exe, et de cliquer sur les boutons de 1 à 4, dans l'ordre. Puis, un clic n'importe où dans la page HTML affichée.

Est-ce que vous pourriez m'aider ?

**exoseven** · 15/11/2014, 17h46

Envoyé par KlausGunther

L'utilitaire EventSinkImp.exe a besoin du programme TLibImp.exe qui fait partie de la distribution Delphi de Borland. En principe. Sauf que ça ne fait pas partie de Delphi 6 Personal Edition, et je n'ai trouvé aucun lien pour le télécharger.

d'après Microsoft TLibImp.exe est livré avec Visual Studio, tu peux essayer d'installer la version gratuite pour voir ...

**KlausGunther** · 16/11/2014, 01h49

d'après Microsoft TLibImp.exe est livré avec Visual Studio, tu peux essayer d'installer la version gratuite pour voir ...

J'ai installé Visual Studio 2012 (quand-même 2,5 Go !), mais il n'y a pas cet utilitaire. Dommage.

En cherchant un peu plus sur le Net, je vois que cet utilitaire est censé être fourni avec Delphi et se trouver dans le dossier ...\Bin\. Mais il n'y est pas non plus - j'ai seulement tlibimp.sym ce qui ne sert à rien.

Donc, mon problème reste entier.

Et sur mon autre tentative - celle de hooker le contrôle TWebBrowser en entier ? Le hook marche parfaitement (en fait, c'est une technique que j'utilise assez souvent, donc pas de pb). Mais je suis bloqué sur ce IHTMLDOCUMENT2 qui est refusé à l'exécution. A la compilation, pas de problème...

**KlausGunther** · 16/11/2014, 10h37

J'ai trouvé une solution à mon problème pour hooker le WebBrowser en entier. Comme ceci, ça marche:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
// procédure réalisant le hook sur l'objet WB
function WB_HeaderProc(wnd: HWND; Msg: Cardinal; wParam: wParam; lParam: lParam): Longint; stdcall;
var
  x, y: integer;
  mes: string;
  Element: IHTMLElement;
  Document:IHTMLDocument2;
begin
  result := 0;
  case Msg of
    WM_PARENTNOTIFY:                                        // seul évènement utile
      begin
        if LOWORD(wParam)=WM_LBUTTONDOWN then begin         // ne retenir que celui-là
          x := LOWORD(lParam);
          y := HIWORD(lParam);
          Document := WB.Document AS IHTMLDocument2;
 
          Element := Document.elementFromPoint(x,y);
          mes := inttostr(wnd)+':'+IntToStr(x)+','+IntToStr(y)+'='+Element.id;
          SendMessage(handle_info, WM_SETTEXT, 0, LongInt(pchar(mes)));
          result := 0;
        end else begin
          Result := CallWindowProc(Pointer(GetWindowLong(wnd, GWL_USERDATA)), wnd, Msg, wParam, lParam);
        end;  // fin de WM_LBUTTONDOWN
      end;   // fin de WM_PARENTNOTIFY
  else Result := CallWindowProc(Pointer(GetWindowLong(wnd, GWL_USERDATA)), wnd, Msg, wParam, lParam);
  end;      // fin de CASE
end;

**KlausGunther** · 22/11/2014, 19h01

J'ai trouvé une solution parfaite à mon problème, et ce sans "hooker" le WebBrowser en entier, et sans recourir à des modules externes comme EventSinkImp.exe. Je publie ici la solution complète, pour ceux que cela intéresse.

J'ai créé une fonction dans la DLL dont le prototype est ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

function WBSurvey(fun: integer; hnd: HWND):integer; stdcall; export;

Utilisation des paramètres:
fun = code fonction 1=activer la surveillance 0=désactiver le surveillance
hnd = handle d'un TMemo recevant les informations sur l'objet surveillé

Dans le programme appelant, il suffit alors de déclarer un évènement ON_CHANGE sur ce mémo pour pouvoir agir en fonction du contexte de l'évènement surveillé.

Je joins une archive ZIP avec les sources et les binaires. Je rappelle le sens:
test_WB.dpr = projet pour construire test_WB.dll
demo_WB.dpr = projet pour construire demo_WB.exe (exécutable utilisant test_WB.dll)
et, nouvellement:
test_WB_on_click.bas = source (en un clone de Basic) de test_WB_on_click.exe (exécutable utilisant test_WB.dll)

Il suffit de décompresser l'archive et de lancer un des exécutables (test_WB.exe ou test_WB_on_click.exe) pour voir l'effet, en baladant la souris sur la fenêtre du browser et/ou en cliquant sur un élément quelconque de la page du browser, même une zone en principe non cliquable.

Une dernière précision: si l'on souhaite éventuellement bloquer un clic sur l'un ou l'autre des éléments, il suffit d'implémenter un évènement OnBeforeNavigate2, exactement selon le modèle de l'évènement OnClick implémenté dans test_WB.dpr. Et dans la fonction associée, on détermine si le clic sur l'élément cliqué doit être exécuté ou non. Et s'il faut refuser l'exécution du clic, il suffit simplement d'ajouter la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

  cancel = true;

C'est aussi simple que ça.

Evènement OnClick sur élément HTML en TWebBrowser

API, COM et SDKs Delphi

Discussions similaires

Partager

Partager