none
VB Script Help/Questions RRS feed

  • Question

  • Hello, we have a vbscript that controls desktop wallpapers on our client machines.  We have a GPO that deploys this script to all clients.  I recently changed the desktop background and replaced the images that the vbscript calls on.  I used the exact same names, so nothing in the script changed.  Windows 10 machines seem to be updating without any problems, but Windows 7 machines are displaying a black background.  What I'm finding is that the script is not copying the files down to the client as designed.  If I manually delete the existing backgrounds on the client and run the script, it then copies the new files down, but it STILL doesn't apply the background.  If I go into the Control Panel display settings, I can see the background listed as an "Unsaved Theme", and it's selected but the wallpaper is still black.  When I simply click on the theme again, it then applies the background.

    I have very little experience with VB and the previous engineer who wrote this is no longer here, so I'm not sure if there's something I'm missing here.  The script is below.  Any help would be appreciated.

    Dim WshShell, wpFile, wpStyle, dWidth, dHeight, lngSuccess, dProd, WVersion, filesys
    
    '-------------------------------------Registry Key Function----------------------------------------
    
     Function RegistryKeyExists(LNGHKEY, strKey, strSubkey)
         Const HKLM = &H80000002
         Const HKCR = &H80000000
         Const HKCU = &H80000001
         Const HKUSERS = &H80000003
         RegistryKeyExists = False
         Dim reg, aSubkeys, s, hkroot
         If LNGHKEY = "HKLM" Then hkRoot = HKLM
         If LNGHKEY = "HKCU" Then hkRoot = HKCU
         If LNGHKEY = "HKCR" Then hkRoot = HKCR
         If LNGHKEY = "HKUSERS" Then hkRoot = HKUSERS
         Set reg = GetObject("WinMgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
         reg.EnumKey hkroot, strKey, aSubkeys
         If Not IsNull(aSubkeys) Then
             For Each s In aSubkeys
                 If lcase(s)=lcase(strSubkey) Then
                     RegistryKeyExists = True
                     Exit Function
                 End If
             Next
         End If
     End Function   
     
     
    set WshShell = CreateObject("Wscript.Shell")
    set filesys=CreateObject("Scripting.FileSystemObject")
    
    wpStyle = 2
    
    set objIe = createObject("internetexplorer.application")
    
    with objIe
    	.navigate "about:blank"
    	with .document.parentWindow.screen
    	dWidth = .width
    	dHeight = .height
    	end with
    end with	
    
    appDataPath = WshShell.ExpandEnvironmentStrings("%APPDATA%")
    pathToCopyTo = appDataPath & "\CCHCTheme\"
    ThemePath = pathToCopyTo & "CCHC-Standard.bmp"
    If (filesys.FolderExists(pathToCopyTo)) Then
    
    	else
    	  Filesys.CreateFolder(pathToCopyTo)
    	end if
    
    	
    	If filesys.FileExists(ThemePath) Then
    
       	ELSE
    		filesys.CopyFile"\\cchdomain1\netlogon\theme\CCHC-Standard1.bmp", pathToCopyTo
    		filesys.CopyFile"\\cchdomain1\netlogon\theme\CCHC-Widescreen1.bmp", pathToCopyTo
    	End If
    
    dProd = dWidth/dHeight
    
    ' WVersion = WshShell.RegRead ("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName")
    
    	If dProd <= 1.4 Then
    		wpFile = "\\cchdomain1\netlogon\theme\CCHC-Standard1.bmp"
    	Else	
    		wpFile = "\\cchdomain1\netlogon\theme\CCHC-Widescreen1.bmp"
    	End If
    
    	WshShell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper",wpFile
    	WshShell.RegWrite "HKCU\Control Panel\Desktop\WallpaperStyle",wpStyle
    
    		
    	If (filesys.FolderExists("C:\SaberCom")) Then
    
    	else
    	  Filesys.CreateFolder("C:\SaberCom")
    	  Filesys.CreateFolder("C:\SaberCom\ssmedia")	
    	end if
    
    	
    	If filesys.FileExists("C:\Sabercom\cchc-sabsav.scr") Then
    
       	ELSE
    		filesys.CopyFile"\\cchdomain1\Netlogon\Theme\SaberCom\*.*", "c:\SaberCom\"
    		filesys.CopyFile "\\cchdomain1\Netlogon\Theme\SaberCom\ssmedia\*.*", "c:\SaberCom\ssmedia\"
    
    	End If
    
    WshShell.RegWrite "HKCU\Control Panel\Desktop\SCRNSAVE.EXE", "C:\Sabercom\cchc-sabsav.scr"
    WshShell.RegWrite "HKCU\Control Panel\Desktop\ScreenSaveTimeout", 600
    WshShell.RegWrite "HKCU\Control Panel\Desktop\ScreenSaverIsSecure", 0
    WshShell.RegWrite "HKCU\Control Panel\Desktop\ScreenSaveActive",1
    WshShell.Run "%windir%\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters",1, False
    
    
    objIe.quit 
    

    Wednesday, September 11, 2019 1:48 PM

All replies