Results 1 to 3 of 3
  1. #1
    GraeagleBill's Avatar
    GraeagleBill is offline Experienced Old Geezer
    Windows 7 64bit Access 2003
    Join Date
    Feb 2011
    Posts
    1,919

    Implementing LiFo Stack, an implementation

    A week or so ago, I inquired about a method or methods for implementing a LiFo stack. The task at hand was the need to examine every file within a given directory tree, even an entire disc. Since there didn't seem to be an abundance of implementations available that ideally suited my needs, I wrote what I've called a "directory tree crawler". For whatever value that might be to anyone, I'm posting my implementation as a followup. The mdb can be downloaded at:

    https://www.dropbox.com/s/80a2in5klt...awler-V1.0.mdb



    Preview:
    Click image for larger version. 

Name:	DirectoryCrawler.jpg 
Views:	75 
Size:	45.5 KB 
ID:	16505

    And, the form's code sheet:

    Code:
    Option Compare Database
    Option Explicit
    Dim strFileName As String
    Dim StackArr() As String
    Dim StackEntry As String
    Dim strPosition As Long
    Dim I As Integer
    Dim idx As Integer
    Dim FileCount As Long
    Dim Exclusions() As String
    
    Private Sub Form_Open(Cancel As Integer)
    Me.tbExclusions = "C:\Windows\; C:\Program Files\; C:\Program Files (x86)\"    ' Initialize the default set of exclusions
    End Sub
    
    Private Sub DirTreeCrawler_Click()
    '*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
    ' This app employs a FIFO stack to traverse the entire folder tree starting with the path
    ' expression entered in the text box "tbRootExp".  The format of the root expression is
    ' of the form: drive:\[folder name1\][folder name2\][folder name3\]........[folder namen\]
    '
    ' As each folder/sub-folder name is encountered via the VBA Dir command, it is put on the
    ' stack via the function "Push".  When the contents of the current folder have been examined,
    ' the loop ends and the next folder to be examined is obtained via the "Pop" function.
    ' Proceeding in this method results in the examination of the entire folder tree.   (And
    ' yes, one can process an entire disc.)
    '
    ' Bill Stanton - May 19, 2014    (a.k.a. GraeagleBill)
    '*=*=*=*=*=*=(Current implementation)*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
    ' The current app shown here is looking for errant files that resulted from a Win 7 Windows
    ' Explorer copy/paste operation of large amounts of folders/sub-folders and the contained
    ' files.  Example: the file MyTextFile.txt~MyTextFile was created in addition to the intended
    ' file, MyTextFile.txt.  There were literally thousands of such files created.  This app finds
    ' and deletes all such files found within the specified directory tree.
    '*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
    
    On Error GoTo DirError
    
    If IsNull(Me.tbRootExp) Then
        MsgBox "Please specify starting directory," & vbNewLine _
               & "as there isn't any default."
        Exit Sub
    End If
    
    If Not IsNull(Me.tbExclusions) Then
        Exclusions = Split(Me.tbExclusions, ";")      ' Load whatever exclusions are to be in effect
    Else
        Exclusions = Split("NONE")                    ' Have at least one array element
    End If
    
    FileCount = 0                     ' Container for the number of files deleted
    ReDim StackArr(0)                 ' Initialize stack array to a single element
    
    Push ("IsEmpty")                  ' Initialze stack with terminating directory expression
    StackEntry = tbRootExp            ' Start as though we just popped a directory name off the stack
    
        Do Until StackEntry = "IsEmpty"
            strFileName = Dir(StackEntry, vbDirectory)              ' Wanting file names or names of sub-directories
    
                Do While strFileName <> ""
                    If Not (strFileName = "." Or strFileName = "..") Then   ' Entries to ignore
                        If InStr(strFileName, ".") = 0 Then
                            Push (StackEntry & strFileName & "\")   ' Append sub-folder name and put dir expression on the stack
                        Else
                            Call FileDisposition
                        End If
                    End If
                strFileName = Dir                                   ' Can be a file name or a sub-directory name
                Loop
    
        StackEntry = Pop()
        Loop
    
    MsgBox "Traversing completed. " & FileCount & " Files deleted."
    Exit Sub
    
    DirError:
    
    MsgBox "Directory Crawler has encountered the following error:" & vbNewLine _
         & Err.Description & vbNewLine _
         & "The accompanying error code is: " & Err.Number
    Exit Sub
    
    End Sub
     
    Private Sub FileDisposition()
    '*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
    ' It is in this sub that anything specific about the current file is handled.  The file
    ' name is strFileName and is contained in the fully qualified folder path, StackEntry.
    ' Both those values have global scope herein.
    '
    '*=*=*=*=*=*=(The disposition)=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
    ' We're looking here to delete the errant files described earlier.  The code here can be
    ' completely replaced if other dispositions of the current file are being considered.
    '*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
    
    strPosition = InStr(strFileName, "~")
        If strPosition > 0 Then                 'Our tell-tell character present in current file name?
            If strPosition > 5 And Mid(strFileName, strPosition - 4, 1) = "." Then  ' Sub-string of the form ".xxx~"
                Kill (StackEntry & strFileName)
                FileCount = FileCount + 1
            End If
        End If
    
    End Sub
    
    Private Function Push(LastIn As String) As String
    '*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
    ' If the "LastIn" folder isn't found in the exclusions list, re-dimension the stack array
    ' to provide for a single addition to the stack.
    '*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
    
        For I = 0 To UBound(Exclusions)
            If LastIn = Trim(Exclusions(I)) Then Exit Function
        Next I
    
        idx = UBound(StackArr) + 1
        ReDim Preserve StackArr(idx)
        StackArr(idx) = LastIn
    
    End Function
    
    Private Function Pop() As String
    '*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
    ' Set the returned value to the last element on the stack.  Then, re-dimension the array
    ' (Stack) to reflect the removable of the last element.  (VBA doesn't provide for an
    ' automatic "throw away" of trailing elements if a "ReDim" reduces its original size, so
    ' it becomes necessary to copy to a temporary array then copy the elements back to the
    ' newly re-dimensioned array.)
    '
    ' Note that the code is insensitive to an empty array in the current application, as the
    ' stack contains a terminating expression as its first element.
    '*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
    Dim TmpStackArr() As String           ' We need a temporary array in the course of reducing size of our stack
    
            idx = UBound(StackArr)
            
            Pop = StackArr(idx)           ' Last in, First out: (last element of the Stack array.)
            
                If StackArr(idx) <> "IsEmpty" Then             ' Only necessary to perform the copy operation if there
                                                               ' are more stack entries to process
                    ReDim TmpStackArr(UBound(StackArr) - 1)    ' Temporary array one element less than the stack.
    
                    For I = 0 To UBound(StackArr) - 1          ' Copy remaining stack entries to temporary array
                        TmpStackArr(I) = StackArr(I)
                    Next I
                    StackArr = TmpStackArr                     ' Now, move the entries back thereby updating the remaining stack
                End If
    
    End Function


  2. #2
    Rod is offline Expert
    Windows 7 64bit Access 2007
    Join Date
    Jun 2011
    Location
    Metro Manila, Philippines
    Posts
    679
    Hi Bill,

    Thanks for this.

    I too have been tinkering with a directory crawler over the past months. One thing I found is that use of Dir seems to be slow and I've been looking for a Windows API to replace it. Do you (or anyone else) know of such an API - there must be one, it's just a matter of identifying it (or them).

    Examining your code I see you store unexamined folders in an array (your LIFO) which you keep redimensioning. The system will get geometrically slower as/if the array fills. Is there a reason you did not use a collection or scripting dictionary?

  3. #3
    GraeagleBill's Avatar
    GraeagleBill is offline Experienced Old Geezer
    Windows 7 64bit Access 2003
    Join Date
    Feb 2011
    Posts
    1,919
    Sorry for the delay in responding. With a super fast desktop machine complete with SSD drives, even if the DIR function were a bit slow in general I'd likely not notice. I ran the app against an entire drive and it only took a hand-full of seconds. The choice of using an array versus a collection was purely arbitrary. I had previously written an app somewhat similar in nature and used an array, so I sort of had that method "on-the-brain".
    Bill

Please reply to this thread with any new information or opinions.

Similar Threads

  1. General Module - Implementing LiFo Stack
    By GraeagleBill in forum Programming
    Replies: 2
    Last Post: 05-13-2014, 01:15 PM
  2. Implementation Question
    By robrich22 in forum Programming
    Replies: 3
    Last Post: 02-19-2013, 04:15 PM
  3. Error 28 Out of Stack Space
    By loulou in forum Programming
    Replies: 1
    Last Post: 03-30-2012, 10:59 AM
  4. Implementation of DSN
    By seageath in forum Database Design
    Replies: 0
    Last Post: 02-28-2012, 09:07 PM
  5. Error 28: Out of Stack Space??
    By mugsmugs in forum Access
    Replies: 1
    Last Post: 02-22-2009, 09:54 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums