Программирование
Веб программирование

Поиск файлов

 
 

Код модуля:



Public Const MAX_PATH = 260
Public Const INVALID_HANDLE_VALUE = -1
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10

Public Type WIN32_FIND_DATA
  dwFileAttributes As Long
  ftCreationTime As Currency
  ftLastAccessTime As Currency
  ftLastWriteTime As Currency
  nFileSizeHigh As Long
  nFileSizeLow As Long
  dwReserved0 As Long
  dwReserved1 As Long
  cFileName As String * MAX_PATH
  cAlternate As String * 14
End Type

Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function lstrcpyn Lib "kernel32" Alias "lstrcpynA" (ByVal lpString1 As String, ByVal lpString2 As String, ByVal iMaxLength As Long) As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Public Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long

Public Function TrimStr(OriginalStr As String) As String
    If InStr(1, OriginalStr, Chr(0)) > 0 Then
        TrimStr = Left(OriginalStr, InStr(1, OriginalStr, Chr(0)) - 1)
        Exit Function
    End If
    TrimStr = OriginalStr
End Function

Public Function FindFiles(path As String, ByRef col As Collection)
Dim WD As WIN32_FIND_DATA
Dim hfile As Long
Dim fname As String
If Right(path, 1) <> "" Then path = path & ""
hfile = FindFirstFile(path & "*.*", WD) ' данная API функция ищет первый попавшийся файл.
If hfile <> INVALID_HANDLE_VALUE Then
  Do
    fname = TrimStr(WD.cFileName)' некоторые API любят добавлять к возвращаемому значению (строка) нулевой символ - chr(0).
'Его нужно удалять из конца строки, в противном случае функции для сравнения строк будут возвращать неверный результат.
    If (fname <> ".") And (fname <> "..") Then
      If (WD.dwFileAttributes And vbDirectory) = vbDirectory Then
        Call FindFiles(path & fname, col) ' рекурсивный поиск. Функция вызывает сама себя, пока не обойдет все подкаталоги.
      Else
        col.Add path & fname
      End If
    End If
    DoEvents
  Loop While FindNextFile(hfile, WD) <> False ' продолжаем цикл до тех пор, пока не будет найден последний файл в данной директории.
  FindClose (hfile)
End If
End Function

Код формы:

Option Explicit

Private Sub AddLine(txtbox As TextBox, Line)' процедура добавляет строки в TextBox.
  ' Тип данных, добавляемых в TextBox так или иначе будет приведен к String.
  ' Поэтому лучше оставим параметр Line как есть (по-умолчанию - Variant) не приводя его к String.
  Dim txtlen As Integer
  txtlen = Len(txtbox) ' каждый раз вычисляется длина текста, что не есть хорошо.
'если убрать, функция будет добавлять лишний перевод строки после текста.
  txtbox.SelStart = txtlen
  If txtlen = 0 Then
    txtbox.SelText = Line
  Else
    txtbox.SelText = vbCrLf & Line
  End If
End Sub

Private Sub Command1_Click()
  Dim col As New Collection
  Dim b As Variant

  FindFiles "C:", col ' Где искать, путь к папке.

' мы сначала помещаем имена найденных файлов в коллекцию (проще говоря - список)
' потом по одному выводим в текстовое поле.

  For Each b In col
    Call AddLine(Text1, b)
  Next
End ыги

Private Sub Form_Load()
Text1.MultiLine = True
End Sub


На форме расположите текстовое поле (TextBox), и кнопку.


Есть вопросы? Спроси на нашем форуме!!
Stertor370 [21.04.2014 00:20]

If Right(path, 1) "" Then path = path & ""
между кавычками должен быть обратный слэш.



Оставлять комментарии можно только зарегистрированным




Предупреждение: Вся информация представлена исключительно в образовательных целях.
Ни авторы, ни администрация не несут ответственности в случае ее использования в противозаконных целях.