Компьютерный форум NoWa.cc
Правила Форума
редакция от 29.01.2013
Портал .::2Baksa.Net::. Трекер BRODIM.COM Фильмы HD Онлайн Форум вебкам моделей
Вернуться   Компьютерный форум NoWa.cc > Операционные системы > Microsoft Windows > Windows 200x Server

Уважаемые пользователи nowa.cc и 2baksa.net. У нас сложилось тяжелое финансовое положение. Мы работаем для вас вот уже более 12 лет
и теперь вынуждены просить о помощи. Окажите посильную поддержку проектам. Мы очень надеемся на вас. Реквизиты для переводов ниже.
Webmoney Webmoney Z826074280762 Webmoney R087294265364 Webmoney U051530505194 Webmoney E804621616710
PayPal E-mail для связи / to Contact E-mail для связи по вопросу помощи / to Contact : E-mail для связи / to Contact
Кошелек для вашей помощи Yandex 410013204813773
Yandex Спасибо за поддержку!

Российский интернет-шлюз: контроль трафика, DLP, антивирус, fail2ban, прокси-сервер, шифрование данных, https-фильтрация. Сертификат ФСТЭК

загрузка...
Ответ
 
Опции темы Language
Старый 22.07.2015, 13:51   #16
Lyuker
Пользователь
 
Пол:Мужской
Регистрация: 18.02.2010
Сообщений: 36
Репутация: 3
По умолчанию Re: автоматическое удаление файла по истечению определенного времени

Цитата:
Сообщение от fmike Посмотреть сообщение
Dim fso

Function DelFiles(Folder)
'*** Функция удаляет все файлы в папке Folder старше N дней

N = 5
Set f = fso.GetFolder(Folder)

Set fc = f.Files
For Each f1 in fc
Set file = fso.GetFile(f1)
diff = DateDiff("d", file.DateCreated, date,0, 0)
If diff > N Then
file.delete
end if
Next

End Function

Function DelSubFolders(SubFolder)
'*** Функция перебирает подпапки в папке SubFolder,
'*** вызывает функцию удаления файлов и удаляет пустые подпапки

'Dim f, f1, fc, ff, ff1, fc1, file, diff

Set f = fso.GetFolder(SubFolder)
Set fc = f.SubFolders
For Each f1 in fc
Set ff = fso.GetFolder(f1)
DelFiles(ff)
DelSubFolders(ff)

if f1.size = 0 then
f1.delete
end if
Next

End Function

Set fso = CreateObject("Scripting.FileSystemObject")

Share = "D:\Common"

DelFiles(Share)
DelSubFolders(Share)

Когда я заменил Share = "D:\Common" на Share = "%USERPROFILE%\Мои документы\Downloads" получаю ошибку:

C:\Program Files\Support Tools>cscript "C:\Documents and Settings\olga\Рабочий с
тол\TMP\test_chrom_download.vbs"
Сервер сценариев Windows (Microsoft R) версия 5.7
c Корпорация Майкрософт (Microsoft Corp.), 1996-2001. Все права защищены.

C:\Documents and Settings\olga\Рабочий стол\TMP\test_chrom_download.vbs(7, 1) Ош
ибка выполнения Microsoft VBScript: Путь не найден


Папка C:\Documents and Settings\olga\Мои документы\Downloads есть.
Что-то не так с переменной среды %USERPROFILE%?

Понял, что проблема с русскими буковками в адресе. Надо переделывать скрипт, чтобы работал и на win xp, и на win vista/7/8/10.

Нашаманил такой код и вроде бы работает, как задумано:
Код:
Dim fso
Dim WshShell, OsVer

Function DelFiles(Folder)
'*** ”г­ЄжЁп г¤ «пҐв ўбҐ д ©«л ў Ї ЇЄҐ Folder бв аиҐ N ¤­Ґ©

N = 1
Set f = fso.GetFolder(Folder)

Set fc = f.Files
For Each f1 in fc
Set file = fso.GetFile(f1)
diff = DateDiff("d", file.DateCreated, date,0, 0)
If diff > N Then
file.delete
end if
Next

End Function

Function DelSubFolders(SubFolder)
'*** ”г­ЄжЁп ЇҐаҐЎЁа Ґв Ї®¤Ї ЇЄЁ ў Ї ЇЄҐ SubFolder,
'*** ўл§лў Ґв дг­ЄжЁо г¤ «Ґ­Ёп д ©«®ў Ё г¤ «пҐв ЇгбвлҐ Ї®¤Ї ЇЄЁ

'Dim f, f1, fc, ff, ff1, fc1, file, diff

Set f = fso.GetFolder(SubFolder)
Set fc = f.SubFolders
For Each f1 in fc
Set ff = fso.GetFolder(f1)
DelFiles(ff)
DelSubFolders(ff)

if f1.size = 0 then
f1.delete
end if	
Next
End Function

' dalee
' proverka nalichiya papki downloads, esli net popli, to vyhod iz skripta
' proverka operacionnoi sistemy, ot etogo zavisyat puti k papke downloads



Set WshShell = CreateObject("WScript.Shell")
OsVer = WshShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentVersion")
Set fso = CreateObject("Scripting.FileSystemObject")
Set WSHShell = WScript.CreateObject("WScript.Shell")
Set oShell = CreateObject("WScript.Shell")
If OsVer = "5.1" Then
	Share = WSHShell.SpecialFolders("MyDocuments")
	Share = Share & "\Downloads"
		If fso.FolderExists(Share) Then

		Else
			WScript.Quit
		End if 

Else
	strHomeFolder = oShell.ExpandEnvironmentStrings("%USERPROFILE%")
	Share = strHomeFolder & "\Downloads"
		If fso.FolderExists(Share) Then

		Else
			WScript.Quit
		End if 
End If

DelFiles(Share)
DelSubFolders(Share)
Для вин server2003 и для 2000/98/95 скорей всего не будет работать. На них не тестировал.

Последний раз редактировалось Lyuker; 10.08.2015 в 13:54.. Причина: обновил код, добавил новое условие
Lyuker вне форума
 
Ответить с цитированием Вверх
Надежный китайский посредник Taobao.com


Реклама: http://taxiru.ru/shashki-dlya-taxi-all/купить тумбу прикроватную белую в москве недорогоновая рига участки в поселкахматрас серта килиманджаро интерьер плазаselect brilliant super fifa


Ответ
 Уважаемые пользователи портала 2BakSa.NeT и форума NoWa.cc !

  Рады Вам сообщить, что у нас открылся Torrent трекер >> BRODIM.COM

  Приглашаем вас принять участие в обмене полезной информацией,

  и ждем от вас поддержки в создании новых раздач.

Опции темы

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
автоматическое включение компьютера galter Microsoft Windows 19 29.06.2011 00:40
Автоматическое поднятие VPN altarasyuk Скорая помощь 1 25.03.2009 13:26
Автоматическое вкл/выкл ПК elcorrason Скорая помощь 11 18.10.2008 13:14
Автоматическое переименование файла porokh Архив 1 23.10.2007 10:56

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход


Текущее время: 16:08. Часовой пояс GMT +3.


Rambler's Top100
Copyright ©2004 - 2018 2Baksa.Net

Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc. Перевод: zCarot
Время генерации страницы 0.11987 секунды с 10 запросами