1

Тема: VBS: поиск по диску и копирование файлов

Доброго времени суток уважаемые форумчане. Прошу сильно не пинать за возможно элементарные для вас вопросы, по для меня это пока тёмный лес!!! Изучение VBS начал совершенно недавно и пока мало что получается.... Пытаюсь сделать скрипт поиска файлов по диску на всю глубину и при обнаружении копировать его в отдельную папку... На форуме нашёл код г. Аlexii и взял его за основу... Однако познаний пока не достаточно и танцы с бубеном не увенчались успехом:)



Option Explicit


Dim objFSO
Dim objDrive
Dim strFileNameForFind
Dim i


strFileNameForFind = "acaddoc.lsp"                                   ' Имя файла для поиска.

Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

For Each objDrive In objFSO.Drives                                   ' Перебираем все существующие тома.
    If objDrive.DriveType = 1 Then                                   ' Том съёмный?
        If objDrive.IsReady Then                                     ' Том готов?
            WScript.Echo "Find on drive " & objDrive.DriveLetter & ":..."
            
            ScanSubFolders objDrive.RootFolder, strFileNameForFind   ' Вызываем процедуру поиска
                                                                     ' для корневой папки этого тома.
                                                                     ' Обработка вложенных папок будет
                                                                     ' вестись рекурсивно.
        End If
    End If
Next

Set objFSO = Nothing

WScript.Quit 0
'=============================================================================

'=============================================================================
Sub ScanSubFolders(objFolder, strFileName)
    Dim objSubFolder
    Dim strFullFileName
    
    WScript.Echo objFolder.Path                                      ' Выводим путь обрабатываемой папки (для
                                                                     ' отладки; имеет смысл закомментировать).
    
    strFullFileName = objFSO.BuildPath(objFolder, strFileName)       ' Строим полный путь файла.
    
    If objFSO.FileExists(strFullFileName) Then                       ' Файл существует?
        WScript.Echo vbTab & "Found as [" & strFullFileName & "], deleting..."
        
        'objFSO.DeleteFile strFullFileName, True                      ' Удаляем файл
    End If
        
    On Error Resume Next                                             ' Обрабатываем ошибки, возможные в случае,
                                                                     ' когда нет доступа к содержимому папки
                                                                     ' (пример - «System Volume Information».
    For Each objSubFolder In objFolder.SubFolders
        If Err.Number = 0 Then                                       ' Удалось получить доступ к содержимому папки?
            On Error Goto 0                                          ' Восстанавливаем стандартную обработку ошибок
            ScanSubFolders objSubFolder, strFileName               ' Вызываем процедуру поиска для каждой из подпапок.
        Else                                                         ' Если не удалось —
            Err.Clear                                                ' сбрасываем состояние ошибки,
            On Error Goto 0                                          ' восстанавливаем стандартную обработку ошибок и движемся дальше.
            WScript.Echo "Can't enumerate subfolders for folder [" & objFolder.Path & "]."
        End If
    Next
End Sub

Как и что нужно переделать что-бы поиск происходил по определённому диску( допустим С), искался файл допустим *.txt  и при обнаружении копировался бы в папку ( допустим: D:\rezerv)?

2

Re: VBS: поиск по диску и копирование файлов

Endrio, вопрос риторический? Ибо «поиска файлов» и «допустим *.txt» — множественное число, а «при обнаружении копировать его» и «искался файл» — единственное число. И методика поиска может быть совершенно разной в том и другом случае.

Пример, который Вы упоминали, предназначен прежде всего именно для поиска конкретного файла с заранее известным именем, а никак не по маске.

Endrio пишет:

…и при обнаружении копировался бы в папку ( допустим: D:\rezerv)

И что делать если будет найдено десять файлов с одинаковым именем?

Опишите Вашу глобальную цель, и почему сие нужно делать периодически (скриптом)?

3 (изменено: Endrio, 2010-01-10 01:02:23)

Re: VBS: поиск по диску и копирование файлов

Уважаемый alexii ,извиняюсь за не точность,*.txt я написал обобщённо , разширения у файлов разные и искомый файл точно один (напримерGTASAsf1.b). Этот скрипт нужен для поиска и копирования сохранений в играх (В кафе) запускатся будет с главной машины. пока же делаем по средствам ОС, что не очень удобно..

4

Re: VBS: поиск по диску и копирование файлов

Значит так: ищем на диске «C:» заведомо единственный файл «GTASAsf1.b», при нахождении — копируем его в папку «D:\rezerv» с заменой. Так? Если я понял всё верно, то примерно так:

Option Explicit


Dim objFSO
Dim objDrive
Dim strFileNameForFind
Dim boolDone


strFileNameForFind = "GTASAsf1.b"                                    ' Имя файла для поиска.

Set objFSO   = WScript.CreateObject("Scripting.FileSystemObject")
Set objDrive = objFSO.GetDrive("c:")

WScript.Echo "Find on drive " & objDrive.DriveLetter & ":..."

boolDone = False
ScanSubFolders objDrive.RootFolder, strFileNameForFind               ' Вызываем процедуру поиска
                                                                     ' для корневой папки этого тома.
                                                                     ' Обработка вложенных папок будет
                                                                     ' вестись рекурсивно.

Set objDrive = Nothing
Set objFSO   = Nothing

WScript.Quit 0
'=============================================================================

'=============================================================================
Sub ScanSubFolders(objFolder, strFileName)
    Dim objSubFolder
    Dim strFullFileName
    
    WScript.Echo objFolder.Path                                      ' Выводим путь обрабатываемой папки (для
                                                                     ' отладки; имеет смысл закомментировать).
    
    strFullFileName = objFSO.BuildPath(objFolder.Path, strFileName)  ' Строим полный путь к файлу.
    
    If objFSO.FileExists(strFullFileName) Then                       ' Файл существует?
        WScript.Echo vbTab & "Found as [" & strFullFileName & "], copying..."
        
                                                                     ' Копируем файл
        objFSO.CopyFile strFullFileName, objFSO.BuildPath("N:\rezerv", strFileName), True
        boolDone = True
        
        Exit Sub
    End If
    
    On Error Resume Next                                             ' Обрабатываем ошибки, возможные в случае,
                                                                     ' когда нет доступа к содержимому папки
                                                                     ' (пример - «System Volume Information».
    For Each objSubFolder In objFolder.SubFolders
        If Err.Number = 0 Then                                       ' Удалось получить доступ к содержимому папки?
            On Error Goto 0                                          ' Восстанавливаем стандартную обработку ошибок
            
            If Not boolDone Then
                ScanSubFolders objSubFolder, strFileName             ' Вызываем процедуру поиска для каждой из подпапок.
            End If
        Else                                                         ' Если не удалось —
            Err.Clear                                                ' сбрасываем состояние ошибки,
            On Error Goto 0                                          ' восстанавливаем стандартную обработку ошибок и движемся дальше.
            WScript.Echo "Can't enumerate subfolders for folder [" & objFolder.Path & "]."
        End If
    Next
End Sub

5

Re: VBS: поиск по диску и копирование файлов

Огромное спасибо всё работает!!! 5+!!!

6

Re: VBS: поиск по диску и копирование файлов

Endrio, прошу прощения за неточность: в скрипте из поста #4 в строке:

objFSO.CopyFile strFullFileName, objFSO.BuildPath("N:\rezerv", strFileName), True

поправить «N:» на «D:» — осталось после отладки. Приношу свои извинения.

7

Re: VBS: поиск по диску и копирование файлов

Спасибо alexii, уже исправил.

8

Re: VBS: поиск по диску и копирование файлов

Endrio пишет:

Огромное спасибо всё работает!!! 5+!!!

Ничего личного - но я бы поставил от силы "удовлетворительно".

Задача "поиск по диску" - с различными дополнительными условиями - является одной из самых "вечнозеленых". Возникает постоянно - и с таким же постоянством предлагается одно и то же решение. Которое впервые - насколько мне помнится - было предложено на этом же сайте году в 2008. Раньше это называлось "застой". Теперь - "ацтой".
Да, решение универсально - в том смысле, что работает везде. На этом все достоинства и заканчиваются.

Давайте вместе попробуем как-то продвинутся в этом вопросе. Возможно и с некоторыми дополнительными ограничениями - но пусть каждый сам выбирает то, что ему больше подходит.

Вот поиск, который использую я:

'
' поиск файлов с использованием FileSearch
'

Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add()

objWord.FileSearch.NewSearch
objWord.FileSearch.FileName = "*.jpg"
objWord.FileSearch.LookIn = "C:\Documents and Settings\"
objWord.FileSearch.SearchSubfolders = True
objWord.FileSearch.Execute

WScript.Echo "Найдено файлов: " & objWord.FileSearch.FoundFiles.Count

For Each objFile in objWord.FileSearch.FoundFiles
    Wscript.Echo objFile
Next

objWord.Quit
Set objWord = Nothing

WScript.Quit 0

Недостатки и ограничения:
1. Требует установленного MS Office.
2. Абсолютно "слепой" процесс - заставить хоть как-то визуально показать ход поиска мне не удалось.

Достоинства:
1. Компактность кода.
2. Поиск по маске имени файла.
3. Быстродействие ("на глаз" явно выше).
4. Легкость включения сортировок - по имени, по дате. Последнее предполагает, например, простоту решения поиска файлов за период.
5. При желании - включения условия "файл содержит...".

Есть еще одно универсальное средство - Search Agent. Тот самый поиск, который каждый может запустить в обычном Explorer.
Но вот добраться до него мне не удалось.
Может кто-то знает, как его запустить программно?

Интересно было бы услышать также другие варианты.

9

Re: VBS: поиск по диску и копирование файлов

Slav пишет:

Раньше это называлось "застой". Теперь - "ацтой".

Поскольку камень в мой огород — аргументируйте.

Slav пишет:

3. Быстродействие ("на глаз" явно выше).

Option Explicit


Dim objFSO
Dim strFileNameForFind
Dim dtStart, dtFinish

dtStart = Now()
WScript.Echo dtStart

strFileNameForFind = "qww.txt"                                       ' Имя файла для поиска.

Set objFSO   = WScript.CreateObject("Scripting.FileSystemObject")

ScanSubFolders objFSO.GetFolder("C:\AAA"), strFileNameForFind        ' Вызываем процедуру поиска
                                                                     ' для корневой папки этого тома.
                                                                     ' Обработка вложенных папок будет
                                                                     ' вестись рекурсивно.
dtFinish = Now()
WScript.Echo dtFinish
WScript.Echo DateDiff("s", dtStart, dtFinish)

Set objFSO   = Nothing

WScript.Quit 0
'=============================================================================

'=============================================================================
Sub ScanSubFolders(objFolder, strFileName)
    Dim objSubFolder
    Dim strFullFileName
    
    
    strFullFileName = objFSO.BuildPath(objFolder.Path, strFileName)  ' Строим полный путь к файлу.
    
    If objFSO.FileExists(strFullFileName) Then                       ' Файл существует?
        WScript.Echo vbTab & "Found as [" & strFullFileName & "]"
    End If
    
    On Error Resume Next                                             ' Обрабатываем ошибки, возможные в случае,
                                                                     ' когда нет доступа к содержимому папки
                                                                     ' (пример - «System Volume Information».
    For Each objSubFolder In objFolder.SubFolders
        If Err.Number = 0 Then                                       ' Удалось получить доступ к содержимому папки?
            On Error Goto 0                                          ' Восстанавливаем стандартную обработку ошибок
            
            ScanSubFolders objSubFolder, strFileName             ' Вызываем процедуру поиска для каждой из подпапок.
        Else                                                         ' Если не удалось —
            Err.Clear                                                ' сбрасываем состояние ошибки,
            On Error Goto 0                                          ' восстанавливаем стандартную обработку ошибок и движемся дальше.
            WScript.Echo "Can't enumerate subfolders for folder [" & objFolder.Path & "]."
        End If
    Next
End Sub
'=============================================================================
13.01.2010 13:05:46
    Found as [C:\AAA\BBB\CCC\DDD\qww.txt]
13.01.2010 13:05:54
8
'
' поиск файлов с использованием FileSearch
'
dtStart = Now()
WScript.Echo dtStart
Set objWord = CreateObject("Word.Application")

objWord.FileSearch.NewSearch
objWord.FileSearch.FileName = "qww.txt"
objWord.FileSearch.LookIn = "C:\AAA\"
objWord.FileSearch.SearchSubfolders = True
objWord.FileSearch.Execute

dtFinish = Now()
WScript.Echo dtFinish
WScript.Echo DateDiff("s", dtStart, dtFinish)

WScript.Echo "Найдено файлов: " & objWord.FileSearch.FoundFiles.Count

For Each objFile in objWord.FileSearch.FoundFiles
    Wscript.Echo objFile
Next

objWord.Quit
Set objWord = Nothing

WScript.Quit 0
13.01.2010 13:06:32
13.01.2010 13:06:44
12
Найдено файлов: 1
C:\AAA\BBB\CCC\DDD\qww.txt

При увеличении количества папок/файлов, среди которых ведётся поиск — разница увеличивается ещё заметнее. Вы, возможно, забыли или не читали про оригинальные рассуждения о том, почему используется «.FileExists()».

P.S. «Set objDoc = objWord.Documents.Add()» — лишнее.

10

Re: VBS: поиск по диску и копирование файлов

alexii,

спасибо за проведение тестов.
Их результаты, без сомнения, будут полезны для оценки эффективности разных способов поиска.

Если Вас не затруднит - проведите, пожалуйста, следующие замеры.

В скрипте 1 произвести изменения::

dtStart = Now()
ScanSubFolders objFSO.GetFolder("C:\AAA"), strFileNameForFind        ' Вызываем процедуру поиска
                                                                     ' для корневой папки этого тома.
                                                                     ' Обработка вложенных папок будет
                                                                     ' вестись рекурсивно.
dtFinish = Now()
WScript.Echo DateDiff("s", dtStart, dtFinish)

В скрипте 2 произвести изменения:

dtStart = Now()
objWord.FileSearch.NewSearch
objWord.FileSearch.FileName = "qww.txt"
objWord.FileSearch.LookIn = "C:\AAA\"
objWord.FileSearch.SearchSubfolders = True
objWord.FileSearch.Execute

dtFinish = Now()
WScript.Echo DateDiff("s", dtStart, dtFinish)

Цель - произвести замеры производительности именно поиска, без накладных расходов.
Смысл этого объясню несколько похже.

Еще одна просьба - запустить один и тот же скрипт 2 раза, друг за другом.
Т.е. результатов должно быть всего 4.
Цель - выяснить, используется ли дисковый кэш разными алгоритмами поиска.
Насколько я заметил - нет, не используется.
А вот упомянутый мной Search Agent точно его применяет - повторные поиски, даже при других условиях явно быстрее.

При увеличении количества папок/файлов, среди которых ведётся поиск — разница увеличивается ещё заметнее. Вы, возможно, забыли или не читали про оригинальные рассуждения о том, почему используется «.FileExists()».

Если не затруднит - ссылку на "оригинальные рассуждения".

«Set objDoc = objWord.Documents.Add()» — лишнее.

В данном случае - действительно не нужно.

И в заключении.
Вы сужаете задачу до одного конкретного случая - поиска одного единственного файла, по конкретному имени. Согласен - давайте всесторонне проанализируем этот случай.
Но я имею ввиду более общий поиск - некое подмножество файлов с именем по маске. А если еще и с учетом даты?
Ваш вариант этого даже не предполагает.

Меня самого куда больше интересует Search Agent. На удивление - такого объекта нет. Почему?

11

Re: VBS: поиск по диску и копирование файлов

Slav пишет:

Цель - произвести замеры производительности именно поиска, без накладных расходов.
Смысл этого объясню несколько похже.

Сделаем вечером. Смысл — хотелось бы услышать.

Slav пишет:

Еще одна просьба - запустить один и тот же скрипт 2 раза, друг за другом.
Т.е. результатов должно быть всего 4.
Цель - выяснить, используется ли дисковый кэш разными алгоритмами поиска.
Насколько я заметил - нет, не используется.

У меня — используется. Ибо первоначальный проход занял больше минуты (и в том, и в другом случае). Отчего не используется у Вас — не знаю. Ни тот, ни другой метод не может никоим образом управлять использованием/не использованием дискового кэша — не тот уровень.

Потому я запускал уже после первого прохода по нескольку раз и выкладывал уже эти результаты. Для полноценного тестирования потребуется запуск после полной перезагрузки машины (я не знаю, как и чем можно наверняка обнулить дисковый кэш), а я к этому пока морально не готов .

Slav пишет:

Вы сужаете задачу до одного конкретного случая - поиска одного единственного файла, по конкретному имени.

Не передёргивайте, коллега. Это Вы вывели данную конкретную задачу поиска определённого файла на диске за рамки поставленной задачи в другую область — поиск по маске. Я же об этом ничего не говорил.

Да, и что там насчёт :

alexii пишет:
Slav пишет:

Раньше это называлось "застой". Теперь - "ацтой".

Поскольку камень в мой огород — аргументируйте.

12

Re: VBS: поиск по диску и копирование файлов

Slav пишет:

Если не затруднит - ссылку на "оригинальные рассуждения".

VBS: Поиск файла на локальном диске, тема в Коллекции со ссылкой на пост коллеги Xameleon (откуда была взята идея): VBScript: поиск файлах.

13

Re: VBS: поиск по диску и копирование файлов

alexii пишет:

Сделаем вечером. Смысл — хотелось бы услышать.

alexii,

спасибо за сотрудничество.

В чем смысл? В том, что при серьезных многокритериальных поисках время инициации объекта WORD ничтожно по сравнению с продолжительностью самого процесса.
При поиске одного файла в одной папке - в Ваших условиях тестирования - CreateObject на порядки больше, чем собственно поиск. Поэтому сравнение некорректно.
Вы можете возразить - но юзеру наплевать, что мы там инициируем. Его интересует время от старта задачи до получения результата. Даже если это поиск файла autoexec.bat в c:\.
А вот тут я вернусь к Вашему замечанию насчет «Set objDoc = objWord.Documents.Add()» — лишнее. Дело в том, что я во многих скриптах использую объект WORD. Чтобы съэкономить время у меня просто висит уже инициированный объект, к которому я подсоединяюсь (GetObject) по мере необходимости.
Т.е. хотелось бы оценить именно "чистый" поиск.

alexii пишет:

У меня — используется. Ибо первоначальный проход занял больше минуты (и в том, и в другом случае). Отчего не используется у Вас — не знаю. Ни тот, ни другой метод не может никоим образом управлять использованием/не использованием дискового кэша — не тот уровень.

Я правильно понял:
1. Вы запустили первый скрипт - "проход занял больше минуты".
2. Запустили первый скрипт еще раз - время снизилось.
3. Запустили второй скрипт - опять "проход занял больше минуты".
4. Запустили второй скрипт еще раз - время снизилось.
Если это так - то куда же делся кэш на 3-ем шаге?
Или я что-то не так понял?

alexii пишет:

Не передёргивайте, коллега. Это Вы вывели данную конкретную задачу поиска определённого файла на диске за рамки поставленной задачи в другую область — поиск по маске.

Да та же самая область - тут на форуме половина вопросов по сути сводится к эффективному поиску.
Что там далеко ходить - nata в соседней ветке мучается
Один файл в одной папке - ну о-о-о-очень частный случай. Надо бы с такими вопросами в FAQ отправлять - а не предлагать в сотый раз скрипт с измененным именем файла.

alexii пишет:

Да, и что там насчёт :

alexii пишет:
Slav пишет:

Раньше это называлось "застой". Теперь - "ацтой".

Поскольку камень в мой огород — аргументируйте.

alexii, Ваш профессиональный уровень и эрудиция лично у меня вызывает искреннее уважение. Я обсуждаю не личности - а решения.
Мне кажется странным (мягко говоря) многолетнее цитирование одного и того же решения. Люди там чего-то придумывают - а мы все ветхозаветные решения цитируем.

"Да, и что там насчет" Search Agent?

PS Интерес к этому вопросу у меня давно - я тут много спрашивал. Пытаясь подходить с самых разных сторон. Если помните - совсем недавно спросил как среагировать на появление нового  файла не просто в конкретной папке, а включая папки вложенные. Т.е. не искать постфактум - а реагировать сразу при появлении. Пока это невозможно - Вы же сами мне это и сказали. Будем искать дальше.

14

Re: VBS: поиск по диску и копирование файлов

Во-первых,

Slav пишет:

При поиске одного файла в одной папке - в Ваших условиях тестирования

Мои условия были такими:

Поиск закончен. Найдено 216563 файл(ов) и 13167 папка(ок)
Slav пишет:

В чем смысл? В том, что при серьезных многокритериальных поисках время инициации объекта WORD ничтожно по сравнению с продолжительностью самого процесса.
При поиске одного файла в одной папке - в Ваших условиях тестирования - CreateObject на порядки больше, чем собственно поиск. Поэтому сравнение некорректно.

Т.е. хотелось бы оценить именно "чистый" поиск.

Почему некорректно? Почему вдруг мы не должны учитывать время на создание экземпляра объекта, который используется для поиска?! Неубедительно, коллега.

Slav пишет:

Я правильно понял:…

Полностью было так:
1. Запустил Ваш вариант скрипта; долго ждал. Когда надоело — остановил скрипт и снял процесс «winword.exe».
2. Запустил поиск в Far Manager, дождался завершения (достаточно долго).
3. Запустил Ваш вариант скрипта, дождался завершения;
4. Запустил свой вариант скрипта, дождался завершения;
Всё ещё достаточно долго. Особой разницы я не заметил.
5. Добавил отсчёт времени в оба варианта.
6. Запустил Ваш модифицированный вариант скрипта, дождался завершения;
7. Запустил свой модифицированный вариант скрипта, дождался завершения;
6,7,6,7,7,6,7,6 и т.д. несколько раз.
8. Спустя пару запусков в обоих вариантах результаты примерно «устаканились», т.е. стали возвращать одинаковые значения при запуске.
Эти примерные результаты я и опубликовал.

Насчёт кэша — Far Manager, FSO и Word.Application.FileSearch запросто могут запрашивать у ОС отличающиеся варианты информации по каталогам/файлам (это лишь моё предположение, но именно поэтому я учитывал именно «устаканившиеся» запуски, а не первые).

Понятное дело, что таковы результаты именно у меня, у Вас могут быть совсем другие (учитывая предыдущий абзац).

Slav пишет:

Да та же самая область - тут на форуме половина вопросов по сути сводится к эффективному поиску.

Другая, поскольку для поиска по маске .FileExists() не применишь . Именно для эффективного поиска для данной частной задачи — по известному имени файла — и был совместными усилиями слеплен данный алгоритм.

Slav пишет:

Что там далеко ходить - nata в соседней ветке мучается

Ну, там без масок и вложенных папок, можно и одним циклом с DateDiff()'ом по «.Files()» пройтись.

Slav пишет:

Один файл в одной папке - ну о-о-о-очень частный случай.

Опять Вы про какой-то один файл в одной папке говорите… Я никак не пойму, где Вы это взяли?!

Slav пишет:

Надо бы с такими вопросами в FAQ отправлять - а не предлагать в сотый раз скрипт с измененным именем файла.

1. А он (FAQ) у нас есть?
2. Присмотритесь внимательнее — не сто вариантов, а всего лишь пять — и все разные . Единая у них только основа, та самая — VBScript: поиск файлах, слепленная благодаря замечательной идее коллеги Xameleon.

Что же вообще насчёт «отправлять» — к сожалению, далеко не все начинающие писать скрипты понимают как работает рекурсия, увы. И мне проще и быстрее адаптировать исходный вариант, нежели на протяжении многих постов пояснять, что и как надо сделать. Ежели человек действительно захочет потом разобраться — вернётся и разберётся.

Slav пишет:

Мне кажется странным (мягко говоря) многолетнее цитирование одного и того же решения. Люди там чего-то придумывают - а мы все ветхозаветные решения цитируем.

Не вижу аргументов.

Slav пишет:

"Да, и что там насчет" Search Agent? smile

Не знаю — и молчу.

P.S. Коллега, я ничуть не возражаю против Вашего решения как такового. В Коллекции по WSH есть и такие варианты, как JScript: Поиск файлов по расширению (при помощи вызова «DIR» в дочернем командном процессоре), VBScript: работаем с утилитой LogParser от Microsoft (весьма разносторонний компонент; поиск файлов лишь одна из возможностей; минус тот же — надо устанавливать отдельно), VBScript: поиск текста в файлах *.doc. Вы ведь соответствующие права имеете, так что — милости просим, выкладывайте #8 хоть отдельно, хоть в развитие к какой-либо из перечисленных тем.

15

Re: VBS: поиск по диску и копирование файлов

Перенёс начало отсчёта времени после создания экземпляра Word.Application:

…
Set objWord = CreateObject("Word.Application")

dtStart = Now()
WScript.Echo dtStart
objWord.FileSearch.NewSearch
…

Результаты такие («FSO/FileExists, Word.Application/FileSearch»; результаты первых нескольких запусков отброшены по вышеизложенным причинам):
«8, 11»; «8, 10»; «8, 12»; «8, 10»; «8, 10»; «8, 10», далее стабильно держатся последние цифры.

Хорошо бы, конечно, найти способ очищать дисковый кэш, было бы гораздо интереснее оценить именно такой вариант, поскольку в реальности будет именно это.

16

Re: VBS: поиск по диску и копирование файлов

Попробовал тут пользовать LogParser по тем же методам:

Option Explicit

Dim dtStart, dtFinish
Dim objLogQuery, objCOMFileSystemInputContext, objLogRecordset, objRecord


dtStart = Now()
WScript.Echo dtStart

Set objLogQuery                  = WScript.CreateObject("MSUtil.LogQuery")
Set objCOMFileSystemInputContext = WScript.CreateObject("MSUtil.LogQuery.FileSystemInputFormat")

With objLogQuery.Execute("SELECT * FROM C:\AAA\qww.txt", objCOMFileSystemInputContext)
    Do While Not .atEnd
        WScript.Echo .getRecord().getValue("Path")
        
        .moveNext
    Loop
    
    .Close
End With

Set objCOMFileSystemInputContext = Nothing
Set objLogQuery                  = Nothing

dtFinish = Now()
WScript.Echo dtFinish
WScript.Echo DateDiff("s", dtStart, dtFinish)

WScript.Quit 0
13.01.2010 20:47:58
C:\AAA\BBB\CCC\DDD\qww.txt
13.01.2010 20:48:01
3

17

Re: VBS: поиск по диску и копирование файлов

alexii,

спасибо за тестирование.
Результаты очень интересные.

Результаты такие («FSO/FileExists, Word.Application/FileSearch»; результаты первых нескольких запусков отброшены по вышеизложенным причинам):
«8, 11»; «8, 10»; «8, 12»; «8, 10»; «8, 10»; «8, 10», далее стабильно держатся последние цифры.

Заточеный под обнаружение единственного файла FileExists однозначно лучше универсального FileSearch.
Беру на заметку.

Попробовал тут пользовать LogParser по тем же методам

Вот же оно! Увидел впервые, первые впечатления - супер!
1. Средство фактически стандартное, хотя и требует установки.
2. Условия формируются запросом, а не программными извратами.
3. Широкий набор атрибутов, встроенная обработка результатов (например, сортировка).
Не очень понятна фантастическая разница по времени между первым и последующим запусками, но это уже надо исследовать.
Время поиска (повторного) впечатляет.

Опять Вы про какой-то один файл в одной папке говорите… Я никак не пойму, где Вы это взяли?!

Вероятно я выразился некорректно.
Я имею ввиду не один файл, сиротливо лежащий на локальном диске в какой-либо папке - а формулирование самой задачи: найти один файл с четко известным именем (только именем!) в одной четко известной папке (включая вложенные). Да, ищете Вы среди десятков, сотен, тысяч файлов - но ищете один.
Хотя даже тут необходимо уточнить - не один файл, а одно известное имя. Ведь если допускается вложенность папок, то файлов с этим одним именем может быть несколько.

Я противник постов, не умещающихся на один экран. Формат форума предполагает четкие формулировки и последовательное изучение разных аспектов обсуждаемой темы.

Поэтому этот пост заканчиваю. Ответы на другие Ваши вопросы и свои мысли по этой теме изложу несколько позже.

PS Считаю что мы - благодаря Вашей работе прежде всего - существенно продвинулись в вопросе "поиск по диску".

18

Re: VBS: поиск по диску и копирование файлов

Slav пишет:

Вот же оно! Увидел впервые, первые впечатления - супер!

Угу. Я тут тоже начал вчитываться глубже, смотрю — оказывается, там есть целая куча функций для запросов; в примерах:

Identical Files
Find out if there are identical copies of the same file on the C: drive:

LogParser "SELECT HASHMD5_FILE(Path) AS Hash, COUNT(*) AS NumberOfCopies FROM C:\*.* GROUP BY Hash HAVING NumberOfCopies > 1" -i:FS

а у нас тут не так давно поднималась тема поиска дубликатов, с «ручным» вычислением и вычислением сторонним компонентом хэшей MD5.

Slav пишет:

Не очень понятна фантастическая разница по времени между первым и последующим запусками, но это уже надо исследовать.

Я так понимаю, что, во всяком случае, у меня после первого(-второго-третьего) прохода поиска требуемая часть MFT ложится в дисковый кэш (и, что немаловажно, целиком там умещается). Потому последующие запуски, теоретически, не приводят к постоянному реальному чтению данных с диска (возможно, иногда, что-то дочитывается/перечитывается, поскольку иногда диск всё ж «подмигивает» в процессе поиска). А первоначальный запуск действительно продолжителен, поскольку, как я указывал, количество файлов и каталогов, на которых я проводил исследование, действительно большое:

Поиск закончен. Найдено 216563 файл(ов) и 13167 папка(ок)

Slav пишет:
alexii пишет:

Опять Вы про какой-то один файл в одной папке говорите… Я никак не пойму, где Вы это взяли?!

…Я имею ввиду не один файл, сиротливо лежащий на локальном диске в какой-либо папке - а формулирование самой задачи: найти один файл с четко известным именем (только именем!) в одной четко известной папке (включая вложенные). Да, ищете Вы среди десятков, сотен, тысяч файлов - но ищете один.

Спасибо, теперь ясно.

Slav пишет:

Хотя даже тут необходимо уточнить - не один файл, а одно известное имя. Ведь если допускается вложенность папок, то файлов с этим одним именем может быть несколько.

Этот вариант учитывается (в оригинальном посте в Коллекции именно такой вариант скрипта, а для задачи из данной темы я как раз ввёл специальное ограничение — прекращать поиск по нахождению первого подходящего файла).

Slav пишет:

PS Считаю что мы - благодаря Вашей работе прежде всего - существенно продвинулись в вопросе "поиск по диску".

Возможно, в итоге и разродимся дополнениями в Коллекции; вот, только, на мой взгляд, правильнее…  не моей работе, а нашей работе, нашей

19

Re: VBS: поиск по диску и копирование файлов

Уважаемые господа Аlexii и Slav. Прошу прощения ,что вмешиваюсь в Вашу дискуссию со своими вопросами. Аlexii Ваш скрипт работает идеально, но так как у меня частный случай применения, необходимо несколько расширить его функциональность. Я Вам в кратце обрисую ситуацию, чтоб Вам была понятна суть проблемы.
Интернет-кафе при школе, 22 машины+ главная, объеденины в сетку,основной контингент посетителей  - школники (играют в различные игры и устраивают между собой соревнования).Задача: после завершения игры, найти файл с сохранениями и скопировать в указанную папку(затем слить на флэшку(дома тренируются:-))))),но это уже в ручную).Скрипт с этим справляется идеально!!!  НО!!! 1.Следующий игрок может загрузить не своё сохранение, а сохранение предидущего игрока - что не совсем честно!!!(приходится всё равно лезть в ручную и затирать содержимое файла,если совсем удалить,то большинство игр выдают ошибку либо на старте,либо в процессе). 2.Аlexii, Вы правильно подметили в одном из предидущих постов, что может оказаться несколько файлов с одинаковым именем,в одном из случаев так и случается... (оказалось 3 файла с одинаковым именем, но в разных папках и с разным содержимым)
Облазил весь форум и приводимые Вами в пример справочники, но так ничего и не нашёл по данному вопросу. Возможно ли выполнение данных задач средствами VBS?
Сценарий скрипта я вижу таким:
1. Поиск указанного файла на указанном диске.
2. Копирование найденного файла в указанную папку, если файлов несколько,то к имени файла добавляем цифру ( имя+ цифра.расш).
3.Затираем содержимое найденого файла.
И ещё,  можно ли производить поиск сразу несколких файлов одновременно ( например: daln396.pl1,GTASAsf1.b, ххх.хх; когда они все в одном месте легче разобраться кому ,что и куда закинуть)
Заранее благодарен за помощь.

20

Re: VBS: поиск по диску и копирование файлов

Endrio пишет:

...
И ещё,  можно ли производить поиск сразу несколких файлов одновременно ( например: daln396.pl1,GTASAsf1.b, ххх.хх; когда они все в одном месте легче разобраться кому ,что и куда закинуть)

alexii,

что-то мне подсказывало что все к этому и придет

Но теперь достойный ответ есть!
Сегодня не могу продолжать - но завтра обязательно выскажусь.

PS Классная это игрушка - LogParser.

21

Re: VBS: поиск по диску и копирование файлов

Slav, поиск  нескольких файлов не является обязательным!!!!Просто для удобства, чтобы не делать для каждой игры отдельный скрипт. Если это будет вызывать ошибки или слишком много потреблять ресурсов - тогда это исключено!!!

22

Re: VBS: поиск по диску и копирование файлов

Slav пишет:

что-то мне подсказывало что все к этому и придет smile

Аналогично, коллега . Только теперь я вовсе перестал понимать, что же всё-таки именно нужно коллеге Endrio.

23

Re: VBS: поиск по диску и копирование файлов

а можно ли данным методом составить список всех файлов находящихся на всем жестком диске?

очень нужно ; )

24

Re: VBS: поиск по диску и копирование файлов

С одним уточнением: всех доступных файлов. Причём несколькими способами: перебор с рекурсией, использование вывода «dir /b /s», WMI. Какова глобальная цель сего действа?

25 (изменено: euphoriawtf, 2010-05-01 20:21:27)

Re: VBS: поиск по диску и копирование файлов

всех доступных файлов перебором с рекурсией

Глобальная цель  сохранить весь список в текстовый файл
лучше бы еще запретить поиск в папке windows

я решил сделать на vbs скрипт который отправит  список с удаленной машины - вот и цель

26

Re: VBS: поиск по диску и копирование файлов

euphoriawtf, пожалуйста, пишите предложения с большой буквы и используйте знаки препинания.

27

Re: VBS: поиск по диску и копирование файлов

Уважаемый Alexii !

Хорошо, что вы любите чистоту на своем красивом и приятном форуме...


Нужна помощь ...
Могли бы Вы, помочь мне в решении одной маленькой проблемы.
Хотелось бы увидеть скрипт для поиска сразу двух и более файлов по всему диску.
Например найти все файлы {programma.exe/document.doc/file.txt}

особенности алгоритма ... использованием  перебора с рекурсией

1) Найденные файлы, нужно будет скопировать рядом с исполняемым скриптом
2) Если будет найден похожий файл, то изменить имя - дополнив его случайным значением
3) Если файл будет иметь размер более 10 MB - то не копировать
4) В случае ошибки, не заканчивать работу, а также не вести поиск в системной папке (это должно ускорить поиск)
5) Вести поиск только HD диске
6) Пропускать файлы или папки, которые могут вызвать ошибку

Все это мне нужно, для понятия алгоритма, и для использования этого скрипта
Так как я только начал изучать этот язык, мне это очень пригодится

Думаю, ВЫ сможете помочь? у Вас наверняка уже есть, что-то подобное ... немного изменить и по алгоритму

28

Re: VBS: поиск по диску и копирование файлов

euphoriawtf пишет:

Нужна помощь ...
Могли бы Вы, помочь мне в решении одной маленькой проблемы.
Хотелось бы увидеть скрипт для поиска сразу двух и более файлов по всему диску.
Например найти все файлы {programma.exe/document.doc/file.txt}

особенности алгоритма ... использованием  перебора с рекурсией

1) Найденные файлы, нужно будет скопировать рядом с исполняемым скриптом
2) Если будет найден похожий файл, то изменить имя - дополнив его случайным значением
3) Если файл будет иметь размер более 10 MB - то не копировать
4) В случае ошибки, не заканчивать работу, а также не вести поиск в системной папке (это должно ускорить поиск)
5) Вести поиск только HD диске
6) Пропускать файлы или папки, которые могут вызвать ошибку

Все это мне нужно, для понятия алгоритма, и для использования этого скрипта
Так как я только начал изучать этот язык, мне это очень пригодится

Эта маленькая проблемка - довольно таки многокритериальный запрос, требующий некоторой усидчивости, вы уверены что вам нужно именно это? Может для понятия алгоритма убрать всякие мелочи запроса, или вообще разбить скрипт на несколько как раз по критериям? В таком случае всё сведется к элементарным операциям. Если всё же вам нужно именно то, что вы просите, может вам начать его "собирать" и спрашивать как раз то, что конкретно вам не понятно, приводя этапы вашей сборки?

Стремление - залог успеха

29

Re: VBS: поиск по диску и копирование файлов

Развивая мысль Lucky, замечу, что один только пункт 5

euphoriawtf пишет:

5) Вести поиск только HD диске

может превратиться в непростую задачу в случае, когда HDD несколько и на каждом из них существует хотя бы один логический диск, а искать файлы надо лишь на одном или нескольких (но не всех) приводах.
Сложность здесь заключается в сопоставлении логических дисков физическим накопителям.

30

Re: VBS: поиск по диску и копирование файлов

беда в том, что я не могу даже начать собирать.

31 (изменено: Swest, 2010-06-24 09:24:47)

Re: VBS: поиск по диску и копирование файлов

Можете помочь прикрутить к вашему скрипту

вот это
 

Dim FSO, FldN, Fls, Fl, D, DtN, FlN
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")

If WScript.Arguments.Count = 0 Then
  MsgBox "Не задано имя папки для распределения файлов по датам. ", vbExclamation, "Ошибка"
  WScript.Quit
End If

FldN = WScript.Arguments(0)
If Not FSO.FolderExists(FldN) Then
  MsgBox "Папка """ & FldN & """ не существует. ", vbExclamation, "Ошибка"
  WScript.Quit
End If

Set Fls = FSO.GetFolder(FldN).Files
For Each Fl In Fls
  D = GetDateName(Fl.DateLastModified)
  DtN = FSO.BuildPath(FldN, D)
  If Not FSO.FolderExists(DtN) Then FSO.CreateFolder DtN

  FlN = FSO.BuildPath(DtN, Fl.Name)
  If FSO.FileExists(FlN) Then
    If MsgBox("Файл """ & Fl.Name & """ уже существует в папке """ & D & """. " & vbCr & "Перезаписать?", vbQuestion + vbOKCancel, "Внимание") = vbOK Then
      FSO.DeleteFile FlN, True
      Fl.Move FlN
    End If
  Else
    Fl.Move FlN
  End If
Next

MsgBox "Скрипт завершен. ", vbInformation, "Финиш"
WScript.Quit

Private Function GetDateName(Dt)
  Dim M, D

  M = Month(Dt)
  D = Day(Dt)
  If M < 10 Then M = "0" & M
  If D < 10 Then D = "0" & D

  GetDateName = Year(Dt) & "-" & M & "-" & D
End Function

Да и можно ли сделать как то поиск по "Дате съемки" фотографии?

32

Re: VBS: поиск по диску и копирование файлов

Простите что вмешиваюсь. Воспользовался Вашим примером. И вот что интересно в папке "c:\Documents and Settings\Admin.BROTHER\Мои документы\Моя музыка\" лежат три mp3 файла.
 

    Set objWord = CreateObject("Word.Application")
   'Set objDoc = objWord.Documents.Add()
   objWord.FileSearch.NewSearch
   objWord.FileSearch.FileName = "*.mp3"
   objWord.FileSearch.LookIn = Fpath
   objWord.FileSearch.SearchSubfolders = True
   objWord.FileSearch.Execute

если задать Fapth = "c:\Documents and Settings\Admin.BROTHER\Мои документы\" , то mp3 файлы находяться а если задать Fpath = "c:\Documents and Settings\" то он их не находит. Это почему так?
Права имею полные.

33

Re: VBS: поиск по диску и копирование файлов

У меня — находит.

34

Re: VBS: поиск по диску и копирование файлов

Wiliam пишет:

...
если задать Fapth = "c:\Documents and Settings\Admin.BROTHER\Мои документы\" , то mp3 файлы находяться а если задать Fpath = "c:\Documents and Settings\" то он их не находит. Это почему так?
Права имею полные.

Wiliam,

1. Какой будет результат, если указать область поиска:
c:\Documents and Settings\Admin.BROTHER\

2. Дайте команду chkdsk на диск с:

35

Re: VBS: поиск по диску и копирование файлов

Slav пишет:

1. Какой будет результат, если указать область поиска:
c:\Documents and Settings\Admin.BROTHER\

2. Дайте команду chkdsk на диск с:

1. При c:\Documents and Settings\Admin.BROTHER\ или выше уровнем результат - 0. Только начиная с "Мои документы". Проэксперементировал с с:\test\1\2\3\4\5\6\7\8\9\10\11\12\13\14\, вложив в каждую по файлу, нашел все. Видимо тут, что-то связанно с правами. Хотя Admin - это я! )) И права администратора домена. не знаю.

2. "Проверка завершена" и никаких ошибок не найдено. Наврятли это тут при чем! )

Думаю можно остановиться, и дальше не разбираться. Частный случай. Можно списать на глюк операционной системы MS Windows XP или темные силы.
Буду эксперементировать на других машинах. Если что накопаю, отпишусь.

Спасибо за попытку помочь.

36

Re: VBS: поиск по диску и копирование файлов

на других компах то же самое. Может дело в том что я обращаюсь к диску с через сеть? (хотя я пробовал и чисто (без добавок) ваш код применять через локальный диск).
Если кому интересно выложил посмотреть. Писал для себя из чисто спортивного интереса ( или от нечего делать).
Код без изменений:
http://wiliams.narod.ru/findfilenet.html

37

Re: VBS: поиск по диску и копирование файлов

Wiliam пишет:

...
Думаю можно остановиться, и дальше не разбираться. Частный случай. Можно списать на глюк операционной системы MS Windows XP или темные силы.
...

Wiliam,

а я бы все-таки разобрался.
Глюки конкретно WIndows XP отняли у меня много времени - не хотелось бы чтобы другие шли по моим граблям.

Если Вас не затруднит - сделайте следующее:
войдите локальным админом на комп, укажите папку для поиска c:\Documents and Settings\ и запустите скрипт поиска.
Ессно, убедитесь, что где-то во вложенных папках есть хоть один mp3.
Файлы находятся или нет?

И еще одна личная просьба.
У Вас на XP стоит SP2 или SP3?
Попробуйте в Планировщике заданий (Назначенные задания) создать любое задание.
Оно создается или возникает ошибка 0x80070005 ?

Кста, последнюю просьбу адресую всем желающим.

Спасибо.

38

Re: VBS: поиск по диску и копирование файлов

Попробовал у себя:
Windows XP SP3 + Word 2007

Ужос!
Не верю своим глазам!

Проверю еще раз в понедельник...

39

Re: VBS: поиск по диску и копирование файлов

Slav пишет:

войдите локальным админом на комп

Локальным админом знаетели скрипт сработал без проблем. Нашел все что можно найти. Жаль вот только что по сети не корректно ищет.

Файлы находятся или нет?

Конечно они есть. Иначе бы я их не стал искать.

У Вас на XP стоит SP2 или SP3?
Попробуйте в Планировщике заданий (Назначенные задания) создать любое задание.
Оно создается или возникает ошибка 0x80070005 ?

SP3. Создается.

40

Re: VBS: поиск по диску и копирование файлов

Понедельник начался с разочарования - объект FileSearch больше не поддерживается:

This issue occurs when you have 2007 Office programs installed on a Microsoft Windows XP computer, and the VBA macro uses the Application.FileSearch object. This object is no longer supported in 2007 Office programs.

41

Re: VBS: поиск по диску и копирование файлов

Угу. Было такое дело, кто-то уже упоминал вроде как.

42 (изменено: Wiliam, 2010-09-28 10:08:23)

Re: VBS: поиск по диску и копирование файлов

такой вот способ нашел все что надо, но слегка медленно, особенно при поиске на дисках большого оъема.

'ищем файл 2.tmp на диске с: в папке TempEI4 на компъютере \\b26  не меняя дату последнего доступа
strComputer = "b26"
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colFiles = objWMIService.ExecQuery _
    ("Select * from CIM_DataFile where Drive = 'c:' and Path = '\\TempEI4\\' and Extension = 'tmp' and FileName = '2'")
For Each objFile in colFiles
    Wscript.Echo objFile.Name & " on computer: " & strComputer
Next

учился здесь: http://www.activexperts.com/activmonito … ers/files/

43

Re: VBS: поиск по диску и копирование файлов

Wiliam, можете попробовать ещё VBScript: утилита LogParser от Microsoft, COM-интерфейс.

44

Re: VBS: поиск по диску и копирование файлов

alexii пишет:

Wiliam, можете попробовать ещё VBScript: утилита LogParser от Microsoft, COM-интерфейс.

не фантан

45

Re: VBS: поиск по диску и копирование файлов

Отчего так?

46

Re: VBS: поиск по диску и копирование файлов

Прошу прощения, может не в тему, но не подскажите, как осуществить поиск папки(по части названия) на диске с последующим ее удалением?

47

Re: VBS: поиск по диску и копирование файлов

HABb пишет:

... как осуществить поиск папки <...> на диске...

Самый очевидный способ - рекурсивный перебор с помощью средств FSO.

HABb пишет:

... (по части названия)...

Простейший (но не лучший) вариант - с помощью функции InStr(). Более сложный (но при этом лучший) вариант - с помощью регулярных выражений.

HABb пишет:

... с последующим ее удалением?

Опять же с помощью FSO. Кстати, следует учесть, что может найтись несколько папок с именами, содержащими искомый фрагмент названия.

48

Re: VBS: поиск по диску и копирование файлов

Пол сотни постов и даже странно что никто...хотя Slav был рядом.

Коллеги, зачем изобретать велосипеды?
Если не ошибаюсь, то либа shdocvw.dll не то что бы не сторонняя (как напрмер "вордовская"), а самая что нинаесть системная.

Так вот, эта библиотека предоставляет COM-сервер с говорящим названием - SearchAssistantOC.

Компутера под рукой нет, так что код как-нибудь в следующий раз. (:

49

Re: VBS: поиск по диску и копирование файлов

Ждём-с…

50

Re: VBS: поиск по диску и копирование файлов

А что, кроме меня никто не умеет пользоваться браузерами объектов?

TLB присутствует?
(Object browser чего-нибудь отображает?)

51

Re: VBS: поиск по диску и копирование файлов

Ага, ждём Вашего Гения . Код был Вами обещан выше.

52

Re: VBS: поиск по диску и копирование файлов

2 Аскет:
1) Пошарил в TLB shdocvw.dll и ieframe.dll у себя на Windows 7 x32. Не нашёл там такого COM.
2) Глянул в инете - обрывками написано, что этот ком служит для выбора поставщика поиска (google / yandex / rambler и т.п).
Ошибаюсь ?

Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !

53

Re: VBS: поиск по диску и копирование файлов

Не знаю-не знаю.

Пару методов я уже нарыл, ближе к ночи посмотрю что из этого можно выжать.

p.s. alexii, не думайте что у меня уже есть готовый код, я в основном пишу и складно сочиняю его на ходу (-

54

Re: VBS: поиск по диску и копирование файлов

alexii пишет:

Угу. Было такое дело, кто-то уже упоминал вроде как.

Поиск файлов по расширению

55 (изменено: Аскет, 2011-06-05 05:21:26)

Re: VBS: поиск по диску и копирование файлов

Итак, внимание. Как и обещал.

Я начну, а Вы, надеюсь, продолжите

Set saOC = CreateObject ("SearchAssistantOC.SearchAssistantOC")

Как ни странно (что бывает очень часто) Ни в tlb, ни в msdn , про SearchAssistantOC ни слова не написано...


...Но есть у меня один могильничик! ©

Имеет значит класс такие функции:
Get_SearchCompanionAvailable
Get_UseSearchCompanion
Set_UseSearchCompanion

Свойства:
SearchCompanionAvailable
UseSearchCompanion

И соотв Events:
OnNewSearch
OnNextMenuSelect


p.s. К слову: времени нет да и голова занята другими, более высокими и полезными сущностями

56

Re: VBS: поиск по диску и копирование файлов

Едем далее и видим компонент с ещё более говорящим названием - 'Search Assistant Control' (srchui.dll).
Тут уже и TLB имеется и методы говорящие за себя (StartNewSearch).

Закваску прилагаю (но лучше наверно сунуть его в hta как object, ибо контрол):

set sui	=	CreateObject ("SrchUI.SearchAssistant.1")

Далее по теме.
- 'Content Index ISearch Creator Object'  (query.dll) - без tlb и progID, но с clsid. Наверно, мало чего интересного;
- Неприметная системная либа itircl.dll с классом ITIR.IndexSearch.4 и ещё 11-тью другими. К сожалению, без TypeLib внутри.

57

Re: VBS: поиск по диску и копирование файлов

А меня вполне устраивает использование метода Filter у объекта FolderItems.
Вот пример, у котором он используется. Сценарий скачивает с фтп "свежий" CureIt, ориентируясь на имена каталогов. Это позволяет "иметь под рукой" несколько релизов. Необходимость появилась после нестабильных версий сканера вирусов.

'Created by OldBoa 10:28 29.10.2010
On Error Resume Next
Set oFtp = CreateObject("ChilkatFTP.ChilkatFTP")
If Err.Number <> 0 Then
    MsgBox "Не установлен бесплатный COM-сервер ChilkatFTP." & _
        VbCrLf & "http://www.chilkatsoft.com/ftp-activex.asp/"
    WScript.Quit
End If
CheckDR
On Error GoTo 0
fDate = NeedNULL(Year(Date)) & NeedNULL(Month(Date)) & NeedNULL(Day(Date))
Destination = "F:\CureIT\"
LogPath = "F:\CureIT\cureit_download.log"
Set Dict = CreateObject("Scripting.Dictionary")
Set FSO = CreateObject("Scripting.FileSystemObject")
With oFtp
    .Hostname = "ftp.drweb.com"
    .Username = "anonymous"
    .Password = "cureit_download.vbs"
End With
CheckOnError(oFtp.Connect())
CheckOnError(oFtp.ChangeRemoteDir("pub/drweb/cureit"))
Set objXMLDoc = CreateObject("Microsoft.XMLDOM")
objXMLDoc.async = False
CurrentDirListing = oFtp.GetCurrentDirListing("*.*")
objXMLDoc.loadXML(CurrentDirListing)
Set remoteDir = objXMLDoc.getElementsByTagName("dir")
For Each Dir In remoteDir
    For Each Child In Dir.childNodes
        CurrentString = Trim(Child.NodeValue)
        CurrentDate = Left(CurrentString,8)
        CurrentTime = Right(CurrentString,6)
        If StrComp(CurrentDate,fDate) = 0 Then
            If Not Dict.Exists(CurrentDate) Then
                Dict.Add CurrentDate, CurrentTime
            Else
                ExistsTime = Dict.Item(CurrentDate)
                ExistsHour = Left(ExistsTime,2)
                ExistsMinute = Mid(ExistsTime,3,2)
                CurrentHour = Left(CurrentTime,2)
                CurrentMinute = Mid(CurrentTime,3,2)
                If ExistsHour < CurrentHour Then
                    Dict.Item(CurrentDate) = CurrentTime
                End If
                If ExistsHour = CurrentHour Then
                    If ExistsMinute < CurrentMinute Then
                        Dict.Item(CurrentDate) = CurrentTime
                    End If
                End If
            End If
        End If
    Next
Next
If Dict.Count > 0 Then
    For i=0 To Dict.Count-1
        Keys = Dict.Keys
        Items = Dict.Items
        FinalRemoteDir = Keys(i) & Items(i)
        Set objShellApp = CreateObject("Shell.Application")
        Set objFolder = objShellApp.NameSpace(Destination)
        Set objFolderItems = objFolder.Items()
        FileName = "cureit_" & FinalRemoteDir & ".exe"
        CheckOnError(oFtp.ChangeRemoteDir(FinalRemoteDir))
        objFolderItems.Filter 64+128, FileName
        If objFolderItems.Count = 0 Then
            CheckOnError(oFtp.GetFile("cureit.exe",Destination & FileName))
        Else
            CurrentDirListing = oFtp.GetCurrentDirListing("*.*")
            'WScript.Echo oFtp.GetCurrentRemoteDir()
            objXMLDoc.loadXML(CurrentDirListing)
            Set remoteDir = objXMLDoc.getElementsByTagName("file")
            For Each Dir In remoteDir
                For Each Child In Dir.childNodes
                    Select Case Child.NodeName
                        Case "size" FileSize = Child.firstChild.nodeValue
                    End Select
                Next
            Next
            Set CureITFile = FSO.GetFile(Destination & FileName)
            If StrComp(CureITFile.Size,Trim(FileSize)) <> 0 Then
                CheckOnError(oFtp.GetFile("cureit.exe",Destination & FileName))
            End If
        End If
        CheckOnError(oFtp.ChangeRemoteDir(".."))
    Next
End If
oFtp.Disconnect
ClearOldCureIt
Function NeedNULL(par)
    If Len(par) < 2 Then
        NeedNULL = "0" & par
    Else
        NeedNULL = par
    End If
End Function
Sub ClearOldCureIt
    Set AFolder = FSO.GetFolder(Destination)
    For Each AFile in AFolder.Files
        If DateDiff("D", AFile.DateLastModified, Now) > 2 Then 
            If FSO.GetExtensionName(AFile.Path) = "exe" Then
                AFile.Delete True
            End If
        End If 
    Next
End Sub
Function CheckDR
    Set objSWbemServicesEx = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    Set collSWbemObjectSet = objSWbemServicesEx.ExecQuery("SELECT Name, CommandLine, ProcessID FROM Win32_Process WHERE " & _
        "Name LIKE '%[cw]script.exe' AND CommandLine LIKE '%[cw]script%" & WScript.ScriptName & "%'", "WQL", 0)
    If collSWbemObjectSet.Count > 1 Then
        WScript.Quit
    End If
End Function
Sub WriteToLog(rectype,logtext)
    If FSO.FileExists(LogPath) then
        Set logfile = FSO.GetFile(LogPath)
        Set TextStream = logfile.OpenAsTextStream(8)
        Begin = ""
    Else
        Set TextStream = FSO.CreateTextFile(LogPath)
        Begin = "Дата;Время;Тип записи;Комментарий" & VbCrLf
    End if
    TextStream.WriteLine Begin & Date & ";" & Time & ";" & rectype & ";" & logtext
    TextStream.Close
End Sub
Sub CheckOnError(success)
    If (success <> 1) Then
        WriteToLog "Ошибка",Replace(oFtp.LastErrorText,VbCrLf,"")
        WScript.Quit
    End If
End Sub

58 (изменено: Mr_Death, 2011-06-23 15:10:03)

Re: VBS: поиск по диску и копирование файлов

Вообщем у меня такая проблема!

Нужно зделать так чтобы искало по всем разделам и найденые файлы заменяло файлом из пути указаной в скрипте.

Есть два скрипта у меня и никак не получаеться их связать.

Первый скрипт ищет файлы и удаляет их
Второй скрипт ищет файл и заменяет только первый найденый
А мне нужно заменять все найденые файлы на всех разделах. (ну кроме того файла который все остальные должен заменять (или он сможет сам себя заменить?) )


Option Explicit
'Dim objArgs
Dim strFileName

'If Not WScript.Arguments.Named.Exists("FileName") Then
'    WScript.Echo "Using: " & WScript.ScriptName & " /FileName:<file for find>"
'    WScript.Quit 1
'End If

'strFileName = WScript.Arguments.Named.Item("FileName")

strFileName = "help.txt" ' — имя файла для поиска писать здесь
Dim objFSO
Dim objDrive
ReDim arrPaths(0)
Dim i
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
arrPaths(LBound(arrPaths)) = False
For Each objDrive In objFSO.Drives
If objDrive.DriveType = 2 Then
If objDrive.IsReady Then
FindInSubFolders objDrive.RootFolder, strFileName
End If
End If
Next
If arrPaths(LBound(arrPaths)) Then
'WScript.Echo "" & strFileName & ""
For i = LBound(arrPaths) + 1 To UBound(arrPaths)
'WScript.Echo arrPaths(i)


objFSO.DeleteFile arrPaths(i)


Next
Else
WScript.Echo "Not found paths for file [" & strFileName & "]."
End If
Set objFSO = Nothing
WScript.Quit 0

Sub FindInSubFolders(objFolderForFind, strFileName)
Dim objFolder
'WScript.Echo objFolderForFind.Path
If objFSO.FileExists(objFSO.BuildPath(objFolderForFind, strFileName)) Then
ReDim Preserve arrPaths(Ubound(arrPaths) + 1)
arrPaths(LBound(arrPaths)) = True
arrPaths(UBound(arrPaths)) = objFSO.BuildPath(objFolderForFind, strFileName)
'WScript.Echo "Found file [" & strFileName & "] on folder [" & objFolderForFind.Path & "]"
End If
On Error Resume Next
For Each objFolder In objFolderForFind.SubFolders
If Err.Number = 0 Then
FindInSubFolders objFolder, strFileName
Else
Err.Clear
'WScript.Echo "Can't enumerate subfolders for folder [" & objFolderForFind.Path & "]"
End If
Next
On Error Goto 0
End Sub

Второй скрипт

Option Explicit


Dim objFSO
Dim objDrive
Dim strFileNameForFind
Dim boolDone


strFileNameForFind = "help.txt"                                    ' Имя файла для поиска.

Set objFSO   = WScript.CreateObject("Scripting.FileSystemObject")
Set objDrive = objFSO.GetDrive("h:")					' Буква Раздела

WScript.Echo "Find on drive " & objDrive.DriveLetter & ":..."

boolDone = False
ScanSubFolders objDrive.RootFolder, strFileNameForFind               ' Вызываем процедуру поиска
                                                                     ' для корневой папки этого тома.
                                                                     ' Обработка вложенных папок будет
                                                                     ' вестись рекурсивно.

Set objDrive = Nothing
Set objFSO   = Nothing

WScript.Quit 0
'=============================================================================

'=============================================================================
Sub ScanSubFolders(objFolder, strFileName)
    Dim objSubFolder
    Dim strFullFileName
    
                                         ' Выводим путь обрабатываемой папки (для
                                                                     ' отладки; имеет смысл закомментировать).
    
    strFullFileName = objFSO.BuildPath(objFolder.Path, strFileName)  ' Строим полный путь к файлу.
    
    If objFSO.FileExists(strFullFileName) Then                       ' Файл существует?
        WScript.Echo vbTab & "Found as [" & strFullFileName & "], copying..."
        
                                                                     ' Копируем файл
        objFSO.CopyFile objFSO.BuildPath("d:\", strFileName), strFullFileName, True
        boolDone = True
        
        Exit Sub
    End If
    
    On Error Resume Next                                             ' Обрабатываем ошибки, возможные в случае,
                                                                     ' когда нет доступа к содержимому папки
                                                                     ' (пример - «System Volume Information».
    For Each objSubFolder In objFolder.SubFolders
        If Err.Number = 0 Then                                       ' Удалось получить доступ к содержимому папки?
            On Error Goto 0                                          ' Восстанавливаем стандартную обработку ошибок
            
            If Not boolDone Then
                ScanSubFolders objSubFolder, strFileName             ' Вызываем процедуру поиска для каждой из подпапок.
            End If
        Else                                                         ' Если не удалось —
            Err.Clear                                                ' сбрасываем состояние ошибки,
            On Error Goto 0                                          ' восстанавливаем стандартную обработку ошибок и движемся дальше.
            WScript.Echo "Can't enumerate subfolders for folder [" & objFolder.Path & "]."
        End If
    Next
End Sub

59

Re: VBS: поиск по диску и копирование файлов

Я так понимаю, готового решения для поиска файлов в подпапках по маске, на VBS не существует?

60

Re: VBS: поиск по диску и копирование файлов

Отчасти. На «чистом» VBScript («искаропки») — нет, только обычный рекурсивный перебор и фильтрация найденных имён посредством RegExp. При использовании вывода dir с метасимволами — обязательно огребёте проблемы с короткими именами кириллических файлов. При использовании WMI — поиск происходит глобально и дико медленно.

Лично я предпочитаю при нужде в масках использование компонента LogParser. Примеры есть на форуме.

61 (изменено: HABb, 2011-06-30 16:32:55)

Re: VBS: поиск по диску и копирование файлов

alexii пишет:

Отчасти. На «чистом» VBScript («искаропки») — нет, только обычный рекурсивный перебор и фильтрация найденных имён посредством RegExp. При использовании вывода dir с метасимволами — обязательно огребёте проблемы с короткими именами кириллических файлов. При использовании WMI — поиск происходит глобально и дико медленно.

Лично я предпочитаю при нужде в масках использование компонента LogParser. Примеры есть на форуме.

Спасибо. Сам я чайник, начинающий пробовать VBS.

Нашел на просторах интернета вот такой скрипт:

Dim fso,mySet,myDir,st
Dim s()
i=0

Dim regEx, Match, Matches, regtxt
Set regEx = New RegExp
regEx.IgnoreCase = True
regEx.Global = True

mySet="*.hrn *.avi"

For Each m1 in Split(mySet," ",-1,1)
    regtxt = regtxt & "\." & m1 & "$|"
Next
regEx.Pattern = Left(regtxt, Len(regtxt)-1)

myDir="d:\games"

Set fso = CreateObject("Scripting.FileSystemObject")

Sub ListFolder(curDir)
On Error Resume Next
    For Each f1 in fso.GetFolder(curDir).Files
    If Err.Number = 0 Then
            If regEx.Test(f1) Then
                ReDim Preserve s(i+1)
                s(i) = f1.path
                i=i+1
            End If
    End If
    Next
Err.Clear
    For Each s1 in fso.GetFolder(curDir).SubFolders
        If Err.Number = 0 Then
            ListFolder(s1.path)
        End If
    Next
Err.Clear
On Error Goto 0
End Sub

ListFolder(myDir)

For k=0 To i-1
        MsgBox "Количество файлов: " & i & vbCrLf & st
        st=k+1 & ") " & s(k) & vbCrLf
Next

Вдруг кому пригодится.

Вопрос по поводу LogParser...

Set oLogQuery = CreateObject("MSUtil.LogQuery")
Set oFormat = CreateObject("MSUtil.LogQuery.FileSystemInputFormat")
Set oRecordSet = oLogQuery.Execute("SELECT * FROM C:\*.mp3", oFormat)
i = 0
While Not oRecordSet.atEnd
    Set oRecord = oRecordSet.getRecord()
    strValue = oRecord.getValue("Path")
    WScript.Echo strValue
    i = i + 1
    oRecordSet.moveNext
Wend
oRecordSet.Close
WScript.Echo "На диске ""C:"" найдено mp3-файлов: " & i

Как сделать так, что бы он найденные файлы записывал в C:\log.txt, а потом удалял?

62

Re: VBS: поиск по диску и копирование файлов

HABb пишет:

Как сделать так, что бы он найденные файлы записывал в C:\log.txt

Как обычно: с помощью «Scripting.FileSystemObject» пишете «strValue» в потребный файл, затем, при помощи него же, удаляете.

63

Re: VBS: поиск по диску и копирование файлов

alexii пишет:

Отчасти. На «чистом» VBScript («искаропки») — нет, только обычный рекурсивный перебор и фильтрация найденных имён посредством RegExp. При использовании вывода dir с метасимволами — обязательно огребёте проблемы с короткими именами кириллических файлов. При использовании WMI — поиск происходит глобально и дико медленно.

Лично я предпочитаю при нужде в масках использование компонента LogParser. Примеры есть на форуме.

А чем плох способ с использованием метода Filter у объекта FolderItems?
Фильтрация найденных имен осуществляется быстро и по маске. Нет необходимости использовать регулярные выражения. Может это слишком медленно, конечно, каждому свое. Но приведенный ниже сценарий, проверив на сетевом ресурсе объемом 150Гб с 11443 папками, искал и выводил путь к каждому mp3-файлу 5 минут и 56 секунд.

'Created by OldBoa 10:12 01.07.2011
StartTime = Timer
TotalFiles = 0
TotalFolders = 0
RootPath = "w:"
FindMask = "*.mp3"
FilesInFolder RootPath,FindMask
WScript.Echo "Обработано папок: " & TotalFolders
WScript.Echo "Найдено файлов: " & TotalFiles
WScript.Echo "Время работы сценария: " & TimeBySeconds(Timer - StartTime)
Sub FilesInFolder(strFolder,strFile)
	Set objShellApp = CreateObject("Shell.Application")
	Set objFolder = objShellApp.NameSpace(strFolder)
	Set objFolderItems = objFolder.Items()
	objFolderItems.Filter 32, "*"
	If objFolderItems.Count <> 0 Then
		TotalFolders = TotalFolders + objFolderItems.Count
		For Each SubFolder In objFolderItems
			FilesInFolder SubFolder.Path,strFile
		Next
	End If
	objFolderItems.Filter 64+128, strFile
	If objFolderItems.Count <> 0 Then
		TotalFiles = TotalFiles + objFolderItems.Count
		For Each CurrentFile In objFolderItems
			WScript.Echo CurrentFile.Path
		Next
	End If
End Sub
Function TimeBySeconds(ttt)
	hours = ttt\3600
	minutes = (ttt-hours*3600)\60
	seconds = ((ttt-hours*3600)-minutes*60)\1
	TimeBySeconds = NeedNULL(hours) & ":" & NeedNULL(minutes) & ":" & NeedNULL(seconds)
End Function
Function NeedNULL(par)
	If Len(par) < 2 Then
		NeedNULL = "0" & par
	Else
		NeedNULL = par
	End If
End Function

64 (изменено: HABb, 2011-07-01 11:12:55)

Re: VBS: поиск по диску и копирование файлов

alexii пишет:

Как обычно: с помощью «Scripting.FileSystemObject» пишете «strValue» в потребный файл, затем, при помощи него же, удаляете.

Т.е. добавить в конце:

Set Fso = CreateObject("Scripting.FileSystemObject")
Set Text = Fso.CreateTextFile("c:\log.txt")
    Text.Write strValue
    Text.Close
Fso.DeleteFile strValue

Я правильно написал? Просто в данном случае он пишет одну строку.

65

Re: VBS: поиск по диску и копирование файлов

Почти. Открывать файл до цикла обработки набора записей, писать в файл внутри цикла, закрывать — после цикла. Удалять файл можно так же внутри цикла обработки.

66

Re: VBS: поиск по диску и копирование файлов

Большое спасибо, становится понятней.
Извините за назойливость, а в данном скрипте:

Dim fso,mySet,myDir,st
Dim s()
i=0

Dim regEx, Match, Matches, regtxt
Set regEx = New RegExp
regEx.IgnoreCase = True
regEx.Global = True

mySet="*.hrn *.avi"

For Each m1 in Split(mySet," ",-1,1)
    regtxt = regtxt & "\." & m1 & "$|"
Next
regEx.Pattern = Left(regtxt, Len(regtxt)-1)

myDir="d:\games"

Set fso = CreateObject("Scripting.FileSystemObject")

Sub ListFolder(curDir)
On Error Resume Next
    For Each f1 in fso.GetFolder(curDir).Files
    If Err.Number = 0 Then
            If regEx.Test(f1) Then
                ReDim Preserve s(i+1)
                s(i) = f1.path
                i=i+1
            End If
    End If
    Next
Err.Clear
    For Each s1 in fso.GetFolder(curDir).SubFolders
        If Err.Number = 0 Then
            ListFolder(s1.path)
        End If
    Next
Err.Clear
On Error Goto 0
End Sub

ListFolder(myDir)

For k=0 To i-1
        MsgBox "Количество файлов: " & i & vbCrLf & st
        st=k+1 & ") " & s(k) & vbCrLf
Next

Где это нужно вставить? Что бы и в лог писалось и удалялись файлы?

67

Re: VBS: поиск по диску и копирование файлов

s(i) = f1.path
'Где-то здесь…
i=i+1

68 (изменено: alexii, 2011-10-15 21:55:05)

Re: VBS: поиск по диску и копирование файлов

Перенесено, как несоответствующее теме, в отдельную тему: VBScript: проверка существования файла.

69

Re: VBS: поиск по диску и копирование файлов

Добрый день!
Сложилась такая ситуация, что необходимо найти все файлы, удовлетворяющие условию (пусть условием будет дата создания < текущая дата - 3 дня) и получить из этого списка список  расширений файлов (т.к. файлов в папке около 2-3 тысяч, а таких папок порядка 10, то перебирать по одному каждый файл - не самое изящное решение, а расширения повторяются).
Смотрел на пост с LogQuery, но не понял правил построения запросов (что подразумевается под *, как выбрать файлы только из одной папки, без поиска в подпапках) и так же неизвестны возможности данного SQL сервера. Может кто-нибудь делал нечто похожее?
Понравился пост про Word.Application, появилась задумка с ним, НО ни в какую не хочет работать сортировка. Если делать макрос в офисе, то сортировка работает, если создавать vbs файл - нет, а нужен именно автономный VBS файл.
Надеюсь не слишком громоздкий пост.:)
Заранее спасибо.

70

Re: VBS: поиск по диску и копирование файлов

Примеры запросов буду приводить для командной строки (при желании для WSH используйте ActiveX LogParser «MSUtil.LogQuery», запросы будут теми же, а результат запроса перебирается практически так же, как в ADO).

необходимо найти все файлы, удовлетворяющие условию (пусть условием будет дата создания < текущая дата - 3 дня)

…WHERE Attributes NOT LIKE 'D________' AND CreationTime >= TO_LOCALTIME(SUB(SYSTEM_TIMESTAMP(), TIMESTAMP('0000-01-04', 'yyyy-MM-dd')))…

и получить из этого списка список  расширений файлов

SELECT Extension USING EXTRACT_EXTENSION(Path) AS Extension

Если требуется не просто отобрать все, а получить именно уникальные, то:

SELECT Extension USING EXTRACT_EXTENSION(Path) AS Extension … GROUP BY Extension ORDER BY Extension ASC

а таких папок порядка 10

…FROM 'E:\Песочница\0099\*.*', 'E:\Песочница\0100\*.*', 'E:\Песочница\0101\*.*'…

Смотрел на пост с LogQuery, но не понял правил построения запросов

В комплекте инсталляции идёт файл справки с подробнейшим описанием и примерами.

как выбрать файлы только из одной папки, без поиска в подпапках

… -recurse:0 …

То есть, у Вас должен получиться примерно такая команда:

"C:\Program Files\Log Parser 2.2\LogParser.exe" "SELECT EXTRACT_EXTENSION(Path) AS Extension FROM 'E:\Песочница\0099\*.*', 'E:\Песочница\0100\*.*', 'E:\Песочница\0101\*.*' WHERE CreationTime >= TO_LOCALTIME(SUB(SYSTEM_TIMESTAMP(), TIMESTAMP('0000-01-04', 'yyyy-MM-dd'))) AND Attributes NOT LIKE 'D________' GROUP BY Extension ORDER BY Extension ASC" -i:FS -q:ON -oCodepage:866 -recurse:0

Под WSH сие может выглядеть, например, так:

Option Explicit

Dim objLogQuery
Dim objFileSystemInputFormat
Dim strQuery
Dim strColumn

Set objLogQuery = WScript.CreateObject("MSUtil.LogQuery")
Set objFileSystemInputFormat = WScript.CreateObject("MSUtil.LogQuery.FileSystemInputFormat")

With objFileSystemInputFormat
    .preserveLastAccTime = True
    .recurse = False
    .useLocalTime = True
End With

strQuery = _
    "SELECT EXTRACT_EXTENSION(Path) AS Extension " & _
    "FROM 'E:\Песочница\0099\*.*', 'E:\Песочница\0100\*.*', 'E:\Песочница\0101\*.*' " & _
    "WHERE CreationTime >= TO_LOCALTIME(SUB(SYSTEM_TIMESTAMP(), TIMESTAMP('0000-01-04', 'yyyy-MM-dd'))) " & _
    "AND Attributes NOT LIKE 'D________' " & _
    "GROUP BY Extension ORDER BY Extension ASC"

With objLogQuery.Execute(strQuery, objFileSystemInputFormat)
    strColumn = .getColumnName(0)
    
    WScript.Echo strColumn
    WScript.Echo "-----------------------------"
    
    Do Until .atEnd()
        With .getRecord()
            If Not .IsNull(strColumn) Then
                WScript.Echo .toNativeString(strColumn)
            Else
                WScript.Echo "(Null)"
            End If
        End With
        
        .moveNext
    Loop
    
    WScript.Echo "-----------------------------"
    
    .close
End With

Set objFileSystemInputFormat = Nothing
Set objLogQuery              = Nothing

WScript.Quit 0

71 (изменено: DiabloNT, 2012-01-17 20:02:14)

Re: VBS: поиск по диску и копирование файлов

Спасибо огромное. Благодаря Вам появился большой плацдарм для размышлений и изучения:) Даже не думал что в винде есть столько всего полезного:)
P.S. условие не верное было, должен быть знак меньше:) Это для тех,  кому еще будет интересен данный код.

CreationTime < TO_LOCALTIME(SUB(SYSTEM_TIMESTAMP(), TIMESTAMP('0000-01-04', 'yyyy-MM-dd')))