помогите с скриптом очистки рабочего стола
Может кто уже делал нужен скрипт на удаление всех файлов и папок с рабочего стола и документов кроме lnk(ярлыков) на WinXP и Win7?
|
Подозреваю, что никто такими ужасами не занимался. Зачем это, если не секрет?
|
Руководство параноит просить у всех юзеров все почистить , научить их сохранять на сетевой диск
|
Scaner, попробуйте на основе такого:
читать дальше »
Код:
Option Explicit
Dim objFSO
Dim objWshShell
Dim objShell
Dim strMyDocuments
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set objWshShell = WScript.CreateObject("WScript.Shell")
Set objShell = WScript.CreateObject("Shell.Application")
strMyDocuments = objWshShell.SpecialFolders("Desktop")
ScanSubFolders objFSO.GetFolder(strMyDocuments) ' Вызываем процедуру обхода
' Обработка вложенных папок будет
' вестись рекурсивно.
Set objShell = Nothing
Set objWshShell = Nothing
Set objFSO = Nothing
WScript.Quit 0
'=============================================================================
'=============================================================================
Sub ScanSubFolders(objFolder)
Dim objFile
Dim objSubFolder
Dim objShellFolder
Dim strFullFileName
WScript.Echo objFolder.Path ' Выводим путь обрабатываемой папки (для
' отладки; имеет смысл закомментировать).
Set objShellFolder = objShell.NameSpace(objFolder.Path) ' Пробуем получить папку.
If Not (objShellFolder Is Nothing) Then ' Если удалось…
With objShellFolder.Self
If .IsFolder And .IsLink Then ' …если это одновременно папка и ссылка…
WScript.Echo " > Link to [" & .GetLink.Path & "]" ' …уведомляем об этом…
Exit Sub ' …и прекращаем обработку такой папки.
End If
End With
End If
For Each objFile In objFolder.Files ' Перебираем все файлы в папке
If UCase(objFSO.GetExtensionName(objFile.Path)) <> UCase("lnk") Then ' Если файл не является ярлыком…
WScript.Echo vbTab & objFile.Path ' …выводим имя файла (можно закомментировать)…
objFile.Delete True ' …и удаляем его.
End If
Next
On Error Resume Next ' Обрабатываем ошибки, возможные в случае,
' когда нет доступа к содержимому папки
' (пример - «System Volume Information».
For Each objSubFolder In objFolder.SubFolders
If Err.Number = 0 Then ' Удалось получить доступ к содержимому папки?
On Error Goto 0 ' Восстанавливаем стандартную обработку ошибок
ScanSubFolders objSubFolder ' Вызываем процедуру поиска для каждой из подпапок.
Else ' Если не удалось —
Err.Clear ' сбрасываем состояние ошибки,
On Error Goto 0 ' восстанавливаем стандартную обработку ошибок и движемся дальше.
WScript.Echo "Can't enumerate subfolders for folder [" & objFolder.Path & "]."
End If
Next
If objFolder.SubFolders.Count = 0 And objFolder.Files.Count = 0 Then ' Если папка пуста…
If UCase(objFolder.Path) <> UCase(strMyDocuments) Then ' …и это не головная папка, с которой началась очистка…
objFolder.Delete True ' …удаляем её
End If
End If
End Sub
'=============================================================================
|
Цитата:
Цитата Scaner
Руководство параноит просить у всех юзеров все почистить , научить их сохранять на сетевой диск »
|
А почему нельзя сделать тогда перенаправляемые папки? |
Большое спасибо все получилось можно
\\closed
|
Время: 19:11.
© OSzone.net 2001-
