It is currently Fri Aug 14, 2020 9:33 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 1 post ] 
Author Message
 Post subject: Wallpaper Changer & Spotlighter
PostPosted: Sat Aug 01, 2020 1:56 pm 
Offline
User
User
User avatar

Joined: Tue Oct 06, 2009 9:11 pm
Posts: 88
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.

_________________
Repeat
PureBasic
ForEver


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 1 post ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 3 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye