RÉCUPÉREZ VOS OBJETS VIA GETOBJECT ROT, RegisterActiveObject, RevokeActiveObject, GetObject, Source N°45432

Information sur la source

Catégorie :Système Classé sous : ROT, RegisterActiveObject, RevokeActiveObject, GetObject Niveau : Débutant Date de création : 15/01/2008 Vu / téléchargé: 3 069 / 131

Auteur : Renfield

Ecrire un message privé

Ce membre participe au partage de revenus publicitaires

Note :
Aucune note

Commentaire sur cette source (3)

Ajouter un commentaire et/ou une note

Description

Cliquez pour voir la capture en taille normale

Encore et toujours un titre pas très clair... pardonnez moi.
J'avoue que je ne voyais pas trop quoi écrire.

Vous connaissez tous l'instruction GetObject, non ?
... non ? Certains ignorent à quoi sert cette instruction VB ?

Rien de dramatique, nous allons reprendre un peu la partie théorique.

Certains Exe, comme par exemple Excel sont en réalité des Exe ActiveX...
Pas très utile de savoir cela, en ces termes.
Un Exe ActiveX est en gros un exe qui exporte des objets COM, tout comme le ferait une Dll ActiveX toute bête...

l'Exe ActiveX a pourtant un avantage qui est de tourner dans son propre process...
Il est donc par ce biais possible de faire du multithread en VB6 (faire tourner plusieurs traitements en parallèle).

Vous avez tous sûrement vu du code qui ressemblait à cela :

Set oExcel = CreateObject("Excel.Application")

Ici, nous créons une nouvelle instance d'un objet étiquetté Excel.Application (il s'agit du CLSID de l'objet en question...)

Pourtant, plutôt que de créer une nouvelle instance, nous pourrions nous greffer sur une instance existante (dite instance active) de notre objet, a supposer qu'une telle instance ait été créée...
Outre le fait de manipuler un objet commun, cette petite astuce est utile avec Excel, pour obtenir plus rapidement un objet Excel.Application.

Nous pouvons par exemple faire :
    On Local Error Resume Next
    Set oExcel = GetObject(,"Excel.Application")
    If Nothing Is oExcel Then
        Set oExcel = CreateObject("Excel.Application")
    End If

pour récupérer une instance de Excel (on en créé une nouvelle si besoin)

- A quoi cela peut il servir ?

Dans un précédent job, nous avions entièrement séparé l'appli pour constituer un Exe ActiveX avec le noyau du de l'application, et une barre d'outil toute bête pour l'interface. l'interface ne faisait rien... elle ne pouvait pas crasher.
le noyau, lui, c'etait une autre histoire. mais les crashes de ce dernier passaient inapercus, vu que l'interface ne crashait pas... il suffisait alors de relancer un noyau et de restaurer la session de travail.
le tout est a piloter via des objets COM, on a donc accès aux evenements, propriétés, méthodes... tout ce qu'il faut pour établir une communication efficace, quoi.

- très bien, mais quel rapport avec la présente source ?

Bonne question, merci de l'avoir posée.
en fait, VB6 vous permet de créer des Exe ActiveX. Il sera donc possible de faire joujou avec du MultiThread.
MAIS, GetObject (attention a la syntaxe de l'appel, il y a bien une virgule qui traine) sert a retrouver les instances des objets enregistrés dans la ROT (Running Object Tables)
ce petit module fournis simplement deux fonctions pour ajouter ou supprimer des objets de la ROT... et donc fournir un support de GetObject a vos objets issus d'Exe ActiveX

Source

Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Const ACTIVEOBJECT_WEAK = 1
Private Declare Function CLSIDFromProgID Lib "ole32.dll" (ByVal ProgID As Long, rclsid As GUID) As Long
Private Declare Function CoDisconnectObject Lib "ole32.dll" (ByVal pUnk As IUnknown, pvReserved As Long) As Long
Private Declare Function RegisterActiveObject Lib "oleaut32.dll" (ByVal pUnk As IUnknown, rclsid As GUID, ByVal dwFlags As Long, pdwRegister As Long) As Long
Private Declare Function RevokeActiveObject Lib "oleaut32.dll" (ByVal dwRegister As Long, ByVal pvReserved As Long) As Long
Public Function AddToROT(ByRef voObject As Object, ByRef vsClass As String) As Long
Dim tGuid As GUID
If Not Nothing Is voObject Then
If CLSIDFromProgID(StrPtr(vsClass), tGuid) = 0 Then
RegisterActiveObject voObject, tGuid, ACTIVEOBJECT_WEAK, AddToROT
End If
End If
End Function
Public Sub RemoveFromROT(ByRef voObject As Object, ByVal vnRotId As Long)
If vnRotId Then
RevokeActiveObject vnRotId, 0
End If
CoDisconnectObject voObject, 0
End Sub

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

Private Const ACTIVEOBJECT_WEAK = 1

Private Declare Function CLSIDFromProgID Lib "ole32.dll" (ByVal ProgID As Long, rclsid As GUID) As Long
Private Declare Function CoDisconnectObject Lib "ole32.dll" (ByVal pUnk As IUnknown, pvReserved As Long) As Long
Private Declare Function RegisterActiveObject Lib "oleaut32.dll" (ByVal pUnk As IUnknown, rclsid As GUID, ByVal dwFlags As Long, pdwRegister As Long) As Long
Private Declare Function RevokeActiveObject Lib "oleaut32.dll" (ByVal dwRegister As Long, ByVal pvReserved As Long) As Long

Public Function AddToROT(ByRef voObject As Object, ByRef vsClass As String) As Long
Dim tGuid As GUID
    If Not Nothing Is voObject Then
        If CLSIDFromProgID(StrPtr(vsClass), tGuid) = 0 Then
            RegisterActiveObject voObject, tGuid, ACTIVEOBJECT_WEAK, AddToROT
        End If
    End If
End Function

Public Sub RemoveFromROT(ByRef voObject As Object, ByVal vnRotId As Long)
    If vnRotId Then
        RevokeActiveObject vnRotId, 0
    End If
    CoDisconnectObject voObject, 0
End Sub

Conclusion

dans le zip, un serveur (l'Exe ActiveX) à recompiler

ensuite, compilez l'exemple (sample)
chaque instance de l'exécutable exemple tentera de se connecter à un serveur commun.
ces instances partageront ensuite une valeur, et seront averties des changement de valeur de cette variable, stockée dans le serveur.

pas clair ? hum.... effectivement.
testez, ca sera peut être plus clair :p

Fichier Zip

Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Samples
- Form1.frm 1 914 octets
- Projet1.vbp 738 octets
Server
- compatibility
  - ROTSample.ex_24 576 octets
- ModROT.bas 1 226 octets
- ROTSample.vbp 794 octets
- Server.cls 961 octets
screen.jpg 19 500 octets

Télécharger le zip

Sources du même auteur

Toutes les sources de Renfield

Sources de la même categorie

Toutes les sources de la catégorie Système

Commentaires

Commentaire de EBArtSoft le 15/01/2008 23:31:54 administrateur CS

le mieu c'est encore quand ça ne "crash" pas :p
Commentaire de Renfield le 16/01/2008 08:25:29 administrateur CS

certes, mais l'appli en question etait assez enorme, un truc codé par le directeur, sur un coin de table...
c'était bien souvent ni fait ni a faire...

donc les plantages étaient souvent de mise ; même si on avait bien nettoyé le code.

des fois, on hérite de sacrés trucs, y'a pas a dire ^^

m'enfin, le support de GetObject peut servir a d'autres choses, hein :p
Commentaire de thierrydelepine le 22/01/2008 14:38:47

Merci Renfield de partager cette méthode qui est tres stable (tester avec ton exemple).
Il va me servir pour une communication inter process entre un service (VB) et un exe (VB) qui sert d'interface utilisateur (sous VISTA on ne peut plus faire un service qui intéragit graphiquement avec le bureau windows et l'utilisateur).
Le principe est génial, simple et stable pour VB.