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

LordHomyak
Да уже, скорее всего, более теоретический, на самом деле поразил тот факт, что вещь вроде как и элементарнейшая, а на практике невозможная =) В любом случае спасибо за советы!

zawakened

Я не случайно спросил про:
Цитата:

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

Если вы можете физически дописать в скрипт код переходника то будет,
так как в вашем посте на прошлой странице.
Код: wscript -e:vbs testscript.vbs test1

LordHomyak

Цитата:

Execute WScript.Arguments(0) WScript.Quit  

А вот это кстати очень просто и со вкусом Прямо благодарствую

Есть ли способ записи/удаления ключей реестра с помощью VBScript в защищенных ветках типа HKEY_LOCAL_MACHINE\SYSTEM, в частности, интересуют разделы ControlSet00x, CurrentControlSet. Если есть, подскажите, шибко нужно. Не для вирусов!

Astra55
Какой windows? xp и 7 в CurrentControlSet пишет точно также как и в другие ветки, под админом естественно.

Black_Lung
Win XP SP3. Желательно получить разрешения на запись/удаление под любой учеткой. Теперь про админов - нет, не пишет, зачем бы я спрашивал? Вопрос в том, какой это админ? Если дефолтный, то может и будет писать, я же не под ним работаю, требуется под созданной учеткой админа. Например, нужны запись/удаление в HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Enum\Root и HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services. Руками разрешение дается, само собой, но вопрос в скрипте, который это сделает.

Astra55
Возможно что-то в вашем компе специально убрало разрешение на запись

Задать разрешение для всех можно c помощью отдельной внешней программы subinacl

Код: subinacl /noverbose /subkeyreg HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Enum\Root /grant=Everyone

Astra55
Тут, скорее всего лучше копнуть в сторону утилиты SubInACL
Код: subinacl.exe /keyreg HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Shared Tools\Graphics Filters /grant="domain users"=f

Спасибо за столь любопытную инфу, отправляюсь ее переваривать. Потом отпишусь о результатах.

Помогите, пожалуйста, создать скрипт.
Нужно при старте системы задержать запуск программы на 10 секунд и при этом процесс должен быть не видим.

доброй ночи, Ustas007

для примера запуск блокнота [more=Код VBS]
Код: Const time_delay = 10 'sec
Const path_run = "C:\windows\notepad.exe"

WScript.Sleep time_delay * 1000

Set WSHShell = WScript.CreateObject("WScript.Shell")
    WSHShell.Run path_run, 0
Set WSHShell = Nothing

Реестр пока отложился, на первый план вышла такая задача:
----------------------
Function OnFirstParentExit
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists("C:\Documents and Settings\Admin\Application Data\Notepad\file.xxx") Then
fso.DeleteFile"C:\Documents and Settings\Admin\Application Data\Notepad\file.xxx", TRUE
End If
End Function
----------------------
Это скрипт удаления файла в виртуальном контейнере ThinApp, все работает, никаких проблем. Но мне нужно заменить абсолютный путь на относительный, а вот это не получается. Должно быть нечто вроде:
If fso.FileExists("%AppData%\Notepad\file.xxx")
Что нужно изменить, чтобы скрипт понял насчет относительного пути к файлу?

Добрый день, Astra55

Код:
Set WshShell = CreateObject("WScript.Shell")
FileName = WshShell.ExpandEnvironmentStrings("%AppData%\Notepad\file.xxx")
MsgBox FileName

Alex_Piggy
Можно весь скрипт с изменениями полностью? Что-то не получается, выдает ошибки.

Astra55
Странно... То, что ниже, сохранить как VBS.
Единственное что - и FSO и WshShell наверное лучше определять не в функции, а в начале программы как паблик (чтобы не пересоздавать для каждой функции).

Код:
Public fso, wshShell
Set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")

OnFirstParentExit

Function OnFirstParentExit
FileName = WshShell.ExpandEnvironmentStrings("%AppData%\Notepad\file.xxx")
If fso.FileExists(FileName) Then
fso.DeleteFile FileName, TRUE
End If
End Function

Alex_Piggy
Не работает. Ошибок не выдает, но и файл не удаляет. Вот проверка в реальных условиях:

Код: Function OnLastProcessExit
Set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
FileName = WshShell.ExpandEnvironmentStrings("%Local AppData%\Compare++\Compare++_2_0.ini")
If fso.FileExists(FileName) Then
fso.DeleteFile FileName, TRUE
End If
End Function

Astra55
Да, файл не удаляется. IMHO, лишний пробел в %Local AppData% - должно быть %LocalAppData%
Исправил, проверил (дописав первой строкой "OnLastProcessExit" ) - работает.
Код:
OnLastProcessExit
Function OnLastProcessExit
Set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
FileName = WshShell.ExpandEnvironmentStrings("%LocalAppData%\Compare++\Compare++_2_0.ini")
If fso.FileExists(FileName) Then
fso.DeleteFile FileName, TRUE
End If
End Function

Alex_Piggy
Пробел есть в имени папки виртуальной системы, имя изменить невозможно. Если есть ThinApp, то могу прислать в ПМ проект, чтобы мы долго и нудно не переписывались, если Вы можете разобраться за несколько минут у себя на компе.

Astra55
#
Увидел. Интересно. Wscript запрещен. Ищу. Временное решение #
Окончательный вариант

Код:
Function OnLastProcessExit
Set FSO = CreateObject("Scripting.FileSystemObject")
BasePath = GetEnvironmentVariable("TS_ORIGIN") : BasePath = Left(BasePath, len (BasePath) - 4) & "\"
FileName=BasePath & "%Local AppData%\Compare++\Compare++_2_0.ini"
If fso.FileExists(FileName) Then
fso.DeleteFile FileName, TRUE
End If
End Function

Alex_Piggy, я так понял нужна папка LocalAppData а не AppData
Можно попробовать получить путь через через NameSpace, проверял на thinapp 4.5 [more=Код VBS]
Код: Function OnLastProcessExit
set SAO = CreateObject("Shell.Application")
Set fso = CreateObject("Scripting.FileSystemObject")
FileName = SAO.NameSpace(&H1C).Self.path & "\Compare++\Compare++_2_0.ini"
If fso.FileExists(FileName) Then
    fso.DeleteFile FileName, TRUE
End If
End Function

Уважаемые знатоки!
Подскажите пожалуйста решение или костыли, если это вообще возможно.
В приложении .hta создал что-то типа массива элементов управления (во всяком случае они создаются и данные в них вносятся). Отрывок на VBS:

Код:                 Set oRow=dinamik.insertRow
                Set oCell = oRow.insertCell
                oCell.InnerHTML ="<input size='6' id=zajavs(" & i & ") type='text' value='" & zajav.value & "'>"

Извините за беспокойство, справился:

Код:             for i=0 to KolVo-1
                zajavsID="zajavs(" & i & ")"
                stampsID="stamps(" & i & ")"
                komplektsID="komplekts(" & i & ")"
                primsID="prims(" & i & ")"
                otherprimsID="otherprims(" & i & ")"
                tf.WriteLine(document.getElementById(zajavsID).value & ":" & document.getElementById(stampsID).value & ":" & document.getElementById(komplektsID).value & ":" & document.getElementById(primsID).value & ":" & document.getElementById(otherprimsID).value)
            Next

Знатоки, прошу, помогите чайнику. RTFM уже прошел, не смог разобраться.

Много лет выручал меня вот этот скрипт для бэкапа:

Код: Option Explicit
Dim objFSO

Set objFSO = CreateObject("Scripting.FileSystemObject")

On Error Resume Next
objFSO.CopyFolder "C:\EssentialPIM" , "F:\BACKUP\EssentialPIM" , TRUE
objFSO.CopyFolder "C:\EssentialPIM" , "F:\EPIMportable\Database" , TRUE
objFSO.CopyFolder "C:\EssentialPIM" , "D:\bu" , TRUE
If Err<>0 Then
MsgBox "Произошла ошибка: " & Err.Description,vbCritical
Else
MsgBox "Копирование завершено успешно",vbInformation
End If

[more] Доброго времени суток, всем!
Признаюсь честно, не знаком с написанием скриптов и пока не времени разбираться, поэтому хотел бы попросить о помощи. Есть скрипт, написан не мною, но задача полностью подходит под мою: позволяет задать определенное "Особое свойство" для группы файлов.

Код:

Код:
'VBS
Set objShellApp = CreateObject("Shell.Application") ' создаем объект оболочки
Set FSO = CreateObject("Scripting.FileSystemObject") ' создаем объект файловой системы
FileChangedCount = 0 ' Количество обработанных файлов

Main ' Поиск файлов

Sub Main '""""""""""""""""" Поиск файлов
On error Resume Next ' Если файлы открыты приложением, будут пропущены
Set OpenDialog = CreateObject("MSComDlg.CommonDialog") ' Microsoft Common Dialog Control
With OpenDialog
.DialogTitle = "Откройте нужный Вам файл(ы)"
.InitDir = "C:\"
.Filter = "Модели Solidworks (*.sldprt,*.sldasm)|*.sldprt;*.sldasm" ' Расширения файлов
.FilterIndex = 1
.Flags = 2621952
.MaxFileSize =32000
.ShowOpen
Filename = .Filename
End With

If (Len(OpenDialog.FileName)= 0) Then
msgbox "Файлы не выбраны!"
Exit Sub
End If

files = Split(OpenDialog.Filename, vbNullChar)
count_files = UBound(files)
If count_files > 0 Then
path = files(0) + "\" ' в ХР работает этот вариант path = files(0), в W7 почему то в окончании \ отсутствует
For i = 1 To count_files
PropertySearch path + files(i) ' Если выбрано несколько файлов
Next
Else
PropertySearch path + files(0) ' Если выбран один файл
End If
Msgbox "Выполнено." &chr(13)& "Количество обработанных файлов: "& FileChangedCount, vbInformation
End Sub

Sub PropertySearch (FilePath) '""""""""""""""""" поиск свойств файла
'msgbox "FilePath = " & FilePath
Set Cprop = CreateObject("DSOFile.OleDocumentProperties") ' создаем объект подключения к свойствам файла
Cprop.Open FilePath, false ' Открываем текущий файл
IsHere = "" ' Наличие свойства Раздел СП, если останется "" то нету
if Cprop.CustomProperties.count > 0 then ' Если у файла есть свойства
for iprop=0 to Cprop.CustomProperties.count-1 ' цикл по свойствам
if Cprop.CustomProperties.item(iprop).Name = "Раздел СП" then ' если Раздел СП есть
IsHere = 1 ' делаем отметку
Exit For
End if
Next
End if
If IsHere = "" then ' если Раздела СП нету
AddCustomProperty Cprop ' назначение свойств для файла
else
AddCustomPropertyEx Cprop, iprop ' если есть
End if
Cprop.close ' закрываем файл
End Sub

Sub AddCustomProperty(Cprop) '""""""""""""""""" назначение свойств для файла
key = "Раздел СП" ' Имя свойства
valueForKey = "Прочие изделия" ' Значение свойства
Cprop.CustomProperties.Add key, valueForKey ' Добавляем новое свойство с
Cprop.Save ' Сохранить изменения
FileChangedCount = FileChangedCount + 1 ' Инкрементация счетчика обработанных
End Sub

Sub AddCustomPropertyEx(Cprop,iprop) '""""""""""""""""" назначение свойств для файла
valueForKey = "Прочие изделия" ' Значение свойства
Cprop.CustomProperties.Item(iprop).value = valueForKey ' изменяем свойство
Cprop.Save ' Сохранить изменения
FileChangedCount = FileChangedCount + 1 ' Инкрементация счетчика обработанных
End Sub

'""""""""""""""""" Освобождаем память
Set objShellApp = Nothing
Set FSO = Nothing
Set Cprop = Nothing
Set OpenDialog = Nothing

Задача несколько усложнилась.. Вышеописанный скрипт запускается на компе сис.админа (Windows 7), но при этом не запускается на других двух компах, при этом на одном проверено в двух режимах пользователя (Администратор и Обычный пользователь), на другом же права администратора по умолчанию (других пользователей и нет).
Скрипт все так же выдаёт окно "Файлы не выбраны!", в то время как на компе сис.админа, как положено, открывается окно проводника с возможностью выбора файлов указанных расширений и далее в автоматическом режиме вносятся изменения в свойства этих файлов.

Цитата:

Скрипт все так же выдаёт окно "Файлы не выбраны!", в то время как на компе сис.админа, как положено, открывается окно проводника с возможностью выбора файлов указанных расширений и далее в автоматическом режиме вносятся изменения в свойства этих файлов.

Судя по описанию ты используешь MSComDlg и он у тебя не работает.
Эти ActiveX библиотеки надо регистрировать в системе, скопировав *.ocx в системный каталог и ввести команду с правами админа вроде на память
regsvr32.exe имя_файла(MSCOMCTL.OCX)

Из инета:
In a similar situation, the problem was solved by re-registering this file: “C:\WINDOWS\System32\MSCOMCTL.OCX”.
This totally saved me, THANKS! I thought the problem was related to my 64bit Windows 7 where files need to be in the SysWOW64 folder and registered via CMD as Administrator. This solved the problem for previous OCX files but not for my current problem. The registry file made ALL the difference and my old faithful APP was running again.

Добавлено:
velvetfox

Цитата:

Как переписать код, чтобы в F:\BACKUP\ каждый раз создавалась новая папка EssentialPIM
с прибавлением порядкового номера (EssentialPIM1, EssentialPIM2 и т.д.) и туда копировалось содержимое C:\EssentialPIM ? Всё остальное без изменений.

Я бы сделал как-то так

Const str = "F:\BACKUP\EssentialPIM"
Dim count
Dim strTargetDir

count=1

Do While objFSO.FolderExists(str & count)
count=count+1
Loop

strTargetDir=str & count

Используешь дальше strTargetDir

Вот с этого места, если можно по-подробнее..
Я просто откровенно чайник в программировании, но были мысли, что в теме автора скрипта идёт указание на лицензирование класса MSComDlg.CommonDialog . Но как конкретно его провести, я не шарю, даже погуглив в нэте.
Что значит регистрировать в системе? Этого не понял.. Сами файлы regsvr32.exe и MSCOMCTL.OCX в системе нашёл, но чё с ними делать.. Если можно, пошагово, что и где изменить в скрипте, что не в скрипте. Где именно, как, если вас не затруднит.
Извиняюсь за свою глупость в данном вопросе!

выполнить команду в cmd от админа в каталоге где лежит MSCOMCTL.OCX
regsvr32.exe MSCOMCTL.OCX
выдастся сообщение что компонент зарегистрирован.

в скрипте менять ничего не надо, просто должно всё заработать

Спасибо за помощь, но это не помогло..
А может и помогло, но только после того, как через regedit в директории HKEY_CLASSES_ROOT\Licenses\ добавил вот такие подразделы:
4D553650-6ABE-11cf-8ADB-00AA00C00905 со значением gfjmrfkfifkmkfffrlmmgmhmnlulkmfmqkqj

а также

78E1BDD1-9941-11cf-9756-00AA00C00908 со значением
yjrjvqkjlqqjnqkjvprqsjnjvkuknjpjtoun

В итоге всё заработало, как должно!

vadim100, благодарю за отзывчивость, а также mozers за запись http://forum.ru-board.com/topic.cgi?forum=33&topic=1491&start=124, а именно

Цитата:

Код:
REGEDIT4

[HKEY_CLASSES_ROOT\Licenses\4D553650-6ABE-11cf-8ADB-00AA00C00905]
@="gfjmrfkfifkmkfffrlmmgmhmnlulkmfmqkqj"

[HKEY_CLASSES_ROOT\Licenses\78E1BDD1-9941-11cf-9756-00AA00C00908]
@="yjrjvqkjlqqjnqkjvprqsjnjvkuknjpjtoun"

Цитата:

также mozers за запись

да уж спасибо mozers.
думал регистрация regsvr32 снимает все проблемы.
а там еще оказывается проблемы с лицензиями.

мда. описание проблемы на английском
http://www.tutorialsto.com/dotnet/control-and-components/with-regard-to-the-registration-and-license-control-solution-to-the-problem.html