Цитата:
Цитата sergeosn
А у Вас случайно нет кодика для второй задачи. про реестр? »
|
Как-то так (проверял на 2008/7 Pro, но не очень тщательно, особенно то, что касается универсальных масок):
Код:
Dim strComputer, strKeyPath, lngKey, xResult, strDescription
'--- Коды ключей реестра
Const HKCR = &H80000000 'HKEY_CLASSES_ROOT
Const HKCU = &H80000001 'HKEY_CURRENT_USER
Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
Const HKU = &H80000003 'HKEY_USERS
'------
strComputer = "computer"
strKeyPath = "Software"
lngKey = HKLM
If Ping_GUI(strComputer) Then
xResult = Get_DACLInfo_Reg(strComputer, lngKey, strKeyPath, strDescription)
If IsNull(xResult) Then
WScript.Echo "Не поддерживаемая версия ОС."
ElseIf IsEmpty(xResult) Then
WScript.Echo "Подключ " & UCase(strKeyPath) & " не найден."
ElseIf IsNumeric(xResult) Then
WScript.Echo "Ошибка " & xResult & vbNewLine & strDescription
ElseIf Len(xResult) = 0 Then
WScript.Echo "Список управления доступом к подключу " & UCase(strKeyPath) & " пуст."
Else
WScript.Echo xResult
End If
Else
WScript.Echo "Станция " & UCase(strComputer) & " не отвечает или не существует."
End If
WScript.Quit 0
'======
Function Get_DACLInfo_Reg(strWS, lngKey, strSubKey, strComment)
Dim objWMI, objCollection, objItem, intOSVersion
Dim arrFlagName, arrFlagValue, arrGenericName, arrGenericValue, arrTypes, arrSubKeys
Dim objSD, intRes, strList, strTemp, lngTemp, blnContinue
Const ACCESS_ALLOWED_ACE_TYPE = 0 'Флаг-признак записи типа "РАЗРЕШЕНИЕ"
Const ACCESS_DENIED_ACE_TYPE = 1 'Флаг-признак записи типа "ЗАПРЕТ"
Const INHERITED_ACE = 16 'Флаг-признак того, что текущая запись DACL унаследована от родительского объекта
Const FULL_ACCESS = 983103 'Значение маски полного разрешения или запрета
arrTypes = Array("РАЗРЕШЕНО:", "ЗАПРЕЩЕНО:")
arrFlagName = Array("Запрос значения", "Задание значения", _
"Создание подраздела", "Перечисление подразделов", _
"Уведомление", "Создание связи", "Удаление", "Запись DAC", _
"Смена владельца", "Чтение разрешений")
arrFlagValue = Array(1, 2, 4, 8, 16, 32, 65536, 262144, 524288, 131072)
'--- Наименования и значения универсальных масок
arrGenericName = Array("Полный доступ (универсальная маска)", "Выполнение (универсальная маска)", "Запись (универсальная маска)", "Чтение (универсальная маска)")
arrGenericValue = Array(&H10000000, &H20000000, &H40000000, &H80000000)
'------
'--- Определение версии ОС
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strWS & "\root\cimv2")
If Err.Number = 0 Then
Set objCollection = objWMI.ExecQuery("SELECT Version FROM Win32_OperatingSystem")
If Err.Number = 0 Then
For Each objItem In objCollection
intOSVersion = CInt(Replace(Left(objItem.Version, 3), ".", ""))
Next
Else
Err.Clear
End If
Set objCollection = Nothing
Else
Err.Clear
End If
'------
If intOSVersion >= 60 Or IsEmpty(intOSVersion) Then
On Error Resume Next
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strWS & "\root\default:StdRegProv")
If Err.Number = 0 Then
If InStr(strSubKey, "\") > 0 Then
strTemp = Left(strSubKey, InStrRev(strSubKey, "\") - 1)
objWMI.EnumKey lngKey, strTemp, arrSubKeys
Else
objWMI.EnumKey lngKey, vbNullString, arrSubKeys
End If
If Err.Number = 0 Then
If IsArray(arrSubKeys) Then
If InStr(1, Join(arrSubKeys, vbNewLine), Split(strSubKey, "\")(UBound(Split(strSubKey, "\"))), vbTextCompare) > 0 Then
blnContinue = True
Else
Get_DACLInfo_Reg = Empty
End If
Else
Get_DACLInfo_Reg = Empty
End If
Else
strComment = Err.Description
Get_DACLInfo_Reg = Err.Number
Err.Clear
End If
If blnContinue Then
intRes = objWMI.GetSecurityDescriptor(lngKey, strSubKey, objSD)
If Err.Number = 0 Then
If intRes = 0 Then
If Not IsNull(objSD.DACL) Then
For Each objItem In objSD.DACL
'--- Определение режима наследования записи, области её действия и типа
If CBool(objItem.AceFlags And INHERITED_ACE) Then
strTemp = " (унаследовано; "
lngTemp = objItem.AceFlags - INHERITED_ACE
Else
strTemp = " (не унаследовано; "
lngTemp = objItem.AceFlags
End If
Select Case lngTemp
Case 0: strTemp = strTemp & "действует на: только текущий раздел)"
Case 2: strTemp = strTemp & "действует на: текущий раздел и его подразделы)"
Case 6, 14: strTemp = strTemp & "действует на: только ближайший подраздел текущего раздела)"
Case 10: strTemp = strTemp & "действует на: только подразделы текущего раздела)"
Case Else: strTemp = strTemp & "область действия не определена); "
End Select
strTemp = strTemp & vbNewLine & "---" & vbNewLine & arrTypes(objItem.AceType) & vbNewLine
'------
'--- Анализ маски доступа текущей записи
lngTemp = objItem.AccessMask
Select Case Abs(lngTemp)
Case FULL_ACCESS: strTemp = strTemp & "Полный доступ" & vbNewLine
Case Else
'обобщённый анализ вариантов универсальных масок (биты №№ 28 - 31)
If Abs(lngTemp) > FULL_ACCESS Then
For i = 0 To UBound(arrGenericValue)
If lngTemp And arrGenericValue(i) Then
strTemp = strTemp & arrGenericName(i) & vbNewLine
End If
Next
End If
'детальный анализ не универсальной маски (биты №№ 0 - 20)
For i = 0 To UBound(arrFlagValue)
If lngTemp And arrFlagValue(i) Then
strTemp = strTemp & arrFlagName(i) & vbNewLine
End If
Next
End Select
'------
strList = strList & UCase(objItem.Trustee.Domain & "\" & objItem.Trustee.Name) & strTemp & "===" & vbNewLine
Next
Set objItem = Nothing
Get_DACLInfo_Reg = strList
Else
Get_DACLInfo_Reg = vbNullString
End If
Set objSD = Nothing
Else
Get_DACLInfo_Reg = intRes
Err.Clear
End If
Else
strComment = Err.Description
Get_DACLInfo_Reg = Err.Number
Err.Clear
End If
End If
Else
strComment = Err.Description
Get_DACLInfo_Reg = Err.Number
Err.Clear
End If
Else
Get_DACLInfo_Reg = Null
End If
Set objWMI = Nothing
End Function
'======
Function Ping_GUI(strName)
Dim objWMI, objItem
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address='" & strName & "'")
For Each objItem In objWMI
If IsNull(objItem.StatusCode) Or objItem.StatusCode <> 0 Then
Ping_GUI = False
Else
Ping_GUI = True
End If
Next
Set objItem = Nothing
Set objWMI = Nothing
End Function
|
