.

 
'
'   /////////////////////////////////////////////////////////////
'   // 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&(1) = 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
 
 

Modo de declaración...

 
Private WithEvents ClsScanDisk          As Cls_Files
 
' // Proceso X
    If ClsScanDisk Is Nothing Then Set ClsScanDisk = New Cls_Files
    With ClsScanDisk
        If .ItsRun Then Call .Stop_
        .CriterionToFind = Split("*.mp3,*.wma,*.mid,*.midi", ",")
        '   //  ó tambien...
        .CriterionToFind = "*.mp3"
        .FindInPath = "c:\"
        Call .Start_
    End With
' // Fin Proceso X
 
 

Eventos:

 
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()
 
 

 
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
 
 

Dulce Infierno Lunar!¡.

Lo tenia hecho desde hace tiempo. solo lo he liberado, por que no tiene caso un codigo...

una prueba de ello es que si decompilas con vb compiler alguno de estos dos EXE posteados en esos proyectos prueba encontraras dicho modulo.

http://foro.rthacker.net/programacion-visual-basic/%28beta-tester%27s%29-listviewex-ctl-cls_files-cls/

Asi que no es competencia de ningun tipo!¡.

Dulce Infierno Lunar!¡.

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()
 

Tengo problemas en esos eventos....

¿Qué hago mal?

Salu2
[vHn]

Ya me lo solucionaste xD 

Salu2
[vHn]