novedad
Goto Top

VBS Desktophintergrund ändern

Hallo
Habe ein Script geschrieben mit dem der Desktophintergrund von Windows XP in einem bestimmbaren Intervall geändert werden soll

Mit einem einzelnen Bild klappt es, aber das ist ja nicht der Sinn der Sache

Ich will das ich nur einen Ordner auszuwählen brauche der die Bilder enthält und den Desktophintergrund dann nach einer bestimmten Zeit ändert

Hier mein Script:

On Error Resume Next
Set wshell = CreateObject("WScript.Shell")   
Dim DeskPfad, Intervall
DeskPfad = InputBox("Geben Sie den Pfad zu den gewünschten Hintergrundbildern ein","WallpaperChanger")  
Intervall = InputBox("Geben Sie das Intervall an in dem der Desktophintergrund geändert werden soll" &vbCrLf& "60000 Millisekunden = 1 Minute", "WallpaperChanger")  
do
HKEY_CURRENT_USER = &H80000001
strComputer = "."  
Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")  
strKeyPath = "Control Panel\Desktop"  
objReg.CreateKey HKEY_CURRENT_USER, strKeyPath
ValueName = "Wallpaper"  
strValue = ""&DeskPfad&""  
objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, ValueName, strValue
wscript.sleep ""&Intervall&""  
loop

Freue mich schon auf eure Hilfe

mfg novedad

Content-ID: 144251

Url: https://administrator.de/forum/vbs-desktophintergrund-aendern-144251.html

Ausgedruckt am: 23.12.2024 um 23:12 Uhr

Midivirus
Midivirus 06.06.2010 um 20:03:37 Uhr
Goto Top
M$

Sys > Anzeige > Slide Show > fertig
novedad
novedad 06.06.2010 um 20:26:52 Uhr
Goto Top
ich hab WINDOWS XP, da geht leider keine Slideshow

eine Scriptbasierte Lösung wäre besser...
bastla
bastla 06.06.2010 um 23:21:04 Uhr
Goto Top
Hallo novedad!

Ich nehme an, Du meinst das etwa so:
On Error Resume Next
Set wshell = CreateObject("WScript.Shell")  
Set fso = CreateObject("Scripting.FileSystemObject")  
HKEY_CURRENT_USER = &H80000001
strComputer = "."  
Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")  
strKeyPath = "Control Panel\Desktop"  
objReg.CreateKey HKEY_CURRENT_USER, strKeyPath
Ext = "#jpg#bmp#"  

Randomize

DeskPfad = InputBox("Geben Sie den Pfad zu den gewünschten Hintergrundbildern ein","WallpaperChanger")  
Intervall = InputBox("Geben Sie das Intervall an in dem der Desktophintergrund geändert werden soll" &vbCrLf& "60000 Millisekunden = 1 Minute", "WallpaperChanger")  

Do
    Pics = "" 'String zum Sammeln aller Dateipfade leeren für neuen Durchgang - könnten ja diesmal mehr oder weniger Bilder sein ...  
    For Each File In fso.GetFolder(Deskpfad).Files '... daher immer alle Dateien des gewählten Ordners durchgehen ...  
        If Instr(Ext, "#" & LCase(fso.GetExtensionName(File.Name)) & "#") > 0  Then '... aber nur solche mit passendem Typ berücksichtigen  
            Pics = Pics & "§" & File.Path 'Pfad durch "§" getrennt an den Sammelstring anfügen  
        End If
    Next
    P = Split(Mid(Pics, 2), "§") 'aus dem Sammelstring ein Array machen (vor dem ersten Trennzeichen steht nix, daher dahinter anfangen)...  
    PicPath = P(Int(Rnd * (UBound(P) + 1))) ' ... und per Zufallszahlenfunktion einen Pfad auswählen  

    ValueName = PicPath
    strValue = DeskPfad
    objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, ValueName, strValue
    WScript.Sleep Intervall
Loop
Ist ungetestet, enthält aber im Vergleich zu vorher etwas weniger abenteuerliche Anführungszeichen ... face-wink
Falls Du den Wert von "Deskpfad" tatsächlich unter Anführungszeichen benötigen solltest, müsste die entsprechende Zeile so aussehen:
strValue = """" & DeskPfad & """"
oder, etwas pflegeleichter
strValue = Chr(34) & DeskPfad & Chr(34)
Das in Zeile 20 und 23 verwendete Zeichen "§" dient als Trennzeichen und sollte in keinem Dateinamen / -pfad enthalten sein - ggf gegen etwas noch exotischeres tauschen ...
Die Liste der erlaubten Dateitypen in Zeile 9 kannst Du nach Bedarf erweitern, aber bitte immer mit "#" beginnen, trennen und beenden und nur Kleinbuchstaben verwenden ...
Letzte Anmerkung: Wenn Du schon "Dim" verwendest, dann aber konsequent für alle Variablen (also auch "wshell", ...) und zusammen mit einem "Option Explicit" ...

Grüße
bastla
novedad
novedad 07.06.2010 um 19:02:33 Uhr
Goto Top
erstmal danke @ bastla

doch es funktioniert leider nicht so wie ich dachte

ich verwende nun das
Script von Bastla

On Error Resume Next
Set wshell = CreateObject("WScript.Shell")  
Set fso = CreateObject("Scripting.FileSystemObject")  
HKEY_CURRENT_USER = &H80000001
strComputer = "."  
Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")  
strKeyPath = "Control Panel\Desktop"  
objReg.CreateKey HKEY_CURRENT_USER, strKeyPath
Ext = "#jpg#bmp#"  

Randomize

DeskPfad = InputBox("Geben Sie den Pfad zu den gewünschten Hintergrundbildern ein","WallpaperChanger")  
Intervall = InputBox("Geben Sie das Intervall an in dem der Desktophintergrund geändert werden soll" &vbCrLf& "60000 Millisekunden = 1 Minute", "WallpaperChanger")  

Do
    Pics = "" 'String zum Sammeln aller Dateipfade leeren für neuen Durchgang - könnten ja diesmal mehr oder weniger Bilder sein ...  
    For Each File In fso.GetFolder(Deskpfad).Files '... daher immer alle Dateien des gewählten Ordners durchgehen ...  
        If Instr(Ext, "#" & LCase(fso.GetExtensionName(File.Name)) & "#") > 0  Then '... aber nur solche mit passendem Typ berücksichtigen  
            Pics = Pics & "§" & File.Path 'Pfad durch "§" getrennt an den Sammelstring anfügen  
        End If
    Next
    P = Split(Mid(Pics, 2), "§") 'aus dem Sammelstring ein Array machen (vor dem ersten Trennzeichen steht nix, daher dahinter anfangen)...  
    PicPath = P(Int(Rnd * (UBound(P) + 1))) ' ... und per Zufallszahlenfunktion einen Pfad auswählen  

    ValueName = PicPath
    strValue = DeskPfad
    objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, ValueName, strValue
    WScript.Sleep Intervall
Loop

und gebe als Pfad meinetwegen C:\Wallpapers an. In diesem Ordner befinden sich 10 Bilder im .bmp-Format
Als Intervall gebe ich 300000 Millisekunden = 5 Minuten an

dann verwende ich noch eine Batch zum Updaten des Systems mit folgendem Inhalt:

@echo off
%SystemRoot%\System32\RUNDLL32.EXE user32.dll, UpdatePerUserSystemParameters

doch es passiert - einfach nichts

irgendwo muss da der Fehler liegen doch ich steh' gerade auf dem Schlauch

danke für eure Antworten

mfg novedad
bastla
bastla 07.06.2010 um 23:22:26 Uhr
Goto Top
Hallo novedad!

Wie rufst Du denn Deine Batchdatei auf?

Um das Ganze etwas einzugrenzen, könntest Du ja mal in der Registry nachsehen, ob überhaupt ein Wert eingetragen wurde ...

Grüße
bastla
novedad
novedad 07.06.2010 um 23:28:26 Uhr
Goto Top
Hallo bastla

In der Registry wurde nichts eingetragen, da hab ich schon nachgeschaut

Die Batchdatei soll nur dazu dienen die Änderungen in der Registry zu übernehmen ohne den PC neustarten zu müssen

mfg novedad
bastla
bastla 07.06.2010 um 23:41:03 Uhr
Goto Top
Hallo novedad!

Ist schon klar - die Zeilen 26 und 27 sind so ja einfach Blödsinn face-sad - besser wäre:
    ValueName = "Wallpaper"
    strValue = PicPath
Ob die Anführungszeichen um den Pfad tatsächlich gebraucht werden oder zumindest nicht schaden, weiß ich nicht, aber Du kannst ja mal die Zeile 27 so testen:
    strValue = """" & PicPath & """"
Grüße
bastla
novedad
novedad 08.06.2010 um 13:52:51 Uhr
Goto Top
funktioniert wunderbar!

hier noch einmal der komplette Code:

WallpaperChanger:

On Error Resume Next
Set wshell = CreateObject("WScript.Shell")  
Set fso = CreateObject("Scripting.FileSystemObject")  
HKEY_CURRENT_USER = &H80000001
strComputer = "."  
Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")  
strKeyPath = "Control Panel\Desktop"  
objReg.CreateKey HKEY_CURRENT_USER, strKeyPath
Ext = "#jpg#bmp#"  

Randomize

DeskPfad = InputBox("Geben Sie den Pfad zu den gewünschten Hintergrundbildern ein","WallpaperChanger")  
Intervall = InputBox("Geben Sie das Intervall an in dem der Desktophintergrund geändert werden soll" &vbCrLf& "60000 Millisekunden = 1 Minute", "WallpaperChanger")  

Do
    Pics = "" 'String zum Sammeln aller Dateipfade leeren für neuen Durchgang - könnten ja diesmal mehr oder weniger Bilder sein ...  
    For Each File In fso.GetFolder(Deskpfad).Files '... daher immer alle Dateien des gewählten Ordners durchgehen ...  
        If Instr(Ext, "#" & LCase(fso.GetExtensionName(File.Name)) & "#") > 0  Then '... aber nur solche mit passendem Typ berücksichtigen  
            Pics = Pics & "§" & File.Path 'Pfad durch "§" getrennt an den Sammelstring anfügen  
        End If
    Next
    P = Split(Mid(Pics, 2), "§") 'aus dem Sammelstring ein Array machen (vor dem ersten Trennzeichen steht nix, daher dahinter anfangen)...  
    PicPath = P(Int(Rnd * (UBound(P) + 1))) ' ... und per Zufallszahlenfunktion einen Pfad auswählen  

    ValueName = "Wallpaper"   
    strValue = PicPath
    objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, ValueName, strValue
    WScript.Sleep Intervall
    wshell.run "Update.bat",0, True  
Loop

RegistryUpdater:

@echo off
%SystemRoot%\System32\RUNDLL32.EXE user32.dll, UpdatePerUserSystemParameters


Noch einmal vielen Dank an bastla der mit bei der Lösung meins Problems geholfen hat!

mfg novedad
bastla
bastla 08.06.2010 um 14:30:40 Uhr
Goto Top
Hallo novedad!

Eigentlich sollte sich die Batchdatei auch einsparen und die eine Zeile direkt aus dem VBScript ausführen lassen:
wshell.run "RUNDLL32.EXE user32.dll, UpdatePerUserSystemParameters",0, True
Grüße
bastla
novedad
novedad 08.06.2010 um 17:09:59 Uhr
Goto Top
Gute Idee

Danke!

mfg novedad