Keskustelu: Ohjelmointikysymykset: VB6: Tiedostojen haku alikansioista

'Huom! Suurilla levyasemilla ohjelman suoritus kestää k a u a n
Private Sub Form_Load()
    asema$ = "D:\leffat\" 'haettava levyasema/hakemisto
    List1.AddItem asema$
    HaeAliHakemistot asema$, 0
End Sub

Sub HaeAliHakemistot(hak$, kerros%)
    kerros% = kerros% + 1
    ReDim hakemistot(255) As String
    ReDim tiedostot(255) As String
    x$ = Dir(hak$, vbDirectory)
    Do While x$ <> ""
        If GetAttr(hak$ + x$) = vbDirectory And Left$(x$, 1) <> "." Then
            haki% = haki% + 1
            hakemistot(haki%) = x$
        End If
        x$ = Dir
    Loop
    For i = 1 To haki%
        tied$ = Dir(hak$ + hakemistot(i) + "\*.avi", vbNormal)

        Do While tied$ <> ""
        If GetAttr(hak$ + hakemistot(i) + "\" + tied$) = vbNormal Then
            tiedi% = tiedi% + 1
            tiedostot(tiedi%) = tied$
        End If
        tied$ = Dir
        Loop

        For a = 1 To tiedi%
        List1.AddItem tiedostot(a)
        Next a

        List1.AddItem String$(kerros% * 3, "-") + hakemistot(i)
        HaeAliHakemistot hak$ + hakemistot(i) + "\", kerros%
    Next
    kerros% = kerros% - 1
    DoEvents 'haun voi keskeyttääkin
End Sub

Sub HaeAliHakemistot(hak$, kerros%)
    kerros% = kerros% + 1
    ReDim hakemistot(255) As String
    ReDim tiedostot(200) As String
    x$ = Dir(hak$, vbDirectory)
    Do While x$ <> ""
        If GetAttr(hak$ + x$) = vbDirectory And Left$(x$, 1) <> "." Then
            haki% = haki% + 1
            hakemistot(haki%) = x$

            tied$ = Dir(hak$ + x$ + "\*.avi")
            Do While tied$ <> ""
                If GetAttr(hak$ + x$ + "\" + tied$) = vbNormal Then
                    tiedi% = tiedi% + 1
                    tiedostot(tiedi%) = tied$
                End If
            Loop
            x$ = Dir
        End If

    Loop
    For i = 1 To haki%
        List1.AddItem String$(kerros% * 3, "-") + hakemistot(i)

        HaeAliHakemistot hak$ + hakemistot(i) + "\", kerros%
    Next
    kerros% = kerros% - 1
    DoEvents 'haun voi keskeyttääkin
End Sub

Dim DirList As New Collection, FileList As New Collection, strTemp As String
' lisää aloitushakemisto, pitää päättyä kenoviivaan
' aloitushakemistoja voi lisätä useammankin
DirList.Add "C:\"
' jatka niin kauan kuin hakemistoja löytyy
Do While DirList.Count
    ' hae ensimmäisen tiedoston nimi
    strTemp = Dir$(DirList(1), vbDirectory)
    ' jatka kunnes tiedostonimeä ei enää tule
    Do While LenB(strTemp)
        If strTemp = "." Or strTemp = ".." Then
            ' älä tee mitään
        ElseIf (GetAttr(DirList(1) & strTemp) And vbDirectory) = vbDirectory Then
            ' lisää hakemisto haettavien listaan
            ' kenoviiva on pakollinen tai homma ei pelaa
            DirList.Add DirList(1) & strTemp & "\"
        Else
            ' tähän voi lisätä esimerkiksi Select Casen,
            ' jolla rajoittaa lisättäviä tiedostoja
            FileList.Add DirList(1) & strTemp
        End If
        ' hae seuraava tiedosto
        strTemp = Dir$
    Loop
    ' poista juuri läpi käyty hakemisto
    DirList.Remove 1
Loop
' nyt FileList sisältää tiedostot