Results 1 to 6 of 6

Thread: VB6 a simple wrapper for the VBA.Collection with (much) faster Indexed-Access

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    VB6 a simple wrapper for the VBA.Collection with (much) faster Indexed-Access

    The title says it all - this is a simple Collection-Wrapper which can act as a compatible
    Replacement for the VBA.Collection - the fast Hash-Access of the VBA.Collection is used further -
    but all the disadvantages with indexed access are avoided for the most typical use-cases.

    At this occasion there were also some other enhancements made as:
    - an Exists Method to check for Keys
    - a RemoveAll-method
    - can hand out Value- and Key-Arrays in appropriate Variant- or String-Arrays (with userdefinable LBound)
    - in addition to the compatible Item-Method we have ItemByIndex and KeyByIndex too
    - The unnerving behaviour to not allow Add(..., BeforeIndex) with an Index at constantly 1 (in case of Count=0) is gone

    It should be also possible, to implement the Item-property also in Write-Direction (with Property Let/Set),
    but I leave that for interested colleagues to explore - currently the internally used Collection-Instance-Types,
    which were pointed out to me in this thread for the first time (structs posted by jbarnett74 - then refined with a few more
    explanations by Bonnie West) - these Structures are currently only used within this wrapper in "safe-read-only-fashion".

    Those who try themselves at implementing Write-Access for the Values over the Item-Property,
    should test this accordingly (back and forward), because these Structs contain quite a few
    "still unknown members", which partly are used for the Hashing-functionality of the VB-Collection,
    but some of them could also store additional information, which is related to the Value-member
    of the Element-Struct - so changing the Value-Member is alluringly simple - since it seems easily
    accessible also for the Write-Direction - but one doesn't know yet, if changing its Value requires
    also changes in a few so far unknown members (which the Add-Method of the VB-Collection might
    automatically ensure under the covers).

    So, as the implementation comes currently - it is "playing things safe" - no real risk in using it, especially
    when you compile it into a dedicated ActiveX-Dll-Binary, to give the Class more IDE-safety with regards
    to cleanup, even when the Stop-Button was pressed in the IDE (it needs to run over its Class_Terminate-
    Event to clear things up properly).

    Ok, so here is the Implementation- and Demo-Code (with a small performance-test):
    CollectionEx.zip

    And here the appropriate ScreenShot:


    An additional advice for those who plan to compile it into an ActiveX-Dll-Binary,
    all extended native Compiler-Options are allowed *aside* from the "Aliasing-Option"
    (which should remain unchecked in this case of SafeArray-Pointer-usage).

    Edit: Please take note that the Class in the above Demo-Zip still contains a Copy&Replace-Bug,
    as pointed out by Elroy in post #5 - I will not re-upload the Zip, since it's easy enough to find and fix IMO.


    Olaf
    Last edited by Schmidt; Aug 30th, 2016 at 10:03 PM.

  2. #2
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    4,060

    Re: VB6 a simple wrapper for the VBA.Collection with (much) faster Indexed-Access

    Quote Originally Posted by Schmidt View Post
    The information about these VBA.Collection-related structs which jbarnett74 posted at the top,
    were new to me, so if somebody (Bonnie?) has more information about the origination of these structs,
    who has used/posted them first in a VB (or C++ context), would be nice.
    Quote Originally Posted by Schmidt View Post
    Earliest I could find (but also only "Poking around wildly", not using any UDTs as shown by jbarnett74)
    was from 2007 (by Ulli, on PSC):
    http://www.planetsourcecode.com/vb/s...68075&lngWId=1

    Perhaps jbarnett74 has some more comments about these Structure-Defs (from the
    Author of the App he has now to maintain)?
    This is also the first time I've seen the internal structure of the VBA.Collection class. I found out that the Key member of the CollectionElement UDT was a BSTR by viewing the IDE's memory in a hex editor. It does make sense that that member is a VB string rather than a C++ string.

    In the PSC code you linked to, the author commented that it was another PSC member "who gave him the collection structures". I searched that member's submissions and fortunately, I immediately found where he declared the Collection UDTs. The following are his notes from clsIndex.Index_Dump:

    Quote Originally Posted by John Underhill (a.k.a. Steppenwolfe)
    Code:
    '/*  dump collection keys and items to a binary file
    '*~ The problem here was that collection keys are -write only-
    '*~ this would have meant parsing key (file name) out of every
    '*~ item, then formatting a string for a binary file dump..
    '*~ This was a very expensive approach, as collection sizes
    '*~ could top 500k items on large drives. I searched the internet
    '*~ for hours, but all posts on the subject agreed that key could
    '*~ not be read -until- some dude had little snippet of code that
    '*~ illustrated collections structure, and said key could be hacked
    '*~ from memory.. good idea! though his example crashed ide :o(
    '*~ So, this was the result of that effort..
    '*~ collection structure is enumerated and key/item extracted and
    '*~ copied to arrays, arrays then use copymemory to build string for
    '*~ the binary dump.. this proved to be hundreds of times faster
    '*~ then original method..
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

  3. #3

    Thread Starter
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: VB6 a simple wrapper for the VBA.Collection with (much) faster Indexed-Access

    Thanks for the Info Bonnie.

    I take it, that we will have to live with "some dude" as the provider of these structs.

    Well, credit to whom it's due I guess... so, chapeau to, erm - 'Mr. dude'...

    OT:

    Just did a look at Steppenwolfes "hyper-search-engine", you linked to (because the description
    surely sounded "overwhelmingly auspicious" ... (well, after a while I was even able to run it
    finally - though only after binding the search-engine classes into the Main-Project directly -
    as Private ones, because his threading implementation constantly crashed here).

    Codewise it's quite an over-complicating approach - and by no means fast or "hyper".

    20 lines of vbRichClient-Code did the test-job here in ~3.8sec, whereas the "hyper-code"
    accomplished the same task (also in a repeated run with hot filecaches) in ~14.5sec.

    One of the reasons surely being, that he used the ANSI-Declares of the FindFile-API,
    which are quite inefficient, compared to their W-counterparts.

    That just as a "been there, tested it, doesn't worth it"-review to those who followed the
    link to that FileSearcher-Tool on PSC - and considered using it.

    Olaf

    P.S. since I have my vbRichClient-based comparison-code still here in a Temp-Project,
    here's what I used, to find all occurences of "desktop.ini" (found about 200 occurences,
    accross ~346,000 Files total in 3.8sec).

    Code:
    Option Explicit
    
    Private Sub Form_Load()
      Dim CompareList As cSortedDictionary
      Set CompareList = New_c.SortedDictionary(TextCompare)
          CompareList.Add "desktop.ini"
          'CompareList.Add "modMain.bas"
          'etc...
      
      New_c.Timing True
        Dim Results As cCollection, FilesScanned As Long, FileName
        Set Results = New_c.Collection 'create an instance which takes up the results
        DirScanRecursive "C:", CompareList, Results, FilesScanned
      Caption = Results.Count & " Files found after:" & New_c.Timing & " TotalFiles-Scanned: " & FilesScanned
      
      For Each FileName In Results
        List1.AddItem FileName
      Next
    End Sub
    
    Private Sub DirScanRecursive(Path$, CompareList As cSortedDictionary, Results As cCollection, FilesScanned As Long)
      Dim i As Long, DL As cDirList
      On Error GoTo SkipAccessDenied
        Set DL = New_c.FSO.GetDirList(Path, , , True, True)
      On Error GoTo 0
      
      FilesScanned = FilesScanned + DL.FilesCount
      For i = 0 To DL.FilesCount - 1
        If CompareList.Exists(DL.FileName(i)) Then Results.Add DL.Path & DL.FileName(i)
      Next i
      
      For i = 0 To DL.SubDirsCount - 1
        DirScanRecursive DL.Path & DL.SubDirName(i), CompareList, Results, FilesScanned
      Next i
    SkipAccessDenied:
    End Sub
    Last edited by Schmidt; Dec 18th, 2014 at 04:16 PM.

  4. #4
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    4,060

    Re: VB6 a simple wrapper for the VBA.Collection with (much) faster Indexed-Access

    Yeah, I'm not really impressed with his code. I also find it hard to believe most of the observations he listed in clsBuilder.cls. For example, "1) Constants slow performance down, hence I removed them where I could", "6) shorter variable names are faster", etc. Furthermore, he was already using a TLB, so he should have declared all the APIs there if he really was serious of writing the fastest code possible.
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

  5. #5
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: VB6 a simple wrapper for the VBA.Collection with (much) faster Indexed-Access

    Say Olaf,

    I just downloaded your code to take a look at it, and it appears to have a syntax error in it. The CollectionEx.cls module:

    Code:
    
    Public Property Get Item(KeyOrIndex)
      If VarType(KeyOrIndex) = vbString Then
        VarCopyHelper Item, mCol.Item(Key)
      Else
        EnsureElementPositioningOn KeyOrIndex
        VarCopyHelper Item, mColElmt(0).Value
      End If
    End Property
    
    
    I suspect it's suppose to be KeyOrIndex, but didn't want to presume.

    Regards,
    Elroy
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  6. #6

    Thread Starter
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: VB6 a simple wrapper for the VBA.Collection with (much) faster Indexed-Access

    Quote Originally Posted by Elroy View Post
    Code:
    
    Public Property Get Item(KeyOrIndex)
      If VarType(KeyOrIndex) = vbString Then
        VarCopyHelper Item, mCol.Item(Key)
      Else
        EnsureElementPositioningOn KeyOrIndex
        VarCopyHelper Item, mColElmt(0).Value
      End If
    End Property
    
    
    I suspect it's suppose to be KeyOrIndex,...
    Yep, right you are - thanks for that...

    Olaf

Posting Permissions

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



Click Here to Expand Forum to Full Width