- Сообщения
 - 8,143
 
- Решения
 - 27
 
- Реакции
 - 6,959
 
А) Тест без повышения привилегий - архив Test_Script_Host_2.zip
1. Скачайте приложенный архив.
2. Распакуйте.
3. Запустите файл Test_Script_Host.cmd
4. Выложите в теме содержимое файла(ов) Host_log_x....txt (будет создан рядом со скриптом).
Б) Тест с повышением привилегий - архив Test_Script_Host.zip
1. Скачайте приложенный архив.
2. Распакуйте.
3. Запустите файл Test_Script_Host.vbs
4. Подтвердите кнопкой "Да" вопрос из диалогового окна "Контроль учетных записей"
5. Выложите в теме содержимое файла Host_log.txt (будет создан рядом со скриптом).
На исправной системе (Windows Vista и выше) лог будет выглядеть так:
	
	
		
			
	
	
	
		
			
	
	
	
		
		
	
	
		
			
		
		
	
				
			1. Скачайте приложенный архив.
2. Распакуйте.
3. Запустите файл Test_Script_Host.cmd
4. Выложите в теме содержимое файла(ов) Host_log_x....txt (будет создан рядом со скриптом).
Б) Тест с повышением привилегий - архив Test_Script_Host.zip
1. Скачайте приложенный архив.
2. Распакуйте.
3. Запустите файл Test_Script_Host.vbs
4. Подтвердите кнопкой "Да" вопрос из диалогового окна "Контроль учетных записей"
5. Выложите в теме содержимое файла Host_log.txt (будет создан рядом со скриптом).
На исправной системе (Windows Vista и выше) лог будет выглядеть так:
WScript.Shell Object - OK.
Shell.Application Object - OK.
WScript.Network Object - OK.
ADODB.Stream Object - OK.
WMI Object - OK.
RegWrite Admin. - FAILED: -2147024891-Неверная ссылка на корень в разделе реестра "HKLM\SOFTWARE\Elevation_Test\".
===============================
WScript.Shell Object - OK.
Shell.Application Object - OK.
WScript.Network Object - OK.
ADODB.Stream Object - OK.
WMI Object - OK.
RegWrite Admin. - OK.
===============================
WScript.Shell Object - OK.
Shell.Application Object - OK.
WScript.Network Object - OK.
ADODB.Stream Object - OK.
WMI Object - OK.
All tests compeleted.
		Shell.Application Object - OK.
WScript.Network Object - OK.
ADODB.Stream Object - OK.
WMI Object - OK.
RegWrite Admin. - FAILED: -2147024891-Неверная ссылка на корень в разделе реестра "HKLM\SOFTWARE\Elevation_Test\".
===============================
WScript.Shell Object - OK.
Shell.Application Object - OK.
WScript.Network Object - OK.
ADODB.Stream Object - OK.
WMI Object - OK.
RegWrite Admin. - OK.
===============================
WScript.Shell Object - OK.
Shell.Application Object - OK.
WScript.Network Object - OK.
ADODB.Stream Object - OK.
WMI Object - OK.
All tests compeleted.
		VB.NET / VBA:
	
	
	Option Explicit
On Error Resume Next
Const DQ = """", SP = " ", BS = "\"
Dim ScriptPath: ScriptPath = WScript.ScriptFullname: ScriptPath = left(ScriptPath, instrrev(ScriptPath, "\"))
'Дозапись в протокол
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim TS: Set TS = FSO.OpenTextFile(ScriptPath & "Host_log.txt", 8, True)
Dim oShell: Set oShell = CreateObject("WScript.Shell")
AddtoLog Err, "WScript.Shell Object"
Dim oShellApp: Set oShellApp = CreateObject("Shell.Application")
AddtoLog Err, "Shell.Application Object"
Dim oNetwork: Set oNetwork = CreateObject("WScript.Network")
AddtoLog Err, "WScript.Network Object"
Dim oADO: Set oADO = CreateObject("ADODB.Stream")
AddtoLog Err, "ADODB.Stream Object"
Test_WMI()
'Проверка админ. привилегии
Dim AdminKey: AdminKey = "HKLM\SOFTWARE\Elevation_Test\"
'Если уже есть значение, то скрипт дважды перезапустился
Err.Clear
Dim Status: Status = oShell.RegRead(AdminKey)
if err = 0 then
   TS.WriteLine "All tests compeleted."
   oShell.RegDelete AdminKey
   WScript.Quit
else
   Err.Clear
end if
'Пытаемся записать ключ
oShell.RegWrite AdminKey, "1"
'Если успех
AddToLog Err, "RegWrite Admin."
Dim isAdmin
if Err = 0 then isAdmin = true else Err.Clear
TS.WriteLine "==============================="
'Если привилегия еще не получена
if not isAdmin then
   'Запуск через GUI Host
  oShellApp.ShellExecute oShell.ExpandEnvironmentStrings("%WinDir%\system32\wscript.exe"), DQ & WScript.ScriptFullName & DQ, "", "runas", 1
   WScript.Quit
else
   'Запуск через Console Host
  oShellApp.ShellExecute oShell.ExpandEnvironmentStrings("%WinDir%\system32\cscript.exe"), DQ & WScript.ScriptFullName & DQ, "", "runas", 1
   WScript.Quit
End If
Function AddtoLog(oErr, Source)
   if oErr.Number = 0 then
     TS.WriteLine Source & " - OK."
   else
     TS.WriteLine Source & " - FAILED: " & oErr.Number & "-" & oErr.Description
   end if
  if oErr <> 0 then Err.Clear
End function
Function Test_WMI()
   Dim colOS: Set colOS = GetObject("winmgmts:\root\cimv2").ExecQuery("Select * from Win32_OperatingSystem")
   AddtoLog Err, "WMI Object"
   Dim oOS
   For Each oOS In colOS
    strOSLong = oOS.Version
   Next
   TS.WriteLine "OS: " & strOSLong
End Function
	Вложения
			
				Последнее редактирование: 
			
		
	
								
								
									
	
		
			
		
		
	
	
	
		
			
		
		
	
								
							
							