hola buenas nochess. estoy tratando de hacer un modulo para listar archivos y carpetas , actualmente me manejo con FileSystemObject , y con la funcion DIR(), o con los controles de usuarion drive y file, dir listbox. quiero hacer algo diferente , puede ser que existan algunas apis que desconozca , me pueden dar una mano.
nota : que se muestren carpetas y archivos ocultos y protegidos por el sistema.
tienen algun código por ahi ? graxx
aqui las apis de manejo de archivos de windows
creo que dir es un alias de la api findNextFile, con eso puedes manejar las capetas con más precision y control que con dir
Apis que necesitas para listar carpetas y archivos:
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Si miras por la web encontraras ejemplos como este (http://allapi.mentalis.org/apilist/DAD43CF20ED09D1897B0ECAAF0BF86EE.html)...
y mi link? :( por que no está... buhh!!! :-( yo puse el de msdn
HAce ya un tiempo atras cree varias clases una de ellas para tratar la busqueda de archivos:
cls_files.cls
'
' /////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) //
' // //
' // Web: http://InfrAngeluX.Sytes.Net/ //
' // //
' // |-> Pueden Distribuir Este codigo siempre y cuando //
' // no se eliminen los creditos originales de este codigo //
' // No importando que sea modificado/editado o engrandecido //
' // o achicado, si es en base a este codigo //
' /////////////////////////////////////////////////////////////
Option Explicit
Private Declare Function lstrcmp Lib "kernel32" Alias "lstrcmpA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function FindFirstFile& Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName$, lpFindFileData As WIN32_FIND_DATA)
Private Declare Function FindNextFile& Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile&, lpFindFileData As WIN32_FIND_DATA)
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose& Lib "kernel32" (ByVal hFindFile&)
Const MAX_PATH As Integer = 260
Const MAXDWORD As Long = &HFFFF
Const INVALID_HANDLE_VALUE As Long = -1
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 * MAX_PATH
cAlternate As String * 14
End Type
Event Folder(ByRef PathFolder As String, ByVal Atrributes As VbFileAttribute)
Event File(ByRef NameFile As String, ByRef TypeOfFile As Long, ByVal Atrributes As VbFileAttribute)
Event Begin()
Event Finish()
Private Priv_StrDir$, Priv_StrCri$(), Priv_IncFolder As Boolean, Priv_Cancel As Boolean
Private Priv_CriFindInDir As VbFileAttribute, Priv_CriFindInFile As VbFileAttribute
Private Hwnd_SearchF&(), LS_Index&(0 To 1), BytesNow_#
Private Bool_Run As Byte
Public AllowEvents As Boolean
Private Sub Class_Initialize()
Priv_IncFolder = True
AllowEvents = True
Priv_CriFindInDir = vbDirectory
Priv_CriFindInFile = vbArchive
End Sub
Public Property Get BytesNow#()
BytesNow# = BytesNow_#
End Property
Public Property Get FindInPath() As String
FindInPath = Priv_StrDir$
End Property
Public Property Let FindInPath(ByVal vData$)
Call Stop_
Call NormalizePath&(vData$)
Priv_StrDir$ = vData$
End Property
Public Property Get CriterionFindDir() As VbFileAttribute
CriterionFindDir = Priv_CriFindInDir
End Property
Public Property Let CriterionFindDir(ByVal vData As VbFileAttribute)
Call Stop_
Priv_CriFindInDir = vData Or vbDirectory
End Property
Public Property Get CriterionFindFile() As VbFileAttribute
CriterionFindFile = Priv_CriFindInFile
End Property
Public Property Let CriterionFindFile(ByVal vData As VbFileAttribute)
Call Stop_
Priv_CriFindInFile = vData Or vbArchive
End Property
Public Property Get CriterionToFind() As Variant
CriterionToFind = Priv_StrCri$
End Property
Public Property Let CriterionToFind(ByRef vData As Variant)
On Error GoTo Err_
Dim L_Index As Long
Call Stop_
Erase Priv_StrCri$
LS_Index&(0) = INVALID_HANDLE_VALUE
LS_Index&(1) = INVALID_HANDLE_VALUE
If IsArray(vData) Then
LS_Index&(0) = LBound(vData)
LS_Index&(1) = UBound(vData)
ReDim Priv_StrCri$(LS_Index&(0) To LS_Index&(1))
For L_Index = LS_Index&(0) To LS_Index&(1)
Priv_StrCri$(L_Index) = CStr(vData(L_Index))
Next L_Index
Else
LS_Index&(0) = 0
LS_Index&(0) = 0
ReDim Priv_StrCri$(0)
Priv_StrCri$(0) = vData
End If
Exit Property
Err_:
Err.Clear
End Property
Public Property Get IncludeSubFolders() As Boolean: IncludeSubFolders = Priv_IncFolder: End Property
Public Property Let IncludeSubFolders(ByVal vData As Boolean): Priv_IncFolder = vData: End Property
Public Property Get ItsRun() As Boolean: ItsRun = Bool_Run = 1: End Property
Public Sub Stop_(): Bool_Run = 0: Priv_Cancel = True: End Sub
Public Function Start_(Optional StrFindInPath As Variant = "", Optional StrCriterionToFind As Variant = Nothing) As Double
Call Stop_
BytesNow_# = 0
If Not StrFindInPath = "" Then FindInPath = StrFindInPath
If Not IsObject(StrCriterionToFind) Then CriterionToFind = StrCriterionToFind
If Not (LS_Index&(0) = INVALID_HANDLE_VALUE And LS_Index&(0) = INVALID_HANDLE_VALUE) And Priv_StrDir$ <> "" And CStr(Dir(Priv_StrDir$, vbDirectory)) <> "" Then
RaiseEvent Begin
Bool_Run = 1
Priv_Cancel = False
Call FindFilesAPI#(Priv_StrDir$, Priv_StrCri$())
Start_# = BytesNow_#
Bool_Run = 0
RaiseEvent Finish
End If
End Function
Private Sub FindFilesAPI(ByVal StrPath$, ByRef StrSearch$())
Dim str_NameNow$
Dim Str_NameDir$()
Dim Lng_DirCant&
Dim Lng_DirCount&
Dim LF_Index&
'Dim Lng_Res&
Dim Hwnd_Search&
Dim WFD As WIN32_FIND_DATA
Lng_DirCount& = 0
Hwnd_Search& = FindFirstFile&(StrPath$ & "*", WFD)
If Hwnd_Search& <> INVALID_HANDLE_VALUE Then
RaiseEvent Folder(StrPath$, WFD.dwFileAttributes)
Do
If AllowEvents Then DoEvents
If Priv_Cancel Then Exit Sub
With WFD
str_NameNow$ = Left$(.cFileName, InStr(.cFileName, Chr(0)) - 1)
If (((.dwFileAttributes Or Priv_CriFindInDir) = .dwFileAttributes) And ((.dwFileAttributes And vbDirectory) = vbDirectory)) Then
If (str_NameNow$ <> ".") And (str_NameNow$ <> "..") Then
ReDim Preserve Str_NameDir$(Lng_DirCount&)
Str_NameDir$(Lng_DirCount&) = str_NameNow$
Lng_DirCount& = Lng_DirCount& + 1
End If
End If
End With
Loop While FindNextFile&(Hwnd_Search&, WFD)
Call FindClose(Hwnd_Search&)
For LF_Index& = LS_Index&(0) To LS_Index&(1)
Hwnd_Search& = FindFirstFile&(StrPath$ & StrSearch$(LF_Index&), WFD)
If Hwnd_Search& <> INVALID_HANDLE_VALUE Then
Do
If AllowEvents Then DoEvents
If Priv_Cancel Then Exit Sub
With WFD
str_NameNow$ = Left$(.cFileName, InStr(.cFileName, Chr(0)) - 1)
If (((.dwFileAttributes Or Priv_CriFindInFile) = .dwFileAttributes) And ((.dwFileAttributes And vbArchive) = vbArchive)) Then
If (str_NameNow$ <> ".") And (str_NameNow$ <> "..") Then
BytesNow_# = BytesNow_# + ((.nFileSizeHigh& * MAXDWORD&) + .nFileSizeLow&) + 0
RaiseEvent File(str_NameNow$, LF_Index&, .dwFileAttributes)
End If
End If
End With
Loop While FindNextFile&(Hwnd_Search&, WFD)
Call FindClose(Hwnd_Search&)
End If
Next LF_Index
If Lng_DirCount& > 0 And Priv_IncFolder Then
For Lng_DirCant& = 0 To Lng_DirCount& - 1
Call FindFilesAPI#(StrPath$ & Str_NameDir$(Lng_DirCant&) & "\", StrSearch$)
Next
End If
End If
End Sub
' Returns
' // 0 = NoPathValid
' // 1 = Ok
' // 2 = Fixed/Ok
Public Function NormalizePath&(ByRef sData$)
If Strings.Len(sData$) > 1 Then
sData$ = Strings.Replace(sData$, "/", "\")
If Not Strings.Right$(sData$, 1) = "\" Then
sData$ = sData$ & "\"
NormalizePath& = 2
Else
NormalizePath& = 1
End If
Else
NormalizePath& = 0
End If
End Function
Ejemplo:
Option Explicit
Private WithEvents ClsScanDisk As cls_files
Private ThisPath$
Private CountFiles&
Private Sub ClsScanDisk_Begin()
ThisPath$ = ClsScanDisk.FindInPath
CountFiles& = 0
Caption = "ScanDisk ha Encontrado: "
End Sub
Private Sub ClsScanDisk_File(NameFile As String, TypeOfFile As Long, ByVal Atrributes As Long)
CountFiles& = CountFiles& + 1
Caption = "ScanDisk ha Encontrado: " & CountFiles&
Debug.Print ThisPath$ & NameFile
Debug.Print vbTab & "Criterio:"; ClsScanDisk.CriterionToFind(TypeOfFile),
Debug.Print "Atributos:"; Atrributes
End Sub
Private Sub ClsScanDisk_Finish()
Caption = "ScanDisk ha Encontrado: " & CountFiles& & " -> Finalizado."
End Sub
Private Sub ClsScanDisk_Folder(PathFolder As String, ByVal Atrributes As Long)
ThisPath$ = PathFolder
End Sub
Private Sub Form_Load()
If ClsScanDisk Is Nothing Then Set ClsScanDisk = New cls_files
With ClsScanDisk
If .ItsRun Then .Stop_
.CriterionToFind = Split("*.mp3,*.wma,*.avi,*.mid,*.mid", ",")
'.CriterionFindDir = vbReadOnly ' // Solo directorios de Solo lectura.
'.CriterionFindFile = vbHidden Or vbReadOnly ' // Solo archivos ocultos.
.FindInPath = "c:\"
.AllowEvents = True
Call .Start_
End With
End Sub
Dulces Lunas!¡.