Компьютерный форум OSzone.net  

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)
-   Скриптовые языки администрирования Windows (http://forum.oszone.net/forumdisplay.php?f=102)
-   -   Очистка рабочего стола/моих документов (http://forum.oszone.net/showthread.php?t=297305)

jbk 22-03-2015 22:45 2486224
Очистка рабочего стола/моих документов
 
Добрый день,

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

нужно чтобы скрипт вначале скопировал все файлы с Рабочего стола и из Моих документов в сетевую папку \\server\Profiles$ создавая для каждого %userprofile% отдельный каталог и копировал в него соотв документы и рабочий стол, сохраняя структуру каталогов,

а затем бы удалил с рабочего стола и моих документов все файлы/папки кроме *.lnk и *.rdp (но эти файлы должны остаться только в корне рабочего стола и моих документов - если были такие файлы во вложенных папках - то их удалять вместе с папками)

главный смысл - все данные слить в сетевую папку,

а рабочий стол/мои документы оставить только с *.lnk и *.rdp файлами, без каких-либо папок и пр. файлов

jbk 23-03-2015 10:25 2486345
нашел вот такой скрипт vbs... но не получается копировать по сетевому пути \\server\profiles$? скрипт только удаляет файлы....

Скрытый текст
'============================================
'Перенос содержимого десктопа пользователя
'Мосийчук Сергей (klasik_cc@mailru), 17.08.2006
'Запускается обьектом груповой политики при выходе пользователя
'============================================

On Error Resume Next
Set SHELL = CreateObject ("WScript.Shell")
Set SF = SHELL.SpecialFolders
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(SF("Desktop"))
Set colSubfolders = objFolder.Subfolders
Set WshNet = CreateObject ("WScript.Network")
DDir = "\\server\Profiles$"

'Используя рекурсию сбрасываем атрибуты всех файлов во всех каталогах и подкаталогах десктопа.
'Необходимо для последующего их удаления.

Set objParentFolder = objFSO.GetFolder(SF("Desktop"))
ShowSubfolders objParentFolder
Sub ShowSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
Set objSubFolder = objFSO.GetFolder(Subfolder.Path)
ShowSubFolders Subfolder
For Each efile in objSubFolder.Files
Set gFILE = objFSO.GetFile (efile)
gFILE.Attributes = 0
Next
Next
End Sub

'копируем с последующим удалением все каталоги десктопа (соответственно с их содержимым).
'Использование здесь CopyFolder вместо MoveFolder связано с возможностью метода CopyFolder перезаписывать файл,
'если такой существует в целевой папке.

For Each objSubfolder in colSubfolders
objFSO.CopyFolder objFSO.GetFolder(SF("Desktop"))+"\"+objSubfolder.Name, DDir+WshNet.UserName+"\"
objFSO.DeleteFolder objFSO.GetFolder(SF("Desktop"))+"\"+objSubfolder.Name
Next

'теперь перебираем все файлы которые находятся на рабочем столе, и если их тип не ярлык,
'то сбрасываем атрибут на 0, копируем и убиваем.

For Each efile in objFolder.Files
Set gFILE = objFSO.GetFile (efile)
fEXT = objFSO.GetExtensionName (efile.Path)
If LCase (fEXT)<>"lnk" then
gFILE.Attributes = 0
objFSO.CopyFile efile, DDir+WshNet.UserName+"\"
objFSO.DeleteFile efile
End If
Next

Iska 23-03-2015 10:32 2486346
Цитата:
Цитата jbk
нашел вот такой скрипт... но не получается копировать по сетевому пути \\server\profiles$ »
Для начала уберите «On Error Resume Next». Возможно, после этого увидите что именно «не получается».

jbk 23-03-2015 10:48 2486358
ага ошибку нашел, вот только слабо я понимаю в программировании....

objFSO.CopyFolder objFSO.GetFolder(SF("Desktop"))+"\"+objSubfolder.Name, DDir+WshNet.UserName+"\" вот в этой строке ошибка - не найден путь..... какой именно путь не пойму.. исходный? рабочий стол пользователя?

Iska 23-03-2015 11:05 2486361
Вставьте перед этой строкой следующее:
Код:
WScript.Echo objFSO.GetFolder(SF("Desktop"))+"\"+objSubfolder.Name
WScript.Echo DDir+WshNet.UserName+"\"
— увидите. Возможно, поможет.

jbk 23-03-2015 11:14 2486366
Iska, помогло....

теперь понял, что мне еще нужно поменять в этом скрипте... может поможете?

у меня скрипт пишет в папку \\server\Profiles$\имя_профиля
при этом папка имя_профиля должна быть создана до исполнения скрипта вручную,
как бы дописать, чтобы сам скрипт создавал папку с именем профиля (%userprofile%) в папке \\server\Profiles$ в случае ее отсутствия
и копировал бы файлы с рабочего стола в папку: \\server\Profiles$\имя_профиля\Desktop

jbk 23-03-2015 12:12 2486394
Допилил скрипт сам, правда убрал папку Desktop:

Скрытый текст
Код:
'============================================ 
'Перенос содержимого десктопа пользователя 
'============================================ 
 
On Error Resume Next 
Set SHELL = CreateObject ("WScript.Shell") 
Set SF = SHELL.SpecialFolders 
Set objFSO = CreateObject("Scripting.FileSystemObject") 
Set objFolder = objFSO.GetFolder(SF("Desktop")) 
Set colSubfolders = objFolder.Subfolders 
Set WshNet = CreateObject ("WScript.Network") 
Set objNet = WScript.CreateObject("WScript.Network")
Set FSO = CreateObject("scripting.filesystemobject")

sUserName = WshNet.UserName
folderToCheckFor = "\\filesrv\profiles$\"+sUserName
If (FSO.FolderExists(folderToCheckFor)) = False Then
FSO.CreateFolder(folderToCheckFor)
End If
 
'Используя рекурсию сбрасываем атрибуты всех файлов во всех каталогах и подкаталогах десктопа. 
'Необходимо для последующего их удаления. 
 
Set objParentFolder = objFSO.GetFolder(SF("Desktop")) 
ShowSubfolders objParentFolder 
Sub ShowSubFolders(Folder) 
For Each Subfolder in Folder.SubFolders 
Set objSubFolder = objFSO.GetFolder(Subfolder.Path) 
ShowSubFolders Subfolder 
For Each efile in objSubFolder.Files 
Set gFILE = objFSO.GetFile (efile) 
gFILE.Attributes = 0 
Next 
Next 
End Sub 
 
'копируем с последующим удалением все каталоги десктопа (соответственно с их содержимым). 
'Использование здесь CopyFolder вместо MoveFolder связано с возможностью метода CopyFolder перезаписывать файл, 
'если такой существует в целевой папке. 
 
For Each objSubfolder in colSubfolders 

'WScript.Echo objFSO.GetFolder(SF("Desktop"))+"\"+objSubfolder.Name
'WScript.Echo DDir+WshNet.UserName+"\"

objFSO.CopyFolder objFSO.GetFolder(SF("Desktop"))+"\"+objSubfolder.Name, folderToCheckFor+"/" 
objFSO.DeleteFolder objFSO.GetFolder(SF("Desktop"))+"\"+objSubfolder.Name 
Next 
 
'теперь перебираем все файлы которые находятся на рабочем столе, и если их тип не ярлык, 
'то сбрасываем атрибут на 0, копируем и убиваем. 
 
For Each efile in objFolder.Files 
Set gFILE = objFSO.GetFile (efile) 
fEXT = objFSO.GetExtensionName (efile.Path) 
If LCase (fEXT)<>"lnk" then 
gFILE.Attributes = 0 
objFSO.CopyFile efile, folderToCheckFor+"/" 
objFSO.DeleteFile efile 
End If 
Next

jbk 23-03-2015 19:59 2486600
есть конечно недочет... убиваются так же ярлыки интернета.... как бы их оставить?

Iska 24-03-2015 05:21 2486722
Если научитесь помимо тэга [spoiler] пользоваться тэгом [code] — подскажу ;).

Замените:
Скрытый текст
Код:
For Each efile in objFolder.Files
Set gFILE = objFSO.GetFile (efile)
fEXT = objFSO.GetExtensionName (efile.Path)
If LCase (fEXT)<>"lnk" then
gFILE.Attributes = 0
objFSO.CopyFile efile, folderToCheckFor+"/"
objFSO.DeleteFile efile
End If
Next

на:
Скрытый текст
Код:
For Each objFile In objFolder.Files
        Select Case LCase(objFile.Name)
                Case "lnk", "url"
                        ' Nothing to do
                Case Else
                        objFile.Attributes = 0
                        objFile.Copy folderToCheckFor & "\", True
                        objFile.Delete True
        End Select
Next

Не проверялось.

jbk 24-03-2015 09:19 2486773
ok, научусь)

представленный код не помог - убивает все, включая ярлыки.... и lnk, и url

Iska 24-03-2015 11:32 2486828
jbk, пока в Вашем коде будет тупо присутствовать первой строкой «On Error Resume Next» — и не такое будет убивать. А что на самом деле обязано присутствовать в первой строке — так это «Option Explicit».

jbk 24-03-2015 11:35 2486830
Iska, да код не мой, я вообще ничего не понимаю в программировании).... изменил как мог для себя...

On Error Resume Next в рабочем скрипте, я закомментил....

если добавлю Option Explicit
то тогда вообще не понимаю что и как делать.....

Iska 24-03-2015 16:56 2486972
jbk, пробуйте:
Скрытый текст
Код:
Option Explicit

Dim objFSO

Dim strDestFolder
Dim strUserNameDestFolder
Dim strSourceFolder
Dim strFullDestFolder

Dim objFolder
Dim objFile


strDestFolder = "\\server\Profiles$"

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

If objFSO.FolderExists(strDestFolder) Then
        strUserNameDestFolder = objFSO.BuildPath(strDestFolder, WScript.CreateObject("WScript.Network").UserName)
       
        If Not objFSO.FolderExists(strUserNameDestFolder) Then
                objFSO.CreateFolder strUserNameDestFolder
        End If
       
       
        strSourceFolder = WScript.CreateObject("WScript.Shell").SpecialFolders("MyDocuments")
        strFullDestFolder = objFSO.BuildPath(strUserNameDestFolder, objFSO.GetFileName(strSourceFolder))
       
        If Not objFSO.FolderExists(strFullDestFolder) Then
                objFSO.CreateFolder strFullDestFolder
        End If
       
        With objFSO.GetFolder(strSourceFolder)
                .Copy strFullDestFolder, True
        End With
       
       
        strSourceFolder = WScript.CreateObject("WScript.Shell").SpecialFolders("Desktop")
        strFullDestFolder = objFSO.BuildPath(strUserNameDestFolder, objFSO.GetFileName(strSourceFolder))
       
        If Not objFSO.FolderExists(strFullDestFolder) Then
                objFSO.CreateFolder strFullDestFolder
        End If
       
        With objFSO.GetFolder(strSourceFolder)
                .Copy strFullDestFolder, True
               
                For Each objFolder In .SubFolders
                        'WScript.Echo "[" & objFolder.Path & "]"
                        .Attributes = 0
                        .Delete True
                Next
               
                For Each objFile In .Files
                        Select Case LCase(objFSO.GetExtensionName(objFile.Name))
                                Case "lnk", "url"
                                        ' Nothing to do
                                Case Else
                                        With objFile
                                                'WScript.Echo objFile.Path
                                                .Attributes = 0
                                                .Delete True
                                        End With
                        End Select
                Next
        End With
Else
        WScript.Echo "Can't find destination folder [" & strDestFolder & "]."
        WScript.Quit 1
End If

Set objFSO = Nothing

WScript.Quit 0

Aelksey Kha 26-05-2016 16:43 2637863
Добрый день Iska.

У меня вопрос по скрипту, который вы опубликовали.

Я разместил данный скрипт в GPO при выходе пользователя из системы.
Все успешно переносится в папку на сервер, но не удаляется информация из папки мои документы и возникает окно с ошибкой 800a0046.

В чем может быть дело.

Так же на рабочем столе не сохраняются lnk, rdp и url. У некоторых пользователей полностью, у некоторых частично.

Еще почему то Windows 10 очень долго думает при выходе из системы и при перезагрузке с этим скриптом.

Помогите решить вопрос.

Заранее огромное спасибо.

Iska 26-05-2016 18:09 2637890
Цитата:
Цитата Aelksey Kha
У меня вопрос по скрипту, который вы опубликовали. »
По этому?

Цитата:
Цитата Aelksey Kha
Я разместил данный скрипт в GPO при выходе пользователя из системы. »
Без изменений (кроме пути, разумеется)?

Цитата:
Цитата Aelksey Kha
но не удаляется информация из папки мои документы и возникает окно с ошибкой 800a0046. »
Покажите скриншот окна ошибки («Alt-PrintScreen») или его содержимое («Ctrl-C»).

Цитата:
Цитата Aelksey Kha
Так же на рабочем столе не сохраняются lnk, rdp и url. У некоторых пользователей полностью, у некоторых частично. »
«.lnk» и «.url» в корне Рабочего стола не должны удаляться. Чтобы не удалялись также «.rdp», добавьте это расширение:
Код:
                                Case "lnk", "url", "rdp"
Цитата:
Цитата Aelksey Kha
Еще почему то Windows 10 очень долго думает при выходе из системы и при перезагрузке с этим скриптом. »
У меня нет Windows 10. «Думать» там особо нечему, кроме копирования. Если копирование занимает свыше 10 минут (по умолчанию; для Windows 8.1 и, надо думать, выше — появилось ещё такое: Logon scripts do not run for five minutes after a user logs on to a Windows 8.1-based computer, не знаю, зачем, не знаю, влияет ли и на LogOff) — работа скрипта, назначенного на Logoff пользователя будет прервана.

Aelksey Kha 26-05-2016 19:09 2637904
Вложений: 1
Iska, спасибо за ответ и размещенный скрипт, то что требовалось он делает, но только жаль что есть ошибки(

1) Да все верно, именно этот скрипт.
Огромное вам спасибо еще раз за размещение.

2) Я изменил путь к серверу соответственно.

3) После запуска скрипта выскакивает окно. Я во вложении разместил скрин.
Попытался подшаманить и убрал строку

[q=Iska]strSourceFolder = WScript.CreateObject("WScript.Shell").SpecialFolders("MyDocuments")
strFullDestFolder = objFSO.BuildPath(strUserNameDestFolder, objFSO.GetFileName(strSourceFolder))
If Not objFSO.FolderExists(strFullDestFolder) Then
objFSO.CreateFolder strFullDestFolder
End If
With objFSO.GetFolder(strSourceFolder)
.Copy strFullDestFolder, True
End With »[/q]

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

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

4) "rdp" в строчку я пробовал добавить, но безрезультатно, все тоже самое.

5) Windows 10 думает очень долго, но перезагружается или выходит из системы. На рабочем столе все очищается.
Пофиксить проблему я так понимаю не получится(

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

Aelksey Kha 27-05-2016 09:19 2638006
Добрый день Iska.

Вы мне поможете с выполнением сценария vbs?

Iska 29-06-2016 05:32 2646353
Цитата:
Цитата Aelksey Kha
3) После запуска скрипта выскакивает окно. Я во вложении разместил скрин. »
Ну, так там вроде бы явно написано, что «разрешение отклонено». Либо на доступ к какой-либо папке из «Моих документов» у пользователя не хватает прав, либо у него не хватает прав на создание подкаталогов и файлов в них на сервере. Я бы начал с проверки этого варианта (AccessEnum в помощь).

Цитата:
Цитата Aelksey Kha
Попытался подшаманить и убрал строку…
После удаления этой строки скрипт срабатывает, но не копирует и не удаляет файлы из документов пользователя.»
Только «не копирует». Удаление происходит ниже, и вовсе не в «Моих документах», а на «Рабочем столе».

Цитата:
Цитата Aelksey Kha
Копирует рабочий стол нормально и очищает тоже без этой строчки, но только вместе с файлами у пользователей удаляются lnk и rdp файлы тоже. »
«Эта строчка» относится только к «Моим документам». Обработка «Рабочего стола» происходит ниже.

Цитата:
Цитата Aelksey Kha
4) "rdp" в строчку я пробовал добавить, но безрезультатно, все тоже самое. »
«Не верю».


Время: 23:14.

Время: 23:14.
© OSzone.net 2001-