Api, carpetas y archivos.

Iniciado por rembolso, 3 Abril 2014, 03:33 AM

0 Miembros y 1 Visitante están viendo este tema.

rembolso

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

engel lex

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
El problema con la sociedad actualmente radica en que todos creen que tienen el derecho de tener una opinión, y que esa opinión sea validada por todos, cuando lo correcto es que todos tengan derecho a una opinión, siempre y cuando esa opinión pueda ser ignorada, cuestionada, e incluso ser sujeta a burla, particularmente cuando no tiene sentido alguno.

noele1995

Apis que necesitas para listar carpetas y archivos:
Código (vb) [Seleccionar]
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...

engel lex

y mi link? :( por que no está... buhh!!!  :-( yo puse el de msdn
El problema con la sociedad actualmente radica en que todos creen que tienen el derecho de tener una opinión, y que esa opinión sea validada por todos, cuando lo correcto es que todos tengan derecho a una opinión, siempre y cuando esa opinión pueda ser ignorada, cuestionada, e incluso ser sujeta a burla, particularmente cuando no tiene sentido alguno.

BlackZeroX

HAce ya un tiempo atras cree varias clases una de ellas para tratar la busqueda de archivos:

cls_files.cls
Código (vb) [Seleccionar]

'
'   /////////////////////////////////////////////////////////////
'   // 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:

Código (vb) [Seleccionar]

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!¡.
The Dark Shadow is my passion.