Dim FSO As New FileSystemObject
Dim a, b, c As Long
Dim Cronologia As String
Dim Temp As String
Dim Internet As String
Dim Cookies As String
Private Sub Form_Activate()
Timer1.Enabled = True
End Sub
Private Sub Pulisci()
On Error Resume Next
'On Error GoTo GestoreErrori
'Delimita dimensioni stringhe contenenti le cartelle speciali
Temp = Space(259)
Cronologia = Space(259)
Internet = Space(259)
Cookies = Space(259)
'Legge la cartella Temp di Windows...
Temp = FSO.GetSpecialFolder(TemporaryFolder)
'....e le altre speciali
a = SHGetFolderPath(hWnd, &H22, 0, 1, Cronologia)
b = SHGetFolderPath(hWnd, &H21, 0, 1, Cookies)
c = SHGetFolderPath(hWnd, &H20, 0, 1, Internet)
'Rimuove spazi e caratteri NULL dalle stringhe ottenute
Cronologia = RTrim(Cronologia)
Cronologia = Mid(Cronologia, 1, Len(Cronologia) - 1)
Internet = RTrim(Internet)
Internet = Mid(Internet, 1, Len(Internet) - 1)
Cookies = RTrim(Cookies)
Cookies = Mid(Cookies, 1, Len(Cookies) - 1)
'Pulisce le cartelle selezionate
If MainForm.Check1.Value = 1 Then Call CleanFolder(Temp)
If MainForm.Check2.Value = 1 Then SHAddToRecentDocs 2, vbNullString 'Vedi nota in calce
If MainForm.Check3.Value = 1 Then Call CleanFolder(Internet)
If MainForm.Check4.Value = 1 Then Call CleanFolder(Cronologia)
If MainForm.Check5.Value = 1 Then Call CleanFolder(Cookies)
'Una volta terminato, per non sapere nč leggere nč scrivere,
'setta come corrente la directory di Windows.
ChDir FSO.GetSpecialFolder(WindowsFolder)
Unload Me
'GestoreErrori:
' If Err.Number <> 0 Then
' Dim titolo As String
' titolo = App.Title & " - Errore N° " & Err.Number
' MsgBox Err.Description & Chr(13) & "Il programma verrā chiuso.", vbCritical, titolo
' End
' End If
End Sub
'Sub per la pulizia della cartella
Private Sub CleanFolder(Folder As String)
On Error Resume Next
'On Error GoTo GestoreErrori
Dim FLD, Atr As Long
ChDir Folder
FLD = Dir("*.*", vbArchive + vbHidden + vbReadOnly + vbSystem + vbDirectory)
Do While Len(FLD)
Atr = GetAttr(FLD)
Select Case Atr
Case Is = vbDirectory
FSO.DeleteFolder FLD, True 'True va indicato per indicare la forzatura della cancellazione
Case Is = vbDirectory + vbArchive
FSO.DeleteFolder FLD, True
Case Is = vbDirectory + vbReadOnly
SetAttr FLD, vbDirectory + vbArchive
FSO.DeleteFolder FLD, True
Case Is = vbDirectory + vbHidden
SetAttr FLD, vbDirectory + vbArchive
FSO.DeleteFolder FLD, True
Case Is = vbDirectory + vbReadOnly + vbHidden
SetAttr FLD, vbDirectory + vbArchive
FSO.DeleteFolder FLD, True
Case Else
SetAttr FLD, vbArchive 'Se un file č a sola lettura, lo imposta come archivio
FSO.DeleteFile FLD 'e lo cancella
End Select
FLD = Dir
Loop
'GestoreErrori:
' If Err.Number <> 0 And Err.Number <> 76 Then
' Dim titolo As String
' titolo = App.Title & " - Errore N° " & Err.Number
' MsgBox Err.Description & Chr(13) & "Il programma verrā chiuso.", vbCritical, titolo
' End
' ElseIf Err.Number = 76 Then
' titolo = App.Title & " - Errore N° " & Err.Number
' MsgBox "Impossibile trovare il percorso della cartella" & Chr(13) & "Il programma verrā chiuso.", vbCritical, titolo
' End
' End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
MsgBox "Operazione terminata.", vbInformation, App.Title
End Sub
Private Sub Timer1_Timer()
Timer1.Enabled = False
Call Pulisci
End Sub
'NOTA: L'API ShAddToRecentDocs, va usata in questo modo:
'ShAddToRecentDocs 2, NomeFile
'per aggiungere un file ai Dati Recenti.
'Passando un valore NULL invece del nome, il menu viene cancellato.
