Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

VBS Desktophintergrund ändern

Frage Entwicklung VB for Applications

Mitglied: novedad

novedad (Level 1) - Jetzt verbinden

06.06.2010 um 18:32 Uhr, 7872 Aufrufe, 10 Kommentare

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:

01.
On Error Resume Next 
02.
Set wshell = CreateObject("WScript.Shell")  
03.
Dim DeskPfad, Intervall 
04.
DeskPfad = InputBox("Geben Sie den Pfad zu den gewünschten Hintergrundbildern ein","WallpaperChanger") 
05.
Intervall = InputBox("Geben Sie das Intervall an in dem der Desktophintergrund geändert werden soll" &vbCrLf& "60000 Millisekunden = 1 Minute", "WallpaperChanger") 
06.
do 
07.
HKEY_CURRENT_USER = &H80000001 
08.
strComputer = "." 
09.
Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv") 
10.
strKeyPath = "Control Panel\Desktop" 
11.
objReg.CreateKey HKEY_CURRENT_USER, strKeyPath 
12.
ValueName = "Wallpaper" 
13.
strValue = ""&DeskPfad&"" 
14.
objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, ValueName, strValue 
15.
wscript.sleep ""&Intervall&"" 
16.
loop
Freue mich schon auf eure Hilfe

mfg novedad
Mitglied: Midivirus
06.06.2010 um 20:03 Uhr
M$

Sys > Anzeige > Slide Show > fertig
Bitte warten ..
Mitglied: novedad
06.06.2010 um 20:26 Uhr
ich hab WINDOWS XP, da geht leider keine Slideshow

eine Scriptbasierte Lösung wäre besser...
Bitte warten ..
Mitglied: bastla
06.06.2010 um 23:21 Uhr
Hallo novedad!

Ich nehme an, Du meinst das etwa so:
01.
On Error Resume Next 
02.
Set wshell = CreateObject("WScript.Shell") 
03.
Set fso = CreateObject("Scripting.FileSystemObject") 
04.
HKEY_CURRENT_USER = &H80000001 
05.
strComputer = "." 
06.
Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv") 
07.
strKeyPath = "Control Panel\Desktop" 
08.
objReg.CreateKey HKEY_CURRENT_USER, strKeyPath 
09.
Ext = "#jpg#bmp#" 
10.
 
11.
Randomize 
12.
 
13.
DeskPfad = InputBox("Geben Sie den Pfad zu den gewünschten Hintergrundbildern ein","WallpaperChanger") 
14.
Intervall = InputBox("Geben Sie das Intervall an in dem der Desktophintergrund geändert werden soll" &vbCrLf& "60000 Millisekunden = 1 Minute", "WallpaperChanger") 
15.
 
16.
Do 
17.
    Pics = "" 'String zum Sammeln aller Dateipfade leeren für neuen Durchgang - könnten ja diesmal mehr oder weniger Bilder sein ... 
18.
    For Each File In fso.GetFolder(Deskpfad).Files '... daher immer alle Dateien des gewählten Ordners durchgehen ... 
19.
        If Instr(Ext, "#" & LCase(fso.GetExtensionName(File.Name)) & "#") > 0  Then '... aber nur solche mit passendem Typ berücksichtigen 
20.
            Pics = Pics & "§" & File.Path 'Pfad durch "§" getrennt an den Sammelstring anfügen 
21.
        End If 
22.
    Next 
23.
    P = Split(Mid(Pics, 2), "§") 'aus dem Sammelstring ein Array machen (vor dem ersten Trennzeichen steht nix, daher dahinter anfangen)... 
24.
    PicPath = P(Int(Rnd * (UBound(P) + 1))) ' ... und per Zufallszahlenfunktion einen Pfad auswählen 
25.
 
26.
    ValueName = PicPath 
27.
    strValue = DeskPfad 
28.
    objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, ValueName, strValue 
29.
    WScript.Sleep Intervall 
30.
Loop
Ist ungetestet, enthält aber im Vergleich zu vorher etwas weniger abenteuerliche Anführungszeichen ...
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
Bitte warten ..
Mitglied: novedad
07.06.2010 um 19:02 Uhr
erstmal danke @ bastla

doch es funktioniert leider nicht so wie ich dachte

ich verwende nun das
Script von Bastla

01.
On Error Resume Next 
02.
Set wshell = CreateObject("WScript.Shell") 
03.
Set fso = CreateObject("Scripting.FileSystemObject") 
04.
HKEY_CURRENT_USER = &H80000001 
05.
strComputer = "." 
06.
Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv") 
07.
strKeyPath = "Control Panel\Desktop" 
08.
objReg.CreateKey HKEY_CURRENT_USER, strKeyPath 
09.
Ext = "#jpg#bmp#" 
10.
 
11.
Randomize 
12.
 
13.
DeskPfad = InputBox("Geben Sie den Pfad zu den gewünschten Hintergrundbildern ein","WallpaperChanger") 
14.
Intervall = InputBox("Geben Sie das Intervall an in dem der Desktophintergrund geändert werden soll" &vbCrLf& "60000 Millisekunden = 1 Minute", "WallpaperChanger") 
15.
 
16.
Do 
17.
    Pics = "" 'String zum Sammeln aller Dateipfade leeren für neuen Durchgang - könnten ja diesmal mehr oder weniger Bilder sein ... 
18.
    For Each File In fso.GetFolder(Deskpfad).Files '... daher immer alle Dateien des gewählten Ordners durchgehen ... 
19.
        If Instr(Ext, "#" & LCase(fso.GetExtensionName(File.Name)) & "#") > 0  Then '... aber nur solche mit passendem Typ berücksichtigen 
20.
            Pics = Pics & "§" & File.Path 'Pfad durch "§" getrennt an den Sammelstring anfügen 
21.
        End If 
22.
    Next 
23.
    P = Split(Mid(Pics, 2), "§") 'aus dem Sammelstring ein Array machen (vor dem ersten Trennzeichen steht nix, daher dahinter anfangen)... 
24.
    PicPath = P(Int(Rnd * (UBound(P) + 1))) ' ... und per Zufallszahlenfunktion einen Pfad auswählen 
25.
 
26.
    ValueName = PicPath 
27.
    strValue = DeskPfad 
28.
    objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, ValueName, strValue 
29.
    WScript.Sleep Intervall 
30.
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:

01.
@echo off 
02.
%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
Bitte warten ..
Mitglied: bastla
07.06.2010 um 23:22 Uhr
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
Bitte warten ..
Mitglied: novedad
07.06.2010 um 23:28 Uhr
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
Bitte warten ..
Mitglied: bastla
07.06.2010 um 23:41 Uhr
Hallo novedad!

Ist schon klar - die Zeilen 26 und 27 sind so ja einfach Blödsinn - 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
Bitte warten ..
Mitglied: novedad
08.06.2010 um 13:52 Uhr
funktioniert wunderbar!

hier noch einmal der komplette Code:

WallpaperChanger:

01.
On Error Resume Next 
02.
Set wshell = CreateObject("WScript.Shell") 
03.
Set fso = CreateObject("Scripting.FileSystemObject") 
04.
HKEY_CURRENT_USER = &H80000001 
05.
strComputer = "." 
06.
Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv") 
07.
strKeyPath = "Control Panel\Desktop" 
08.
objReg.CreateKey HKEY_CURRENT_USER, strKeyPath 
09.
Ext = "#jpg#bmp#" 
10.
 
11.
Randomize 
12.
 
13.
DeskPfad = InputBox("Geben Sie den Pfad zu den gewünschten Hintergrundbildern ein","WallpaperChanger") 
14.
Intervall = InputBox("Geben Sie das Intervall an in dem der Desktophintergrund geändert werden soll" &vbCrLf& "60000 Millisekunden = 1 Minute", "WallpaperChanger") 
15.
 
16.
Do 
17.
    Pics = "" 'String zum Sammeln aller Dateipfade leeren für neuen Durchgang - könnten ja diesmal mehr oder weniger Bilder sein ... 
18.
    For Each File In fso.GetFolder(Deskpfad).Files '... daher immer alle Dateien des gewählten Ordners durchgehen ... 
19.
        If Instr(Ext, "#" & LCase(fso.GetExtensionName(File.Name)) & "#") > 0  Then '... aber nur solche mit passendem Typ berücksichtigen 
20.
            Pics = Pics & "§" & File.Path 'Pfad durch "§" getrennt an den Sammelstring anfügen 
21.
        End If 
22.
    Next 
23.
    P = Split(Mid(Pics, 2), "§") 'aus dem Sammelstring ein Array machen (vor dem ersten Trennzeichen steht nix, daher dahinter anfangen)... 
24.
    PicPath = P(Int(Rnd * (UBound(P) + 1))) ' ... und per Zufallszahlenfunktion einen Pfad auswählen 
25.
 
26.
    ValueName = "Wallpaper"  
27.
    strValue = PicPath 
28.
    objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, ValueName, strValue 
29.
    WScript.Sleep Intervall 
30.
    wshell.run "Update.bat",0, True 
31.
Loop
RegistryUpdater:

01.
@echo off 
02.
%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
Bitte warten ..
Mitglied: bastla
08.06.2010 um 14:30 Uhr
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
Bitte warten ..
Mitglied: novedad
08.06.2010 um 17:09 Uhr
Gute Idee

Danke!

mfg novedad
Bitte warten ..
Neuester Wissensbeitrag
Off Topic

"Ich habe nichts zu verbergen"

(2)

Erfahrungsbericht von FA-jka zum Thema Off Topic ...

Ähnliche Inhalte
Grafikkarten & Monitore
Intel User Interface - Sprache ändern (4)

Frage von FA-jka zum Thema Grafikkarten & Monitore ...

Batch & Shell
gelöst Base64 Decode (Batch,VBS) (26)

Frage von clragon zum Thema Batch & Shell ...

DNS
gelöst Hostnamen eines Internetanschluss ändern (5)

Frage von christianlindloff zum Thema DNS ...

Windows Server
gelöst Servername in der Domäne ändern nicht möglich (4)

Frage von Ghost108 zum Thema Windows Server ...

Heiß diskutierte Inhalte
Linux Netzwerk
gelöst DHCP vergibt keine Adressen (32)

Frage von Maik82 zum Thema Linux Netzwerk ...

Apache Server
gelöst Lets Encrypt SSL mit Apache2 (20)

Frage von banane31 zum Thema Apache Server ...

CPU, RAM, Mainboards
Kaufberatung für mind. 8 verschiedene HighEnd-Mainboards (20)

Frage von yperiu zum Thema CPU, RAM, Mainboards ...

Hardware
gelöst PCI-Express-Adapterfrage (14)

Frage von DerWoWusste zum Thema Hardware ...