A random Windows wallpaper every day...

      

If you are looking for a simple program to randomly refresh your Windows wallpaper every day, here it is! 

Every day, this program randomly selects a picture among the .JPG files stored in a given directory, and then refreshes the Windows wallpaper with it.

This program is open-source: it is written in VB script, which means you can have a look at the source code and modify/customize it with a simple text editor.

I initially wrote it for my own computers but, as some colleagues and friends also wanted it, I decided to put it on the Web... It is (of course) totally free: you can use, modify or share it as you like... Do not hesitate to contact me to say that you are using it, what you think of it, ... or if you have improved it! You can contact me by email at sharerandomwallpapers@gmail.com.

HOW TO INSTALL THIS PROGRAM?

This program works on Windows
XP, Vista, 7 or more recent Windows versions... 
To install it, please follow the below steps:

1) Download the RandomWallpapers.zip
file.

2) Open it and extract all the files it contains into a directory of your choice on your hard disk.

Notes:
The files contained in RandomWallpapers.zip are:
- "RandomWallpapers.vbs": this is the main VB script. This script randomly selects a picture every day and refreshes the Windows wallpaper with it.
- A directory called "Wallpapers": it is the directory in which you will have to put your picture files.
- "Install.vbs": this VB script sets the Windows wallpaper to the picture file which will be daily updated by "RandomWallpapers.vbs" and adds a shortcut towards "RandomWallpapers.vbs" in the Windows "Start Up" directory.
- A directory called "JpgToBmp_conversion" (only useful in case of Windows XP - you can remove this directory otherwise): this directory contains a VB script which converts .JPG pictures into .BMP format using MS Word. Such a conversion is necessary because .JPG wallpapers cannot be refreshed (at all) in Windows XP (only .BMP wallpapers can). 
- A directory called "RefreshWallpaperCommand" (only useful in case of Windows 7 or more recent Windows version - you can remove this directory otherwise): this directory contains a wallpaper-refreshing C program that can be compiled.
- "README.txt": this file contains some textual information.
- "Uninstall.vbs": this VB script contains the reverse operations of "Install.vbs".


- If you do not have a tool on your computer to open .zip files, you can download the free open-source tool "7-zip" at the URL http://www.7-zip.org/.
-
To extract all the files contained in RandomWallpapers.zip, you have to 1) open the RandomWallpapers.zip file (by double-clicking on it), 2) select the directory called "RandomWallpapers" (by simple-clicking on it), 3) click on the "Extract" (or "Extract all files") icon (or, if you do not have such an icon, right-click on the directory "RandomWallpapers" and then click "Extract All"), and at last 4) select a directory of your choice on your hard disk so that the extracted files will be put in this directory.

3) Put all the .JPG picture files that you want to use as wallpapers into the "Wallpapers" directory.

Note: only .JPG picture files are allowed.


4) Double-click on the "Install.vbs" file to execute this script.

Note: as said above, this VB script sets the Windows wallpaper (as if you did it in the "Windows Display" settings) to the picture file which will be daily updated by "RandomWallpapers.vbs" and adds a shortcut towards "RandomWallpapers.vbs" in the Windows "Start Up" directory (visible in the Windows menus "Start>Programs>Start Up"). You can have a look at the source code of this VB script by opening it with a simple text editor.

5) From now on, your Windows wallpaper will be updated every day by randomly selecting one of the pictures stored in the "Wallpapers" directory!

Notes:
- Every day, it is the "RandomWallpapers.vbs" script which will randomly select a picture and refresh the Windows wallpaper with it.
- You can add new .JPG picture files in the "Wallpapers" directory , or remove some, whenever you like... The new picture files will be taken into account from the following day, and they will be selected with a higher probability compared to older pictures (so if you come back from holidays, you will be more likely to see your holiday pictures as wallpapers in the following days!).
- A text file called "trace.txt" will be generated by "RandomWallpapers.vbs" enabling you (if you wish) to see the last operations done by "RandomWallpapers.vbs", for example an history of the pictures selected...
- To uninstall this program, double-click on the "Uninstall.vbs" file to execute this script.

VISUAL BASIC SCRIPT SOURCE CODE:

For your information, here is the source code of the "RandomWallpapers.vbs" VB script.
(This file is part of the
RandomWallpapers.zip file. To know how to run it, see the steps 1), 2), 3), 4) and 5) above).

' ***************************************************************************
' 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), "VISTA" or "WINDOWS7" 
'   (to be used for Windows 7 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/
'
' ***************************************************************************

Option Explicit

' ***************
' Check arguments
' ***************

Dim tracefilename
tracefilename = "trace.txt"

Dim nbArguments
nbArguments = wscript.arguments.count

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

Dim filesys
Set filesys = CreateObject("Scripting.FileSystemObject")

Dim currentdirectory 
currentdirectory = left(WScript.ScriptFullName,(Len(WScript.ScriptFullName))-(len(WScript.ScriptName)))

If nbArguments = 2 Then

Dim opsys
opsys = ucase(wscript.arguments(0))

Dim wallpaperfilename
wallpaperfilename = wscript.arguments(1)

Dim wallpaperpictureformat
If opsys = "VISTA" or opsys = "WINDOWS7" 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, Windows 7 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, VISTA or WINDOWS7 (" & 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 or Windows 7)
WScript.Echo "RandomWallpapers.vbs is run for the first time: click on ""OK""... and 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 or Windows 7)

' Wait for 15 seconds
' *******************

    If opsys = "WINDOWS7" Then
      writeInTraceTxtFile("Wait for 15 seconds before updating the Windows wallpaper...")
      WScript.Sleep(15000) ' Avoid any R/W issue at Windows 7 (re)start
    End if

' 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 AND FUNCTIONS:
' ***************************************************************************
' ***************************************************************************

' ***************************************************************************
' This function randomly updates the Windows wallpaper file according to 
' one the .JPG picture files stored in the Wallpapers directory.
' ***************************************************************************

Sub UpdateWallpaperFileRandomly()

' 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
' **********************************************************

Const ReadOnly = 1

Dim foldercontents
Set foldercontents = filesys.GetFolder(currentdirectory & "Wallpapers")

Dim nbJpgFiles
nbJpgFiles = 0

Dim file
Dim objFile
' Check that the Wallpapers directory only contains .JPG picture files
For Each file In foldercontents.Files
  ' The Thumbs.db file, if it exists, is ignored (Windows file useful for thumbnails)
If InStr(lcase(file.Name),"thumbs.db") = 0 Then
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
    ' (If applicable, unset 'read-only' file setting)   
    Set objFile = filesys.GetFile(currentdirectory & "Wallpapers\" & file.Name)
    If objFile.Attributes AND ReadOnly Then
      objFile.Attributes = objFile.Attributes XOR ReadOnly
    End If
End if
Next
Set objFile = Nothing

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
' *****************************************************************************

Dim nbLoops
nbLoops = nbJpgFiles / 3
nbLoops = Int(nbLoops + 0.5) '(round to nearest integer)
If nbLoops < 5 Then
  nbLoops = 5
End if

Dim count
count = 0
Randomize()
Do ' This loop allows to select new pictures files in priority vs older ones 

' Select a random number between 1 and nbJpgFiles
Dim selectedfileNb
selectedfileNb = Int(nbJpgFiles*Rnd + 1)
Dim selectedfilename
selectedfilename = ""

' Select the corresponding .JPG file
Dim i
i = 0
For Each file In foldercontents.Files
' The Thumbs.db file, if it exists, is ignored (Windows file useful for thumbnails)
If InStr(lcase(file.Name),"thumbs.db") = 0 Then
i = i + 1
if i = selectedfileNb Then
selectedfilename = file.Name
Exit For
End if
End if
Next

' Defensive check
If selectedfilename = "" Then
WScript.Echo "RandomWallpapers.vbs: ERROR! Internal error when selecting .JPG file."
WScript.Quit
End if

' Select new pictures files in priority vs older ones: if a new picture file is found, the loop is exited
If NOT checkIfFileWasAlreadySelectedSeveralTimesAsWallpaper(selectedfilename) Then
Exit Do
End if

count = count + 1

Loop While (count < nbLoops)

writeInTraceTxtFile(selectedfilename & " is selected to be the next Windows wallpaper (" & count & "/" & nbLoops & ")")

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, True
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", True
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, True
End if
filesys.MoveFile "JpgToBmp_conversion\out.bmp", wallpaperfilename
filesys.DeleteFile "JpgToBmp_conversion\in.jpg", True

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()

' Option to refresh the Windows wallpaper on weekdays only 
Const refresh_wallpaper_on_weekdays_only = False '(False: the Windows wallpaper is refreshed every day, True: the Windows wallpaper is only refreshed on weekdays but not on Saturdays & Sundays)    

Dim validDateChange
Do

  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)

  ' Check if the Windows wallpaper shall only be refreshed on weekdays
  ' ******************************************************************

  validDateChange = True
  If refresh_wallpaper_on_weekdays_only Then
    If Weekday(now) = 7 Then ' Saturday
      writeInTraceTxtFile("Next day is detected (Saturday) but skipped as it is not a weekday")
      validDateChange = False
    End if
    If Weekday(now) = 1 Then ' Sunday
      writeInTraceTxtFile("Next day is detected (Sunday) but skipped as it is not a weekday")
      validDateChange = False
    End if
  End if

Loop While NOT validDateChange

writeInTraceTxtFile("Next day is detected")

End sub

' ***************************************************************************
' This function refreshes the Windows wallpaper (Windows desktop background)
' ***************************************************************************

Sub RefreshWindowsWallpaper()

If opsys = "XP" Then

  ' Windows refresh command
  oShell.Run "%windir%\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 0, True
  writeInTraceTxtFile("The Windows wallpaper is refreshed")

ElseIf opsys = "VISTA" Then

  ' Windows refresh command
  oShell.Run "%windir%\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 0, 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)
Dim i
For i = 1 to 12
WScript.Sleep(30000 + i * 30000)
' Repeat refresh command
oShell.Run "%windir%\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 0, True
writeInTraceTxtFile("The Windows wallpaper is refreshed again (#" & i & ")")
Next

Else ' Windows 7

  ' In Windows 7 (or more recent Windows version), wallpaper cannot be
  ' refreshed by VB script commands only: an executable file shall be run 
  ' to call the SystemParametersInfo(SPI_SETDESKWALLPAPER, ...) function. 
  ' This is the goal of the RefreshWallpaperCommand\RefreshWallpaperCommand.exe file 
  ' (You can regenerate/recompile this executable file from the associated .c file, 
  ' using GCC for example).
  oShell.Run "RefreshWallpaperCommand\RefreshWallpaperCommand.exe " & """" & currentdirectory & wallpaperfilename & """", 0, True

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")

' Check that the trace file remains small in size, otherwise reset it
If objFSO.FileExists(tracefilename) Then
If objFSO.GetFile(tracefilename).Size > 10000000 Then
objFSO.DeleteFile(tracefilename), True
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

' *************************************************************************
' This function checks if a picture file was already selected several times 
' in the past as wallpaper, by reading the trace.txt file (useful to select  
' new pictures files in priority vs older ones)
' *************************************************************************

Function checkIfFileWasAlreadySelectedSeveralTimesAsWallpaper(filename_p)

Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Set the default function's return value
checkIfFileWasAlreadySelectedSeveralTimesAsWallpaper = False

Dim nbOccurrences
nbOccurrences = 0

If objFSO.FileExists(tracefilename) Then

Const ForReading = 1
Dim objTextFile
Set objTextFile = objFSO.OpenTextFile(tracefilename, ForReading)
Dim currentLine
Dim lastSelectedWallpaperLine
lastSelectedWallpaperLine = ""
Do Until objTextFile.AtEndOfStream

    ' Read a line in the trace file
    currentLine = objTextFile.Readline

    ' Check if there is a wallpaper selection on the current line of the trace file
    If NOT InStr(lcase(currentLine),lcase("selected to be the next Windows wallpaper")) = 0 Then

      ' Check if the file name appears on the current line of the trace file
      If NOT InStr(lcase(currentLine),lcase(filename_p)) = 0 Then
        nbOccurrences = nbOccurrences + 1
        ' Check if the file name globally appears several times in the trace file
        If nbOccurrences >= 2 Then
       Set currentLine = Nothing
       objTextFile.Close
       Set objTextFile = Nothing
       Set objFSO = Nothing
       ' Set the function's return value
       checkIfFileWasAlreadySelectedSeveralTimesAsWallpaper = True
       Exit Function
        End if
      End if

      lastSelectedWallpaperLine = currentLine
      
    End if
      
Loop

  ' Check if the file name appears on the last line (containing a wallpaper selection) of the trace file. 
  ' This check tends to avoid reusing the same wallpaper twice. 
  If NOT InStr(lcase(lastSelectedWallpaperLine),lcase(filename_p)) = 0 Then    
    Set currentLine = Nothing
    objTextFile.Close
    Set objTextFile = Nothing
    ' Set the function's return value
    checkIfFileWasAlreadySelectedSeveralTimesAsWallpaper = True  
  Else
  Set currentLine = Nothing
  objTextFile.Close
  Set objTextFile = Nothing
  ' Set the function's return value
  checkIfFileWasAlreadySelectedSeveralTimesAsWallpaper = False
  End if

End if

Set objFSO = Nothing

End function

WALLPAPER PICTURES:

At last, here are some beautiful wallpaper pictures
;)
(click on the pictures to enlarge them)


Dragonflies and fairies playing (somewhere in France)


The zen garden of the Chionin temple in Kyoto (Japan)


The Golden temple, Kinkaku-ji, in Kyoto (Japan)


The Tenryu-ji zen garden in Kyoto (Japan), the shape of the pond is like the Chinese character "heart"


Love in the sand of the Elim Dune (Namibia)

     

Last update of this page: March 21st 2014.

Thank you for your visit!
Merci de votre visite sur cette page!



 
Subpages (1): download