Post Reply

Forums -> UltraMon™ -> UltraMon Auto Wallpaper Changer VBScript
Al   2006-12-25 15:47
I have created a VB script for auto changing UltraMon wallpaper ‘on the fly’.

Two additional features that would be real nice if someone would like to add them, is image folder recursion so the images can be organized in a folder structure rather than being all in one folder. Also ability to use only one instance of the script for all monitors with each having their own update intervals.

Merry Christmas


' UtraMon Wallpaper Auto Changer ' Version: Alpha 1 ' Date: December 25, 2006 ' Syntax: ' "UltraMon Wallpaper Changer" <Monitor Number> <Change Interval> <Change Interval Units> ' <Monitor Number> is which monitor to change wallpaper on (based on order of Strucs in the UltraMon wallpaper file). Default is 1 ' <Change Interval> is an integer specifying how often to change the wallpaper. Default is 60 ' <Change interval Units> is a multiplier to the <Change interval> value. Valid options are: Sec, Min, Hrs. Default is Sec ' Usage: ' Set UltraMon 'Default' wallpaper for each monitor to an image of a folder of images for that monitors wallpaper ' Run an instance of the 'UltraMon Wallpaper Changer' for each monitor to have its wallpaper changed. ' To stop the UtraMon Wallpaper Auto Changer, use taskmanger to end the 'wscript.exe' process(es). ' How it Works Overview: ' Looks in Personal UltraMon wallpaper folder for 'Default.wallpaper', if found copies it to 'UMAutoChanger.wallpaper'. ' If 'Default.wallpaper' file was not found in the personal UltraMon wallpaper folder, ' then looks in All Users UltraMon wallpaper folder for 'Default.wallpaper', if found copies it to 'UMAutoChanger.wallpaper'. ' Obtains images folder path of specified monitor from Struc in 'UMAutoChanger.wallpaper'. ' Selects an image file from the folder. ' Updates the Struc in 'UMAutoChanger.wallpaper' with new image path. ' Runs "%ProgramFiles%\UltraMon\UltraMonDesktop.exe" to have UltraMon rebuild the wallpaper. ' Repeats loop to change the wallpaper at specified interval. Option Explicit 'Const MONITOR = 1 'Which monitor to change 'Const INTERVAL = 10 'interval between wallpaper changes in minutes Const UMDESKTOP_EXE = "%ProgramFiles%\UltraMon\UltraMonDesktop.exe" Dim MONITOR, INTERVAL, INTERVAL_UNITS Dim UMWPFileString, NewUMWPFileString, WPImagesFolder, ImageFilePath, Rest Dim NumMonitors, NumMon, StrucStart, NumStrucs, NumStruc, i, j Dim UMWPFolder 'WScript Shell Dim sh Set sh = CreateObject("WScript.Shell") 'FSO Const ForReading = 1, ForWriting = 2, ForAppending = 8 Dim fso, File Set fso = CreateObject("Scripting.FileSystemObject") ' Default Monitor and Interval MONITOR = 1 INTERVAL = 60 INTERVAL_UNITS = "SEC" ' Override defaults with command line argument values If WScript.Arguments.Count > 0 Then MONITOR = CInt(WScript.Arguments(0)) If WScript.Arguments.Count > 1 Then INTERVAL = CInt(WScript.Arguments(1)) If WScript.Arguments.Count > 2 Then INTERVAL_UNITS = WScript.Arguments(2) INTERVAL_UNITS = LCase(INTERVAL_UNITS) Select Case (INTERVAL_UNITS) Case "sec" INTERVAL = INTERVAL Case "min" INTERVAL = INTERVAL * 60 Case "hrs" INTERVAL = INTERVAL * 3600 Case Else INTERVAL = INTERVAL End Select '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(0) = sh.RegRead("HKLM\Software\Realtime Soft\UltraMon\Wallpaper\All Users Wallpaper Directory") ' Add trailing backslash if not present For i = 0 To UBound(dirWps) If Right(dirWps(i), 1) <> "\" Then dirWps(i) = dirWps(i) & "\" Next ' Personal or All Users Default.wallpaper If fso.FileExists(dirwps(0) & "Default.wallpaper") Then UMWPFolder = dirwps(0) ElseIf fso.FileExists(dirwps(1) & "Default.wallpaper") Then UMWPFolder = dirwps(1) End If Do While True ' Copy Personal or All Users Default.wallpaper file to UMAutoChanger.wallpaper, unless already exists If fso.FileExists(UMWPFolder & "Default.wallpaper") And Not fso.FileExists(UMWPFolder & "UMAutoChanger.wallpaper") Then fso.CopyFile UMWPFolder & "Default.wallpaper", UMWPFolder & "UMAutoChanger.wallpaper", false End If ' Get UMAutoChanger.wallpaper file data Set File = fso.OpenTextFile(UMWPFolder & "UMAutoChanger.wallpaper", ForReading) UMWPFileString = "" Do until File.AtEndOfStream UMWPFileString = UMWPFileString & File.Read(1024) 'UMWPFileString = File.ReadAll ' Don't Use the ReadAll method, it won't work because of the 'binary' file contents Loop File.Close ' Get Images Folder Path from UMAutoChanger.wallpaper file data NumMonitors = AscB((Mid(UMWPFileString, 8, 1))) StrucStart = 19 + (NumMonitors * 16) + 1 NumStrucs = AscB((Mid(UMWPFileString, StrucStart - 4, 1))) If (MONITOR <= NumStrucs) And (Monitor > 0) Then StrucStart = 19 + (NumMonitors * 16) + ((MONITOR - 1) * ((260 * 2) + 16)) + 1 'MsgBox("NumMonitors: " & NumMonitors & " Monitor: " & MONITOR & " StrucStart: " & StrucStart) ImageFilePath = Mid(UMWPFileString, StrucStart + 16, 520) ' MAX PATH 260 * 2 = 520 ' Rest = Mid(UMWPFileString, StrucStart + 16 + 520) ' Convert to regular string up to the last "\" WPImagesFolder = "" For i = 1 To InStrRev(ImageFilePath, "\") If Mid(ImageFilePath, i, 1) <> Chr(0) Then WPImagesFolder = WPImagesFolder & Mid(ImageFilePath, i, 1) End If Next ' Enumerate Available Image Files Dim fldWp, fileWp, nextOne, nextWp, firstWp, fileWpFullName Set fldWp = fso.GetFolder(WPImagesFolder) For Each fileWp In fldWp.Files If (Right(fileWp.Name, 4) = ".jpg") or (Right(fileWp.Name, 4) = ".bmp") Then ImageFilePath = WPImagesFolder & fileWp.Name ' MSgBox(ImageFilePath) Dim Tmp ' Convert ImageFilePath to Unicode Tmp = "" For i = 1 To Len(ImageFilePath) Tmp = Tmp & Mid(ImageFilePath, i, 1) & Chr(0) Next For i = (Len(Tmp) + 1) To 520 Tmp = Tmp & Chr(0) Next ImageFilePath = Tmp ' Refresh the our data from the file in case there is more than one instance running for other monitors ' Get UMAutoChanger.wallpaper file data Set File = fso.OpenTextFile(UMWPFolder & "UMAutoChanger.wallpaper", ForReading) UMWPFileString = "" Do until File.AtEndOfStream UMWPFileString = UMWPFileString & File.Read(1024) 'UMWPFileString = File.ReadAll ' Don't Use the ReadAll method, it won't work because of the 'binary' file contents Loop File.Close Rest = Mid(UMWPFileString, StrucStart + 16 + 520) ' Build New UltraMon Wallpaper File Data; NewUMWPFileString ' Get everything preceeding the Struc we are working on NewUMWPFileString = Mid(UMWPFileString, 1, StrucStart - 1) ' Append the first 16 bytes of the Struc we are working on NewUMWPFileString = NewUMWPFileString & Mid(UMWPFileString, StrucStart, 16) ' Append the ImageFilePath for the Struc we are working on NewUMWPFileString = NewUMWPFileString & ImageFilePath ' Append the remaining monitor Strucs NewUMWPFileString = NewUMWPFileString & Rest ' Write the New Ultra Mon Wallpaper Data String to the UltraMon UMAutoChanger.wallpaper File. Set File = fso.OpenTextFile(UMWPFolder & "UMAutoChanger.wallpaper", ForWriting, True) File.Write NewUMWPFileString File.Close ' Delete the current Changer.BMP file so UltaMon Desktop will recreate it using the new image file(s) If fso.FileExists(UMWPFolder & "UMAutoChanger.BMP") Then fso.DeleteFile(UMWPFolder & "UMAutoChanger.BMP") End If 'load next wallpaper Dim cmd : cmd = """" & UMDESKTOP_EXE & """ /load " & UMWPFolder & "UMAutoChanger.wallpaper" sh.Run cmd 'wait WScript.Sleep INTERVAL * 1000 End If Next End If Loop
Al   2006-12-25 17:24
Image file extension check case sensitive. To make case insensitive...

Replace line 132:
If (Right(fileWp.Name, 4) = ".jpg") or (Right(fileWp.Name, 4) = ".bmp") Then

With this:
If (LCase(Right(fileWp.Name, 4)) = ".jpg") or (LCase(Right(fileWp.Name, 4)) = ".bmp") Then
Al   2006-12-25 18:29
Line 74:
dirWps(0) = sh.RegRead("HKLM\Software\Realtime Soft\UltraMon\Wallpaper\All Users Wallpaper Directory")

Should be:
dirWps(1) = sh.RegRead("HKLM\Software\Realtime Soft\UltraMon\Wallpaper\All Users Wallpaper Directory")
Christian Studer   2006-12-26 12:22
Nice script! Let me know if you would want it added to the scripts page.

Christian Studer - www.realtimesoft.com
Al   2006-12-26 15:09
Sure but let me email you a newer version, including not only the two correction posted above, but also in addition to bmp and jpg, accepting pcx, png, tga, and tif, jpeg, and tiff image file extensions.

By the way, do you have any VBScript code handy for doing folder recursion?

Also any suggestions for making a single instance work for n monitors, each having their own images folder and change interval, would be welcome. WScript is sort of memory pig, like about 30MB per instance, so running an instance for each of more that a few monitors can really start to chew up a significant amount of memory.

Those are the main two additional features I'd like for the script to support.

P.S. Running this script to change the wallpaper ever 10 seconds is what revealed the MS OE task bar button growth issue.
Christian Studer   2006-12-27 10:22
I have uploaded the script, thanks!

You could get all files in a folder and subfolders with a recursive function:Set fso = CreateObject("Scripting.FileSystemObject") Set dir = fso.GetFolder("C:\Temp\") files = "" GetFiles dir, files MsgBox files Sub GetFiles(dir, files) files = files & dir.Path & ":" & vbNewline & vbNewline For Each file In dir.Files files = files & file.Name & vbNewline Next files = files & vbNewline For Each fldr In dir.SubFolders GetFiles fldr, files Next End Sub

Christian Studer - www.realtimesoft.com
Al   2006-12-27 13:05
Thanks for the code Christian,

I found similar code on internet and have folder recursion working. But since the path in UMWPAutoChanger.wallpaper now is always changing I have to choose a different means of getting the base images folder for each monitor.

Some possibilities would be:
- Get from Default.wallpaper
- Create a config file
- Hard code constant in script

Any other suggestions?
What would you recommend?
Christian Studer   2006-12-28 08:46
I would probably add a constant to the script, users may need to edit the script anyway so it shouldn't be a problem.

Christian Studer - www.realtimesoft.com
Al   2007-01-01 06:30
New script posted.

- Image folder recursion
- Random or sequential image order
- Unique change interval, image order, and image folder,
for each monitor with a single running instance of script.

http://www.realtimesoft.com/ultramon/scripts/UltraMon Wallpaper Auto Changer.vbs

Happy New Year, enjoy.
dan   2007-02-27 03:04
Hello,
I was looking for something like this for Ultramon. So how do you install/run the script?
Anla-shok   2007-02-27 06:12
I keep getting a error.
Line: 566
Char: 2
Error: Path Not Found
Code: 800A004C

Any ideas what I am doing wrong?
Christian Studer   2007-02-27 11:07
dan, see the script for information on setting it up (right-click and select Edit from the menu to open it in Notepad).

Anla-shok, you would get this error if one of the image folders doesn't exist.

Christian Studer - www.realtimesoft.com
Jer   2007-04-12 00:56
I tried to load this and got error, "Ultramon Walpaper Auto Changer Walpaper file not found, Terninating" any ideas?

Thanks
Al   2007-04-12 09:08
What version of UltraMon are you running? Only intended for version 2.71

Is the UltraMon Desktop installed?

Has an UltraMon wallpaper been created?

Follow setup instructions in the file.
Jer   2007-04-12 11:28
Thanks, I didn't have a default walpaper created.
Al   2007-04-12 11:53
You're welcome. Glad I wrote that thing. Was getting tired of staring at the same ol' wallpaper and having to manually change it on multiple monitors. Now it's all auto-magical.

http://www.realtimesoft.com/multimon/gallery_browse.asp?ID=796&date=desc&nummon=false&mon=desc
Gotanius   2007-07-02 02:43
any possibility for an update to make it work with ultramon 3.0 ?
I would really like that.
I know completely nothing about scripting so i can't do it myself =/
Gotanius   2007-07-02 04:49
well i tried some scripting.
i got not very far.
I'm stuck @ the fso.GetFile(FilePath) at line 455 =/
and i just can't see where i went wrong.
Christian Studer   2007-07-03 04:22
I have uploaded a new version of the script with support for UltraMon 3, UltraMon Wallpaper Auto Changer 2

Christian Studer - www.realtimesoft.com
Gotanius   2007-07-04 03:47
Dude your awesome!
thnx alot!
Gotanius   2007-07-04 03:59
Hmm can't edit my post,

How can i use the script for 2 monitors? I want to have 2 different wallpapers on my monitors.
How do i do that ?
Christian Studer   2007-07-04 08:22
See the script for details on configuration, to view it right-click the script in Windows Explorer and select Edit from the menu.

Christian Studer - www.realtimesoft.com
Gotanius   2007-07-04 08:33
yeah i tried, but i can't make heads or tails out of it.
Like i said, i'm a n00b @ vb (or any scripting language for that matter).
Christian Studer   2007-07-05 10:19
Basically you need to create a wallpaper named Default via UltraMon (if it doesn't exist already), then configure the wallpaper to show a different image on each monitor.

You can now select an image from the folder you want to use for each monitor.

When you start the wallpaper changer script, it will create a new wallpaper every minute using images from the same folders used by the Default wallpaper.

Christian Studer - www.realtimesoft.com
Gotanius   2007-07-05 20:19
Thnx that worked! And how can i change the interval?
I found 2 interval things in the script but i don't know which to use.
Christian Studer   2007-07-06 10:59
After running the script for the first time, you'll have a file named UMWPAutoChanger.cfg in the same folder as your Default wallpaper.

To change the interval, open this file in a text editor, for example Notepad, then change each interval as desired.

Default is 00:01:00, which means 1 minute. 00:00:30 would be 30 seconds, etc.

Christian Studer - www.realtimesoft.com
Gotanius   2007-07-06 20:43
Thnx! I got it fixed
Dave   2007-08-08 15:10
I've go this script running under XP with dual monitors, however the wallpaper doesn't change automatically.

It does update the images showing under "Wallpaper" at the appropriate interval, just not the wallpapers on screen.

I'm currently using a trial version of the 3.0.0 beta.
Are there any ideas as to why this isn't changing?
Dave   2007-08-08 15:13
An addendum to the above.

If I go into the UltraMon Wallpaper manager then select default/UMWPAutoChanger then click apply the wallpaper changes.

Without changing to default then back to UMWP Ultramon does not apply the changed wallpaper.

I just have to do this manually every time I want the wallpaper to change.
Christian Studer   2007-08-09 09:44
I have uploaded an updated version of UltraMon Wallpaper Auto Changer 2 which fixes the problem.

The original version of the script works fine on Vista, but not on XP or 2000.

Christian Studer - www.realtimesoft.com
Dave   2007-08-09 10:31
Thanks.
It's now working.

Regards,
Dave.
Dave   2007-08-09 15:47
Actually, I tell a lie. It's not working.

I've been trying to debug the script but cannot find anythign that is wrong with it.

When processing the command
cmd = """" & UMDESKTOP_EXE & """ /load " & UMWPFolder & "UMWPAutoChanger.wallpaper"

Nothing happens even tho the "UMWPAutoChanger.wallpaper" has changed.

I have found that if I run the command manually it also does nothing.
C:\Program Files\UltraMon\UltraMonDesktop.exe" /load C:\Documents and Settings\dwithnall\Application Data\Realtime Soft\UltraMon\3.0.0\Wallpapers\UMWPAutoChanger.wallpaper

However, if I run the command to load the Default.wallpaper

C:\Program Files\UltraMon\UltraMonDesktop.exe" /load C:\Documents and Settings\dwithnall\Application Data\Realtime Soft\UltraMon\3.0.0\Wallpapers\Default.wallpaper

Then run it to set the auto wallpaper it uses the new auto change datafile.

I believe there may be something in UltraMonDesktop.exe which is picking up that, even though the profile data file has change, the Wallpaper Profile has not.
As such it's not forcing the changes through.

This is similar to if you open the UI when the autochange is operating.
If you open the wallpaper dialog you can see that the background images have changed. However, if you don't change any of the settings, "Apply" is inactive and can't be used. So when you click "OK" the procedure which changes the wallpaper doesn't get activated.

But if you do change anything (Even switching back and forth between profiles) "Apply" becomes active and both "Apply" & "OK" make the changes.

Regards,
Dave.
Christian Studer   2007-08-10 03:37
I'm not sure why this wouldn't work, for me the updated version works fine on XP SP2 with UltraMon 3.0 Beta 1.

The problem with the script was that deleting the wallpaper bitmap generated by UltraMon, C:\Documents and Settings\<username>\Local Settings\Application Data\Realtime Soft\UltraMon\UltraMon Wallpaper.bmp, failed, and UltraMon then didn't create an updated bitmap when calling UltraMonDesktop.exe with the /load option. But this issue should be fixed in the new version of the script.

Christian Studer - www.realtimesoft.com
Dave   2007-08-12 14:45
I figured out the issue finally.

It turns out my profile doesn't have %LOCALAPPDATA% set.
so I changed wpBitmap to %USERPROFILE%\Local Settings\Application Data\...

and now the auto changer is working.

nfi why localappdata isn't there tho.

Regards,
Dave.
Saya   2007-08-19 02:35
I must have some setting wrong.. Trying to run the .vbs file doesn't do anything. Every time I tried to run it, it opened in my text editor... So I changed the default launch application to be Ultramon.. but selecting/trying to run it doesn't seem to do anything at all, now.
I'd really, really like to get this to work.. What am I missing?
Thanks,
~Saya
Saya   2007-08-19 02:58
yea... it's definitely not running wscript.exe... I can't figure how to get it to. :-/
Christian Studer   2007-08-19 06:47
To set this up, right-click the script, select Properties from the menu, then change 'Opens with' to wscript.exe.

Christian Studer - www.realtimesoft.com
Saya   2007-08-19 06:59
Thank you Christian!
That was definitely it!

For others' reference, I located wscript.exe in the C:\WINDOWS\system32 folder...

Thanks again.. I've missed my auto-changing wallpapers for months.
Best regards,
~Saya
X   2007-09-28 05:04
I have Vista, and set an image to default, but all I get is wallpaper not found.
X   2007-09-28 05:26
I see what is wrong now, I can not have one image across both monitors and have that single image change. I have to have different images on each monitor? But I want one to stretch across both!
X   2007-09-28 05:39
I think I tricked it.

I made the default pictures different on each monitor and let the program run. Then I deleted all the single pictures and only had the wide pictures I wanted in the folder. Then I changed the setting in Ultramon for the Autochanger file back to allow one picture across the two monitors. So I am where I want to be... a little awkwardly though.
Nick   2007-10-20 10:38
I can't get this script to run, or any other wallpaper script either. When I double-click it I get the error

---------------------------
Windows Script Host
---------------------------
Script: C:\Documents and Settings\Sleipnir\Desktop\UltraMon Wallpaper Auto Changer.vbs
Line: 295
Char: 2
Error: Unable to open registry key "HKCU\Software\Realtime Soft\UltraMon\Wallpaper\Wallpaper Directory" for reading.
Code: 80070002
Source: WshShell.RegRead


Anyone have any idea what to do here?
Christian Studer   2007-10-21 11:26
Are you using UltraMon 3?

If yes, you'll need to use the second version of the script, UltraMon Wallpaper Auto Changer 2.

Christian Studer - www.realtimesoft.com
Nick   2007-10-21 13:56
No, I'm using Ultramon 2.5 (2.5.22.0). I've tried some of the other versions and I'm getting the same error.
Christian Studer   2007-10-22 09:34
If you right-click the UltraMon icon in the system tray, do you have the Wallpaper option on the menu?

Christian Studer - www.realtimesoft.com
Nick   2007-10-22 17:59
I have an option called "Wallpaper" that takes me to UltraMon Desktop, I also have an option under shortcuts called "Change Wallpaper"
Christian Studer   2007-10-23 09:43
If you run regedit.exe, do you have the registry key 'HKEY_CURRENT_USER\Software\Realtime Soft\UltraMon\Wallpaper' and does it have the Wallpaper Directory value?

Christian Studer - www.realtimesoft.com
Nick   2007-10-23 12:28
Ha! That was the problem! I was missing that value. I put a string value in there with the directory to my wallpapers and everything is fixed. Thanks!
Menthol   2008-07-21 04:53
Having some trouble, everytime I try to run the script I just get the error "Ultramon Wallpaper Auto Changer Wallpaper file not found, Terminating."

I'm running Vista and downloaded the right version I'm sure, with Ultramon 3.0.2, just doesn't seem to want to work for me. Any suggestions?
Menthol   2008-07-21 05:01
Ah, nevermind, figured it out. For those who may be confused, you need to create a new wallpaper profile actually named "Default" if one doesn't already exist. Having a profile created by any other name is not sufficent.
dssamusaran   2008-09-03 06:41
Hello,

I've a quite big problem with the script. I'm running ultramon 3.0.2 under Win XP pro sp2

It's quite simple to explain, in fact the script only return me:

Ultramon Wallpaper Auto Changer
Wallpeper file not found, Terminating.


I tried to modify the keys to be read with those I found in my registry (for the dirWps() var, but I'm really unsure of what I'm doing, I never did vbscript, I code in java and C so I understand some things but I don't catch everything.

Have I to create manually the UMWPAutoChanger.wallpaper or is it created by the script?


Thanks a lot !
Christian Studer   2008-09-03 09:47
You'll need to have a wallpaper named Default for the script to work, see the comments at the beginning of the script file for details.

Christian Studer - www.realtimesoft.com
Mike   2008-10-17 01:40
Is there a way to have a option (or modifying the script) to only change wallpapers when the screen saver is OFF.

Thnx
Christian Studer   2008-10-17 07:11
Currently I don't see a way to detect this from the script.

Christian Studer - www.realtimesoft.com
Mike   2008-10-29 12:43
Is their a way to configure this script (or is it simply running multiple copy's, or a different script) to auto change a separate/different (random) wallpaper for each monitor?
Another side question, I can't get this script or find a script that does this for the screen saver (Go through a specified folder and randomly choose a wallpaper for both monitors/or a separate wallpaper for each). The only way I know to have the screen saver go through all my images (200+ for dual 600+ for single) is to add them manually (time consuming) and use UltraMon Screen Saver Player. Is they a program (or script) that will either add all the wallpapers for me (preferably with options like auto add with stretch/tile/etc.. and have it save it using the wallpaper name) or just simply work just like the UltraMon Wallpaper Auto Changer script but for the screen saver?
Mike   2008-10-29 14:57
never mind I got wallpaper working. But I still can't get it to work for the screen saver without adding all the wallpapers manually.
Marty   2008-11-17 01:04
I'm getting the error "Ultramon Wallpaper Auto Changer Wallpaper file not found, Terminating".

I may be trying something not supported by this script. I use 3 monitors and only triple monitor wallpapers. I see reference to creating a default waallpaper on each monitor, but if I were to do that, I would not be able to use my wallpapers. Am I asking to much of the script or am I doing something wrong?

To give you an idea of what I am using, I get my wallpapers from http://wallpaper.panedia.com/

Thanks in advance!

Marty
Marty   2008-11-17 05:50
Nevermind... I should have known with windows. Once I rebooted the script works fine.

Thanks for a great script.

Marty
Xenophod   2009-01-12 05:45
I'm not sure how I would go about editing the "UltraMon Wallpaper Auto Changer 2" VB Script to do this, so I'm throwing it out there.

I'd like to have the wall paper change on the hour. So, if I boot up at 12:55 pm I get "A" wallpaper, and when 1:00 pm rolls around, I'd like it to change to the next wallpaper, "B". Or maybe if we name the Wallpaper profiles based on 24 hour times, "1300_Foo-Blah" (for 1 pm) it will change it to that profile... based on the time...

I'm imagining a "window" type desktop where I can set "time based" images as my wallpaper at the same approximate time of day. Sun rise at 6am, afternoon for 12pm, sun set at 6pm, night scenes at 9pm.

Would that be too difficult?
Chandler   2009-06-10 19:40
Is there anyway to make a script like this (with the randomizer) that just picks from your present .wallpaper files?

A little nonsense now and then is relished by the wisest men.
-Willy Wonka-
juan   2009-10-27 07:45
hi, i want to change the interval but i'm not generating an UMWPAutoChanger.cfg file on my ultramon folder.
David S   2010-02-18 06:53
Juan.

The UMWPAutoChanger.cfg file is located here: %APPDATA%\Realtime Soft\UltraMon\3.0.x\Wallpapers
where x is the version of UltraMon that you are running.

If you are using XP and the latest version of UltraMon then the location will be C:\Documents and Settings\(username)\Application Data\Realtime Soft\UltraMon\3.0.10\Wallpapers
pgde   2010-09-14 06:24
Is anybody using this script on Win 7 Pro? If so, how do you configure it? It is not working for me, although wscript.exe is being loaded.
pgde   2010-09-14 08:28
More. For some reason the wallpaper directory is C:\Users\Peter\AppData\Roaming\Realtime Soft\UltraMon\3.0.10\Wallpapers (note the roaming in the string). Also, I have tried uninstalling and reinstalling without success.

Thx

P,
Christian Studer   2010-09-14 10:34
You only need to create a wallpaper profile named Default via UltraMon menu > Wallpaper, then for each monitor select an image from the folder you want to use for that monitor. Now run the script, it will then automatically create the config file which you can edit if necessary.

During testing on Windows 7 I noticed an issue with the script if no image is selected for a monitor (for example because it is disabled), I have fixed this issue and have uploaded an updated version of the UltraMon Wallpaper Auto Changer 2 script.

Christian Studer - www.realtimesoft.com
pgde   2010-09-15 01:24
I did all of the above, including downloading the new script and it still doesn't work. No .cfg file seems to be created. In what folder is the script supposed to be placed? This worked fine in XP before I upgraded to Win7 over the weekend. Am running the 64 bit version of both Win and UM. Is there a log file created someplace to see if there were any errors generated? BTW, wscript is being loaded fine.
Christian Studer   2010-09-15 10:31
You can place the script anywhere, location doesn't matter. The UMWPAutoChanger.cfg file gets created in the wallpaper folder, which is under C:\Users\<username>\AppData\Roaming\Realtime Soft\UltraMon\<version>\Wallpapers on Windows 7.

Do you have a file named Default.wallpaper in this folder?

Christian Studer - www.realtimesoft.com
pgde   2010-09-15 13:17
Just checked. Yes it is there.
Christian Studer   2010-09-16 09:40
Unfortunately I don't know why this wouldn't work, I just looked at the script again, you should get an error message if the script doesn't find the UltraMon wallpaper folder or can't create the config and wallpaper files.

Can you run other UltraMon scripts? Maybe you have security software installed which prevents this.

Christian Studer - www.realtimesoft.com
nonhocapito   2010-11-13 21:29
this script is fantastic and does what it is set out to do. thanks for it!

Because mankind is never happy with what it has, I too have a desiderata.

I want to be able to switch to the next image in the folder also *manually*, when I feel like it. More importantly, this should happen without interrupting the automatic change of wallpapers, but just moving it along, one change for every click, so to speak.

How about this?
Rick   2011-02-23 04:47
I'm running Ultramon 3.0.10 on Windows 7, x64. I've added a shortcut for Wallpaper Auto Changer 2 to my startup items folder. On every startup I get this error:

Auto Changer 2.vbs
Line: 804
Char: 3
Error: Permission denied
Code: 800A0046
Source: Microsoft VBScript runtime error

The script runs flawlessly when I start it manually via the Shortcuts menu. Any help for me?

Thanks.
Christian Studer   2011-02-23 09:07
You'll get this error if the script fails to delete the file 'UltraMon Wallpaper.bmp' in the folder C:\Users\<username>\AppData\Local\Realtime Soft\UltraMon.

Maybe UltraMon is accessing the file at the same time, or you have the folder on a network drive which isn't available yet. To fix this, you could delay script execution: add the following on line 68 (after Option Explicit):

WScript.Sleep 10000

This will wait for 10 seconds (= 10000 milliseconds).

Christian Studer - www.realtimesoft.com
Rick   2011-02-24 06:21
Thanks, mon. That fixed me right up. LOVE this script.
GunnzAKimbo   2011-07-11 05:23
My error

Script: C:\Users\Administrator\AppData\Roaming\Realtime Soft\UltraMon\3.1.0\Shortcuts\Ultramon Wallpaper Changer 2.vbs
Line: 296
Char: 3
Error: Library not registered
Code: 8002801D
Source: (null)
Christian Studer   2011-07-11 09:50
Please try downloading the latest version of the script, then try again. Let me know if you still get an error.

Christian Studer - www.realtimesoft.com
GunnzAKimbo   2011-07-18 13:19
Exactly the same thing. It might be my end, because i was following other instructions on changing the directory in the registry and other such things.

I just want it to cycle my multi-monitor wallpaper profiles. as my monitor array is rather unusual.

X
Christian Studer   2011-07-19 08:21
I'm not sure why you would get this error, with the latest version of the script you should only get to this line of the script if you're using version 2 of UltraMon.

Maybe there's a problem with the installation, you could try if repairing UltraMon fixes the problem. You can do this via Control Panel > Programs and Features, select UltraMon and click on Repair.

If you only want to switch between UltraMon wallpaper profiles, take a look at the ChangeWallpaperAuto2 script.

Christian Studer - www.realtimesoft.com
andrew   2011-12-04 22:11
Thanks heaps for this guys it works really well! i am using the changewallpaperauto2 and iv had no problems even for a scrip noob like my self :-)

Ps. why dont they include something like this with ultramon in the first place?
Owyn   2012-01-12 10:32
Thank you so much for this., simply the best thing for UltraMon, ever.

Still trying to work out how to apply shuffle to it, though. Cannot find this aforementioned .cfg file.
Owyn   2012-01-12 11:00
Update: All sorted now, for some reason it was selected as "hidden".

Again, amazing script. Thank you!
Owyn   2012-01-15 01:31
Can someone please paste the contents of their UMWPAutoChanger.cfg here for me please? I was twatting around with mine and managed to fuck it up so the path has disappeared and I cannot recall how it looked.

Thanks.
Christian Studer   2012-01-15 02:43
Here's how this should look like:

1,00:00:05,Sequential,C:\Pictures 1
2,00:00:05,Sequential,C:\Pictures 2

Format is <monitor number>,<interval>,<ordering>,<picture folder>.

Christian Studer - www.realtimesoft.com
Jae   2012-02-03 18:34
I'm getting a similar error but not exactly with an earlier person, this is with the latest version of the script and ultramon 3 on Win7:
Script: J:\Downloads\UltraMon Wallpaper Auto Changer 2.vbs
Line 296
Char: 3
Error: Invalid root in registry key "HKCU\Software\RealtimeSoft\UltraMon\Wallpaper\Wallpaper Directory"/
Code: 80070002
Source: WshShell.RegRead

I noticed that the directory isn't correct, its not including the version and I don't have a 'Wallpaper Directory' within 'Wallpaper'. (Creating/Correcting it did not help)
Christian Studer   2012-02-04 08:17
You'll get this if the script fails to read the UltraMon version number, and then assumes you have version 2 of UltraMon installed. Most likely this is a permissions issue.

The version number is stored in the registry under HKEY_LOCAL_MACHINE\SOFTWARE\Realtime Soft\UltraMon, value CurrentVersion. To check permissions, right-click the key and select Permissions from the menu, then make sure your user account has at least read permissions.

Christian Studer - www.realtimesoft.com
Jae   2012-02-04 10:42
Thank you for the quick response, I did check the file, which had read access and I even tried setting all accounts to full access but it does not appear to have helped.
When I first tried to set it up, I noticed that I did not have a UMWPAutoChanger.cfg file, so I created it with the following entries:
1,00:00:05,Sequential,I:\D Drive\Images\wallpaper
2,00:00:05,Sequential,I:\D Drive\Images\wallpaper

This was created in: C:\Users\Qkrwogud\AppData\Roaming\Realtime Soft\UltraMon\3.0.6\Wallpapers
Christian Studer   2012-02-04 23:41
Do you have the CurrentVersion value under HKEY_LOCAL_MACHINE\SOFTWARE\Realtime Soft\UltraMon, and what is its value?

Christian Studer - www.realtimesoft.com
Jae   2012-02-06 07:40
Yes, I do have that key and its value is 3.0.6
It is type REG_SZ and permissions look fine.
Christian Studer   2012-02-06 09:00
Do you have any security software (antivirus, firewall) installed which could prevent the script from reading the version from the registry? Apart from that I don't know what else might cause this.

Christian Studer - www.realtimesoft.com
Jae   2012-02-08 21:36
I've tried turning everything off but didn't help, I appreciate you trying to help though, so thanks for your effort and time :)
Christian Studer   2012-02-09 07:59
I just thought of something else which might cause this: if you're on 64-bit Windows, but scripts get executed in 32-bit mode for some reason (the default is 64-bit), the script wouldn't find the CurrentVersion registry setting because this only exists in the 64-bit registry.

To check if that's the problem, please run GetUmVer.vbs and let me know what message you get.

Christian Studer - www.realtimesoft.com
Jae   2012-02-09 10:09
Yes I'm running 64 bit Windows 7, heres a screenshot of the error I get: http://i40.tinypic.com/2lvo946.png
Christian Studer   2012-02-10 10:37
That's indeed the error you would get when the script is running in 32-bit mode.

I'm not sure why this would be the case on your system, but there's an easy fix for this: instead of running the script directly, create a new shortcut and enter the following command:

%WINDIR%\system32\wscript.exe <script>

for example:

%WINDIR%\system32\wscript.exe "C:\Temp\UltraMon Wallpaper Auto Changer 2.vbs"

This will force the script to get executed by the 64-bit script engine.

Christian Studer - www.realtimesoft.com
Ernie   2013-09-04 06:20
Not sure if this helps anyone or not but just in case. I have been using UM for a while and I had to adjust the script to account for when I am docked and undocked since I have a laptop and often run on single screen. I just added a third monitor so now I can have a 3 monitor setup at work, 2 monitor at home (have a dock for it) or 1 when undocked.

So I had to adjust the code further so it will work for any number of monitors (limited by whatever windows/UM can handle). Below is the code. The trick is to create wallpaper profiles for each scenario with the format "X_Monitor.wallpaper" where X is the number of monitors. So I have three files in my AppData\Roaming\Realtime Soft\UltraMon\3.2.2\Wallpapers folder: "3_Monitor.wallpaper", "2_Monitor.wallpaper" or "1_Monitor.wallpaper" in my . I have some more details in the comments of the script below. I have done limited testing and it seems to work so far.

' UltraMon Wallpaper Auto Changer ' Version: 1.0.0 ' Date: Sep 14, 2010, Sep 09, 2013 (Ernie Salazar) ' Fixes: ' ConfigFileMonInfo and ImageFileSelector now correctly handle monitors which have no image folder specified ' Version History - See end of this script file ' Syntax: ' UltraMon Wallpaper Auto Changer.vbs ' Usage: ' Set UltraMon 'Default' wallpaper for each monitor ' to an image in a folder containing images for that monitors wallpaper. ' Run UltraMon Wallpaper Auto Changer. ' To alter the change interval, image order, or images folder, for each monitor, ' edit the 'UMWPAutoChanger.cfg' file, located in the UltraMon Wallpapers folder. ' To prevent the wallpaper of a monitor from being changed, set the interval to zero (00:00:00). ' Configuration file format is comma separated, (spaces permitted but not tabs) as follows: ' Monitor Number, Change Interval (hh:mm:ss), Order (Random, Sequential), Images Folder Path ' Initial Defaults are: ' <Monitor Number>,00:01:00,Sequential,<image folder path from UltraMon Default Wallpaper> ' Typical UltraMon wallpaper folder location is: ' 'My Documents\My Wallpapers' or 'All Users\Documents\Shared Wallpapers' for UltraMon 2, ' %APPDATA%\Realtime Soft\UltraMon\<version>\Wallpapers for UltraMon 3. ' To stop the 'UltraMon Wallpaper Auto Changer', use task manager to end the 'wscript.exe' process. ' Images folder can contain shortcuts to image files, rather than being duplicates. ' Folder shortcuts though are disabled by default. ' To enable/disable folder shortcuts support, set 'FolderShortcuts' constant in code below to 'True'/'False'. ' There is a significant processing hit when Folder Shortcuts are enabled. Default is disabled ('False'). ' Making configuration changes on the fly: ' Changes to the UltraMon 'Default' wallpaper are applied to ‘UMWPAutoChanger’ at the next change interval. ' Changes to the UltraMon 'UMWPAutoChanger' wallpaper are applied at the next change interval, ' except image path, which always comes from the UltraMon 'Default.wallpaper' file. ' Changes made to the 'UMWPAutoChanger.cfg' configuration file are applied at the next 'SleepTimeSec' interval. ' How it Works Overview: ' Looks in personal Users UltraMon wallpaper folder for 'Default.wallpaper', ' if found copies it to 'UMWPAutoChanger.wallpaper'. ' If 'Default.wallpaper' file was not found in the personal users UltraMon wallpaper folder, ' then looks in All Users UltraMon wallpaper folder for 'Default.wallpaper', ' if found copies it to 'UMWPAutoChanger.wallpaper'. ' Obtains images folder paths of each monitor from strucs in 'Default.wallpaper'. ' Creates a configuration file for storing - ' monitor number, interval, image order, and images folder path for each monitor. ' Selects an image file from the images folder of each monitor to be changed. ' Updates the struc of each monitor to be changed in 'UMWPAutoChanger.wallpaper' with new image path. ' Runs 'UltraMonDesktop.exe' to have UltraMon rebuild the wallpaper. ' Repeats loop to change the wallpaper at specified interval. 'UPDATE - ERNIE SALAZAR: ' The UMWPAutoChanger.wallpaper files is no longer used in lieu of 'UMProfile' variable. ' UMProfile stores the wallpaper file name based on the number of monitors. Create a .wallpaper ' file for each configuration and name them "X_Monitor.wallpaper" where X is the number of monitors. So ' for a 3 screen setup, create the following profiles files: "3_Monitor.wallpaper", "2_Monitor.wallpaper" ' or "1_Monitor.wallpaper" in the UltraMon configuration tool. (note the .wallpaper extension is ' automatically added by UltraMon when saved) Remember to update the 'UMWPAutoChanger.cfg' file. Option Explicit 'Const UMDESKTOP_EXE = "%ProgramFiles%UltraMon\UltraMonDesktop.exe" ' This is obtained dynamically now. Const FolderShortcuts = False ' Disabled (False) by default. See 'Usage' for additional information. Const SleepTimeSec = 60 ' How often to check if a monitors wallpaper needs changed, in seconds. ' UltraMon Wallpaper file structure positions/lengths. Const wpfsNumMonPos = 8 ' Position for Number of Monitors Const wpfsHeaderLen = 19 ' Number of Bytes Preceeding Monitor Structures (excluding Monitor Rectangles) Const wpfsMonRectLen = 16 ' Length of Each Monitor Rectangle (16 bytes each) Const wpfsMaxPathLen = 260 ' Maximum Path Length Const wpfsMonStrucHeadLen = 16 ' Background, Color 1, Color 2, Image Style (4 bytes each) 'Ernie Salazar Const MonitorProfileSufix = "_Monitor.wallpaper" Dim UMProfile Dim UMDESKTOP_EXE, UMWPFolder, UMWPBitmap Dim MonStrucStart, NumStrucs, NumMonitors ' Re-Sized in ConfigFileMonInfo() ' Offset '0' ingnored/unused. Offset '1' = Monitor '1', etc. Dim IntervalSec(), IntervalTimerSec() Dim ImagesOrder(), ImageFileNum(), ImagesFolder() 'WScript Shell Dim sh Set sh = CreateObject("WScript.Shell") 'FSO Const ForReading = 1, ForWriting = 2, ForAppending = 8 Const Create = True, DontCreate = False Const SysDefault = -2, Unicode = -1, ASCII = 0 Const OverWrite = True, DontOverWrite = False Const OverRideReadOnlyAttribute = True, HonorReadOnlyAttribute = False Dim fso Set fso = CreateObject("Scripting.FileSystemObject") ' Start Here Start() Sub Start() If UltraMonWallpaperMangerInstalled() Then 'Delay to allow windows to fully boot (60 secs), Ernie Salazar WScript.Sleep(60 * 1000) 'Determine the profile based on the number of monitors, Ernie Salazar Dim sys Set sys = CreateObject("UltraMon.System") UMProfile = Trim(sys.NumActiveMonitors) & MonitorProfileSufix SetFileLocations UMWPFolder, UMWPBitmap ' Update config file <interval>,<units> format to hh:mm:ss ' This can be removed once previous config file format has been converted. cfgFileIntervalTimeFormatChange() Initialize() TimerLoop() Else MsgBox( _ "UltraMon Wallpaper Manager installation location could not be found." & vbCr & _ "Terminating UltraMon Wallpaper Auto Changer.") End If End Sub ' Nerver ending loop to check if wallpaper needs changed. Sub TimerLoop() Do While True UpdateNeededCheck() 'wait WScript.Sleep(SleepTimeSec * 1000) Loop End Sub ' Check if it is time to change wallpaper for any of the monitors. Sub UpdateNeededCheck() Dim ChangesMade, UMWPFileData, i ChangesMade = False UMWPFileData = "" '****************************************************************** 'Determine how many monitors and set the profile, Ernie Salazar Dim sys Set sys = CreateObject("UltraMon.System") UMProfile = Trim(sys.NumActiveMonitors) & MonitorProfileSufix Initialize() '****************************************************************** ChangesMade = CfgFileChangeCheck(UMWPFileData) For i = 1 To NumMonitors If IntervalSec(i) > 0 Then ' Skip Monitor if this is not set to greater than zero. If IntervalTimerSec(i) <= 0 Then ' Refresh data from the file to ensure we have most recent data. If Len(UMWPFileData) < 1 Then ' Get UMWPAutoChanger.wallpaper file data. 'UMWPFileData = GetFileData(UMWPFolder & "UMWPAutoChanger.wallpaper") UMWPFileData = GetFileData(UMWPFolder & UMProfile) 'Ernie Salazar End If UpdateWallpaperFileData i, UMWPFileData IntervalTimerSec(i) = IntervalSec(i) ChangesMade = True End If IntervalTimerSec(i) = IntervalTimerSec(i) - SleepTimeSec End If Next If ChangesMade Then ApplyWallpaperChanges(UMWPFileData) UMWPFileData = "" End If End Sub ' Check if configuration file (.cfg) has changed (newer than UMWPAC wallpaper file) ' If changed, update wallpaper file for all monitors and return 'True'. Function CfgFileChangeCheck(ByRef UMWPFileData) ' Initialize Return Value CfgFileChangeCheck = False 'Make sure the profile var is there as well as the autochanger config file - Ernie Salazar 'If fso.FileExists(UMWPFolder & "UMWPAutoChanger.wallpaper") Then If fso.FileExists(UMWPFolder & UMProfile) And fso.FileExists(UMWPFolder & "UMWPAutoChanger.cfg") Then Dim wpFile, cfgFile Set cfgFile = fso.GetFile(UMWPFolder & "UMWPAutoChanger.cfg") 'use the profile var instead - Ernie Salazar 'Set wpFile = fso.GetFile(UMWPFolder & "UMWPAutoChanger.wallpaper") Set wpFile = fso.GetFile(UMWPFolder & UMProfile) If cfgFile.DateLastModified > wpFile.DateLastModified Then ConfigFileMonInfo() Dim i For i = 1 To NumMonitors If IntervalSec(i) > 0 Then ' Skip Monitor if this is not set to > zero. If Len(UMWPFileData) < 1 Then ' Get UMWPAutoChanger.wallpaper file data. 'Use the profile var instead - Ernie Salazar 'UMWPFileData = GetFileData(UMWPFolder & "UMWPAutoChanger.wallpaper") UMWPFileData = GetFileData(UMWPFolder & UMProfile) End If UpdateWallpaperFileData i, UMWPFileData End If Next For i = 1 To UBound(IntervalSec) IntervalTimerSec(i) = IntervalSec(i) Next CfgFileChangeCheck = True End If End If End Function ' Get wallpaper file contents, Initialize variables, create/update files if need be. Sub Initialize() Dim UMWPFileData CopyUMDefaultWallpaper() 'Use the profile var instead - Ernie Salazar 'UMWPFileData = GetFileData(UMWPFolder & "UMWPAutoChanger.wallpaper") UMWPFileData = GetFileData(UMWPFolder & UMProfile) MonStrucsInfo 1, UMWPFileData CreateUpdateConfigFile(UMWPFileData) ConfigFileMonInfo() End Sub ' Determine if and where UltraMon Wallpaper Manager is installed. Function UltraMonWallpaperMangerInstalled() Dim msi, cmpIds(2), umDesktopExe, prod, i ' Initialize Return Value UltraMonWallpaperMangerInstalled = False Set msi = CreateObject("WindowsInstaller.Installer") 'Dim cmpIds 'cmpIds = Array("", "{BEDCF68A-6628-48D7-ABA9-85A28ACE5B6C}", "{B8105F70-BFBE-4FCC-99B7-81417F56AAF6}") 'cmpIds(0) = "" cmpIds(1) = "{BEDCF68A-6628-48D7-ABA9-85A28ACE5B6C}" cmpIds(2) = "{B8105F70-BFBE-4FCC-99B7-81417F56AAF6}" i = 1 umDesktopExe = "" Do While umDesktopExe = "" And i <= UBound(cmpIds) For Each prod In msi.ComponentClients(cmpIds(i)) umDesktopExe = msi.ComponentPath(prod, cmpIds(i)) Exit For Next i = i + 1 Loop If Len(umDesktopExe) > 0 Then UMDESKTOP_EXE = umDesktopExe UltraMonWallpaperMangerInstalled = True End If End Function ' Get location of the wallpaper folder and the wallpaper bitmap file. Sub SetFileLocations(wpFolder, wpBitmap) wpFolder = "" wpBitmap = "" 'check if UltraMon 3 or later is installed Dim umVer : umVer = "" On Error Resume Next umVer = sh.RegRead("HKLM\Software\Realtime Soft\UltraMon\CurrentVersion") On Error Goto 0 'get the location of the wallpaper folder(s) Dim dirWps(1) If umVer = "" Then 'UltraMon 2, location of the user and shared wallpaper folders stored in the registry 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") Else 'UltraMon 3 or later, wallpaper folder is at a known location dirWps(0) = sh.ExpandEnvironmentStrings("%APPDATA%\Realtime Soft\UltraMon\" & umVer & "\Wallpapers") End If Dim i For i = 0 To UBound(dirWps) If dirWps(i) <> "" Then If Right(dirWps(i), 1) <> "\" Then dirWps(i) = dirWps(i) & "\" 'Use the profile var instead - Ernie Salazar 'If fso.FileExists(dirWps(i) & "UMWPAutoChanger.wallpaper") Or fso.FileExists(dirWps(i) & "Default.wallpaper") Then If fso.FileExists(dirWps(i) & UMProfile) Or fso.FileExists(dirWps(i) & "Default.wallpaper") Then wpFolder = dirWps(i) Exit For End If End If Next If wpFolder = "" Then MsgBox( _ "UltraMon Wallpaper Auto Changer" & vbCr & _ "Wallpaper file not found, Terminating.") WScript.Quit() End If 'get the name of the wallpaper bitmap file If umVer = "" Then 'UltraMon 2, bitmap file in same folder as wallpaper file wpBitmap = wpFolder & "UMWPAutoChanger.bmp" Else 'UltraMon 3 or later, bitmap stored in local user data folder wpBitmap = sh.ExpandEnvironmentStrings("%LOCALAPPDATA%\Realtime Soft\UltraMon\UltraMon Wallpaper.bmp") If InStr(wpBitmap, "%LOCALAPPDATA%") <> 0 Then '%LOCALAPPDATA% is only available on Vista and later, construct the path manually wpBitmap = sh.ExpandEnvironmentStrings("%USERPROFILE%") & "\Local Settings\Application Data\Realtime Soft\UltraMon\UltraMon Wallpaper.bmp" End If End If End Sub ' Create or update auto changer wallpaper file from copy of the UltraMon Default wallpaper file. Function CopyUMDefaultWallpaper() Dim DefaultWP, UMWPAC ' Initialize Return Value CopyUMDefaultWallpaper = False ' Copy 'Personal' or 'All Users' Default.wallpaper file to UMWPAutoChanger.wallpaper, unless already exists. 'Use the profile var instead - Ernie Salazar If fso.FileExists(UMWPFolder & "Default.wallpaper") _ And Not fso.FileExists(UMWPFolder & UMProfile) Then 'And Not fso.FileExists(UMWPFolder & "UMWPAutoChanger.wallpaper") Then CopyUMDefaultWallpaper = True ' If Default.wallpaper is newer, copy it to UMWPAutoChanger.wallpaper. ElseIf fso.FileExists(UMWPFolder & "Default.wallpaper") _ And fso.FileExists(UMWPFolder & "UMWPAutoChanger.wallpaper") Then 'Ernie Salazar 'And fso.FileExists(UMWPFolder & "UMWPAutoChanger.wallpaper") Then Set DefaultWP = fso.GetFile(UMWPFolder & "Default.wallpaper") 'Set UMWPAC = fso.GetFile(UMWPFolder & "UMWPAutoChanger.wallpaper") Set UMWPAC = fso.GetFile(UMWPFolder & UMProfile) 'Ernie Salazar If DefaultWP.DateLastModified > UMWPAC.DateLastModified Then CopyUMDefaultWallpaper = True End If End If If CopyUMDefaultWallpaper Then 'Use the profile var instead - Ernie Salazar 'fso.CopyFile UMWPFolder & "Default.wallpaper", UMWPFolder & "UMWPAutoChanger.wallpaper", OverWrite fso.CopyFile UMWPFolder & "Default.wallpaper", UMWPFolder & UMProfile, OverWrite End If End Function ' Create or update auto changer configuration file from info obtained from the UltraMon Default wallpaper file. Sub CreateUpdateConfigFile(ByRef UMWPFileData) Dim Create, Update, FileText, cfgFile, wpFile Create = False 'Use the profile var instead - Ernie Salazar If fso.FileExists(UMWPFolder & "Default.wallpaper") _ And fso.FileExists(UMWPFolder & UMProfile) _ And Not fso.FileExists(UMWPFolder & "UMWPAutoChanger.cfg") Then 'And fso.FileExists(UMWPFolder & "UMWPAutoChanger.wallpaper") Then Create = True End If Update = False If fso.FileExists(UMWPFolder & "Default.wallpaper") _ And fso.FileExists(UMWPFolder & "UMWPAutoChanger.cfg") Then Set wpFile = fso.GetFile(UMWPFolder & "Default.wallpaper") Set cfgFile = fso.GetFile(UMWPFolder & "UMWPAutoChanger.cfg") If wpFile.DateLastModified > cfgFile.DateLastModified Then Set cfgFile = fso.OpenTextFile(UMWPFolder & "UMWPAutoChanger.cfg", ForReading, DontCreate, ASCII) FileText = cfgFile.ReadAll cfgFile.Close() Update = True End If End If If Update Or Create Then Dim WPImagesFolder, ImageFilePath, Lines, FileLines, LnPos, UnicodeImageFilePath, i, j Lines = "" FileLines = Split(FileText, vbNewLine) For i = 1 To NumStrucs ' Calculate Position of 'Unicode' Image File Path in UltraMon Wallpaper File Data. LnPos = MonStrucStart + ((i - 1) * ((wpfsMaxPathLen * 2) + wpfsMonStrucHeadLen)) + wpfsMonStrucHeadLen ' Get 'Unicode' Image File Path from UltraMon Wallpaper File. UnicodeImageFilePath = Mid(UMWPFileData, LnPos, wpfsMaxPathLen * 2) ' Convert 'Unicode' Image File Path to Regular String. ImageFilePath = Replace(UnicodeImageFilePath, Chr(0), "") ' Get just the folder path portion of ImageFilePath (everything to last backslash). WPImagesFolder = Mid(ImageFilePath, 1, InStrRev(ImageFilePath, "\")) ' Get a config file line. Dim LineUpdated, Line, Count LineUpdated = False For Each Line In FileLines Count = InStr(1, Line, ",") - 1 If Count > 0 Then If Trim(Mid(Line, 1, Count)) = CStr(i) Then ' Update with new images folder path. LnPos = 1 For j = 1 To 3 LnPos = InStr(LnPos, Line, ",") + 1 Next Lines = Lines & Mid(Line, 1, LnPos - 1) & WPImagesFolder & vbNewLine LineUpdated = True End If End If Next ' If an existing entry for monitor was not found, create a new defalut entry with folder path. If Not LineUpdated Then Lines = Lines & i & ",00:01:00,Sequential," & WPImagesFolder & vbNewLine End If Next Set cfgFile = fso.OpenTextFile(UMWPFolder & "UMWPAutoChanger.cfg", ForWriting, Create, ASCII) cfgFile.Write(Lines) cfgFile.Close() End If End Sub ' Obtain UltraMon wallpaper file contents. Function GetFileData(ByRef FilePath) ' Initialize Return String 'GetFileData = "" Dim File, FileData, FileString Set File = fso.GetFile(FilePath) Set FileData = fso.OpenTextFile(File, ForReading, DontCreate, ASCII) GetFileData = FileData.Read(File.Size) ' Don't Use the ReadAll method, it won't work because of the 'binary' file contents 'GetFileData = FileData.ReadAll FileData.Close() End Function ' Calculate and set values we need from UltraMon wallpaper file data. Sub MonStrucsInfo(ByRef MonNum, ByRef UMWPFileData) ' Get Number of Monitors, Monitor Strucs and Struc Posistion ' from UMWPAutoChanger.wallpaper file data NumMonitors = Asc(Mid(UMWPFileData, wpfsNumMonPos, 1)) NumStrucs = Asc(Mid(UMWPFileData, wpfsHeaderLen + (NumMonitors * wpfsMonRectLen) + 1 - 4)) MonStrucStart = wpfsHeaderLen + (NumMonitors * wpfsMonRectLen) + ((MonNum - 1) * ((wpfsMaxPathLen * 2) + wpfsMonStrucHeadLen)) + 1 ' MsgBox( _ ' "MonStrucsInfo" & vbCr & _ ' "Monitor Number: " & MonNum & vbCr & _ ' "Monitors: " & NumMonitors & vbCr & _ ' "Strucs: " & NumStrucs & vbCr & _ ' "Struc Start: " & MonStrucStart) End Sub ' Load information from auto changer config file into variables. Sub ConfigFileMonInfo() Dim FileText, FileLines, cfgFile Dim Hours, Minutes, Seconds Dim Line, LnPos, Count, MonNum, Size Set cfgFile = fso.OpenTextFile(UMWPFolder & "UMWPAutoChanger.cfg", ForReading, DontCreate, ASCII) FileText = cfgFile.ReadAll cfgFile.Close() FileLines = Split(FileText, vbNewLine) ' Remove trailing blank lines Do While Len(FileLines(UBound(FileLines))) <= 0 ReDim Preserve FileLines(UBound(FileLines) - 1) Loop ' Get number of config file lines. Size = UBound(FileLines) ' Set array size to greater of monitors, monitor structures, or config file lines. If NumStrucs > Size Then Size = NumStrucs If NumMonitors > Size Then Size = NumMonitors ReDim Preserve IntervalSec(Size + 1) ReDim Preserve IntervalTimerSec(Size + 1) ReDim Preserve ImagesOrder(Size + 1) ReDim Preserve ImageFileNum(Size + 1) ReDim Preserve ImagesFolder(Size + 1) ' Update Parameters Arrays For All Monitors In Config File For Each Line In FileLines ' If line doesn't have at least one ',' then don't get anymore lines. If InStr(1, Line, ",") <= 0 Then Exit For ' Get Monitor Number LnPos = 1 Count = InStr(LnPos, Line, ",") - LnPos MonNum = CInt(Trim(Mid(Line, LnPos, Count))) 'MonNumber(MonNum) = CInt(Trim(Mid(Line, LnPos, Count))) ' Get Hours LnPos = LnPos + Count + 1 Count = InStr(LnPos, Line, ":") - LnPos Hours = CInt(Trim(Mid(Line, LnPos, Count))) ' Get Minutes LnPos = LnPos + Count + 1 Count = InStr(LnPos, Line, ":") - LnPos Minutes = CInt(Trim(Mid(Line, LnPos, Count))) ' Get Seconds LnPos = LnPos + Count + 1 Count = InStr(LnPos, Line, ",") - LnPos Seconds = CInt(Trim(Mid(Line, LnPos, Count))) ' Convert Hours, Minutes & Seconds to Seconds IntervalSec(MonNum) = (Hours * 3600) + (Minutes * 60) + Seconds ' Get Order LnPos = LnPos + Count + 1 Count = InStr(LnPos, Line, ",") - LnPos ImagesOrder(MonNum) = Trim(Mid(Line, LnPos, Count)) ' Get Images Folder LnPos = LnPos + Count + 1 Count = InStr(LnPos, Line, ",") - LnPos ImagesFolder(MonNum) = Trim(Mid(Line, LnPos)) ' To End of Line ' Add trailing backslash to Images Folder if not present If ImagesFolder(MonNum) <> "" Then If Right(ImagesFolder(MonNum), 1) <> "\" Then ImagesFolder(MonNum) = ImagesFolder(MonNum) & "\" End If ' MSgBox( _ ' "Config File Mon Info" & vbCR & _ ' "Monitor: " & MonNum & vbCR & _ ' "Interval: " & Hours & ":" & Minutes & ":" & Seconds & vbCR & _ ' "Order: " & ImagesOrder(MonNum) & vbCR & _ ' "WP Images folder: " & ImagesFolder(MonNum)) Next End Sub ' Determine which image file to select. Function ImageFileSelector(ByRef MonNum) If ImagesFolder(MonNum) = "" Then ImageFileSelector = "" Exit Function End If Dim ImageFileCount, objFolder If ImageFileNum(MonNum) < 1 Then ImageFileNum(MonNum) = 1 ' Enumerate Available Image Files and Select Next One Set objFolder = fso.GetFolder(ImagesFolder(MonNum)) If LCase(ImagesOrder(MonNum)) = "random" Then Dim Max, Min ImageFileNum(MonNum) = 4294967296 ' Supposedly 4 Giga Files is maximum for an NTFS volume ImageFileCount = 1 SelectImageFile MonNum, objFolder, ImageFileCount Max = ImageFileCount - 1 Min = 1 Randomize ' Give Rnd a new seed value so same random order is not repeated. ImageFileNum(MonNum) = Int((Max - Min + 1) * Rnd() + Min) ElseIf LCase(ImagesOrder(MonNum)) = "Sequential" Then End If ImageFileCount = 1 ImageFileSelector = SelectImageFile(MonNum, objFolder, ImageFileCount) 'If ImageFileSelector = False Then If Len(ImageFileSelector) < 1 Then ImageFileNum(MonNum) = 1 ImageFileCount = 1 ImageFileSelector = SelectImageFile(MonNum, objFolder, ImageFileCount) 'If ImageFileSelector = False Then If Len(ImageFileSelector) < 1 Then MsgBox( _ "UltraMon Wallpaper Auto Changer" & vbCr & _ "No Images Found in: " & vbCr & _ ImagesFolder(MonNum) & vbCr & _ "Terminating.") WScript.Quit() End If End If ImageFileNum(MonNum) = ImageFileNum(MonNum) + 1 End Function ' Locate image file selected and return full path to target. Function SelectImageFile(ByRef MonNum, ByVal objFolder, ByRef ImageFileCount) 'SelectImageFile = False SelectImageFile = "" Dim objSubFolder If objFolder.Files.Count + ImageFileCount > ImageFileNum(MonNum) Then ' This folder has the file we want. Dim File For Each File In objFolder.Files If (ImageFileCount = ImageFileNum(MonNum)) Then ' This is file 'number' we want. Dim FilePath, FileExtn If File.Type = "Shortcut" Then 'Get target path) Dim Link set Link = sh.CreateShortcut(File) FilePath = Link.targetpath Else ' Not a shortcut so use path and name directly. FilePath = File.Path End If ' Get Image File Extension and Convert to Non-Cap Letters FileExtn = LCase(Mid(FilePath, InStrRev(FilePath, ".") + 1)) Select Case (FileExtn) ' Only use if file has 'blessed' image file extension. Case "bmp", "jpg", "pcx", "png", "tga", "tif", "jpeg", "tiff" If (fso.FileExists(FilePath)) Then ' Proceed with this file. SelectImageFile = FilePath Else ' Probably a folder shortcut. SelectImageFile = "" ImageFileNum(MonNum) = ImageFileNum(MonNum) + 1 End If Case Else ' Not a 'blessed' image file extension. SelectImageFile = "" ImageFileNum(MonNum) = ImageFileNum(MonNum) + 1 End Select End If ' Increment counter until it is passed the correct image file. ImageFileCount = ImageFileCount + 1 If ImageFileCount > ImageFileNum(MonNum) Then Exit Function Next Else ' This folder doesn't have the file we want, continue on to next subfolder. ImageFileCount = ImageFileCount + objFolder.Files.Count End If ' Folder Shortcuts - Disabled (False) by default. See 'Usage' for additional information. ' There is a significant processing hit when Folder Shortcuts are enabled. Default is disabled ('False'). ' There must be a more efficient method of determining if target of shortcut is a folder. ' The processing hit comes from having to sift through all the image files and shortcuts to identify folder shortcuts. If FolderShortcuts Then ' Recursion through all the folder shortcuts 'Dim File For Each File In objFolder.Files If ImageFileCount > ImageFileNum(MonNum) Then Exit Function If File.Type = "Shortcut" Then ' Remove shortcut file extension (.lnk). Dim FileName FileName = Mid(File.Name, 1, InStrRev(File.Name, ".") - 1) FileExtn = LCase(Mid(FileName, InStrRev(FileName, ".") + 1)) ' Exclude image files Select Case (FileExtn) Case "bmp", "jpg", "pcx", "png", "tga", "tif", "jpeg", "tiff" ' A 'blessed' image file extension - Do nothing (skip it). Case Else ' Not a 'blessed' image file extension - proceed. Dim FolderPath set Link = sh.CreateShortcut(File) FolderPath = Link.targetpath If (fso.FolderExists(FolderPath)) Then ' Proceed with this folder. Set objSubFolder = fso.GetFolder(FolderPath) SelectImageFile = SelectImageFile(MonNum, objSubFolder, ImageFileCount) End If End Select End If Next End If ' Recursion through all the sub-folders For Each objSubFolder In objFolder.SubFolders If ImageFileCount > ImageFileNum(MonNum) Then Exit Function SelectImageFile = SelectImageFile(MonNum, objSubFolder, ImageFileCount) Next End Function ' Update the UltraMon Wallpaper Auto Changer file data string with path to newly seleted image file. Sub UpdateWallpaperFileData(ByRef MonNum, ByRef UMWPFileData) Dim NewUMWPFileData, ImageFilePath, UnicodeImageFilePath, i ' Build New UltraMon Wallpaper File Data ' If changes have been made to Default.wallpaper, ' Update UMWPAutoChanger.wallpaper and config file by reinitializing. If CopyUMDefaultWallpaper() Then Initialize() ' Select an image file from monitor specific folder ImageFilePath = ImageFileSelector(MonNum) ' Convert regular image file path string to 'unicode'. UnicodeImageFilePath = "" For i = 1 To Len(ImageFilePath) UnicodeImageFilePath = UnicodeImageFilePath & Mid(ImageFilePath, i, 1) & Chr(0) Next ' Fill to max path length UnicodeImageFilePath = UnicodeImageFilePath & String((wpfsMaxPathLen * 2) - Len(UnicodeImageFilePath), Chr(0)) ' Refresh Monitor Struc Info for MonNum from UMWPFileData. MonStrucsInfo MonNum, UMWPFileData ' Update the UltraMon Wallpaper File Data with new Image File Path. ' Get everything preceding the File Path. ' (everything preceding the Struc we are working on, pluse the first 16 bytes of the Struc we are working on) NewUMWPFileData = Mid(UMWPFileData, 1, MonStrucStart - 1 + wpfsMonStrucHeadLen) ' Append the ImageFilePath for the Struc we are working on NewUMWPFileData = NewUMWPFileData & UnicodeImageFilePath ' Append all remaining monitor Strucs. NewUMWPFileData = NewUMWPFileData & Mid(UMWPFileData, MonStrucStart + wpfsMonStrucHeadLen + (wpfsMaxPathLen * 2)) ' Save the new file data string. UMWPFileData = NewUMWPFileData End Sub ' Apply updated UltraMon Wallpaper. Sub ApplyWallpaperChanges(ByRef NewUMWPFileData) ' Write the New Ultra Mon Wallpaper Data String to the UMWPAutoChanger.wallpaper File. Dim UMWPACFile 'Set UMWPACFile = fso.OpenTextFile(UMWPFolder & "UMWPAutoChanger.wallpaper", ForWriting, Create, ASCII) Set UMWPACFile = fso.OpenTextFile(UMWPFolder & UMProfile, ForWriting, Create, ASCII) 'Ernie Salazar UMWPACFile.Write(NewUMWPFileData) UMWPACFile.Close() ' Delete current wallpaper bitmap (UMWPAutoChanger.BMP) ' so UltaMon Desktop will recreate it with the new images. If fso.FileExists(UMWPBitmap) Then fso.DeleteFile UMWPBitmap, OverRideReadOnlyAttribute End If ' Have UltraMon Rebuild and Apply the New Wallpaper Dim cmd cmd = """" & UMDESKTOP_EXE & """ /load " & UMWPFolder & UMProfile 'Ernie Salazar 'cmd = """" & UMDESKTOP_EXE & """ /load " & UMWPFolder & "UMWPAutoChanger.wallpaper" sh.Run(cmd) End Sub ' Update config file <interval>,<units> format to hh:mm:ss ' This subroutine can be removed once previous config file format has been converted. Sub cfgFileIntervalTimeFormatChange() If fso.FileExists(UMWPFolder & "UMWPAutoChanger.cfg") Then Dim FileText, FileLines, Line, Convert, i Dim cfgFile Set cfgFile = fso.OpenTextFile(UMWPFolder & "UMWPAutoChanger.cfg", ForReading, DontCreate, ASCII) FileText = cfgFile.ReadAll cfgFile.Close() FileLines = Split(FileText, vbNewLine) ' Remove trailing blank lines Do While Len(FileLines(UBound(FileLines))) <= 0 ReDim Preserve FileLines(UBound(FileLines) - 1) Loop Convert = False i = 0 For Each Line In FileLines ' If line doesn't have at least one ',' then skip it. If InStr(1, Line, ",") <= 0 Then ' Skip Else Dim LnPos, Count, Monitor, Interval, Units, Order, Path LnPos = 1 Count = InStr(LnPos, Line, ",") - LnPos Monitor = Mid(Line, LnPos, Count) LnPos = LnPos + Count + 1 Count = InStr(LnPos, Line, ",") - LnPos Interval = Mid(Line, LnPos, Count) LnPos = LnPos + Count + 1 Count = InStr(LnPos, Line, ",") - LnPos Units = LCase(Mid(Line, LnPos, Count)) LnPos = LnPos + Count + 1 Count = InStr(LnPos, Line, ",") - LnPos If Count > 0 Then Order = Mid(Line, LnPos, Count) LnPos = LnPos + Count + 1 End If Path = Mid(Line, LnPos) ' To end of line Select Case (Units) Case "hrs" If Interval < 10 Then Interval = "0" & Interval If Interval > 99 Then Interval = "99" Interval = "" & Interval & ":00:00" Convert = True Case "min" If Interval < 10 Then Interval = "0" & Interval If Interval > 99 Then Interval = "99" Interval = "00:" & Interval & ":00" Convert = True Case "sec" If Interval < 10 Then Interval = "0" & Interval If Interval > 99 Then Interval = "99" Interval = "00:00:" & Interval Convert = True Case Else End Select FileLines(i) = Monitor & "," & Interval & "," & Order & "," & Path i = i + 1 End If Next If Convert Then Set cfgFile = fso.OpenTextFile(UMWPFolder & "UMWPAutoChanger.cfg", ForWriting, DontCreate, ASCII) For Each Line In FileLines cfgFile.WriteLine(Line) Next cfgFile.Close() End If End If End Sub ' Version History ' Version: Alpha 1 ' Date: December 25, 2006 ' Original Creation ' Version: Alpha 2 ' Date: December 26, 2006 ' Fixes: ' Image file extension check case sensitive. To make case insensitive... ' Replace line 132 ' If (Right(fileWp.Name, 4) = .jpg) or (Right(fileWp.Name, 4) = .bmp) Then ' With this ' If (LCase(Right(fileWp.Name, 4)) = .jpg) or (LCase(Right(fileWp.Name, 4)) = .bmp) Then ' Line 74 ' dirWps(0) = sh.RegRead(HKLMSoftwareRealtime SoftUltraMonWallpaperAll Users Wallpaper Directory) ' Should be ' dirWps(1) = sh.RegRead(HKLMSoftwareRealtime SoftUltraMonWallpaperAll Users Wallpaper Directory) ' Changes: ' In addition to bmp and jpg, accepting pcx, png, tga, and tif, jpeg, and tiff image file extensions ' Version: Alpha 3 ' Date: December 29, 2006 ' Changes: ' Image folder recursion added. ' Random or sequential image file order selection option added. ' Command line options monitor number now must be preceded with 'M'. Example M3 30 Sec Rand M5 10 Min Seq ' Organized into functions and subroutines. ' Version: Alpha 4 ' Date December 31, 2006 ' Changes: ' Single instance of script supporting each monitor with unique change interval, image order, and image folder. ' Command line parameters support removed. Real-time dynamic control through configuration file. ' Version: Alpha 5 ' Date: January 12, 2007 ' Fixes: ' Repositioned interval timer update to correct from being of by 1 loop count (1 x seconds). ' Increased maximum image file number from 100,000 to 4,294,967,296. ' Supposedly 4 Giga Files is maximum for an NTFS volume. ' Changes: ' Config file (.cfg) format changed from <Interval>,<Units> to <hh:mm:ss> (all digits required). ' Dynamic Locate of 'UltraMon Wallpaper Manager' Installation via Windows Installer. ' Dynamic array sizing for number of monitors. ' Version: Alpha 6 ' Date: January 19, 2007 ' Fixes: ' Significant efficiency improvement of the 'SelectImageFile' function. ' Read/Write of wallpaper file for each monitor wallpaper being changed reduced to ' a single read/write of wallpaper file for all monintor wallpapers being changed. ' Some code, comments and documentation cleanup and corrections. ' Changes: ' Added support for image file shortcuts. Folder shortcuts though are disabled by default. ' Images folders can now contain shortcuts to the actual image files, rather than being duplicates. ' Version: Alpha 7 ' Date: July 3, 2007 ' Changes: ' Added support for UltraMon 3. GetUMWPFolderLocation replaced with SetFileLocations, which has support for both UltraMon 2 ' and 3. Added global variable UMWPBitmap, which is set by SetFileLocations, and is used by ApplyWallpaperChanges to delete ' the existing wallpaper bitmap. Updated documentation

Ernie
salazare@verizon.net
Ernie   2013-10-05 17:27
Sorry, noticed one place I forgot to up. If you use my modified script, search for:

And fso.FileExists(UMWPFolder & "UMWPAutoChanger.wallpaper") Then 'Ernie Salazar

and replace it with:

And fso.FileExists(UMWPFolder & UMProfile) Then 'Ernie Salazar

Ernie
salazare@verizon.net
Forums -> UltraMon™ -> UltraMon Auto Wallpaper Changer VBScript

Post Reply