[VB6] IEnumVARIANT / For Each support without a typelib-VBForums
Results 1 to 6 of 6

Thread: [VB6] IEnumVARIANT / For Each support without a typelib

  1. #1

    Thread Starter
    Frenzied Member
    Join Date
    Jun 2015
    Posts
    1,546

    [VB6] IEnumVARIANT / For Each support without a typelib

    In my own projects I use a typelib and a custom interface to do the same thing, (comparable to .NET and Olaf's examples) which might seem overly complex, so here's an example that gets the job done without any dependencies. It also serves as a good example of creating a Lightweight COM Object that's less complex than Curland's examples (which are always over-complicated). It should be easy enough to adapt to your own custom collections.

    Code:
    ' Copyright  2017 Dexter Freivald. All Rights Reserved. DEXWERX.COM
    '
    ' MEnumerator.bas
    '
    ' Implementation of IEnumVARIANT to support For Each in VB6
    '
    Option Explicit
    
    Private Type TENUMERATOR
        VTablePtr   As Long
        References  As Long
        Enumerable  As Object
        Index       As Long
        Upper       As Long
        Lower       As Long
    End Type
    
    Private Enum API
        NULL_ = 0
        S_OK = 0
        S_FALSE = 1
        E_NOTIMPL = &H80004001
        E_NOINTERFACE = &H80004002
        E_POINTER = &H80004003
    #If False Then
        Dim NULL_, S_OK, S_FALSE, E_NOTIMPL, E_NOINTERFACE, E_POINTER
    #End If
    End Enum
    
    Private Declare Function FncPtr Lib "msvbvm60" Alias "VarPtr" (ByVal FunctionAddress As Long) As Long
    Private Declare Function GetMem4 Lib "msvbvm60" (Src As Any, Dst As Any) As Long
    Private Declare Function CopyBytesZero Lib "msvbvm60" Alias "__vbaCopyBytesZero" (ByVal Length As Long, Dst As Any, Src As Any) As Long
    Private Declare Function CoTaskMemAlloc Lib "ole32" (ByVal cb As Long) As Long
    Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long)
    Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, ByVal lpiid As Long) As Long
    Private Declare Function SysAllocStringByteLen Lib "oleaut32" (ByVal psz As Long, ByVal cblen As Long) As Long
    Private Declare Function VariantCopyToPtr Lib "oleaut32" Alias "VariantCopy" (ByVal pvargDest As Long, ByRef pvargSrc As Variant) As Long
    
    Public Function NewEnumerator(ByRef Enumerable As Object, _
                                  ByVal Upper As Long, _
                                  Optional ByVal Lower As Long _
                                  ) As IEnumVARIANT
        
        Static VTable(6) As Long
        If VTable(0) = NULL_ Then
            VTable(0) = FncPtr(AddressOf IUnknown_QueryInterface)
            VTable(1) = FncPtr(AddressOf IUnknown_AddRef)
            VTable(2) = FncPtr(AddressOf IUnknown_Release)
            VTable(3) = FncPtr(AddressOf IEnumVARIANT_Next)
            VTable(4) = FncPtr(AddressOf IEnumVARIANT_Skip)
            VTable(5) = FncPtr(AddressOf IEnumVARIANT_Reset)
            VTable(6) = FncPtr(AddressOf IEnumVARIANT_Clone)
        End If
        
        Dim This As TENUMERATOR
        With This
            .VTablePtr = VarPtr(VTable(0))
            .Lower = Lower
            .Index = Lower
            .Upper = Upper
            .References = 1
            Set .Enumerable = Enumerable
        End With
        
        Dim pThis As Long
        pThis = CoTaskMemAlloc(LenB(This))
        CopyBytesZero LenB(This), ByVal pThis, This
        GetMem4 pThis, NewEnumerator
    End Function
    
    Private Function IID$(ByVal riid As Long)
        StrRef(IID) = SysAllocStringByteLen(riid, 16&)
    End Function
    
    Private Function IID_IUnknown() As String
        Static IID As String
        If StrPtr(IID) = NULL_ Then
            IID = String$(8, vbNullChar)
            IIDFromString StrPtr("{00000000-0000-0000-C000-000000000046}"), StrPtr(IID)
        End If
        IID_IUnknown = IID
    End Function
    
    Private Function IID_IEnumVARIANT() As String
        Static IID As String
        If StrPtr(IID) = NULL_ Then
            IID = String$(8, vbNullChar)
            IIDFromString StrPtr("{00020404-0000-0000-C000-000000000046}"), StrPtr(IID)
        End If
        IID_IEnumVARIANT = IID
    End Function
    
    Private Function IUnknown_QueryInterface(ByRef This As TENUMERATOR, _
                                             ByVal riid As Long, _
                                             ByVal ppvObject As Long _
                                             ) As Long
        If ppvObject = NULL_ Then
            IUnknown_QueryInterface = E_POINTER
            Exit Function
        End If
    
        Dim siid As String
        siid = IID$(riid)
    
        If siid = IID_IUnknown Or siid = IID_IEnumVARIANT Then
            DeRef(ppvObject) = VarPtr(This)
            IUnknown_AddRef This
            IUnknown_QueryInterface = S_OK
        Else
            IUnknown_QueryInterface = E_NOINTERFACE
        End If
    End Function
    
    Private Function IUnknown_AddRef(ByRef This As TENUMERATOR) As Long
        With This
            .References = .References + 1
            IUnknown_AddRef = .References
        End With
    End Function
    
    Private Function IUnknown_Release(ByRef This As TENUMERATOR) As Long
        With This
            .References = .References - 1
            IUnknown_Release = .References
            If .References = 0 Then
                Set .Enumerable = Nothing
                CoTaskMemFree VarPtr(This)
            End If
        End With
    End Function
    
    Private Function IEnumVARIANT_Next(ByRef This As TENUMERATOR, _
                                       ByVal celt As Long, _
                                       ByVal rgVar As Long, _
                                       ByVal pceltFetched As Long _
                                       ) As Long
        If rgVar = NULL_ Then
            IEnumVARIANT_Next = E_POINTER
            Exit Function
        End If
        
        Dim Fetched As Long
        With This
            Do Until .Index > .Upper
                VariantCopyToPtr rgVar, .Enumerable(.Index)
                .Index = .Index + 1&
                Fetched = Fetched + 1&
                If Fetched = celt Then Exit Do
                rgVar = PtrAdd(rgVar, 16&)
            Loop
        End With
        
        If pceltFetched Then DLng(pceltFetched) = Fetched
        If Fetched < celt Then IEnumVARIANT_Next = S_FALSE
    End Function
    
    Private Function IEnumVARIANT_Skip(ByRef This As TENUMERATOR, ByVal celt As Long) As Long
        IEnumVARIANT_Skip = E_NOTIMPL
    End Function
    
    Private Function IEnumVARIANT_Reset(ByRef This As TENUMERATOR) As Long
        IEnumVARIANT_Reset = E_NOTIMPL
    End Function
    
    Private Function IEnumVARIANT_Clone(ByRef This As TENUMERATOR, ByVal ppEnum As Long) As Long
        IEnumVARIANT_Clone = E_NOTIMPL
    End Function
    
    Private Function PtrAdd(ByVal Pointer As Long, ByVal Offset As Long) As Long
        PtrAdd = (Pointer Xor &H80000000) + Offset Xor &H80000000
    End Function
    
    Private Property Let DeRef(ByVal Address As Long, ByVal Value As Long)
        GetMem4 Value, ByVal Address
    End Property
    
    Private Property Let DLng(ByVal Address As Long, ByVal Value As Long)
        GetMem4 Value, ByVal Address
    End Property
    
    Private Property Let StrRef(ByRef Str As String, ByVal Value As Long)
        GetMem4 Value, ByVal VarPtr(Str)
    End Property
    Attached Files Attached Files
    Imagine what it would be like to set breakpoints in, or step through subclassing code;
    and then being able to hit stop/end/debug or continue, without crashing the IDE.

    VB6.tlb | Bulletproof Subclassing in the IDE

  2. #2
    Member
    Join Date
    Jul 2015
    Location
    Belarus, Minsk
    Posts
    56

    Re: [VB6] IEnumVARIANT / For Each support without a typelib

    Can I use this implementation in FTypes project?

  3. #3
    New Member
    Join Date
    Sep 2016
    Location
    Texas panhandle
    Posts
    14

    Re: [VB6] IEnumVARIANT / For Each support without a typelib

    Can it be modified to handle strings?

  4. #4
    Member
    Join Date
    Jul 2015
    Location
    Belarus, Minsk
    Posts
    56

    Re: [VB6] IEnumVARIANT / For Each support without a typelib

    Quote Originally Posted by VBClassic04 View Post
    Can it be modified to handle strings?
    Sorry, i'm not an author of this thread, but what do you mean of "handle strings"? If your code is about to enumerate string characters - than of course it can be used.

  5. #5

    Thread Starter
    Frenzied Member
    Join Date
    Jun 2015
    Posts
    1,546

    Re: [VB6] IEnumVARIANT / For Each support without a typelib

    Quote Originally Posted by VBClassic04 View Post
    Can it be modified to handle strings?
    No modification necessary.
    Sure, I'll post a modified example if you want.
    Attached Files Attached Files
    Last edited by DEXWERX; Nov 13th, 2017 at 12:39 PM.
    Imagine what it would be like to set breakpoints in, or step through subclassing code;
    and then being able to hit stop/end/debug or continue, without crashing the IDE.

    VB6.tlb | Bulletproof Subclassing in the IDE

  6. #6

    Thread Starter
    Frenzied Member
    Join Date
    Jun 2015
    Posts
    1,546

    Re: [VB6] IEnumVARIANT / For Each support without a typelib

    Quote Originally Posted by hwoarang View Post
    Can I use this implementation in FTypes project?
    Of course. Use it how you see fit.
    Imagine what it would be like to set breakpoints in, or step through subclassing code;
    and then being able to hit stop/end/debug or continue, without crashing the IDE.

    VB6.tlb | Bulletproof Subclassing in the IDE

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width

Survey posted by VBForums.