;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

; 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