Новости для программистов подгружаются..
Модераторы: December, bartram, Akella

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Полезные скрипты 
:(
    Опции темы
Теги: Скрипт, vbscript, VBS, CreateObject, script, cscript, очистки
localhost
Дата 4.6.2007, 15:16 (ссылка) | (голосов:2) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 655
Друзей: 2; Групп: 1
Регистрация: 8.11.2005
Где: Н.Новгород

Репутация: 37
Всего: 43
Уважаемые копипэйстэры других форумов, если берёте эти скрипты, то обязательно давайте ссылку на эту тему. Akella©

А то вот ребята с сисадмин.ру своровали, а ссылку на эту тему не поставили
http://sysadmins.ru/topic79925-195.html
------------------------------------------------------------------------------------------------------------------------------


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

Получение серийных номеров ОС

Код

' Скрипт для получения серийных номеров ОС Windows на компьютерах локальной сети
' Получение номера осуществляется путем извлечения бинарного ключа реестра и пе-
' редача его на расшифровку функции GetKey. Скрипт перед подключением проверяет
' доступность компьютера с помощью утилиты ping. Данное решение обосновано тем,
' что использование класса Win32_PingStatus возможно только на компьютерах под
' управлением WinXP и Win2k3

On Error Resume Next

'**********************************************************************************
' Инициализация данных

Const HKEY_LOCAL_MACHINE = &H80000002
Const ADS_SCOPE_SUBTREE = 2

strComputer = ""

Dim fso
Dim file

Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.OpenTextFile ("key_list.txt", 2, True)
Set objShell = CreateObject("WScript.Shell")
 
strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
strValueName = "DigitalProductId"

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "Select Name, Location from 'LDAP://DC=mydomain, DC=local' " _
& "Where objectClass ='computer'"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
Set objRecordSet = objCommand.Execute

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

objRecordSet.MoveFirst

Wscript.Echo "Processing information. This might take several minutes."

Do Until objRecordSet.EOF
    strComputer = objRecordSet.Fields("Name").Value
    
'   Проверяем доступность компьютера с помощью команды PING 
'    и анализа выходного потока

    Set objScriptExec = objShell.Exec("%comspec% /c ping.exe -n 1 " & strComputer)
    strPingResults = LCase(objScriptExec.StdOut.ReadAll)

'    Если компьютер отвечает, подключаемся к его WMI, извлекаем
'    ключ реестра, передаем его на расшифровку функции GetKey

    If InStr(strPingResults, "ttl=") Then
     Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" _
                             & strComputer & "\root\default:StdRegProv")
     oReg.GetBinaryValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
        strWinKey = GetKey(strValue)
        WScript.Echo (strComputer & ": " & strWinKey)
        file.WriteLine("******************************************************")
        file.WriteLine(strComputer & ": " & strWinKey)
        
'    Определяем операционную(ые) систему(ы) на компьютере        

        Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 
        Set colItems = objWMIService.ExecQuery( _
         "SELECT * FROM Win32_OperatingSystem",,48) 
        For Each objItem in colItems 
         Wscript.Echo " OS Name: " & objItem.Name
         file.WriteLine(objItem.Name)
         file.WriteLine("******************************************************")
        Next
        
        objRecordSet.MoveNext
        
'    Если компьютер не отвечает - выводим сообщение и перемещаемся к следующему

    Else
     WScript.Echo(strComputer & ": Не отвечает...")
        objRecordSet.MoveNext
    End If
Loop

WScript.Echo("Script completed!")

'**********************************************************************************
'    Функция разбора ключа реестра (by PaulD)
'    Вход: Ключ DigitalProductId в ветке 
'    HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion
'    Выход: Лицензионный ключ
'    Прим.: Функция взята с http://forum.ixbt.com/topic.cgi?id=67:28
'    
Function GetKey(rpk)

    Const rpkOffset = 52
    i = 28
    szPossibleChars="BCDFGHJKMPQRTVWXY2346789"
 
    Do 'Rep1
        dwAccumulator = 0
        j = 14
        Do 
            dwAccumulator = dwAccumulator*256 
            dwAccumulator = rpk(j + rpkOffset) + dwAccumulator
            rpk(j + rpkOffset) = (dwAccumulator\24) and 255 
            dwAccumulator = dwAccumulator Mod 24
            j = j - 1
        Loop While j >= 0
        i = i - 1
        szProductKey = Mid(szPossibleChars, dwAccumulator + 1, 1)&szProductKey
        If (((29 - i) Mod 6) = 0) and (i <> -1) then 
            i = i - 1 : szProductKey = "-"&szProductKey
        End If
    Loop While i >= 0 'Goto Rep1
 
GetKey = szProductKey

End Function


!!! Вместо mydomain пишем имя домена.


Список установленных программ на всех компьютерах домена

Добавлено @ 15:20
Код

' Скрипт осуществляет инвентаризацию установленных программ на компьютерах
' локальной сети
' Процедура ViewSoft взята из репозитория MS
' http://www.microsoft.com/technet/scriptcenter/scripts/apps/user/usapvb11.mspx

' 1. Инициализируем необходимые данные

On Error Resume Next

Const ADS_SCOPE_SUBTREE = 2

Dim fso
Dim file
strComputerName = ""

' 2. Последовательно выбираем компьютеры из каталога и применяем к ним процедуру ViewSoft

Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.OpenTextFile("soft_list.txt", 2, True)

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "Select Name, Location from 'LDAP://DC=mydomain, DC=local' " _
& "Where objectClass ='computer'"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst

Do Until objRecordSet.EOF
   strComputerName = objRecordSet.Fields("Name").Value
   ViewSoft(objRecordSet.Fields("Name").Value)
   file.WriteLine (objRecordSet.Fields("Name").Value)
   objRecordSet.MoveNext
Loop

file.Close

' 3. Процедура просмотра установленных приожений

Sub ViewSoft (strComputerName)

Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
strComputer = strComputerName
strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
strEntry1a = "DisplayName"
strEntry1b = "QuietDisplayName"
strEntry2 = "InstallDate"
strEntry3 = "VersionMajor"
strEntry4 = "VersionMinor"
strEntry5 = "EstimatedSize"

Set objReg = GetObject("winmgmts://" & strComputer & _
 "/root/default:StdRegProv")
objReg.EnumKey HKLM, strKey, arrSubkeys
file.WriteLine ("***********************************************************")
file.WriteLine("Installed Applications on " & strComputer & vbCrLf)
file.WriteLine ("***********************************************************")
For Each strSubkey In arrSubkeys
  intRet1 = objReg.GetStringValue(HKLM, strKey & strSubkey, _
   strEntry1a, strValue1)
  If intRet1 <> 0 Then
    objReg.GetStringValue HKLM, strKey & strSubkey, _
     strEntry1b, strValue1
  End If
  If strValue1 <> "" Then
    file.WriteLine(VbCrLf & "Display Name: " & strValue1)
  End If
  objReg.GetStringValue HKLM, strKey & strSubkey, _
   strEntry2, strValue2
  If strValue2 <> "" Then
    file.WriteLine("Install Date: " & strValue2)
  End If
  objReg.GetDWORDValue HKLM, strKey & strSubkey, _
   strEntry3, intValue3
  objReg.GetDWORDValue HKLM, strKey & strSubkey, _
   strEntry4, intValue4
  If intValue3 <> "" Then
     file.WriteLine("Version: " & intValue3 & "." & intValue4)
  End If
  objReg.GetDWORDValue HKLM, strKey & strSubkey, _
   strEntry5, intValue5
  If intValue5 <> "" Then
    file.WriteLine("Estimated Size: " & Round(intValue5/1024, 3) & " megabytes")
  End If
Next
End Sub



Это сообщение отредактировал(а) Akella - 18.4.2008, 19:38


--------------------
ВСЕ Нижегородцы! Отмечаемся здесь!!!
Jabber ID: inspire@lampochki.net

user posted image
PM MAIL   Вверх
Akella
Дата 4.6.2007, 17:20 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Ситхи не пройдут
****


Профиль
Группа: Комодератор
Сообщений: 13830
Друзей: 20; Групп: 5
Регистрация: 14.5.2003
Где: Корусант

Репутация: 64
Всего: 243
Получение списка пользователей и компьютеров домена

Код

'***************************************************************** 
'* Имя: Users_Computers_List.vbs                                 * 
'* Язык: VBScript                                                * 
'* Назначение: Формирование списка учётных записей пользователей *
'*             и компьютеров домена с указанием даты их создания * 
'*****************************************************************
Const strResFile = "C:\Users_Computers.txt"
Set objRoot = GetObject("LDAP://RootDSE")
strDomName = objRoot.Get("DefaultNamingContext")
Set objRoot = Nothing
strAttributes = "cn,whenCreated"
arrCmdText = Array("<LDAP://" & strDomName & ">;(&(objectCategory=Person)(objectClass=User));" & strAttributes & ";Subtree", _
                    "<LDAP://" & strDomName & ">;(objectCategory=Computer);" & strAttributes & ";Subtree")
arrCapLines = Array("|Пользователь|Дата создания|", "|Компьютер|Дата создания|")
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.Properties("Sort On") = "cn"
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFile = objFS.CreateTextFile(strResFile, True)
For i = LBound(arrCmdText) To UBound(arrCmdText)
    objCommand.CommandText = arrCmdText(i)
    Set objRSet = objCommand.Execute
    If objRSet.RecordCount > 0 Then
        objFile.WriteLine(arrCapLines(i))
        objRSet.MoveFirst
        Do Until objRSet.EOF
            objFile.WriteLine("|" & objRSet.Fields(0).Value & "|" & DateValue(objRSet.Fields(1).Value) & "|")
            objRSet.MoveNext
        Loop
    End If
    If i < UBound(arrCmdText) Then objFile.WriteLine(vbCrLf)
Next
objFile.Close
Set objFile = Nothing
Set objFS = Nothing
Set objRSet = Nothing
Set objCommand = Nothing
Set objConnection = Nothing
WScript.Echo "Готово."


Это сообщение отредактировал(а) Akella - 16.11.2007, 16:22


--------------------
мы не в ответе за тех, кого приручили
PM MAIL WWW   Вверх
localhost
Дата 5.6.2007, 09:52 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 655
Друзей: 2; Групп: 1
Регистрация: 8.11.2005
Где: Н.Новгород

Репутация: 37
Всего: 43
Море полезных примеров на Microsoft ScriptCenter


--------------------
ВСЕ Нижегородцы! Отмечаемся здесь!!!
Jabber ID: inspire@lampochki.net

user posted image
PM MAIL   Вверх
Akella
Дата 6.6.2007, 07:56 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Ситхи не пройдут
****


Профиль
Группа: Комодератор
Сообщений: 13830
Друзей: 20; Групп: 5
Регистрация: 14.5.2003
Где: Корусант

Репутация: 64
Всего: 243
Мог бы быть полезен скрипт, который меняет настройки учетной записи в MS Outlook  smile



Добавлено @ 08:06
Код

Set objUser = GetObject _
  ("LDAP://cn=myerken,ou=management,dc=fabrikam,dc=com")
 
If objUser.AccountDisabled = FALSE Then
      WScript.Echo "The account is enabled."
Else
      WScript.Echo "The account is disabled."
End If

неплохой скрипт, но вот если бы вставить его В цикл по всем учетный записям, чтобы можно было знать, кто в онлайне, а кто нет

Это сообщение отредактировал(а) Akella - 6.6.2007, 08:18


--------------------
мы не в ответе за тех, кого приручили
PM MAIL WWW   Вверх
Валк
Дата 6.6.2007, 09:50 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 98
Друзей: 0; Групп: 0
Регистрация: 25.5.2006
Где: Тольятти, Россия

Репутация: нет
Всего: нет
Посмотрите пожалуйста следующий скрипт, он предназначен для присоединения сетевого диска, индивидуального для каждого пользователя, с проверкой наличия доступа к сетевому ресурсу:

Подключение сетевого диска с проверкой прав

Код
Dim WshNetwork
Dim FSO

Set WshNetwork = WScript.CreateObject("WScript.Network")
Set FSO = CreateObject("Scripting.FileSystemObject")

If FSO.FolderExists("\\S1\UserDocs\") Then
    If Not(FSO.FolderExists("\\S1\UserDocs\" & WshNetwork.UserName)) Then
    FSO.CreateFolder "\\S1\UserDocs\" & WshNetwork.UserName
    End If
    WshNetwork.MapNetworkDrive "M:", "\\S1\UserDocs\" & WshNetwork.UserName
End If

Set WshNetwork = Nothing
Set FSO = Nothing

Если за кусок кода проверки наличия директории и присоединения сетевого диска я уверен, то вот проверка на доступность сетевого ресурса \\S1\UserDocs\ у меня вызывает сомнения.

Это сообщение отредактировал(а) Akella - 16.11.2007, 16:23
PM MAIL ICQ   Вверх
localhost
Дата 6.6.2007, 12:36 (ссылка) | (голосов:2) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 655
Друзей: 2; Групп: 1
Регистрация: 8.11.2005
Где: Н.Новгород

Репутация: 37
Всего: 43
Закрытие процесса по имени на всех online компьютерах домена

Код

'*******************************************************************************
' Скрипт, последовательно просматривает список компьютеров в AD
' и вырубает заданный процесс.
'*******************************************************************************

' Инициализируем данные

Set objRoot = GetObject("LDAP://RootDSE")
Set objShell = CreateObject("WScript.Shell")

Const ADS_SCOPE_SUBTREE = 2
strProcName = ""
strComputerName = ""
intWasKilled = 0
strDomainName = objRoot.Get("DefaultNamingContext")

Set objRoot = Nothing

' Пользователь задает имя процесса

WScript.Echo("Введите имя процесса:")
strProcName = WScript.StdIn.ReadLine

' Инициализируем и получаем доступ к AD, формируем список компьютеров для просмотра

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "Select Name, Location from 'LDAP://" _
& strDomainName & "'" & "Where objectClass ='computer'"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst

' В цикле последовательно к каждому компьютеру применяем функцию KillProc

Do Until objRecordSet.EOF
   strComputerName = objRecordSet.Fields("Name").Value
   WScript.Echo (strComputerName & " Поиск ...")
   
' Проверяем доступность компьютера с помощью команды PING 
' и анализа выходного потока

    Set objScriptExec = objShell.Exec("%comspec% /c ping.exe -n 1 " & strComputerName)
    strPingResults = LCase(objScriptExec.StdOut.ReadAll)

'    Если компьютер отвечает, подключаемся к его WMI
    
    If InStr(strPingResults, "ttl=") Then
        intWasKilled = KillProc (strComputerName, strProcName)
        WScript.Echo(" Passed. Killed (" & bWasKilled & ")")
        objRecordSet.MoveNext
    Else
     WScript.Echo(strComputerName & ": Не отвечает...")
        objRecordSet.MoveNext
    End If
Loop



'*******************************************************************************
' Функция уничтожения заданного процесса на заданном компьютере
' Вход: имя компьютера, имя процесса
' Выход: количество убитых процессов
'*******************************************************************************

Function KillProc (strComputerName, strProcName)

On Error Resume Next

strComputer = strComputerName

' С помощью моникера winmgmts получаем доступ к WMI целевого компьютера

Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    
' Просматриваем список процессов, находим требуемый

Set colProcessList = objWMIService.ExecQuery _
    ("Select * from Win32_Process Where Name = '" & strProcName & "'")

' Kill It :)

For Each objProcess in colProcessList
    objProcess.Terminate()
Next

' Возвращаем результат (кол-во найденных и завершенных процессов)

KillProc = colProcessList.Count

End Function


Это сообщение отредактировал(а) Akella - 16.11.2007, 16:25


--------------------
ВСЕ Нижегородцы! Отмечаемся здесь!!!
Jabber ID: inspire@lampochki.net

user posted image
PM MAIL   Вверх
localhost
Дата 7.6.2007, 10:59 (ссылка) | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 655
Друзей: 2; Групп: 1
Регистрация: 8.11.2005
Где: Н.Новгород

Репутация: 37
Всего: 43
Список компьютеров домена с залогиненными на них пользователями

Код

' Скрипт опрашивает компьютеры домена на предмет того, какой пользователь
' залогинен в данный момент на каждом компьютере

On Error Resume Next

Const ADS_SCOPE_SUBTREE = 2

Set objRoot = GetObject("LDAP://RootDSE")
strDomainName = objRoot.Get("DefaultNamingContext")
Set objRoot = Nothing

strComputer = ""
Dim fso
Dim file

Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.OpenTextFile ("logged_user_list.txt", 2, True)
Set objShell = CreateObject("WScript.Shell")

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "Select Name, Location from 'LDAP://" & strDomainName & "'" _
& "Where objectClass ='computer'"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
Set objRecordSet = objCommand.Execute

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

objRecordSet.MoveFirst

Wscript.Echo "Processing information. This might take several minutes."

Do Until objRecordSet.EOF
    strComputer = objRecordSet.Fields("Name").Value

' Проверяем доступность компьютера с помощью команды PING 
' и анализа выходного потока

    Set objScriptExec = objShell.Exec("%comspec% /c ping.exe -n 1 " & strComputer)
    strPingResults = LCase(objScriptExec.StdOut.ReadAll)

'    Если компьютер отвечает, подключаемся к его WMI

    If InStr(strPingResults, "ttl=") Then
     Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 
        
        Set colComputer = objWMIService.ExecQuery _
    ("Select * from Win32_ComputerSystem")
    
' Выводим список залогиненных пользователей в файл и на экран

        For Each objComputer in colComputer
             Wscript.Echo "Logged-on " &strComputer & " user: " & objComputer.UserName
             file.WriteLine("Logged-on " &strComputer & " user: " & objComputer.UserName)
        Next
        objRecordSet.MoveNext
        
' Если компьютер не отвечает - выводим сообщение и перемещаемся к следующему

    Else
     WScript.Echo(strComputer & ": Не отвечает...")
        objRecordSet.MoveNext
    End If
Loop



Вариант скрипта, выдающего имя пользователя на конкретном компьютере:

Код

WScript.Echo("Введите имя компьютера:")
strComputer = WScript.StdIn.ReadLine
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 

Set colComputer = objWMIService.ExecQuery _
    ("Select * from Win32_ComputerSystem")
 
For Each objComputer in colComputer
    Wscript.Echo "Logged-on user: " & objComputer.UserName
Next


Это сообщение отредактировал(а) Akella - 16.11.2007, 16:26


--------------------
ВСЕ Нижегородцы! Отмечаемся здесь!!!
Jabber ID: inspire@lampochki.net

user posted image
PM MAIL   Вверх
Akella
Дата 7.6.2007, 11:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Ситхи не пройдут
****


Профиль
Группа: Комодератор
Сообщений: 13830
Друзей: 20; Групп: 5
Регистрация: 14.5.2003
Где: Корусант

Репутация: 64
Всего: 243
localhost, скрипты нужно запускать на КД или можно с любого компа?

Добавлено через 1 минуту и 29 секунд
кстати если на удаленном компе всё закрыто огненной стеной, то "Comp1: Не отвечает..."


--------------------
мы не в ответе за тех, кого приручили
PM MAIL WWW   Вверх
localhost
Дата 7.6.2007, 11:56 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 655
Друзей: 2; Групп: 1
Регистрация: 8.11.2005
Где: Н.Новгород

Репутация: 37
Всего: 43
Цитата(Akella @  7.6.2007,  12:14 Найти цитируемый пост)
localhost, скрипты нужно запускать на КД или можно с любого компа?

C любого компа под доменным админом
Цитата(Akella @  7.6.2007,  12:14 Найти цитируемый пост)
кстати если на удаленном компе всё закрыто огненной стеной, то "Comp1: Не отвечает..." 

Само собой. Для доступа к WMI нужно открыть порт TCP 135
Подробнее о решении неполадок клиентских компьютеров при удаленной работе с WMI читаем тут и тут

Это сообщение отредактировал(а) localhost - 7.6.2007, 11:58


--------------------
ВСЕ Нижегородцы! Отмечаемся здесь!!!
Jabber ID: inspire@lampochki.net

user posted image
PM MAIL   Вверх
localhost
Дата 7.6.2007, 15:03 (ссылка) | (голосов:2) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 655
Друзей: 2; Групп: 1
Регистрация: 8.11.2005
Где: Н.Новгород

Репутация: 37
Всего: 43
Изменение описания компьютера
(имеется ввиду описание то, что видно в проводнике в сетевом окружении)

По просьбе Akella выкладываю скрипт, с помощью которого можно менять описание компьютера на всех машинах домена. Новое описание запрашивается у пользователя для каждого компьютера.
Код

On Error Resume Next

Const ADS_SCOPE_SUBTREE = 2

Set objRoot = GetObject("LDAP://RootDSE")
strDomainName = objRoot.Get("DefaultNamingContext")
Set objRoot = Nothing

Set objShell = CreateObject("WScript.Shell")

strComputer = ""

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "Select Name, Location from 'LDAP://" & strDomainName & "'" _
& "Where objectClass ='computer'"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
Set objRecordSet = objCommand.Execute

objRecordSet.MoveFirst

Do Until objRecordSet.EOF
    strComputer = objRecordSet.Fields("Name").Value
    Set objScriptExec = objShell.Exec("%comspec% /c ping.exe -n 2 " & strComputer)
    strPingResults = LCase(objScriptExec.StdOut.ReadAll)
    
    If InStr(strPingResults, "ttl=") Then
        WScript.Echo ""
        WScript.Echo "Input a new Description for " & strComputer
        strNewDescription = WScript.StdIn.ReadLine
        
        Set objWMIService = GetObject("winmgmts:\\" & strComputer).InstancesOf("Win32_OperatingSystem") 
        For Each x In objWMIService
            x.Description = strNewDescription
            x.Put_
        Next
     objRecordSet.MoveNext
             
    Else
     WScript.Echo(strComputer & ": Not answer...")
        objRecordSet.MoveNext
    End If
Loop


Это сообщение отредактировал(а) Akella - 16.11.2007, 16:28


--------------------
ВСЕ Нижегородцы! Отмечаемся здесь!!!
Jabber ID: inspire@lampochki.net

user posted image
PM MAIL   Вверх
Akella
Дата 7.6.2007, 16:44 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Ситхи не пройдут
****


Профиль
Группа: Комодератор
Сообщений: 13830
Друзей: 20; Групп: 5
Регистрация: 14.5.2003
Где: Корусант

Репутация: 64
Всего: 243
молодец, хороший скрипт


--------------------
мы не в ответе за тех, кого приручили
PM MAIL WWW   Вверх
mihanik
Дата 15.6.2007, 13:32 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


-=Белый Медведь=-
****


Профиль
Группа: Комодератор
Сообщений: 2972
Друзей: 1; Групп: 1
Регистрация: 24.4.2006
Где: г. Тверь

Репутация: 46
Всего: 79
Список компьютеров в одноранговой сети

Скрипт формирует список сетевых компьютеров в переменной MyList.
По окончании работы в MyList содержится многострочный текст, одна строка содержит одно DNS-имя компьютера...
Работает и в одноранговой сети...


Код

' Константы для работы с файлами
Const ForReading = 1, ForWriting = 2, ForAppending = 8

' Переменные для работы с файлами
Dim fso, f
Dim MyFileName
Dim I
Dim MyList

' Переменные для работы с WScript.Shell
Dim WshShell, oExec

'  "придумаем" уникальное имя файла для размещения в c:\
Set fso = CreateObject("Scripting.FileSystemObject")
I = 0
MyFileName = "c:\netview.txt"

While (fso.FileExists(MyFileName))
    MyFileName = "c:\netview(" & cstr(i) & ").txt" 
    I = I + 1
Wend

' Выведем список компьютеров сети в файл
Set WshShell = CreateObject("WScript.Shell")
Set oExec = WshShell.Exec("%comspec% /c  net.exe view >> " & MyFileName)

' Ждём завершения формирования списка компьютеров...
Do While oExec.Status = 0
     WScript.Sleep 100
Loop

' Проверим существование файла...
If not (fso.FileExists(MyFileName)) then
    ' если файла нет, то завершаем работу с сообщением об ошибке...
    msgbox "Не удалось сформировать список доступных сетевых компьютеров!", VBCritical, "Ошибка!!!"
    WScript.quit
end if

'  Откроем файл и сформируем список компьютеров...
On error resume next
MyList = ""

Set f = fso.OpenTextFile(MyFileName, ForReading)

If Err.Number Then
    ' если не удалось открыть файл для чтения, то завершаем работу с сообщением об ошибке...
    msgbox "Не удалось сформировать список доступных сетевых компьютеров!", VBCritical, "Ошибка!!!"
    WScript.quit
end if

While F.AtEndOfStream <> True
    S = f.readline
    If Len (S)>2 Then
        If mid(S,1,2)="\\" Then
            S = Mid(s,3,instr(S," ")-3)
            MyList = MyList & S & VbCrLf
        end If
    end If
Wend

F.close

If Err.Number Then
    ' если во время работы произошли ошибки, то завершаем работу с сообщением об ошибке...
    msgbox "Не удалось сформировать список доступных сетевых компьютеров!", VBCritical, "Ошибка!!!"
    WScript.quit
end if

' удалим файл с диска...
fso.DeleteFile(MyFileName)
WScript.Sleep 100

If Err.Number Then
    ' если не удалось удалить файл , то сообщаем об этом
    msgbox "Не удалось удалить временный файл с именем" & vbcrlf & """" & MyFileName & """" & vbcrlf & _
         "Вы можете удалить его позже вручную." , VBCritical, "Ошибка!!!"
end if

' Выводим список компьютеров на экран...
msgbox MyList


Это сообщение отредактировал(а) Akella - 16.11.2007, 16:28


--------------------
Программистами не рождаются, - это родовая травма...
user posted imageuser posted image
PM MAIL WWW ICQ   Вверх
Akella
Дата 15.6.2007, 13:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Ситхи не пройдут
****


Профиль
Группа: Комодератор
Сообщений: 13830
Друзей: 20; Групп: 5
Регистрация: 14.5.2003
Где: Корусант

Репутация: 64
Всего: 243
а в текстовый файл слабо?


--------------------
мы не в ответе за тех, кого приручили
PM MAIL WWW   Вверх
mihanik
Дата 15.6.2007, 13:50 (ссылка) | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


-=Белый Медведь=-
****


Профиль
Группа: Комодератор
Сообщений: 2972
Друзей: 1; Групп: 1
Регистрация: 24.4.2006
Где: г. Тверь

Репутация: 46
Всего: 79
Список компьютеров в одноранговой сети

Код

' Константы для работы с файлами
Const ForReading = 1, ForWriting = 2, ForAppending = 8

' Переменные для работы с файлами
Dim fso, f
Dim MyFileName
Dim I
Dim MyList

' Переменные для работы с WScript.Shell
Dim WshShell, oExec

'  "придумаем" уникальное имя файла для размещения в c:\
Set fso = CreateObject("Scripting.FileSystemObject")
I = 0
MyFileName = "c:\netview.txt"

While (fso.FileExists(MyFileName))
    MyFileName = "c:\netview(" & cstr(i) & ").txt" 
    I = I + 1
Wend

' Выведем список компьютеров сети в файл
Set WshShell = CreateObject("WScript.Shell")
Set oExec = WshShell.Exec("%comspec% /c  net.exe view >> " & MyFileName)

' Ждём завершения формирования списка компьютеров...
Do While oExec.Status = 0
     WScript.Sleep 100
Loop


Всего и делов-то...
Т.е. мой предыдущий скрипт работает так...
1. Придумывает уникальное имя файла для размещения в с:\
2. Использует net view  для вывода списка компов в файл с найденным именем.
3. Открывает файл на чтение
4. Анализирует его содержимое, формирует список в переменной
5. закрывает файл.
6. удаляет файл
7. выводит результат на экран.

Т.е. если выбросить пункты, начиная с 3, то получиться то, что ты хочешь...
 smile

Добавлено @ 13:54
На этой же идее можно построить скрипт, дающий ответ "в сети ли компьютер, или нет"...

Это сообщение отредактировал(а) Akella - 16.11.2007, 16:29


--------------------
Программистами не рождаются, - это родовая травма...
user posted imageuser posted image
PM MAIL WWW ICQ   Вверх
localhost
Дата 16.6.2007, 13:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 655
Друзей: 2; Групп: 1
Регистрация: 8.11.2005
Где: Н.Новгород

Репутация: 37
Всего: 43
Цитата(mihanik @  15.6.2007,  14:50 Найти цитируемый пост)
На этой же идее можно построить скрипт, дающий ответ "в сети ли компьютер, или нет"... 

net view как раз и выводит список компьюютеров в сети, полученных от мастер-браузера. Единственное что, в развитии этой идеи для применения скриптов на всех компьютерах сети, придется парсить вывод данной команды. Другого способа для сетей без AD я не вижу.


--------------------
ВСЕ Нижегородцы! Отмечаемся здесь!!!
Jabber ID: inspire@lampochki.net

user posted image
PM MAIL   Вверх
Akella
Дата 21.6.2007, 10:25 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Ситхи не пройдут
****


Профиль
Группа: Комодератор
Сообщений: 13830
Друзей: 20; Групп: 5
Регистрация: 14.5.2003
Где: Корусант

Репутация: 64
Всего: 243
Цитата

Существуют уже готовые скрипты:

    * prndrvr.vbs - Добавляет, удаляет и перечисляет драйверы принтера с локального или удаленных серверов печати. 
    * prnjobs.vbs - Приостанавливает, возобновляет, отменяет и перечисляет задания печати. 
    * prnmngr.vbs - Добавляет, удаляет и перечисляет принтеры или подключения принтеров, а также настраивает и отображает принтер, используемый по умолчанию.
    * prnport.vbs - Создает, удаляет и перечисляет стандартные порты TCP/IP для принтеров, а также отображает и изменяет конфигурацию порта.
    * prnqctl.vbs - Печатает пробную страницу, приостанавливает или возобновляет работу принтера и очищает очередь принтера.
    * pubprn.vbs - Настройка сетевых принтеров.
    * eventquery.vbs - Выводит список событий и их свойств из одного или нескольких журналов событий.
    * pagefileconfig.vbs - Производит отображение и настройку параметров использования виртуальной памяти файлом подкачки.
    * prncnfg.vbs - Производит настройку или отображение сведений о конфигурации принтера.


http://forum.vingrad.ru/forum/topic-160118...y1173360/0.html


--------------------
мы не в ответе за тех, кого приручили
PM MAIL WWW   Вверх
mihanik
Дата 21.6.2007, 12:52 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


-=Белый Медведь=-
****


Профиль
Группа: Комодератор
Сообщений: 2972
Друзей: 1; Групп: 1
Регистрация: 24.4.2006
Где: г. Тверь

Репутация: 46
Всего: 79
Запуск скрипта/программы на удалённой машине в сети. 

Следующий сценарий демонстрирует запуск скрипта с именем 111.vbs, лежащего в корне диска с:
Тонкость в том, что машина находиться в сети, а мы знаем её имя и данные пользователя с правами админа.




Код

On Error Resume Next
Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")
CompName = "MyComp" 'имя компьютера
UserName = "Admin" 'имя пользователя
Pass = "bla-bla-bla" 'пароль пользователя

Set objServices = objSWbemLocator.ConnectServer(CompName, "root\CIMV2", UserName, Pass, Null, Null, 0)

If Err.Number <> 0 Then
    WScript.Echo Err.Number & ": " & Err.Description
    WScript.Quit
End If

Set objClass = objServices.Get("Win32_Process")

Res = objClass.Create("wscript.exe c:\111.vbs", Null, Null, PID)

If Res <> 0 Then
    WScript.Echo "Код ошибки: " & Res
End If



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

Чтобы запустить на исполнение vb- или js-скрипт на удалённом компьютере, при вызове метода Create() используйте командную строку типа "wscript.exe c:\filename.vbs", при этом запускаемый файл сценария должен быть расположен на локальном диске удалённого компьютера. 





--------------------
Программистами не рождаются, - это родовая травма...
user posted imageuser posted image
PM MAIL WWW ICQ   Вверх
mihanik
Дата 21.6.2007, 13:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


-=Белый Медведь=-
****


Профиль
Группа: Комодератор
Сообщений: 2972
Друзей: 1; Групп: 1
Регистрация: 24.4.2006
Где: г. Тверь

Репутация: 46
Всего: 79
Почитайте ЗДЕСЬ.
Очень много разных вкусностей!!!


--------------------
Программистами не рождаются, - это родовая травма...
user posted imageuser posted image
PM MAIL WWW ICQ   Вверх
localhost
Дата 16.8.2007, 14:20 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 655
Друзей: 2; Групп: 1
Регистрация: 8.11.2005
Где: Н.Новгород

Репутация: 37
Всего: 43
Еще один экспромт smile

Получение информации о сетевых адаптерах и отправка её по электронной почте

Код

'    Скрипт извлекает информацию о всех сетевых адаптерах, имеющихся в системе
'    и назначенным им IP адресам. Полученные сведения отправляются по e-mail
'    Для успешной отправки сообщения, редактируем секцию "Параметры конфигурации"
'    Скрипт проверенно работает на Windows XP (Home, Pro), Windows 2000 Pro (SP4)
'    Скрипт также поддерживает базовую и NTLM SMTP-аутентификацию, а также соединение
'    с SMTP сервером через SSL

'*******************************************************************
'    Основные параметры конфигурации:
     
strEmailFrom = ""    '    E-mail отправителя
strEmailTo = ""    '    E-mail получателя
strEmailSubject = ""    '    Тема сообщения
strSMTPServer = ""    '    SMTP-сервер
intSMTPPort = 25    '    Порт SMTP Сервера
strSMTPLogin = ""    '    Логин на SMTP Сервере
strSMTPPass = ""    '    Пароль на SMTP сервере

'    Дополнительные параметры конфигурации:

bSMTPUseSSL = False        '    При соединении с SMTP через SSL, необходимо изменить значение на True
intUseAuth = 1            '    Если SMTP-аутентификация не требуется, можно установить значение 0. Для NTLM аутентификации - значение  2

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

strComputer = "." 
Set objEmail = CreateObject("CDO.Message")

objEmail.From = strEmailFrom
objEmail.To = strEmailTo
objEmail.Subject = strEmailSubject

objEmail.Textbody = ""
 
objEmail.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPServer
objEmail.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = intUseAuth
objEMail.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = bSMTPUseSSL
objEmail.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = intSMTPPort
objEmail.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusername") = strSMTPLogin
objEmail.Configuration.Fields.Item _ 
    ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strSMTPPass

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 
Set colItems = objWMIService.ExecQuery( _
    "SELECT * FROM Win32_NetworkAdapterConfiguration",,48) 
For Each objItem in colItems 
    If isNull(objItem.IPAddress) Then
    Else
        strTextBody = strTextBody + vbCrLf + "Adapter: " & objItem.Caption & ", IPAddress: " & Join(objItem.IPAddress, ",")
    End If
Next

objEmail.Textbody = strTextBody
objEmail.Configuration.Fields.Update
objEmail.Send


Это сообщение отредактировал(а) Akella - 16.11.2007, 16:30


--------------------
ВСЕ Нижегородцы! Отмечаемся здесь!!!
Jabber ID: inspire@lampochki.net

user posted image
PM MAIL   Вверх
mihanik
Дата 16.8.2007, 19:44 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


-=Белый Медведь=-
****


Профиль
Группа: Комодератор
Сообщений: 2972
Друзей: 1; Групп: 1
Регистрация: 24.4.2006
Где: г. Тверь

Репутация: 46
Всего: 79
Получение информации о сетевых адаптерах и отправка её по электронной почте

Код

'    Скрипт извлекает информацию о всех сетевых адаптерах, имеющихся в системе
'    и назначенным им IP адресам. Полученные сведения отправляются по e-mail
'    Для успешной отправки сообщения необходим ЛЮБОЙ настроенный e-mail-клиент

' Получим данные об IP-адресах компьютера...

strMyString = ""
strMyString2 = ""
strEmail = "mihanik2000@mail.ru"    ' ЗДЕСЬ УКАЗЫВАЕМ АДРЕС АДМИНИСТРАТОРА
strComputer = "."

Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set IPConfigSet = objWMIService.ExecQuery _
    ("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE")
 
For Each IPConfig in IPConfigSet
    If Not IsNull(IPConfig.IPAddress) Then 
        For i=LBound(IPConfig.IPAddress) to UBound(IPConfig.IPAddress)
            strMyString = strMyString & IPConfig.ServiceName (i) & ": " & IPConfig.IPAddress(i) & vbCrLf
        Next
    End If
Next

    Set IPConfigSet = Nothing
    Set objWMIService = Nothing
    
    strMyString2 = replace(strMyString, vbCrLf, "<br>")

' Запускаем  Internet Explorer 
Set IEObject = CreateObject("InternetExplorer.Application")

' Проверяем есть ли проблемы при запуске
If Err.Number <> 0 then
    MsgBox "Во время запуска Internet Explorer возникла проблема."
    WScript.Quit
End If

' Устанавливаем свойства Internet Explorer 
    IEObject.left = 75
    IEObject.top = 75
    IEObject.width = 400
    IEObject.Height = 300
    IEObject.Menubar = 0 
    IEObject.Toolbar = 0
    IEObject.Navigate "About:Blank"
    IEObject.Visible = 1

' Ждём пока появится
    Do While IEObject.Busy
    Loop
    
' Формируем документ...

    IEObject.Document.Write "<html>"
    IEObject.Document.Write "<head>"
    IEObject.Document.Write "</head>"
    IEObject.Document.Write "<body>"
    IEObject.Document.Write "<center> Найдены следующие IP-адреса: </Center><Br>"
    IEObject.Document.Write strMyString2 & "<Br>"
    strMyString2 = replace(strMyString, vbCrLf, "     |     ")
    IEObject.Document.Write "<Center><A href=""mailto:" & strEmail & "?subject=Отчёт об IP&body=" & strMyString2 & """>Отправить Администратору сети...</A></Center>"
    IEObject.Document.Write "<br>"
    IEObject.Document.Write "<P align = ""right"">(c) Mihanik</p>"
    IEObject.Document.Write "</body>"
    IEObject.Document.Write "</html>"
    
    Set IEObject = Nothing


Добавлено @ 19:45
А вот и сам файл со скриптом...


Это сообщение отредактировал(а) Akella - 16.11.2007, 16:32

Присоединённый файл ( Кол-во скачиваний: 20 )
Присоединённый файл  Ip______.vbs 2,01 Kb


--------------------
Программистами не рождаются, - это родовая травма...
user posted imageuser posted image
PM MAIL WWW ICQ   Вверх
localhost
Дата 10.9.2007, 10:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 655
Друзей: 2; Групп: 1
Регистрация: 8.11.2005
Где: Н.Новгород

Репутация: 37
Всего: 43
Локальная версия Microsoft Script Center в виде chm-файла
http://rapidshare.com/files/54623037/script_center.rar.html (~1,5 Mb)

Это сообщение отредактировал(а) localhost - 10.9.2007, 10:18


--------------------
ВСЕ Нижегородцы! Отмечаемся здесь!!!
Jabber ID: inspire@lampochki.net

user posted image
PM MAIL   Вверх
Akella
Дата 12.9.2007, 16:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Ситхи не пройдут
****


Профиль
Группа: Комодератор
Сообщений: 13830
Друзей: 20; Групп: 5
Регистрация: 14.5.2003
Где: Корусант

Репутация: 64
Всего: 243
хороший файлик +1
только нету там скриптов для MS Outlook  smile 


--------------------
мы не в ответе за тех, кого приручили
PM MAIL WWW   Вверх
Akina
Дата 12.9.2007, 18:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Советчик
****


Профиль
Группа: Модератор
Сообщений: 14445
Друзей: 0; Групп: 0
Регистрация: 8.4.2004
Где: Зеленоград, Москв а, Россия

Репутация: 20
Всего: 271
Удалённое выключение/перезагрузка компьютера

Код

' Скрипт используется для удаленного выключения/перезагрузки/прочее. Есссно подключаться надо с соотв. правами.

Dim StationName
Dim OpSysSet
Dim Flags
Dim Reserved
StationName = InputBox("Insert the Name of the Station to be Shutdown.")
Set OpSysSet = GetObject("winmgmts:{impersonationLevel=impersonate,(RemoteShutdown)}//" & StationName).ExecQuery("select * from Win32_OperatingSystem where Primary=true")

' Flags Action
'  0    Logoff 
'  1    Shutdown 
'  2    Reboot 
'  4    Force 
'  8    Power Off 
' 16    Force If Hung 
Flags = 16

Reserved = 0

For Each OpSys In OpSysSet
   OpSys.Win32Shutdown Flags,Reserved
Next


Это сообщение отредактировал(а) Akella - 16.11.2007, 16:32


--------------------
 О(б)суждение моих действий - в соответствующей теме, пожалуйста. Или в РМ. И высшая инстанция - Администрация форума.
PM MAIL WWW ICQ Jabber   Вверх
localhost
Дата 16.11.2007, 16:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 655
Друзей: 2; Групп: 1
Регистрация: 8.11.2005
Где: Н.Новгород

Репутация: 37
Всего: 43
Удалённая смена пароля

Код

' Скрипт для удаленной смены/задания пароля пользователям домена
' Запрашивает User Logon Name (Имя входа пользователя), на основе чего ищет
' сопоставленную ему учетную запись пользователя и запрашивает новый пароль
' Скрипт проверен на WinXP Pro SP2. 
' Для смены пароля требуются права доменного администратора.

' Устанавливаем сервер сценариев по умолчанию на csript

Set WshShell = CreateObject("WScript.Shell")
Set oExec = WshShell.Exec("cscript.exe /h:cscript")

' Инициализируем переменные

Const ADS_SCOPE_SUBTREE = 2

Set objRoot = GetObject("LDAP://RootDSE")
strDomainName = objRoot.Get("DefaultNamingContext")
Set objRoot = Nothing

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCOmmand.ActiveConnection = objConnection

' Запрашиваем имя пользователя

WScript.StdOut.Write "Input User Logon Name: "
strUserName = WScript.StdIn.ReadLine ()

' Формируем запрос к службе каталога

objCommand.CommandText = _
    "SELECT distinguishedName FROM 'LDAP://" & strDomainName & "'" _
& "WHERE objectClass ='user' AND sAMAccountName='" & strUserName & "'"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 

Set objRecordSet = objCommand.Execute

' Если кол-во возвращенных запросом записей = 0, значит такого пользвователя нет :)

If objRecordSet.RecordCount = 0 Then
    MsgBox ("User not found in domain!")

' Иначе - устанавливаем новый пароль    

Else
    strDistinguishedName = objRecordSet.Fields("distinguishedName").Value
    Set objPassword = CreateObject("ScriptPW.Password") 
    WScript.StdOut.Write "Please, enter your password for " & strUserName & ": "
    strPassword = objPassword.GetPassword()
    WScript.StdOut.WriteLine
    WScript.StdOut.Write "Please, re-type password: "
    strPasswordReType = objPassword.GetPassword()
    If strPassword = strPasswordReType Then
        Set objUser = GetObject("LDAP://" & strDistinguishedName)
        objUser.SetPassword strPassword
        MsgBox ("Password has been set")
    Else
        MsgBox ("Password mismatch")
    End If
End If



Это сообщение отредактировал(а) localhost - 16.11.2007, 16:53


--------------------
ВСЕ Нижегородцы! Отмечаемся здесь!!!
Jabber ID: inspire@lampochki.net

user posted image
PM MAIL   Вверх
Akella
Дата 16.11.2007, 16:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Ситхи не пройдут
****


Профиль
Группа: Комодератор
Сообщений: 13830
Друзей: 20; Групп: 5
Регистрация: 14.5.2003
Где: Корусант

Репутация: 64
Всего: 243
Проверил, работает. Спасибо. Можно из FAR`а запускать так:
1. Становимся курсором на файл.
2. Набираем: cscript
3. Нажимает Ctrl+enter
4. Нажимаем Enter.

Спасибо, дружище

Это сообщение отредактировал(а) Akella - 16.11.2007, 16:18


--------------------
мы не в ответе за тех, кого приручили
PM MAIL WWW   Вверх
localhost
Дата 16.11.2007, 16:35 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 655
Друзей: 2; Групп: 1
Регистрация: 8.11.2005
Где: Н.Новгород

Репутация: 37
Всего: 43
Akella, спасибо за испытания  smile , немного подправил скрипт. Теперь все должно работать smile


--------------------
ВСЕ Нижегородцы! Отмечаемся здесь!!!
Jabber ID: inspire@lampochki.net

user posted image
PM MAIL   Вверх
bartram
Дата 19.11.2007, 21:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Комодератор
Сообщений: 1540
Друзей: 6; Групп: 5
Регистрация: 22.2.2004
Где: Russia, Samara

Репутация: 12
Всего: 28
Спасибо ребята, классные скрипты. В работе пригодятся. 


--------------------
В каждом из нас спит гений, но с каждым днем все крепче ;-)
bartram.ru
Twitter
user posted image 
user posted image
PM MAIL WWW ICQ   Вверх
MS2007
Дата 13.12.2007, 17:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 3
Друзей: 0; Групп: 0
Регистрация: 24.9.2007

Репутация: нет
Всего: нет
Здравствуйте.
Помогите пожалуйста со скриптом.
Как можно подключить сетевой диск от имени другого юзера находящегося в другом домене?
MapDrv "w:", "\\192.168.12.2\User_data"
UserName = "domain\ruser"
Pass = "Password"
PM MAIL   Вверх
marykone (Online)
Дата 18.12.2007, 11:31 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


ученик
****


Профиль
Группа: Комодератор
Сообщений: 2497
Друзей: 0; Групп: 3
Регистрация: 2.5.2006
Где: Краснодар

Репутация: 10
Всего: 64
Цитата(Akina @  12.9.2007,  18:19 Найти цитируемый пост)
Удалённое выключение/перезагрузка компьютера


я в скриптах не силен но вот почему для этого нельзя использовать bat файл 
со строчками shutdown -r -m \\ipremotecomp

извиняюсь если не прав 


--------------------
Все говорят, что у меня /dev/hands криво и я всё делаю через /dev/ass. А у меня этих файлов вообще нет!
PM   Вверх
localhost
Дата 20.12.2007, 20:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 655
Друзей: 2; Групп: 1
Регистрация: 8.11.2005
Где: Н.Новгород

Репутация: 37
Всего: 43
bat-сценарий и вправду тут не пойдет (ну если runas только использовать)
MS2007, отпишись, если актуально до сих пор, что-нибудь придумаем.


--------------------
ВСЕ Нижегородцы! Отмечаемся здесь!!!
Jabber ID: inspire@lampochki.net

user posted image
PM MAIL   Вверх
localhost
Дата 29.2.2008, 11:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 655
Друзей: 2; Групп: 1
Регистрация: 8.11.2005
Где: Н.Новгород

Репутация: 37
Всего: 43
Скрипт, детектирующий и пытающийся исправить распространенную проблему при запуске служб Automatic Updates и BITS

Код

' Скрипт, детектирующий и пытающийся исправить распространенную проблему при запуске служб Automatic Updates и BITS
' на клиентских компьютерах, связанную с ошибками использования идентификатора безопасности (EventID 7023, 7024).
' Данная проблема проявляется на клиентских компьютерах при изменении групповых политик
' При обнаружении указанной проблемы, скрипт сбрасывает идентификатор безопасности, в соответствии
' с KnowlegeBase Microsoft http://support.microsoft.com/kb/555336 и запускает данные службы.
' Может быть полезен тем, кто использует в своей сети Windows Server Update Services 3.0 (WSUS)
' Данный скрипт можно прописать в групповых политиках в качестве logon-скрипта.
' Добавления и замечания, просьба писать в ПМ

' BEGIN :)

' Инициализируем переменные и WMI-моникер
strComputer = "."

Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

' Выбираем из списка процессов интересующие нас Automatic Updates и BITS
Set colListOfServices = objWMIService.ExecQuery _
    ("Select * from Win32_Service Where Name = 'BITS' or Name = 'wuauserv'")

' Применительно к каждому из выбранных процессов:
For Each objService in colListOfServices
    isStarted = 0
    ' Провеяем его состояние. Если он остановлен, то
    If  objService.State = "Stopped" Then
     ' Пытаемся запустить. 
     WScript.Echo ("Service " & objService.Name & " Stopped")
     isStarted = objService.StartService()
  
     ' Если при запуске получаем ту самую проблему, пытаемся ее поправить (исправление оформлено в виде функции Repair)
     If objService.ExitCode <> 0 Then 
         WScript.Echo("WARNING!!! Error occured, when try to started...")
         WScript.Echo ("Try to repair..." & objService.Name)
            intCode = Repair(strComputer)
            If intCode = 0 Then 
                WScript.Echo("Done...")
                objService.StartService
            Else WScript.Echo("Failed To Repair")
            End If 
     Else If objService.ExitCode = 0 Then WScript.Echo ("Successfully stated...")
     End If
    End If
Next

Function Repair(strComputer)

    strCommandLine = "sc sdset " & objService.Name & " " & Chr(34) & "D:(A;;CCLCSWRPWPDTLOCRRC;;;SY)(A;;CCDCLCSWRPWPDTLOCRSDRCWDWO;;;BA)(A;;CCLCSWLOCRRC;;;AU)(A;;CCLCSWRPWPDTLOCRRC;;;PU)" & Chr(34)
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 
    ' Obtain the definition of the class.
    Set objShare = objWMIService.Get("Win32_Process")

    ' Obtain an InParameters object specific
    ' to the method.
    Set objInParam = objShare.Methods_("Create"). _
     inParameters.SpawnInstance_()


    ' Add the input parameters.
    objInParam.Properties_.Item("CommandLine") = strCommandLine

    ' Execute the method and obtain the return status.
    ' The OutParameters object in objOutParams
    ' is created by the provider.
    Set objOutParams = objWMIService.ExecMethod("Win32_Process", "Create", objInParam)

    ' List OutParams
    'WScript.Echo "Out Parameters: "
    'WScript.echo "ProcessId: " & objOutParams.ProcessId
    Repair = objOutParams.ReturnValue
End Function



Это сообщение отредактировал(а) Akella - 7.3.2008, 22:06


--------------------
ВСЕ Нижегородцы! Отмечаемся здесь!!!
Jabber ID: inspire@lampochki.net

user posted image
PM MAIL   Вверх
mihanik
Дата 2.3.2008, 00:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


-=Белый Медведь=-
****


Профиль
Группа: Комодератор
Сообщений: 2972
Друзей: 1; Групп: 1
Регистрация: 24.4.2006
Где: г. Тверь

Репутация: 46
Всего: 79
"Маленький " скриптик для просмотра некоторых сетевых настроек...

Код

'********************************************************************
'* Declare main constants
'********************************************************************
CONST CurrentBuild             = "ShowNetSettings 0.1"           ' Имя текущего билда.

Dim MenuItem, Question, FullName, Name, Domen

On Error Resume Next

' Проверим установлен ли необходимый сервер сценариев.
    If Not IsEngineCScript Then
        ' Установим необходимый тип сервера сценариев
        Call NotEngineCScript
    End If
    
' Выведем имя автора скрипта
    Call PrintAutorName
    
    WScript.Echo
    WScript.Echo "Сетевые настройки компьютера:"
    WScript.Echo
    
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

    Set colItems = objWMIService.ExecQuery("Select * from Win32_Proxy")

    For Each objItem in colItems
        FullName = objItem.ServerName
        Wscript.Echo "Имя компьютера:            " & objItem.ServerName
        Wscript.Echo "Прокси-сервер:            " & objItem.ProxyServer
        WScript.Echo "Номер порта прокси-сервера:    " & objItem.ProxyPortNumber
        Wscript.Echo
    Next
    
    strComputer = "."

Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colAdapters = objWMIService.ExecQuery _
    ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")

WScript.Echo "У компьютера обнаружено сетевых адаптеров : " & colAdapters.Count

n = 1
WScript.Echo
 
For Each objAdapter in colAdapters
   WScript.Echo "Сетевой адаптер № " & n
   WScript.Echo "==================="
   WScript.Echo "Описание:        " & objAdapter.Description
 
   WScript.Echo "Физический (MAC) адрес: " & objAdapter.MACAddress
   WScript.Echo "Имя компьютера:        " & objAdapter.DNSHostName
 
   If Not IsNull(objAdapter.IPAddress) Then
      For i = 0 To UBound(objAdapter.IPAddress)
        If CStr(objAdapter.IPAddress(i))="0.0.0.0" Then 
          WScript.Echo "IP-адрес:        " & objAdapter.IPAddress(i) & " - Адрес не получен!"
         Else 
          If Mid(CStr(objAdapter.IPAddress(i)),1,7)="169.254" Then
              WScript.Echo "IP-адрес:        " & objAdapter.IPAddress(i) & " - Сетевое подключение ограничено или отсутствует!"
          Else
              WScript.Echo "IP-адрес:        " & objAdapter.IPAddress(i)
          End If
         End If 
      Next
   End If
 
   If Not IsNull(objAdapter.IPSubnet) Then
      For i = 0 To UBound(objAdapter.IPSubnet)
       If CStr(objAdapter.IPSubnet(i)) = "255.255.0.0" Or CStr(objAdapter.IPSubnet(i)) = "255.255.255.0" Then
         WScript.Echo "Маска сети:        " & objAdapter.IPSubnet(i) & " - Вероятно это локальный адрес..."
        Else    
         WScript.Echo "Маска сети:        " & objAdapter.IPSubnet(i)
        End If
      Next
   End If
 
   If Not IsNull(objAdapter.DefaultIPGateway) Then
      For i = 0 To UBound(objAdapter.DefaultIPGateway)
         WScript.Echo "Шлюз по умолчанию:    " & _
             objAdapter.DefaultIPGateway(i)
      Next
   End If
 
 WScript.Echo
   WScript.Echo "  Записи DNS"
   WScript.Echo "  ----------"
   WScript.Echo "  Список DNS-серверов:"
 
   If Not IsNull(objAdapter.DNSServerSearchOrder) Then
      For i = 0 To UBound(objAdapter.DNSServerSearchOrder)
         WScript.Echo "      " & objAdapter.DNSServerSearchOrder(i)
      Next
   End If
 
   WScript.Echo "  DNS-домены: " & objAdapter.DNSDomain
 
   If Not IsNull(objAdapter.DNSDomainSuffixSearchOrder) Then
      For i = 0 To UBound(objAdapter.DNSDomainSuffixSearchOrder)
         WScript.Echo "    DNS suffix search list: " & _
             objAdapter.DNSDomainSuffixSearchOrder(i)
             If Len(CStr(objAdapter.DNSDomainSuffixSearchOrder(i))) <> 0 Then Domen = objAdapter.DNSDomainSuffixSearchOrder(i)

      Next
   End If
 
    n = n + 1
     WScript.Echo
Next
        
    WScript.Echo "Для завершения работы нажмите <Enter>."
    Question = WScript.StdIn.ReadLine

WScript.Quit

'********************************************************************
'*
'* Функция   IsEngineCScript()
'* Описание: Определяет тип сервера сценариев.
'* Вход    : Нет
'* Выход   : True если используется CScript.
'*
'********************************************************************

Function IsEngineCScript()

Dim strFullName, strCommand, i, j

ON ERROR RESUME NEXT

    IsEngineCScript = False

' Получим полное имя файла исполнителя сервера сценариев
' В случае ошибки остановим выполнение скрипта

    strFullName = WScript.FullName
    If Err.Number Then
'
' Во время проверки типа сервера сценариев возникла ошибка.
' Error номер ошибки: расшифровка ошибки
' Выполнение программы остановлено."
'
       msgbox  "При определении типа сервера сценариев произошла ошибка." & vbcrlf & _ 
               "Error " & Err.Number & ": " & Err.Description & vbcrlf & _
               "Выполнение программы остановлено.", vbCritical, CurrentBuild
       WScript.Quit
    End if

    i = InStr(1, strFullName, ".exe", 1)
    If i = 0 Then
        Exit Function
    Else
        j = InStrRev(strFullName, "\", i, 1)
        If j = 0 Then
            Exit Function
        Else
            strCommand = Mid(strFullName, j+1, i-j-1)
            Select Case LCase(strCommand)
                Case "cscript"
                     IsEngineCScript = True
                Case "wscript"
                     'IsEngineCScript уже False мы ничего не делаем
                Case Else

' Обработаем невероятный случай :-)
' Для выполнения данного скрипта используется неизвестный тип сервера сценариев.
' Только CScript.Exe или WScript.Exe могут быть использованы для запуска этого скрипта.
' Выполнение программы остановлено.

                     msgbox "Для выполнения данного скрипта используется неизвестный тип сервера сценариев." & vbcrlf & _
                    "Только CScript.Exe или WScript.Exe могут быть использованы для запуска этого скрипта." & vbcrlf & _
                    "Выполнение программы остановлено.", vbCritical, CurrentBuild
                     WScript.Quit
            End Select
        End If
    End If

End Function

'********************************************************************
'*
'* Процедура NotEngineCScript()
'* Описание: Устанавливает тип сервера сценариев по умолчанию.
'* Вход    : Нет
'* Выход   : Нет
'*
'********************************************************************
Sub NotEngineCScript ()
Dim strA               ' Ответ человека
Dim WshShell, oExec    ' Для запуска внешних программ...

   ON ERROR RESUME NEXT

       ' Проверим, при помощи какого сервера сценариев выполняется скрипт
       strA = msgbox( "      Вы используете сервер сценариев отличный от CScript." & vbcrlf & _
                    "Выводимые на экран сообщения могут стать сюрпризом для Вас..."  & vbcrlf & _
                    "        Сделать CScript сервером сценариев по умолчанию?" & vbcrlf & _
                    "                (Потребуется перезапуск скрипта)", VbYesNo, CurrentBuild)
       If strA = VbYes Then
          Set WshShell = CreateObject("WScript.Shell")
          Set oExec = WshShell.Exec("cscript.exe /h:cscript")
              If Err.Number Then
'
' Во время назначения сервера сценариев, используемого по умолчанию, возникла ошибка.
' Error номер ошибки: расшифровка ошибки
' Выполнение программы остановлено."
'
                 msgbox "Во время назначения сервера сценариев, используемого по умолчанию, возникла ошибка." & _
                         vbcrlf & "Error " & Err.Number & ": " & Err.Description & vbcrlf & _ 
                         "Выполнение программы остановлено.", vbCritical, CurrentBuild
                 WScript.Quit
              Else
'
' Запустите скрипт ещё раз!
'
                 msgbox  "Запустите скрипт ещё раз!" , vbInformation , CurrentBuild
                 WScript.Quit
              End if
       Else
' К сожалению скрипт не может продолжить работу!
' Переназначьте используемый по умолчанию сервер сценариев.
           msgbox "      К сожалению скрипт не может продолжить работу!" & vbcrlf & _
                  "Переназначьте используемый по умолчанию сервер сценариев.", vbCritical, CurrentBuild
           WScript.Quit
       End If
End Sub

'********************************************************************
'*
'* Процедура PrintAutorName()
'* Описание: Выводим информацию об авторе скрипта.
'* Вход    : Нет
'* Выход   : Нет
'*
'********************************************************************
Sub PrintAutorName ()
Dim S

' Формируем сточку из звёздочек для обрамления имени автора.
    S = String( 34, "*")

' Выводим имя автора в рамочке из звёздочек.
    Wscript.Echo S
    Wscript.Echo "* " & "(с) Михаил Медведев. 2008 год." & " *"
    Wscript.Echo S
    Wscript.Echo

End sub



Это сообщение отредактировал(а) Akella - 7.3.2008, 22:08


--------------------
Программистами не рождаются, - это родовая травма...
user posted imageuser posted image
PM MAIL WWW ICQ   Вверх
Штык
Дата 27.3.2008, 16:08 (ссылка) | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 206
Друзей: 1; Групп: 0
Регистрация: 9.5.2005
Где: Москоу

Репутация: нет
Всего: 1
Скрипт пишущий в Описание компьютера какой пользователь сейчас залогинен на рабочей станции

в функции right число 8 означает длину вашего доменного имени(не стал писать функцию по подсчету символов)

Код


    On Error Resume Next
 
        strComputer = "."
          
        Set objWMIService = GetObject("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
        Set colComputer = objWMIService.ExecQuery _
        ("Select * from Win32_ComputerSystem")
  
        For Each objComputer In colComputer
             strNewDescription = objComputer.UserName
        Next
     
        st=right(strNewDescription,len(strNewDescription)-8)
     
        Set colItems = objWMIService.ExecQuery( _
         "SELECT * FROM Win32_UserAccount WHERE Name='" & st & "'", , 48)
        For Each objItem In colItems
          strNewDescription = objItem.FullName
        Next 
         
       Set objWMIService = GetObject("winmgmts:\\" & strComputer).InstancesOf("Win32_OperatingSystem")
        For Each x In objWMIService      
            x.Description = strNewDescription
            x.Put_
        Next

    




Это сообщение отредактировал(а) Штык - 27.3.2008, 16:12


--------------------
Lachetes familieres
Qui nous rendent guerrieres
PM MAIL WWW ICQ   Вверх
localhost
Дата 2.4.2008, 09:13 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 655
Друзей: 2; Групп: 1
Регистрация: 8.11.2005
Где: Н.Новгород

Репутация: 37
Всего: 43
Скрипт бэкапа файлопомойки (можно приспособить под любые сетевые файловые ресурсы) с помощью WinRAR и записью в лог-файл о возникших ошибках. 

Параметры:
C:\backup_scripts\log\share_out_error.log - путь к файлу для записи подробного описания ошибок.
C:\backup_scripts\log\share_out.log - путь к файлу с общим результатом работы скрипта.
E:\backup\share\ - путь к каталогу, где будут храниться архивы
C:\backup_scripts\exclude.lst - путь к файлу со списком исключений (файлы и маски, перечисленные в нем, обрабатываться не будут)
\\fileserver\d$\shared\* - собственно, путь к файлопомойке. В данном примере, скрипт запускается на т.н. бэкап-сервере под пользователем, имеющем право доступа к файл-серверу.

Цитата

@echo off
SET ERRORLOG=
rar.exe a -ilogC:\backup_scripts\log\share_out_error.log E:\backup\share\share -x@C:\backup_scripts\exclude.lst -rr3p -agDD-MM-YYYY -m3 -r \\fileserver\d$\shared\*

IF ERRORLEVEL 1 (echo %DATE% %TIME% SHARE : WARNING!!! Error exist!!! Exit Code: %ERRORLEVEL% For more details see share_out_error.log >> C:\backup_scripts\log\share_out.log) ELSE (echo %DATE% %TIME% SHARE : Backup successfully created! Code %ERRORLEVEL% >> C:\backup_scripts\log\share_out.log)


Можно скрипт запускать в Планировщике. Имя архива формируется путем добавления даты создания к имени архива.

Это сообщение отредактировал(а) localhost - 2.4.2008, 09:18


--------------------
ВСЕ Нижегородцы! Отмечаемся здесь!!!
Jabber ID: inspire@lampochki.net

user posted image
PM MAIL   Вверх
localhost
Дата 17.4.2008, 14:49 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 655
Друзей: 2; Групп: 1
Регистрация: 8.11.2005
Где: Н.Новгород

Репутация: 37
Всего: 43
Скрипт проверки доступности сервера/компьютера

При желании видоизменяется как угодно smile Вопросы, дополнения - в ПМ
У себя применяю для отслеживания функционирования важных бизнес-процессов. В Sheduled Tasks данный скрипт запускается каждые 10 минут.

Код

' Скрипт проверки доступности сервера/компьютера
' При недоступности или превышении допустимого времени отклика,
' скрипт отсылает уведомление администратору средставми net send

' Параметры конфигурации
strAdmin = "admin"        ' Имя компьютера, на который будут идти уведомления
intResponseTime = 50    ' Максимально допустимое время отклика    
strMachines = "www.server1.ru;www.server2.ru;www.server3.ru"    ' Тестируемые компьютеры (через точку с запятой)

' Начало скрипта
aMachines = split(strMachines, ";")
strCommand = "%comspec% /c net send " & strAdmin & " "
Set WshShell = Wscript.CreateObject("Wscript.Shell")
 
For Each machine in aMachines
    Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}")._
        ExecQuery("select * from Win32_PingStatus where address = '"_
            & machine & "'")
    For Each objStatus in objPing
        If IsNull(objStatus.StatusCode) or objStatus.StatusCode<>0 Then 
            ' Код обработки ситуации, когда ресурс недоступен
            strMessage = "WARNING!!! " & machine & " is not reachable!!!"
            WshShell.Run strCommand & Chr(34) & strMessage & Chr(34) 
        Else 
         If objStatus.ResponseTime > intResponseTime Then 
             ' Код обработки ситуации, если велико время отклика
             strMessage = "WARNING!!! Response time from " & machine & " is too big! (" & objStatus.ResponseTime & ")"
             WshShell.Run strCommand & Chr(34) & strMessage & Chr(34)
         Else
             ' Код обработки, когда "все в порядке" :)
         End If
        End If
    Next
Next

Set WshShell = Nothing
Set objPing = Nothing
    


Это сообщение отредактировал(а) localhost - 17.4.2008, 14:55


--------------------
ВСЕ Нижегородцы! Отмечаемся здесь!!!
Jabber ID: inspire@lampochki.net

user posted image
PM MAIL   Вверх
mihanik
Дата 3.5.2008, 20:07 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


-=Белый Медведь=-
****


Профиль
Группа: Комодератор
Сообщений: 2972
Друзей: 1; Групп: 1
Регистрация: 24.4.2006
Где: г. Тверь

Репутация: 46
Всего: 79
Выношу на суд админов подборку из процедур и функций, позволяющих управлять в Windows XP учётными записями ЛОКАЛЬНЫХ пользователей.

Код

'#####################################################################
'#
'# Функция   GetUserList()
'# Описание: Возвращает список имём всех учётных записей на локальном компьютре
'# Вход    : Нет
'# Выход   : Символьная строка, содержащая имена пользователей, разделённые ";"
'#####################################################################
Function GetUserList()
Dim S
Dim objWMIService, colItems, objItem
    
    S = ""    
    
    On Error Resume Next
    
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")

        Set colItems = objWMIService.ExecQuery _
            ("Select * from Win32_UserAccount Where LocalAccount = True")
        
            For Each objItem in colItems
                    If S = "" Then S = objItem.Name Else S = S & ";" & objItem.Name
            Next
        
        Set colItems = Nothing
    Set objWMIService = Nothing
    
    On Error Goto 0 
    
    GetUserList = S
    
End Function

'#####################################################################
'#
'# Функция   GetGroupList()
'# Описание: Возвращает список имён всех групп на локальном компьютре
'# Вход    : Нет
'# Выход   : Символьная строка, содержащая имена групп, разделённые ";"
'#####################################################################
Function GetGroupList()
Dim S
Dim objWMIService, colItems, objItem
    
    S = ""

    On Error Resume Next
    
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    
    Set colItems = objWMIService.ExecQuery _
        ("Select * from Win32_Group  Where LocalAccount = True")

    For Each objItem in colItems
        If S = "" Then
            S = objItem.Name 
        Else
            S = S & ";" & objItem.Name 
        End If
    Next
    
    On Error Goto 0
    
    GetGroupList = S

End Function

'#####################################################################
'#
'# Функция   BuildinAdministratorName()
'# Описание: Определяет имя встроенной учётной записи локального администратора
'# Вход    : Нет
'# Выход   : Имя встроенного локального администратора (String)
'#####################################################################
Function BuildInAdministratorName()
Dim AdmSID        ' SID пользователя
Dim objWMIService, colItems, objItem
    
    On Error Resume Next

    BuildInAdministratorName = ""
    
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")

    Set colItems = objWMIService.ExecQuery _
        ("Select * from Win32_UserAccount Where LocalAccount = True")
    
    For Each objItem in colItems
        AdmSID = Mid(objItem.SID,1,6) & "*" & _
              Mid(objItem.SID, InStrRev(objItem.SID,"-"), _
              Len(objItem.SID)-InStrRev(objItem.SID,"-")+1)
        
        If AdmSID = "S-1-5-*-500" Then
         BuildInAdministratorName = objItem.Name
            Exit For
        End If
    Next
    
    Set colItems = Nothing
    Set objWMIService = Nothing
    
    On Error Goto 0 
    
End Function

'#####################################################################
'#
'# Процедура CreateLocalUser
'# Описание: Создаёт учётную запись пользователя  
'# Вход    : strUserName - Имя пользователя
'#             strPassword - пароль пользователя
'# Выход   : Нет
'#####################################################################
Sub CreateLocalUser (byVal strUserName, byVal strPassword)
Dim objComputer
Dim strComputer
Dim colAccounts
Dim objUser

    On Error Resume Next

    Set objComputer = CreateObject("Shell.LocalMachine")
        strComputer = objComputer.MachineName
    Set objComputer = Nothing

    Set colAccounts = GetObject("WinNT://" & strComputer & "")
        Set objUser = colAccounts.Create("user", strUserName)
            objUser.SetPassword strPassword
            objUser.SetInfo
        Set objUser = Nothing
    Set colAccounts = Nothing    

    On Error Goto 0

End Sub

'#####################################################################
'#
'# Процедура SetUserPassword
'# Описание: Устанавливает пароль для локальной учётной записи
'# Вход    : strUserName - Имя пользователя
'#             strPassword - Пароль пользователя
'# Выход   : Нет
'#####################################################################
Sub SetUserPassword (byval strUserName, byval strPassword)
Dim objComputer
Dim strComputer
Dim objUser

    On Error Resume Next

    Set objComputer = CreateObject("Shell.LocalMachine")
        strComputer = objComputer.MachineName
    Set objComputer = Nothing

    Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ", user")
        objUser.SetPassword strPassword
        objUser.SetInfo
    Set objUser = Nothing

    On Error Goto 0

End Sub

'#####################################################################
'#
'# Процедура SetUserDescription
'# Описание: Устанавливает описание для локальной учётной записи
'# Вход    : strUserName - Имя пользователя
'#             strDescription - Описание пользователя
'# Выход   : Нет
'#####################################################################
Sub SetUserPassword (byval strUserName, byval strDescription)
Dim objComputer
Dim strComputer
Dim objUser

    On Error Resume Next

    Set objComputer = CreateObject("Shell.LocalMachine")
        strComputer = objComputer.MachineName
    Set objComputer = Nothing

    Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ", user")
        objUser.Description = strDescription
        objUser.SetInfo
    Set objUser = Nothing

    On Error Goto 0

End Sub

'#####################################################################
'#
'# Процедура SetUserFullName
'# Описание: Устанавливает полное имя для локальной учётной записи
'# Вход    : strUserName - Имя пользователя
'#             strFullName - Полное имя пользователя
'# Выход   : Нет
'#####################################################################
Sub SetUserFullName (byval strUserName, byval strFullName)
Dim objComputer
Dim strComputer
Dim objUser

    On Error Resume Next

    Set objComputer = CreateObject("Shell.LocalMachine")
        strComputer = objComputer.MachineName
    Set objComputer = Nothing

    Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ", user")
        objUser.FullName = strFullName
        objUser.SetInfo
    Set objUser = Nothing

    On Error Goto 0

End Sub

'#####################################################################
'#
'# Процедура SetCommonProperties
'# Описание: Управляет общими свойствами (галками) учётной записи.
'#             
'# Вход    : byVal strUserName                    - имя пользователя
'#             ByVal blnRequireChangePassword     - требовать/не требовать менять пароль при следующем входе
'#             ByVal blnUserCanNotChangePassword  - может/не может пользователь менять свой пароль
'#             ByVal blnNeverExpirePassword        - пароль пользователя никогда не "сгорает" (да/нет)
'#             ByVal blnAccountDisabled            - пользователь включен/выключен
'# Выход   : Нет
'#####################################################################
Sub SetCommonProperties (byVal strUserName, ByVal blnRequireChangePassword, _
                                            ByVal blnUserCanNotChangePassword, _
                                            ByVal blnNeverExpirePassword, _
                                            ByVal blnAccountDisabled )
Dim objComputer
Dim strComputer
Dim colAccounts
Dim objFlag
Dim objUserFlags
Dim objUser


Const ADS_UF_SCRIPT = &H1                             ' The logon script will be executed
Const ADS_UF_ACCOUNTDISABLE = &H2                     ' Disable user account
Const ADS_UF_HOMEDIR_REQUIRED = &H8                   ' Requires a root directory
Const ADS_UF_LOCKOUT = &H10                           ' Account is locked out
Const ADS_UF_PASSWD_NOTREQD = &H20                    ' No password is required
Const ADS_UF_PASSWD_CANT_CHANGE = &H40                ' The user cannot change the password
Const ADS_UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED = &H80   ' Encrypted password allowed
Const ADS_UF_TEMP_DUPLICATE_ACCOUNT = &H100           ' Local user account
Const ADS_UF_NORMAL_ACCOUNT = &H200                   ' Typical user account
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000

    On Error Resume Next

'# Определяем имя компьютера
    Set objComputer = CreateObject("Shell.LocalMachine")
        strComputer = objComputer.MachineName
    Set objComputer = Nothing

'# Устанавливаем/Снимает галку с пункта
'# "Потребвать сену пароля при следующем входе в систему"    
If Not IsNull(blnRequireChangePassword) Then    
        Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ", user")
            
            If blnRequireChangePassword Then 
                objUser.Put "PasswordExpired", 1
            Else
                objUser.Put "PasswordExpired", 0
            End If
        
        objUser.SetInfo
        
        Set objUser = Nothing
End if

'# Устанавливаем/Снимает галку с пункта
'# "Запретить смену пароля пользователем"
If Not IsNull(blnUserCanNotChangePassword) Then    

        Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ", user")
            
            objUserFlags = objUser.Get("UserFlags")
            
            If blnUserCanNotChangePassword Then
             objFlag = objUserFlags Or ADS_UF_PASSWD_CANT_CHANGE
         Else
             objFlag = objUserFlags And Not ADS_UF_PASSWD_CANT_CHANGE
         End If
            
            objUser.Put "userFlags", objFlag 
            objUser.SetInfo
     
        Set objUser = Nothing
End If

'# Устанавливаем/Снимает галку с пункта
'# "Срок действия пароля не ограничен"
If Not IsNull(blnNeverExpirePassword) Then    
    
        Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ", user")
            
            objUserFlags = objUser.Get("UserFlags")
            
            If blnNeverExpirePassword Then
                objFlag = objUserFlags OR ADS_UF_DONT_EXPIRE_PASSWD
            Else
                objFlag = objUserFlags And Not ADS_UF_DONT_EXPIRE_PASSWD
            End If
            
            objUser.Put "userFlags", objFlag 
            objUser.SetInfo
            
        Set objUser = Nothing
End if

'# Устанавливаем включена/выключена учётная запись
If Not IsNull(blnAccountDisabled) Then    

    Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ", user")
        
        objUserFlags = objUser.Get("UserFlags")
        
        If blnAccountDisabled Then
            objFlag = objUserFlags OR ADS_UF_ACCOUNTDISABLE
        Else
            objFlag = objUserFlags And Not ADS_UF_ACCOUNTDISABLE
        End If
        
        objUser.Put "userFlags", objFlag 
        objUser.SetInfo
        
    Set objUser = Nothing
    
End if    

    On Error Goto 0
    
End Sub

'#####################################################################
'#
'# Процедура AddUserToLocalGroup ()
'# Описание: Добавляет пользователя в локальную группу.         
'# Вход    : byVal strUserName                    - имя пользователя
'#             ByVal strGroupName              - Имя группы
'# Выход   : Нет
'#####################################################################
Sub AddUserToLocalGroup(byVal strUserName, byVal strGroupName)
Dim objGroup, objUser, objComputer, strComputer

    On Error Resume Next    
    
    Set objComputer = CreateObject("Shell.LocalMachine")
        strComputer = objComputer.MachineName
    Set objComputer = Nothing

    Set objGroup = GetObject("WinNT://" & strComputer & "/" & strGroupName & ",group")
        Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ",user")
            objGroup.Add(objUser.ADsPath)
            objGroup.SetInfo
        Set objUser = Nothing
    Set objGroup = Nothing
    
    On Error Goto 0

End Sub

'#####################################################################
'#
'# Процедура SetUserHomeDirectory
'# Описание: Устанавливает путь к домашней папке
'# Вход    : strUserName - Имя пользователя
'#             strHomeDirectory - локальный путь к домашней папке
'# Выход   : Нет
'#####################################################################
Sub SetUserHomeDirectory (byval strUserName, byval strHomeDirectory)
Dim objComputer
Dim strComputer
Dim objUser

    On Error Resume Next

    Set objComputer = CreateObject("Shell.LocalMachine")
        strComputer = objComputer.MachineName
    Set objComputer = Nothing

    Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ", user")
        objUser.HomeDirectory = strHomeDirectory
        objUser.SetInfo
    Set objUser = Nothing

    On Error Goto 0

End Sub

'#####################################################################
'#
'# Процедура SetUserHomeDirDrive
'# Описание: Устанавливает сетевой путь к домашней папке
'#           Используется совместно с SetUserHomeDirectory
'# Вход    : strUserName - Имя пользователя
'#             strHomeDirDrive - имя подключаемого сетевого диска (Например "X:" или "Z:")
'# Выход   : Нет
'#####################################################################
Sub SetUserHomeDirDrive (byval strUserName, byval strHomeDirDrive)
Dim objComputer
Dim strComputer
Dim objUser

    On Error Resume Next

    Set objComputer = CreateObject("Shell.LocalMachine")
        strComputer = objComputer.MachineName
    Set objComputer = Nothing

    Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ", user")
        objUser.HomeDirDrive = strHomeDirDrive
        objUser.SetInfo
    Set objUser = Nothing

    On Error Goto 0

End Sub

'#####################################################################
'#
'# Процедура SetUserProfile
'# Описание: Устанавливает путь к профайлу пользователя
'# Вход    : strUserName - Имя пользователя
'#             strUserProfile - путь к профайлу пользователя
'# Выход   : Нет
'#####################################################################
Sub SetUserProfile (byval strUserName, byval strUserProfile)
Dim objComputer
Dim strComputer
Dim objUser

    On Error Resume Next

    Set objComputer = CreateObject("Shell.LocalMachine")
        strComputer = objComputer.MachineName
    Set objComputer = Nothing

    Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ", user")
        objUser.Profile = strUserProfile
        objUser.SetInfo
    Set objUser = Nothing

    On Error Goto 0

End Sub

'#####################################################################
'#
'# Процедура DeleteLocalUser
'# Описание: Удаляет учётную запись локального пользователя
'# Вход    : strUserName - Имя пользователя
'# Выход   : Нет
'#####################################################################
Sub DeleteLocalUser (byval strUserName)
Dim objComputer
Dim strComputer
Dim colAccounts
Dim objUser

    On Error Resume Next

    Set objComputer = CreateObject("Shell.LocalMachine")
        strComputer = objComputer.MachineName
    Set objComputer = Nothing

    Set colAccounts = GetObject("WinNT://" & strComputer & "")
        colAccounts.Delete "user", strUserName
    Set colAccounts = Nothing    

    On Error Goto 0

End Sub

'#####################################################################
'#
'# Процедура RenameLocalUser
'# Описание: Переименовывает учётную запись локального пользователя
'# Вход    : strUserName - Имя учётной записи пользователя,
'#             strNewUserName - Новое имя учётной записи пользователя
'# Выход   : Нет
'#####################################################################
Sub RenameLocalUser (byval strUserName, byVal strNewUserName)
Dim objComputer
Dim strComputer
Dim colAccounts
Dim objUser

    On Error Resume Next

    Set objComputer = CreateObject("Shell.LocalMachine")
        strComputer = objComputer.MachineName
    Set objComputer = Nothing

    Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ", user")

        Set objComputer = GetObject("WinNT://" & strComputer)
        
            objComputer.MoveHere objUser.AdsPath, strNewUserName
    
        Set objComputer = Nothing
    
    Set objUser = Nothing
    
    On Error Goto 0

End Sub



Пример использования

Код

    Call CreateLocalUser ("АрсеньевА", "1q2w!Q@W" )
    Call AddUserToLocalGroup ("АрсеньевА", "Опытные пользователи" )
    Call SetCommonPropertyes ("АрсеньевА", False, True, True, False)
    Call SetUserProfile ("АрсеньевА", "D:\D&S\%UserName%")



Это сообщение отредактировал(а) mihanik - 4.5.2008, 20:51


--------------------
Программистами не рождаются, - это родовая травма...
user posted imageuser posted image
PM MAIL WWW ICQ   Вверх
mihanik
Дата 10.5.2008, 21:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


-=Белый Медведь=-
****


Профиль
Группа: Комодератор
Сообщений: 2972
Друзей: 1; Групп: 1
Регистрация: 24.4.2006
Где: г. Тверь

Репутация: 46
Всего: 79
Итак...
Завершил работу над скриптом по управлению локальными учётными записями.
Всё параметры для своей работы скрипт берёт из текстового файла.
Достаточно просто "схватить" текстовый файл левой кнопкой мышки и перетащить на значёк моего скрипта.
(можно также запускать скрипт из командной строки, указав в качестве параметра необходимый файл.)

Формат текстового файла по управлению скриптом следующий:

Код

################################################################
#  Файл с командами по управлению локальными учётными записями
################################################################

################################################################
# 
#  Строение файла:
#  1. Пустые, "пробельные" строки, а также строки, начинающиеся со знака "#"
#      рассматриваются как коментарий.
#  2. Файл может содержать любое количество строк
#  3. В одной строке можно указывать только одну команду
#  4. Все команды (кроме команды DeleteUser) имеют два аргумента, разделённых запятой
# 
#  Список используемых команд:
# 
#  1. CreateUser - создаёт учётную запись пользователя с указанным паролем
#      Формат команды: 
#     CreateUser <имя>, <пароль>
# 
#      Здесь: <имя> - имя создаваемой учётной записи
#           <пароль> - пароль создаваемой учётной записи
# 
#      Пример:
#  CreateUser ПупкиВ, 1q2w!Q@W
#    
#  2. SetPassword - устанавливает пароль учётной записи пользователя с указанным именем
#      Формат команды: 
#     SetPassword <имя>, <пароль>
# 
#       Здесь: <имя> - имя создаваемой учётной записи
#       <пароль> - пароль создаваемой учётной записи
# 
#      Пример:
#  SetPassword ПупкиВ, 1q2w!Q@W
#    
#  3. SetDescription - устанавливает описание учётной записи пользователя с указанным именем
#      Формат команды: 
#     SetDescription <имя>, <описание>
# 
#       Здесь: <имя> - имя учётной записи
#       <описание> - описание для учётной записи
#  
#      Пример:
#  SetDescription ПупкиВ, Автоматически созданная учётная запись пользователя
#    
#  4. SetUserFullName - устанавливает полное имя учётной записи пользователя с указанным именем
#      Формат команды: 
#     SetUserFullName <имя>, <полное имя>
# 
#       Здесь: <имя> - имя  учётной записи
#       <полное имя> - полное имя учётной записи
#  
#      Пример:
#  SetUserFullName ПупкиВ, Пупкин Василий Петрович
#    
#  5. AddUserToLocalGroup - добавляет учётную запись пользователя в локальную группу с указанным именем
#      Формат команды: 
#     AddUserToLocalGroup <имя>, <имя группы>
# 
#       Здесь: <имя> - имя учётной записи
#       <имя группы> - имя локальной группы
#  
#      Пример:
#  AddUserToLocalGroup ПупкиВ, Опытные пользователи
#    
#  6. SetUserProfile - устанавливает путь к профилю учётной записи пользователя с указанным именем
#      Формат команды: 
#     AddUserToLocalGroup <имя>, <путь>
# 
#       Здесь: <имя> - имя учётной записи
#       <путь> - путь к профилю
#  
#      Пример:
#  SetUserProfile ПупкиВ, D:\D&S\ПупкиВ
#    
#  7. DeleteUser - удаляет учётную запись пользователя с указанным именем
#      Осторожно!!! Учётная запись удаляется без дополнительного предупреждения
# 
#      Формат команды: 
#     DeleteUser <имя>
# 
#       Здесь: <имя> - имя учётной записи
#  
#      Пример:
#  DeleteUser ПупкиВ
#    
#  8. RenameLocalUser - переименовывает учётную запись пользователя с указанным именем
#      Формат команды: 
#     RenameLocalUser <имя>, <новое имя>
# 
#       Здесь: <имя> - имя учётной записи
#       <новое имя> - новое имя учётной записи
#  
#      Пример:
#  RenameLocalUser ПупкиВ, ПупкинВасилий
#    
#  9. AccountDisabled - устанваливает отключена или включена учётная запись пользователя с указанным именем
#      Формат команды: 
#     AccountDisabled <имя>, <yes|no>
# 
#       Здесь: <имя> - имя учётной записи
#       <yes> - учётная запись отключена
#       <no>  - учётная запись включена
#   
#      Пример:
#  AccountDisabled ПупкиВ, yes
#    
#  10. NeverExpirePassword - устанваливает имеет ли ограничение срок действия пароля учётной записи пользователя с указанным именем
#       Формат команды: 
#     NeverExpirePassword <имя>, <yes|no>
# 
#        Здесь: <имя> - имя учётной записи
#       <yes> - срок действия пароля не ограничен
#       <no>  - срок действия пароля ограничен
#   
#       Пример:
#  NeverExpirePassword ПупкиВ, yes
#    
#  11. UserCanNotChangePassword - устанваливает может ли пользователь с указанным именем менять свой пароль
#       Формат команды: 
#     UserCanNotChangePassword <имя>, <yes|no>
# 
#        Здесь: <имя> - имя учётной записи
#       <yes> - пользователь не может менять свой пароль
#       <no>  - пользователь может менять свой пароль
#   
#       Пример:
#  UserCanNotChangePassword ПупкиВ, yes
#    
#  11. RequireChangePassword - устанваливает требовать ли от  пользователя с указанным именем сменить пароль при следующем входе в систему
#       Формат команды: 
#     RequireChangePassword <имя>, <yes|no>
# 
#        Здесь: <имя> - имя учётной записи
#       <yes> - требовать от пользователя  сменить свой пароль
#       <no>  - не требовать от пользователя  сменить свой пароль
#   
#       Пример:
#  RequireChangePassword ПупкиВ, yes
################################################################
 

#  Пример управления пользователем

CreateUser    ПупкиВ, 1й2ц!Й"Ц
SetPassword    ПупкиВ, , 1й2ц3у!Й"Ц№У
SetDescription    ПупкиВ,  Автоматически созданная учётная запись
SetUserFullName    ПупкиВ,  Пупкин Василий Петрович
AddUserToLocalGroup    ПупкиВ,   Опытные пользователи    
SetUserProfile    ПупкиВ,  D:\D&S\ПупкиВ
NeverExpirePassword    ПупкиВ,  yes
UserCanNotChangePassword    ПупкиВ,  yes
RenameLocalUser    ПупкиВ,  ПупкиВасилий
AccountDisabled    ПупкиВасилий, yes

#  DeleteUser    Василиус




А вот непосредственно и сам скрипт в приложении


Это сообщение отредактировал(а) mihanik - 10.5.2008, 21:14

Присоединённый файл ( Кол-во скачиваний: 28 )
Присоединённый файл  ManageUserAccounts.rar 7,59 Kb


--------------------
Программистами не рождаются, - это родовая травма...
user posted imageuser posted image
PM MAIL WWW ICQ   Вверх
mihanik
Дата 18.5.2008, 22:25 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


-=Белый Медведь=-
****


Профиль
Группа: Комодератор
Сообщений: 2972
Друзей: 1; Групп: 1
Регистрация: 24.4.2006
Где: г. Тверь

Репутация: 46
Всего: 79
Код

'********************************************************************
'*
'* Класс    : EngineScript
'* Описание : Экземпляры объекта данного класса используются для определения
'*              типа сервера сценариев, установки нужного типа сервера сценария.
'* Вход     : Нет
'* Выход    : Нет
'*
'********************************************************************
class EngineScript
    
    ' Свойства класса
    Dim EngineScriptType    '        тип сервера сценариев по-умолчанию
                            '            0 - тип не определён
                            '            1 - wscript
                            '            2 - cscript
    Dim EngineScriptName    '        имя сервера сценариев по-умолчанию
                            '            wscript или cscript
    Dim ClassErr            '        номер ошибки времени исполнения
    Dim ClassErrDescription    '        расшифровка ошибки времени исполнения

    ' Используемые в классе переменные
    Private WshShell    ' для создания WScript.Shell
    
    ' Переменные, используемые для локализации скрипта
    Private Msg1
    Private Msg2
    
    '********************************************************************
    '*
    '* Процедура: class_Initialize
    '* Описание : Выполняет действия, необходимые для инициализации класса
    '* Вход     : Нет
    '* Выход    : Нет (Создаётся экземпляр объекта этого класса)
    '*
    '********************************************************************
    Private Sub class_Initialize()
    
        ' Локализация
        Msg1 = "Ошибка определения имени сервера сценариев."
        Msg2 = "Неизвестное имя сервера сценариев."
        
        On Error Resume Next
        Err.Clear
        
        ClassErr = 0
        ClassErrDescription = ""
        EngineScriptType = 0
        EngineScriptName = ""

        ' Получим полное имя файла исполнителя сервера сценариев
        EngineScriptName = WScript.FullName
            
        If Err.Number Then
            ClassErr = Err.Number
            ClassErrDescription = Err.Description
            Err.Clear
            Exit Sub
        End if
        
        If Len (EngineScriptName) < 14 Then
            ClassErr = -1 ' Ошибка определения имени
            ClassErrDescription = Msg1
        Else
            EngineScriptName = UCase(Mid(EngineScriptName,Len(EngineScriptName)-10,11))
        End If
        
        Select Case EngineScriptName
            Case "WSCRIPT.EXE"    
                     EngineScriptType = 1
                        EngineScriptName = "WSCRIPT"
            Case "CSCRIPT.EXE"    
                     EngineScriptType = 2
                        EngineScriptName = "CSCRIPT"
            Case Else        
                     EngineScriptType = 0
                        EngineScriptName = "UNKNOWN"
        End Select
    
    End sub

    '********************************************************************
    '*
    '* Процедура: SetEngineScript
    '* Описание : Устанавливает нужный сервер сценариев по умолчанию
    '* Вход     : strName - cscript или wscript
    '* Выход    : нет
    '*
    '********************************************************************
    Sub SetEngineScript ( ByVal strName)

        strName = UCase(strName)
        
        On Error Resume Next
        Err.Clear
    
        Set WshShell = CreateObject("WScript.Shell")

            If Err.Number Then
                ClassErr = Err.Number
                ClassErrDescription = Err.Description
                Err.Clear
                Exit Sub
            End if
    
            Select Case strName
                Case "WSCRIPT"    
                 WshShell.Run "wscript.exe //h:wscript", 1, True
                Case "CSCRIPT"    
                 WshShell.Run "wscript.exe //h:cscript", 1, True
                Case Else
                    ClassErr = -2 
                    ClassErrDescription = Msg2
            End Select
          
        Set WshShell = Nothing

    End Sub
End class



Пример использования

Код

    Dim a
    
    Set a = New EngineScript

    If a.EngineScriptType <> 2 Then a.SetEngineScript ("cscript")    
    
    Set a = Nothing




--------------------
Программистами не рождаются, - это родовая травма...
user posted imageuser posted image
PM MAIL WWW ICQ   Вверх
Akina
Дата 19.5.2008, 00:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Советчик
****


Профиль
Группа: Модератор
Сообщений: 14445
Друзей: 0; Групп: 0
Регистрация: 8.4.2004
Где: Зеленоград, Москв а, Россия

Репутация: 20
Всего: 271
mihanik
Во-первых, не понимаю, почему вместо (или в дополнение? так даже лучше - EngineScriptType и EngineScriptName) символьного имени скрипт отдает числовое?
Во-вторых, почему при ином типе сервера сценариев не вывести именно его имя, а не абстрактное UNKNOWN.
Ну и в третьих - зачем эта проверка на 14 символов? и почему надо откусывать последние 11, вместо того чтобы распарсить что там после последнего слеша...


--------------------
 О(б)суждение моих действий - в соответствующей теме, пожалуйста. Или в РМ. И высшая инстанция - Администрация форума.
PM MAIL WWW ICQ Jabber   Вверх
mihanik
Дата 19.5.2008, 06:49 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


-=Белый Медведь=-
****


Профиль
Группа: Комодератор
Сообщений: 2972
Друзей: 1; Групп: 1
Регистрация: 24.4.2006
Где: г. Тверь

Репутация: 46
Всего: 79
Цитата(Akina @  19.5.2008,  00:47 Найти цитируемый пост)
Ну и в третьих - зачем эта проверка на 14 символов?


len ("c:\cscript.exe") = 14 (трудно придумать более короткий путь...)



Цитата(Akina @  19.5.2008,  00:47 Найти цитируемый пост)
почему надо откусывать последние 11, вместо того чтобы распарсить что там после последнего слеша... 


Распарсить не проблема.
Но !
1. В основном используются cscript и wscript
а их название это последние 11 символов.

2. Другие серверы сценариев меня не интересуют.
Это является ответом и на вопрос


Цитата(Akina @  19.5.2008,  00:47 Найти цитируемый пост)
почему при ином типе сервера сценариев не вывести именно его имя, а не абстрактное UNKNOWN.


А на вопрос 
Цитата(Akina @  19.5.2008,  00:47 Найти цитируемый пост)
имени скрипт отдает числовое?

отвечу, что это я подсмотрел у MS.

Так же подсмотрел там и там, что потом оформил в вот этом скрипте.

Код

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Процедура VBPrintf()
' Описание: Эмитирует работу функции printf
' Вход    : strEcho  - строка для вывода
'            arrParam - массив параметров
' Выход   : Нет
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub VBPrintf (byVal strEcho, byVal arrParam)
Dim intI
Dim intN
Dim strS

    If IsArray(arrParam) Then 

        intN = UBound(arrParam)
        
        While blnTestString(strEcho, "^.*%[0-9]+.*$")
        
            strS = strExtractString( strEcho, "%[0-9]+")
            intI = CInt(Mid (strS,2,Len(strS)-1))-1
            
            If intI <= intN Then 
                strEcho = Replace (strEcho, strS, arrParam(intI))
            Else
                strEcho = Replace (strEcho, strS, "!NoParameter")
            End If
            
        Wend
        
        strEcho = Replace (strEcho, "!NoParameter", "%Err")
        
    End If

    WScript.Echo strEcho
    
End Sub

'********************************************************************
'*
'* Функция  : blnTestString (приватная)
'* Описание : Определяет соответствует ли строка шаблону
'* Вход     : strString - строка
'*            strPath   - шаблон (регулярное выражение)
'* Выход    : true - соответствует шаблону; false - не соответствует шаблону
'*
'********************************************************************
Private Function blnTestString(ByVal strString, ByVal strPath)

    Dim RegEx
    
    Set RegEx = CreateObject("VBScript.RegExp")
    
        RegEx.IgnoreCase = True
        RegEx.Global = False
        RegEx.MultiLine = False
        RegEx.Pattern = strPath
        
        blnTestString = RegEx.Test(strString)
    
    Set RegEx = Nothing

End Function

'********************************************************************
'*
'* Функция  : strExtractString (приватная)
'* Описание : Выделяет из строки подстроку, удовлетворяющую шаблону
'* Вход     : strString - строка
'*            strPath   - шаблон
'* Выход    : строка соответствущая шаблону
'*
'********************************************************************
Private Function strExtractString(ByVal strString, ByVal strPath)
Dim RegEx
Dim colMatches
Dim aMatch

    Set RegEx = CreateObject("VBScript.RegExp")
    
        RegEx.IgnoreCase = True
        RegEx.Global = False
        RegEx.MultiLine = False
        RegEx.Pattern = strPath
        
        Set colMatches = RegEx.Execute(strString)
            For Each aMatch In colMatches
                strExtractString = aMatch.Value
                Exit For
            Next

        Set colMatches = Nothing
    Set RegEx = Nothing

End Function






Это сообщение отредактировал(а) mihanik - 19.5.2008, 06:49


--------------------
Программистами не рождаются, - это родовая травма...
user posted imageuser posted image
PM MAIL WWW ICQ   Вверх
neo980
Дата 3.7.2008, 10:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 1
Друзей: 0; Групп: 0
Регистрация: 3.7.2008

Репутация: нет
Всего: нет
Доброго времени суток.
Помогите немного доработать скрипт запуска программы если она не запущена, просто этот скрипт выполняется на сервере терминалов и нужно чтобы он узнавал запущенный указанный процесс под локальным пользователем, а не пользователем терминала, и если он не запущен, то запускал его, вот код, который не просматривает кем запущен процесс:
Код

Option Explicit
Dim wmiObj, proCollection, scrShell
Set wmiObj = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set proCollection = wmiObj.ExecQuery("Select * from Win32_Process Where Name = '1cv7.exe'")
If proCollection.Count = 0 Then
    Set scrShell = CreateObject("WScript.Shell")
    scrShell.Run "1CV7s.exe enterprise /Di:\base /nadmin /ppass", 1
'Else
End If

Заранее благодарю
PM MAIL   Вверх
Akella
Дата 6.7.2008, 10:30 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Ситхи не пройдут
****


Профиль
Группа: Комодератор
Сообщений: 13830
Друзей: 20; Групп: 5
Регистрация: 14.5.2003
Где: Корусант

Репутация: 64
Всего: 243
http://www.osp.ru/win2000/2006/06/3274500/

Скрипт
Цитата

Поиск файлов по имени владельца



--------------------
мы не в ответе за тех, кого приручили
PM MAIL WWW   Вверх
Конструктор
Дата 7.11.2008, 18:35 (ссылка) | (голосов:2) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 642
Друзей: 0; Групп: 0
Регистрация: 12.5.2004
Где: Москва

Репутация: 2
Всего: 10
Скрипт, добавляет задание в стандартный шедулер windows. Еще кому-то отдельно может пригодиться функция TimeToUTC, конвертирующая время в формат UTC-WMI.

Код

Option Explicit
'Description:
'    Schedules job to standart windows task scheduler.
'
'
'Author:
'    Evgeniy Vigovskiy aka Konstructor
'
'
'Syntax: 
'    putscheduledjob.vbs </Exec:"Executable"> [/host:"hostname"] [/offset:"minutes"]
'
'
'Arguments:
'/Exec: executable - Program to schedule for launch
'
'/Host:computer name - The job will be added on the specified host. Default "."
'
'/Offset:minutes - Time in minutes to wait before launch. Job will be started
'         at Now + minutes. Don't use 0 here, or your task will be scheduled to
'         the next day. Default "1".
'
'
'History:
'    2008-07-11 - 1.0 - Intital release
'
'
'Reference:
'    MS Scriptng Guy: How Can I Manage Scheduled Tasks Using Scripts?
'    http://www.microsoft.com/technet/scriptcenter/resources/qanda/sept04/hey0922.mspx
'
'    MSDN: Create Method of the Win32_ScheduledJob Class
'    http://msdn.microsoft.com/en-us/library/aa389389(VS.85).aspx
'
'    Technet: Converting a Standard Date to a WMI Date-Time Format
'    http://www.microsoft.com/technet/scriptcenter/guide/sas_wmi_onfu.mspx?mfr=true
'
'    Technet: Converting WMI Dates to a Standard Date-Time Format
'    http://www.microsoft.com/technet/scriptcenter/guide/sas_wmi_yakv.mspx?mfr=true


Dim strComputer
Dim StorePath
Dim OutString
Dim strExecutable
Dim strOffset
Dim dtmLaunchTime
Dim strUTCLaunchTime
Dim objWMIService
Dim objNewJob
Dim intJobID
dim errJobCreated

'Parse arguments
If (WScript.Arguments.Named("Exec") <> "") then
    strExecutable = WScript.Arguments.Named("Exec")
Else
    WScript.Echo "-ERR: Executable not defined. Return code: 254"
    WScript.Quit 254
End if

If (WScript.Arguments.Named("Host") <> "") then
    strComputer = WScript.Arguments.Named("Host")
Else
    strComputer = "."
End if

If (WScript.Arguments.Named("Offset") <> "") then
    strOffset = WScript.Arguments.Named("Offset")
Else
    strOffset = "1"
End if

'Prepare for Job creation
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set objNewJob = objWMIService.Get("Win32_ScheduledJob")

'Calculate launch time
dtmLaunchTime = Now
dtmLaunchTime = DateAdd ("n" , cint(strOffset) , dtmLaunchTime)
strUTCLaunchTime = TimeToUTC(dtmLaunchTime , strComputer)

'Create Job
errJobCreated = objNewJob.Create _
    (strExecutable, strUTCLaunchTime , False , , , , intJobID)

'Handle creation errors        
Select case errJobCreated
    Case 0
        WScript.Echo "+OK: ID=" & intJobID & " EXEC=" & strExecutable & _
                     " UTC=" & strUTCLaunchTime
        WScript.Quit 0

    Case 1
        WScript.Echo "-ERR: The request is not supported. Return code: 1"
        WScript.Quit 1

    Case 2
        WScript.Echo "-ERR: The user does not have the necessary access. " & _
            "Return code: 2"
        WScript.Quit 2

    Case 8
        WScript.Echo "-ERR: Interactive process. Return code: 8"
        WScript.Quit 8

    Case 9
        WScript.Echo "-ERR: The directory path to the service executable file" & _ 
            "cannot be found. Return code: 9"
        WScript.Quit 9

    Case 21
        WScript.Echo "-ERR: Invalid parameters have been passed to the service." & _ 
            "Return code: 21"
        WScript.Quit 21

    Case 22
        WScript.Echo "-ERR: The account that this service runs under is invalid or" & _
            "lacks the permissions to run the service. Return code: 22"
        WScript.Quit 22

    Case Else
        WScript.Echo "-ERR: Unknown error. Return code: 253"
        WScript.Quit 253
End select

'Function converts standart time to WMI-UTC format.
'
'strComputer - computer to take timezone settings. "." is generally ok.
'dtmTime - standart date-time value to convert
'
'returns - string with time in UTC-WMI format, date value ommited
Function TimeToUTC(byval dtmTime , byval strComputer)
    Dim objWMIService
    Dim colTimeZone
    Dim objTimeZone
    Dim intOffset
    Dim strHours
    Dim strMinutes
    Dim strSeconds
    Dim strTimeZoneOffset

    Set objWMIService = GetObject("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

    Set colTimeZone = objWMIService.ExecQuery ("SELECT * FROM Win32_TimeZone")
    For Each objTimeZone in colTimeZone
        intOffset = objTimeZone.Bias
    Next
    
    strHours = cstr(Hour(dtmTime))
    If Len(strHours) < 2 Then strHours = "0" + strHours
    
    strMinutes = cstr(Minute(dtmTime))
    If Len(strMinutes) < 2 Then strMinutes = "0" + strMinutes

    strSeconds = cstr(Second(dtmTime))
    If Len(strSeconds) < 2 Then strSeconds = "0" + strSeconds

    
    If intOffset >= 0 then 
        strTimeZoneOffset = "+" & cstr(intOffset)
    Else
        strTimeZoneOffset = cstr(intOffset)
    End if
    
    TimeToUTC = "********" & strHours & strMinutes & strSeconds & ".000000" & strTimeZoneOffset
End function



Это сообщение отредактировал(а) Конструктор - 7.11.2008, 18:40
PM MAIL WWW ICQ   Вверх
Конструктор
Дата 8.11.2008, 23:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 642
Друзей: 0; Групп: 0
Регистрация: 12.5.2004
Где: Москва

Репутация: 2
Всего: 10
Если в том смысле "как запустить", то:

putscheduledjob.vbs </Exec:"программа"> [/host:"компьютер"] [/offset:"минуты"]

программа - та программа, которая будет запущена при исполнении задания
компьютер - локальный или удаленный компьютер, на котором будет добавлено задание. Можно не указывать, тогда будет локальный компьютер.
минуты - задания будет запускаться через указанное количество минут. Если сейчас 12-00, а в скрипт мы передадим 10, то задание будет запущено в 12-10. Конкретное время запуска устанавливать нельзя. Можно не указывать, тогда будет задержка в  1 минуту.

Если в том смысле, "зачем вообще нужен такой скрипт", то суть его в том, чтобы отсрочить выполнение logon-скриптов. Допустим кто-то написал ядреный скрип, который собирает кучу разной статистики с рабочей станции пользователя. Чтобы избежать тормозни при загрузке операционной системы в logon-скрипты в AD можно просто прописать этот скрипт, который при загрузке быстро создаст задание. Когда система загрузится, поднимет все службы и прекратит тормозить, запустится задание с более тяжелой нагрузкой.
PM MAIL WWW ICQ   Вверх
Конструктор
Дата 29.1.2009, 00:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 642
Друзей: 0; Групп: 0
Регистрация: 12.5.2004
Где: Москва

Репутация: 2
Всего: 10
Скрипт ищет неиспользуемые терминальные профили, перемещаемые профили, домашние папки и терминальные домашние папки. Правда помочь он может только в том случае, если разные типы профилей хранятся достаточно компактно, например все терминальные профили в папке \\server\termprofiles, перемещаемые \\server\profiles и т.д. Особенно полезен если при увольнении людей админу было лень вычищать и архивировать пользователские профили, а со временем их накопилось так много, что пытаться что-то расчищать смерти подобно. Скрипт просматривает указанную при запуске папку в которой хранятся например терминальные профили на предмет подпапок. Затем он рекурсивно перебирает всех пользователей в указанном OU и смотрит используются ли пользователями подпапки в качестве терминальных профилей. Если какая-либо подпапка не числится терминальным профилем ни у одного пользователя в OU, то она считается неиспользуемым профилем. То же самое для всех остальных типов профилей и домашних папок. Код довольно развесист и полон комментариев, поэтому я его приложу в виде файла.

Запуск: 
FindUnusedRemoteProfiles.vbs /Domain:"домен" /OU:"OU" [/TSProfiles:"путь"] [/TSHomes:"путь"] [/Profiles:"путь"] [/Homes:"путь"]

/Domain:"домен" - Имя домена. Например: mydomain.local будет "dc=mydomain,dc=local"

/OU:"OU" - OU для сканирования. Например: Users\Accounting будет "OU=Accounting,OU=Users"

Если не указывать нижеследующие параметры, соответствующие проверки проводиться не будут
/TSProfiles:"путь" - Путь к папке с терминальными профилями

/TSHomes:"путь" - Путь к папке с домашними каталогами терминальных пользователей

/Profiles:"путь" - Путь к папке с перемещаемыми профилями

/Homes:"путь" - Путь к папке с домашними каталогами пользователей


Это сообщение отредактировал(а) Конструктор - 29.1.2009, 16:39

Присоединённый файл ( Кол-во скачиваний: 2 )
Присоединённый файл  FindUnusedRemoteProfiles_1.0.zip 2,44 Kb
PM MAIL WWW ICQ   Вверх
Akella
Дата 2.4.2009, 15:01 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Ситхи не пройдут
****


Профиль
Группа: Комодератор
Сообщений: 13830
Друзей: 20; Групп: 5
Регистрация: 14.5.2003
Где: Корусант

Репутация: 64
Всего: 243
Подключение принтеров при входе пользователя



--------------------
мы не в ответе за тех, кого приручили
PM MAIL WWW   Вверх
mihanik
Дата 18.5.2009, 20:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


-=Белый Медведь=-
****


Профиль
Группа: Комодератор
Сообщений: 2972
Друзей: 1; Групп: 1
Регистрация: 24.4.2006
Где: г. Тверь

Репутация: 46
Всего: 79
Конструктор, с шедулером это ты круто...

А чем тебе Schtasks  не понравилась?

http://www.windowsfaq.ru/content/view/83/37/


--------------------
Программистами не рождаются, - это родовая травма...
user posted imageuser posted image
PM MAIL WWW ICQ   Вверх
Akella
Дата 17.11.2009, 23:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Ситхи не пройдут
****


Профиль
Группа: Комодератор
Сообщений: 13830
Друзей: 20; Групп: 5
Регистрация: 14.5.2003
Где: Корусант

Репутация: 64
Всего: 243
Работа с сетевыми принтерами
http://forum.vingrad.ru/index.php?showtopi...t&p=2023290


--------------------
мы не в ответе за тех, кого приручили
PM MAIL WWW   Вверх
mihanik
Дата 24.11.2009, 15:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


-=Белый Медведь=-
****


Профиль
Группа: Комодератор
Сообщений: 2972
Друзей: 1; Групп: 1
Регистрация: 24.4.2006
Где: г. Тверь

Репутация: 46
Всего: 79
Закачивание файлов через HTTP посредством VBS

http://forum.vingrad.ru/index.php?showtopi...t&p=2029240

 smile 



--------------------
Программистами не рождаются, - это родовая травма...
user posted imageuser posted image
PM MAIL WWW ICQ   Вверх
mihanik
Дата 11.12.2009, 20:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


-=Белый Медведь=-
****


Профиль
Группа: Комодератор
Сообщений: 2972
Друзей: 1; Групп: 1
Регистрация: 24.4.2006
Где: г. Тверь

Репутация: 46
Всего: 79
Отправка почты из VBS

http://forum.vingrad.ru/index.php?showtopi...t&p=2044502



--------------------
Программистами не рождаются, - это родовая травма...
user posted imageuser posted image
PM MAIL WWW ICQ   Вверх
mihanik
Дата 16.12.2009, 19:16 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


-=Белый Медведь=-
****


Профиль
Группа: Комодератор
Сообщений: 2972
Друзей: 1; Групп: 1
Регистрация: 24.4.2006
Где: г. Тверь

Репутация: 46
Всего: 79
Код

'********************************************************************
'*
'*  Функция   : EventsList
'*  Описание  : Возвращает список событий указанного типа за указанный день.
'*  Вход      : 
'*            strDay - дата, за которую собираются события.
'*                     Дата указывается в формате "15-12-2009"
'*
'*          strLogfile - тип журнала
'*                    System - "система"
'*                    Application - "приложение"
'*
'*
'*            intEventsType - тип возвращаемых событий
'*
'*                    1 - Error 
'*                    2 - Warning 
'*                    3 - Information 
'*                    4 - Security audit success 
'*                    5 - Security audit failure
'* 
'*  Выход     : текстовая строка
'*
'********************************************************************
Function EventsList (byval strDay, byval strLogfile, byval intEventsType)

Const CONVERT_TO_LOCAL_TIME = True

Dim dtmStartDate, dtmEndDate, DateToCheck, WMIDateToString, strS

strS= ""

    Set dtmStartDate = CreateObject("WbemScripting.SWbemDateTime")
    Set dtmEndDate = CreateObject("WbemScripting.SWbemDateTime")
        DateToCheck = CDate(strDay)
        dtmStartDate.SetVarDate DateToCheck, CONVERT_TO_LOCAL_TIME
        dtmEndDate.SetVarDate DateToCheck + 1, CONVERT_TO_LOCAL_TIME
        
        Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
        Set colEvents = objWMIService.ExecQuery _
            ("Select * from Win32_NTLogEvent Where Logfile = '" & strLogfile & "' " _
            & "and EventType = " & intEventsType _
            & " and TimeWritten >= '" & dtmStartDate & "' and TimeWritten < '" & dtmEndDate & "'") 
        
            For Each objEvent in colEvents
                strS = strS & "Category: " & objEvent.Category & vbcrlf
                strS = strS & "Computer Name: " & objEvent.ComputerName & vbcrlf
                strS = strS & "Event Code: " & objEvent.EventCode & vbcrlf
                strS = strS & "Message: " & objEvent.Message & vbcrlf
                strS = strS & "Record Number: " & objEvent.RecordNumber & vbcrlf
                strS = strS & "Source Name: " & objEvent.SourceName & vbCrLf
                WMIDateToString =    Mid(objEvent.TimeWritten, 7, 2) & "-" & _
                                 Mid(objEvent.TimeWritten, 5, 2) & "-" & _
                                 Left(objEvent.TimeWritten, 4)
                strS = strS & "Time Written: " & WMIDateToString& vbcrlf
                strS = strS & "Event Type: " & objEvent.Type & vbcrlf
                strS = strS & "User: " & objEvent.User & vbcrlf
                strS = strS & objEvent.LogFile & vbCrLf & vbcrlf
            Next
    
    Set dtmStartDate = Nothing
    Set dtmEndDate = Nothing

EventsList = strS

End Function



Пример использования

Код

WScript.Echo EventsList ("14-12-2009", "System", 2 )



--------------------
Программистами не рождаются, - это родовая травма...
user posted imageuser posted image
PM MAIL WWW ICQ   Вверх
mihanik
Дата 16.12.2009, 22:08 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


-=Белый Медведь=-
****


Профиль
Группа: Комодератор
Сообщений: 2972
Друзей: 1; Групп: 1
Регистрация: 24.4.2006
Где: г. Тверь

Репутация: 46
Всего: 79
Стартовый скрипт. в помощь системному администратору/

Алгоритм работы (упрощённо) следующий:
1. Проверяем, а запускался ли скрипт сегодня...
2. Проверяем наличие папки C:\Log, в том случае, если папка отсутствует, создаём её.
3. Получаем список всех установленных на компьютере программ
4. Проверяем, установлен ли на компьютере антивирус от Microsoft
5. При необходимости устанавливаем обновления для Microsoft Security Essentials
6. Получаем список нужных событий за предыдущий день и отправляем их системному администратору по почте
(у меня в офисе свой почтовый сервачок...)

http://forum.vingrad.ru/forum/act-ST/f-28/...4/unread-1.html



--------------------
Программистами не рождаются, - это родовая травма...
user posted imageuser posted image
PM MAIL WWW ICQ   Вверх
Google
  Дата 2.9.2010, 22:40 (ссылка)  





  Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Windows"
December
bartram
Akella

Запрещается!

1. Обсуждать взлом и делиться кряками

2. Способствовать созданию и распространению вирусов

  • Для бессмертных бородатых вопросов типа Win vs Nix есть специальный форум Религиозные Войны
  • Несанкционированная реклама на форуме запрещена
  • Пожалуйста, давайте своим темам осмысленный, информативный заголовок. Вопль "Помогите!" таковым не является.
  • Чем полнее и яснее Вы изложите проблему, тем быстрее мы её решим.
  • ВСЕГДА УКАЗЫВАЙТЕ ВЕРСИЮ ОС

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, December, bartram, Akella.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | MS Windows | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 


Rambler's Top100

[ Время генерации скрипта: 0.7610 ]   [ Использовано запросов: 43 ]   [ GZIP включён ]


Реклама на сайте

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Хостинг: Vingrad Hosting     Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.