Misfortune
New Member
I found a neat script that runs on startup and can change the desktop background to a random picture on the hard drive.
One problem I have with it is that it currently checks the date of the image and won't update the desktop background more than once a day. However, I'd like to update the desktop background every time I start the computer, not simply once a day. In other words, I'd like to remove the date check, and make it update the desktop background on startup.
Another problem is that the script also includes a "refresh" command, and runs in the background for some time and tries to refresh the desktop background so that the new image can load. But this doesn't work for me, and wscript.exe remains running in the background. Therefore, I'd like to remove this feature as well, and have the script change the desktop background, and then exit.
Unfortunately, I don't know a thing about VB scripts
. I've tried editing the script to my liking, but I always get an error and the script fails to run. I'm wondering if anyone can walk me through the steps to modify it, or even edit the script and post it back for me to use.
The website is called random wallpapers, and it provides information on how the script works. The actual script can be downloaded here.
Any help would be greatly appreciated!
EDIT: Here is the script
One problem I have with it is that it currently checks the date of the image and won't update the desktop background more than once a day. However, I'd like to update the desktop background every time I start the computer, not simply once a day. In other words, I'd like to remove the date check, and make it update the desktop background on startup.
Another problem is that the script also includes a "refresh" command, and runs in the background for some time and tries to refresh the desktop background so that the new image can load. But this doesn't work for me, and wscript.exe remains running in the background. Therefore, I'd like to remove this feature as well, and have the script change the desktop background, and then exit.
Unfortunately, I don't know a thing about VB scripts
. I've tried editing the script to my liking, but I always get an error and the script fails to run. I'm wondering if anyone can walk me through the steps to modify it, or even edit the script and post it back for me to use.The website is called random wallpapers, and it provides information on how the script works. The actual script can be downloaded here.
Any help would be greatly appreciated!
EDIT: Here is the script
Code:
' ***************************************************************************
' This VB script randomly selects a picture every day (among the .JPG picture
' files stored in the "Wallpapers" directory) and refreshes the Windows
' wallpaper with it.
' ***************************************************************************
'
' Usage: RandomWallpapers.vbs opsys wallpaperfilename
'
' with:
' - opsys is the Windows version: allowed values are "XP" (to be used
' for Windows XP or older Windows versions) or "VISTA" (to be used
' for Windows Vista or more recent Windows versions).
' - wallpaperfilename is the name of the Windows wallpaper file. It will
' be updated randomly every day according to one of the pictures stored
' in the "Wallpapers" directory.
'
' Web site: http://sites.google.com/site/sharerandomwallpapers/
' Version of this script: '1.0'
'
' ***************************************************************************
Option Explicit
' ***************
' Check arguments
' ***************
Dim nbArguments
nbArguments = wscript.arguments.count
Dim oShell
Set oShell = CreateObject("WScript.Shell")
Dim filesys
Set filesys = CreateObject("Scripting.FileSystemObject")
If nbArguments = 2 Then
Dim opsys
opsys = ucase(wscript.arguments(0))
Dim wallpaperfilename
wallpaperfilename = wscript.arguments(1)
Dim wallpaperpictureformat
If opsys = "VISTA" Then
If InStr(lcase(wallpaperfilename),".jpg") = 0 Then
WScript.Echo "RandomWallpapers.vbs: ERROR! Inconsistent argument: wallpaperfilename shall be in .JPG format when using Windows Vista or a more recent Windows version (" & wallpaperfilename & ")."
WScript.Quit
End if
wallpaperpictureformat = "JPG"
ElseIf opsys = "XP" Then
If InStr(lcase(wallpaperfilename),".bmp") = 0 Then
WScript.Echo "RandomWallpapers.vbs: ERROR! Inconsistent argument: wallpaperfilename shall be in .BMP format when using Windows XP or an older Windows version (" & wallpaperfilename & ")."
WScript.Quit
End if
wallpaperpictureformat = "BMP"
Else
WScript.Echo "RandomWallpapers.vbs: ERROR! Inconsistent argument: opsys is not equal to XP or VISTA (" & opsys & ")."
WScript.Quit
End if
writeInTraceTxtFile("***** RandomWallpapers.vbs is run (" & opsys & ", " & wallpaperfilename & ") *****")
If NOT filesys.FileExists(wallpaperfilename) Then
If opsys = "VISTA" Then
WScript.Echo "RandomWallpapers.vbs is run for the first time: the Windows wallpaper will be refreshed tomorrow morning (or at next computer restart)"
Else ' (XP)
WScript.Echo "RandomWallpapers.vbs is run for the first time: the Windows wallpaper will be refreshed in a few moments..."
End if
End if
Else
WScript.Echo "RandomWallpapers.vbs: ERROR! Wrong number of arguments (" & nbArguments & " argument(s))."
WScript.Quit
End if
' ***************
' Main processing
' ***************
Do While True
If opsys = "VISTA" Then
' Wait for 3 minutes
' ******************
If filesys.FileExists(wallpaperfilename) Then
writeInTraceTxtFile("Wait for 3 minutes before updating the Windows wallpaper...")
WScript.Sleep(180000)
End if
' Update the Windows wallpaper randomly
' *************************************
UpdateWallpaperFileRandomly()
' Wait for the next day
' *********************
' (Only useful if the computer is not stopped in between. If it is stopped, the wallpaper
' will be automatically refreshed by Windows at next computer restart)
WaitForNextDay()
' Refresh the Windows wallpaper
' *****************************
RefreshWindowsWallpaper()
Else ' (XP)
' Update the Windows wallpaper randomly
' *************************************
UpdateWallpaperFileRandomly()
' Refresh the Windows wallpaper
' *****************************
RefreshWindowsWallpaper()
' Wait for the next day to do again the same operations
' *****************************************************
' (Only useful if the computer is not stopped in between)
WaitForNextDay()
End if
Loop
' ***************************************************************************
' ***************************************************************************
' SUBs:
' ***************************************************************************
' ***************************************************************************
' ***************************************************************************
' This function randomly updates the Windows wallpaper file according to
' one the .JPG picture files stored in the Wallpapers directory.
' ***************************************************************************
Sub UpdateWallpaperFileRandomly()
Dim currentdirectory
currentdirectory = left(WScript.ScriptFullName,(Len(WScript.ScriptFullName))-(len(WScript.ScriptName)))
' Check that the Wallpapers directory exists
' ******************************************
' Check that the Wallpapers directory exists
If NOT filesys.FolderExists("Wallpapers") Then
WScript.Echo "RandomWallpapers.vbs: ERROR! The Wallpapers directory does not exist. Please create it (" & currentdirectory & "Wallpapers" & ") and put your .JPG picture files in it."
WScript.Quit
End if
' Count the number of .JPG files in the Wallpapers directory
' **********************************************************
Dim foldercontents
Set foldercontents = filesys.GetFolder(currentdirectory & "Wallpapers")
Dim nbJpgFiles
nbJpgFiles = 0
Dim file
For Each file In foldercontents.Files
' Check that the Wallpapers directory only contains .JPG picture files
If InStr(lcase(file.Name),".jpg") = 0 Then
WScript.Echo "RandomWallpapers.vbs: ERROR! Only .JPG picture files shall be stored in the Wallpapers directory, but a file named " & file.Name & " was found. Please remove this file from the Wallpapers directory (" & currentdirectory & "Wallpapers" & ")."
WScript.Quit
End if
nbJpgFiles = nbJpgFiles + 1
Next
writeInTraceTxtFile(nbJpgFiles & " picture files are stored in the Wallpapers directory")
' Check that the Wallpapers directory is not empty
If nbJpgFiles = 0 Then
WScript.Echo "RandomWallpapers.vbs: ERROR! No .JPG picture file was found in the Wallpapers directory (" & currentdirectory & "Wallpapers" & "). Please add some .JPG picture files in this directory."
WScript.Quit
End if
' Check if the Wallpapers directory contains only one file (if so, display a warning message)
If nbJpgFiles = 1 Then
WScript.Echo "RandomWallpapers.vbs: WARNING! Only one .JPG picture file was found in the Wallpapers directory (" & currentdirectory & "Wallpapers" & "). You have to add more .JPG picture files in this directory if you want your Windows wallpaper to change every day..."
End if
' Check if the Windows wallpaper was already updated today
' ********************************************************
Dim oShellTouch, oFolderTouch
Set oShellTouch = CreateObject("Shell.Application")
Set oFolderTouch = oShellTouch.NameSpace(currentdirectory)
If filesys.FileExists(wallpaperfilename) Then
Dim modifydate
modifydate = oFolderTouch.Items.Item(wallpaperfilename).ModifyDate
If day(modifydate) & month(modifydate) & year(modifydate) = day(now) & month(now) & year(now) Then
writeInTraceTxtFile("No new Windows wallpaper is selected as already done once today")
Exit Sub
End if
End if
' Select a .JPG file randomly among the ones stored in the Wallpapers directory
' *****************************************************************************
' Select a random number between 1 and nbJpgFiles
Randomize()
Dim selectedfileNb
selectedfileNb = Int(nbJpgFiles*Rnd + 1)
Dim selectedfilename
selectedfilename = ""
' Select the corresponding .JPG file
Dim i
For Each file In foldercontents.Files
i = i + 1
if i = selectedfileNb Then
selectedfilename = file.Name
Exit For
End if
Next
' Defensive check
If selectedfilename = "" Then
WScript.Echo "RandomWallpapers.vbs: ERROR! Internal error when selecting .JPG file."
WScript.Quit
End if
writeInTraceTxtFile(selectedfilename & " is selected to be the next Windows wallpaper")
set foldercontents = Nothing
' Update the Windows wallpaper file according to the selected .JPG file
' *********************************************************************
If wallpaperpictureformat = "JPG" Then
' Copy the selected .JPG file into the .JPG Windows wallpaper file
' ****************************************************************
filesys.CopyFile "Wallpapers\" & selectedfilename, currentdirectory
If filesys.FileExists(wallpaperfilename) Then
filesys.DeleteFile wallpaperfilename
End if
filesys.MoveFile selectedfilename, wallpaperfilename
Else
' Convert the selected .JPG file into the .BMP Windows wallpaper file
' *******************************************************************
' If Windows XP (or older Windows version), MS Word shall be
' is installed on the PC (necessary to convert the .JPG pictures
' into .BMP format, because .JPG wallpapers cannot be refreshed
' (at all) in Windows XP).
' If MS Word is not installed on the PC, some other tools than MS Word
' allow to do this (like IrfanView): you can download such a tool
' and modify the VB scripts accordingly. The command for IrfanView is:
' i_view32.exe picturename.jpg /convert=picturename.bmp
' Check that all the .JPG -> .BMP conversion files are present
if NOT filesys.FolderExists(currentdirectory & "JpgToBmp_conversion\") _
OR NOT filesys.FileExists(currentdirectory & "JpgToBmp_conversion\JpgToBmp_conversion.vbs") _
OR NOT filesys.FileExists(currentdirectory & "JpgToBmp_conversion\JpgToBmp_conversion.doc") Then
WScript.Echo "RandomWallpapers.vbs: ERROR! Some of the .JPG -> .BMP conversion files are missing. Please check the contents of the JpgToBmp_conversion directory: it shall contain a file called JpgToBmp_conversion.vbs and another one called JpgToBmp_conversion.doc."
WScript.Quit
End if
filesys.CopyFile "Wallpapers\" & selectedfilename, currentdirectory & "\JpgToBmp_conversion\"
If filesys.FileExists("JpgToBmp_conversion\in.jpg") Then
filesys.DeleteFile "JpgToBmp_conversion\in.jpg"
End if
filesys.MoveFile "JpgToBmp_conversion\" & selectedfilename, "JpgToBmp_conversion\in.jpg"
' .JPG to .BMP picture conversion using MS Word
oShell.Run "Wscript.exe JpgToBmp_conversion\JpgToBmp_conversion.vbs", 0, True
If NOT filesys.FileExists(currentdirectory & "JpgToBmp_conversion\out.bmp") Then
WScript.Echo "RandomWallpapers.vbs: ERROR! Cannot convert the selected .JPG file (" & selectedfilename & ") into the .BMP Windows wallpaper file (" & wallpaperfilename & ")."
WScript.Quit
End if
If filesys.FileExists(wallpaperfilename) Then
filesys.DeleteFile wallpaperfilename
End if
filesys.MoveFile "JpgToBmp_conversion\out.bmp", wallpaperfilename
filesys.DeleteFile "JpgToBmp_conversion\in.jpg"
End if
' Touch the Windows wallpaper file (i.e. update its modification date and time)
If NOT filesys.FileExists(wallpaperfilename) Then
WScript.Echo "RandomWallpapers.vbs: ERROR! Internal error after Windows wallpaper file generation."
WScript.Quit
End if
oFolderTouch.Items.Item(wallpaperfilename).ModifyDate = now
Set oShellTouch = Nothing
Set oFolderTouch = Nothing
End sub
' ***************************************************************************
' This function waits for the next day
' ***************************************************************************
Sub WaitForNextDay()
Dim dateStr
dateStr = day(now) & month(now) & year(now)
' Wait for the next day
Do
' Check date change every minute
WScript.Sleep(60000)
Loop While dateStr = day(now) & month(now) & year(now)
writeInTraceTxtFile("Next day is detected")
End sub
' ***************************************************************************
' This function refreshes the Windows wallpaper (Windows desktop background)
' ***************************************************************************
Sub RefreshWindowsWallpaper()
' Windows refresh command
oShell.Run "%windir%\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
writeInTraceTxtFile("The Windows wallpaper is refreshed")
' Repeat Windows refresh command several times in Windows Vista (due to low task priorities for refreshing wallpapers in Windows Vista)
If opsys = "VISTA" Then
Dim i
For i = 1 to 12
WScript.Sleep(30000 + i * 30000)
' Repeat refresh command
oShell.Run "%windir%\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
writeInTraceTxtFile("The Windows wallpaper is refreshed again (#" & i & ")")
Next
End if
End sub
' ***************************************************************************
' This function adds a line of text in the trace.txt file
' ***************************************************************************
Sub writeInTraceTxtFile(str_p)
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim tracefilename
tracefilename = "trace.txt"
' Check that the trace file remains small in size, otherwise reset it
If objFSO.FileExists(tracefilename) Then
If objFSO.GetFile(tracefilename).Size > 100000 Then
objFSO.DeleteFile(tracefilename)
str_p = str_p & " [trace file has been reset]"
End if
End if
Const ForAppending = 8
Const CreateFileIfDoesNotExist = True
Dim traceTextFile
Set traceTextFile = objFSO.OpenTextFile (tracefilename, ForAppending, CreateFileIfDoesNotExist)
traceTextFile.WriteLine(FormatDateTime(now) & ": " & str_p)
traceTextFile.Close
Set traceTextFile = Nothing
Set objFSO = Nothing
End sub
Last edited: