Форум технической поддержки Компьютерного сервиса ИТ Консалт.
 
ФорумФорум  ПорталПортал  КалендарьКалендарь  ЧаВоЧаВо  ПоискПоиск  ПользователиПользователи  ГруппыГруппы  РегистрацияРегистрация  Вход  

Поделиться | 
 

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

Перейти вниз 
АвторСообщение
ХаЦкер
Хранитель
avatar

Мужчина
Количество сообщений : 33
Возраст : 38
Географическое положение : Просторы интернета
Настроение : Пока оно есть, отличное!
Дата регистрации : 2008-04-19

СообщениеТема: Полезные скрипты!   Сб Апр 19, 2008 10:03 pm

Цитата :
' Скрипт для получения серийных номеров ОС 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
Вернуться к началу Перейти вниз
Посмотреть профиль
ХаЦкер
Хранитель
avatar

Мужчина
Количество сообщений : 33
Возраст : 38
Географическое положение : Просторы интернета
Настроение : Пока оно есть, отличное!
Дата регистрации : 2008-04-19

СообщениеТема: Re: Полезные скрипты!   Сб Апр 19, 2008 10:05 pm

Цитата :
' Скрипт осуществляет инвентаризацию установленных программ на компьютерах
' локальной сети
' Процедура 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
Вернуться к началу Перейти вниз
Посмотреть профиль
Jaath
Admin
avatar

Мужчина
Количество сообщений : 263
Возраст : 35
Дата регистрации : 2008-04-19

СообщениеТема: Re: Полезные скрипты!   Сб Апр 19, 2008 11:38 pm

Цитата :
Ну неплохо не плохо)
Вернуться к началу Перейти вниз
Посмотреть профиль http://multi.2x2forum.ru
Спонсируемый контент




СообщениеТема: Re: Полезные скрипты!   

Вернуться к началу Перейти вниз
 
Полезные скрипты!
Вернуться к началу 
Страница 1 из 1

Права доступа к этому форуму:Вы не можете отвечать на сообщения
ИТ Консалт :: Тех поддержка ИТ Консалт :: Софт \Windows\-
Перейти: