NAW1986
12-06-2009, 10:52
Есть скрипт получения списка файлов в локальной сети:
'**********************************************
'* 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
Dim FSO,F,File,Files,WshShell,PathList,WshFldrs,strTemp,strNew
'инициализация переменных
strSeparator = String(40, "-")
strSpace = Space(3)
'--------------------------------------------------------------
'Создаем объект FileSystemObject
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
'Создаем объект WshShell
Set WshShell = WScript.CreateObject("Wscript.Shell")
'Создаем объект WshSpecialFolders
Set WshFldrs = WshShell.SpecialFolders
'Определяем путь к папке \\AC\MP3
PathList = WshFldrs.item("NAW") & "\\AC\Mp3\Volume.10"
'Создаем объект Folder для папки \\AC\MP3
Set strPath = objFSO.GetFolder(PathList)
''проверяем доступность указанного ресурса
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
on error resume next
For Each dFile In dFolder.Files
strBuffer = strBuffer & strSpace & dFile.Name & vbNewLine
Next
strBuffer = strBuffer & strSeparator & vbNewLine
'проходим рекурсивно по всем подкаталогам
For Each dSubFolder In dFolder.SubFolders
dhGetListFolderFile(dSubFolder.Path)
Next
End Function
Вроде работет, но когда идет обращение к ресурсу к которому нету доступа выбивает ошибку и прикращает работу. А как сделать чтобы при запрете доступа скрипт просматривал остальные папки и создавал отчет.
'**********************************************
'* 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
Dim FSO,F,File,Files,WshShell,PathList,WshFldrs,strTemp,strNew
'инициализация переменных
strSeparator = String(40, "-")
strSpace = Space(3)
'--------------------------------------------------------------
'Создаем объект FileSystemObject
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
'Создаем объект WshShell
Set WshShell = WScript.CreateObject("Wscript.Shell")
'Создаем объект WshSpecialFolders
Set WshFldrs = WshShell.SpecialFolders
'Определяем путь к папке \\AC\MP3
PathList = WshFldrs.item("NAW") & "\\AC\Mp3\Volume.10"
'Создаем объект Folder для папки \\AC\MP3
Set strPath = objFSO.GetFolder(PathList)
''проверяем доступность указанного ресурса
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
on error resume next
For Each dFile In dFolder.Files
strBuffer = strBuffer & strSpace & dFile.Name & vbNewLine
Next
strBuffer = strBuffer & strSeparator & vbNewLine
'проходим рекурсивно по всем подкаталогам
For Each dSubFolder In dFolder.SubFolders
dhGetListFolderFile(dSubFolder.Path)
Next
End Function
Вроде работет, но когда идет обращение к ресурсу к которому нету доступа выбивает ошибку и прикращает работу. А как сделать чтобы при запрете доступа скрипт просматривал остальные папки и создавал отчет.