автоматиеская очистка рабочего стола
посоветуйте как с помощью сценария входа в систему очищать рабочий стол – чтобы оставался фиксированный набор ярлыков, а все файлы и папки перемещались в папку пользователя. ограничение – под конкретного пользователя, а не всех сразу.
в идеале текст сценария и куда его подставить.
|
sanek-l,
Код:
Option Explicit
Dim objFSO, objWshShell, objShell
Dim objFile, objSubFolder, objFolder
Dim objFolderItem, objShellFolder
Dim objWshShortcut, strDesktop, strDstPath
Dim strUserTask, strUserName, strTask
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set objShell = WScript.CreateObject("Shell.Application")
Set objWshShell = WScript.CreateObject("WScript.Shell")
strDesktop = objWshShell.SpecialFolders("Desktop") ' Определяем "Рабочий стол" пользователя
strDstPath = objWshShell.SpecialFolders("MyDocuments")
strUserName = objwshshell.ExpandEnvironmentStrings("%USERNAME%")
strDstPath = strDstPath &"\"&"DeskResource" ' Определяем целевую папку (в "Моих документах")
strUserTask = "HP Pavilion" ' Определяем "конкретного пользователя"
If Not strUserTask = strUserName Then
MsgBox "Процедура не предусмотрена для текущего пользователя" ' Если пользователь не тот, то... (необязательно)
WScript.Quit 0
Else
strTask = False
Call ClearDesktop("str")
IF strTask Then
Call Shortcut("str")
End if
Set objShell = Nothing
Set objWshShell = Nothing
Set objFSO = Nothing
End If
Wscript.Echo "Сценарий успешно выполнен!" ' Необязательно
WScript.Quit 0
' ************************************************************************
Function ClearDesktop(str) ' Проверяем все элементы рабочего стола
set objFolder = objFSO.GetFolder(strDesktop)
For Each objFile In objFolder.Files
' Если не ярлык
' и не ярлык интернета (можно убрать)
' и не файл desktop.ini
IF UCase(objFSO.GetExtensionName(objFile)) <> UCase("lnk") And _
UCase(objFSO.GetExtensionName(objFile)) <> UCase("url") And _
objFSO.GetBaseName(objFile.Name) <> "desktop" Then
strTask = True
If Not objFSO.FolderExists(strDstPath) Then ' Если целевой папки нет
objFSO.CreateFolder strDstPath ' создаем её
End If
objFile.Move strDstPath &"\" ' перемещаем файлы
End if
Next
' -------------------------------------------------------------------------
For Each objSubFolder In objFolder.SubFolders
Set objShellFolder = objShell.NameSpace(objSubFolder.Path)
IF Not Len(objShellFolder.Self) < Len(objSubFolder.Name) Then ' Если папка не ярлык
strTask = True
If Not objFSO.FolderExists(strDstPath) Then
objFSO.CreateFolder strDstPath
End If
If objSubFolder.Files.Count = 0 Then ' Если папка пустая
objSubFolder.Delete ' Удаляем
Else
objSubFolder.Move strDstPath &"\" ' Если нет - перемещаем
End If
End if
Next
End function
' *************************************************************************
Function Shortcut(str) ' Создаем ярлык для папки с перемещенными файлами (если его нет)
If not objFSO.FileExists(strDesktop & "\DeskResource.lnk") Then
Set objWshShortcut = objWshShell.CreateShortcut(strDesktop & "\DeskResource.lnk")
objWshShortcut.WorkingDirectory = strDstPath
objWshShortcut.TargetPath = strDstPath
objWshShortcut.Description = "Сохраненные файлы рабочего стола"
objWshShortcut.IconLocation = "shell32.dll, 260"
objWshShortcut.Save
End If
End function
Испытано на WinVista! Прошу отписаться по факту проверки...
|
Время: 18:21.
© OSzone.net 2001-
