Realtime Soft Forum

Forums -> UltraMon™ -> Previous Wallpaper script

TG 2007-08-19 07:09

I found the ChangeWallpaper.vbs script very useful, but limited in that it progresses through the wallpaper folder with no ability to reverse direction. I modified it to invert the file list, and use the the two scripts via a "Next" shortcut to the original script and a "Previous" shortcut to the modified script. Suits my purposes perfectly, thought others might find it useful.

It's unoriginal, just the original code modified with a sort function I found elsewhere.

The bubble sort used is slow; if anyone knows of a faster sort that could be used, that would be a nice improvement.

The original line
fileWpFullName = dirWps(i) & fileWp.Name
has been replaced with
fileWpFullName = fldWp & "\" & strFileName

That works fine for me so far with all wallpapers in My Documents\My Wallpapers; I just added a first wallpaper in the All Users\Documents\Shared Wallpapers folder and it seems to still work o.k.

Here's the script:
' PreviousWallpaper.vbs ' A modification of the ChangeWallpaper.vbs script to allow changing wallpaper in inverse order. ' Used in conjunction with the Change Wallpaper script you can now navigate through your wallpapers ' with "Next" and "Previous" shortcuts and/or hotkeys. Option Explicit Const UMDESKTOP_EXE = "C:\Program Files\UltraMon\UltraMonDesktop.exe" Dim sh, fso Set sh = CreateObject("WScript.Shell") Set fso = CreateObject("Scripting.FileSystemObject") 'get the location of the user and shared wallpaper folders Dim dirWps(1) dirWps(0) = sh.RegRead("HKCU\Software\Realtime Soft\UltraMon\Wallpaper\Wallpaper Directory") dirWps(1) = sh.RegRead("HKLM\Software\Realtime Soft\UltraMon\Wallpaper\All Users Wallpaper Directory") Dim i For i = 0 To UBound(dirWps) If Right(dirWps(i), 1) <> "\" Then dirWps(i) = dirWps(i) & "\" Next 'get name of current wallpaper Dim curWp curWp = sh.RegRead("HKCU\Control Panel\Desktop\Wallpaper") i = InStrRev(curWp, ".") curWp = Left(curWp, i) & "wallpaper" 'enumerate available wallpapers Dim fldWp, n , arrItem, arrSortItem, strFileName For i = 0 To UBound(dirWps) Set fldWp = fso.GetFolder(dirWps(i)) 'Sort the files with bubble sort n = fso.GetFolder(fldWp).Files.count - 1 ReDim arrItem(n) Dim fileWp i = 0 For Each fileWp In fso.GetFolder(fldWp).Files arrItem(i) = fileWp.Name i = i + 1 Next Next 'Execute the bubble sort function arrSortItem = SortItem(arrItem) 'Display the sorted items from the array Dim nextOne, nextWp, firstWp, fileWpFullName For i = 0 To UBound(arrSortItem) strFileName = arrSortItem(i) If Right(strFileName, 10) = ".wallpaper" Then fileWpFullName = fldWp & "\" & strFileName If firstWp = "" Then firstWp = fileWpFullName If nextOne = True Then nextWp = fileWpFullName Exit For ElseIf fileWpFullName = curWp Then nextOne = True End If End If Next If nextWp = "" Then nextWp = firstWp 'load next wallpaper If nextWp <> "" Then Dim cmd : cmd = """" & UMDESKTOP_EXE & """ /load " & nextWp sh.Run cmd End If 'Function to sort the files Function SortItem(arrSort) Dim k, j, temp For k = UBound(arrSort) - 1 To 0 Step -1 For j= 0 To k If Lcase(arrSort(j))<LCase(arrSort(j+1)) Then temp=arrSort(j+1) arrSort(j+1)=arrSort(j) arrSort(j)=temp End If Next Next SortItem = arrSort End Function

Christian Studer 2007-08-20 09:11

Thanks for sharing the script,

Christian Studer - www.realtimesoft.com

TG 2007-08-20 15:08

One warning: I said that it seemed to work navigating both the user and shared wallpaper folders; it doesn't. I accidentally added some wallpapers in the shared folder today after having checked that option yesterday, and found that it was only finding and sorting the files in the user directory.

I'm using the posted script as "Previous Wallpaper". I changed one character and saved the script as "Next Wallpaper", to get the same sort navigating forward.

Change < to > in the line
If Lcase(arrSort(j))<LCase(arrSort(j+1)) Then
for a "Next Wallpaper" sort.

I've tried limiting the use of the "i" variable and keeping track of the folders with dirWps(i) with no luck so far, though. I don't have much use for the shared folder, but it would be nice to have it work like the original script. For now I've removed the line For i = 0 To UBound(dirWps) and it's closing "Next", and changed "i" to "0" in Set fldWp = fso.GetFolder(dirWps(i)) to leave it in the user folder.

TG 2007-08-21 09:02

O.K., here's the proper script. Just a few lines added to the ChangeWallpaper script to sort the files and reverse the order. No more ugly bubble sort. Progresses through both the user and shared wallpaper folders as the original script intended. For a companion NextWallpaper script, simply delete the line DataList.Reverse() and save as NextWallpaper.vbs. Save the following as PreviousWallpaper.vbs: Option Explicit Const UMDESKTOP_EXE = "C:\Program Files\UltraMon\UltraMonDesktop.exe" Dim sh, fso Set sh = CreateObject("WScript.Shell") Set fso = CreateObject("Scripting.FileSystemObject") 'get the location of the user and shared wallpaper folders Dim dirWps(1) dirWps(0) = sh.RegRead("HKCU\Software\Realtime Soft\UltraMon\Wallpaper\Wallpaper Directory") dirWps(1) = sh.RegRead("HKLM\Software\Realtime Soft\UltraMon\Wallpaper\All Users Wallpaper Directory") Dim i For i = 0 To UBound(dirWps) If Right(dirWps(i), 1) <> "\" Then dirWps(i) = dirWps(i) & "\" Next 'get name of current wallpaper Dim curWp curWp = sh.RegRead("HKCU\Control Panel\Desktop\Wallpaper") i = InStrRev(curWp, ".") curWp = Left(curWp, i) & "wallpaper" 'enumerate available wallpapers Dim DataList, strItem, m, fldWp, fileWp, nextOne, nextWp, firstWp, fileWpFullName, wallPaper Set DataList = CreateObject _ ("System.Collections.ArrayList") m = 0 For i = 0 To UBound(dirWps) Set fldWp = fso.GetFolder(dirWps(i)) For Each fileWp In fldWp.Files fileWpFullName = fileWp DataList.Add fileWpFullName m = m + 1 Next Next DataList.Sort DataList.Reverse() For Each strItem in DataList If Right(strItem, 10) = ".wallpaper" Then wallPaper = strItem If firstWp = "" Then firstWp = wallPaper If nextOne = True Then nextWp = wallPaper Exit For ElseIf wallPaper = curWp Then nextOne = True End If End If Next If nextWp = "" Then nextWp = firstWp 'load next wallpaper If nextWp <> "" Then Dim cmd : cmd = """" & UMDESKTOP_EXE & """ /load " & nextWp sh.Run cmd End If

TG 2007-08-21 12:05

O.K., here's the FINAL script. The last script added all the files in the two folders in an array and sorted them. Then the script looped through the items identifying the wallpapers.

This version adds ONLY the wallpaper files from the two folders into the array before sorting them. Half as many files to sort. As before, save this as "PreviousWallpaper.vbs". Delete the line DataList.Reverse() and save as "NextWallpaper.vbs".

The script follows:
Option Explicit Const UMDESKTOP_EXE = "C:\Program Files\UltraMon\UltraMonDesktop.exe" Dim sh, fso Set sh = CreateObject("WScript.Shell") Set fso = CreateObject("Scripting.FileSystemObject") 'get the location of the user and shared wallpaper folders Dim dirWps(1) dirWps(0) = sh.RegRead("HKCU\Software\Realtime Soft\UltraMon\Wallpaper\Wallpaper Directory") dirWps(1) = sh.RegRead("HKLM\Software\Realtime Soft\UltraMon\Wallpaper\All Users Wallpaper Directory") Dim i For i = 0 To UBound(dirWps) If Right(dirWps(i), 1) <> "\" Then dirWps(i) = dirWps(i) & "\" Next 'get name of current wallpaper Dim curWp curWp = sh.RegRead("HKCU\Control Panel\Desktop\Wallpaper") i = InStrRev(curWp, ".") curWp = Left(curWp, i) & "wallpaper" 'enumerate available wallpapers Dim DataList, strItem, m, fldWp, fileWp, nextOne, nextWp, firstWp, fileWpFullName Set DataList = CreateObject _ ("System.Collections.ArrayList") m = 0 For i = 0 To UBound(dirWps) Set fldWp = fso.GetFolder(dirWps(i)) For Each fileWp In fldWp.Files If Right(fileWp, 10) = ".wallpaper" Then fileWpFullName = fileWp DataList.Add fileWpFullName End If m = m + 1 Next Next DataList.Sort DataList.Reverse() For Each strItem in DataList If firstWp = "" Then firstWp = strItem If nextOne = True Then nextWp = strItem Exit For ElseIf strItem = curWp Then nextOne = True End If Next If nextWp = "" Then nextWp = firstWp 'load next wallpaper If nextWp <> "" Then Dim cmd : cmd = """" & UMDESKTOP_EXE & """ /load " & nextWp sh.Run cmd End If

TG 2007-08-23 02:09

I've finished making changes to this script. I'll post the new ones in another thread.

The new scripts save a lot of disk space. Instead of having a bunch of UltraMon-generated .bmp files that are copies of other files on the system, the new scripts leave only the current UltraMon .bmp for the current user in the wallpaper folders. A third, short script is included to be placed in the All Users Startup folder so each user's current wallpaper .bmp is reloaded.

Forums -> UltraMon™ -> Previous Wallpaper script

Post Reply