CodeS-SourceS
Rechercher un code, un tuto, une réponse

Implémenter for each

Août 2017


Implémenter for each



Le principe


Lorsque l'on fait un For Each sur une classe, on demande d'énumérer des Variant ou des objets. VB demande à la fonction NewEnum, qui a l'ID (dans outils/attributs de procédure) -4, de renvoyer un objet IEnumVARIANT. VB appelle la méthode Next de cet objet pour demander le prochain élément jusqu'à ce qu'elle renvoie 1.

Si l'on énumère une collection interne


Si l'on a une collection qui est déclarée comme suit :


Private m_Items As Collection


On créera une fonction publique NewEnum :

Public Function NewEnum() As IEnumVARIANT
    Set NewEnum = m_Items.[_NewEnum]
End Function


Il faut modifier les attributs de la fonctions : Menu Outils |Attributs de procédure...
  • Cliquer sur Avancés >>
  • Dans ID de la procédure : taper -4
  • Cocher la case Masquer ce membre afin de la réserver à VB uniquement


Voilà, c'est tout...
Mais imaginons que l'objet de l'énumération ne soit pas une collection VB...

Si l'on énumère autre chose


Le problème est que cette interface expose des types que VB ne supporte pas dans du code. On ne peut donc pas faire un simple Implements.

Il existe deux solutions :
  • Créer une typelib VB-izée
  • Utiliser un objet léger sans typelib puisque que VB définit et autorise une variable ou fonction de type IEnumVARIANT mais pas son utilisation dans du code.


Nous allons nous servir des objets légers afin de créer un objet IEnumVARIANT pour gérer Next par nous même. On utilisera les objets alloués dans le tas.

Le principe est le suivant :

NewEnum renvoie une instance de notre objet léger à VB,
VB appelle uniquement la méthode Next tant qu'elle renvoie 0. Quand il n'y a plus d'éléments à énumérer, Next renvoie 1.
A chaque appel de Next, cette méthode rappelle la méthode ForEach de l'objet qui expose la collection. Celle-ci remplit le Variant avec l'élément demandé et renvoie 0 (élément existant) ou 1 (élément inexistant).

Le code sera le suivant :

'la structure d'un Guid :
Private Type Guid
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

'VB se sert de l'interface IEnumVARIANT pour implémenter For Each.
'Vous pouvez énumérer tout type de données sauf les Type que vous définissez.
'Vous ne pouvez pas affecter une structure à un Variant (sauf dans les dll ActiveX)

'Implémentation d'une interface IEnumVARIANT pour For Each

'indique que l'objet ne supporte pas l'interface demandée
Private Const E_NOINTERFACE AsLong  = &H80004002

'indique que la méthode n'est pas implémentée
Private ConstE_NOTIMPL As Long=  &H80004001

'le guid de l'interface IEnumVARIANT :
Private Const guidIEnumVARIANT AsString ="{00020404-0000-0000-C000-000000000046}"

'le guid numérique
Private m_guidIEnumVARIANT As Guid

'La vtable : table des fonctions virtuelles

'En résumé, elle contient les pointeurs vers les fonctions publiques de l'objet

'dans notre cas, il faut 7fonctions :

'   -> les 3 fonctions de l'interface de base IUnknown (base dufonctionnement de COM)

'   -> les 4 fonctions de l'interface IEnumVARIANT

Private TypeVTable
    Methods(0 To6) As Long
End Type

'on garde une trace du pointeur vers la vtable pour savoir si elle est initialisée
Private m_pVTable As Long

'on garde une variable contenant la vtable
Private m_VTable As VTable

'ceci est la structure d'un objet : la seule différence entre un objet et un Type,
'c'est le premier membre, un pointeur vers la vtable

Private Type EnumVar
    'le pointeur vers la vtable
    pVTable As Long
    'le compteur de référence pour savoir quand on doit libérer la mémoire de l'objet
    cCount As Long
    'données attachées
    '--------------------
    'l'objet de rappel pour la fonction Next
    lpCollection As Object
    'l'index courant de l'énumération
    iCurrent As Long
End Type

'remplit une zone avec des 0
Private Declare Sub ZeroMemory Lib"kernel32.dll" Alias"RtlZeroMemory" (ByRef Destination As Any, ByVal Length As Long)

'copie d'une zone mémoire dans une autre

Private Declare Sub CopyMemory Lib"kernel32.dll" Alias"RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

'alloue de la mémoire dynamiquement dans le tas
Private Declare Function CoTaskMemAlloc Lib "ole32.dll" (ByValcb As Long) As Long

'libère de la mémoire allouée dans le tas
Private Declare Sub CoTaskMemFree Lib"ole32.dll" (ByRef pv As Any)

'convertit un guid chaine en guid numérique
Private Declare Sub CLSIDFromString Lib"ole32.dll" (ByVal lpsz As Long, ByRef pclsid As Guid)

'compare deux guids et renvoie True s'ils sont égaux
Private Function IsIIDEqual(guid1 As Guid, guid2 As Guid) As Boolean
    IsIIDEqual = ((guid1.Data1 = guid2.Data1) And _
                  (guid1.Data2 = guid2.Data2) And _
                  (guid1.Data3 = guid2.Data3) And _
                  (guid1.Data4(0) = guid2.Data4(0)) And _
                  (guid1.Data4(1) = guid2.Data4(1)) And _
                  (guid1.Data4(2) = guid2.Data4(2)) And _
                  (guid1.Data4(3) = guid2.Data4(3)) And _
                  (guid1.Data4(4) = guid2.Data4(4)) And _
                  (guid1.Data4(5) = guid2.Data4(5)) And _
                  (guid1.Data4(6) = guid2.Data4(6)) And _
                  (guid1.Data4(7) = guid2.Data4(7)))
End Function

'comme on ne peut pas affecter la valeur de AddressOf à une variable directement,
'on doit le passer en paramètre d'une fonction qui nous le renvoie
Public Function FuncPtr(ByVal addr AsLong) As Long
    FuncPtr = addr
End Function

'crée un objet IEnumVARIANT qui appellera la méthode ForEach de l'objet objCallback 
'à chaque itération de For Each
Public Function InitCollection(ByVal objCallback As Object) As IEnumVARIANT
    'pointeur vers la collection
    Dim ptrCollection As Long
    'contenu de l'objet
    Dim Collection AsEnumVar

    'si la vtable n'est pas initialisée
    If m_pVTable = 0 Then
        'on la remplit
        With m_VTable
            .Methods(0) = FuncPtr(AddressOfQueryInterface)
            .Methods(1) = FuncPtr(AddressOf AddRef)
            .Methods(2) = FuncPtr(AddressOf Release)
            .Methods(3) = FuncPtr(AddressOf IEnumVARIANT_Next)
            .Methods(4) = FuncPtr(AddressOf IEnumVARIANT_Skip)
            .Methods(5) = FuncPtr(AddressOf IEnumVARIANT_Reset)
            .Methods(6) = FuncPtr(AddressOf IEnumVARIANT_Clone)
        EndWith
        'et on en garde l'adresse
        m_pVTable =VarPtr(m_VTable)

       'on initialise le guid numérique
        CLSIDFromString ByVal StrPtr(guidIEnumVARIANT), m_guidIEnumVARIANT
    End If

    'on construit l'objet
    With Collection
        'le pointeur vers la vtable
        .pVTable =m_pVTable
        'le compteur de référence : on crée un objet donc il est à un
        .cCount = 1
        'on garde une trace de l'objet de rappel
        Set .lpCollection = objCallback
    End With

    'on alloue de l'espace mémoire pour l'objet
    ptrCollection = CoTaskMemAlloc(LenB(Collection))

    'si succès
    If ptrCollection Then
        'on remplit l'objet
        CopyMemory ByValptrCollection, ByVal VarPtr(Collection),LenB(Collection)
    End If

    'on assigne la référence à la variable de retour de la fonction
    CopyMemory ByValVarPtr(InitCollection), ptrCollection, 4&

    'on évite la libération des ressources que nous avons transférées dans l'objet
    ZeroMemory ByValVarPtr(Collection), LenB(Collection)
End Function

'implémentation des méthodes de l'interface
'le premier paramètre de toutes les méthodes est un pointeur vers la zone mémoire
'servant à stocker le pointeur de vtable et les données (l'instance de l'objet)

'cette fonction sert à demander à l'objet s'il sait gérer l'interface iid (c'est un GUID)
'si oui, elle retourne l'adresse vers l'objet du type en question dans ppvObject et S_OK
'si non, elle met Nothing (cad 0) dans ppvObject et renvoie E_NOINTERFACE

Private FunctionQueryInterface( _
  ByRef This As EnumVar, _
  ByRef iid As Guid, _
  ByRefppvObject As Long_
) As Long
    IfIsIIDEqual(m_guidIEnumVARIANT, iid) Then
        This.cCount = This.cCount + 1
        ppvObject = VarPtr(This)
        QueryInterface = 0
    Else
        ppvObject = 0
        QueryInterface = E_NOINTERFACE
    End If
End Function

'cette fonction incrémente uncompteur de référence (nombre d'instance) de l'objet

Private FunctionAddRef(ByRef This AsEnumVar) As Long
This.cCount= This.cCount + 1
AddRef =This.cCount
End Function

'cette fonction décrémente uncompteur de référence (nombre d'instance) de l'objet
'quand le compteur atteind 0, sa structure est libérée

Private FunctionRelease(ByRef This AsEnumVar) As Long
This.cCount= This.cCount - 1
Release =This.cCount
If This.cCount = 0 Then
    Set This.lpCollection = Nothing
    CoTaskMemFree ByVal VarPtr(This)
End If
End Function

'implémentation de la méthode d'énumération

Private FunctionIEnumVARIANT_Next( _
  ByRef This As EnumVar, _
  ByVal celt As Long, _
  ByRef rgVar As Variant, _
  ByValpCeltFetched As Long _
) As Long
    Dim lng As Long

    'normalement,VB met toujours celt à 1 :
    'il réclame toujours un et un seul élément de la collection
    If celt <> 1 Then
        IEnumVARIANT_Next = E_NOTIMPL
        Exit Function
    End If
 
    'si l'appelant demande le nombre d'éléments renvoyés
    If pCeltFetched Then
        'on en renvoie toujours 1
        lng = 1
        CopyMemory ByValpCeltFetched, lng, 4&
    EndIf

    'on appelle la fonction de l'objet possédant la collection 
    'pour qu'elle renvoie l'élément courant
    'Elle appelle la fonction publique For Each de l'objet
   '---------------------------------------------------------------------------------------
    'For Each doit être une fonction PUBLIQUE définie dans l'objet qui contient la collection
Public Function ForEach(ByVal iCurrent as Long,ByRef var as Variant) asLong
    IEnumVARIANT_Next =This.lpCollection.ForEach(This.iCurrent, rgVar)

    'on passe à l'élément suivant
    This.iCurrent = This.iCurrent + 1
End Function

'fait une copie de l'objet d'énumération
'cette fonction n'est jamais appelée par VB
Private FunctionIEnumVARIANT_Clone( _
  ByRef This As EnumVar, _
  ByRef ppEnumAs Long _
) As Long
    ppEnum = CoTaskMemAlloc(LenB(This))
    CopyMemory ByValppEnum, This, LenB(This)
    IEnumVARIANT_Clone = 0
End Function

'cette fonction remet à 0 l'énumération
Private FunctionIEnumVARIANT_Reset(ByRef This As EnumVar)
    This.iCurrent = 0
End Function

'cette fonction avance de celt éléments sans les lire
Private FunctionIEnumVARIANT_Skip( _
  ByRef This As EnumVar, _
  ByVal celt As Long _
) As Long
    This.iCurrent = This.iCurrent + celt
End Function


Notons les points suivants :
  • La gestion de la mémoire de l'objet se fait dans Release, la construction étant celle d'un objet dans le tas,
  • QueryInterface accepte seulement l'interface IEnumVARIANT
  • L'interface IEnumVARIANT a quatre méthodes :
    • Next, c'est la seule que VB utilise. Elle est appelée pour renvoyer les éléments un par un dans la boucle For Each tant qu'elle renvoie 0,
    • Clone, elle n'est jamais appelée par VB. Elle permet de dupliquer l'objet IEnumVARIANT afin de sauvegarder son état,
    • Reset, elle n'est jamais appelée par VB. Elle permet de redémarrer l'énumération des éléments depuis le début,
    • Skip, elle n'est jamais appelée par VB. Elle permet de passer n éléments sans les lire.
  • Pour les méthodes jamais appelées, on pourrait se contenter de renvoyer E_NOIMPL pour dire que l'on ne les gère pas.

Utilisation dans un modulede classe


Dans le module de classe le code sera le suivant :

'cette méthode est appelée par VB pour demander un objet d'énumération
'elle doit avoir un ID de -4 dans les attributs de procéure
Public Function NewEnum() As IEnumVARIANT
    'on renvoie l'objet d'énumération
    Set NewEnum = InitCollection(Me)
End Function

'renvoie l'élément d'index iCurrent dans la variable var
'elle doit renvoyer 0 si tout va bien
'1 s'il n'y a plus d'éléments dans la collection
Public Function ForEach(ByVal iCurrent AsLong, var As Variant) As Long
'
End Function


Notons les points suivants :
  • Il faut modifier les attributs de la fonctions : Menu Outils |Attributs de procédure...
  • Cliquer sur Avancés >>
  • Dans ID de la procédure : taper -4
  • Cocher la case Masquer ce membre afin de la réserver à VB uniquement
  • La fonction ForEach doit être publique afin d'être appelable depuis l'extérieur : l'objet IEnumVARIANT
  • La fonction ForEach doit absolument être implémentée dans l'objet exposant la collection par NewEnum.
  • iCurrent est l'index (partant de 0) de l'élément à renvoyer dans var
  • var doit contenir l'élément iCurrent (s'il existe)
  • La fonction renvoie :
    • 1 s'il n'y a plus d'éléments à énumérer (si iCurrent n'existe pas)
    • 0 s'il y a encore des éléments à énumérer (si iCurrent existe)

Optimisation


On pourrait implémenter le mécanisme d'énumération directement dans le module BAS. Cela permettrait de se passer de la liaison tardive de la méthode ForEach de la classe.

A voir également

Publié par ShareVB.
Ce document intitulé «  Implémenter for each  » issu de CodeS-SourceS (codes-sources.commentcamarche.net) est mis à disposition sous les termes de la licence Creative Commons. Vous pouvez copier, modifier des copies de cette page, dans les conditions fixées par la licence, tant que cette note apparaît clairement.
Fournir des fonctions callbacks autres que stdcall
Infos systeme avec vb.net