Консультация № 67767
19.12.2006, 23:29
0.00 руб.
0 1 1
Доброго дня. Подскажите кодом или ссылкой по VB. Тема такая. Нужно проверить диск на наличие файлов или папок (включая вложенные папки) по маске имени для дальнейшего переименования. Мне нужен код именно поиска по всему диску. Спаибо всем кто чем-нибудь поможет

Обсуждение

Неизвестный
20.12.2006, 12:24
общий
это ответ
Здравствуйте, Igigig!
Предлагаю Вашему вниманию 2 функции для поиска файлов по маске, одна использует Windows API вторая нет.
т.к. взяты и переделаны из MSDN, кроме списка файлов вычисляют еще и дополнителную информацию.
После доработки, думаю, можно использовать.

Аргументы:
(IN) path As String - место поиска;
(IN) SearchStr As String - маска поиска;
(OUT) Files As String - список найденых файлов и папок с путями, разделенный vbCrLf;
(OUT) FileCount As Integer - количество найденых файлов и папок;
(OUT) DirCount As Integer - количество вложенных папок в которых производился поиск;

Return:
возвращают as Long - суммарный размер всех найденых файлов;

будут вопросы, пишите.


Приложение:
‘с использованием API‘В отдельном модуле Option Explicit Declare Function FindFirstFile Lib "kernel32" Alias _ "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData _ As WIN32_FIND_DATA) As Long Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _ (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long Declare Function GetFileAttributes Lib "kernel32" Alias _ "GetFileAttributesA" (ByVal lpFileName As String) As Long Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) _ As Long Public Const MAX_PATH = 260 Public Const MAXDWORD = &HFFFF Public Const INVALID_HANDLE_VALUE = -1 Public Const FILE_ATTRIBUTE_ARCHIVE = &H20 Public Const FILE_ATTRIBUTE_DIRECTORY = &H10 Public Const FILE_ATTRIBUTE_HIDDEN = &H2 Public Const FILE_ATTRIBUTE_NORMAL = &H80 Public Const FILE_ATTRIBUTE_READONLY = &H1 Public Const FILE_ATTRIBUTE_SYSTEM = &H4 Public Const FILE_ATTRIBUTE_TEMPORARY = &H100 Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type 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 Public Function StripNulls(OriginalStr As String) As String If (InStr(OriginalStr, Chr(0)) > 0) Then OriginalStr = Left(OriginalStr, _ InStr(OriginalStr, Chr(0)) - 1) End If StripNulls = OriginalStr End Function Function FindFilesAPI(path As String, SearchStr As String, _ Files As String, FileCount As Integer, DirCount As Integer) As Long Dim FileName As String ‘ Walking filename variable... Dim DirName As String ‘ SubDirectory Name Dim dirNames() As String ‘ Buffer for directory name entries Dim nDir As Integer ‘ Number of directories in this path Dim i As Integer ‘ For-loop counter... Dim hSearch As Long ‘ Search Handle Dim WFD As WIN32_FIND_DATA Dim Cont As Integer Dim FT As FILETIME Dim DateCStr As String, DateMStr As String If Right(path, 1) <> "" Then path = path & "" ‘ Search for subdirectories. nDir = 0 ReDim dirNames(nDir) Cont = True hSearch = FindFirstFile(path & "*", WFD) If hSearch <> INVALID_HANDLE_VALUE Then Do While Cont DirName = StripNulls(WFD.cFileName) ‘ Ignore the current and encompassing directories. If (DirName <> ".") And (DirName <> "..") Then ‘ Check for directory with bitwise comparison. If GetFileAttributes(path & DirName) And _ FILE_ATTRIBUTE_DIRECTORY Then dirNames(nDir) = DirName DirCount = DirCount + 1 nDir = nDir + 1 ReDim Preserve dirNames(nDir) ‘Files = Files & path & DirName & vbCrLf End If End If Cont = FindNextFile(hSearch, WFD) ‘ Get next subdirectory. Loop Cont = FindClose(hSearch) End If ‘ Walk through this directory and sum file sizes. hSearch = FindFirstFile(path & SearchStr, WFD) Cont = True If hSearch <> INVALID_HANDLE_VALUE Then While Cont FileName = StripNulls(WFD.cFileName) If (FileName <> ".") And (FileName <> "..") Then FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * _ MAXDWORD) + WFD.nFileSizeLow FileCount = FileCount + 1 Files = Files & path & FileName & vbCrLf End If Cont = FindNextFile(hSearch, WFD) ‘ Get next file Wend Cont = FindClose(hSearch) End If ‘ If there are sub-directories... If nDir > 0 Then ‘ Recursively walk into them... For i = 0 To nDir - 1 FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) _ & "", SearchStr, Files, FileCount, DirCount) Next i End If End Function‘без API‘В отдельном модулеFunction FindFiles(path As String, SearchStr As String, _ Files As String, FileCount As Integer, DirCount As Integer) As Long Dim FileName As String ‘ Walking filename variable. Dim DirName As String ‘ SubDirectory Name. Dim dirNames() As String ‘ Buffer for directory name entries. Dim nDir As Integer ‘ Number of directories in this path. Dim i As Integer ‘ For-loop counter. On Error GoTo sysFileERR If Right(path, 1) <> "" Then path = path & "" ‘ Search for subdirectories. nDir = 0 ReDim dirNames(nDir) DirName = Dir(path, vbDirectory Or vbHidden Or vbArchive Or vbReadOnly _Or vbSystem) ‘ Even if hidden, and so on. Do While Len(DirName) > 0 ‘ Ignore the current and encompassing directories. If (DirName <> ".") And (DirName <> "..") Then ‘ Check for directory with bitwise comparison. If GetAttr(path & DirName) And vbDirectory Then dirNames(nDir) = DirName DirCount = DirCount + 1 nDir = nDir + 1 ReDim Preserve dirNames(nDir) ‘Files = Files & path & DirName & vbCrLf End IfsysFileERRCont: End If DirName = Dir() ‘ Get next subdirectory. Loop ‘ Search through this directory and sum file sizes. FileName = Dir(path & SearchStr, vbNormal Or vbHidden Or vbDirectory Or vbSystem _ Or vbReadOnly Or vbArchive) While Len(FileName) <> 0 FindFiles = FindFiles + FileLen(path & FileName) FileCount = FileCount + 1 Files = Files & path & FileName & vbCrLf FileName = Dir() ‘ Get next file. Wend ‘ If there are sub-directories.. If nDir > 0 Then ‘ Recursively walk into them For i = 0 To nDir - 1 FindFiles = FindFiles + FindFiles(path & dirNames(i) & "", _ SearchStr, Files, FileCount, DirCount) Next i End IfAbortFunction: Exit FunctionsysFileERR: If Right(DirName, 4) = ".sys" Or path = "System Volume Information" Then Resume sysFileERRCont ‘ Known issue with pagefile.sys Else ‘MsgBox "Error: " & Err.Number & " - " & Err.Description, , "Unexpected Error" Resume AbortFunction End If End Function‘процедура для тестированияPrivate Sub test() Dim SearchPath As String, FindStr As String, Files As String, Msg As String Dim FileSize As Long Dim NumFiles As Integer, NumDirs As Integer SearchPath = "c:\Windows" FindStr = "sys*.dat" Files = "" NumFiles = 0 NumDirs = 0 FileSize = FindFilesAPI(SearchPath, FindStr, Files, NumFiles, NumDirs) Msg = NumFiles & " Files and Folders found with API in " & NumDirs + 1 & " Directories" & vbCrLf Msg = Msg & String(Len(Msg), "*") & vbCrLf Msg = Msg & Files & vbCrLf & vbCrLf Msg = Msg & "Size of files found under " & SearchPath & " = " & Format(FileSize, "#,###,###,##0") & " Bytes" & vbCrLf MsgBox Msg Files = "" NumFiles = 0 NumDirs = 0 FileSize = FindFiles(SearchPath, FindStr, Files, NumFiles, NumDirs) Msg = NumFiles & " Files and Folders found in " & NumDirs + 1 & " Directories" & vbCrLf Msg = Msg & String(Len(Msg), "*") & vbCrLf Msg = Msg & Files & vbCrLf & vbCrLf Msg = Msg & "Size of files found under " & SearchPath & " = " & Format(FileSize, "#,###,###,##0") & " Bytes" & vbCrLf MsgBox Msg End Sub
Форма ответа