PureBasic Forum
https://www.purebasic.fr/english/

Wallpaper Changer & Spotlighter
https://www.purebasic.fr/english/viewtopic.php?f=27&t=75793
Page 1 of 1

Author:  A.D. [ Sat Aug 01, 2020 1:56 pm ]
Post subject:  Wallpaper Changer & Spotlighter

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:
;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:
; 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.

Page 1 of 1 All times are UTC + 1 hour
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/