» Программирование "удобняшек" на VBScript (Часть 2)

Alex_Piggy
спасибо. буду дальше разбираться.

В связи с необходимостью минимизации набора ПЗ на компьютерах пришлось удалить Birthday millenium (напоминаловку дней рождений). Хочется заменить на скрипт, результатом работы которого будет некое окошко с инфой при старте компьютера - текущая дата, сегодня ДР у таких-то, завтра - у таких, послезавтра у таких. Если у кого УЖЕ есть хоть какой-то вариант решения - прошу поделиться.

Доброе время, laprad
Только написано. Все равно посмотрите - авось пригодится [more]
Код:
vDataFile = "D:\birthday.txt"

Set FSO = CreateObject("Scripting.FileSystemObject")
Set objTextStream=FSO.OpenTextFile(vDataFile,1,0)
Set vToday = CreateObject("Scripting.Dictionary")
Set vTomorrow = CreateObject("Scripting.Dictionary")
Set vAfterTomorrow = CreateObject("Scripting.Dictionary")
vText = Date & vbCrLf

Do Until objTextStream.AtEndOfStream
vStr=objTextStream.ReadLine
If Len(vStr)>12 Then
Select Case DateDiff("d", Date, DateValue(Left(vStr, 6) & Year(Now)))
Case "0" : vToday.Add Mid(vStr, 11), Year(Now) - Mid(vStr, 7, 4)
Case "1" : vTomorrow.Add Mid(vStr, 11), Year(Now) - Mid(vStr, 7, 4)
Case "2" : vAfterTomorrow.Add Mid(vStr, 11), Year(Now) - Mid(vStr, 7, 4)
End Select
End If
Loop
If Not vToday.Count=0 Then vText = vText & " Сегодня исполняется" & func_DictToStr (vToday)
If Not vTomorrow.Count=0 Then vText = vText & " Завтра исполнится" & func_DictToStr (vTomorrow)
If Not vAfterTomorrow.Count=0 Then vText = vText & " Послезавтра исполнится" & func_DictToStr (vAfterTomorrow)
MsgBox vText

Function func_DictToStr (Dict)
Arr = Dict.Keys
For i = LBound(Arr) To UBound(Arr) - 1
For j = i + 1 To UBound(Arr)
If Arr(i) > Arr(j) Then
Temp = Arr(j) : Arr(j) = Arr(i) : Arr(i) = Temp
End If
Next
Next
For Each Txt in Arr
func_DictToStr = func_DictToStr & vbCrLf & Dict.Item(Txt) & Txt
Next
func_DictToStr = func_DictToStr & vbCrLf & vbCrLf
End Function

Доброго времени суток!
Снова need help.
как можно проверить наличие запущенного приложения? Например, если запущен total commander - ничего не делать, если не запущен - послать комп в режим кибернации.
Буду признателен за совет.

Доброе время
Cryzer
Странно... Пожалуйста уточните, что Вам нужно. То, что написал - выведет отсортированный список по 10 шт. Как параметр принимает путь к папке.

Код:
If Wscript.Arguments.Count = 0 Then Wscript.Quit 1
Set objShellApp = CreateObject("Shell.Application")
Set objFolder = objShellApp.NameSpace(Wscript.Arguments.Item(0))
Set objItems = objFolder.Items
For i=0 to objItems.Count - 1
If ((i + 1) Mod 10 = 0) Then MsgBox vText : vText = "" End If
vText=vtext & vbCrLf & Mid (objItems.Item(i).Path,InStrRev(objItems.Item(i).Path,"\")+1)
Next
MsgBox vText

Alex_Piggy
То что надо. Спасибо!

Добрый день
Нужна Ваша помощь.
Суть такая в этой папке появляются файлы E:\00DOCUMENTS\Wi-fi в фотмате *JPG
Нужно чтоб при появлении в этой папке нового файла происходил фоновый запуст короткой мелодии "ПИМ-ПИМ"к примеру, можно из файла, Опрос папки на наличие новых файлов каждые 10-15 сек.
И можно ещё одну опцию чтоб его можно было выключать сам скрипт, просто прописать на убивание процесса.
Вот вообщем то и всё, Спасибо

Доброе время, TYMAH3003
Попробуйте. Первый запуск начинает наблюдение, второй - завершает.
Раз в cMainSleep с в папке cPath проверяется наличие новых файлов с расширением cExtension.
Хорошо было бы добавить запрос еще и группировку, но у меня не работает - & " GROUP WHITHIN " & cMainSleep
Звук проверить не могу - звуковая отвалилась. Должен проигрывать "%WinDir%\Media\tada.wav"
[more]

Код:
Const cMainSleep = 10
Const cPath = "E:\temp\33\"
Const cExtension = "jpg"

Set FSO = CreateObject("scripting.FileSystemObject")
Set oVoice = CreateObject("SAPI.SpVoice")
Set oSpFileStream = CreateObject("SAPI.SpFileStream")
Set WshShell = CreateObject("WScript.Shell")
Set objWMIService = GetObject("winmgmts:\\.\root\CIMv2")

Set colItems = GetObject("winmgmts:\\.\root\cimv2").ExecQuery ("Select * From Win32_Process Where CommandLine Like '%" & Replace(Wscript.ScriptFullName,"\","\\") & "%'")
If colItems.Count > 1 Then
MsgBox "Watch Finished " & cPath & "*." & cExtension
For Each Process in colItems
Process.Terminate
Next
End If

vDrive = Left(cPath,2)
vDir = Mid(cPath,3)
vSoundFile = WshShell.ExpandEnvironmentStrings("%WinDir%\Media\tada.wav")

Set objEvents = objWMIService.ExecNotificationQuery ("SELECT * FROM __InstanceCreationEvent WITHIN " & cMainSleep & "WHERE " & "TargetInstance ISA 'CIM_DataFile'" & " AND TargetInstance.Drive = '" & vDrive & "'" & " AND TargetInstance.Path = '" & replace(vDir,"\","\\") & "' AND TargetInstance.Extension = '" & cExtension & "'")
MsgBox "Watch begin " & cPath & "*." & cExtension    
Do While(True)
Set objReceivedEvent = objEvents.NextEvent
oSpFileStream.Open(vSoundFile)
oVoice.SpeakStream oSpFileStream
oSpFileStream.Close
Loop

Спасибо всё как нужно работает отлично СПАСИБО

Доброго времени суток. Снова нужна подсказка.
Есть маленький скрипт из 3-х строк

Код:
Set Wshshell=CreateObject("Word.Basic")
WshShell.sendkeys"{prtsc}"
set Wshshell = nothing
Wscript.Quit

Alex_Piggy выражаю признательность за очень полезный скрипт Ссылка (6 просто переименовывает, 7 оставляет прежнее имя + переименовывает... остальные варианты - история разработчика)

- переименование фотографий - при переименовании в названии указывается дата по EXIF, к названию идет в скобках следующее - Имя и Возраст например, человека, которые отсчитываются от заданной даты.

Получается примерно 2014-02-19 21-01-01 Я на руборде 8 лет 6 месяцев 10 дней.JPG

привет
есть страничка
например
http://www.myscore.ru/match/0Me3ayQk/#h2h;overall
надо перейти по линкам встреч и там из вкладки вытянуть статистику по угловым и карточкам и потом акуратно положить их в таблицу excel
наверно трудно но возможно?

Доброго времени суток. Необходим скрипт для поиска папки (допустим Mozilla) в профилях доменных юзеров и удаления ее содержимого .
С дальнейшим его запуском через планировщик.
Буду очень признателен, за помощь

nicka
маловероятно, страница сделано так, что данные вытянуть невозможно.

Здравствуйте, все!

Народ, может кто подскажет. Есть задача на паре десятков рабочих станций в домене со статическими IP-адресами изменить адрес шлюза. Вручную менять не хочется, поэтому хочу сделать все скриптом. В написании скрипта, как бы, вопросов нет, за исключением одного момента.

Метод SetGateways(arrDefaultGateways, arrGatewayCostMetrics) из класса Win32_NetworkAdapterConfiguration требует два параметра: адрес шлюза и метрику. А можно ли средствами VBS поменять только шлюз, а метрику явно не указывать, а принудительно задать режим "Автоматическое назначение метрики"?

Добрый день!

Подскажите как в скрипте определить имя установленного продукта Office или Windows?
есть такое:

strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery( _
"SELECT * FROM SoftwareLicensingProduct",,48)
For Each objItem in colItems
Wscript.Echo objItem.Name
Next

но выводит все имена присутствующие в "SoftwareLicensingProduct"
Office 15, OfficeProPlusR_Retail edition
Office 15, OfficeO365SmallBusPremR_SubTrial5 edition
Windows(R), ProfessionalWMC edition
Office 15, OfficeO365SmallBusPremR_Subscription2 edition
Office 15, OfficeO365ProPlusR_Retail edition
Office 15, OfficeO365ProPlusR_Subscription1 edition
Office 15, OfficeProPlusR_Grace edition
Office 15, OfficeO365SmallBusPremR_SubTrial2 edition
Office 15, OfficeO365ProPlusR_SubTrial2 edition
Office 15, OfficeO365SmallBusPremR_SubTrial3 edition
Office 15, OfficeO365ProPlusR_Grace edition
Office 15, OfficeProPlusMSDNR_Retail edition
Office 15, OfficeO365ProPlusR_SubTrial1 edition
Windows(R), OCUR add-on for all editions
Office 15, OfficeO365SmallBusPremR_Subscription4 edition
Windows(R), ProfessionalWMC edition
Office 15, OfficeO365SmallBusPremR_Subscription3 edition
Office 15, OfficeO365SmallBusPremR_SubTrial1 edition
Office 15, OfficeO365ProPlusR_Subscription4 edition
Office 15, OfficeO365SmallBusPremR_Retail edition
Windows(R), ProfessionalWMC edition
Windows(R), ProfessionalWMC edition
Office 15, OfficeProPlusDemoR_BypassTrial180 edition
Office 15, OfficeO365SmallBusPremR_Subscription5 edition
Windows(R), ProfessionalWMC edition
Office 15, OfficeO365SmallBusPremR_Grace edition
Office 15, OfficeO365ProPlusR_Subscription3 edition
Office 15, OfficeO365ProPlusR_SubTrial3 edition
Office 15, OfficeO365SmallBusPremR_Subscription1 edition
Office 15, OfficeProPlusR_OEM_Perp edition
Office 15, OfficeO365SmallBusPremR_SubTrial4 edition
Windows(R), ProfessionalWMC edition
Office 15, OfficeProPlusR_Trial edition
Office 15, OfficeO365ProPlusR_SubTrial5 edition
Office 15, OfficeO365ProPlusR_Subscription2 edition
Office 15, OfficeO365ProPlusR_SubTrial4 edition
Windows(R), APPXLOB-Client add-on for EmbeddedIndustry,EmbeddedIndustryA,Embedde
dIndustryE,EmbeddedIndustryEEval,EmbeddedIndustryEval,CoreARM,ProfessionalN,Prof
essional,ProfessionalWMC,EnterpriseN,EnterpriseNEval,Enterprise,EnterpriseEval
Windows(R), ProfessionalWMC edition
Office 15, OfficeO365ProPlusR_Subscription5 edition

как можно определить точно имя?

Добрый день.

Можно как-то установить обои рабочего стола для всех юзеров через vbs-скрипт? Желательно с растягиванием/уменьшением по разрешению.
Права администратора.

Доброе время
loban_ser
"Where" пробовали?
"SELECT * FROM SoftwareLicensingProduct Where Name='Office 15, OfficeProPlusMSDNR_Retail edition'"
Или что/какой результат нужно получить?

Engaged Clown
Попробуйте...
Описание на WallPaperStyle - MSDN WallPaperStyle

Код:
WallFileName = "C:\MyWallPaper.jpg"
WallFileStyle = 2
Set WshShell = CreateObject("WScript.Shell")
Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_UserAccount")
For Each objItem in colItems
WshShell.RegWrite "HKEY_USERS\"& objItem.SID & "\Control Panel\Desktop\wallpaper", WallFileName, "REG_SZ"
WshShell.RegWrite "HKEY_USERS\"& objItem.SID & "\Control Panel\Desktop\wallpaperstyle", WallFileStyle, "REG_DWORD"
Next

Alex_Piggy


Цитата:

какой результат нужно получить?

нужно узнать какой в ОС офис установлен, допустим вот:



в Windows 8.1 это определяется без труда даже в бат.
а вот в 8 и 7-ке в WMI (SoftwareLicensingProduct,OfficeSoftwareProtectionProduct) нет такого параметра ProductKeyChannel.
Вот я и подумал, может возможно как-то в VBS определить?

loban_ser
Попробуйте проверить статус лицензии или наличие ключа продукта (SoftwareLicensingProduct class)
"SELECT * FROM SoftwareLicensingProduct Where LicenseStatus=1"
или
"SELECT * FROM SoftwareLicensingProduct Where PartialProductKey>0"

PS. Батником - wmic path SoftwareLicensingProduct Where LicenseStatus=1 get Name

Alex_Piggy

Цитата:

"SELECT * FROM SoftwareLicensingProduct Where LicenseStatus=1"
или  
"SELECT * FROM SoftwareLicensingProduct Where PartialProductKey>0"

да по этим двум параметрам можно проверить имя, но как задать например конкретно для офис?

батником можно
wmic path SoftwareLicensingProduct Where LicenseStatus=1 get Name,Name | findstr Office
но только если лицензирован.

сюда бы что подставить: wmic path SoftwareLicensingProduct Where PartialProductKey=? get Name,Name | findstr Office
что определяло установленные продукты.

и, спасибо, что откликнулись.

loban_ser
Использовать оператор Like?
"Name Like '%Office%'" - "Имя содержит слово Office"
"SELECT * FROM SoftwareLicensingProduct Where LicenseStatus=1 And Name Like '%Office%'"


Цитата:

но только если лицензирован.

Прошу прощения, не понял это замечание.

Вы посмотрите какие параметры Вас устраивают в CSV файле :

wmic /output:SoftwareLicensingProduct.csv path SoftwareLicensingProduct get /format:csv

И при помощи Excel откройте SoftwareLicensingProduct.csv.
Просто у меня сейчас нет под руками установленного офиса.

Alex_Piggy
[more=>>>]ADActivationCsvlkPid=
ADActivationCsvlkSkuId=
ADActivationObjectDN=
ADActivationObjectName=
ApplicationID=0ff1ce15-a989-479d-af46-f275c6370663
AutomaticVMActivationHostDigitalPid2=
AutomaticVMActivationHostMachineName=
AutomaticVMActivationLastActivationTime=16010101000000.000000-000
Description=Office 15, RETAIL channel
DiscoveredKeyManagementServiceMachineIpAddress=
DiscoveredKeyManagementServiceMachineName=
DiscoveredKeyManagementServiceMachinePort=0
EvaluationEndDate=16010101000000.000000-000
ExtendedGrace=4294967295
GenuineStatus=1
GracePeriodRemaining=0
IAID=
ID=064383fa-1538-491c-859b-0ecab169a0ab
IsKeyManagementServiceMachine=0
KeyManagementServiceCurrentCount=4294967295
KeyManagementServiceFailedRequests=4294967295
KeyManagementServiceLicensedRequests=4294967295
KeyManagementServiceLookupDomain=
KeyManagementServiceMachine=
KeyManagementServiceNonGenuineGraceRequests=4294967295
KeyManagementServiceNotificationRequests=4294967295
KeyManagementServiceOOBGraceRequests=4294967295
KeyManagementServiceOOTGraceRequests=4294967295
KeyManagementServicePort=0
KeyManagementServiceProductKeyID=
KeyManagementServiceTotalRequests=4294967295
KeyManagementServiceUnlicensedRequests=4294967295
LicenseDependsOn=
LicenseFamily=OfficeProPlusR_Retail
LicenseIsAddon=FALSE
LicenseStatus=0
LicenseStatusReason=3221549076
MachineURL=
Name=Office 15, OfficeProPlusR_Retail edition
OfflineInstallationId=
PartialProductKey=
ProcessorURL=
ProductKeyChannel=
ProductKeyID=
ProductKeyID2=
ProductKeyURL=
RemainingAppReArmCount=1
RemainingSkuReArmCount=4294967295
RequiredClientCount=4294967295
TokenActivationAdditionalInfo=
TokenActivationCertificateThumbprint=
TokenActivationGrantNumber=4294967295
TokenActivationILID=
TokenActivationILVID=4294967295
TrustedTime=20140126145052.682000-000
UseLicenseURL=https://activation.sls.microsoft.com/SLActivateProduct/SLActivateProduct.asmx?configextension=o14
ValidationURL=http://go.microsoft.com/fwlink/?LinkID=187557
VLActivationInterval=120
VLActivationType=4294967295
VLActivationTypeEnabled=0
VLRenewalInterval=10080[/more]

интересуют Name и ID.

Вот вроде оно

strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery( _
"SELECT * FROM SoftwareLicensingProduct WHERE PartialProductKey>0 And Name Like '%Office%'",,48)
For Each objItem in colItems
Wscript.Echo objItem.Name
Next

только бы ещё изловчится с Project и Visio, чтоб отдельно?

Спасибо большое за помощь

Доброго времени суток. Нужна подсказка. В примерах на разных сайтах, в том числе и майкрософта, встречается оператор goto. Сколько сам не пытался реализовать - постоянно ошибка. Есть ли goto в vbs? если есть, то как реализовать?

msmih
.vbs только в таком виде
On Error GoTo 0
The On Error GoTo 0 statement is used to disable error handling.

Можно ли через vbs сбрасывать/устанавливать эту опцию для файлов и папок?

Пытался найти в Гугле, но безрезультатно. В стандартном скрипте такого не значится:
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.GetFile("C:\FSO\TestScript.vbs")
If objFile.Attributes = objFile.Attributes AND 1 Then
objFile.Attributes = objFile.Attributes XOR 1
End If

Name Value Description Read/Write attribute
Normal 0 Normal file Read/write
ReadOnly 1 Read-only file Read only
Hidden 2 Hidden file Read/write
System 4 System file Read/write
Volume 8 Disk drive volume label Read only
Directory 16 Folder or directory Read-only
Archive 32 File has changed since last backup Read/write
Alias 64 Link or shortcut Read-only
Compressed 2048 Compressed file Read-only

доброго всем читающим и помогающим.
Вопрос - есть строка длинной ХХХ символов. Ее надо преобразовать(виртуально разбить на подстроки) - путем вставки в каждую следующую позицию НН символа перенос строки + сдвиг каретки + пробел. Причем при очередном подсчете следующей позиции НН символа - нужно учитывать вставленный пробел - ибо он становится обязательным первым символом для следующей подстроки
Пример на начальной строке из 15 символов:

Код: dgk74gjje63830k

Доброе время
Astra55
Разве? "Archive 32 File has changed since last backup Read/write"
Устанавливать при помощи "objFile.Attributes=objFile.Attributes OR 32" снимать - "If objFile.Attributes AND 32 Then objFile.Attributes=objFile.Attributes XOR 32"

destiny_child

Прошу прощения, пропустил пробел... Секундочку...

UPDATE : (?:XXX) все-таки учавствует в выражении... Исправлено.

Код:
vStr = "dgk74gjje63830k" & vbCrLf & "dgk74gjje63830k" & vbCrLf & "dgk74gjje63830kdgk74gjje63830k"
MsgBox vStr
Set objRegEx = CreateObject("VBscript.regexp")
With objRegEx
.Global = True : .IgnoreCase = False : .MultiLine = False
End With
objRegEx.Pattern = "(\n|^)([^\r\n\t]{6})"
vStr = objRegEx.Replace(vStr,"$1$2" & vbCrLf & vbTab & " ")
objRegEx.Pattern = "(\n|^)(\t [^\r\n\t]{5})(?!\r\n)"
Do While objRegEx.Test(vStr)
vStr = objRegEx.Replace(vStr,"$1$2" & vbCrLf & vbTab & " ")
Loop
MsgBox vStr

Как при имитации нажатия клавиш в vbs файле написать круглую скобку?
Двойные кавычки так делаются
" & Chr(34) & "

oShell.SendKeys "" & Chr(34) & "слова в кавычках" & Chr(34) & ""

вот так не получается
" & Chr(40) & "

Доброе время, king_stiven
Спецсимол для группировки, указывается в фигурных скобках. Попробуйте эту строку :
oShell.SendKeys """{(}TEST{)}"""