Wallpaper Changer & Spotlighter

Applications, Games, Tools, User libs and useful stuff coded in PureBasic
User avatar
A.D.
User
User
Posts: 96
Joined: Tue Oct 06, 2009 9:11 pm

Wallpaper Changer & Spotlighter

Post by A.D. »

Hello there!

i wrote two little tools which are changing my wallpapers and additionally copy the wonderful Windows 10 Spotlight Backround Images daily to my current wallpaper folder. You just need to add these two little programs to the task scheduler and decide yourself how often they are executed.

Code: Select all

;Wallpaper Changer

#WPSTYLE_CENTER = 0 
#WPSTYLE_TILE = 1 
#WPSTYLE_STRETCH = 2 
#WPSTYLE_MAX = 3 

#AD_APPLY_SAVE = 1 
#AD_APPLY_HTMLGEN = 2 
#AD_APPLY_REFRESH = 4 
#AD_APPLY_FORCE = 8 
#AD_APPLY_BUFFERED_REFRESH = 10
#AD_APPLY_COMPLETEREFRESH = 20
#AD_APPLY_DYNAMICREFRESH = 20
#AD_APPLY_ALL = #AD_APPLY_SAVE | #AD_APPLY_HTMLGEN | #AD_APPLY_REFRESH 

Structure myWALLPAPEROPT 
  dwSize.l 
  dwStyle.l 
EndStructure 

Global wallpaperOptions.myWALLPAPEROPT 
Global deskObj.IActiveDesktop 


Procedure.s GetWallpaper()
 
CoInitialize_(0)

wbuf=AllocateMemory(1000) ;wide char
mbuf=AllocateMemory(1000) ;multy byte

CoCreateInstance_(?CLSID_ActiveDesktop,0,1,?IID_IActiveDesktop,@pobj.IActiveDesktop)

pobj\GetWallpaper(wbuf,1000,0)
pobj\release()

WideCharToMultiByte_(#CP_ACP,0,wbuf,-1,mbuf,1000,#Null,#Null)

ProcedureReturn PeekS(mbuf,1000,#PB_UTF8)

CoUninitialize_()
FreeMemory(0)
FreeMemory(1)

;CLSID_ActiveDesktop="{75048700-EF1F-11D0-9888-006097DEACF9}"
;IID_IActiveDesktop="{F490EB00-1240-11D1-9888006097DEACF9}"

EndProcedure


Procedure SetWallpaper(myWallpaper$, Style) 
 
 CoInitialize_(0) 
 If CoCreateInstance_(?CLSID_ActiveDesktop,0,1,?IID_IActiveDesktop,@deskObj.IActiveDesktop) <> #S_OK 
 MessageRequester("Error", "Could not create object") 
 End
 EndIf 

 wallpaperOptions\dwSize = SizeOf(myWALLPAPEROPT) 
 wallpaperOptions\dwStyle = Style
 
  ;... allocate for wStr filename 
  *filenameWide = AllocateMemory(Len(myWallpaper$)*2+2) 
  PokeS(*filenameWide, myWallpaper$, -1, #PB_Unicode)
  If deskObj\SetWallpaperOptions(@wallpaperOptions, 0) = #S_OK 
    If deskObj\SetWallpaper(*filenameWide, 0) = #S_OK 
      If deskObj\ApplyChanges(#AD_APPLY_ALL) <> #S_OK 
        MessageRequester("Error", "Unable to apply changes to Wallpaper.") 
      EndIf 
    EndIf 
  EndIf 
  FreeMemory(*filenameWide) 
  
 If deskObj 
 deskObj\Release() 
 EndIf 
 CoUninitialize_() 

  ProcedureReturn 0 
  
 EndProcedure 
 
 If Not OSVersion() = #PB_OS_Windows_10 : MessageRequester("ChangeWallpaper", "This tool requires Windows 10!") : End : EndIf
 
 oldwallpaper.s = GetWallpaper() : Debug oldwallpaper
 If Not ReadFile(0, oldwallpaper) And IsFile(0) : MessageRequester("ChangeWallpaper", "Could not retrieve current wallpaper!") : End : EndIf : CloseFile(0)
   
 wallpaper.s = Space(#MAX_PATH) 
 Directory.s = GetPathPart(oldwallpaper)
 
 NewList Wallpapers.s()
 
 If ExamineDirectory(0, Directory, "*.*")
  While NextDirectoryEntry(0)
   If DirectoryEntryType(0) = #PB_DirectoryEntry_File
    Ext.s = UCase(GetExtensionPart(DirectoryEntryName(0)))
    Select Ext
      Case "JPG", "JPEG", "PNG", "BMP"
       If Not DirectoryEntryName(0) = GetFilePart(oldwallpaper)
         countwallpapers + 1 : AddElement(Wallpapers()) : Wallpapers() = GetFilePart(DirectoryEntryName(0))
        EndIf 
    EndSelect
   EndIf 
  Wend
  FinishDirectory(0)     
 EndIf
 
If Not countwallpapers = 0 
 newwallpaper_id = Random(countwallpapers, 1)
 SelectElement(Wallpapers(), newwallpaper_id) : newwallpaper.s = Wallpapers() : Debug newwallpaper 
 SetWallpaper(directory+newwallpaper, #WPSTYLE_CENTER)
EndIf

End

DataSection 
CLSID_ActiveDesktop: 
Data.l $75048700 
Data.w $EF1F,$11D0 
Data.b $98,$88,$00,$60,$97,$DE,$AC,$F9 

IID_IActiveDesktop: 
Data.l $F490EB00 
Data.w $1240,$11D1 
Data.b $98,$88,$00,$60,$97,$DE,$AC,$F9 
EndDataSection 
and here comes the Spotlighter:

Code: Select all

; MS SPOTLIGHT Add Images to Wallpapers

#WPSTYLE_CENTER = 0 
#WPSTYLE_TILE = 1 
#WPSTYLE_STRETCH = 2 
#WPSTYLE_MAX = 3 

#AD_APPLY_SAVE = 1 
#AD_APPLY_HTMLGEN = 2 
#AD_APPLY_REFRESH = 4 
#AD_APPLY_FORCE = 8 
#AD_APPLY_BUFFERED_REFRESH = 10
#AD_APPLY_COMPLETEREFRESH = 20
#AD_APPLY_DYNAMICREFRESH = 20
#AD_APPLY_ALL = #AD_APPLY_SAVE | #AD_APPLY_HTMLGEN | #AD_APPLY_REFRESH 

Structure myWALLPAPEROPT 
  dwSize.l 
  dwStyle.l 
EndStructure 

Global wallpaperOptions.myWALLPAPEROPT 
Global deskObj.IActiveDesktop 

ExamineDesktops() : Global DesktopWidth=DesktopWidth(0), DesktopHeight=DesktopHeight(0)
UseJPEGImageDecoder()

Procedure.s GetWallpaper()
 
CoInitialize_(0)

wbuf=AllocateMemory(1000) ;wide char
mbuf=AllocateMemory(1000) ;multy byte

CoCreateInstance_(?CLSID_ActiveDesktop,0,1,?IID_IActiveDesktop,@pobj.IActiveDesktop)

pobj\GetWallpaper(wbuf,1000,0)
pobj\release()

WideCharToMultiByte_(#CP_ACP,0,wbuf,-1,mbuf,1000,#Null,#Null)

ProcedureReturn PeekS(mbuf,1000,#PB_UTF8)

CoUninitialize_()
FreeMemory(0)
FreeMemory(1)

;CLSID_ActiveDesktop="{75048700-EF1F-11D0-9888-006097DEACF9}"
;IID_IActiveDesktop="{F490EB00-1240-11D1-9888006097DEACF9}"

EndProcedure


If Not OSVersion() = #PB_OS_Windows_10 : MessageRequester("Spotlighter", "This tool requires Windows 10!") : End : EndIf

SpotLightFolder.s =  RemoveString(GetUserDirectory(#PB_Directory_ProgramData), "Roaming\") + "Local\Packages\" 

If ExamineDirectory(0, SpotLightFolder.s, "Microsoft.Windows.ContentDeliveryManager_*")
  While NextDirectoryEntry(0)
   If DirectoryEntryType(0) = #PB_DirectoryEntry_Directory
     SpotLightFolder.s = SpotLightFolder.s + DirectoryEntryName(0) + "\LocalState\Assets\"
   Else
      MessageRequester("SpotLighter", "Error Finding Asset Folder") : End
   EndIf 
 Wend
  FinishDirectory(0)         
 Else 
   MessageRequester("SpotLight Tool", "Error Finding Asset Folder") : End
 EndIf
 
 Debug SpotLightFolder
 
 CurrentWallpaper.s = GetWallpaper() : Debug CurrentWallpaper
 DirCurrentWallpaper.s = GetPathPart(CurrentWallPaper)
 If CurrentWallpaper = "" : MessageRequester("SpotLighter", "Error Finding Current Wallpaper") : End : EndIf
 
 If ExamineDirectory(0, SpotLightFolder, "*.*")
   While NextDirectoryEntry(0)
     If DirectoryEntryType(0) = #PB_DirectoryEntry_File
       image.s = DirectoryEntryName(0) ;Debug SpotlightFolder+ image 
       If LoadImage(0, SpotlightFolder+image) 
         If ImageHeight(0) = DesktopHeight And ImageWidth(0) = DesktopWidth
          If Not FileSize(DirCurrentWallpaper+image+".jpg") > 0
            Debug "Copy"
            CopyFile(SpotlightFolder+image, DirCurrentWallpaper+image+".jpg")
         EndIf
       EndIf 
       FreeImage(0)  
     EndIf 
    EndIf
  Wend
  FinishDirectory(0)     
 EndIf
 
 End
 
DataSection 
CLSID_ActiveDesktop: 
Data.l $75048700 
Data.w $EF1F,$11D0 
Data.b $98,$88,$00,$60,$97,$DE,$AC,$F9 

IID_IActiveDesktop: 
Data.l $F490EB00 
Data.w $1240,$11D1 
Data.b $98,$88,$00,$60,$97,$DE,$AC,$F9 
EndDataSection 
I hope you may find these two little helpers useful. If you find a bug, please let me know!

Greetings
A.D.
Repeat
PureBasic
ForEver