» Программирование "удобняшек" на VBScript

Привет всем, не подскажите как сменить логон-скрипт у всех пользователей в домене именно скриптом????

YURETS777
Конечно реально.

Я тут озадачился запуском процессов в скрытом режиме, и накидал следующее:

Код: Const HIDDEN_WINDOW = 12

strComputer = "."
Set objWMIService = GetObject("winmgmts: {impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set objStartup = objWMIService.Get("Win32_ProcessStartup")

Set objConfig = objStartup.SpawnInstance_
objConfig.ShowWindow = HIDDEN_WINDOW
Set objProcess = GetObject("winmgmts:root\cimv2:Win32_Process")
errReturn = objProcess.Create("notepad.exe", null, objConfig, intProcessID)

Здравствуйте! Уважаемые, у меня к вам необычная прозьба:
Есть такой замечательный компонент: wodXMPP (интересует именно COM объект wodXMPP.dll)
В нём реализована работа с протоколом XMPP (Jabber)
С этого сайта можно скачать комплект (компонент, документация, примеры на разных языках)
Есть пример на VBS

Код: Option Explicit
Dim XMPP1
Set XMPP1 = WScript.CreateObject( "WeOnlyDo.wodXMPPCom.1", "wod_")

' please change these lines, from here
WScript.echo "Please edit this file to setup Login and Password properties"

XMPP1.Login = "somename@wippien.com"
XMPP1.Password = "password"
XMPP1.Blocking = True
'XMPP1.Register = True        ' register new account
XMPP1.Connect

'XMPP1.Contacts.Add("someone@wippien.com").Subscribe        ' you can add someone to your contact list...
XMPP1.SendText "someone@wippien.com", "Hello there!"

XMPP1.Disconnect

Sub wod_Disconnected()
WScript.Echo "Done and disconnected"
End Sub

Добрый день
Помогите со скриптом

есть папки вида

c:/../../../TEST/001
c:/../../../TEST/002
c:/../../../TEST/003

в которых
c:/../../../ - путь к папке специфической программы в MyDocuments. То есть, различается для XP и Vista/7 и неизвестно имя пользователя

TEST - известная часть пути
001 - название папок в TEST

в каждой из папок вида c:/../../../TEST/001 лежит файл с известным именем, Sample.txt

Задача: найти все такие файлы, то есть
c:/../../../TEST/001/Sample.txt
c:/../../../TEST/002/Sample.txt


и считать из него 1 и 3 строку, или к примеру первые 5 в какой-то общий файл.

У меня получилось сделать только частично - либо скопировать все ТХТ из нужной папки (только первой), либо скопировать нужные данные зная точный путь.

Скрипт будет запускаться на другой машине, так что нет возможности вписать точный путь в скрипт.

Буду благодарен за помощь, сам новичек

MoonGod
Цитата:

путь к папке специфической программы в MyDocuments. То есть, различается для XP и Vista/7 и неизвестно имя пользователя

Чего специфичного то? Есть системная переменная возвращающая папку пользователя %HOMEPATH%.
http://www.windowsfaq.ru/content/view/263/

Цитата:

Чего специфичного то? Есть системная переменная возвращающая папку пользователя %HOMEPATH%.
http://www.windowsfaq.ru/content/view/263/

спасибо, думаю USERPROFILE будет лучше + попрыгаю еще от Win32_OperatingSystem чтоб определить какая винда и сделать правильный путь

Сделал нужный мне скрипт, возник следующий вопрос - при выполнении скрипта постоянно пищит биппер (обнаружил после тестирование на другом компе). Есть ли возможность его отключить через скрипт?

С неособым трудом нашел скрипт удаляющий старые файлы в поддиректориях, но для полного удобства не хватает одной функции - не трогать файлы, если их количество менее 5-ти в одной папке. Если Вам не трудно, поправьте скрипт ибо Я и VBS полный нюб... Только начинаю bat осваивать.



Код:
path = "D:\Backup"

killdate = date() - 30

arFiles = Array()
set fso = createobject("scripting.filesystemobject")

' True - для поиска и по поддиректориям тоже, False - только в самой директории
SelectFiles path, killdate, arFiles, true

nDeleted = 0
for n = 0 to ubound(arFiles)
on error resume next 'in case of 'in use' files...
arFiles(n).delete true
if err.number <> 0 then
else
nDeleted = nDeleted + 1
end if
on error goto 0
next

sub SelectFiles(sPath,vKillDate,arFilesToKill,bIncludeSubFolders)
on error resume next
set folder = fso.getfolder(sPath)
set files = folder.files

for each file in files
dtlastmodified = null
on error resume Next
dtlastmodified = file.datelastmodified
on error goto 0
if not isnull(dtlastmodified) Then
if dtlastmodified < vKillDate then
count = ubound(arFilesToKill) + 1
redim preserve arFilesToKill(count)
set arFilesToKill(count) = file
end if
end if
next

if bIncludeSubFolders then
for each fldr in folder.subfolders
SelectFiles fldr.path,vKillDate,arFilesToKill,true
next
end if
end sub

vivasem

Код: path = "D:\Backup"

killdate = date() - 30

arFiles = Array()
set fso = createobject("scripting.filesystemobject")

' True - для поиска и по поддиректориям тоже, False - только в самой директории
SelectFiles path, killdate, arFiles, true

nDeleted = 0
for n = 0 to ubound(arFiles)
on error resume next 'in case of 'in use' files...
arFiles(n).delete true
if err.number <> 0 then
else
nDeleted = nDeleted + 1
end if
on error goto 0
next

sub SelectFiles(sPath,vKillDate,arFilesToKill,bIncludeSubFolders)
on error resume next
set folder = fso.getfolder(sPath)
set files = folder.files

if files.count > 4 then
for each file in files
dtlastmodified = null
on error resume Next
dtlastmodified = file.datelastmodified
on error goto 0
if not isnull(dtlastmodified) Then
if dtlastmodified < vKillDate then
count = ubound(arFilesToKill) + 1
redim preserve arFilesToKill(count)
set arFilesToKill(count) = file
end if
end if
next
end if

if bIncludeSubFolders then
for each fldr in folder.subfolders
SelectFiles fldr.path,vKillDate,arFilesToKill,true
next
end if
end sub

Rush
Спасибо огромное!!! Вот наконец закончил собирать пакет скриптов для автоматизации резевного копирования. Если кому нужно, это ТУТ

Господа, плз, помогите новичку.
Есть вот такой скрипт создающий подпись в Outlook:


Код:
On Error Resume Next
Set objSysInfo = CreateObject("ADSystemInfo")

strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)

strRegard = "С уважением,"
'Получаем полное имя
strName = objUser.FullName
'Должность
strTitle = objUser.Title
'Подразделение
'strDepartment = objUser.Department
'Компания
strCompany = objUser.Company
'Номер телефона
strPhone = objUser.telephoneNumber
'Сотовый
strMobile = objUser.mobile
'Факс
strFax = objuser.facsimileTelephoneNumber
'IP-телефон, у себя не использую, так как внутренний номер дописываю в поле основного телефона
strIntPhone = objuser.ipPhone
'Получаем почтовый индекс
strPostIndex = ObjUser.postalCode
'Город
strCity = objuser.l
'Улица
strStreet = objuser.streetAddress
'адрес электронной почты
strEmail = objuser.mail
'WEB страница
strWeb = objuser.wWWHomePage
'Логотип организации
'strLogo = "\\domain.corp\NETLOGON\company-logo.gif"



Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries

'Задаем настройки шрифта
'Шрифт
objSelection.Font.Name = "Arial"
'Размер
objSelection.Font.Size = "10"
'Цвет, можно указывать в десятичном или RGB формате, тогда: RGB(0, 55, 110)
objSelection.Font.Color = RGB(0,0,0)
'Формат
objSelection.ParagraphFormat.Space1

objSelection.TypeText strRegard
objSelection.TypeText CHR(11)
'Вставляем полное имя
objSelection.Font.bold=true
objSelection.TypeText strName
objSelection.TypeText CHR(11)
objSelection.Font.bold=false
'Должность
objSelection.TypeText strTitle
objSelection.TypeText CHR(11)
'Подразделение
'objSelection.TypeText strDepartment
'objSelection.TypeText CHR(11)
'Компанию
objSelection.TypeText strCompany
objSelection.TypeText CHR(11)
'Уменьшаем размер шрифта для адреса
'objSelection.Font.Size = "9"
'Почтовый адрес
'objSelection.TypeText strPostIndex & ", г. " & strCity & ", " & strStreet
'objSelection.TypeText CHR(11)
'Телефон
objSelection.TypeText "Тел.: " & strPhone & " доб." & strIntPhone
objSelection.TypeText CHR(11)
'Сотовый
'objSelection.TypeText "Моб. " & strMobile
'objSelection.TypeText CHR(11)
'Факс
objSelection.TypeText "Факс: " & strFax
objSelection.TypeText CHR(11)
'Вставляем адрес почты
objSelection.TypeText "mail to: "
'Изменяем цвет для адреса электронной почты и сайта
objselection.font.color = RGB(0, 0, 255)
Set hyp = objSelection.Hyperlinks.Add(objSelection.Range, "mailto: " & strEmail, , , strEmail)
hyp.Range.Font.Size = "10"
hyp.Range.Font.Name = "Arial"
objSelection.TypeText CHR(11)
'корпоративный сайт
Set hyp = objSelection.Hyperlinks.Add(objSelection.Range, strWeb, "", "", strWeb)
hyp.Range.Font.Size = "10"
hyp.Range.Font.Name = "Arial"
'objSelection.Hyperlinks.Add objSelection.Range, strWeb, "", "", strWeb
'objSelection.TypeText CHR(11)
'логотип компании
'objSelection.InlineShapes.AddPicture(strLogo)

Set objSelection = objDoc.Range()

objSignatureEntries.Add "Company Signature", objSelection
objSignatureObject.NewMessageSignature = "Company Signature"
objSignatureObject.ReplyMessageSignature = "Company Signature"

objDoc.Saved = True
objDoc.Close
objWord.Quit

Ребят, Кто знает как автоматизировать процесс смены буквы флешки через diskmgmt.msc через батник? суть такая, втыкаю флэшку, выполняется авторун, авторун выполняет батник, а батник должен сменить букву флешки на ту, которую мне нужно..

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

Всем привет.
Начал тут VB изучать. Застопорился на таком моменте.
Есть переменная "NameComp" Если прописываю прямо


Код: Dim NameComp
NameComp = "тут руками пишу имя компа"

Scaramanga

Код:
Dim NameComp, WshShell
Set WshShell = CreateObject("WScript.Shell")
NameComp = WshShell.ExpandEnvironmentStrings("%ComputerName%")

Огромное спасибо

Доброго времени суток!
Есть код:

Код: On Error Resume Next

Dim Args, WshShell, BtnCode, strText, strTitle, nSecondsToWait, nType

Set Args=WScript.Arguments
Set WshShell=WScript.CreateObject("WScript.Shell")

If Args.Count<4 Or Args.Count>5 Then WScript.Quit(255)
strText=Args(0)
strTitle=Args(1)
If Args.Count=5 Then nSecondsToWait=Args(4) Else nSecondsToWait=0

nType=0
Select Case UCase( Left(Args(2), 1) )
case "W" nType=16
case "Q" nType=32
case "E" nType=48
case "I" nType=64
End Select

Select Case UCase( Args(3) )
case "OK" nType=nType+0
case "OKCANCEL" nType=nType+1
case "ABORTRETRYIGNORE" nType=nType+2
case "YESNOCANCEL" nType=nType+3
case "YESNO" nType=nType+4
case "RETRYCANCEL" nType=nType+5
End Select

WScript.Quit( WshShell.Popup(strText, nSecondsToWait, strTitle, nType) )

Free_Soft

Код: "" & Chr(10) & "Blah-blah-blah"

ComradG
Т.е. Это не в код вставлять а в строку синтаксиса?

Free_Soft
Тебе же нужно строки разбивать, так ведь? Вот, допустим у тебя есть строка: "Never trust a pinguin, dude!" Нужно, чтобы "pinguin, dude!" оказалось на следующей строке. Тогда пишешь:

Код: "Never trust" & Chr(10) & "a pinguin, dude!"

нет, в сообщении. А чтобы пустую строку вставить просто пробел в кавычках набить?

Free_Soft
Ага.

ComradG
Пасиб.

Добавлено:
а можно как то выделять кнопки по умолчанию?

Free_Soft
Наверное можно, ведь это ж по сути перманентный Бэйсик. Как, если честно, не знаю, не сталкивался с оным. Но можно попробовать потыкать в сторону свойств элементов формы, например, IsDefault или чего-то в этом роде. А чтобы не гадать на кофейной гуще, лучше заглянуть на msdn (описание VBSсript'а)

ComradG
сейчас попробовал
Код: "Never trust" & Chr(10) & "a pinguin, dude!"

Всем привет.
Есть код создает zip архив и добавляет в него нужный файл

Код: Set FileSytemObject = CreateObject("Scripting.FileSystemObject")
SourceFilePath = "c:\eventlogs.csv"
DestFilePath = "c:\EventLogs.zip"
Set Zip = New ZipClass
Zip.CreateArchive DestFilePath
Zip.CopyFileToArchive SourceFilePath
Zip.CloseArchive

MsgBox "Архив создан на рабочем столе", vbInformation, "Операция завершена"

Class ZipClass
Private Shell
Private FileSystemObject
Private ArchiveFolder
Private ItemsCount

Private Sub Class_Initialize()
Set Shell = CreateObject("Shell.Application")
Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
End Sub

Function CreateArchive(ZipArchivePath)
If UCase(FileSystemObject.GetExtensionName(ZipArchivePath)) <> "ZIP" Then
Exit Function
End If

Dim ZipFileHeader
ZipFileHeader = "PK" & Chr(5) & Chr(6) & String(18, 0)
FileSystemObject.OpenTextFile(ZipArchivePath, 2, True).Write ZipFileHeader
Set ArchiveFolder = Shell.NameSpace(ZipArchivePath)
If Not (ArchiveFolder is Nothing) Then CreateArchive = True
End Function

Function CopyFileToArchive(FilePath)
If (ArchiveFolder Is Nothing) Then Exit Function
ArchiveFolder.CopyHere FilePath
ItemsCount = ItemsCount + 1
End Function

Function CopyFolderToArchive(FolderPath)
If (ArchiveFolder Is Nothing) Then Exit Function
ArchiveFolder.CopyHere FolderPath
ItemsCount = ItemsCount + 1
End Function

Function CloseArchive
If (ArchiveFolder is Nothing) Then Exit Function
Set WsriptShell = CreateObject("Wscript.Shell")
If IsObject(Wscript) Then
Do
Wscript.Sleep 100
Loop Until ArchiveFolder.Items.Count => ItemsCount
Else
ServerSleep
End if
ItemsCount = 0
End Function

Private Function ServerSleep
Set WsriptShell = CreateObject("Wscript.Shell")
Do
WsriptShell.Popup "", 1, ""
Loop Until ArchiveFolder.Items.Count => ItemsCount
End Function

Function MoveFileToArchive(FilePath)
If (ArchiveFolder is Nothing) Then Exit Function
ArchiveFolder.MoveHere FilePath
End Function
End Class

Free_Soft
Сейчас посмотрю...
Scaramanga
Вроде все правильно Хотя может я чего пропустил, но вполне возможно, что в сценарии попадаются переменные с одними и теми же именами. Лучше, чтоб не искать иглу в стоге сена, разбей сценарий на несколько, и напиши к ним ланчуру: во-первых, легче искать ошибки, во-вторых, можно оперативно вносить исправления.

Free_Soft
Накидал пример с мессадж-боксом, все работает, проверил трижды.

Код: strSoundFile = "C:\windows\Media\Notify.wav"
Set objShell = CreateObject("Wscript.Shell")
strCommand = "sndrec32 /play /close " & chr(34) & strSoundFile & chr(34)
objShell.Run strCommand, 0, False
Wscript.Sleep 500
MsgBox "It's just playing soud..." & Chr(10) & "And you what thought about?"

Цитата:

и напиши к ним ланчуру

Для меня это пока темный лес)

Цитата:

что в сценарии попадаются переменные с одними и теми же именами

В куске архивирования файла только одна переменная ZipFileHeader, в коде больше она нигде не втстречается, а без куска архивирования, скрипт отрабатывает полностью и без ошибок

Scaramanga

Цитата:

Для меня это пока темный лес)

Хм, а что тут сложного?! Если скрипт планируется запускать через консоль, то можно навалять батник в качестве ланчуры.

Цитата:

В куске архивирования файла только одна переменная

Да, я уже заметил, так что пересматриваю твой сценарий заново. Найду ошибку свистну. А если нет, то ушел на боковую )

Scaramanga
Плохо, когда все делается копипастом, без понимания.
Уж не буду говорить, что там много лишнего, объекты инициализируются по нескольку раз и т.п. - черт с ним.
Но все таки элементарное понятие надо иметь.
Если стоит параметр Option Explicit, то надо все переменные объявлять. А у тебя необъявленных целая куча.
Ну и поскольку стоит On Error Resume Next - обошибках тебе ничего не говорится и тихо завершает работу, не сделав нужное.
Припиши к скрипту

Код: Dim SourceFilePath, DestFilePath, Zip, WsriptShell, strMailBody, FileSytemObject