Форум на Исходниках.RU

Полезные скрипты

Radikson — Tue, 28 Apr 2020 20:27:35 +0000

Radikson: Просто если использовать тег VB вместо VB Script код становится намного читабельней.

Полезные скрипты

Dan-K — Wed, 09 May 2012 13:32:03 +0000

Dan-K: Нашел в самом начале топика скрипт от B.V. - Вывод на экран списка всех запущенных на локальной рабочей станции процессов

Я сам работаю в VBA, и вышеуказанный скрипт очень пригодился для активации окна соседнего приложения и открытия файла Excel - именно в соседнем приложении.
Приведу немного переделанный и подогнанный код для VBA

Option Explicit

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _

(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _

ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Public PID_OPEN_FILE_1

Public strFullFileName$

Sub АКТИВИРУЕМ_ОКНО_СОСЕДНЕГО_ПРИЛОЖЕНИЯ_EXCEL_И_ОТКРЫВАЕМ_ФАЙЛ_В_НЕМ()

Dim WMI

Dim Process

Dim SQuery

Dim WShell '

Dim Processes 'Коллекция процессов

Dim Ret

Dim PID

'On Error Resume Next

strFullFileName = "C:.xls"

' //Соединяемся с WMI

If PID_OPEN_FILE_1 = Empty Then

MsgBox "попыток открытия файла с помощью данного макроса еще небыло"

Else

MsgBox "файл уже открывали"

End If

Set WShell = CreateObject("Wscript.Shell")

Set WMI = GetObject("winMgmts:")

PID = GetCurrentProcessId

'Формируем текст запроса

SQuery = "SELECT * FROM Win32_Process WHERE Name<>'EXPLORER.EXE'"

'Создаем коллекцию-результат запроса

Set Processes = WMI.ExecQuery(SQuery)

'Цикл по всем элементам коллекции

For Each Process In Processes

Ret = False

If Process.Caption Like "EXCEL.EXE" And Process.processid <> PID Then

Select Case PID_OPEN_FILE_1

Case Empty

'''для контроля записываем id-процесса, в котором открыли файл.

'''при последующем открытии файла будем перебирать все id-процесса - пока не найдем нужный

PID_OPEN_FILE_1 = Process.processid

Ret = WShell.AppActivate(Process.processid)

If Ret = True Then Ret = ShellExecute(0, "open", strFullFileName, 0, vbNullString, 5)

Case Process.processid

Ret = WShell.AppActivate(Process.processid)

If Ret = True Then Ret = ShellExecute(0, "open", strFullFileName, 0, vbNullString, 5)

End Select

End If

Set WMI = Nothing

Set WShell = Nothing

End Sub

Но встала задача: перебрать все открытые приложения Excel и получить полные имена всех открытых файлов.

Как это можно сделать через скрипт?

Полезные скрипты

Dmitrii — Sun, 31 Jul 2011 19:47:43 +0000

Dmitrii: Функция для VB-сценария, позволяющая очищать DACL подкаталогов заданного каталога от не олицетворённых DACL-записей, сохраняя при этом настройки, унаследованные от "родителя".
Дополнительные возможности функции:
- поддержка работы как в графическом, так и в консольном режимах;
- поддержка рекурсивного просмотра подкаталогов;
- ведение журнала работы;
- поддержка работы в "молчаливом" режиме.

Описание параметров.

objWMIServ - входной, обязательный, подтип Object.
Смысловая нагрузка - ссылка на WMI-пространство того компьютера, на томе которого (локальном или сетевом) расположено обрабатываемое дерево подкаталогов.
Допустимое значение: ссылка на пространство CIMV2, полученная с помощью моникера.

objDir - входной, обязательный, подтип Object.
Смысловая нагрузка - ссылка на каталог, содержащий обрабатываемое дерево подкаталогов.
Допустимое значение: любая корректная ссылка на объект типа FOLDER (модель FSO) локального или удалённого компьютера.
При работе с каталогом удалённого компьютера предполагается, что ссылка формируется с использованием административного ресурса для соответствующего логического тома.

objLog - входной, обязательный, подтип Object.
Смысловая нагрузка - ссылка на текстовый файл, представляющий собой журнал работы функции, а также индикатор необходимости ведения такого журнала.
Допустимые значения:
любая корректная ссылка на открытый для записи объект типа TEXTSTREAM (модель FSO) локального компьютера (журнал ведётся);
Nothing (журнал не ведётся).

blnRec - входной, обязательный, подтип Boolean.
Смысловая нагрузка - логический индикатор режима рекурсивного просмотра обрабатываемого дерева подкаталогов.
Допустимые значения:
TRUE - выполнять рекурсивный просмотр;
FALSE - не выполнять рекурсивный просмотр.

blnCon - входной, обязательный, подтип Boolean.
Смысловая нагрузка - логический индикатор режима выполнения сценария (в составе которого задействована функция), определяющий возможность вывода на экран текущих диагностических сообщений функции.
Допустимые значения:
TRUE - консольный режим, вывод сообщений возможен;
FALSE - графический режим, вывод сообщений невозможен .

blnSil - входной, обязательный, подтип Boolean.
Смысловая нагрузка - логический индикатор режима отображения на экране текущих диагностических сообщений функции.
Допустимые значения:
TRUE - "молчаливый" режим;
FALSE - режим отображения сообщений.
При работе в "молчаливом" режиме не выводятся никакие сообщения, кроме сообщений о ситуациях, приводящих к аварийному завершению работы функции. Данный режим никак не влияет на процедуру ведения журнала.

Возвращаемое значение у функции отсутствует.

Function Clear_DACL(objWMIServ, objDir, objLog, blnRec, blnCon, blnSil)

Dim objItem, objSecSettings, objSD, objACE, arrACE, strSID

Dim strPath, strTemp, blnHasInherited, blnHasError, blnIsFound, intRes, i

Const SE_DACL_PROTECTED = 4096 'Флаг-признак отключенного режима наследования управляемым каталогом

'безопасности NTFS от "родителя"

Const INHERITED_ACE = 16 'Флаг-признак того, что текущая запись DACL унаследована от "родителя"

On Error Resume Next

For Each objItem In objDir.SubFolders

blnHasError = False: blnIsFound = False: strSID = vbNullString

strPath = objItem.Path

If Err.Number = 0 Then

strTemp = strTemp & UCase(strPath) & vbNewLine

i = InStr(strPath, "$")

If i > 0 Then

strPath = Replace(Mid(strPath, i - 1), "$", ":")

End If

Set objSecSettings = objWMIServ.Get("Win32_LogicalFileSecuritySetting.Path='" & strPath & "'")

If Err.Number = 0 Then

If objSecSettings.GetSecurityDescriptor(objSD) = 0 Then

If Err.Number = 0 Then

intRes = 0

If Not IsNull(objSD.DACL) Then

For Each objACE In objSD.DACL

If IsNull(objACE.Trustee.Name) Then

blnIsFound = True

Exit For

End If

If blnIsFound Then

If CBool(objSD.ControlFlags And SE_DACL_PROTECTED) Then

arrACE = objSD.DACL

Else

blnHasInherited = True

arrACE = Array()

i = -1

'--- Выборка из исходного DACL записей, не унаследованных от "родителя"

For Each objACE In objSD.DACL

If CBool(objACE.AceFlags And INHERITED_ACE) Then

If IsNull(objACE.Trustee.Name) Then

blnHasError = True

strTemp = strTemp & objACE.Trustee.SIDString & _

" -> запись унаследована от ""родителя""." & vbNewLine

End If

Else

i = i + 1

ReDim Preserve arrACE(i)

Set arrACE(i) = objACE

End If

'------

'--- Отключение наследования настроек безопасности от "родителя"

objSD.ControlFlags = objSD.ControlFlags + SE_DACL_PROTECTED

intResult = objSecSettings.SetSecurityDescriptor(objSD)

'------

End If

If intRes = 0 Then

'--- Поиск в DACL записей, у свойства Trustee.Name которых отсутствует значение

For Each objACE In arrACE

If IsNull(objACE.Trustee.Name) Then

objACE.AccessMask = 0 'назначение нулевой маски для последующего автоудаления записи

strSID = strSID & objACE.Trustee.SIDString & " -> запись удалена." & vbNewLine

End If

'------

Set objACE = Nothing

objSD.DACL = arrACE 'собственно изменение DACL

Erase arrACE

'--- Включение наследования настроек безопасности от "родителя",

'если первоначально оно было включено

If blnHasInherited Then

objSD.ControlFlags = objSD.ControlFlags - SE_DACL_PROTECTED

End If

'------

'--- Итоговое сохраненение изменений, внесённых в дескриптор безопасности

intRes = objSecSettings.SetSecurityDescriptor(objSD)

Select Case intRes

Case 0

strTemp = strTemp & strSID

If blnHasError Then

strTemp = strTemp & "Частично успешное завершение." & vbNewLine

Else

strTemp = strTemp & "Полностью успешное завершение." & vbNewLine

End If

Case 2: strTemp = strTemp & "Доступ запрещён." & vbNewLine

Case 5, 9, 1307: strTemp = strTemp & "Для выполнения операции недостаточно полномочий." & vbNewLine

Case 21: strTemp = strTemp & "Заданы недопустимые значения параметров." & vbNewLine

Case Else: strTemp = strTemp & "Неизвестная ошибка с кодом: " & intRes & vbNewLine

End Select

'------

Else

strTemp = strTemp & "Не удалось отключить наследование безопасности." & vbNewLine

End If

Else

strTemp = strTemp & "Очистка DACL не требуется." & vbNewLine

End If

Else

strTemp = strTemp & "Список управления доступом пуст." & vbNewLine

End If

Else

strTemp = strTemp & "Ошибка " & Err.Number & " при выполнении метода GetSecurityDescriptor." & _

vbNewLine & Err.Description & vbNewLine

Err.Clear

End If

Else

strTemp = strTemp & "Не удалось прочитать дескриптор безопасности." & vbNewLine

End If

Else

strTemp = strTemp & "Ошибка " & Err.Number & " обращения к классу Win32_LogicalFileSecuritySetting " & _

"при обработке папки " & UCase(strPath) & vbNewLine

Err.Clear

End If

Else

blnHasError = True

strTemp = strTemp & "Ошибка " & Err.Number & " при попытке рекурсивного просмотра папки " & _

UCase(objDir.Path) & vbNewLine

Err.Clear

End If

Set objSD = Nothing

Set objSecSettings = Nothing

If Not objLog Is Nothing Then objLog.WriteLine strTemp

If blnCon And Not blnSil Then WScript.Echo strTemp

strTemp = vbNullString

If blnRec And Not blnHasError Then Call Clear_DACL(objWMIServ, objItem, objLog, blnRec, blnCon, blnSil)

Set objItem = Nothing

On Error GoTo 0

End Function

Полезные скрипты

AGhost — Tue, 05 Jul 2011 06:25:28 +0000

AGhost:

Цитата Dmitrii @ 27.06.11, 09:53

Цитата AGhost @ 24.06.11, 12:56

можно ли как то обойтись без setinfo ?

Нет.

AGhost, без ответа остался вопрос: "Другие сценарии, вносящие изменения в AD через провайдер WinNT, работают нормально (в тех же условиях, что и обсуждаемый сценарий, разумеется)"?

Всё решил через LDAP провайдера....

Полезные скрипты

Dmitrii — Mon, 27 Jun 2011 09:53:49 +0000

Dmitrii:

Цитата AGhost @ 24.06.11, 12:56

можно ли как то обойтись без setinfo ?

Полезные скрипты

AGhost — Fri, 24 Jun 2011 12:56:08 +0000

AGhost: Запускается на удаленной машине из под админского аккаунта, из под которого который можно ручками в оснастке делать unlock логинов...

p.s. можно ли как то обойтись без setinfo ??

Полезные скрипты

Dmitrii — Fri, 24 Jun 2011 07:49:31 +0000

Dmitrii:

Цитата AGhost @ 22.06.11, 12:57

... что необходимо чтобы разблокировать скриптом?

В самом общем случае нужно то же, что и для выполнения любого другого сценария на контроллере - достаточные полномочия.
Сюда нужно отнести: уровень привилегий "учётки", от имени которой выполняется сценарий, отсутствие ограничений со стороны групповой политики, отсутствие блокировок со стороны локального ПО, обеспечивающего безопасность контроллера (например, UAC, брандмауэра).

Цитата AGhost @ 22.06.11, 12:57

... скрипт выдает acces denied на SetInfo.. почему?..

Сценарий запускается с удалённой станции или непосредственно на контроллере домена?
Другие сценарии, вносящие изменения в AD через провайдер WinNT, работают нормально (в тех же условиях, что и обсуждаемый сценарий, разумеется)?

Полезные скрипты

AGhost — Wed, 22 Jun 2011 12:57:26 +0000

AGhost: Скрипт для разблокировки аккаунта запускается от админа который может в оснастке разблокировать аккаунт
но сам скрипт выдает acces denied на SetInfo.. почему ?
и что необходимо чтобы разблокировать скриптом?

Set UserObj = GetObject("WinNT://"& DomainName &"/"& UserName &"")
If UserObj.IsAccountLocked = -1 then UserObj.IsAccountLocked = 0
UserObj.SetInfo

Полезные скрипты

Dmitrii — Fri, 17 Jun 2011 10:55:59 +0000

Dmitrii: Функция для VB-сценария, позволяющая изменять список управления доступом NTFS (DACL) дескриптора безопасности каталога, сохраняя при этом настройки, унаследованные от "родителя".
Варианты изменения DACL (все варианты возможны только для не унаследованных записей):
- изменение маски доступа существующей записи с учётом области её действия;
- добавление отсутствующей записи с заданными типом, областью действия и маской;
- удаление существующей записи с учётом её типа и области действия.
Функция позволяет изменять DACL и того каталога, у которого включено наследование от "родителя", и того - у которого отключено.

Описание параметров.

strDom - входной, обязательный, подтип String.
Смысловая нагрузка - левая часть отличительного имени (distinguished name) "учётки" пользователя или группы, представленного в формате ADS_NAME_TYPE_NT4.
Допустимые значения:
- NetBIOS-имя домена, например, "fabric" (используется для обработки записей DACL, соответствующих "учётке" пользователя или группы из Active Directory);
- NetBIOS-имя компьютера, например, "ws" (используется для обработки записей DACL, соответствующих "учётке" пользователя или группы локального компьютера, кроме "учёток" локальной системы и группы "Все");
- строка нулевой длины (используется для обработки записей DACL, соответствующих "учётке" локальной системы или группы "Все" локального компьютера).

strWS - входной, обязательный, подтип String.
Смысловая нагрузка - имя сервера WMI-пространства CIMV2.
Допустимые значения:
- NetBIOS-имя компьютера, например, "ws" (используется для подключения к WMI-пространству произвольномго компьютера);
- символ "." (может использоваться как альтернатива NetBIOS-имени для подключения к WMI-пространству локального компьютера).

strSAN - входной, обязательный, подтип String.
Смысловая нагрузка - правая часть отличительного имени (distinguished name) "учётки" пользователя или группы, представленного в формате ADS_NAME_TYPE_NT4.
Допустимое значения - NetBIOS-имя "учётки" пользователя или группы локального компьютера или Active Directory, например, "user01".

strDir - входной, обязательный, подтип String.
Смысловая нагрузка - абсолютный локальный путь к каталогу, в DACL дескриптора безопасности которго вносится изменение.
Допустимые значения:
- путь к любому каталогу тома, кроме "корневого", без завершающего символа "\", например, d:\temp\test;
- путь к "корневому" каталогу тома, например, d:\.

intType - входной, обязательный, подтип Integer.
Смысловая нагрузка - числовой индикатор типа записи DACL, назначенной для обработки.
Допустимые значения:
-1 - любой тип;
0 - тип "РАЗРЕШЕНИЕ";
1 - тип "ЗАПРЕТ".

intScope - входной, обязательный, подтип Integer.
Смысловая нагрузка - числовой индикатор области действия записи DACL, назначенной для обработки.
Допустимые значения:
-1 - любая область действия;
0 - область "Только для этой папки";
1 - область "Для этой папки и её файлов";
2 - область "Для этой папки и её подпапок";
3 - область "Для этой папки, её подпапок и файлов";
9 - область "Только для файлов";
10 - область "Только для подпапок";
11 - область "Только для подпапок и файлов".

lngMask - входной, обязательный, подтип Long.
Смысловая нагрузка - числовой индикатор маски доступа записи DACL, назначенной для обработки.
Допустимые значения:
0 - запись назначена для удаления;
- любое числовое значение, допустимое для свойства AccessMask WMI-класса Win32_ACE.

Возвращаемое значение.

Функция возвращает строку с диагностическим сообщением о результатах работы.

Function Modify_DACL(strDom, strWS, strSAN, strDir, intType, intScope, lngMask)

Dim objWMI, objSecSettings, objSD, blnHasInherited, blnHasACE, i

Dim xRes, arrACE, objCollection, objItem, strSID

Dim objSID, objTrustee, objACE

Const SE_DACL_PROTECTED = 4096 'Флаг-признак наследования управляемым каталогом безопасности NTFS от "родителя"

Const INHERITED_ACE = 16 'Флаг-признак того, что текущая запись DACL унаследована от "родителя"

On Error Resume Next

xRes = 0

Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\" & strWS & "\root\cimv2")

If Err.Number = 0 Then

Set objSecSettings = objWMI.Get("Win32_LogicalFileSecuritySetting.Path='" & strDir & "'")

If Err.Number = 0 Then

If objSecSettings.GetSecurityDescriptor(objSD) = 0 Then

If Not IsNull(objSD.DACL) Then

'--- Поиск заданной "учётки" на локальном компьютере или в Active Directory

If Len(strDom) > 0 Then

Set objCollection = objWMI.ExecQuery("SELECT SID FROM Win32_Account WHERE Domain='" & strDom & "' AND Name='" & strSAN & "'")

Else

Set objCollection = objWMI.ExecQuery("SELECT SID FROM Win32_Account WHERE Name='" & strSAN & "'")

End If

'------

If objCollection.Count > 0 Then

If Not CBool(objSD.ControlFlags And SE_DACL_PROTECTED) Then blnHasInherited = True

If blnHasInherited Then

arrACE = Array()

'--- Выборка из исходного DACL записей, не унаследованных от "родителя"

i = -1

For Each objItem In objSD.DACL

If Not CBool(objItem.AceFlags And INHERITED_ACE) Then

i = i + 1

ReDim Preserve arrACE(i)

Set arrACE(i) = objItem

End If

Set objItem = Nothing

'------

'--- Отключение наследования настроек безопасности от "родителя"

objSD.ControlFlags = objSD.ControlFlags + SE_DACL_PROTECTED

xRes = objSecSettings.SetSecurityDescriptor(objSD)

'------

Else

arrACE = objSD.DACL

End If

If xRes = 0 Then

'--- Определение SID "учётки", назначенной для обработки

For Each objItem In objCollection

strSID = UCase(objItem.SID)

Set objItem = Nothing

'------

If lngMask > 0 Then

'--- Подготовка к добавлению в DACL новой записи

Set objSID = objWMI.Get("Win32_SID.SID='" & strSID & "'")

Set objTrustee = objWMI.Get("Win32_Trustee").Spawninstance_()

objTrustee.Domain = strDom

objTrustee.Name = strSAN

objTrustee.SID = objSID.BinaryRepresentation

objTrustee.SidLength = objSID.SidLength

objTrustee.SIDString = strSID

Set objSID = Nothing

Set objACE = objWMI.Get("Win32_Ace").Spawninstance_()

objACE.AceType = intType

objACE.AceFlags = intScope

objACE.AccessMask = lngMask

objACE.Trustee = objTrustee

Set objTrustee = Nothing

i = UBound(arrACE) + 1

ReDim Preserve arrACE(i)

Set arrACE(i) = objACE

objSD.DACL = arrACE

'------

Else

'--- Подготовка к удалению из DACL указанной записи

For Each objACE In arrACE

blnHasACE = False

'--- Поиск указанной записи по SID, области действия и типу

If UCase(objACE.Trustee.SIDString) = strSID Then

If intScope >= 0 Then

If objACE.AceFlags = intScope Then

If intType < 0 Or objACE.AceType = intType Then

blnHasACE = True 'запись заданного типа с искомыми SID и областью действия найдена

End If

Else

blnHasACE = True 'запись с искомым SID найдена (область действия - любая)

End If

If blnHasACE Then

objACE.AccessMask = 0

End If

'------

End If

objSD.DACL = arrACE 'Собственно изменение DACL

Set objACE = Nothing

Erase arrACE

If blnHasInherited Then

'--- Включение наследования настроек безопасности от "родителя",

'если первоначально оно было включено

objSD.ControlFlags = objSD.ControlFlags - SE_DACL_PROTECTED

'------

End If

'--- Итоговое сохраненение изменений, внесённых в дескриптор безопасности

xRes = objSecSettings.SetSecurityDescriptor(objSD)

Select Case xRes

Case 0: xRes = "Успешное завершение."

Case 2: xRes = "Не удалось сохранить изменения DACL." & vbNewLine & "Доступ запрещён."

Case 5, 9: xRes = "Не удалось сохранить изменения DACL." & vbNewLine & "Для выполнения операции недостаточно полномочий."

Case 21: xRes = "Не удалось сохранить изменения DACL." & vbNewLine & "Заданы недопустимые значения параметров."

Case Else: xRes = "Не удалось сохранить изменения DACL." & vbNewLine & "Неизвестная ошибка."

End Select

'------

Else

xRes = "Не удалось отключить наследование безопасности для папки " & UCase(strDir)

End If

Else

xRes = "Не найдена учётная запись объекта " & UCase(strDom & "\" & strSAN)

End If

Set objCollection = Nothing

Else

xRes = "Список управления доступом (ACL) к заданному объекту пуст."

End If

Else

xRes = "Не удалось прочитать дескриптор безопасности объекта."

End If

Set objSD = Nothing

Set objSecSettings = Nothing

Else

xRes = "Ошибка " & CStr(Err.Number) & vbNewLine & Err.Description

Err.Clear

End If

Else

xRes = "Ошибка " & CStr(Err.Number) & vbNewLine & Err.Description

Err.Clear

End If

Set objWMI = Nothing

On Error GoTo 0

Modify_DACL = xRes

End Function

Полезные скрипты

Dmitrii — Wed, 08 Dec 2010 13:07:23 +0000

Dmitrii:

'********************************************************************************

'* Имя: Get_Pinters_List_in_AD.vbs *

'* Язык: VBScript *

'* Назначение: Создание списка всех опубликованных в Active Directory принтеров *

'* путём запроса с помощью ADO. *

'********************************************************************************

Dim objRoot, objConnection, objCommand, objRSet

Dim intNumRecords, strDomain, strLog, arrTemp, strLine, strTemp

Dim objFS, objFile, objWShell

Dim strTranslator, blnIsConsole

Set objFS = CreateObject("Scripting.FileSystemObject")

strTranslator = objFS.GetBaseName(WScript.FullName)

If StrComp(strTranslator, "cscript", vbTextCompare) = 0 Then

blnIsConsole = True

Else

blnIsConsole = False

End If

strLog = "Printers_List_in_AD.log"

Set objRoot = GetObject("LDAP://RootDSE")

strDomain = objRoot.Get("DefaultNamingContext")

Set objRoot = Nothing

Set objConnection = CreateObject("ADODB.Connection")

objConnection.Provider = "ADsDSOObject"

objConnection.Open "Active Directory Provider"

Set objCommand = CreateObject("ADODB.Command")

Set objCommand.ActiveConnection = objConnection

strAttributes = "printerName,uNCName,portName,driverName,serverName,shortServerName,Location"

objCommand.CommandText = "<LDAP://" & strDomain & ">;(objectCategory=printQueue);" & strAttributes & ";Subtree"

objCommand.Properties("Page Size") = 1000

objCommand.Properties("Timeout") = 30

On Error Resume Next

Set objRSet = objCommand.Execute

If Err.Number = 0 Then

intNumRecords = objRSet.RecordCount

If intNumRecords > 0 Then

strLog = objFS.BuildPath(objFS.GetParentFolderName(WScript.ScriptFullName), strLog)

Set objFile = objFS.CreateTextFile(strLog, True)

If Err.Number = 0 Then

strLine = "Обнаружено записей: " & intNumRecords & vbNewLine & "==="

objFile.WriteLine strLine

If blnIsConsole Then WScript.Echo strLine

objRSet.MoveFirst

Do Until objRSet.EOF

For i = 0 To objRSet.Fields.Count - 1

strTemp = vbNullString

If IsArray(objRSet.Fields(i)) Then

arrTemp = objRSet.Fields(i)

For j = 0 To UBound(arrTemp)

strTemp = strTemp & arrTemp(j) & ";"

If Err.Number <> 0 Then Err.Clear

Erase arrTemp

Else

strTemp = objRSet.Fields(i).Value

If Err.Number <> 0 Then Err.Clear

End If

strLine = objRSet.Fields(i).Name & " = " & strTemp

objFile.WriteLine strLine

If blnIsConsole Then WScript.Echo strLine

objFile.WriteLine "---"

If blnIsConsole Then WScript.Echo "---"

objRSet.MoveNext

Loop

objFile.Close

Set objFile = Nothing

If blnIsConsole Then

WScript.Echo "Путь к файлу отчёта: " & UCase(strLog)

Else

Set objWShell = CreateObject("WScript.Shell")

objWShell.Run "notepad.exe " & strLog, 1

Set objWShell = Nothing

End If

Else

WScript.Echo "Ошибка создания файла отчёта: " & Err.Number & vbNewLine & Err.Description

Err.Clear

End If

Else

WScript.Echo "Ничего не обнаружено."

End If

Else

WScript.Echo "Ошибка выполения запроса: " & Err.Number & vbNewLine & Err.Description

Err.Clear

End If

Set objRSet = Nothing

On Error GoTo 0

Set objCommand = Nothing

objConnection.Close

Set objConnection = Nothing

Set objFS = Nothing

WScript.Quit 0

Сообщения были разделены в тему "Помогите написать скрипт"

Полезные скрипты

Dmitrii — Wed, 08 Sep 2010 11:24:54 +0000

Dmitrii:

'*************************************************************************************

'* Имя: Volumes_to_DiskDrives_Associator.vbs *

'* Язык: VBScript *

'* Назначение: Сопоставление логических томов, назначенных съёмным накопителям, *

'* с физическими устройствами. *

'* Типы съёмных накопителей, на работу с которыми ориентирован сценарий: *

'* Flash-диски, Flash-карты, ZIP-диски. *

'*************************************************************************************

Dim objWMI, objLogicalDisks, objLD

Dim objPartitions, objPart, objDrives, objDrive

Dim strComputer, strTemp

strComputer = "."

Set objWMI = GetObject("winmgmts:{impersonationLevel=Impersonate}!\" & strComputer & "\root\cimv2")

Set objLogicalDisks = objWMI.ExecQuery("SELECT * FROM Win32_LogicalDisk WHERE DriveType=2")

For Each objLD In objLogicalDisks

Set objPartitions = objWMI.ExecQuery("ASSOCIATORS OF {Win32_LogicalDisk.DeviceID=""" & _

objLD.DeviceID & _

"""} WHERE AssocClass=Win32_LogicalDiskToPartition")

For Each objPart In objPartitions

Set objDrives = objWMI.ExecQuery("ASSOCIATORS OF {Win32_DiskPartition.DeviceID=""" & _

objPart.DeviceID & _

"""} WHERE AssocClass=Win32_DiskDriveToDiskPartition")

For Each objDrive In objDrives

strTemp = strTemp & objLD.DeviceID & " => " & objDrive.Caption & _

" (Диск " & objDrive.Index & ")" & vbNewLine

Set objDrive = Nothing

Set objDrives = Nothing

Set objPart = Nothing

Set objPartitions = Nothing

Set objLD = Nothing

Set objLogicalDisks = Nothing

Set objWMI = Nothing

If Len(strTemp) = 0 Then

strTemp = "Накопителей указанного типа не обнаружено."

End If

WScript.Echo strTemp

WScript.Quit 0

Полезные скрипты

vladimir_02 — Sat, 07 Aug 2010 13:47:54 +0000

vladimir_02:

'************************************************************

'* Имя: Sendmail Lotus *

'* Язык: VBScript *

'* Назначение: Отправка почты через клиент Lotus Notes *

'* с вложенным файлом с диалогом выбора файла *

'***********************************************************

On Error Goto 0: sendLNMail()

Dim s

Dim db

Dim doc

Dim rtitem

Dim subj

Dim bdy

Dim recips(2)

'File System Object Decs

Dim fs

Dim fName

Dim path

Sub sendLNMail()

On Error Resume Next

'///////////////////////////////////////

' ////////////////////////////////

'Begin Error/Input Routines

'Created by Steven Jacobs

'2004

'///////////////////////////////////////

' ////////////////////////////////

'Get subject...if no subject, exit sub

'subj = inputbox("Please enter a subject For your mail memo.","Email Subject Text")

subj = "Тема письма" ' тут указываем тему пиьма

if subj = "" Then

MsgBox "Введите тему"

Exit Sub

End if

'Get body text...if no body text, exit s

' ub

'bdy = inputbox("Please enter text For your body mail memo.","Email Body Text")

bdy = "C уважением," & chr (10) & _ ' тут пишем текст пиьма

"Vladimir" & chr (10) & _

"Пользователь форума Исходники.ру" & chr (10) & _

"тел. (012345) 1-23-45"

if bdy = "" Then

MsgBox "Введите тест письма"

Exit Sub

End if

Set fs = createobject("Scripting.FileSystemObject")

if fs Is Nothing Then

MsgBox "Could Not Create FileSystemObject",16,"File System Object Error."

endMe

Exit Sub

End if

Set objDialog = CreateObject("UserAccounts.CommonDialog")

objDialog.FilterIndex = 0

objDialog.InitialDir = "d:\" ' путь по умолчанию в диалоге открытия файла

intResult = objDialog.ShowOpen

If intResult = 0 Then

msgbox "Файл не выбран!", vbExclamation, "Внимание!"

Wscript.Quit

Else

'Wscript.Echo objDialog.FileName

fName = objDialog.FileName

Set objFSO = CreateObject("Scripting.FileSystemObject")

End If

'fName = inputbox("Please enter the full path For the file","Enter Full Path To File","C:\")

'if fName = "" Then

'MsgBox "Empty Path"

'endMe

'Exit Sub

'End if

path = fs.GetAbsolutePathName(fName)

if Not fs.FileExists(path) Then

MsgBox "Файл не существует в данной папке"

endMe

End if

'///////////////////////////////////////

' ////////////////////////////////

'End Error/Input Routines

'///////////////////////////////////////

' ////////////////////////////////

Set s = createobject("Notes.NotesSession")

if s Is Nothing Then

MsgBox "Ошибка создания сессии Lotus. Проверьте запущен ли Lotus",16,"Notes Session Error."

endMe

Exit Sub

End if

'See if we can create the main object (s

' ession)

if Err.Number <> 0 Then

On Error Goto 0

MsgBox "Could Not create session 'Lotus Notes' from object"

Exit Sub

End if

Set db = s.getdatabase(s.getenvironmentstring("MailServer",True),s.getenvironmentstring("Mailfile",true))

'See if we can a handle on the mail file

if Err.Number <> 0 Then

On Error Goto 0

MsgBox "Could find or Get a handle on the mail file"

Exit Sub

End if

Set doc = db.createdocument

Doc.SAVEMESSAGEONSEND = True

Set rtitem = doc.createrichtextitem("BODY")

recips(1) = "Email@mail.com" ' указываем адрес получателя

'recips(2) - "rrr@rrr.com"

With doc

.form = "Memo"

.subject = subj

.sendto = "Email@mail.com" ' указываем адрес получателя

'.copyto = "<yyy>@yyy.com"

.body = bdy

.postdate = Date

End With

call rtitem.embedobject(1454,"",fName)

doc.visible = True

doc.send False

'if we made it this far, alert the user

' the mail memo has been created and sent

MsgBox "Файл: " & fName & " успешно отправлен" & chr(10) & _

chr(13) & "Спасибо!",64,"Message Sent Notification."

endMe

End Sub

Sub endMe()

'clean objects/memory

Set s = nothing

Set db = nothing

Set doc = nothing

Set rtitem = nothing

Set fs = nothing

End Sub

для работы этого скрипта (вернее для диалога выбора файла) нужна зарегистрированная comdlg32.ocx
Как переделать этот код, чтобы можно было выбрать для вложения и отправки несколько файлов??
и еще... есть такая задача: приходят с одного адреса письма с вложениями (два архива 11.zip и 14.zip), нужно их открепить от письма (извлечь) в папку на диск (нпар. c:\Inbox\). Потом эти два архива распаковать и несколько извлеченных файлов отпраить по другим адресам...

Полезные скрипты

^D^ima — Sun, 01 Aug 2010 18:54:26 +0000

^D^ima: Доброго времени суток.

Нет ли у кого скрипта для установки скринсейвера?

Полезные скрипты

grade86 — Fri, 23 Jul 2010 08:48:58 +0000

grade86: Господа, подсобите скрипт, чтобы прикрутить в GPO, для автозапуска приложения с шары в домене один раз на каждом ПК. И чтобы не выдавал сообщение "не удается проверить издателя" (хотя если шара в домене и путь netbios, то вроде не должна)

Полезные скрипты

temp_user — Wed, 19 May 2010 09:53:35 +0000

temp_user: O'Reilly - Active Directory Cookbook:

8.8.1 Problem
You want to find inactive computer accounts in a domain.

8.8.2 Solution

These solutions only apply to Windows-based machines. Other types of machines (e.g., Unix) that have accounts in Active Directory may not update their login timestamps or passwords, which are used to determine inactivity.

8.8.2.1 Using a command-line interface
The following query will locate all inactive computers in the current forest:

> dsquery computer forestroot -inactive
You can also use domainroot in combination with the -d option to query a specific domain:

> dsquery computer domainroot -d -inactive
or you can target your query at a specific container:

> dsquery computer ou=MyComputers,dc=rallencorp,dc=com -inactive

This can only be run against a Windows Server 2003 domain functional level or higher domain.

2Moderators: Снесите плз треды о определении "старых" учетных записях в отдельную тему.

Полезные скрипты

blackangel — Wed, 19 May 2010 09:36:16 +0000

blackangel: Всем привет! В AD есть список компов, которые когда-либо были подключены к домену. Хотелось бы выяснить какие из них уже давно не существуют в сети путем просмотра даты последней регистрации в домене. Как это сделать через VBScript?ОЧень нужно(( Спасибо большое за ответ!

Полезные скрипты

Dmitrii — Fri, 16 Apr 2010 09:36:31 +0000

Dmitrii:

Цитата Mazepa @ 15.04.10, 06:30

А возможно ли с помощью скрипта принудительно завершить все клиентские подключения к определенной шаре?

Нет.

Полезные скрипты

Mazepa — Thu, 15 Apr 2010 06:30:04 +0000

Mazepa: Здравствуйте.
А возможно ли с помощью скрипта принудительно завершить все клиентские подключения к определенной шаре?
Все классы WMI пересмотрел, ничего подходящего :(

Полезные скрипты

agem — Thu, 25 Mar 2010 09:28:19 +0000

agem: Реализация возможности просмотра подключений флешек в домене.
Создаем файл usb.mof

#pragma namespace ("\\.\root\subscription")

instance of ActiveScriptEventConsumer as $CONSUMER

{

Name = "MyStandardConsumer";

KillTimeout = 300;

ScriptingEngine = "VBScript";

ScriptFileName = "\\computername\folder\usb.vbs"; //путь к скрипту для события "появился съемный диск"

};

instance of __EventFilter as $FILTER

{

Name = "MyRemDevFilter";

Query = "SELECT * FROM __InstanceCreationEvent WITHIN 5 WHERE TargetInstance ISA "

"\"Win32_LogicalDisk\" AND TargetInstance.DriveType = 2" ;

QueryLanguage = "WQL";

EventNamespace = "root\CIMv2";

};

instance of __FilterToConsumerBinding

{

Consumer = $CONSUMER;

Filter = $FILTER;

};

файл usb.vbs

Dim objFSO, objFile, WshNetwork

Set objFSO = CreateObject ("Scripting.FileSystemObject")

Set objFile = objFSO.OpenTextFile ("\computername\folder\Scriptlog.txt", 8, true) //путь к файлу, куда пишутся логи

Set WshNetwork = CreateObject("WScript.Network")

objFile.WriteLine "Time: " & Now & "; Entry made by ASEC"

objFile.WriteLine "Script Started for USB Drive: " & TargetEvent.TargetInstance.Caption

objFile.Writeline "Sender: " & WshNetwork.ComputerName

objFile.Writeline ""

objFile.Close

после чего запускаем usb.mof

mofcomp usb.mof Для удаленного запуска используем "назначенные задания"

Работает даже после перезагрузки компьютера

Для отключения возможности запускаем файлик delete.vbs

On Error Resume Next

Set objWIMService = GetObject("winmgmts:\.\root\subscription")

Set objList = objWIMService.ExecQuery("references of { EventFilter.Name='MyStandardConsumer'}")

For each objInst in objList

objInst.Delete

Set objList = objWIMService.ExecQuery ("references of {NTEventLogEventConsumer.Name='MyStandardConsumer'}")

For each objInst in objList

objInst.Delete

Set objSTDConsumerInst = GetObject("winmgmts:\.\root\subscription:NTEventLogEventConsumer='MyStandardConsumer'")

objSTDConsumerInst.Delete

Set objEventFltInst = GetObject("winmgmts:\.\root\subscription: EventFilter='MyMonitoring'")

objEventFltInst.Delete

Полезные скрипты

Dmitrii — Wed, 24 Mar 2010 08:22:06 +0000

Dmitrii:

Цитата Kevin-Nash @ 19.03.10, 10:26

... с рабочей станции администратора инициировать локальный вход на группе компьютеров(имя-пароль пользователя известны)...

Стандартными средствами сценариев (в том числе и с помощью WMI) этого сделать нельзя.

Полезные скрипты

Kevin-Nash — Fri, 19 Mar 2010 10:26:14 +0000

Kevin-Nash: Доброго времени суток!
Хочу обратиться к вам за советом или помощью -
С WMI еще дела иметь не приходилось, опыта, соответственно нет.

Задача следующая:
Есть группа компьютеров с Windows XP Professional SP3, объединенных в одноранговую сеть и распределенных по территории компании. Есть "рабочая станция администратора". Для компьютеров существует некая задача распределенных вычислений. Нужно: с рабочей станции администратора инициировать локальный вход на группе компьютеров(имя-пароль пользователя известны) и запустить на них некое приложение.

Возможно ли сделать такое средствами WMI и в какую сторону копать?

Полезные скрипты

Dmitrii — Tue, 02 Mar 2010 06:29:43 +0000

Dmitrii:

Цитата blackangel @ 01.03.10, 10:43

... как запустить два процесса параллельно? ... есть асинхронные и полусинхронные вызовы, но ка реализовать не знаю...

И из запускаемых процессов, и из их откликов будут выстраиваться очереди, хотим мы того или не хотим. Но так как отклики могут приходить асинхронно, то и обрабатывать их можно в асинхронном режиме. Использовать для этого можно механизмы WMI.
Поищите материал по ключам: SWbemSink, ExecQueryAsync, Sink_OnObjectReady (более деятельно сейчас помочь Вам ничем не могу).

Полезные скрипты

-=CAP=- — Mon, 01 Mar 2010 15:35:53 +0000

-=CAP=-: blackangel, попробуй написать еще один скрипт, который будет вызывать твой скрипт с параметром CompName столько раз, на сколько компов надо проинсталить. Только при вызове твоего скрипта не ждать его завершения. В результате ты получишь много окошек с результатами выполнения :)

Полезные скрипты

blackangel — Mon, 01 Mar 2010 15:07:49 +0000

blackangel:

Цитата Akina @ 01.03.10, 13:47

Ммм... WaitForSingleObject/WaitForSingleObjectEx... но вот как это в скрипте - навскидку не сообразится что-то.

эххх:(( буду продолжать ломать голову.

Полезные скрипты

Akina — Mon, 01 Mar 2010 13:47:21 +0000

Akina: Ммм... WaitForSingleObject/WaitForSingleObjectEx... но вот как это в скрипте - навскидку не сообразится что-то.

Полезные скрипты

blackangel — Mon, 01 Mar 2010 10:43:24 +0000

blackangel: Подскажите пожалуйста, как запустить два процесса параллельно? А именно нужно вот что:
Устанавливаю апдейты для Винды на удаленной машине след образом

RetCode = WshShell.Run("d:\psexec.exe \comp1 -s \server\enu\windowsXP-KB957097-x86.exe /quiet /norestart", 1, True)

MsgBox "Обновление завершено! Код возврата - " & RetCode

В первой строке происходит обновление, а затем, когда обновление закончится выводится сообщение с кодом возврата(успешно выполнена установка или нет). Таким образом можно ПООЧЕРЕДНО устанавливать на все компы организации нужное обновление...
Господа! Как запустить эти процессы параллельно на нескольких компьютерах и от каждого процесса получить код возврата?? Знаю, что есть асинхронные и полусинхронные вызовы, но ка реализовать не знаю((( Или может есть другие способы? Помогите плз..

Полезные скрипты

arr1val — Fri, 19 Feb 2010 13:09:00 +0000

arr1val: Подскажите как изменить скрипт приведенный выше по теме:

strComputer = "."

Set objWMIService = GetObject("winmgmts:\" & strComputer & "\root\cimv2")

Set colNetAdapters = objWMIService.ExecQuery ("Select * from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE and DHCPEnabled=TRUE")

For Each objNetAdapter in colNetAdapters

For Each strAddress in objNetAdapter.IPAddress

arrOctets = Split(strAddress, ".")

If arrOctets(0) and arrOctets(1) Then

strNewAddress = arroctets(0) & "." & arroctets(1) & "." & arrOctets(2) & "." & "211"

arrIPAddress = Array(strNewAddress)

strSubnetMask = objNetAdapter.IPSubnet

strGateway = objNetAdapter.DefaultIPGateway

strGatewayMetric = objNetAdapter.GatewayCostMetric

arrDNSServers = objNetAdapter.DNSServerSearchOrder

errEnable = objNetAdapter.EnableStatic(arrIPAddress, strSubnetMask)

errGateways = objNetAdapter.SetGateways(strGateway, strGatewaymetric)

objNetAdapter.SetDNSServerSearchOrder(arrDNSServers)

End If

чтобы он менял все (маску, dns, wins, gateway), кроме айпишника, который и так уже статично задан. Заранее большое спасибо.

----------------------------------------
Пришли сами к такому решению:

strComputer = "."

Set objWMIService = GetObject("winmgmts:" _

& "{impersonationLevel=impersonate}!\" & strComputer & "\root\cimv2")

Set colNetAdapters = objWMIService.ExecQuery _

("Select * from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")

strSubnetMask = "255.255.248.0"

For Each objNetAdapter in colNetAdapters

strIPAddress = CStr(objNetAdapter.IPAddress(0))

errEnable = objNetAdapter.EnableStatic(Array(strIPAddress), Array(strSubnetMask))

Полезные скрипты

Dmitrii — Fri, 05 Feb 2010 13:57:05 +0000

Dmitrii:

Цитата pride.psy @ 04.02.10, 17:27

нужен скрипт, перемещающий отключенных ... пользователей и компьютеров в AD в отдельное подразделение

Пример сценария для перемещения отключенных "учёток" пользователей и компьютеров в отдельное подразделение (предполагается, что оно уже существует в AD):

Public objTargetOU

Public strUsers, strComputers, strTargetOU

Public Const strNoMoved = "krbtgt;Гость" 'Пример списка отключенных "учёток", которые не надо перемещать

Dim objRoot, objContainer, objItem

Dim objFS, objFile

Dim strDomain, strTemp

Const strFile = "C:\Disabled_Users_and_Computers.txt"

strTargetOU = "LDAP://OU=Отключенные и неиспользуемые,"

Set objRoot = GetObject("LDAP://rootDSE")

strDomain = objRoot.Get("defaultNamingContext")

Set objContainer = GetObject("LDAP://" & strDomain)

strTargetOU = strTargetOU & strDomain

Set objRoot = Nothing

Set objTargetOU = GetObject(strTargetOU)

For Each objItem In objContainer

strTemp = objItem.Class

If StrComp(strTemp, "organizationalUnit", vbTextCompare) = 0 Or _

StrComp(strTemp, "container", vbTextCompare) = 0 Then

Call Get_Members(objItem)

End If

Set objItem = Nothing

Set objContainer = Nothing

Set objFS = CreateObject("Scripting.FileSystemObject")

Set objFile = objFS.CreateTextFile(strFile, True)

objFile.WriteLine strUsers & vbNewLine & "=====" & vbNewLine & vbNewLine & strComputers

objFile.Close

Set objFile = Nothing

Set objFS = Nothing

WScript.Echo "Готово."

WScript.Quit 0

'===

Function Get_Members(objOU)

Dim objItem, objIADs, strTemp

If StrComp(objOU.ADsPath, strTargetOU, vbTextCompare) <> 0 Then

For Each objItem In objOU

strTemp = objItem.Class

If StrComp(strTemp, "computer", vbTextCompare) = 0 Then

Set objIADs = GetObject(objItem.ADsPath)

If objIADs.AccountDisabled Then

strComputers = strComputers & objIADs.ADsPath & vbNewLine

objTargetOU.MoveHere objIADs.ADsPath, vbNullString

End If

Set objIADs = Nothing

Else

If StrComp(strTemp, "user", vbTextCompare) = 0 Then

If Instr(1, strNoMoved, objItem.cn, vbTextCompare) = 0 Then

Set objIADs = GetObject(objItem.ADsPath)

If objIADs.AccountDisabled Then

strUsers = strUsers & objIADs.ADsPath & vbNewLine

objTargetOU.MoveHere objIADs.ADsPath, vbNullString

End If

Set objIADs = Nothing

End If

Else

If StrComp(strTemp, "organizationalUnit", vbTextCompare) = 0 Or _

StrComp(strTemp, "container", vbTextCompare) = 0 Then

Call Get_Members(objItem)

End If

Set objItem = Nothing

End If

End Function

Для определения "учёток", не проявляющих активности в течение заданного времени, вычисляйте разницу между текущей датой и значением атрибута LastLogin объекта типа "Пользователь".
Учтите, что это не реплицируемый атрибут, поэтому в мультиконтроллерном домене надо опросить все контроллеры и выбрать наиболее "свежую" дату из полученных.

Полезные скрипты

pride.psy — Thu, 04 Feb 2010 17:27:10 +0000

pride.psy: Доброго времени суток!
Ребят, выручите, нужен скрипт, перемещающий отключенных или неактивных в течении определенного количества дней пользователей и компьютеров в AD в отдельное подразделение.

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

Полезные скрипты

AlexCray — Fri, 15 Jan 2010 15:07:49 +0000

AlexCray: Доброго дня! Ни у кого не завалялось скрипта, копирующего некую иерархию каталогов, с файлами, по сети с сохранением прав доступа пользователей ActiveDirectory?

Полезные скрипты

Dmitrii — Tue, 22 Dec 2009 11:42:45 +0000

Dmitrii: Alexsz, попробуйте так:

Dim objFS, objItem, objFile, objDict, arrFolders, strTemp

Dim objRoot, strDomain

Dim objConnection, objCommand, objRSet, strCmdText

Const strResFile = "C:\Absent.txt"

Set objDict = CreateObject("Scripting.Dictionary")

objDict.CompareMode = 1

'=== Не забудьте правильно задать содержимое массива arrFolders

arrFolders = Array("x:\usrdata", "y:\userdata", "z:\roaming")

'===

Set objFS = CreateObject("Scripting.FileSystemObject")

For i = 0 To UBound(arrFolders)

If objFS.FolderExists(arrFolders(i)) Then

For Each objItem In objFS.GetFolder(arrFolders(i)).SubFolders

strTemp = objItem.Name

If Not objDict.Exists(strTemp) Then

objDict.Add strTemp, False

End If

If objDict.Count > 0 Then

Set objRoot = GetObject("LDAP://RootDSE")

strDomain = objRoot.Get("DefaultNamingContext")

Set objRoot = Nothing

strCmdText = "<LDAP://" & strDomain & ">;(&(objectCategory=Person)(objectClass=User));userPrincipalName;Subtree"

Set objConnection = CreateObject("ADODB.Connection")

objConnection.Provider = "ADsDSOObject"

objConnection.Open "Active Directory Provider"

Set objCommand = CreateObject("ADODB.Command")

Set objCommand.ActiveConnection = objConnection

objCommand.Properties("Page Size") = 1000

objCommand.Properties("Timeout") = 30

objCommand.CommandText = strCmdText

Set objRSet = objCommand.Execute

objRSet.MoveFirst

Do Until objRSet.EOF

strTemp = objRSet.Fields(0).Value

If objDict.Exists(strTemp) Then

objDict.Item(strTemp) = True

End If

objRSet.MoveNext

Loop

Set objRSet = Nothing

Set objCommand = Nothing

Set objConnection = Nothing

strTemp = vbNullString

For Each objItem In objDict.Keys

If Not objDict.Item(objItem) Then

strTemp = strTemp & objItem & vbNewLine

End If

Set objFile = objFS.CreateTextFile(strResFile, True)

objFile.Write strTemp

objFile.Close

Set objFile = Nothing

WScript.Echo "Готово."

Else

WScript.Echo "Список пользователей пуст."

End If

Set objFS = Nothing

Set objDict = Nothing

WScript.Quit 0

Полезные скрипты

Alexsz — Tue, 22 Dec 2009 08:05:10 +0000

Alexsz: Dmitrii
userPrincipalName атрибут, первый ваш пост немного не понял..)

Полезные скрипты

Dmitrii — Tue, 22 Dec 2009 07:53:27 +0000

Dmitrii: Alexsz, первый вопрос остался без ответа. Повторяю его в иной форме.
Какой атрибут схемы AD подразумевается под словом "логин": userPrincipalName, sAMAccountName, displayName, какой-то другой..?

Полезные скрипты

Alexsz — Tue, 22 Dec 2009 07:04:13 +0000

Alexsz: Dmitrii
1.2. Список логинов берется с 3-х мест на сервере: папка с профилями юзеров usrdata (50 на 50,активные и неактивные), папка с профилями userdata (50 на 50,активные и неактивные), папка с профилями roaming (перемещаемые профили).
Брать список юзверей нужно именно с этих папок и сопоставлять с AD. Список можно получить, например, так: dir /ad /b > users.txt
3.2003 r2 sp2

Полезные скрипты

Dmitrii — Tue, 22 Dec 2009 05:38:35 +0000

Dmitrii:

Цитата Alexsz @ 21.12.09, 11:51

Есть список логинов (юзвери)...

1. Речь именно о "логинах" (т.е. об атрибуте схемы userPrincipalName)?
2. Откуда возмётся список, который надо сопоставлять с содержимым AD?
3. Версия сервера?

Полезные скрипты

Alexsz — Mon, 21 Dec 2009 11:51:00 +0000

Alexsz: Здравствуйте!
Имеется следующая задача:
Есть список логинов (юзвери), нужно проверить эти логины на соответствие их в AD (т.е. не все из этих логинов существуют в AD(некоторых допустим уволили но в списке они есть а в AD нету уже).
Как сие организовать? Как организовать вывод логинов которых скрипт не нашел в AD?(думаю нужно вывести их в отдельный txt)..
Подскажите куда рыть...

Полезные скрипты

Alexsz — Sat, 28 Nov 2009 10:06:37 +0000

Alexsz: 3dmaxxx
Зашифровать можно переведя скрипт в exe, гуглите на тему vbs2exe..

Полезные скрипты

3dmaxxx — Sat, 28 Nov 2009 09:25:26 +0000

3dmaxxx:

Цитата Akina @ 28.11.09, 05:37

CallByName или его аналога в WSH нет.

CallByName возращает 0 или 1. А может она как-нибудь возратить ссылку на новый объект, создаваемый методом,-- вызывающийся из CallByName.

PS Как можно зашифровать исходный код скрипта так, что бы он был не читаем для человека, но рабочим для машины?

Полезные скрипты

Akina — Sat, 28 Nov 2009 05:37:49 +0000

Akina: CallByName или его аналога в WSH нет.

Полезные скрипты

3dmaxxx — Fri, 27 Nov 2009 22:08:45 +0000

3dmaxxx: Мне нужно внутри одного скрипта выполнить другой, не явно указанный.
Например, в обычном HTML-интегрированном скрипте это можно было сделать методом write[ln] объекта document...
Есть подобная возможность в WSH?

Полезные скрипты

BlackGod — Wed, 25 Nov 2009 15:57:07 +0000

BlackGod: Alexsz
спасибо =)

Полезные скрипты

Alexsz — Wed, 25 Nov 2009 10:47:19 +0000

Alexsz: BlackGod
Мне ненадо такой скрипт, ибо сам могу написать. Включайте логику и вперед, хотя бы куски кода предлагайте!
з.ы. погуглите, чтоли..

Полезные скрипты

BlackGod — Wed, 25 Nov 2009 10:27:12 +0000

BlackGod:

Цитата Alexsz @ 25.11.09, 10:14

И еще, тут никто за Вас писать скрипты не будет, предлагайте скрипт, написанный Вами, будем думать!

а знаю...

з.ы. есть скриптик, который при запуске с параметром (IP или имя компьютера) устанавливает сервер R_Admin'a на машину...
если надо, то могу и так дать...
Вообще есть немного скриптов, но я думаю, что большинство встречается тут..

Полезные скрипты

Alexsz — Wed, 25 Nov 2009 10:14:46 +0000

Alexsz: strComputer = "."

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery _
("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")

For Each objItem in colItems
Wscript.Echo objItem.MACAddress
For Each strAddress in objItem.IPAddress
Wscript.Echo strAddress
Next
Next

Выводит попапом мак и ип текущего пк
Имя пользователя см имя пк, все по анологии, cpu, mem и hdd берите через wmi

И еще, тут никто за Вас писать скрипты не будет, предлагайте скрипт, написанный Вами, будем думать!

Полезные скрипты

BlackGod — Wed, 25 Nov 2009 09:46:00 +0000

BlackGod:

Цитата Alexsz @ 25.11.09, 09:13

BlackGod
Например: (узнаем имя пк)
WshNetwork = CreateObject("WScript.Network")
WshNetwork.ComputerName

Ну и далее смотрите что Вам нужно в скрипте..

к сожалению в скриптах не силён... :(

Полезные скрипты

Alexsz — Wed, 25 Nov 2009 09:13:02 +0000

Alexsz: BlackGod
Например: (узнаем имя пк)
WshNetwork = CreateObject("WScript.Network")
WshNetwork.ComputerName

Ну и далее смотрите что Вам нужно в скрипте..

Полезные скрипты

BlackGod — Wed, 25 Nov 2009 09:01:09 +0000

BlackGod: Здравствуйте =) помогите со скриптом, который собирал бы в домене информацию о компьютерах пользователей и записывал её в файл (имя компьютера - название файла) вот такой структурой:

[Info]

MAC_Addr=

Current_User_Name= ИМЯ_ПОЛЬЗОВАТЕЛЯ

Computer_Name=ИМЯ_КОМПЬЮТЕРА

IP_Addr=IP_АДРЕС_КОМПЬЮТЕРА Host: ИМЯ_КОМПЬЮТЕРА

System=Windows XP build 2600/Service Pack 1,Русский

Param_0=

Param_1=ИМЯ_ПОЛЬЗОВАТЕЛЯ

Record_Date=28.04.2009

[Computer]

BIOS=

CPU_Freq_in_MHz=

CPU=

Memory_in_Mb=

Total_HDD_in_Mb=

ИМЯ_ПОЛЬЗОВАТЕЛЯ, ИМЯ_КОМПЬЮТЕРА и IP_АДРЕС_КОМПЬЮТЕРА это в принципе основное в этом файле.. если и другое впихнётся, то я не против буду =)

з.ы. вообще это возможно по средством скриптов?)

Полезные скрипты

blackangel — Tue, 24 Nov 2009 09:50:21 +0000

blackangel:

Цитата Akina @ 23.11.09, 18:11

silent? или требуется интерактивное управление пакетом?

Silent. Скрипт запускаем на контроллере домена и он устанавливает пакет на нужные машины.

Полезные скрипты

Akina — Mon, 23 Nov 2009 18:11:48 +0000

Akina:

Цитата blackangel @ 23.11.09, 14:26

установить msi пакет на удаленную машину

silent? или требуется интерактивное управление пакетом?

Полезные скрипты

blackangel — Mon, 23 Nov 2009 14:26:40 +0000

blackangel: Уважаемые, подскажите плз, как установить msi пакет на удаленную машину ПРИ ПОМОЩИ VBS? Все дело естественно в домене.

Полезные скрипты

Alexsz — Wed, 18 Nov 2009 10:13:45 +0000

Alexsz: аааа! а я копал в другом направлении)) Спасибо, все понял! Вывод в StrMessage я и не трогал... ппц.. Спасибо Аkina!

Полезные скрипты

Akina — Wed, 18 Nov 2009 10:02:22 +0000

Akina:

StrMessage = StrMessage & "<p> Лог файл BackupDB: </p>" & "<table border = 1> <tr><td>"& Replace(Ar,vbCrLf,"<br>") &" <br></td></tr></table>"

Полезные скрипты

Alexsz — Wed, 18 Nov 2009 09:56:29 +0000

Alexsz: Ткните пожалуйста, куда Replace вставить?
И что заменять нужно.. :(
П.С. vbNewLine = vbCrLf?

Полезные скрипты

Akina — Wed, 18 Nov 2009 09:41:22 +0000

Akina: Использовать Replace и заменить vbNewLine на "
"

Полезные скрипты

Alexsz — Wed, 18 Nov 2009 07:29:02 +0000

Alexsz: Здравствуйте!
Подскажите пожалуйста, имеется следующий код:

Dim strMessage

Dim fso, arch, backup

Set fso = CreateObject("Scripting.FileSystemObject")

Set arch = fso.OpenTextFile("C:\check free space\Log\Archiving.log", ForReading)

Ar = arch.ReadAll

arch.Close

StrMessage = StrMessage & "<p> Лог файл BackupDB: </p>" & "<table border = 1> <tr><td>"& Ar &" <br></td></tr></table>"

Этот скрипт рассылает сообщение (оформленное как .htmlBody), вопрос - скрипт берет данные из текстового файла, как их вывести в html построчно?
Просто если оставить как есть, то скрипт выведет информацию с Archiving.log одной строкой...
?
(вариант вставить теги
в лог файл некатит, ибо то, что выводит лог не умеет вставлять теги, а каждый день вбивать в лог файл теги это сооовсем не вариант)

П.С.

Подумав сделал так:

Dim strMessage

Dim fso, objFSO, arch, backup, arrlin, strlin

Set fso = CreateObject("Scripting.FileSystemObject")

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set arch = fso.OpenTextFile("C:\check free space\Log\Archiving.log", ForReading)

Ar = arch.ReadAll

arch.Close

arrlin = split(Ar, vbCrLf)

for each Ar in arrlin

StrMessage = StrMessage & "<p> Лог файл BackupDB: </p>" & "<table border=1 align=center><tr><td>"& Ar &"</td></tr></table>"

Если после for each Ar in arrlin добавить wscript.echo Ar то попапами выведется построчно инфа с файла Archiving.log. Но если все оставить как указано в коде, без эхо, то в отсылаемом письме придет только пустая рамка от таблицы, т.е. содержимое файла Archiving.log почему то не желает выводится в тело письма! Куда рыть??? :(

Полезные скрипты

3dmaxxx — Wed, 11 Nov 2009 22:17:42 +0000

3dmaxxx: В общем-то я и использую SWbemLocator. В случае не большой ошибки сети или ещё чего, даже при обращении к машине у которой все необходимые службы активны, часто программа прерывается с ошибкой: "Сервер RPC не доступен". Эсли действительно способа заведомой проверки у WMI связи нет, то Microsoft здесь облажалась.
Главное везде в своём MSDN, перед выполнением каких-либо операций, например, доступа к файлу, прежде всего проверяют его наличие а здесь не в менее серьёзном сбое при не возможности установить WMI-связь, буд-то бы так и надо...
>:(

Полезные скрипты

Akina — Wed, 11 Nov 2009 18:10:10 +0000

Akina: Используй SWbemLocator.ConnectServer, а не IWbemLocator.ConnectServer

Полезные скрипты

3dmaxxx — Wed, 11 Nov 2009 14:28:09 +0000

3dmaxxx: Мой вопрос на сто миллионов долларов?
WMI-- мощная штука, а элементарных вещей делать не может...

Полезные скрипты

3dmaxxx — Tue, 10 Nov 2009 20:35:09 +0000

3dmaxxx: ConnectServer(Edit1.Text, 'root\CIMV2', ...

В указанной выше строке данные беруться из поля Edit1.Text. Если в поле введено не верное имя компьютера или ПК в данный момент не включен или WMI служба на нём не запущена...-- Всё это ведёт к сбою подключения с последующей остановкой программы. Обработчики ошибок не помогают...

Как заранее проверить, что указанная строка даст либо не даст добро на работу?

Полезные скрипты

Akina — Fri, 23 Oct 2009 10:18:05 +0000

Akina:

Цитата Chingizhan @ 23.10.09, 10:14

скрипт будет актуален для многих админов.

Однозначно нет. А вот для ломастеров - да.

Цитата Chingizhan @ 23.10.09, 10:14

Буду очень благодарен за скрипт!

Вот прям готовый тебе вынь да положь? так ты разделом ошибся, тебе в ПОМОЩЬ СТУДЕНТАМ
А если всё-таки намерен делать сам- показывай, что уже сделано и в чём возникла проблема.

Полезные скрипты

Chingizhan — Fri, 23 Oct 2009 10:17:30 +0000

Chingizhan: Еще бы очень нужный скриптик, который бы формировал файл с именами пользователей и паролей в домена.

Полезные скрипты

Chingizhan — Fri, 23 Oct 2009 10:14:08 +0000

Chingizhan: Всем Привет!!!
Столкнулся с потребностью удаления определенного файла у пользователей. Суть такая, место положение файла известно, он может находится в одном из трех мест (на каждой машине находится по разному, но всегда в одном из этих трех мест), имя файла также известно, нужно что бы этот файл удалялся, лучше конечно через какой-то промежуток времени, либо по завершению сеанса пользователя.
Буду очень благодарен за скрипт! Да и так думаю скрипт будет актуален для многих админов.

Полезные скрипты

Akina — Thu, 15 Oct 2009 12:37:54 +0000

Akina:

Sub WriteDataToFile(FullFileName, TextToWrite)

Const ForReading = 1, ForWriting = 2, ForAppending = 8

Dim fso, f

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.OpenTextFile(FullFileName, ForAppending, True)

f.Write TextToWrite

f.Close

End Sub

Call WriteDataToFile("c:\logfile.txt", "Test String")

WScript.Sleep(60000)

Loop

Есссно предусмотри, как завершать работу скрипта - не снимать же процесс...

Полезные скрипты

Alexsz — Thu, 15 Oct 2009 12:25:55 +0000

Alexsz: Спасибо Akina за совет!
Получилось следующее:

Const AlertHigh = .9

Const emailFrom = "xx@xxx.ru"

Const emailTo = "xx@xxx.ru"

Const MailServer = "mail.xxx.ru"

Const WaitTimeInMinutes = 1

Dim strMessage

Dim arrServerList

arrServerList = array("server name")

Do until i = 2

strMessage = ""

PollServers(arrServerList)

if strMessage <> "" then

EmailAlert(strMessage)

end if

WScript.Sleep(WaitTimeInMinutes*60000)

Loop

Sub PollServers(arrServers)

on error resume next

for each Server in arrServers

set objSvc = GetObject("winmgmts:{impersonationLevel=impersonate}//" & Server & "/root/cimv2")

set objRet = objSvc.InstancesOf("win32_LogicalDisk")

for each item in objRet

if item.DriveType = 7 then

end if

if item.FreeSpace/item.size <= AlertHigh then

strMessage = strMessage & UCase(Server) & ": Alert, drive '" & item.caption & "' is low on HDD space! There are " & FormatNumber((item.FreeSpace/1024000),0) & " MB free <7%" & vbCRLF

end if

set objSvc = Nothing

set objRet = Nothing

End Sub

Sub EmailAlert(Message)

on error resume next

Set objMessage = CreateObject("CDO.Message")

with objMessage

.From = emailFrom

.To = emailTo

.Subject = "Low Disk Space Update"

.TextBody = Message

.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = MailServer

.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic

.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxx"

.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxx"

.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False

.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

.Configuration.Fields.Update

.Send

end with

Set objMessage = Nothing

End Sub

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

Полезные скрипты

Akina — Tue, 13 Oct 2009 12:02:12 +0000

Akina:

Цитата Alexsz @ 13.10.09, 11:48

что модифицировать нужно,чтобы скрипт выводил данные в процентах?

Получить не только объём свободного пространства (FreeSpace), но и полный объём (TotalSize). Поделить одно на другое. Умножить на 100. Добавить в конце символ "%".

Цитата Alexsz @ 13.10.09, 11:48

как сделать чтобы при превышении определенного порога % свободного пространства скрипт отсылал предупреждающее ( о том что, допустим, на системном диске 0% свободно) сообщение на мыло?

Задействовать SimpleMAPI. См. "Microsoft Collaboration Data Objects Programmer's Reference" в MSDN.

Полезные скрипты

Alexsz — Tue, 13 Oct 2009 11:48:58 +0000

Alexsz: Здравствуйте! Имеется следующий скрипт: (выводит свободное дисковое пространтсво)

on Error resume Next

stringx = "Локальные диски" & vbNewLine & vbNewLine

Set fso = WScript.CreateObject("Scripting.FileSystemObject")

Set WSHShell = WScript.CreateObject("WScript.Shell")

'Проверяем все драйвы (HDD, FDD, CDD) в системе

For each i In fso.Drives

If i.DriveType=1 Then

If i<>"A:" Then

freef = frit(i)

End If

If i.DriveType=2 Then

free=frit(i)

stringx= stringx & " На диске " & i & " свободно " & free & " Мб " & vbNewLine

End If

stringx = stringx

WSHShell.Popup(stringx)

WScript.Quit()

function frit(gg)

frit = FormatNumber(fso.GetDrive(gg.DriveLetter).FreeSpace/1048576, 1)

End function

Вопрос: что модифицировать нужно,чтобы скрипт выводил данные в процентах? И как сделать чтобы при превышении определенного порога % свободного пространства скрипт отсылал предупреждающее ( о том что, допустим, на системном диске 0% свободно) сообщение на мыло?

Полезные скрипты

Akina — Mon, 21 Sep 2009 14:02:25 +0000

Akina:

Цитата Alexsz @ 21.09.09, 13:18

А если сбросить командой netsh winsock reset? Тогда этот самый фантом исчезнет?)

Если сбросить на мастер-браузере и на рабстанции - да.

Сообщения были разделены в тему "Скрипт для биллинга"

Полезные скрипты

Alexsz — Mon, 21 Sep 2009 13:18:55 +0000

Alexsz:

Цитата Akina @ 18.09.09, 11:01

Цитата

Плюс некоторое время висит фантом в НетБИОС-окружении.

Akina
А если сбросить командой netsh winsock reset? Тогда этот самый фантом исчезнет?

Полезные скрипты

AlexJ — Mon, 21 Sep 2009 01:27:27 +0000

AlexJ:

Цитата Akina @ 18.09.09, 17:31

Вообще-то это определяется параметром Leased Time самогО DHCP-сервера.

Ну так о нем и говорю, редко кто ставит меньше 15 минут, а обычно все ставят неделю, после чего кэш DHCP сервака сбрасывается, если не было больше подключений с определенного МАС-адреса.

Полезные скрипты

Akina — Fri, 18 Sep 2009 17:31:12 +0000

Akina:

Цитата AlexJ @ 18.09.09, 16:27

не видел я чтоб сброс кэша DHCP был меньше 15 минут, а обычно неделя или больше

Вообще-то это определяется параметром Leased Time самогО DHCP-сервера.

Полезные скрипты

AlexJ — Fri, 18 Sep 2009 16:27:53 +0000

AlexJ:

Цитата Akina @ 18.09.09, 11:01

Единственный минус такого подхода - не сбрасывается резервирование адреса на DHCP-сервере.

Akina абсолютно прав, и плюс ко всему даже после перезагрузки перезагрузки ИПшник не сброситься, не видел я чтоб сброс кэша DHCP был меньше 15 минут, а обычно неделя или больше. "Сбить" DHCP сервак можно только сменив МАС адрес сетевухи или "вписаться" самому в протокол DHCP и отвергать предложения сервака получить "старый" ИП.

Полезные скрипты

Akina — Fri, 18 Sep 2009 11:01:31 +0000

Akina:

Цитата Alexsz @ 17.09.09, 11:08

В конце можно при желании прикрутить ребут машины..)

А смысл? достаточно опустить и снова поднять интерфейс - а на ХР и старше так и вовсе ничего не нужно, применяется на лету.
Единственный минус такого подхода - не сбрасывается резервирование адреса на DHCP-сервере. Плюс некоторое время висит фантом в НетБИОС-окружении.

Полезные скрипты

Alexsz — Thu, 17 Sep 2009 11:08:04 +0000

Alexsz: Еще раз спасибо Akina за то что изначально направил меня в нужное русло!:)
Итоговый рабочий самописный скрипт:

strComputer = "."

Set objWMIService = GetObject("winmgmts:\" & strComputer & "\root\cimv2")

Set colNetAdapters = objWMIService.ExecQuery ("Select * from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE and DHCPEnabled=TRUE")

For Each objNetAdapter in colNetAdapters

For Each strAddress in objNetAdapter.IPAddress

arrOctets = Split(strAddress, ".")

If arrOctets(0) and arrOctets(1) Then

strNewAddress = arroctets(0) & "." & arroctets(1) & "." & arrOctets(2) & "." & "211"

arrIPAddress = Array(strNewAddress)

strSubnetMask = objNetAdapter.IPSubnet

strGateway = objNetAdapter.DefaultIPGateway

strGatewayMetric = objNetAdapter.GatewayCostMetric

arrDNSServers = objNetAdapter.DNSServerSearchOrder

errEnable = objNetAdapter.EnableStatic(arrIPAddress, strSubnetMask)

errGateways = objNetAdapter.SetGateways(strGateway, strGatewaymetric)

objNetAdapter.SetDNSServerSearchOrder(arrDNSServers)

End If

В конце можно при желании прикрутить ребут машины..)

Полезные скрипты

Alexsz — Thu, 17 Sep 2009 05:45:19 +0000

Alexsz: To Akina
Я пытаюсь понять, на более простом примере у меня все получается, однако именно в этом случае проблемы, благодаря Вам, Akina, я пытаюсь их решить.
Получилось следующее:

strComputer = "."

Set objWMIService = GetObject("winmgmts:\" & strComputer & "\root\cimv2")

Set colNetAdapters = objWMIService.ExecQuery ("Select * from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE and DHCPEnabled=TRUE")

ArrIpAddress = array("192.168.0.3")

For Each objNetAdapter in colNetAdapters

for each straddress in objnetadapter.ipaddress

arroctet = split(straddress, ".")

if arroctet(0) = "10" and arroctet(1) = "10" then

strnewaddress = "192.168." & arroctets(2) & "." & arroctets(3)

arripaddress = array(strnewaddress)

strSubnetMask = objNetAdapter.IPSubnet

strGateway = objNetAdapter.DefaultIPGateway

strGatewayMetric = objNetAdapter.GatewayCostMetric

arrDNSServers = objNetAdapter.DNSServerSearchOrder

arrEnable = objNetAdapter.EnableStatic(arrIPAddress, strSubnetMask)

errGateways = objNetAdapter.SetGateways(strGateway, strGatewaymetric)

objNetAdapter.SetDNSServerSearchOrder(arrDNSServers)

End If

if err.number<>0 then

wscript.echo err.number, err.description

err.Clear

end if

Скрипт отрабатывает без ошибок но не меняет никаких параметров (ip,mask,gtw,dns..)
Где я ошибся? Помогите пожалуйста Понять..