[mwz]

А начиная с вин 10 1803 защитник скрипт считает вирусом и удаляет »

А добавить его Защитнику в непроверяемые?

[James Marsh]

А какой код? »

cmd-конструкция

Код:

@echo off
setlocal enableextensions enabledelayedexpansion
mshta "javascript: var o = new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1); o.Write(screen.width); o.Write('_' + screen.height); close()" 1 >> z:\scr_resolution.txt
CScript \\10.17.11.21\scripts\wallpaper_srv.vbs //NoLogo
\\10.17.11.21\scripts\bginfo\bginfo.exe \\10.17.11.21\scripts\bginfo\init.bgi /timer:0 /SILENT /NOLICPROMPT
del z:\scr_resolution.txt
endlocal
exit /b 0

wallpaper_srv.vbs

Код:

Dim fso, ts, scrres
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile("z:\scr_resolution.txt", 1)
  scrres = ts.ReadLine
	filename = "\\10.17.11.21\scripts\wlp\" & scrres & ".bmp"
 	'msgbox (filename)



Set wshShell = WScript.CreateObject("WScript.Shell")
 
	Set oShell = CreateObject("WScript.Shell")

	Set oFSO = CreateObject("Scripting.FileSystemObject")
 
	sWinDir = oFSO.GetSpecialFolder(0)

	If oFSO.FileExists(filename) Then

		oShell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", filename
		oShell.RegWrite "HKCU\Control Panel\Desktop\TileWallpaper", 0
		oShell.RegWrite "HKCU\Control Panel\Desktop\WallpaperStyle", 2
 
		oShell.Run "%windir%\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
	Else 
	 	msgbox ("Скажите системному администратору обои рабочего стола для разрешения экрана " & scrres & " отсутствует!")
	End If

А защитник ругается на mshta

Хотя, положа руку на сердце, скажу что данный велосипед устарел. Писался он когда был зоопарк мониторов и ноутбуков различного разрешения:



И так как сейчас 95% экранов фуллхд, то здается мне, что можно этот вЭлосЫпЭд как-то переписать, что бы убрать кусок определяющий, и считывающий разрешение экрана.

Вот кстати, как ругается

[Busla]

James Marsh, а чем

Код:

wmic DESKTOPMONITOR GET ScreenHeight

не устроил?

[mwz]

А защитник ругается на mshta »

Так как насчёт добавления его в исключения?
Как раз сегодня, даже для использования GPO годится: http://forum.oszone.net/thread-339118.html

[James Marsh]

wmic DESKTOPMONITOR GET ScreenHeight не устроил? »

А я про него в первый раз слышу. Поцацкаемся...

Тьфу, блин. А шо я мучаюсь? Экраны то все фуллхд... накой мне проверка разрешения? Я же могу в вбс-скрипте прямо файл обоев прописать и морочить себе голову.

[Iska]

James Marsh, нет никакой нужды в mshta.exe:

Код:

Option Explicit

' Раз:
With WScript.CreateObject("htmlfile")
	.open
	.close
	
	With .parentWindow.screen
		WScript.Echo .width & "x" & .height
	End With
End With

' Два (вариант коллеги Busla):
Dim objSWbemObjectEx

For Each objSWbemObjectEx In WScript.CreateObject("WbemScripting.SWbemLocator").ConnectServer(".", "root\cimv2").ExecQuery("SELECT * FROM Win32_DesktopMonitor")
	With objSWbemObjectEx
		WScript.Echo .ScreenWidth & "x" & .ScreenHeight
	End With
Next

WScript.Quit 0

wallpaper_srv.vbs »

Примерно так:

Код:

Option Explicit

Const strRegistryPath    = "HKCU\Control Panel\Desktop"
Const strPath2Wallpapers = "\\10.17.11.21\scripts\wlp"

Dim strWallpaperFile


With WScript.CreateObject("htmlfile")
	.open
	.close
	
	With .parentWindow.screen
		strWallpaperFile = strPath2Wallpapers & "\" & CStr(.width) & "x" & CStr(.height) & ".bmp"
	End With
End With

If Not WScript.CreateObject("Scripting.FileSystemObject").FileExists(strPath2Wallpapers) Then
	With WScript.CreateObject("WScript.Shell")
		.RegWrite strRegistryPath & "\Wallpaper",      strWallpaperFile
		.RegWrite strRegistryPath & "\TileWallpaper",  0
		.RegWrite strRegistryPath & "\WallpaperStyle", 2
		
		.Run """rundll32.exe"" user32.dll,UpdatePerUserSystemParameters", 0, True
	End With
Else
	WScript.Echo "Can't find valid wallpaper's file [" & strWallpaperFile & "]."
	WScript.Quit 1
End If

WScript.Quit 0

А ежели ещё предварительно подготовить где-нибудь там же, в strPath2Wallpapers, одиннадцать графических файлов, десять с цифирью и один с точкой, то можно будет тем же скриптом посредством библиотеки WIA 2.0 самостоятельно лепить IP-адрес поверх обоев, без участия BGInfo (можно, конечно, и прямо рисовать на векторе картинки поточечно, но уж больно много возни выйдет).

[James Marsh]

Спасибо, по свободе на буднях попробую ваши конструкции. Отпишусь по результату.

[James Marsh]

В обчем, так как парк экранов на 99% - фуллхд, то я просто урезал vbs

Код:

Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Set wshShell = WScript.CreateObject("WScript.Shell")
Set oShell = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
sWinDir = oFSO.GetSpecialFolder(0)
filename = "\\10.19.11.21\_scripts\wlp\1920_1080.bmp"
oShell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", filename
		oShell.RegWrite "HKCU\Control Panel\Desktop\TileWallpaper", 0
		oShell.RegWrite "HKCU\Control Panel\Desktop\WallpaperStyle", 2
 
oShell.Run "%windir%\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True

и запихнул его в логон-скрипт групповой политикой. Ну и рядом cmd для bginfo.

Код:

\\10.19.11.21\scripts\bginfo\bginfo.exe \\10.19.11.21\scripts\bginfo\init.bgi /timer:0 /SILENT /NOLICPROMPT

В опчем с пивом покатит. Все равно это не самая глобальная проблема, которая на повестке дня. Фсем спасибо.