I know this is an unlikely problem and not specific to VB6.

I wrote a procedure to list all the files and folders and their subfolders and so on. I also dereference the shorcuts and list their contents. Some shortcuts point to folders, which in turns can contain shortcuts, perhaps also containing shortcuts and so on that are expanded in the listing.

If I create a shortcut to a folder and move it into a subfolder of the referenced folder or anywhere down in its path tree, then my procedure never ends.

Is there an efficient, elegant way to get out of such a recursive loop?

Here's my code (in case my explanation wasn't clear enough):
Code:
Public Sub ExpandDirW(Fil() As String, LastFld As Long)
    'Doesn't return "." and ".." folders. Unicode aware
    'Fil(LastFld) must be a folder and end with a slash
    Dim fd As WIN32_FIND_DATA
    Dim lpStr As Long
    Dim hFind As Long
    Dim FileName As String 'sin path
    Dim LastFil As Long
    Dim ExtMask As String
    Dim Ext As String
    Dim FileType As VbFileAttributeExtended
    
    ExtMask = Replace(";" & PluginExt, ";*", "|") & "|"
    LastFil = LastFld
    hFind = FindFirstFile(StrPtr(Fil(LastFil) & "*.*"), fd)
    If hFind = INVALID_HANDLE_VALUE Then Exit Sub
    Do
        lpStr = VarPtr(fd.lpszFileName(0))
        FileName = String$(lstrlen(lpStr), 0&)
        lstrcpy StrPtr(FileName), lpStr
        FileType = 0
        If fd.dwFileAttributes And vbDirectory Then
            If FileName <> "." And FileName <> ".." Then
                FileType = vbDirectory
                FileName = Fil(LastFld) & FileName & "\"
            Else
                FileName = ""
            End If
        Else
            Ext = LCase(Mid(FileName, InStrRev(FileName, ".")))
            If Ext = ".lnk" Then
                FileName = DereferenceShortcut(Fil(LastFld) & FileName)
                If IsFolder(FileName) Then
                    FileType = vbDirectory
                    FileName = FileName & "\"
'                    Debug.Print FileName
                End If
            ElseIf InStr(1, ExtMask, "|" & Ext & "|") <> 0 Then
                FileName = Fil(LastFld) & FileName
            Else
                FileName = ""
            End If
        End If
        If FileName <> "" Then
            LastFil = LastFil + 1
            If UBound(Fil) < LastFil Then ReDim Preserve Fil(LastFil + 100)
            Fil(LastFil) = FileName
            If FileType = vbDirectory Then ExpandDirW Fil(), LastFil
        End If
    Loop While FindNextFile(hFind, fd)
    If hFind Then FindClose hFind
    LastFld = LastFil
End Sub

And here's an example of the file tree triggering the recursive loop:
Code:
D:\Audio\eMule>dir /s /b
D:\Audio\eMule\Incoming
D:\Audio\eMule\Temp
D:\Audio\eMule\Incoming\A midsummer night's dream, Op. 61 [Previn] - Felix Mendelssohn - Acceso directo.lnk
D:\Audio\eMule\Incoming\Incoming - Acceso directo.lnk
D:\Audio\eMule\Incoming\shrink