[RESOLVED] load list why is it not loading the last file.

[doberman2002]

Loading zip in listbox, when it comes to one zip remaining in app.path it don't load it into listbox if i add 2 zips in path then it adds all.

Private Sub Command5_Click()

Const EXCLUSION_LIST As String = "3dobios.zip|airlbios.zip|aleck64.zip|alg_bios.zip|allied.zip" 'Empty if none, "|" symbols delimit
                                                   'multiple entries.
    Const SEARCH_PATH As String = "List"
    Const NB_SPACES As String = "     " 'Several No-break space chars, Chr$(&HA0) not
                                        'regular spaces Chr$(&H20).
    Dim Exclusions() As String
    Dim Path As String
    Dim T0 As Double
    Dim ParentChildList As Variant
    Dim ParentCount As Long
    Dim ChildCount As Long
    Dim T1 As Double
    Dim ParentChildIndex As Long
    Dim Item As Variant

    Exclusions = Split(EXCLUSION_LIST, "|")
    Path = Text11.text
    If Right$(Path, 1) <> "\" Then Path = Path & "\"
    MicroTimer.Init
    T0 = MicroTimer.Ticks
    ListFiles ParentChildList, ParentCount, ChildCount, Exclusions, Path
    T1 = MicroTimer.Ticks
   ' Label1.Caption = CStr(ParentCount) & " parents, " _
                   & CStr(ChildCount) & " children, in " _
                   & FormatNumber(T1 - T0, 3) & " seconds"
    For ParentChildIndex = 0 To UBound(ParentChildList)
        Item = ParentChildList(ParentChildIndex)
        If Item(1) Then
           
            List4.AddItem Item(0)
            
        Else
            'List1.AddItem NB_SPACES & Item(0)
            List9.AddItem Item(0)
        End If
    Next
end sub

Private Sub ListFiles( _
    ByRef ParentChildList As Variant, _
    ByRef ParentCount As Long, _
    ByRef ChildCount As Long, _
    ByRef Exclusions() As String, _
    ByVal Path As String, _
    Optional ByVal Pattern As String = "*.*")
    'By looking at each file entry found in a directory search, guess the parent and
    'child relationships based on matching first characters.
    '
    'After sorting in ascending order the first item is a "Parent" and any subsequent
    'items that match for the length of that Parent's Name are "Children."
    '
    'Exclusions contains zero or more Like operator patterns to exclude.
    '
    'Return ParentChildList as a Collection of Variants containing arrays:
    '
    '   Element 0 contains the file's name and extension.
    '   Element 1 contains: True for a "parent" file.
    '                       False for a "child" file.
    Const CHUNK As Long = 500
    Dim i As Long
    Dim File As String
    Dim RawList() As String
    Dim RawListMax As Long
    Dim RawListIndex As Long
    Dim Dot As Long
    Dim ParentNamePart As String
    Dim NamePart As String

    'We want to do case insensitive exclusions:
    For i = LBound(Exclusions) To UBound(Exclusions)
        Exclusions(i) = UCase$(Exclusions(i))
    Next
    If Right$(Path, 1) <> "\" Then Path = Path & "\"
    If Left$(Pattern, 2) <> "*." Then Pattern = "*." & Pattern

    ReDim RawList(CHUNK - 1)
    File = Dir$(Path & Pattern, vbNormal Or vbReadOnly)
    RawListMax = -1
    Do While Len(File) > 0
        If Not LikeList(UCase$(File), Exclusions) Then
            RawListMax = RawListMax + 1
            If RawListMax > UBound(RawList) Then
                ReDim Preserve RawList(UBound(RawList) + CHUNK)
            End If
            RawList(RawListMax) = File
        End If
        File = Dir$()
    Loop
    HeapsortStr.Sort RawList, RawListMax
    ReDim ParentChildList(RawListMax)
    ParentNamePart = "\" 'Initial "no parent name yet" value with a length > 0 that no
                         'file's Name could match.
    ParentCount = 0
    ChildCount = 0
    For RawListIndex = 0 To RawListMax
        File = RawList(RawListIndex)
        Dot = InStrRev(File, ".")
        If Dot > 0 Then
            NamePart = UCase$(Left$(File, Dot - 1))
        Else
            NamePart = UCase$(File)
        End If
        If ParentNamePart <> Left$(NamePart, Len(ParentNamePart)) Then
            ParentNamePart = NamePart
            ParentChildList(RawListIndex) = Array(File, True)
            ParentCount = ParentCount + 1
        Else
            ParentChildList(RawListIndex) = Array(File, False)
            ChildCount = ChildCount + 1
        End If
    Next
End Sub

when i try and load 1 item i se empty line in listbox why

[SamOscarBrown]

Where did you get this ugly code?
Are you simply trying to load all zipped files located in app.path into a listbox?

Or is this something completely different?

[dilettante]

The code has some issues, but the problem it was meant to solve is a bit weird.

This thread seems to be a continuation of a previous one, so there is a lot more code that wasn't shown here. I suppose some people don't understand how forums work.


Anyway... I found the bug. In HeapsortStr.bas change the red lines:

Public Sub Sort(ByRef Strings() As String, Optional ByVal LastUsed As Long = -1)
    Dim Last As Long
    Dim TempAddr As Long

    If LastUsed < 0 Then LastUsed = UBound(Strings)
    Heapify Strings, LastUsed + 1
    For Last = LastUsed To 1 Step -1
        CopyMemory VarPtr(TempAddr), VarPtr(Strings(Last)), 4
        CopyMemory VarPtr(Strings(Last)), VarPtr(Strings(0)), 4
        CopyMemory VarPtr(Strings(0)), VarPtr(TempAddr), 4
        SiftDown Strings, 0, Last - 1
    Next
End Sub

Two folders supplied as test cases.

Folder "List1" has several items, "List2" only has one item.

[doberman2002]

Where did you get this ugly code?
Are you simply trying to load all zipped files located in app.path into a listbox?

Or is this something completely different?

yes am trying to load all zip from a path specified in textbox or app.path to make it simple and not load

Const EXCLUSION_LIST As String = "3dobios.zip|airlbios.zip|aleck64.zip|alg_bios.zip|allied.zip" 'Empty if none, "|" symbols delimit

[doberman2002]

The code has some issues, but the problem it was meant to solve is a bit weird.

This thread seems to be a continuation of a previous one, so there is a lot more code that wasn't shown here. I suppose some people don't understand how forums work.


Anyway... I found the bug. In HeapsortStr.bas change the red lines:

Public Sub Sort(ByRef Strings() As String, Optional ByVal LastUsed As Long = -1)
    Dim Last As Long
    Dim TempAddr As Long

    If LastUsed < 0 Then LastUsed = UBound(Strings)
    Heapify Strings, LastUsed + 1
    For Last = LastUsed To 1 Step -1
        CopyMemory VarPtr(TempAddr), VarPtr(Strings(Last)), 4
        CopyMemory VarPtr(Strings(Last)), VarPtr(Strings(0)), 4
        CopyMemory VarPtr(Strings(0)), VarPtr(TempAddr), 4
        SiftDown Strings, 0, Last - 1
    Next
End Sub

Two folders supplied as test cases.

Folder "List1" has several items, "List2" only has one item.

thank you sam.

[XavSnap]

I suppose some people don't understand how forums work.

thank you sam.

It's looks better now.

[SamOscarBrown]

SOLVED then? If No...let us know. If Yes, make it so.

[dilettante]

I suspect it is solved, but until somebody explains the Thread Tools menu again I doubt we'll see him use it.


It would have been easier if I had either not tried to simplify things by adding that optional parameter or else I'd tried testing cases where there was 1 file or 0 files. Then this thread might not exist.

Speaking of the 0 files case, I suspect he didn't see that I added this:

    If RawListMax < 0 Then
        ParentChildList = Array()
        Exit Sub
    End If

... to the ListFiles subroutine.

So sooner or later we can probably expect yet another thread to be started once he stumbles into that case.