Visual Basic, .NET, ASP, VBScript
 

   
   
     

Форум - Общий форум

Страница: 1 |

 

  Вопрос: Проверка каталогов на наличие файлов VB6 Добавлено: 11.07.06 12:23  

Автор вопроса:  SRV | ICQ: 254226129 
Привет ребята, подскажите как правильно загнать в определённом каталоге все подкаталоги в цикл, проверить каждый на наличие файлов и если есть файл, то скопировать его в другое место с виводом сообщения что такой-то файл был скопирован из такой-то папки :). Я пробую, но у меня выходит очень много кода, каталогов 21, скажите как это можно организовать проще, спасибо :)

Ответить

  Ответы Всего ответов: 14  

Номер ответа: 1
Автор ответа:
 [root]



Вопросов: 45
Ответов: 1212
 Web-сайт: bit.pirit.info
 Профиль | | #1
Добавлено: 11.07.06 12:33
могу дать код, на поиск в каталоге всех файлов определенного расширения, но он не сканирует вложенные папки

ЗЫ в поиск, товарищ! Я поднимал этот вопрос ранее, вариантов было море

Ответить

Номер ответа: 2
Автор ответа:
 SRV



ICQ: 254226129 

Вопросов: 30
Ответов: 107
 Профиль | | #2 Добавлено: 11.07.06 12:49
давай тада код, если не трудно :) Пасибо.

Ответить

Номер ответа: 3
Автор ответа:
 Sacred Phoenix



ICQ: 304238252 

Вопросов: 52
Ответов: 927
 Профиль | | #3 Добавлено: 11.07.06 12:52
рекурсией перебирай

Ответить

Номер ответа: 4
Автор ответа:
 [root]



Вопросов: 45
Ответов: 1212
 Web-сайт: bit.pirit.info
 Профиль | | #4
Добавлено: 11.07.06 13:01
Не забудь подключить Microsoft Scripting Runtime

Option Explicit
Dim FileNum1 As Byte
Dim FileNum2 As Byte
Dim strText As String
Dim s As String

Function ListFiles(ByVal Path As String, Optional ByVal NestedDirs As Boolean) As String()
Dim FSO As New Scripting.FileSystemObject
Dim fld As Scripting.Folder
Dim fileList As String
Set fld = FSO.GetFolder(Path)
fileList = ListFilesPriv(fld, NestedDirs)
ListFiles = Split(fileList, vbCrLf)
Text1 = Text1.Text & vbCrLf & fileList
End Function

Function ListFilesPriv(ByVal fld As Scripting.Folder, ByVal NestedDirs As Boolean) As String
Dim fil As Scripting.File
Dim subfld As Scripting.Folder
For Each fil In fld.Files
ListFilesPriv = ListFilesPriv & vbCrLf & fil.Path
Next
If NestedDirs Then
For Each subfld In fld.SubFolders
ListFilesPriv = ListFilesPriv & ListFilesPriv(subfld, NestedDirs)
Next
End If
End Function

Private Sub Form_Load()
Dim FSO As New FileSystemObject
Dim sFile As File
For Each sFile In FSO.GetFolder(App.Path & "\";).Files
    If UCase(FSO.GetExtensionName(sFile)) = "TXT" Then
    [QUOTE]Тут пишешь чего делать с етими файлами[/QUOTE]
    End If
Next sFile
End
End Sub

Ответить

Номер ответа: 5
Автор ответа:
 SRV



ICQ: 254226129 

Вопросов: 30
Ответов: 107
 Профиль | | #5 Добавлено: 11.07.06 13:01
Фоникс точнее можно плз. какой-то примерчик хотябы :) Пасибо. :)

Ответить

Номер ответа: 6
Автор ответа:
 SRV



ICQ: 254226129 

Вопросов: 30
Ответов: 107
 Профиль | | #6 Добавлено: 11.07.06 17:58
Большое спасибо ROOT

Ответить

Номер ответа: 7
Автор ответа:
 [root]



Вопросов: 45
Ответов: 1212
 Web-сайт: bit.pirit.info
 Профиль | | #7
Добавлено: 11.07.06 18:33
да не зачто

Ответить

Номер ответа: 8
Автор ответа:
 Sacred Phoenix



ICQ: 304238252 

Вопросов: 52
Ответов: 927
 Профиль | | #8 Добавлено: 11.07.06 20:07
я приведу код под vb2005, но перевести, думаю, будет не трудно.

Private Sub SearchFolders(ByVal Path As String)
   For Each File As System.String In System.IO.Directory.GetFiles(Path)
      '// действия для каждого файла, например, ищем файлы *.VBP
         If (System.IO.Path.GetExtension(File).ToLower = ".vbp";) Then
            '// действия для файла
            MessageBox.Show(File)
         End If
   Next
   For Each Subfolder As System.String In System.IO.Directory.GetDirectories(Path)
      SearchFolders(Subfolder)
   Next
End Sub

Private Sub Form1_Load(ByVal Sender As Object, ByVal Args As System.EventArgs) Handles Me.Load
   SearchFolders("C:\Program Files\Microsoft Visual Studio\VB98";)
End Sub

Ответить

Номер ответа: 9
Автор ответа:
 HACKER


 

Разработчик Offline Client

Вопросов: 236
Ответов: 8362
 Профиль | | #9 Добавлено: 12.07.06 01:04
FindFileFirst/Next

Ответить

Номер ответа: 10
Автор ответа:
 [root]



Вопросов: 45
Ответов: 1212
 Web-сайт: bit.pirit.info
 Профиль | | #10
Добавлено: 17.07.06 11:23
Рекурсивный поиск файлов и папок:

Автор: Бельбаков Александр

В этой статье описывается минимальный код для поиска файлов и папок с использованием API функций FindFirstFile,
FindNextFile и FindClose. Данный пример поиска довольно прост, он позволяет задать только одиночный запрос: "*.*"
или "*", запрос с несколькими файлами не даст результатов: "*.bmp,*.gif". Его принцип таков:

Ищем все подкаталоги в папке, в которой был указан поиск.
В каждом найденном подкаталоге ищем файлы, указанные для поиска.
Для реализации принципа, во - первых, нам потребуется создать функцию поиска папок:



Private Sub SearchForFolders(fName As String, Path As String, File As String)
'fName - указывает, какие подкаталоги будем искать("*" - все подкаталоги, как и в нашем случае);
' Path - указывает, в какой папке будем искать; File - указывает, какой файл будем искать.
If StopSearch = True Then Exit Sub 'переменная StopSearch указывает, должен ли быть прерван поиск.
Dim Atr As Integer
Dim hFnd As Long
Dim WFD As WIN32_FIND_DATA
hFnd = FindFirstFile(Path & fName, WFD) 'ищем первый подкаталог.
If hFnd = INVALID_HANDLE_VALUE Then Exit Sub 'если подкаталог не найден, то выходим из функции.
SearchForFiles File, Path 'вызывает ещё одну фнкцию для поиска файлов в папке.
Do
Atr = (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) 'узнаём, является ли найденный файл папкой
If TrimNull(WFD.cFileName) <> "." And TrimNull(WFD.cFileName) <> ".." Then 'если папка не
является корневой на диске, то функция FindNextFile возвращает эти два значения.
If Atr > 0 Then
DoEvents
SearchForFolders fName, Path & TrimNull(WFD.cFileName) & "\", File 'Если файл является папкой, то снова
 вызываем функцию поиска подкаталогов в этой папке.
End If
End If
Loop While FindNextFile(hFnd, WFD) 'производим поиск до конца.
FindClose hFnd 'освобождаем память.
End Sub

Думаю, что всем понятен принцип этой функции: производится поиск всех папок, для каждой папки производится
поиск подкаталогов и так далее, пока не будут найдены все папки - в этом и заключается рекурсия. Одновременно с поиском
папок в них производится поиск указанного файла. Функция для поиска файлов почти аналогична функции поиска папок:

Private Sub SearchForFiles(fName As String, Path As String) 'Path - указывает в какой папке
 будет производится поиск фалов, указанных в параметре fName.
If StopSearch = True Then Exit Sub
Dim Atr As Integer
Dim hFnd As Long
Dim WFD As WIN32_FIND_DATA
hFnd = FindFirstFile(Path & fName, WFD)
If hFnd = INVALID_HANDLE_VALUE Then Exit Sub
Do
Atr = (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY)
If TrimNull(WFD.cFileName) <> "." And TrimNull(WFD.cFileName) <> ".." Then
If Atr > 0 Then 'если это папка
lstFiles.AddItem "[" & Path & TrimNull(WFD.cFileName) & "]"
Else 'если это файл
lstFiles.AddItem Path & TrimNull(WFD.cFileName)
End If
End If
Loop While FindNextFile(hFnd, WFD)
FindClose hFnd
End Sub

Теперь пробуем поиск - вызываем функцию SearchForFolders:

SearchForFolders ( "*.*", "c:\windows\", "*.txt";)

"*" - ищем во всех подкаталогах папки "c:\windows\" файлы с именем "*.txt".

Ответить

Номер ответа: 11
Автор ответа:
 Sacred Phoenix



ICQ: 304238252 

Вопросов: 52
Ответов: 927
 Профиль | | #11 Добавлено: 17.07.06 19:24
2 [root]: мой код намного меньше))) правда, под vb2005 ;)

Ответить

Номер ответа: 12
Автор ответа:
 HACKER


 

Разработчик Offline Client

Вопросов: 236
Ответов: 8362
 Профиль | | #12 Добавлено: 17.07.06 21:46
2 Sacred Phoenix мой код намного меньше))) правда, под vb2002 ;)

Private Sub Form_Load()
    Ret = Dir("C:\", vbDirectory)
    While Ret <> ""
        s$ = s$ & Ret & vbCrLf
        Ret = Dir()
    Wend
    MsgBox s$
End Sub

Ответить

Номер ответа: 13
Автор ответа:
 [root]



Вопросов: 45
Ответов: 1212
 Web-сайт: bit.pirit.info
 Профиль | | #13
Добавлено: 18.07.06 05:07
тут либо есть либо нет, а размер не так уж и велик

Ответить

Номер ответа: 14
Автор ответа:
 SRV



ICQ: 254226129 

Вопросов: 30
Ответов: 107
 Профиль | | #14 Добавлено: 18.07.06 10:09
Мне код ROOT больше понравился, ещё раз спасибо :)

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам