Communiquer avec un ActiveX

Version imprimable

08/12/2020, 16h05
franckcl

Communiquer avec un ActiveX

[Dernière version de Delphi]
Bonjour,

Je dois récupérer des données d'un autre logiciel (soft appellé EIES de chez Inficon).
Dans la doc du soft, il est indiqué qu'on peut utiliser query et update.
Voici ce qui est indiqué aussi dans cette doc:
"The EIES software must be running to use the ActiveX interface. Any program that supports Microsoft's COM (ActiveX) interface (i.e., LabView, Wonderware, etc..) can communicate with the EIES software"

Ce soft est fourni avec un autre soft d'exemple développé en VB qui permet de tester la communication avec l'EIES et ça marche.

Mais voilà je bloque, je n'arrive pas à voir ce soft dans les ActiveX.
Dans l'IDE de Delphi, quand je vais dans le menu Composant/Importer un composant puis "Importer un contrôle Active X" aucun activex ne correspond à ce soft EIES.

Merci pour vos conseils.
08/12/2020, 17h51
blonde

Est-ce qu'il y aurait un fichier .ocx installé avec ce soft ?
Si oui, tu peux tenter de l'importer.
08/12/2020, 18h04
ShaiLeTroll

Avez-vous lancer le programme EIES_Vxxx_COMM.exe qui semble activer les ActiveX et contenir une Démo (le programme VB que vous évoquez peut-être ?)
Avez-vous vérifier 32/64 Bits ?
09/12/2020, 09h48
franckcl

1 pièce(s) jointe(s)

Bonjour à tous les deux et merci pour votre aide.
Il n'y a pas de fichier OCX.
Les seuls fichiers qu'il y a dans le dossier d'installation sont:
- EIES.Exe: le soft lui même.
- SigmaFlash.exe : d'après la doc c'est un utilitaire pour flasher le firmware de l'appareil
- SiUSBXp.dll: d'après google, un driver USB
Les autres fichiers sont des fichiers de données "passifs"

Lors de l'installation, un fichier DAO360.DLL a été installé dans le dossier C:\Program Files (x86)\Common Files\Microsoft Shared\DAO

Lorsque les 2 softs (EIES et le soft de test) sont executés, je ne vois rien qui ressemble à l'EIES dans les activeX qui sont affichés par l'IDE de RadStudio.

Pièce jointe 586211
09/12/2020, 11h25
franckcl

J'ai désinsinstallé le soft EIES puis j'ai rebooté le PC puis je suis retourné dans la liste des ActiveX de l'IDE RadStudio et cette liste n'a pas changé, rien de supprimé, rien d'ajouté, rien de modifié.

Dans le dossier C:\Program Files (x86)\Common Files\Microsoft Shared\DAO il y a en fait 2 fichiers qui sont:
- DAO350.DLL
- DAO360.DLL

L'installation du soft EIES installe le fichier DAO350.dll (et non pas DAO360.dll)
Lorsque le soft EIES n'est pas executé, je peux renommer le fichier DAO350.dll, ce qui veut dire qu'il n'est pas utilisé par une autre application en revanche, DAO360.dll est utilisé par une autre application car je ne peux pas renommer le fichier.
En revanche, lorsque le soft EIES est executé, je ne peux pas renommer le fichier DAO350.dll donc le soft utilise cette DLL

J'avoue ne pas comprendre comme faire.
09/12/2020, 15h06
SergioMaster

1 pièce(s) jointe(s)

Bonjour,

À mon avis, il faut avant tout recenser la dll DAO350.dll en croisant les doigts pour que ce soit la bonne.

puis Composants/importer un composant
Pièce jointe 586270
sélectionner la bibliothèque qui devrait alors apparaitre
09/12/2020, 15h20
Paul TOTH

DAO = Data Access Object, c'est le successeur de ODBC, ça n'a rien à voir avec le composant spécifique.

mais je suppose qu'on doit trouver dans le code VB un CreateOleObject() ou équivalent pour initialiser l'ActiveX en question.
09/12/2020, 17h31
ShaiLeTroll

Est-ce que la démo "EIES_Vxxx_COMM.exe" a donné quelque chose ? c'est la démo en VB que vous avez mentionné.

Sinon un EXE peut contenir un server OLE, ça peut être "EIES.Exe" qui contient un serveur COM (voire DCOM), c'est le mode "out-process" du COM que l'on oppose au mode "in-process" que l'on a avec une DLL.
a voir si il faut utiliser GetActiveObject si "EIES.Exe" a recensé son interface (typiquement RegisterActiveObject)
ou sinon CreateOleObject/CreateComObject

J'avance...doucement mais j'avance...
J'ai demandé les sources du soft de test en VB (EIES_COMM) au fournisseur mais je n'ai pas encore de réponse.

En revanche, j'ai examiné ce soft de test avec un éditeur HEXA et j'ai pu voir qu'il faisait appel à c:\windows\SysWOW64\SQS242X.exe
Du coup, j'ai installé le composant dans Delphi et il m'a indiqué qu'il était déjà recensé.

L'assistant d'importation m'indique: "Noms des classes: cComm242=TcComm242,cSQS242Comm=TcSQS242Comm"

Cela m'a créé une unité que voici:

Code:

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
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
unit SQS242X_TLB;
 
// ************************************************************************ //
// AVERTISSEMENT
// -------
// Les types déclarés dans ce fichier ont été générés à partir de données lues
// depuis la bibliothèque de types. Si cette dernière (via une autre bibliothèque de types
// s'y référant) est explicitement ou indirectement ré-importée, ou la commande "Actualiser"
// de l'éditeur de bibliothèque de types est activée lors de la modification de la bibliothèque
// de types, le contenu de ce fichier sera régénéré et toutes les modifications
// manuellement apportées seront perdues.
// ************************************************************************ //
 
// $Rev: 98336 $
// Fichier généré le 10/12/2020 10:34:26 depuis la bibliothèque de types ci-dessous.
 
// ************************************************************************  //
// Biblio. types : C:\WINDOWS\SysWOW64\SQS242X.exe (1)
// LIBID : {3497C7D4-31E1-4ABC-A8BD-996D94DF51E1}
// LCID : 0
// Fichier d'aide : 
// Chaîne d'aide : Sigma Instruments SQS242 ActiveX Interface
// DepndLst : 
//   (1) v2.0 stdole, (C:\Windows\SysWOW64\stdole2.tlb)
// SYS_KIND: SYS_WIN32
// ************************************************************************ //
{$TYPEDADDRESS OFF} // L'unité doit être compilée sans pointeur à type contrôlé.  
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
{$ALIGN 4}
 
interface
 
uses Winapi.Windows, System.Classes, System.Variants, System.Win.StdVCL, Vcl.Graphics, Vcl.OleServer, Winapi.ActiveX;
 
// *********************************************************************//
// GUIDS déclarés dans la bibliothèque de types. Préfixes utilisés:        
//   Bibliothèques de types : LIBID_xxxx                                      
//   CoClasses              : CLASS_xxxx                                      
//   Interfaces DISP        : DIID_xxxx                                       
//   Interfaces Non-DISP    : IID_xxxx                                        
// *********************************************************************//
const
  // Versions mineure et majeure de la bibliothèque de types
  SQS242XMajorVersion = 5;
  SQS242XMinorVersion = 0;
 
  LIBID_SQS242X: TGUID = '{3497C7D4-31E1-4ABC-A8BD-996D94DF51E1}';
 
  IID__cComm242: TGUID = '{6E481EF2-CD76-405B-88D1-55D4394B3BF6}';
  DIID___cComm242: TGUID = '{15D72DE9-788F-47F2-A418-A120C0158788}';
  IID__cSQS242Comm: TGUID = '{9D071745-BC9C-457C-B50C-9CED78E5761E}';
  CLASS_cSQS242Comm: TGUID = '{CB1ED393-6037-449E-9D37-E0DC9C1F44BB}';
  CLASS_cComm242: TGUID = '{4217208C-3198-4688-B05A-8015294CED16}';
type
 
// *********************************************************************//
// Déclaration Forward des types définis dans la bibliothèque de types                     
// *********************************************************************//
  _cComm242 = interface;
  _cComm242Disp = dispinterface;
  __cComm242 = dispinterface;
  _cSQS242Comm = interface;
  _cSQS242CommDisp = dispinterface;
 
// *********************************************************************//
// Déclaration de CoClasses définies dans la bibliothèque de types        
// (REMARQUE: On affecte chaque CoClasse à son Interface par défaut)      
// *********************************************************************//
  cSQS242Comm = _cSQS242Comm;
  cComm242 = _cComm242;
 
 
// *********************************************************************//
// Interface :   _cComm242
// Indicateurs : (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID :        {6E481EF2-CD76-405B-88D1-55D4394B3BF6}
// *********************************************************************//
  _cComm242 = interface(IDispatch)
    ['{6E481EF2-CD76-405B-88D1-55D4394B3BF6}']
    function Get_Response: WideString; safecall;
    procedure Set_Response(const Param1: WideString); safecall;
    function Get_Command: WideString; safecall;
    procedure Set_Command(const Param1: WideString); safecall;
    property Response: WideString read Get_Response write Set_Response;
    property Command: WideString read Get_Command write Set_Command;
  end;
 
// *********************************************************************//
// DispIntf :    _cComm242Disp
// Indicateurs : (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID :        {6E481EF2-CD76-405B-88D1-55D4394B3BF6}
// *********************************************************************//
  _cComm242Disp = dispinterface
    ['{6E481EF2-CD76-405B-88D1-55D4394B3BF6}']
    property Response: WideString dispid 1745027073;
    property Command: WideString dispid 1745027072;
  end;
 
// *********************************************************************//
// DispIntf :    __cComm242
// Indicateurs : (4240) Hidden NonExtensible Dispatchable
// GUID :        {15D72DE9-788F-47F2-A418-A120C0158788}
// *********************************************************************//
  __cComm242 = dispinterface
    ['{15D72DE9-788F-47F2-A418-A120C0158788}']
    procedure CommandEvent(var sText: WideString); dispid 1;
    procedure ResponseEvent(var sText: WideString); dispid 2;
  end;
 
// *********************************************************************//
// Interface :   _cSQS242Comm
// Indicateurs : (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID :        {9D071745-BC9C-457C-B50C-9CED78E5761E}
// *********************************************************************//
  _cSQS242Comm = interface(IDispatch)
    ['{9D071745-BC9C-457C-B50C-9CED78E5761E}']
    function Get_SQS242Comm: _cComm242; safecall;
    property SQS242Comm: _cComm242 read Get_SQS242Comm;
  end;
 
// *********************************************************************//
// DispIntf :    _cSQS242CommDisp
// Indicateurs : (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID :        {9D071745-BC9C-457C-B50C-9CED78E5761E}
// *********************************************************************//
  _cSQS242CommDisp = dispinterface
    ['{9D071745-BC9C-457C-B50C-9CED78E5761E}']
    property SQS242Comm: _cComm242 readonly dispid 1745027072;
  end;
 
// *********************************************************************//
// La classe CocSQS242Comm fournit une méthode Create et CreateRemote pour
// créer des instances de l'interface par défaut _cSQS242Comm exposée
// par la CoClasse cSQS242Comm. Les fonctions sont destinées à être utilisées par
// les clients désirant automatiser les objets CoClasse exposés par
// le serveur de cette bibliothèque de types.
// *********************************************************************//
  CocSQS242Comm = class
    class function Create: _cSQS242Comm;
    class function CreateRemote(const MachineName: string): _cSQS242Comm;
  end;
 
// *********************************************************************//
// La classe CocComm242 fournit une méthode Create et CreateRemote pour
// créer des instances de l'interface par défaut _cComm242 exposée
// par la CoClasse cComm242. Les fonctions sont destinées à être utilisées par
// les clients désirant automatiser les objets CoClasse exposés par
// le serveur de cette bibliothèque de types.
// *********************************************************************//
  CocComm242 = class
    class function Create: _cComm242;
    class function CreateRemote(const MachineName: string): _cComm242;
  end;
 
  TcComm242CommandEvent = procedure(ASender: TObject; var sText: WideString) of object;
  TcComm242ResponseEvent = procedure(ASender: TObject; var sText: WideString) of object;
 
 
// *********************************************************************//
// Déclaration de classe proxy de serveur OLE
// Objet serveur        : TcComm242
// Chaîne d'aide : 
// Interface par défaut : _cComm242
// DISP Int. Déf. ?     : No
// Interface événements : __cComm242
// TypeFlags            : (2) CanCreate
// *********************************************************************//
  TcComm242 = class(TOleServer)
  private
    FOnCommandEvent: TcComm242CommandEvent;
    FOnResponseEvent: TcComm242ResponseEvent;
    FIntf: _cComm242;
    function GetDefaultInterface: _cComm242;
  protected
    procedure InitServerData; override;
    procedure InvokeEvent(DispID: TDispID; var Params: TVariantArray); override;
    function Get_Response: WideString;
    procedure Set_Response(const Param1: WideString);
    function Get_Command: WideString;
    procedure Set_Command(const Param1: WideString);
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure Connect; override;
    procedure ConnectTo(svrIntf: _cComm242);
    procedure Disconnect; override;
    property DefaultInterface: _cComm242 read GetDefaultInterface;
    property Response: WideString read Get_Response write Set_Response;
    property Command: WideString read Get_Command write Set_Command;
  published
    property OnCommandEvent: TcComm242CommandEvent read FOnCommandEvent write FOnCommandEvent;
    property OnResponseEvent: TcComm242ResponseEvent read FOnResponseEvent write FOnResponseEvent;
  end;
 
procedure Register;
 
resourcestring
  dtlServerPage = 'ActiveX';
 
  dtlOcxPage = 'ActiveX';
 
implementation
 
uses System.Win.ComObj;
 
class function CocSQS242Comm.Create: _cSQS242Comm;
begin
  Result := CreateComObject(CLASS_cSQS242Comm) as _cSQS242Comm;
end;
 
class function CocSQS242Comm.CreateRemote(const MachineName: string): _cSQS242Comm;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_cSQS242Comm) as _cSQS242Comm;
end;
 
class function CocComm242.Create: _cComm242;
begin
  Result := CreateComObject(CLASS_cComm242) as _cComm242;
end;
 
class function CocComm242.CreateRemote(const MachineName: string): _cComm242;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_cComm242) as _cComm242;
end;
 
procedure TcComm242.InitServerData;
const
  CServerData: TServerData = (
    ClassID:   '{4217208C-3198-4688-B05A-8015294CED16}';
    IntfIID:   '{6E481EF2-CD76-405B-88D1-55D4394B3BF6}';
    EventIID:  '{15D72DE9-788F-47F2-A418-A120C0158788}';
    LicenseKey: nil;
    Version: 500);
begin
  ServerData := @CServerData;
end;
 
procedure TcComm242.Connect;
var
  punk: IUnknown;
begin
  if FIntf = nil then
  begin
    punk := GetServer;
    ConnectEvents(punk);
    Fintf:= punk as _cComm242;
  end;
end;
 
procedure TcComm242.ConnectTo(svrIntf: _cComm242);
begin
  Disconnect;
  FIntf := svrIntf;
  ConnectEvents(FIntf);
end;
 
procedure TcComm242.DisConnect;
begin
  if Fintf <> nil then
  begin
    DisconnectEvents(FIntf);
    FIntf := nil;
  end;
end;
 
function TcComm242.GetDefaultInterface: _cComm242;
begin
  if FIntf = nil then
    Connect;
  Assert(FIntf <> nil, 'DefaultInterface est NULL. Le composant n''est pas connecté au serveur. Vous devez appeler "Connect" ou "ConnectTo" avant cette opération');
  Result := FIntf;
end;
 
constructor TcComm242.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;
 
destructor TcComm242.Destroy;
begin
  inherited Destroy;
end;
 
procedure TcComm242.InvokeEvent(DispID: TDispID; var Params: TVariantArray);
begin
  case DispID of
    -1: Exit;  // DISPID_UNKNOWN
    1: if Assigned(FOnCommandEvent) then
         FOnCommandEvent(Self, WideString((TVarData(Params[0]).VPointer)^) {var WideString});
    2: if Assigned(FOnResponseEvent) then
         FOnResponseEvent(Self, WideString((TVarData(Params[0]).VPointer)^) {var WideString});
  end; {case DispID}
end;
 
function TcComm242.Get_Response: WideString;
begin
  Result := DefaultInterface.Response;
end;
 
procedure TcComm242.Set_Response(const Param1: WideString);
begin
  DefaultInterface.Response := Param1;
end;
 
function TcComm242.Get_Command: WideString;
begin
  Result := DefaultInterface.Command;
end;
 
procedure TcComm242.Set_Command(const Param1: WideString);
begin
  DefaultInterface.Command := Param1;
end;
 
procedure Register;
begin
  RegisterComponents(dtlServerPage, [TcComm242]);
end;
 
end.

Reste à savoir comment l'utiliser.
Je continue mes investigations.....mais je pense avoir touché le nerf 😉

10/12/2020, 11h24
ShaiLeTroll

Par curiosité, l'import de "EIES.Exe" n'aura pas donné aussi un résultat ... curieux que vous n'ayez pas commencé par importer cet "EIES.Exe" avant l'autre.
A voir maintenant si "EIES.Exe" et "SQS242X.exe" sont au même niveau de protocol

Tout ça est indiqué dans
SQS-242 Deposition Control Software - "5.6 Protocol"
Guardian Co-Deposition Controller - ''7.2.3.1 Query Commande Format"
Cela semble être le même protocole
10/12/2020, 11h54
franckcl

Citation:

Envoyé par ShaiLeTroll

Par curiosité, l'import de "EIES.Exe" n'aura pas donné aussi un résultat ... curieux que vous n'ayez pas commencé par importer cet "EIES.Exe" avant l'autre.

Non, impossible d'importer EIES.exe, j'ai le message d'erreur suivant: "Erreur lors du chargement de la bibliothèque/DLL du type"

Merci pour les liens sur le site du constructeur.
J'avais déjà la doc "Guardian Co-Deposition Controller - ''7.2.3.1 Query Commande Format" et c'est là que j'ai vu qu'il fallait utiliser un Active X, mais rien n'indique comment l'utiliser, c'est le problème.

Concernant la doc SQS-242 Deposition Control Software - "5.6 Protocol" c'est la doc du contrôleur lui même avec qui le soft EIES communique et je me demande si "SQS242X.exe" est la solution car ce que je veux c'est communiquer avec l'application EIES, pas avec le contrôleur.
Je sais communiquer en Ethernet avec le contrôleur, j'ai déjà fait des essais, j'ai la doc du protocole donc pas de problème de ce coté là.
J'ai aussi les spécifications de ce que fait le soft EIES à partir des données lues dans le contrôleur, et ce n'est pas simple, je ne veux pas redévelopper ce que fait le soft EIES.

Il faut dont que je trouve le moyen de communiquer avec ce soft pour récupérer les données qui sont déjà interprêtées mais là je sèche à nouveau.
10/12/2020, 12h12
ShaiLeTroll

Citation:

Envoyé par franckcl

Il faut dont que je trouve le moyen de communiquer avec ce soft pour récupérer les données qui sont déjà interprêtées mais là je sèche à nouveau.

Là, il semble simplement suffire d'envoyer une demande au fabricant comme vous l'avez fait pour l'application VB
Voir avec eux, si il y a un enregistrement à faire, la démo EIES_COMM.exe fonctionne au moins ?
Faudrait qu'il vous donne le GUID pour que vous puissiez trouver l'ActiveX et l'importer (fouiller la base de registre pour le trouver dedans)
Un fichier .TLB pourrait aussi aider à l'intégration ...

Je n'ai pas fait d'ActiveX depuis longtemps, est-ce que Delphi ne voit que les ActiveX 32Bits pour l'import ?
Depuis Delphi, tu as essayé l'import d'une bibliothèques et d'un ActiveX, va savoir dans quelle listes il est réellement recensé
Est-ce que EIES.exe est 32Bits ou 64Bits, son activeX est-il In-Process(DLL) ou Out-Process(Exe)

Il y a clairement dans la documentation un flou pour identifier l'ActiveX

Oui la doc n'est pas claire du tout et j'aimerais bien avoir une réponse de leur part...mais j'ai l'impression que ce soft n'a pas été développé par eux, peut être par une société qu'ils ont rachetée (Sigma instruments)
Ce soft date de 2011 ! et il est probable qu'ils n'ont plus les sources...enfin c'est bizarre que ce soft n'ait pas évolué depuis.

Et oui EIES_COMM fonctionne très bien en mode ActiveX (le protocole est configurable depuis l'interface).

Mais je me dis qu'il est peut être probable que l'EIES_COMM utilise le "SQS242X.exe"

J'ai donc essayé ceci:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 uses SQS242X_TLB; //------------------------------------------------------------------------------------------------------------------------------ procedure TForm3.BtnConnectClick(Sender: TObject); var Comm242 : TcComm242; begin Comm242 := TcComm242.Create(self); Comm242.Connect; Comm242.free; end; //------------------------------------------------------------------------------------------------------------------------------
Mais j'ai une exception avec le message "EOLEsysError 'Classe non enregistrée'"
J'ai vu qu'il y avait une procedure "Register" mais quand je l'appelle j'ai le message: "Invalid component registration"
Pendant ces tests, l'application EIES est bien en cours d'execution.
et moi non plus je ne maitrise pas les Active X.

10/12/2020, 12h30
franckcl

Je pense effectivement que ces logiciels utilisent SQS242X.exe car je le vois dans le gestionnaire des tâches de Windows.
Dès que je lance EIES.exe, cette tache apparait dans le gestionnaire de tâches.
Si je tue la tache et que je lance EIES_COMM, je n'arrive plus à communiquer avec.
Je constate que EIES_COMM lance aussi cette tache mais ça ne marche pas pour autant.
Pour que ça marche, il faut lancer EIES (qui lance SQS242X.exe) puis EIES_COMM ou dans l'autre sens, ça marche aussi. Mais il ne faut pas tuer la tache SQS242X.exe entre les deux lancements.

Il faut donc que j'arrive à utiliser cet Active X
10/12/2020, 13h51
ShaiLeTroll

Register c'est pour la palette si tu l'installe via un DPK
Tu es bien en 32Bits pour qu'il accède à la base de registre 32bits qui contient le ClassID associé au GUID ?

Si EIES.exe est lancé, essaye de voir aussi un GetActiveObject qui te retournera une Intf que tu casteras en _cComm242
tu partageras ainsi l'instance existante, je l'ai fait ainsi entre un Exe Delphi qui lançait un script PHP, ce dernier utilisait GetActiveObject pour dialoguer avec l'Exe Delphi (en plus des pipes)

Oui je compile bien en 32 bits.

Pour GetActiveObject il me faut le GUID de l'application mais je ne sais pas comment l'obtenir.

J'ai essayé ceci (repris d'un exemple pour word):

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
procedure TForm3.Button3Click(Sender: TObject);
var
    clsid: TCLSID;
    sCLSID: string;
    result: hResult;
begin
  CoInitialize(nil);
  result := CLSIDFromProgID('EIES.Application', clsid);  // exemple avec word:Word.Appplication
  sCLSID := GUIDToString(clsid);
  try
        OleCheck(result);
        ShowMessage('Class Word.recognized with CLSID ' + sCLSID);
  except
        on e: EOleSysError do
        begin
            ShowMessage('Class not recognized CLSID ' + sCLSID);
        end;
  end;
  CoUninitialize;
end;

Mais OleCheck retourne le message 'Chaine de classe incorrecte'

J'ai ensuite essayé ceci (j'ai récupéré le TGUID dans l'unité importé du SQS242X:

Code:

1
2
3
4
5
6
7
8
 
const  CLASS_cComm242: TGUID = '{4217208C-3198-4688-B05A-8015294CED16}';
procedure TForm3.Button2Click(Sender: TObject);
Var
  Unknown: IUnknown;
begin
 if GetActiveObject(CLASS_cComm242,nil,Unknown)=S_OK then ShowMessage('OK') else ShowMessage('NOK');
end;

Mais il m'affiche NOK

10/12/2020, 17h49
ShaiLeTroll

Pour Word, j'utilise System.Win.ComObj.GetActiveOleObject

Ce n'est qu'une supposition, si l'instance est enregistrée, tout dépend ce qu'a prévu l'auteur car gérer une interaction entre deux instances du même objet COM ça peut être vite compliqué alors qu'utiliser une instance unique est plus simple
Evidemment avec EIES.exe lancé et SQS242X.exe lancé ...

Pour le nom de la classe, on serait plus dans un truc genre 'SQS242X.cComm242' ou 'SQS242X.cSQS242Comm" mais vérifier en base de registre reste nécessaire tant que tu n'as pas plus d'information
Tout ces GUID, tu dois les trouver dans "HKEY_CLASSES_ROOT\CLSID" (64Bits) ou "HKEY_CLASSES_ROOT\Wow6432Node\CLSID" (32Bits)

J'attendrais que le support fabricant te fournisses un code, perso, je fais tous mes validations de mes propres objets COM via VBS (script pas VB), et c'est facile à traduire en Delphi ensuite

1 pièce(s) jointe(s)

J'ai toujours le message "'Classe non enregistrée" mais je persiste et signe.....
Voilà où j'en suis: ils m'ont envoyé les sources du programme de test en VB mais ils n'ont aucune explication à me donner, pas de doc, rien, je pense que le gars qui a développé ça n'est plus chez eux...et ils ne maitrisent rien.
Voici en pièce jointe les sources VB ici: Pièce jointe 586656

Je n'ai pas VB mais j'ai regardé dans le fichier EIES.Comm.frm, et j'ai extrait ici que le code:

Code:

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
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "tabctl32.ocx"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
 
Dim ParamNum(0 To 5) As Integer
Dim EthernetConnected
 
Private WithEvents CommEvent As cComm242
Attribute CommEvent.VB_VarHelpID = -1
 
Private Sub Command1_Click()
 
End Sub
 
Private Sub cmdHelp_Click()
 
    Dim MsgTxt As String
 
 
    MsgTxt = "This program will help you understand communications with the EIES program." & vbCrLf
    MsgTxt = MsgTxt & "Consult the communications section of the EIES User Guide for detailed information." & vbCrLf & vbCrLf
    MsgTxt = MsgTxt & "First, setup your communications on the Utility tab." & vbCrLf & vbCrLf
    MsgTxt = MsgTxt & "Select Query to read or Update to set values in the EIES program." & vbCrLf
    MsgTxt = MsgTxt & "Select a parameter on the tabbed dialog.  If Update is selected, enter a parameter value." & vbCrLf
    MsgTxt = MsgTxt & "Press Send to send the Query or Update to the EIES program." & vbCrLf & vbCrLf
    MsgTxt = MsgTxt & "The  strings sent to and received from the EIES program are shown below."
 
    MsgBox MsgTxt, , "EIES Comm Help"
 
End Sub
 
Private Sub CommEvent_ResponseEvent(sText As String)
 
    Dim strData As String
 
    strData = sText
 
    Do While Len(strData) > 0
        RcvMessage Left$(strData, 1)
        strData = Right$(strData, Len(strData) - 1)
    Loop
 
End Sub
 
Private Sub Form_Load()
 
    Dim i As Integer
 
    ' In case SQS242 Comm not loaded
    On Error Resume Next
 
    Set CommEvent = SQS242Comm
 
    Me.Caption = " " & Me.Caption & " - V" & App.Major & "." & App.Minor & App.Revision
 
    For i = 0 To 99
        cboLayer.AddItem i
    Next i
 
    cboOutput.Clear
    cboPower.Clear
    For i = 1 To 8
        cboOutput.AddItem i
        cboPower.AddItem i
    Next i
    cboPower.AddItem "All"
    cboOutput.ListIndex = 0
    cboPower.ListIndex = 0
    cboLayer.ListIndex = 0
    cboSensor.ListIndex = 0
 
    cboOutputRdg.ListIndex = 0
    cboSensorRdg.ListIndex = 0
 
    optMode(0) = True
    optQueryProcess(0) = True
    optMeasure(10) = True
    OptLayer(0) = True
    optFilm(0) = True
    optFilm(30) = True
    optUtility(0) = True
    optSensor(0) = True
 
    tabMain.Tab = 0
 
    ' Read last comm setup (changed opt indexes, so a little remapping needed for backward compatibility)
    cboPort.ListIndex = CInt(GetSetting(App.Title, "Comm Settings", "Port", "0"))
    If cboPort.ListIndex < 0 Then cboPort.ListIndex = 0
    cboBaud.ListIndex = CInt(GetSetting(App.Title, "Comm Settings", "Baud Rate", "0"))
    If cboBaud.ListIndex < 0 Then cboBaud.ListIndex = 0
    txtServer.Text = GetSetting(App.Title, "Comm Settings", "Ethernet Server", "")
    txtPort.Text = GetSetting(App.Title, "Comm Settings", "Ethernet Port", "")
    Select Case CInt(GetSetting(App.Title, "Comm Settings", "Comm Select", "3"))
    Case 0, 1
        'RS232
        optComm(0).Value = True
    Case 2
        'Ethernet
        optComm(2).Value = True
    Case 3
        'ActiveX
        optComm(3).Value = True
    End Select
 
End Sub
 
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
 
    Dim i As Integer
 
    For i = 0 To 3
        If i <> 1 Then
            If optComm(i).Value = True Then
                SaveSetting App.Title, "Comm Settings", "Comm Select", CStr(i)
                Exit For
            End If
        End If
    Next i
 
    SaveSetting App.Title, "Comm Settings", "Port", cboPort.ListIndex
    SaveSetting App.Title, "Comm Settings", "Baud Rate", cboBaud.ListIndex
    SaveSetting App.Title, "Comm Settings", "Ethernet Server", txtServer
    SaveSetting App.Title, "Comm Settings", "Ethernet Port", txtPort
 
    If tcpMain.State = sckConnected Then
        tcpMain.Close
    End If
 
End Sub
 
Private Sub cmdSend_Click()
 
    ' Adds CRC and ships it out the comm  or ethernet port
 
    On Error Resume Next
 
    Dim MsgString As String
 
    If optMode(0) Then
        Select Case tabMain.Tab
        Case 0
            MsgString = QueryProcess
        Case 1      ' Process
            MsgString = QueryMeasurement
        Case 2
            MsgString = QueryLayer
        Case 3
            MsgString = QueryFilm
        Case 4
            MsgString = QueryFilm
        Case 5
            MsgString = QuerySensor
        Case 6
            MsgString = QueryUtility
        End Select
    Else
        Select Case tabMain.Tab
        Case 0
            MsgString = UpdateProcess
        Case 1
            'MsgString = UpdateMeasurement
        Case 2
            MsgString = UpdateLayer
        Case 3
            MsgString = UpdateFilm
        Case 4
            MsgString = UpdateFilm
        Case 5
            MsgString = UpdateSensor
        Case 6
            MsgString = UpdateUtility
        End Select
    End If
 
    ' Add the checksum to message and ship it
    If chkChecksum.Value = vbChecked Then
        MsgString = MsgString & ";" & CalcChkSum(MsgString & ";") & Chr$(13)
    Else
        MsgString = MsgString & ";" & "00" & Chr$(13)
    End If
 
    ' Clear receive, and show transmit text boxes
    If Len(MsgString) > 0 Then
        txtSent = Left$(MsgString, Len(MsgString) - 1)
    Else
        txtSent = ""
    End If
    txtResponse = ""
 
    ' Ship it danno
    Select Case True
    Case optComm(0)
        With MSComm1
            .PortOpen = True
            If .PortOpen Then
                 ' Clear the receive buffer
                 .InBufferCount = 0
                 .Output = MsgString
                 ' Set Tx Timeout timer
            Else
                 ' Trying to send with comm port closed
                 ' Catch this case during development
                 Debug.Assert False
            End If
        End With
    Case optComm(2)
        ' Ethernet selected, be sure we are connected
        With tcpMain
            If .State = sckConnected _
                    And .RemoteHost = txtServer _
                        And .RemotePort = CInt(Val(txtPort.Text)) Then
                .SendData MsgString
            Else
                .Close
                .LocalPort = 0
                .RemoteHost = txtServer
                .RemotePort = CInt(Val(txtPort.Text))
                .Connect
                TimeWait 1
                .SendData MsgString
            End If
        End With
    Case optComm(3)
        SQS242Comm.Command = MsgString
    End Select
 
End Sub
 
Private Sub RcvMessage(RcvChar As String)
 
    Static MsgString As String
    Dim NakErr As String
 
    Select Case RcvChar
    Case "@"
        MsgString = RcvChar
    Case Chr$(13)
        Select Case Mid$(MsgString, 5, 1)
        Case Chr$(6)
            txtResponse = Left$(MsgString, 4) _
                & "ACK" & Right$(MsgString, Len(MsgString) - 5)
        Case Chr$(21)
            Select Case Mid$(MsgString, 7, 2)
            Case "01"
                NakErr = "CMD"
            Case "02"
                NakErr = "PRM"
            Case "03"
                NakErr = "FMT"
            Case "04"
                NakErr = "CHK"
            Case "05"
                NakErr = "REQ"
            Case "06"
                NakErr = "UNK"
            Case "07"
                NakErr = "TMO"
            End Select
            txtResponse = Left$(MsgString, 4) _
                & "NAK" & ";" & NakErr _
                    & Right$(MsgString, Len(MsgString) - 8)
        Case Else
            txtResponse = MsgString
        End Select
    Case Else
        MsgString = MsgString & RcvChar
    End Select
 
End Sub
 
Private Sub optSensor_Click(Index As Integer)
 
  ParamNum(1) = Index + 1
 
End Sub
 
Private Sub tabMain_Click(PreviousTab As Integer)
 
    Select Case tabMain.Tab
    Case 1
        optMode(0) = True
        optMode(1).Enabled = False
    Case Else
        optMode(1).Enabled = True
    End Select
 
End Sub
 
Private Sub tcpMain_DataArrival(ByVal bytesTotal As Long)
 
    Dim strData As String
 
    tcpMain.GetData strData
 
    Do While Len(strData) > 0
        RcvMessage Left$(strData, 1)
        strData = Right$(strData, Len(strData) - 1)
    Loop
 
End Sub
 
Private Sub MSComm1_OnComm()
 
    With MSComm1
 
        Select Case .CommEvent
        Case comEvReceive
            Do While .InBufferCount > 0
                RcvMessage Chr$(AscB(.Input))
            Loop
        End Select
 
    End With
 
End Sub
 
Private Sub cboBaud_Click()
 
    MSComm1.Settings = cboBaud.Text & "n,8,1"
 
End Sub
 
Private Sub cboPort_Click()
 
    If optComm(0) = True Then
        MSComm1.CommPort = cboPort.ListIndex + 1
    End If
 
End Sub
 
Private Sub optComm_Click(Index As Integer)
 
    On Error Resume Next
 
    Select Case Index
    Case 0, 1
        ' Setup Comm port
        With MSComm1
            .CommPort = cboPort.ItemData(cboPort.ListIndex)
            .Handshaking = comNone
            .InBufferSize = 1024
            .NullDiscard = False
            .RTSEnable = False
            .InputMode = comInputModeBinary
            .InputLen = 1
            .RThreshold = 1
            .SThreshold = 0
        End With
        tcpMain.Close
    Case 2
        MSComm1.PortOpen = False
    Case 3
        MSComm1.PortOpen = False
        tcpMain.Close
    End Select
 
End Sub
 
Private Sub optFilm_Click(Index As Integer)
 
    Select Case Index
    Case Is < 6, 12 To 22
        ParamNum(3) = Index + 1
    Case Else
        ParamNum(4) = Index + 1
    End Select
 
End Sub
 
Private Sub optMeasure_Click(Index As Integer)
 
    ParamNum(1) = Index + 1
 
End Sub
 
Private Sub optQueryProcess_Click(Index As Integer)
 
    ParamNum(0) = Index + 1
 
End Sub
 
Private Sub optUtility_Click(Index As Integer)
 
    ParamNum(5) = Index + 1
 
End Sub
 
Private Sub optUpdateProcess_Click(Index As Integer)
 
    ParamNum(0) = Index + 1
 
End Sub
 
Private Sub optLayer_Click(Index As Integer)
 
    ParamNum(2) = Index + 1
 
End Sub
 
Private Sub optMode_Click(Index As Integer)
 
    Dim i As Integer
 
    Select Case Index
    Case 0
        ' Query Mode
        optUpdateProcess(1).Enabled = False
        optUpdateProcess(2).Enabled = False
        optUpdateProcess(5).Enabled = False
        optUpdateProcess(7).Enabled = False
        optUpdateProcess(50).Enabled = False
        optUpdateProcess(60).Enabled = False
        For i = 1 To 7
            optQueryProcess(i).Enabled = True
        Next i
        optQueryProcess(8).Enabled = True
        optQueryProcess(10).Enabled = True
        optQueryProcess(20).Enabled = True
        ' Measurements
        Frame6.Enabled = True
        'Layer
        OptLayer(0).Enabled = True
        OptLayer(1).Enabled = True
        ' Utility
        For i = 10 To 12
            optUtility(i).Enabled = True
        Next i
        txtUpdate.Visible = False
        lblUpdate.Visible = False
    Case 1
        ' Disable process inappropriate updates
        optUpdateProcess(1).Enabled = True
        optUpdateProcess(2).Enabled = True
        optUpdateProcess(5).Enabled = True
        optUpdateProcess(7).Enabled = True
        optUpdateProcess(50).Enabled = True
        optUpdateProcess(60).Enabled = True
        For i = 1 To 7
            optQueryProcess(i).Enabled = False
        Next i
        optQueryProcess(6).Enabled = True
        optQueryProcess(8).Enabled = False
        optQueryProcess(10).Enabled = False
        optQueryProcess(20).Enabled = False
        ' Measurements
        Frame6.Enabled = False
        ' Layer
        OptLayer(0).Enabled = False
        OptLayer(1).Enabled = False
        'Utility
        For i = 10 To 12
            optUtility(i).Enabled = False
        Next i
        txtUpdate.Visible = True
        lblUpdate.Visible = True
    End Select
 
End Sub
 
Private Function CalcChkSum(ByRef Message As String) As String
 
    ' Calcultes the FCS checksum of a string of characters.
    ' Received messages must be stripped of their terminator charaters
    ' before passing to this routine.
 
    Dim i As Integer
    Dim FCS As Integer
 
    ' XOR ASCII codes
    For i = 1 To Len(Message)
        FCS = Asc(Mid$(Message, i, 1)) Xor FCS
    Next i
 
    ' Conver to two character hex string
    If Len(Hex$(FCS)) = 1 Then
        CalcChkSum = "0" & Hex$(FCS)
    Else
        CalcChkSum = Hex$(FCS)
    End If
 
End Function
 
Private Function QueryProcess() As String
 
    Select Case ParamNum(0)
    Case 1 To 10, 30 To 39, 71 To 74
        QueryProcess = "@QP;0" & CStr(ParamNum(0))
    Case 11 To 16
        QueryProcess = "@QP;" & CStr(ParamNum(0) + cboPower.ListIndex)
    Case 21 To 28
        QueryProcess = "@QP;" & CStr(ParamNum(0) + cboPower.ListIndex)
    Case 41 To 48
        QueryProcess = "@QP;" & CStr(ParamNum(0) + cboPower.ListIndex)
    End Select
 
End Function
 
Private Function UpdateProcess() As String
 
    ' Use Query as basis so only one routine is required
 
    Select Case ParamNum(0)
    Case 0 To 10, 36, 37, 38, 71 To 74
        UpdateProcess = "@U" _
            & Right$(QueryProcess, Len(QueryProcess) - 2) _
                & ";" & txtUpdate
    Case 11     ' Set Layer
        UpdateProcess = "@UP;" & CStr(ParamNum(0)) & ";" & txtUpdate
    Case 30
        If txtUpdate = "1" Then
            UpdateProcess = "@UP;31"
        Else
            UpdateProcess = "@UP;30"
        End If
    Case 32
        If txtUpdate = "1" Then
            UpdateProcess = "@UP;33"
        Else
            UpdateProcess = "@UP;32"
        End If
    Case 34
        If txtUpdate = "1" Then
            UpdateProcess = "@UP;35"
        Else
            UpdateProcess = "@UP;34"
        End If
    Case 41
        UpdateProcess = "@UP;" & CStr(ParamNum(0) + CInt(cboPower.ListIndex)) & ";" & txtUpdate
    Case 51
        UpdateProcess = "@UP;" & CStr(ParamNum(0) + CInt(cboPower.ListIndex)) & ";" & txtUpdate
    Case 61
        UpdateProcess = "@UP;" & CStr(ParamNum(0) + CInt(cboPower.ListIndex)) & ";" & txtUpdate
    End Select
 
End Function
 
Private Function QueryMeasurement() As String
 
    Select Case ParamNum(1)
    Case 1 To 2
        Select Case cboSensorRdg.ListIndex
        Case 0
            ' Emission current
            QueryMeasurement = "@QM;5" & CStr(ParamNum(1))
        Case 1
            ' Leakage Current
            QueryMeasurement = "@QM;5" & CStr(ParamNum(1) + 4)
        Case 2
            ' Power
            QueryMeasurement = "@QM;6" & CStr(ParamNum(1))
        Case 3
            ' Status
            QueryMeasurement = "@QM;6" & CStr(ParamNum(1) + 4)
        Case 4
            ' Filament Current
            QueryMeasurement = "@QM;7" & CStr(ParamNum(1))
        Case 5
            ' Bias voltage
            QueryMeasurement = "@QM;7" & CStr(ParamNum(1) + 4)
        End Select
    Case 11 To 18
        QueryMeasurement = "@QM;" & CStr((10 * cboOutputRdg.ListIndex) + ParamNum(1))
    End Select
 
End Function
 
Private Function QueryLayer() As String
 
    Select Case ParamNum(2)
    Case 1
        QueryLayer = "@QL;0" & CStr(ParamNum(2)) & ";" _
            & (cboLayer.ListIndex) & ";" _
                & (cboOutput.ListIndex)
    Case 2
        ' Material is a film parameter, but clearer on this tab
        QueryLayer = "@QF;0" & CStr(28) & ";" _
            & (cboLayer.ListIndex) & ";" _
                & (cboOutput.ListIndex)
    Case 3 To 9
        ' Subtract one from paramnum because of material
        QueryLayer = "@QL;0" & CStr(ParamNum(2) - 1) & ";" _
            & (cboLayer.ListIndex) & ";" _
                & (cboOutput.ListIndex)
    Case 40, 42 To 46
        QueryLayer = "@QL;" & CStr(ParamNum(2)) & ";" _
            & (cboLayer.ListIndex) & ";" _
                & (cboOutput.ListIndex)
    Case 41
        ' Layer Index
    Case 47
        ' Source Index Done
    Case 48
        'Layer Index Done
    Case Else
        QueryLayer = "@QL;" & CStr(ParamNum(2)) & ";" _
                & (cboLayer.ListIndex) & ";" _
                    & (cboOutput.ListIndex)
    End Select
 
End Function
 
Private Function UpdateLayer() As String
 
    UpdateLayer = "@U" _
        & Right$(QueryLayer, Len(QueryLayer) - 2) _
            & ";" & txtUpdate
 
End Function
 
Private Function QueryFilm() As String
 
    Select Case tabMain.Tab
    Case 3
        Select Case ParamNum(3)
        Case 1 To 9
            QueryFilm = "@QF;0" & CStr(ParamNum(3)) & ";" _
                & (cboLayer.ListIndex) & ";" _
                    & (cboOutput.ListIndex)
        Case 10 To 41
            QueryFilm = "@QF;" & CStr(ParamNum(3)) & ";" _
                & (cboLayer.ListIndex) & ";" _
                    & (cboOutput.ListIndex)
        End Select
    Case 4
        Select Case ParamNum(4)
        Case 1 To 9
            QueryFilm = "@QF;0" & CStr(ParamNum(4)) & ";" _
                & (cboLayer.ListIndex) & ";" _
                    & (cboOutput.ListIndex)
        Case 10 To 41
            QueryFilm = "@QF;" & CStr(ParamNum(4)) & ";" _
                & (cboLayer.ListIndex) & ";" _
                    & (cboOutput.ListIndex)
        End Select
    End Select
 
End Function
 
Private Function UpdateFilm() As String
 
    UpdateFilm = "@U" _
        & Right$(QueryFilm, Len(QueryFilm) - 2) _
            & ";" & txtUpdate
 
End Function
 
Private Function QueryUtility() As String
 
    ' This function requires an index because of the set Full Scale command
    ' so send a dummy index for 1 to 7, and 11 to 14
 
    Select Case ParamNum(5)
    Case 1 To 7, 11 To 14
        QueryUtility = "@QU;0" & CStr(ParamNum(5))
    Case 16
        ' Any string
        QueryUtility = txtString
    End Select
 
End Function
 
Private Function UpdateUtility() As String
 
    Dim FPValue As Integer
    Dim i As Integer
 
    Select Case ParamNum(5)
    Case 6
        For i = 0 To 10
            If chkFP(i).Value = vbChecked Then
                FPValue = FPValue + (2 ^ i)
            End If
        Next i
        UpdateUtility = "@U" _
            & Right$(QueryUtility, Len(QueryUtility) - 2) _
                & ";" & CStr(FPValue)
    Case 1 To 5, 7, 11 To 14
        UpdateUtility = "@U" _
            & Right$(QueryUtility, Len(QueryUtility) - 2) _
                & ";" & txtUpdate
    End Select
 
End Function
 
Private Function QuerySensor() As String
 
    Select Case cboSensor.ListIndex
    Case 0
        ' Emission On/Off
        QuerySensor = "@QS;0" & CStr((2 * (ParamNum(1) - 1)) + 1)
    Case 1
        ' Emission SetPt
        QuerySensor = "@QS;1" & CStr(ParamNum(1))
    Case 2
        ' Max. leakage
        QuerySensor = "@QS;2" & CStr(ParamNum(1))
    Case 3
        ' Gas Cal
        QuerySensor = "@QS;3" & CStr(ParamNum(1))
    End Select
 
End Function
 
Private Function UpdateSensor() As String
 
 
    Select Case cboSensor.ListIndex
    Case 0
        ' Emission on/off
        If txtUpdate = "1" Then
            ' On
            UpdateSensor = "@US;0" & CStr(2 * ParamNum(1))
        Else
            ' Off
            UpdateSensor = "@US;0" & CStr((2 * ParamNum(1)) - 1)
        End If
    Case 1
        ' Emission Setpt
        UpdateSensor = "@US;1" & CStr(ParamNum(1)) & ";" & txtUpdate
    Case 2
        ' Max Leakage
        UpdateSensor = "@US;2" & CStr(ParamNum(1)) & ";" & txtUpdate
    Case 2
        ' Gas Cal
        UpdateSensor = "@US;3" & CStr(ParamNum(1)) & ";" & txtUpdate
    End Select
 
End Function
 
 
Public Sub TimeWait(ByVal nValue As Integer)
 
    ' Delay nValue seconds
 
    Dim WaitTimer As Long
 
    DoEvents
    WaitTimer = Timer
    Do While Timer - WaitTimer < nValue
        If Timer < WaitTimer Then WaitTimer = Timer - WaitTimer + 86400
        DoEvents
    Loop
 
End Sub

J'ai réussi a ajouter le composant TcComm242 dans la palette en faisant ceci:
- Menu Fichier /Nouveau / Package delphi, cible en 32 bits
- Renommer le projet depuis la liste des projets puis enregistrer sous ActiveX.bpl
- De mettre en release
- Menu Composant / Importer un composant / Importer une bibliotheque de types / Sigma instruments SQS242 ActiveX Interface / Page de palette = ActiveX / Ajouter une unité au projet ActiveX.dproj / [Oui] pour activer le framework.
- Click droit sur le projet / Installer

J'ai créé un projet qui utilise ce composant comme ceci:
- Creer un nouveau projet VCL et déposer le composant TcComm242 depuis la palette (catégorie ActiveX) sur la fiche.
- Ajouter un bouton et rentrer ce code:

Code:

1
2
3
4
5
 
procedure TForm3.BtnConnectClick(Sender: TObject);
begin
  cComm2421.Connect;
end;

A l'execution, j'ai le message suivant qui s'affiche
"Le projet a déclenché la classe d'exception EOleSysError avec le message 'Classe non enregistrée'."

Donc j'en suis au même point, je n'arrive pas à enregistrer cette classe ?
Comment fait-on pour enregistrer un classe ?
J'ai simplement essayé ceci:

Code:

1
2
 
  Classes.RegisterClass(TcComm242);

Mais ça change rien.

15/12/2020, 11h37
ShaiLeTroll
RegisterClass, grossièrement résumé, c'est pour les éléments d'une DFM

Là c'est l'enregistrement par System32\RegSvr32 et System32\SysWow64\regsvr32.exe

Comme je l'ai déjà mentionné, cherche les différents GUID en BDR, tu dois les trouver dans "HKEY_CLASSES_ROOT\CLSID" (64Bits) ou "HKEY_CLASSES_ROOT\Wow6432Node\CLSID" (32Bits)
Comment Delphi pourrait importer l'objet "Sigma instruments SQS242 ActiveX Interface" si il n'est pas enregistré :roll:
D'ailleurs, "EIES Comm.exe", il fonctionne donc c'est qu'il trouve donc l'objet, c'est qu'il est enregistré (supposant que EIES fourni les redistribuables VB requis)

En Debug, ce code déclenche-t il une assertion ?
Code:

1 2 3 4 procedure TForm3.BtnConnectClick(Sender: TObject); begin cComm2421.Command = 'toto'; end;
il y aussi la propriété AutoConnect, surement à False, surement pas mieux en la passant à True (l'Exception aura juste lieu plus tôt avant même le click sur le bouton)

Qu'affiche ceci ?
Code:

1 2 3 4 procedure TForm3.BtnConnectClick(Sender: TObject); begin ShowMessage(IntToStr(SizeOf(cComm2421))); end;

J'ajouterais une autre méthode de chargement
Code:

1 2 3 4 5 6 procedure TForm3.BtnConnectClick(Sender: TObject); begin ShowMessage(IntToStr(NativeInt(CocSQS242Comm.Create()))); ShowMessage(IntToStr(NativeInt(CocSQS242Comm.Create().SQS242Comm))); CocSQS242Comm.Create().SQS242Comm.Command := 'toto'; end;
Et encore, il nous reste encore le LateBinding (il me semble que VB ne fait que du LateBinding)
Pour ça, trouver le nom de la classe exacte en BDR est nécessaire peut-être juste 'SQS242Comm' ou 'SQS242X.cSQS242Comm'

Oui le fait d'assigner le propriété "command" provoque le message d'erreur:
"Le projet a déclenché la classe d'eception EOleSysErrir avec le message 'Classe non enregistrée, ClassID: {4217208C-3198-4688-B05A-8015294CED16}'

L'exception se trouve dans la fonction CreateComObject de l'unité System.Win.ComObj

Dans la base de registre, une recherche sur "SQS242" donne ceci :
HKEY_CLASSES_ROOT\WOW6432Node\CLSID\{4217208C-3198-4688-B05A-8015294CED16}\ProgID et en donnée il y a: "SQS242X.cComm242"

Je retrouve bien ce GUID dans l'unité SQS242X_TLB :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 procedure TcComm242.InitServerData; const CServerData: TServerData = ( ClassID: '{4217208C-3198-4688-B05A-8015294CED16}'; IntfIID: '{6E481EF2-CD76-405B-88D1-55D4394B3BF6}'; EventIID: '{15D72DE9-788F-47F2-A418-A120C0158788}'; LicenseKey: nil; Version: 500); begin ServerData := @CServerData; end;
Je viens d'essayer le code
Code:

1 2 3 4 5 6 7 8 procedure TForm3.BtnConnectClick(Sender: TObject); begin // cComm2421.Connect; ShowMessage(IntToStr(NativeInt(CocSQS242Comm.Create()))); ShowMessage(IntToStr(NativeInt(CocSQS242Comm.Create().SQS242Comm))); CocSQS242Comm.Create().SQS242Comm.Command := 'toto'; end;
J'ai les messages suivants:
- 21627476
- puis 21012660
Aucun message d'erreur

15/12/2020, 12h04
franckcl

et rien non plus dans les évènements OnResponsEvent et OnCommandEvent. Ils ne sont pas appellés
En revanche si je fais cComm2421.Command:='@QM;21;00'; j'ai la même exception que précédemment.

Si CocSQS242Comm.Create().SQS242Comm retourne un _cComm242 valide on peut donc essayer ceci
Code:

1 2 3 4 5 procedure TForm3.BtnConnectClick(Sender: TObject); begin cComm2421.ConnectTo(CocSQS242Comm.Create().SQS242Comm); // faut une Interface _cComm242 en paramètre, peut importe la façon de la créer cComm2421.Command := '@QM;21;00'; end;
Mais cela me fait penser que "_cSQS242Comm" est la classe enregistrée qui sert de factory à une instance de "_cComm242"
On ne peut pas instancier directement une "_cComm242" qui doit être instanciée par l'activeX (SQS242X.exe) que l'on récupère via "_cSQS242Comm"

16/12/2020, 09h45
franckcl

Ca marche !
ShaiLeTroll, je ne sais comment te remercier.
ll y a des gens dont les compétences m'étonnent et tu en fais partie.
Bravo et merci pour l'investissement que tu fais dans ce forum.
16/12/2020, 10h25
ShaiLeTroll

Je me suis battu avec des ActiveX VB dès ma 3ème année d'apprentissage, c'était il y a longtemps

J'ai bcp appris quand j'ai fait mon dernier COM, il y a bien 10 ans.
J'ai maintenu du DCOM mais sans vraiment devoir m'y intéresser (surtout que cela a été traduit en DataSnap)
Je me dis que cela fait longtemps que je n'en ai pas fait ... et je constate que la technique du tâtonnement pour trouver la bonne CoClasse fonctionne encore :ptdr::mouarf: