Тема: VBScript: скрипт составления списка файлов
Скрипт составляет список всех файлов указанного пользователем ресурса: диска или папки, включая файлы во всех вложенных папках.
Для указания ресурса используется стандартное диалоговое окно "Обзор папок". Скрипт составляет список всех файлов, содержащихся в указанной пользователем папке и ее подпапках. Результат записывается в файл отчета.
Логика работы скрипта описана в комментариях кода.
'**********************************************
'* GetListFiles.vbs
'*---------------------------------------------
'* Скрипт получения списка файлов
'*---------------------------------------------
'* Programming by VerSys, 2008
'**********************************************
Option Explicit
'
'Переменные и константы
Public strPath 'Патч текущих диска, папки, подпапки
Public strSeparator 'Строка-разделитель списка
Public strSpace 'Строка с заданным количеством пробелов
Public strBuffer 'Строка-накопитель сведений о папках, файлах
Dim strFileName 'Имя файла отчета
Const strHead = "Выберите диск или папку:"
'
'объектные переменные
Dim objShell
Dim objDialogFolder
Dim objDialogFolderItem
Dim objFolder
Dim objFolderItem
Dim objFSO
'инициализация переменных
strSeparator = String(40, "-")
strSpace = Space(3)
'--------------------------------------------------------------
'Формируем диалоговое окно "Обзор папок"
Set objShell = CreateObject("Shell.Application") 'Объект Shell
Set objDialogFolder = objShell.Namespace(&H11&) 'Name_Space = "Мой компьютер",
Set objDialogFolderItem = objDialogFolder.Self 'и устанавливаем по умолчанию в диал.окне
strPath = objDialogFolderItem.Path
'
'Выводим диалоговое окно "Обзор папок"
Set objFolder = objShell.BrowseForFolder(0,strHead,0,strPath)
'
'Если ничего не выбрано - завершаем скрипт
If objFolder Is Nothing Then
Wscript.Quit
End If
'
'Если пользователь выбрал диск или папку:
''получаем патч из диалога
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
'
''создаем File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
'
''проверяем доступность указанного ресурса
If objFSO.FolderExists(strPath) = False Then
MsgBox "Нет доступа к ресурсу ''" & strPath & "''",_
vbOkOnly + vbCritical, strPath
Wscript.Quit
End If
'
''вызываем функцию прохода по каталогам и файлам
dhGetListFolderFile(strPath)
'
''Создаем файл отчета
'''Формируем имя файла отчета как строка патча с заменой недопустимых символов
strFileName = Replace(Replace(strPath, ":\", "-"), "\", "=")
strFileName = strFileName & ".txt"
'''Результат пишем в файл
With objFSO.CreateTextFile(strFileName)
.WriteLine(strBuffer)
.Close
End With
'
'Уничтожаем объекты
Set objShell = Nothing
Set objDialogFolder = Nothing
Set objDialogFolderItem = Nothing
Set objFolder = Nothing
Set objFolderItem = Nothing
Set objFSO = Nothing
'
'Сообщаем о создании отчета
MsgBox "Отчет создан в файле:" & Chr(13) &_
"''" & strFileName & "''", vbOkOnly + vbInformation, strPath
'
'--------------------------------------------------------------
' FUNCTION'S
'--------------------------------------------------------------
Function dhGetListFolderFile(strFolderName)
'Функция прохода по каталогам и файлам
Dim dFolder, dFile, dSubFolder
'получаем патч каталога
Set dFolder = objFSO.GetFolder(strFolderName)
'проходим файлы текущего каталога
strBuffer = strBuffer & strFolderName & " <DIR>" & vbNewLine
For Each dFile In dFolder.Files
strBuffer = strBuffer & strSpace & dFile.Name & " - " & dFile.Size & vbNewLine
Next
strBuffer = strBuffer & strSeparator & vbNewLine
'проходим рекурсивно по всем подкаталогам
For Each dSubFolder In dFolder.SubFolders
dhGetListFolderFile(dSubFolder.Path)
Next
End Function