Перейти из форума на сайт.

Новости • Файловые архивы
Поиск • Активные темы • Топ лист
Правила • Кто в on-line?
Вход • Забыли пароль? • Первый раз на этом сайте? • Регистрация
Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Программирование "удобняшек" на VBScript (Часть 2)

Модерирует : ShIvADeSt

 Версия для печати • Подписаться • Добавить в закладки
Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67

Открыть новую тему     Написать ответ в эту тему

ShIvADeSt



Moderator		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Вопросы, задачи и их решения по VBScript.

 
Мануал (english, 600 Кб). | Зеркало
MS Scripting 5.6 (700 КБ), включает последнюю версию VBS. Владельцам XP/2000(?) должен быть не нужен. | Зеркало
Немного на wikiпедии.
Предыдущие части: 1
 
Смежные темы:
Сценарии Windows
Командная строка, батники\сценарии (bat, cmd)
Скрипты KiXtart
Всего записей: 3956 | Зарегистр. 29-07-2003 | Отправлено: 04:12 12-07-2011 | Исправлено: Smitis, 23:28 26-02-2018
vadim100

Junior Member		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
ysybarite
 
проверил твой скрипт, всё он отрабатывает отлично.
попробуй в командной строке сделать  
ping google.com
 
возможно у тебя google не пингуется, поэтому скрипт не работает.
если это так поменяй переменную Const UrlPing = "google.com" на то что пингуется.
 
 
Добавлено:
IGNAT48
 
погуглил
http://itband.ru/2009/11/remote-execution/
Всего записей: 90 | Зарегистр. 02-04-2003 | Отправлено: 07:10 27-06-2013
IGNAT48

Newbie		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Все, разобрался, сделал скрипты и запустил на серваках....все работает, единственное добавляет только по 1 пользователю...
Всего записей: 2 | Зарегистр. 15-05-2011 | Отправлено: 14:23 28-06-2013
villa777



Silver Member		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
del
Всего записей: 2773 | Зарегистр. 22-06-2011 | Отправлено: 11:56 01-07-2013 | Исправлено: villa777, 18:19 08-07-2013
mapazzzm

Junior Member		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Знатоки, нужна помощь. У меня мозг кончился. Следующий скрипт прописан в гпо на выполнение при загрузке компьютера. То есть после входа в профиль пользователя он уже выполняется, но при этом от системной учетки. Итог - при выполнении условий успеха всплывающее сообщение не появляется. Что можно сделать? Запускать при входе пользователя не предлагать, потому что права у него не админские и скрипт выдает "Access is denied".
 
Set objWMIService = GetObject("winmgmts:" _
 & "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colProcessStopTrace = objWMIService.ExecNotificationQuery _
("SELECT * FROM Win32_ProcessStopTrace")
 
trigger = 0
Do While trigger = 0
  Set objLatestEvent = colProcessStopTrace.NextEvent
  If objLatestEvent.ProcessName = "setup.exe" Then
  MsgBox "Установка приложения успешно завершена!", 4160, "Проверка готовности установки приложения"
  trigger = 1
  End If
Loop
 
 
Пробовал использовать Popup - та же фигня.
 
Может быть есть какая-то другая возможность реализовать поиск по завершению нужного процесса без использования objWMIService, чтобы уже тогда встроить скрипт в запуск при входе пользователя?
Всего записей: 52 | Зарегистр. 27-02-2008 | Отправлено: 12:48 04-07-2013 | Исправлено: mapazzzm, 12:49 04-07-2013
toni3d



Newbie		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
кто знает можно ли при записи значений в реестр использовать кирилицу?
хочу - LDAPdisplayname = "Компания"
а в реестре получаются кракозябры
 
'-=-=-=-=-=-=-=-=-=-=-=-=-=-
'Written By James McWhinney
'Vancouver BC, Canada
'www.importfanatik.com
'April 26th, 2006
'-=-=-=-=-=-=-=-=-=-=-=-=-=-
 
const HKEY_CURRENT_USER = &H80000001
strComputer = "."
Set oReg=GetObject( "winmgmts:{impersonationLevel=impersonate}!\\" _
    & strComputer & "\root\default:StdRegProv")
RegistryFolder = "Software\Microsoft\Windows NT\" & _  
  "CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook\"
 
LDAPdisplayname = "test"
LDAPserver = "ldap.test.ca"
LDAPport = "389"
LDAPsearchbase = "o=test.ca"
 
 
'Add Ldap Type Key
sKeyPath = RegistryFolder & "e8cb48869c395445ade13e3c1c80d154\"
oReg.CreateKey HKEY_CURRENT_USER, sKeyPath  
oReg.SetBinaryValue HKEY_CURRENT_USER, _
     sKeyPath, "00033009", Array(0,0,0,0)
oReg.SetBinaryValue HKEY_CURRENT_USER, _
     sKeyPath, "00033e03", Array(&H23,0,0,0)
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , _
     "001e3001", "Microsoft LDAP Directory"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , _
     "001e3006", "Microsoft LDAP Directory"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , _
     "001e300a", "EMABLT.DLL"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , _
     "001e3d09", "EMABLT"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , _
     "001e3d13", "{6485D268-C2AC-11D1-AD3E-10A0C911C9C0}"
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, _
    "01023d0c", Array(&H5c,&Hb9,&H3b,&H24, _
    &Hff,&H71,&H07,&H41,&Hb7,&Hd8,_
    &H3b,&H9c,&Hb6,&H31,&H79,&H92)
 
'Add Ldap connection settings key
sKeyPath = RegistryFolder & "5cb93b24ff710741b7d83b9cb6317992\"
oReg.CreateKey HKEY_CURRENT_USER, sKeyPath
oReg.SetBinaryValue HKEY_CURRENT_USER, _
     sKeyPath, "00033009", Array(&H20,0,0,0)
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "000b6613", Array(0,0)
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "000b6615", Array(0,0)
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e3001", LDAPdisplayname
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e3d09", "EMABLT"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e3d0a", "BJABLR.DLL"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e3d0b", "ServiceEntry"
oReg.SetStringValue HKEY_CURRENT_USER, _
     sKeyPath , "001e3d13", "{6485D268-C2AC-11D1-AD3E-10A0C911C9C0}"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6600", LDAPserver
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6601", LDAPport
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6602", ""
oReg.SetStringValue HKEY_CURRENT_USER, _
     sKeyPath , "001e6603", LDAPsearchbase
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , _
     "001e6604", "(&(mail=*)(|(mail=%s*)" & _  
     "(|(cn=%s*)(|(sn=%s*)(givenName=%s*)))))"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6605", "SMTP"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6606", "mail"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6607", "60"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6608", "100"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6609", "120"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e660a", "15"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e660b", ""
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e660c", "OFF"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e660d", "OFF"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e660e", "NONE"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e660f", "OFF"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6610", "postalAddress"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6611", "cn"
oReg.SetStringValue HKEY_CURRENT_USER, sKeyPath , "001e6612", "1"
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "001e67f1", Array(&H0a)
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023615", _
     Array(&H50,&Ha7,&H0a,&H61,&H55,&Hde,_
     &Hd3,&H11,&H9d,&H60,&H00,_
     &Hc0,&H4f,&H4c,&H8e,&Hfa)
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023d01", _
     Array(&He8,&Hcb,&H48,&H86,&H9c,&H39,_
     &H54,&H45,&Had,&He1,&H3e,&H3c,_
     &H1c,&H80,&Hd1,&H54)
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01026631", _
     Array(&H98,&H17,&H82,&H92,&H5b,&H43,_
     &H03,&H4b,&H99,&H5d,&H5c,_
     &Hc6,&H74,&H88,&H7b,&H34)
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "101e3d0f", _
     Array(&H02,&H00,&H00,&H00,&H0c,&H00,_
     &H00,&H00,&H17,&H00,&H00,&H00,_
     &H45,&H4d,&H41,&H42,&H4c,&H54,_
     &H2e,&H44,&H4c,&H4c,&H00,&H42,_
     &H4a,&H41,&H42,&H4c,&H52,&H2e,_
     &H44,&Hc,&H4c,&H00)
 
'Append to Backup Key for ldap types
sKeyPath = RegistryFolder & "9207f3e0a3b11019908b08002b2a56c2\"
oReg.getBinaryValue HKEY_CURRENT_USER,sKeyPath, "01023d01",Backup
Dim oldLength
oldLength = UBound(Backup)
ReDim Preserve Backup(oldLength+16)
Backup(oldLength+1) = &He8
Backup(oldLength+2) = &Hcb
Backup(oldLength+3) = &H48
Backup(oldLength+4) = &H86
Backup(oldLength+5) = &H9c
Backup(oldLength+6) = &H39
Backup(oldLength+7) = &H54
Backup(oldLength+8) = &H45
Backup(oldLength+9) = &Had
Backup(oldLength+10) = &He1
Backup(oldLength+11) = &H3e
Backup(oldLength+12) = &H3c
Backup(oldLength+13) = &H1c
Backup(oldLength+14) = &H80
Backup(oldLength+15) = &Hd1
Backup(oldLength+16) = &H54
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023d01", Backup
 
 
'Append to Backup Key for ldap connection settings
sKeyPath = RegistryFolder & "9207f3e0a3b11019908b08002b2a56c2\"
oReg.getBinaryValue HKEY_CURRENT_USER,sKeyPath, "01023d0e",Backup
oldLength = UBound(Backup)
ReDim Preserve Backup(oldLength+16)
Backup(oldLength+1) = &H5c
Backup(oldLength+2) = &Hb9
Backup(oldLength+3) = &H3b
Backup(oldLength+4) = &H24
Backup(oldLength+5) = &Hff
Backup(oldLength+6) = &H71
Backup(oldLength+7) = &H07
Backup(oldLength+8) = &H41
Backup(oldLength+9) = &Hb7
Backup(oldLength+10) = &Hd8
Backup(oldLength+11) = &H3b
Backup(oldLength+12) = &H9c
Backup(oldLength+13) = &Hb6
Backup(oldLength+14) = &H31
Backup(oldLength+15) = &H79
Backup(oldLength+16) = &H92
oReg.SetBinaryValue HKEY_CURRENT_USER, sKeyPath, "01023d0e", Backup
 
 
'Delete Active Books List Key
sKeyPath = RegistryFolder & "9375CFF0413111d3B88A001" & _  
           "04B2A6676\{ED475419-B0D6-11D2-8C3B-00104B2A6676}"
oReg.DeleteKey HKEY_CURRENT_USER, sKeyPath
Всего записей: 30 | Зарегистр. 30-05-2008 | Отправлено: 14:54 04-07-2013
SerGap



Full Member		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Никто не может помочь переделать на паскаль unpack.vbs отсюда _http://operafan.net/forum/index.php?topic=20397.msg193677#msg193677
Всего записей: 541 | Зарегистр. 21-12-2008 | Отправлено: 21:50 17-07-2013
coherent

Silver Member		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Хочу в текстовом файле, содержащем несколько десятков строк, найти и заменить такую строку
StrOld = "<path recursive="1">PathOld\Content</path>"
на такую
StrNew = "<path recursive="1">PathNew\Content</path>
PathOld и PathNew - это конкретный путь к некоторой папке Content.
Как правильно задать маску для PathOld в StrOld?
 
добавлено
задачу решил без регэкспов, поскольку номер строки, в которой делается замена, известен.
В регэкспах не силен, поэтому было бы все же интересно узнать, чем заменить PathOld. Насколько понимаю, это любые символы. Пробовал подставлять (.*?), а замена через Replace, но не получилось.
Всего записей: 3883 | Зарегистр. 20-02-2007 | Отправлено: 15:15 18-07-2013 | Исправлено: coherent, 22:32 18-07-2013
pycukk



BANNED		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору

Цитата:
Небольшая утилита, добавляющая пункт Remove Empty Sub Folders («Удалить пустые подпапки») в контекстное меню проводника. Таким образом, выбрав папку, нажав на ней правой кнопкой и выбрав данный пункт меню, можно очистить ее от всех пустых вложенных папок.  
размер: 839 Кб  
http://leelusoft.blogspot.ru/2013/04/sub4del-10.html  
сборка для флешки (без мусора в инсталяторе): http://rghost.ru/46865382  

 
Предисловие и отказ от ответственности. Маленькая поделка, написанная мною, под впечатлением от оригинала, на VBScript. Можно использовать безвозмезно, в любых целях. В случае непредвиденных обстоятельств или любых видов убытков, автор претензии не принимает, вы используете это на свой риск.
 
Функционал. В отличии от оригинала представляет собой нешифрованный скрипт с открытым кодом, таким образом лишенный главного недостатка предка - невозможности самостоятельного улучшения. Встраивается в контекстное меню Проводника пунктом "Чистка папки..". Удаляет все вложенные пустые подпапки, в рекурсивном режиме. Степень вложенности ограничена только мощностями ПК. В отличии от оригинала, также удаляет некоторые типы мусорных файлов. *.bak; *.tmp; *.temp; *.$; *.-; а также содержащие символ “~” в имени или расширении. Перед началом выдает запрос на продолжение. По окончании выдает на экран отчет в виде списка удаленных файлов и папок, и освобожденное место в байтах. Деинсталлятор не предусмотрен, за что прошу больно не пинать. Полностью на русском.Вирусов нет!
 
Скачать.
http://rghost.ru/47418538

 
Вышла в свет новая версия Чистка папки (Clean Folder) 1.0.
Список изменений и дополнений:
+ Применен микро-инсталлятор ZipInstaller ( http://www.nirsoft.net/ ), благодаря чему размер установщика уменьшен со 179 Кб до 39 Кб., но при этом улучшена функциональность.
+ Допилена деинсталляция. Удалять программу теперь можно стандартными средствами.
+ Скрипт прописывается в меню не сразу после инсталляции, а только после запуска вручную.
+ Улучшен процесс сканирования, за счет введения безопасного режима сканирования защищенных папок (вроде "xerox" или "microsoft frontpage").
+ Откомментирован код.
+ Улучшен внешний вид отчета.
! Исправлен баг, когда в отчете не отражалось кол-во очищенных килобайт.  
! Много мелких изменений и улучшений.
 
Скачать (39 Кб.)
Всего записей: 196 | Зарегистр. 25-04-2011 | Отправлено: 21:44 19-07-2013
Paaxaan



Junior Member		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Приветствую!
Есть скрипт на удаление всех принтаков, которые установлены. НО он почему-то не срабатывает, выдает Access denied
Код: 80041003
Источник: SWbemObjectEx
 
Что не так???
вот сам скрипт:
 
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
 
Set colInstalledPrinters = objWMIService.ExecQuery _
("Select * from Win32_Printer")
 
For Each objPrinter in colInstalledPrinters
objPrinter.Delete_
Next
Всего записей: 199 | Зарегистр. 23-10-2004 | Отправлено: 12:36 19-08-2013
Snak2013

Newbie		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Доброго времени суток, написал скрипт на удаление файлов из папки по их разрешению, но он у меня не заработал с виду все правильно, но может быть, я что-то упустил.
 
Public objFSO
Folder = "c:\papka"
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
If objFSO.FolderExists(Folder) Then
        Call ClrFolder(Folder)
        WScript.Echo "Готово."
Else
        WScript.Echo "Не найден путь " & Folder
End If
WScript.Quit 0
 
Function ClrFolder(strFolder)
Dim objFolder, objFile
Set objFolder = objFSO.GetFolder(strFolder)
For Each objFile In objFolder.Files
        if LCase(objFSO.GetExtensionName(File)) = "jpg" or _
        LCase(objFSO.GetExtensionName(File)) = "xls" then
        objFile.Delete TRUE
 
end if
next
end Function
Всего записей: 1 | Зарегистр. 21-08-2013 | Отправлено: 10:07 21-08-2013
RomanoSadovnik

Junior Member		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Не могу понять в чём причина. Написал скрипт, имеющий такие строки:
Set IE = CreateObject("InternetExplorer.Application")
далее цикл, в цикле
if not IE.document.all.Item(String) is nothing then
...
 - под XP всё работает, под Win Server 2008 R2 вылетает с ошибкой в этой строке (WSH 5.8), ошибка 800A01A8 ("Требуется объект"). Может VBScript под WSH 5.8 имеет какие-то особенности синтаксиса?
 
Добавлено:
Всё, разобрался, но меня это ничуть не обрадовало. Действительно, разница диалектов. Под XP, если объект не найден, условие просто не выполняется и без проблем идём к следующей итерации цикла, и дальше всё находится и всё считается. Под R2, если объект не найден, система обнаружения ошибок кричит об этом на всю Ивановскую, и пофигу ей на все эти проверки и условия. Теперь вот ну ничего совершенно не приходит на ум, как же поставить реакцию на несуществование объекта...
Всего записей: 47 | Зарегистр. 23-10-2010 | Отправлено: 19:53 09-09-2013
Vladson1980



Member		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Ссылка на мануал умерла... Не подскажете где самую самую базу прочитать ? (математика там, побитовые операции если есть, строки, итд)
Всего записей: 275 | Зарегистр. 19-08-2009 | Отправлено: 17:49 28-09-2013
VicNes

Newbie		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Проблема с сохранением  
 
 
Set oIE = CreateObject("InternetExplorer.Application")
oIE.Navigate "http://...."
Do While oIE.Busy
Loop
oIE.ExecWB 4, 2, "param.txt"
 
Не хочет автоматически сохранять, вылетает диалоговое окно "Сохранить как..." с предложением сохранить файл param.txt и ждет нажатия кнопки Save.
Всего записей: 1 | Зарегистр. 05-12-2007 | Отправлено: 16:28 03-10-2013 | Исправлено: VicNes, 16:30 03-10-2013
Darktime



Junior Member		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Добрый день.
Понадобилось мне тут решить вопрос с массовым созданием пользователей в win server 2008 (без AD). По поиску смог найти скрипт на VBS:
 

Код:
 
Dim pwFile,compName,userName,userPw,strLine
Dim pwArray
Set objArgs = WScript.Arguments
 
If objArgs.Count < 2 Then
MsgBox "Usage: " & WScript.ScriptName & " pwfile mashinname"
WScript.Quit
End If
compName=objArgs(1)
pwFile=objArgs(0)
set objSystem = GetObject("WinNT://" & compName)
set objUser = objSystem.Create("user", WinUserAccountName)
Set oFS = CreateObject("Scripting.FileSystemObject")
Set oPws = oFS.OpenTextFile(pwFile)
'go through the password file
Do Until oPws.AtEndOfStream
On Error Resume Next
strLine=oPws.ReadLine
pwArray = Split(strLine," ",-1,1)
userName = pwArray(0)
userPw = pwArray(1)
set objUser = objSystem.Create("user", userName)
objUser.SetPassword userPw
objUser.SetInfo
Loop
 

 
Но при его использовании выпадает ошибка связанная с AD которого нет на сервере. Что в скрипте нужно убрать для устранения ошибки?
Ошибка:

Код:
 
---------------------------
Windows Script Host
---------------------------
Сценарий:    C:\CreateUser\CreateUser.vbs
Строка:    12
Символ:    1
Ошибка:    Был передан недопустимый путь службы каталогов
 
Код:    80005000
Источник:     Active Directory
 
---------------------------
ОК    
---------------------------
 
Всего записей: 87 | Зарегистр. 02-06-2010 | Отправлено: 10:21 08-10-2013
maK



Gold Member		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
132 примера сценариев на языке VBScript и Jscript - pdf
Всего записей: 5706 | Зарегистр. 19-12-2003 | Отправлено: 17:57 14-10-2013
Darktime



Junior Member		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
maK
Большое спасибо!
Всего записей: 87 | Зарегистр. 02-06-2010 | Отправлено: 10:46 15-10-2013
ponand

Junior Member		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Подскажите как с помощь vbs снять защиту с ячейки листа Excel
 
попробовал так
 

Код:
 
  Sheets.Cells(i,1).Locked = False
  Sheets.Cells(i,1).FormulaHidden = False
 

 
вылезла ошибка
 
Нельзя установить свойство Locked класса Range
Всего записей: 56 | Зарегистр. 14-07-2008 | Отправлено: 12:39 21-10-2013
sovadak



Junior Member		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Встал вопрос. Задача распространенная, но нуждаюсь в уточнении...  
Имею сервер 2003.  
На нем имею скрипт для удаления старых папок и файлов по дате, старше чем n-ое количество дней.  
Собственно он:

Код:
Option Explicit  
Dim FSO, Folder, subFolder
Dim strSource
Dim intErrLevel
   
    strSource   = "D:\FTP\Camera\Parking" 'папка содержащая каталоги для проверки
    intErrLevel = 0
 
    Set FSO = WScript.CreateObject("Scripting.FileSystemObject")      
 
    If FSO.FolderExists(strSource) Then
       Set Folder = FSO.GetFolder(strSource)
           For Each subFolder In Folder.subFolders
               if DateDiff("D", subFolder.DateLastModified, Now) > 2  Then 'количество дней, старше которых будет происходить удаление
                  subFolder.Delete  
               End If    
           Next
    Else
           WScript.Echo "папка " & strSource & " не найдена."  
           intErrLevel = 1
     End If  
     Set FSO = Nothing  
WScript.Quit intErrLevel

Хочу, чтобы скрипт смотрел не в одну папку, а в несколько. Скрипт этот удаляет записи с камер. Но камер несколько, поэтому и смотреть скрипт должен не в одну папку.  
Структура такая D:/Camera(папка всех камер)/Parking(камера)/дата(здесь создаются папки каждого дня записи) - вот их количество я и хочу контролировать.  
 
Вопрос наверное нубовский, этот скрипт я нашел в нете, лишь пояснения прописал для потомков =)  В программировании я не шарю, поэтому решил обратиться к знающим людям.  
Прошу сильно не пинать))
Всего записей: 111 | Зарегистр. 18-09-2009 | Отправлено: 13:25 21-10-2013
AndVGri

Advanced Member		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Так второй For Each, что-то вроде такого

Код:
 
Public Sub DeleteOldDateFolders()
    Const baseFolder = "D:\FTP\Camera\"
    Dim fso, camFolder, dateFolder
    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each camFolder In fso.GetFolder(baseFolder).SubFolders
        For Each dateFolder In camFolder.SubFolders
            If DateDiff("D", dateFolder.DateLastModified, Now) > 2 Then dateFolder.Delete
        Next
    Next
End Sub
 
Всего записей: 750 | Зарегистр. 14-12-2005 | Отправлено: 05:30 22-10-2013 | Исправлено: AndVGri, 05:31 22-10-2013
sovadak



Junior Member		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
AndVGriваш код вставлять в самый конец моего скрипта? Сори, но я не шарю. Можно подробнее?
Всего записей: 111 | Зарегистр. 18-09-2009 | Отправлено: 11:11 22-10-2013
Открыть новую тему     Написать ответ в эту тему

Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67

Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Программирование "удобняшек" на VBScript (Часть 2)


Реклама на форуме Ru.Board.

Powered by Ikonboard "v2.1.7b" © 2000 Ikonboard.com
Modified by Ru.B0ard
© Ru.B0ard 2000-2024

BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

Рейтинг.ru