.
'
' /////////////////////////////////////////////////////////////
' // 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!¡.
