[Script] VBScript definir Papel de parede com base na resolução da tela

Scripts diversos para automatizar tarefas em servidores ou auxilio com tarefas administrativas.
Avatar do usuário
marceloleaes
Administrator
Administrator
Mensagens: 1516
Registrado em: 10 Jun 2013 12:45
Localização: Novo Hamburgo
Idade: 41
Contato:
Status: Offline

[Script] VBScript definir Papel de parede com base na resolução da tela

Mensagem por marceloleaes »

Olá,

Segue abaixo o vbscript definitivo para automatizar o processo de atribuição do wallpaper para as estações Windows XP / 7 / 8.

Esse vbscript atende todas as resoluções de tela, (incluindo as resoluções das conexões via TS que sempre foge do padrão como por exemplo 1364X768 - 1280X960)

VBScript em três etapas:

1. Detectar a resolução de tela atual.
2. Copia o papel de parede para a máquina local.
3. Definir o papel de parede como padrão.

IMPORTANTE:

Apenas os campos em vermelho deverão ser preenchido com suas informações, no exemplo abaixo usarei as informações a seguir como padrão:

C:\MeuSistema\Wallpaper
Local onde será guardado o papel de parede (máquina local).

\\SERVIDOR\DIVERSOS\WALLPAPER
Local onde está armazenados todos os papéis de parede disponíveis e com suas respectivas resoluções.

Blue_ (resolução) .bmp
Nome do meu papel de parede;

Obs.: Todos os wallpapers deverão ter o mesmo padrão de nome mudando apenas a resolução.

Ex: Blue_1366x768.bmp
Blue_1024x768.bmp
Blue_1280x1024.bmp
Blue_800x600.bmp

Conteúdo do script:

Código: Selecionar todos

'1 - Detectar a resolução atual da tela

dim filesys

set filesys=CreateObject("Scripting.FileSystemObject")
Set objSh = CreateObject("Wscript.Shell")

ScreenRes = funcScreenResolution()
Function funcScreenResolution()
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Navigate("about:blank")
Do Until objIE.readyState = 4: Loop
width = objIE.document.ParentWindow.screen.width
height = objIE.document.ParentWindow.screen.height
objIE.Quit
funcScreenResolution = array(width,height)
End Function

strRes = ScreenRes(0) & "x" & ScreenRes(1)
'wscript.echo "Resolução = " & strRes

'2 – Criar a pasta, subpasta e copiar o wallpaper para o computador local.

On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.CreateFolder("C:\MeuSistema\")
Set objFolder = objFSO.CreateFolder("C:\MeuSistema\Wallpaper\")

strWallpaperPath = "\\SERVIDOR\DIVERSOS\WALLPAPER\Blue_" & strRes & ".bmp"

filesys.CopyFile strWallpaperPath, "C:\MeuSistema\Wallpaper\"


'3 – define o wallpaper como padrão

sWallPaper = "C:\MeuSistema\Wallpaper\\Blue_" & strRes & ".bmp"

' update in registry
 objSh.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", sWallPaper
objSh.Regwrite "HKCU\Software\Microsoft\Internet Explorer\Desktop\General\Wallpaper", sWallPaper
objSh.Regwrite "HKCU\Software\Microsoft\Internet Explorer\Desktop\General\BackupWallpaper", sWallPaper
' let the system know about the change
objSh.Run "%windir%\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
Autor: FORJABAHIA


"Transportai um punhado de terra todos os dias e fareis uma montanha." Confúcio

Voltar para “Scripts”