Files& Folders

Borrar,Copiar,Mover, etc; Archivos y Dirs : http://www.canalvisualbasic.net/foro/gestion-de-archivos/borrar-copiar-mover-etc-archivos-y-dirs-2370/

Borrado irrecuperable de archivos: http://www.canalvisualbasic.net/foro/gestion-de-archivos/borrado-irrecuperable-de-archivos-6546/

Borrar Dir y todo sus Arch. en 2 Lineas : http://www.canalvisualbasic.net/foro/gestion-de-archivos/borrar-dir-y-todo-sus-arch-en-2-lineas-3346/

Recorrer directorios ( muy rapido )

http://vbsystemlibrary.free.fr/code.php?ID=33

Option Explicit

'-------------------------------------------------------

'TYPES

'-------------------------------------------------------

Private Type FILETIME

dwLowDateTime As Long

dwHighDateTime As Long

End Type

Private Type WIN32_FIND_DATA

dwFileAttributes As Long

ftCreationTime As FILETIME

ftLastAccessTime As FILETIME

ftLastWriteTime As FILETIME

nFileSizeHigh As Long

nFileSizeLow As Long

dwReserved0 As Long

dwReserved1 As Long

cFileName As String * 260

cAlternate As String * 14

End Type

'-------------------------------------------------------

'APIS

'-------------------------------------------------------

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Private Declare Function FindNextFile Lib "kernel32.dll" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long

'-------------------------------------------------------

'CONSTANTES

'-------------------------------------------------------

Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10

'-------------------------------------------------------

'énumère les fichiers d'un dossier

'de 1 à Ubound

'-------------------------------------------------------

Public Sub EnumFiles(ByVal Directory As String, Files() As String, Optional Begin As Boolean = False, Optional SubFolder As Boolean = True)

'infos d'un fichier et handle d'énumération

Dim FileInfo As WIN32_FIND_DATA, hFind As Long

'limite de Files

Static ub As Long

'si on commence la limite est 0, pas d'enregistrement dans le tableau

If Begin = True Then ub = 0

'ouvre le dossier pour récupérer la liste de ses fichiers

hFind = FindFirstFile(Directory & "*", FileInfo)

If hFind <> -1 Then

'si le fichier est un dossier

If (FileInfo.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then

'si ce n'est ni . ni ..

If InStr(FileInfo.cFileName, ".") <> 1 And SubFolder Then

'on récupère la liste des fichiers de ce sous dossier

EnumFiles Directory & Mid$(FileInfo.cFileName, 1, InStr(FileInfo.cFileName, vbNullChar) - 1) & "\", Files, False

End If

'sinon on l'ajoute à la fin de la liste

Else

ub = ub + 1

ReDim Preserve Files(ub)

'chemin complet

Files(ub) = Directory & Mid$(FileInfo.cFileName, 1, InStr(FileInfo.cFileName, vbNullChar) - 1)

End If

'tant qu'il y a des fichiers dans le dossier en cours

Do While FindNextFile(hFind, FileInfo)

'on peut arrêter à tout moment

DoEvents

'si le fichier est un dossier

If (FileInfo.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then

'si ce n'est ni . ni ..

If InStr(FileInfo.cFileName, ".") <> 1 And SubFolder Then

'on récupère la liste des fichiers de ce sous dossier

EnumFiles Directory & Mid$(FileInfo.cFileName, 1, InStr(FileInfo.cFileName, vbNullChar) - 1) & "\", Files, False

End If

'sinon on l'ajoute à la fin de la liste

Else

ub = ub + 1

ReDim Preserve Files(ub)

'chemin complet

Files(ub) = Directory & Mid$(FileInfo.cFileName, 1, InStr(FileInfo.cFileName, vbNullChar) - 1)

End If

Loop

End If

'ferme l'énumèration

FindClose hFind

End Sub

'-------------------------------------------------------

'énumère les sous dossiers d'un dossier

'de 1 à Ubound

'-------------------------------------------------------

Public Sub EnumFolders(ByVal Directory As String, Folders() As String, Optional Begin As Boolean = False, Optional SubFolder As Boolean = True)

'infos d'un fichier et handle d'énumération

Dim FileInfo As WIN32_FIND_DATA, hFind As Long, sDir As String

'limite de Files

Static ub As Long

'si on commence la limite est 0, pas d'enregistrement dans le tableau

If Begin = True Then ub = 0

'ouvre le dossier pour récupérer la liste de ses fichiers

hFind = FindFirstFile(Directory & "*", FileInfo)

If hFind <> -1 Then

'si le fichier est un dossier

If (FileInfo.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then

'si ce n'est ni . ni ..

If InStr(FileInfo.cFileName, ".") <> 1 And SubFolder Then

'on récupère la liste des fichiers de ce sous dossier

EnumFolders Directory & Mid$(FileInfo.cFileName, 1, InStr(FileInfo.cFileName, vbNullChar) - 1) & "\", Folders, False

End If

End If

'tant qu'il y a des fichiers dans le dossier en cours

Do While FindNextFile(hFind, FileInfo)

'on peut arrêter à tout moment

DoEvents

'si le fichier est un dossier

If (FileInfo.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then

'si ce n'est ni . ni ..

If InStr(FileInfo.cFileName, ".") <> 1 And SubFolder Then

'on récupère la liste des fichiers de ce sous dossier

EnumFolders Directory & Mid$(FileInfo.cFileName, 1, InStr(FileInfo.cFileName, vbNullChar) - 1) & "\", Folders, False

End If

sDir = Directory & Mid$(FileInfo.cFileName, 1, InStr(FileInfo.cFileName, vbNullChar) - 1)

If Right$(sDir, 3) <> "\.." Then

ub = ub + 1

ReDim Preserve Folders(ub)

'chemin complet

Folders(ub) = sDir

End If

End If

Loop

End If

'ferme l'énumèration

FindClose hFind

Private Sub CmdVer_Click()

Dim sFiles() As String

Dim sFolders() As String

Dim x As Long

'Me.List1.Clear

'Me.List2.Clear

ReDim sFiles(0) 'évite l'erreur dans le For... Ubound(sFile()) si aucun fichier trouvé

EnumFiles "c:\", sFiles(), True, False 'énumère les fichiers

EnumFolders "c:\", sFolders(), True, False 'énumère les dossiers

For x = 1 To UBound(sFiles())

List1.AddItem sFiles(x)

Next x

For x = 1 To UBound(sFolders())

List2.AddItem sFolders(x)

Next x

End Sub