Post Reply
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"
' is which monitor to change wallpaper on (based on order of Strucs in the UltraMon wallpaper file). Default is 1
' is an integer specifying how often to change the wallpaper. Default is 60
' is a multiplier to the 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:
' ,00:01:00,Sequential,
' Typical UltraMon wallpaper folder location is:
' 'My Documents\My Wallpapers' or 'All Users\Documents\Shared Wallpapers' for UltraMon 2,
' %APPDATA%\Realtime Soft\UltraMon\\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 , 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 , 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 , to (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
|
Post Reply
|