2008-01-09

Skript na zmenu wallpaperu

Toz sharper chtela skript na nahodnou zmenu wallpaperu, ma ho mit:

Option Explicit

Const strWallpapersFolder = "E:\\_wallpapers\\"

Dim objFSO, objWF, objFile, objFiles
Dim arrWallpapers(), i
Dim intRnd
Dim objShell

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWF = objFSO.GetFolder(strWallpapersFolder)
Set objFiles = objWF.Files
i = 0
For Each objFile in objFiles
If LCase(Right(objFile.name, 3)) = "bmp" Then
i = i + 1
redim preserve arrWallpapers(i)
arrWallpapers(i) = objFile.name
End If
Next

Randomize
intRnd = Int((i * Rnd) + 1)

Set objShell = WScript.CreateObject("Wscript.Shell")

objShell.RegWrite "HKCU\\Control Panel\\Desktop\\Wallpaper", strWallpapersFolder & arrWallPapers(intRnd)
objShell.Run "C:\\windows\\System32\\rundll32.exe user32.dll,UpdatePerUserSystemParameters", 1, False

redim arrWallpapers(0)
Set objShell = Nothing
Set objFile = Nothing
Set objFiles = Nothing
Set objWF = Nothing
Set objFSO = Nothing

9 komentářů:

  1. Hm......nepovedlo se mi tam narvat backslashe, tak jen technicka - strWallpapersFolder musi koncit na backslash (ale to je snad nasnade)

    OdpovědětVymazat
  2. Ha!Taky me to mohlo napadnout driv ;-)

    OdpovědětVymazat
  3. Šmarjáto mi připomíná, že za pár dní budu skriptovat na zkoušce. Uáááááá!

    OdpovědětVymazat
  4. lední brtník9/1/08 18:51

    2 lomítkakdyž máš lomítka čitelně u cesty na e:, oprav to ještě ve zdrojáku u hkcu...

    OdpovědětVymazat
  5. medvede......diky za upozorneni, byl jsem tak stastnej z toho, ze jsem na to prisel, ze jsem si nezkontroloval zbytek ;-)

    OdpovědětVymazat
  6. Skripty jsou možná fpoho......ale asi jak pro koho. Ať žije jazyk avenue a program ArcView. Fuj!

    OdpovědětVymazat
  7. Looney......na prvni pohled nic tak strasnyho ;-)

    OdpovědětVymazat
  8. LooneySak to taky nic strasnyho neni ;-)

    OdpovědětVymazat

Mazat komentáře nehodlám, výjimky však tvoří vulgární a off-topic komentáře!