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

Друзья, нужна помощь! Стоит задача: есть процесс ipmgui.exe, который запускается с некоторой периодичностью, скажем раз в 2-3 часа, и который, когда он запустится надо остановить. Я написал такой скрипт, который запускается при старте системы:

Код: Dim colProcessList, objProcess, ProcessName, ProcessIsRunning

ProcessName = "ipmgui.exe"
ProcessIsRunning = False

Do
Do while not ProcessIsRunning
Set colProcessList = Getobject("Winmgmts:").Execquery _
("Select * from Win32_Process Where Name ='" & ProcessName & "'")
If colProcessList.Count > 0 Then
ProcessIsRunning = True
End If
Set colProcessList = Nothing
Loop

Set colProcessList = GetObject("Winmgmts:").ExecQuery _
("Select * from Win32_Process Where Name ='" & ProcessName & "'")
For Each objProcess in colProcessList
objProcess.Terminate( )
Next
Set colProcessList = Nothing
Loop

Может кто помочь в этом Ссылка написал там думал это можно через батник сделать, но вроде это через батник нельзя

Скрипт vbs работает, если запускаю мышкой, если его запускает другая программа (sfx или инсталлятор) - не работает

Здравствуйте!
При запуске файла myscript.vbs в диспетчере задач появляется процесс wscript.exe.
Подскажите, пожалуйста, каким образом средствами VBS можно сделать так, чтобы при запуске VBScript в диспетчере задач появлялся процесс с именем этого файла, а не wscript.exe?

Никак т.к. *.vbs это не процесс.

скомпилировать программу.

Laserje18
Можно с помощью программ типа vbs2exe преобразовать твой скрипт в самостоятельную программу

VadimLou
slime555
idiMAN

Да я думал как-нибудь так:

Код: Set FSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
n = "myscript.vbs"
n1 = "C:\Windows\System32\"&Replace(n,".vbs","")&".exe"
FSO.CopyFile "C:\Windows\System32\wscript.exe", n1
WshShell.Run n1 n
FSO.DeleteFile n1

Всем доброго дня! Нужен скриптик, который бы следил за процессом ragent.exe и если тот падает делал "net start "1C:Enterprise 8.3 Server Agent""

Всем доброго здоровья!
Вынужден запросить подмоги у вас из соседней ветки http://forum.ru-board.com/topic.cgi?forum=5&topic=26082&start=1420 которая 3 месяца мёртвая. Работа с nnCron, который поддерживает и VBScript. Имеется следующее:



В главном окне "Main" при отсутствии соединения открывается дочернее окно "Ошибка". Нужно сделать так, чтоб при появлении окна "Ошибка" срабатывал батник на выполнение команды.
Пытаюсь делать по документации www.nncron.ru/help/help_ru.htm , как описано в примере

Код:
\ после слова 'WIN-EXIST:' переменная 'WIN-HWND'
\ установлена должным образом
WIN-EXIST: "xxx"
IF
FOR-CHILD-WINDOWS: "yyy"
\ ... выполняем работу с дочерними окнами
;FOR-CHILD-WINDOWS
THEN

\ при каждом цикле 'FOR-WINDOWS:' переменная
\ 'WIN-HWND' содержит window handle текущего окна
FOR-WINDOWS: "xxx"
\ ... выполняем работу
FOR-CHILD-WINDOWS: "yyy"
\ ... выполняем работу с дочерними окнами
;FOR-CHILD-WINDOWS
;FOR-WINDOWS

sundraw
по описанию: вместо xxx вставляете верхний заголовок "Main"
потом в цикле поиска дочерних окон, вместо yyy "Ошибка"

Tilks
Сделал следующее:

Код:
WatchWinCreate: "*Main"
Action:
WIN-EXIST: "*Main"
IF
FOR-CHILD-WINDOWS: "Ошибка"
;FOR-CHILD-WINDOWS
THEN
FOR-WINDOWS: "*Main"
FOR-CHILD-WINDOWS: "Ошибка"
START-APP: C:\Windows\NewIP.bat
;FOR-CHILD-WINDOWS
;FOR-WINDOWS

sundraw
в личку ответил, тут оффтоп.

Ребят, помогите советом, пожалуйста.
Есть скрипт, который мне помогали дописать здесь vadim100 и Tilks. Вот его код.

Код:
'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

Parazitif
удалите или закомментируйте строку On error Resume Next , тогда будет видно ошибки.
вообще то уже было, или это очередной виток истории.

Цитата:

после чего зарегистрировал через cmd:

всякий мусор зарегистрировали, а где нужный comdlg32.ocx

Tilks
У вас хорошая память) Со скриптами всё хорошо, их редактировать не надо. Дело было в нужном comdlg32.ocx. Спасибо огромное, всё заработало!

Доброе время, Laserje18
Самый примитивный способ - через Left.

Код:
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder("test")
Set WshShell = CreateObject("WScript.Shell")
For Each File In Folder.Files
if Left(File.Name,4)="tty-" Then MsgBox File.Name
Next

Люди добрые помогите пожалуйста, есть задача:
нужно создать средствами vbs ярлык на рабочем столе текущего пользователя (который запускает скрипт) к гугл хрому уже установленному на компьютере с параметром преехода на корпоративный сайт, сложность в том что гугл хром может быть установлен в разных местах, профиле пользователя, програмных файлах с разной разрядностью ос...

пробовал так... но что то не получается...

Код:
Set WshShell = WScript.CreateObject("WScript.Shell")
strDesktop = WshShell.SpecialFolders("Desktop")
DIM fso
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists("%userprofile%\Local Settings\Application Data\Google\Chrome\Application\chrome.exe")) Then
Set oShellLink = WshShell.CreateShortcut(strDesktop + "\Яндекс.lnk")
oShellLink.TargetPath = "%userprofile%\Local Settings\Application Data\Google\Chrome\Application\chrome.exe"
oShellLink.WindowStyle = 3
oShellLink.IconLocation = "%userprofile%\Local Settings\Application Data\Google\Chrome\Application\chrome.exe, 0"
oShellLink.Description = "Яндекс"
oShellLink.WorkingDirectory = "%userprofile%\Local Settings\Application Data\Google\Chrome\Application"
oShellLink.Arguments = "http://www.ya.ru/"
oShellLink.Save
Else
If (fso.FileExists("%programfiles%\Google\Chrome\Application\chrome.exe")) Then
Set oShellLink = WshShell.CreateShortcut(strDesktop + "\Яндекс.lnk")
oShellLink.TargetPath = "%programfiles%\Google\Chrome\Application\chrome.exe"
oShellLink.WindowStyle = 3
oShellLink.IconLocation = "%programfiles%\Google\Chrome\Application\chrome.exe, 0"
oShellLink.Description = "Яндекс"
oShellLink.WorkingDirectory = "%programfiles%\Google\Chrome\Application"
oShellLink.Arguments = "http://www.ya.ru/"
oShellLink.Save
Else
If (fso.FileExists("%programfiles%\Google\Chrome\Application\chrome.exe")) Then
Set oShellLink = WshShell.CreateShortcut(strDesktop + "\Яндекс.lnk")
oShellLink.TargetPath = "%programfiles%\Google\Chrome\Application\chrome.exe"
oShellLink.WindowStyle = 3
oShellLink.IconLocation = "%programfiles(x86)%\Google\Chrome\Application\chrome.exe, 0"
oShellLink.Description = "Яндекс"
oShellLink.WorkingDirectory = "%programfiles(x86)%\Google\Chrome\Application"
oShellLink.Arguments = "http://www.ya.ru/"
oShellLink.Save
Else
End If
End If
End If
WScript.Quit()

PavelSES

Не получается из-за наличия в параметре FileExist пути с переменными окружения.
Их нужно перед этим раскрыть например функцией ExpandEnvironmentStrings.

Если гугл хром установлен, то должна быть отметка в AppPath, попробуйте [more=так]

Код: linkName = "Yandex.lnk"
siteName = "http://www.ya.ru/"
description = "Яндекс"

appName = "chrome.exe"
msgNotExist = "Google Chrome не найден"

Set WshShell = WScript.CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")

If Not existApp(appName, path, folder) Then
MsgBox msgNotExist, vbInformation
WScript.Quit()
End If

vbMaximizedFocus = 3
pathLink = WshShell.SpecialFolders("Desktop") & "\" & linkName

With WshShell.CreateShortcut(pathLink)
.TargetPath = path
.WindowStyle = vbMaximizedFocus
.IconLocation = path
.Description = description
.WorkingDirectory = folder
.Arguments = siteName
.Save
End With

Function existApp(appName, path, folder)
    strAppPath = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\"
On Error Resume Next
path = WshShell.RegRead(strAppPath & appName & "\")
folder = WshShell.RegRead(strAppPath & appName & "\" & "path")

'****** REMOVE **********************************************
MsgBox "path: """ + path & """" & vbNewLine & _
     "folder: """ & folder & """" & vbNewLine & _
     "Exist: " & FSO.FileExists(path)
'****** REMOVE **********************************************

existApp = FSO.FileExists(path) And err.Number = 0
On Error Goto 0

End Function

LordHomyak
Спасибо за помощь, но не срвсем верно получается, дело в том что ключ реестра "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\" существует если гугл хром установлен от администртатора через установщик для всех пользователей. Но часто юзер сам ставит себе хром при отсутствии админ прав, тогда этот ключ находится по адресу "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\". Тоесть нужно сначала проверять есть ли ключ реестра у юзера и брать значение оттуда а если у юзера нет то из общей HKEY_LOCAL_MACHINE.

Спасибо за ранее.

PavelSES
Это был всего лишь пример, для юзер\локал скрипт будет выглядеть [more=так]
Код: linkName = "Yandex.lnk"
siteName = "http://www.ya.ru/"
description = "Яндекс"

appName = "chrome.exe"
msgNotExist = "Google Chrome не найден"

Set WshShell = WScript.CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")

If existApp(appName, path, folder, "HKEY_CURRENT_USER" ) Then
ElseIf existApp(appName, path, folder, "HKEY_LOCAL_MACHINE") Then
Else
MsgBox msgNotExist, vbInformation
WScript.Quit()
End If

vbMaximizedFocus = 3
pathLink = WshShell.SpecialFolders("Desktop") & "\" & linkName

With WshShell.CreateShortcut(pathLink)
.TargetPath = path
.WindowStyle = vbMaximizedFocus
.IconLocation = path
.Description = description
.WorkingDirectory = folder
.Arguments = siteName
.Save
End With

Function existApp(appName, path, folder, root)
strAppPath = root & "\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\"
On Error Resume Next
path = WshShell.RegRead(strAppPath & appName & "\")
folder = WshShell.RegRead(strAppPath & appName & "\" & "path")

'****** REMOVE **********************************************
MsgBox "path: """ + path & """" & vbNewLine & _
"folder: """ & folder & """" & vbNewLine & _
"Exist: " & FSO.FileExists(path)
'****** REMOVE **********************************************

existApp = FSO.FileExists(path) And err.Number = 0
On Error Goto 0

End Function

Буду признателен за помощь.
Набросал скрипт для автоматической авторизации и входа на сайт.
захожу и перехожу по ссылкам с помощью .Navigate
все работает.
Но уже с авторизованной страницы необходимо перейти по ссылке методом post. как это сделать?

Доброе время, msmih
1 Вариант - попробовать передать POST в URL (не помню, как это правильно называется)
ie.navigate2 "http://forum.ru-board.com/misc.cgi?action=dologin&inmembername=LOGIN&inpassword=PASSWORD"
Не всегда отрабатывает
2 Вариант - Логин на на Ру-Борде при помощи POST

Код:
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible=True
vPost="action=dologin&inmembername=LOGIN&inpassword=PASSWORD"
ie.navigate2 "http://forum.ru-board.com/misc.cgi",1,"_top",Stream_StringToBinary(vPost,"us-ascii")

Function Stream_StringToBinary(Text, CharSet)
Const adTypeText = 2
Const adTypeBinary = 1
Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Type = adTypeText
If Len(CharSet) > 0 Then BinaryStream.CharSet = CharSet Else BinaryStream.CharSet = "us-ascii"
BinaryStream.Open
BinaryStream.WriteText Text
BinaryStream.Position = 0: BinaryStream.Type = adTypeBinary : BinaryStream.Position = 0
Stream_StringToBinary = BinaryStream.Read
End Function

Может есть готовое решение удаления первой строки в txt?

Добавлено:
Почему ругается?


Код: ' Извлекаю путь данного vbs
Set FSO = CreateObject("Scripting.FileSystemObject")
Set F = FSO.GetFile(Wscript.ScriptFullName)
path = FSO.GetParentFolderName(F)

' Массив строк csv
FileName = path+"\01.data.csv"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set F = FSO.OpenTextFile(FileName, 1)
ReDim ArrayString(0)
i = 0
While Not F.AtEndOfStream
ReDim Preserve ArrayString(i)
ArrayString(i) = F.ReadLine
i = i + 1
WEnd
F.Close

' Удаление 01.data.csv
FileName = path+"\01.data.csv"
SET File=fso.GetFile(FileName)
File.Delete

' Создание 01.data.csv без первой строки
FileName = path+"\01.data.csv"
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
Set File = FSO.CreateTextFile(FileName)
    k = 1
    While k<i
        File.WriteLine(ArrayString(k))
        k = k+1
    WEnd
File.Close

' Запись первой строки в 03.good.txt
FileName = path+"\03.good.csv"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set File = fso.GetFile(FileName)
    Set tf = File.OpenAsTextStream(ForWriting, True)
        tf.WriteLine(ArrayString(0))
    tf.Close

Spy686

Цитата:

Почему ругается?

Видимо ругается на константу ForWriting. Её, как и некоторых других в vb-скрипте нет.

Если нужно перенести только первую строку из одного файла в другой
то можно обойтись без построчного чтения файла

Вы не указали что делать, если файл не существует или пуст, поэтому код без проверок [more]

Код: Set FSO = CreateObject( "Scripting.FileSystemObject" )
pathScript = FSO.GetParentFolderName( WScript.ScriptFullName )

fileName = pathScript & "\01.data.csv"
fileNameGood = pathScript & "\03.good.csv"

fileTmp = fileName & "~~$.tmp"

ForReading = 1
ForWriting = 2
ForAppending = 8

Set hFileInp = FSO.OpenTextFile( fileName, ForReading )
Set hFileTmp = FSO.OpenTextFile( fileTmp, ForWriting, True )
Set hFileGood = FSO.OpenTextFile( fileNameGood, ForWriting, True ) ' ForAppending для добавления строки

hFileGood.WriteLine( hFileInp.ReadLine )
hFileTmp.Write( hFileInp.ReadAll )

hFileInp.Close
hFileTmp.Close
hFileGood.Close

FSO.GetFile( fileName ).Delete True
FSO.MoveFile fileTmp, fileName

он каждый раз записывает только одну строку. надо дописывать в 03.good.csv.

Spy686
Сейчас он делает то, что ваш скрипт выше, то есть перезаписывает файл 03.good.csv.
Именно для этого в скрипте есть комментарий что нужно изменить.

Код: Set hFileGood = FSO.OpenTextFile( fileNameGood, ForWriting, True )

Приветствую.
Есть скрипт для быстрой навигации на странице вверх-обратно:
Код: javascript:(function(d,scrT){scrT=d.documentElement.scrollTop||d.body.scrollTop;if(scrT){localStorage['bmk_'+d.location.href]=scrT;scrollTo(0,0)}else{scrollTo(0,localStorage['bmk_'+d.location.href]||0)}})(document)

Цитата:

Spy686

Цитата:
Почему ругается?

Видимо ругается на константу ForWriting. Её, как и некоторых других в vb-скрипте нет.
 
Если нужно перенести только первую строку из одного файла в другой
то можно обойтись без построчного чтения файла  
 
Вы не указали что делать, если файл не существует или пуст, поэтому код без проверок Подробнее...
Батником покороче получится.

Может можно с этим чтото сделать?

Ссылка

Доброго времени суток.

Spy686
В файле перемещаемая строка была единственной.

Финальный вариант, если ошибки доступа к файлам выводить не нужно,
то удалить строку "MsgBox errMsg, vbCritical" [more]
Код: Set FSO = CreateObject("Scripting.FileSystemObject")
pathScript = FSO.GetParentFolderName( WScript.ScriptFullName )

fileName = pathScript & "\01.data.csv"
fileNameGood = pathScript & "\03.good.csv"

ForReading = 1
ForWriting = 2
ForAppending = 8

strBuffer = ""

On Error Resume Next

Set hFileInp = FSO.OpenTextFile( fileName, ForReading)
WScriptQuitIfError "Нет доступа или """ & fileName & """ не существует"

If hFileInp.AtEndOfStream Then
hFileInp.Close
WScript.Quit
End If

With FSO.OpenTextFile( fileNameGood, ForAppending, True )
.WriteLine( hFileInp.ReadLine )
.Close
End With
WScriptQuitIfError "Нет прав на запись в файл """ & fileNameGood & """"

If Not hFileInp.AtEndOfStream Then _
strBuffer = hFileInp.ReadAll

hFileInp.Close

With FSO.OpenTextFile( fileName, ForWriting)
.Write( strBuffer )
.Close
End With
WScriptQuitIfError "Нет прав на запись в файл """ & fileName & """"

Function WScriptQuitIfError(errMsg)
If Err.Number Then
MsgBox errMsg, vbCritical
WScript.Quit
End If
End Function