Controlli - Directory

Visual # ricerca directory e subdirectory - individuazione di tutti i files contenuti nel driver
Private Sub command1_click()
    On Error Goto errore
    
    Dim evento, contoquantifiles As Integer
    Dim num_subdirectory As Integer
    Dim indice As Integer
    Dim nome_file As String
    Dim listasubdirectory() As String
    Dim percorso_attuale As String
    Dim ora As string, minuti As String
    Dim cercadoppia As Integer
    num_subdirectory = 0
    indice = 0
    ' per velocizzare questa finestra, si mette list1.visible = false
    list1.visible = False
    ' esamina la root
    dir1.refresh
    dir1.path = Mid(drive1.drive, 1, 2) & "\"
    percorso_attuale = dir1.path
    chdir (dir1.path)
    percorso_attuale = curdir(Mid(drive1.drive, 1, 1))
    nome_file = dir(percorso_attuale & "*.*", vbdirectory)
    Do While (nome_file <> "")
        If (getattr(percorso_attuale & nome_file) = vbdirectory) Then
            If (nome_file <> ".") And (nome_file <> "..") Then
                num_subdirectory = num_subdirectory + 1
                Redim preserve listasubdirectory(1 To num_subdirectory)
                listasubdirectory(num_subdirectory) = Mid(percorso_attuale, 3) & nome_file
            End If
        Else
            ' data1.recordset.addnew
            screen.mousepointer = 13
            
            ' text8.refresh
            contoquantifiles = contoquantifiles + 1
            text5.text = contoquantifiles
            text5.refresh
            ' data1.recordset.fields("disco_num") = disconumero
            ' data1.recordset.fields("contenitor") = contenitore
            ' data1.recordset.fields("nomefiles") = mid(nome_file, 1, 50)
            ' data1.recordset.fields("directory") = percorso_attuale
            ' data1.recordset.fields("lunghezza") = filelen(percorso_attuale & nome_file)
            ' data1.recordset.fields("data_file") = mid(filedatetime(percorso_attuale & nome_file), 1, 8)
            
            '    label2.caption = " " & ucase(percorso_attuale) & "\" & nome_file
            '    label2.refresh
            ' per la variabile composta dalla root e nomefiles, si forma alle vole la doppia \\ _
            e queste 5 riche di codice servono a cancellare le doppie \\
            cercadoppia = instr(1, Ucase(percorso_attuale) & "\" & nome_file, "\\")
            
            If cercadoppia > 0 Then
                label2.caption = Ucase(percorso_attuale) & nome_file
            Else
                label2.caption = " " & Ucase(percorso_attuale) & "\" & nome_file
                label2.refresh
            End If
            
            If nome_file <> "" Then
                list1.additem contoquantifiles & ")  " & label2.caption
            End If
            
            If Len(Hour(filedatetime(percorso_attuale & nome_file))) = 1 Then
                ora = "0" & Hour(filedatetime(percorso_attuale & nome_file))
            Else
                ora = Hour(filedatetime(percorso_attuale & nome_file))
            End If
            If Len(minute(filedatetime(percorso_attuale & nome_file))) = 1 Then
                minuti = "0" & minute(filedatetime(percorso_attuale & nome_file))
            Else
                minuti = minute(filedatetime(percorso_attuale & nome_file))
            End If
            If (ora & ":" & minuti) = ":" Then
                ora = "00"
                minuti = "00"
            End If
            ' data1.recordset.fields("time_file") = ora & ":" & minuti
            ' data1.updaterecord
            ' data1.recordset.bookmark = data1.recordset.lastmodified
            screen.mousepointer = 13
        End If
        nome_file = dir
        ' uscita temporanea dal loop in attesa di un tasto di interruzione
        evento = doevents()
        If esci = True Then
            screen.mousepointer = 0
            If fermatutto = True Then
                esci = False
                Exit Sub
            End If
        End If
    Loop
    
    ' itera il procedimento sulle sottodirectory
    dir1.refresh
    dir1.path = Mid(drive1.drive, 1, 2)
    percorso_attuale = dir1.path
    chdir (dir1.path)
    percorso_attuale = curdir(Mid(drive1.drive, 1, 1))
    
    Do While (indice < num_subdirectory)
        indice = indice + 1
        chdir (Mid(drive1.drive, 1, 2) & listasubdirectory(indice))
        percorso_attuale = curdir(Mid(drive1.drive, 1, 1))
        nome_file = dir(percorso_attuale & "\*.*", vbdirectory)
        Do While (nome_file <> "")
            On Error Resume Next
            If (getattr(percorso_attuale & "\" & nome_file) = vbdirectory) Then
                If (nome_file <> ".") And (nome_file <> "..") Then
                    num_subdirectory = num_subdirectory + 1
                    Redim preserve listasubdirectory(1 To num_subdirectory)
                    listasubdirectory(num_subdirectory) = Mid(percorso_attuale, 3) & "\" & nome_file
                End If
            Else
                '  data1.recordset.addnew
                screen.mousepointer = 13
                
                contoquantifiles = contoquantifiles + 1
                text5.text = contoquantifiles
                text5.refresh
                
                '     data1.recordset.fields("disco_num") = disconumero
                '    data1.recordset.fields("contenitor") = contenitore
                '    data1.recordset.fields("nomefiles") = mid(nome_file, 1, 50)
                '    data1.recordset.fields("directory") = percorso_attuale
                '    data1.recordset.fields("lunghezza") = filelen(percorso_attuale & "\" & nome_file)
                '    data1.recordset.fields("data_file") = mid(filedatetime(percorso_attuale & "\" & nome_file), 1, 8)
                '         label2.caption = " " & ucase(percorso_attuale) & "\" & nome_file
                '    label2.refresh
                cercadoppia = instr(1, Ucase(percorso_attuale) & "\" & nome_file, "\\")
                
                If cercadoppia > 0 Then
                    label2.caption = Ucase(percorso_attuale) & nome_file
                Else
                    label2.caption = " " & Ucase(percorso_attuale) & "\" & nome_file
                    label2.refresh
                End If
                If nome_file <> "" Then
                    list1.additem contoquantifiles & ")  " & label2.caption
                End If
                
                If Len(Hour(filedatetime(percorso_attuale & "\" & nome_file))) = 1 Then
                    ora = "0" & Hour(filedatetime(percorso_attuale & "\" & nome_file))
                Else
                    ora = Hour(filedatetime(percorso_attuale & "\" & nome_file))
                End If
                If Len(minute(filedatetime(percorso_attuale & "\" & nome_file))) = 1 Then
                    minuti = "0" & minute(filedatetime(percorso_attuale & "\" & nome_file))
                Else
                    minuti = minute(filedatetime(percorso_attuale & "\" & nome_file))
                End If
                If (ora & ":" & minuti) = ":" Then
                    ora = "00"
                    minuti = "00"
                End If
                '    data1.recordset.fields("time_file") = ora & ":" & minuti
                '    data1.updaterecord
                '    data1.recordset.bookmark = data1.recordset.lastmodified
                screen.mousepointer = 13
                
            End If
            nome_file = dir
            ' uscita temporanea dal loop in attesa di un tasto di interruzione
            evento = doevents()
            If esci = True Then
                screen.mousepointer = 0
                If fermatutto = True Then
                    esci = False
                    Exit Sub
                End If
            End If
            
        Loop
        
        ' uscita temporanea dal loop in attesa di un tasto di interruzione
        evento = doevents()
        If esci = True Then
            screen.mousepointer = 0
            If fermatutto = True Then
                esci = False
                Exit Sub
            End If
        End If
    Loop
    screen.mousepointer = 0
    
    list1.visible = True
    command2.enabled = True
    errore:
    Resume Next
End Sub

Private Sub text4_change()
End Sub

Private Sub command2_click()
    Dim msg As String
    Dim i As Integer
    msg = inputbox("inserisci il nome del files da creare unitamente alla sua directory")
    If msg <> "" Then
        Open msg For Output shared As #1
        For i = 0 To list1.listcount
            msg = list1.list(i)
            Print #1, msg
        Next
        Close #1
    End If
End Sub

Visual # ricerca directory e subdirectory - individuazione di tutti i files contenuti nel driver
Private Sub command1_click()
On Error Goto errore

Dim evento, contoquantifiles As Integer
Dim num_subdirectory As Integer
Dim indice As Integer
Dim nome_file As String
Dim listasubdirectory() As String
Dim percorso_attuale As String
Dim ora As string, minuti As String
Dim cercadoppia As Integer
num_subdirectory = 0
indice = 0
' per velocizzare questa finestra, si mette list1.visible = false

list1.visible = False
' esamina la root

dir1.refresh
dir1.path = Mid(drive1.drive, 1, 2) & "\"
percorso_attuale = dir1.path
chdir (dir1.path)
percorso_attuale = curdir(Mid(drive1.drive, 1, 1))
nome_file = dir(percorso_attuale & "*.*", vbdirectory)
Do While (nome_file <> "")
If (getattr(percorso_attuale & nome_file) = vbdirectory) Then
If (nome_file <> ".") And (nome_file <> "..") Then
num_subdirectory = num_subdirectory + 1
Redim preserve listasubdirectory(1 To num_subdirectory)
listasubdirectory(num_subdirectory) = Mid(percorso_attuale, 3) & nome_file
End If
Else
' data1.recordset.addnew

screen.mousepointer = 13

' text8.refresh

contoquantifiles = contoquantifiles + 1
text5.text = contoquantifiles
text5.refresh
' data1.recordset.fields("disco_num") = disconumero

' data1.recordset.fields("contenitor") = contenitore

' data1.recordset.fields("nomefiles") = mid(nome_file, 1, 50)

' data1.recordset.fields("directory") = percorso_attuale

' data1.recordset.fields("lunghezza") = filelen(percorso_attuale & nome_file)

' data1.recordset.fields("data_file") = mid(filedatetime(percorso_attuale & nome_file), 1, 8)

' label2.caption = " " & ucase(percorso_attuale) & "\" & nome_file

' label2.refresh

' per la variabile composta dalla root e nomefiles, si forma alle vole la doppia \\ _

e queste 5 riche di codice servono a cancellare le doppie \\
cercadoppia = instr(1, Ucase(percorso_attuale) & "\" & nome_file, "\\")

If cercadoppia > 0 Then
label2.caption = Ucase(percorso_attuale) & nome_file
Else
label2.caption = " " & Ucase(percorso_attuale) & "\" & nome_file
label2.refresh
End If

If nome_file <> "" Then
list1.additem contoquantifiles & ") " & label2.caption
End If

If Len(Hour(filedatetime(percorso_attuale & nome_file))) = 1 Then
ora = "0" & Hour(filedatetime(percorso_attuale & nome_file))
Else
ora = Hour(filedatetime(percorso_attuale & nome_file))
End If
If Len(minute(filedatetime(percorso_attuale & nome_file))) = 1 Then
minuti = "0" & minute(filedatetime(percorso_attuale & nome_file))
Else
minuti = minute(filedatetime(percorso_attuale & nome_file))
End If
If (ora & ":" & minuti) = ":" Then
ora = "00"
minuti = "00"
End If
' data1.recordset.fields("time_file") = ora & ":" & minuti

' data1.updaterecord

' data1.recordset.bookmark = data1.recordset.lastmodified

screen.mousepointer = 13
End If
nome_file = dir
' uscita temporanea dal loop in attesa di un tasto di interruzione

evento = doevents()
If esci = True Then
screen.mousepointer = 0
If fermatutto = True Then
esci = False
Exit Sub
End If
End If
Loop

' itera il procedimento sulle sottodirectory

dir1.refresh
dir1.path = Mid(drive1.drive, 1, 2)
percorso_attuale = dir1.path
chdir (dir1.path)
percorso_attuale = curdir(Mid(drive1.drive, 1, 1))

Do While (indice < num_subdirectory)
indice = indice + 1
chdir (Mid(drive1.drive, 1, 2) & listasubdirectory(indice))
percorso_attuale = curdir(Mid(drive1.drive, 1, 1))
nome_file = dir(percorso_attuale & "\*.*", vbdirectory)
Do While (nome_file <> "")
On Error Resume Next
If (getattr(percorso_attuale & "\" & nome_file) = vbdirectory) Then
If (nome_file <> ".") And (nome_file <> "..") Then
num_subdirectory = num_subdirectory + 1
Redim preserve listasubdirectory(1 To num_subdirectory)
listasubdirectory(num_subdirectory) = Mid(percorso_attuale, 3) & "\" & nome_file
End If
Else
' data1.recordset.addnew

screen.mousepointer = 13

contoquantifiles = contoquantifiles + 1
text5.text = contoquantifiles
text5.refresh

' data1.recordset.fields("disco_num") = disconumero

' data1.recordset.fields("contenitor") = contenitore

' data1.recordset.fields("nomefiles") = mid(nome_file, 1, 50)

' data1.recordset.fields("directory") = percorso_attuale

' data1.recordset.fields("lunghezza") = filelen(percorso_attuale & "\" & nome_file)

' data1.recordset.fields("data_file") = mid(filedatetime(percorso_attuale & "\" & nome_file), 1, 8)

' label2.caption = " " & ucase(percorso_attuale) & "\" & nome_file

' label2.refresh

cercadoppia = instr(1, Ucase(percorso_attuale) & "\" & nome_file, "\\")

If cercadoppia > 0 Then
label2.caption = Ucase(percorso_attuale) & nome_file
Else
label2.caption = " " & Ucase(percorso_attuale) & "\" & nome_file
label2.refresh
End If
If nome_file <> "" Then
list1.additem contoquantifiles & ") " & label2.caption
End If

If Len(Hour(filedatetime(percorso_attuale & "\" & nome_file))) = 1 Then
ora = "0" & Hour(filedatetime(percorso_attuale & "\" & nome_file))
Else
ora = Hour(filedatetime(percorso_attuale & "\" & nome_file))
End If
If Len(minute(filedatetime(percorso_attuale & "\" & nome_file))) = 1 Then
minuti = "0" & minute(filedatetime(percorso_attuale & "\" & nome_file))
Else
minuti = minute(filedatetime(percorso_attuale & "\" & nome_file))
End If
If (ora & ":" & minuti) = ":" Then
ora = "00"
minuti = "00"
End If
' data1.recordset.fields("time_file") = ora & ":" & minuti

' data1.updaterecord

' data1.recordset.bookmark = data1.recordset.lastmodified

screen.mousepointer = 13

End If
nome_file = dir
' uscita temporanea dal loop in attesa di un tasto di interruzione

evento = doevents()
If esci = True Then
screen.mousepointer = 0
If fermatutto = True Then
esci = False
Exit Sub
End If
End If

Loop

' uscita temporanea dal loop in attesa di un tasto di interruzione

evento = doevents()
If esci = True Then
screen.mousepointer = 0
If fermatutto = True Then
esci = False
Exit Sub
End If
End If
Loop
screen.mousepointer = 0

list1.visible = True
command2.enabled = True
errore:
Resume Next
End Sub

Private Sub text4_change()
End Sub

Private Sub command2_click()
Dim msg As String
Dim i As Integer
msg = inputbox("inserisci il nome del files da creare unitamente alla sua directory")
If msg <> "" Then
Open msg For Output shared As #1
For i = 0 To list1.listcount
msg = list1.list(i)
Print #1, msg
Next
Close #1
End If
End Sub