Realtime Soft Forum

Forums -> UltraMon™ -> A wallpaper changer that also frees up disk space

TG 2007-08-23 02:40

These 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, these scripts leave only the current UltraMon .bmp for the current user in the wallpaper folders.

The first script sorts the wallpaper files and changes your wallpaper to the next one in the list. It deletes all .bmp files generated by UltraMon except the current one. It does NOT delete any .bmp files that were not generated by UltraMon, or any .wallpaper or any other files.

The second script script does the same thing, but changes your wallpaper to the one previous to your current wallpaper. A pair of shortcuts to each of these scripts provides forward/backward navigation through your UltraMon wallpapers.

A shortcut to the third script should be added to the All Users Startup folder to be run at login. It simply identifies the current user's current UltraMon wallpaper and reloads it.

Tested with UltraMon 2.7.1 and WinXP.

Each script will follow in the next three postings.

TG 2007-08-23 02:43

'NextWallpaper.vbs 'A modification of ChangeWallpaper.vbs found at http://www.realtimesoft.com/ultramon/ 'Adds file sorting and the detection and deletion of Ultramon-generated .bmp files 'Use in conjunction with PreviousWallpaper.vbs for navigation back and forth 'Please also add a shortcut to RefreshWallpaper.vbs in the All Users Startup folder 'to reload the user's current wallpaper at login Option Explicit Const UMDESKTOP_EXE = "C:\Program Files\UltraMon\UltraMonDesktop.exe" Dim sh, fso Set sh = CreateObject("WScript.Shell") Set fso = CreateObject("Scripting.FileSystemObject") Set DataList = CreateObject("System.Collections.ArrayList") Set SecondList = CreateObject("System.Collections.ArrayList") Set GoneList = CreateObject("System.Collections.ArrayList") '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, SecondList, GoneList, fldWp, fileWp, fileWpFullName 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 'find bitmaps ElseIf Right(fileWp, 4) = ".bmp" Then fileWpFullName = fileWp SecondList.Add fileWpFullName End If Next Next 'determine which bitmaps were generated by UltraMon Dim strItem, compareFile For Each strItem in SecondList compareFile = (Replace(strItem,".bmp",".wallpaper")) If DataList.Contains(compareFile) Then GoneList.Add strItem Next 'delete only the UltraMon bitmaps Dim bitMap For Each strItem in GoneList Set bitMap = fso.GetFile(strItem) 'comment out the following line if you'd like to regenerate your UltraMon .bmp files bitMap.Delete Next 'sort and move to the next wallpaper DataList.Sort Dim firstWp, nextOne, nextWp 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:44

'PreviousWallpaper.vbs 'A modification of ChangeWallpaper.vbs found at http://www.realtimesoft.com/ultramon/ 'Adds file sorting and the detection and deletion of Ultramon-generated .bmp files 'Use in conjunction with NextWallpaper.vbs for navigation back and forth 'Please also add a shortcut to RefreshWallpaper.vbs in the All Users Startup folder 'to reload the user's current wallpaper at login Option Explicit Const UMDESKTOP_EXE = "C:\Program Files\UltraMon\UltraMonDesktop.exe" Dim sh, fso Set sh = CreateObject("WScript.Shell") Set fso = CreateObject("Scripting.FileSystemObject") Set DataList = CreateObject("System.Collections.ArrayList") Set SecondList = CreateObject("System.Collections.ArrayList") Set GoneList = CreateObject("System.Collections.ArrayList") '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, SecondList, GoneList, fldWp, fileWp, fileWpFullName 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 'find bitmaps ElseIf Right(fileWp, 4) = ".bmp" Then fileWpFullName = fileWp SecondList.Add fileWpFullName End If Next Next 'determine which bitmaps were generated by UltraMon Dim strItem, compareFile For Each strItem in SecondList compareFile = (Replace(strItem,".bmp",".wallpaper")) If DataList.Contains(compareFile) Then GoneList.Add strItem Next 'delete only the UltraMon bitmaps Dim bitMap For Each strItem in GoneList Set bitMap = fso.GetFile(strItem) 'comment out the following line if you'd like to regenerate your UltraMon .bmp files bitMap.Delete Next 'sort and move to the next wallpaper DataList.Sort DataList.Reverse() Dim firstWp, nextOne, nextWp 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:45

'RefreshWallpaper.vbs 'A modification of ChangeWallpaper.vbs found at http://www.realtimesoft.com/ultramon/ 'Use in conjunction with NextWallpaper.vbs and PreviousWallpaper.vbs 'Add a shortcut to RefreshWallpaper.vbs in the All Users Startup folder 'to reload the user's current wallpaper at login Option Explicit Const UMDESKTOP_EXE = "C:\Program Files\UltraMon\UltraMonDesktop.exe" Dim sh Set sh = CreateObject("WScript.Shell") 'get name of current wallpaper and reload it Dim curWp, i curWp = sh.RegRead("HKCU\Control Panel\Desktop\Wallpaper") i = InStrRev(curWp, ".") curWp = Left(curWp, i) & "wallpaper" Dim cmd : cmd = """" & UMDESKTOP_EXE & """ /load " & curWp sh.Run cmd

TG 2007-09-11 10:02

FWIW, here's a much improved version of the script. Runs smoothly if you click away multiple times on a shortcut while browsing through your wallpaper. Or tap away on a hotkey assigned to the script.
'NextWallpaper.vbs 'A modification of ChangeWallpaper.vbs found at http://www.realtimesoft.com/ultramon/ 'Please also add a shortcut to RefreshWallpaper.vbs in the All Users Startup folder 'to reload the user's current wallpaper at login Option Explicit Const UMDESKTOP_EXE = "C:\Program Files\UltraMon\UltraMonDesktop.exe" Dim sh, fso Set sh = CreateObject("WScript.Shell") Set fso = CreateObject("Scripting.FileSystemObject") Set WallpaperList = CreateObject("System.Collections.ArrayList") Set BitmapList = CreateObject("System.Collections.ArrayList") Set DeleteList = CreateObject("System.Collections.ArrayList") '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 'Set a cookie to indicate the script is running; if one is already found, wait to proceed Dim chkFile, objFile chkFile = "ScriptActive.txt" For i = 1 To 100 If fso.FileExists(dirWps(0) & chkFile) Then WScript.Sleep(2000) On Error Resume Next Else Set objFile = fso.CreateTextFile(dirWps(0) & chkFile) Exit For Wscript.Quit End If Next On Error GoTo 0 set objFile = nothing 'gather a list of wallpaper files, and another list of bmp's Dim fldWp, strItem, fileWpFullName, WallpaperList, BitmapList For i = 0 To UBound(dirWps) Set fldWp = fso.GetFolder(dirWps(i)) For Each strItem In fldWp.Files If Right(strItem, 10) = ".wallpaper" Then fileWpFullName = strItem WallpaperList.Add fileWpFullName ElseIf Right(strItem, 4) = ".bmp" Then fileWpFullName = strItem BitmapList.Add fileWpFullName End If Next Next 'Sort the wallpapers WallpaperList.Sort 'uncomment the following line and save file as PreviousWallpaper.vbs ' WallpaperList.Reverse() 'Change the wallpaper to the next in the list Dim curWp, firstWp, nextOne, nextWp curWp = sh.RegRead("HKCU\Control Panel\Desktop\Wallpaper") i = InStrRev(curWp, ".") curWp = Left(curWp, i) & "wallpaper" For Each strItem in WallpaperList 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 If nextWp <> "" Then Dim cmd : cmd = """" & UMDESKTOP_EXE & """ /load " & nextWp sh.Run cmd End If 'delete only the bmp's generated by ultramon, and delete the cookie Dim compareFile, DeleteList BitmapList.Remove nextWp For Each strItem in BitmapList compareFile = (Replace(strItem,".bmp",".wallpaper")) If WallpaperList.Contains(compareFile) Then DeleteList.Add strItem Next Dim bitMap On Error Resume Next For Each strItem in DeleteList Set bitMap = fso.GetFile(strItem) bitMap.Delete Next fso.DeleteFile(dirWps(0) & chkFile) Wscript.Quit

basder 2026-02-25 01:53

Sitting in a pub in Manchester, waiting for my mates who are always late. It was raining heavily outside. I pulled out my mobile and tried https://highflybets.net just to kill time. I deposited twenty quid. The poker tables were surprisingly active. I managed to bluff my way through a few hands of poker and walked away with a tidy profit before the guys finally showed up. Drinks are on me tonight.

Forums -> UltraMon™ -> A wallpaper changer that also frees up disk space

Post Reply