Wallpaper und Windows 8+

[KodeZwerg]

Hallo Gemeinde,

in einem mini-Projekt versuche ich zu ermitteln wie der aktuell benutzte Dateiname zum Desktop Hintergrund-Bild lautet.
Also Ergebnis sollte ein vollständiger Pfad + Dateiname sein.

Was ich hier in DP gefunden war ist folgender Beitrag von turboPASCAL:

Delphi-Quellcode:

function GetWallpaperBitmap: String;
const
  SPI_GETDESKWALLPAPER = $0073; 
var
  wpFName: array [0..MAX_PATH] of Char;
begin
  if SystemParametersInfo(SPI_GETDESKWALLPAPER, MAX_PATH, @wpFName, 0)
    then Result := String(wpFName)
    else Result := '';
end;

Das funktioniert mit meinem eigenen Windows 10 (noch ist alles so wie nach OS-Installation) wunderbar.

Ich fand eine Seite die einen völlig anderen Weg beschreitet und da frage ich mich ob die oben genannte Methode noch aktuell ist.
PowerShell Scripte wie man es heute wohl machen sollte.

Von daher meine Frage an alle die Windows 8 oder höher nutzen und eigene Hintergrundbilder verwenden,
erhaltet ihr mit obiger Funktion tatsächlich den Dateinamen oder klappt da was nicht?


Grüße

[TiGü]

Klappt. Windows 10 1803.

[old7]

Klappt. Win8.1 und Win10 1809 (Build 17763.55).

[KodeZwerg]

Dankeschön fürs testen! :thumb:

[HolgerX]

Hmm..

auch unter W7 ;)

Sollte auch, da MS hier

https://docs.microsoft.com/en-us/win...arametersinfoa

auch dies beschreibt!

Würde es hierfür eine neue API geben, dann würde es ja hier beschrieben sein ;)

[Bernhard Geyer]

Zitat:

Zitat von KodeZwerg (Beitrag 1415495)

Ich fand eine Seite die einen völlig anderen Weg beschreitet und da frage ich mich ob die oben genannte Methode noch aktuell ist.

Das Ausnutzen der Speicherortes in der DWK ist wohl ein offizielle Schnittstelle/weg.
Es funktioniert halt - Bis MS meint den Speicherkey zu ändern.

Dein Weg ist schon der Offizielle. Evtl. gibt es einen neueren COM/WinRT-Weg

[p80286]

Zitat:

Zitat von KodeZwerg (Beitrag 1415495)

Ich fand eine Seite die einen völlig anderen Weg beschreitet und da frage ich mich ob die oben genannte Methode noch aktuell ist.
PowerShell Scripte wie man es heute wohl machen sollte.

Das hast Du missverstanden. Das ist der Weg für Leute die keine richtige Programmiersprache zur Verfügung haben. (Scriptkiddies):mrgreen:

Gruß
K-H

[KodeZwerg]

ich holte mir damals immer über

Delphi-Quellcode:

HKEY_CURRENT_USER\Control Panel\Desktop\Wallpaper

den namen.
für mein eigenes windows 10 passt das immer noch.
nun bekam ich ne nachricht das dort was mit "Transcoded" nur noch dargestellt wird, also habe ich mich ein wenig schlau gemacht was damit gemeint sei.
mein versuch diesen

Delphi-Quellcode:

HKEY_CURRENT_USER\Control Panel\Desktop\TranscodedImageCache

eintrag auszuwerten, da klappt was mit meiner umsetzung noch nicht so ganz bzw bezweifle ich meinen eigenen code.

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
const
  CDataValue: string = 'TranscodedImageCache';
  CKeyName: string = 'Control Panel\Desktop\';
var
  regist: TRegistry;
  KeyExists: boolean;
  vSize, p: integer;
  tmpStr, tmp: string;
begin
  regist := TRegistry.Create;
  try
    regist.RootKey := HKEY_CURRENT_USER;
    try
      KeyExists := regist.OpenKey(CKeyName, false);
      if (KeyExists) then
      begin
        vSize := regist.GetDataSize(CDataValue);
        if (vSize > 0) then
        begin
          SetLength(tmpStr, vSize);
          regist.ReadBinaryData(CDataValue, tmpstr[1], vSize);
          tmpStr := Copy(tmpStr, 13, vSize);
          Edit1.Text := tmpStr;
        end;
      end;
    except
      regist.CloseKey;
    end
  finally
    regist.Free;
  end;
end;

Da der Beitrag von turboPASCAL doch schon ein paar tage alt ist, wollte ich sichergehen, ist ja auch getan, Danke!

Danke auch an die weiteren Hinweise, siehste, ich hatte das bei msdn nicht gefunden oder nicht angestrengt genug gesucht :)

[KodeZwerg]

mist, so ganz scheint das mit der microsoft api nicht zu stimmen.
auf dem fremdrechner bekomme ich per api als result ein verzeichnis

Delphi-Quellcode:

\AppData\Roaming\Microsoft\Windows\Themes\TranscodedWallpaper

mein binär versuch schlägt da zwar fehl aber der pfad+name sei wohl enthalten inklusive vieler unicode zeichen.
also ist die zweite variante doch eher die korrekte methode, ich muss nur noch heraus finden wie der eintrag korrekt in text umgewandelt wird.

[API]

Warum genau sucht du nach einer alternativen Möglichkeit oder warum verwendest du nicht deine Funktion?

Delphi-Quellcode:

function GetWallpaperBitmap: String;

[KodeZwerg]

Zitat:

Zitat von API (Beitrag 1415547)

Warum genau sucht du nach einer alternativen Möglichkeit oder warum verwendest du nicht deine Funktion?

weil

Zitat:

Zitat von KodeZwerg (Beitrag 1415544)

auf dem fremdrechner bekomme ich per api als result ein verzeichnis

Delphi-Quellcode:

\AppData\Roaming\Microsoft\Windows\Themes\TranscodedWallpaper

deswegen schau ich mir mal den binären eintrag nun genauer an um zu wissen wie der aufgebaut ist.

also

Delphi-Quellcode:

function GetWallpaperBitmap: String;

scheidet wegen obigen fehler aus obwohl das die windows api ist und der beschreibung nach auch machen sollte.

[KodeZwerg]

Code:

' Copyright © 2013 Dwight Grant.  All rights reserved.
' Filename:  Win8_WP_Curr_Image_Name-Folder.txt
' Version:  2.00.01
'
' Purpose:  If (in Windows 8) running Desktop Wallpaper Slideshow:
'              To Display the Name of the Current Image (opt=1)
'                                      or
'              Display the Folder with the Current Image Selected (opt=2).
'
' This script reads and decodes registry key:
'      HKEY_CURRENT_USER\Control Panel\Desktop\TranscodedImageCache
'          and displays results on desktop
'
' How to Use  -  Creation:
' 1. Save Text file at a location of your choosing.
' 2. Open Text file with "Notepad" and "Save As" same name with ".vbs" file type.
'       You will now have both  "Win8_WP_Curr_Image_Name-Folder.txt" and
'                               "Win8_WP_Curr_Image_Name-Folder.vbs".
' 3. Create desktop shortcut to "Win8_WP_Curr_Image_Name-Folder.vbs".
'
' Operation:  Double Click on the Desktop Icon Created,
'               Executes "Microsoft Windows Based Script Host" and
'                 will display full path name of Wallpaper file.
'
'***  Author: Dwight Grant  **** Revised: Nov. 27, 2013 ***
' based upon idea from Ramesh Srinivasan in program "WPTargetDir.vbs" for Win 7
' & revisions suggested by FleetCommand.
'
' ***  Please note:  It is not unicode compliant - Path name needs to be ASCII to display properly.
'        If anyone has sugestions as to how to make it compliant, please explain, and I will try to 
'             incorporate it into the next version.
'  **********************************************************
Set Shell    = CreateObject("WScript.Shell")

strEr1       = "Error "
strSingle    = " "
strSelect    = " /select,"
strExplor    = "   "
opt          =  2         '1= Display File Name Only  -  2=Display Folder w/ File Name Selected

strPath      = ""                          'Path Name w/ leading blanks removed
sQ1          = """"                        'A QUOTE mark
Results      = "   "

On Error Resume Next
arr          = Shell.RegRead("HKCU\Control Panel\Desktop\TranscodedImageCache")
If Err.Number <> 0 Then
     strEr1  =  strEr1 & CStr(Err.Number)     'Set error display string
     msgbox strEr1,,"Win8 WP Curr Image Name"  'display error
     WScript.Quit
End If
On Error Goto 0

a            = arr
For I = LBound(arr) To Ubound(arr)         'Pull data from "arr" and convert to integer 
a(I) = Cint(arr(I))                        'Store integer in array "a"
   if I > 23 then                          'Disregard the first 23 characters
       strSingle = Chr(a(I))               'Move byte in array "a" to "strSingle”
       if a(I) > 0 then                    'If byte > zero, use it, else ignore
           strPath = strPath & strSingle   'Add character to string for display
       end if
  end if
Next
        
'  **********************************************************
if opt = 1 then
     msgbox strPath,,"The Wallpaper File Name is"   'Display results on desktop screen
end if
if opt = 2 then
     Results = sQ1 & strPath & sQ1
     strExplor = strSelect & Results 
          'msgbox strExplor,,"The String Passed to Explorer is"     'Diagnostic Display
     return = Shell.run("explorer.exe" & strExplor,,true)
end if
'  **********************************************************
Wscript.Quit

dieses .vbs script funktioniert auf fremdrechner.

edit
so habe ich es nun in delphi

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
const
  CDataValue: string = 'TranscodedImageCache';
  CKeyName: string = 'Control Panel\Desktop\';
var
  regist: TRegistry;
  KeyExists: boolean;
  vSize, p, i: integer;
  tmpStr, tmp: string;
  arr: array of byte;
begin
//  Edit1.Text := GetWallpaperBitmap;
  regist := TRegistry.Create;
  try
    regist.RootKey := HKEY_CURRENT_USER;
    try
      KeyExists := regist.OpenKey(CKeyName, false);
      if (KeyExists) then
      begin
        vSize := regist.GetDataSize(CDataValue);
        if (vSize > 0) then
        begin
          tmpStr := '';
          SetLength(arr, vSize);
          regist.ReadBinaryData(CDataValue, arr[0], vSize);
          for i := 23 to vSize -1 do
              if arr[i] > 31 then tmpStr := tmpStr + Chr(arr[i]);
          Edit1.Text := tmpStr;
        end;
      end;
    except
      regist.CloseKey;
    end
  finally
    regist.Free;
  end;
end;

[HolgerX]

Hmm.

Hast Du dir mal das
\AppData\Roaming\Microsoft\Windows\Themes\Transcod edWallpaper

genauer angeschaut?

Das ist nicht nur ein Verzeichnis, das IST das Bild, jedoch ohne Endung!
Im Ordner '\AppData\Roaming\Microsoft\Windows\Themes\' liegt die Datei TranscodedWallpaper.

Windows kopiert, aufgrund der Themes mit Slideshows und ähnliches, dein ausgewähltes Bild als eben diese Datei in den Ordner.
Somit wird nicht mehr zu deinem Original-Bild verlinkt, sondern Windows nimmt einfach dieses...

Ich vermute, das Windows sogar hingeht und dein z.B. selbstgemachtes Foto noch überarbeitet (verkleinert, Farbtiefe).

Mal eben angetestet, ja Windows verkleinert das Originalbild in der Größe und passt es wohl direkt an die Desktop-Size an..

[KodeZwerg]

hallo HolgerX!

also nachschauen was das ziel ist kann ich nicht, da es ein fremdrechner ist.
was ich wiederum sagen kann, die windows api gibt nur ein verzeichnis wieder wo hingegen das script sowie auch meine delphi umsetzung davon einen pfad+dateinamen ausspuckt.
der code ist noch nicht ganz fertig, man sieht ja das es ne baustelle ist :)
was noch fehlt ist multi monitor support, wenn man zwei oder mehr hat und verschiedene wallpaper je monitor einsetzt, dann landet das alles auch in dem binären eintrag, da weiß ich gerade noch nicht wie windows das dann speichert.
für single wallpaper ist der code oben okay.
für ein generelles usage sollte man eine windows os versions abfrage mit einbauen, alles vor windows 8 mit der api aufrufen alles ab windows 8 sollte mein code nun vernünftig umsetzen.

[HolgerX]

Hmm..

Hab hier nen Win8.1 Notebbook und einfach mal in \AppData\Roaming\Microsoft\Windows\Themes\ reingeschaut, wenn ich ein Hintergrundbild unter Windows auswähle.

Dort wurde die Datei TranscodedWallpaper seitens Windows ausgetauscht. Es handelt sich dabei um ein JPG.

[KodeZwerg]

ja du hattest vollkommen recht @holgerx, es ist eine datei, da ich die infos nur per mail erhalten hatte, kam es als ein verzeichnis name rüber wegen fehlender endung.
meine obige funktion gibt jedenfalls den originalen dateinamen wieder aus dem diese TranscodedWallpaper datei entstand.
also beides hat seine richtigkeit irgendwie :P
die api lügt ja nicht, von daher korrigiere ich meine aussage, nur das eigentliche ziel/original das ist daraus nicht ersichtlich.

[HolgerX]

Hmm..

Ich habe mir mal erlaubt, deine Routine zu korrigieren:

Delphi-Quellcode:

function GetWallpaperCache:WideString;
const
  CDataValue: string = 'TranscodedImageCache';
  CKeyName: string = 'Control Panel\Desktop\';
var
  regist: TRegistry;
  KeyExists: boolean;
  vSize : integer;
  arr: array of WideChar;
begin
  Result := '';
  regist := TRegistry.Create;
  try
    regist.RootKey := HKEY_CURRENT_USER;
    try
      KeyExists := regist.OpenKey(CKeyName, false);
      if (KeyExists) then
      begin
        vSize := regist.GetDataSize(CDataValue);
        if (vSize > 0) then
        begin
          SetLength(arr, vSize div 2);
          regist.ReadBinaryData(CDataValue, arr[0], vSize);
          Result := PWideChar(@Arr[12]);
        end;
      end;
    except
      regist.CloseKey;
    end
  finally
    regist.Free;
  end;
end;

Die ReadBinaryData enthalten offensichtlich ab dem Byte 24 einen WideString.
Dann sollte man diesen auch als dass verwenden, damit wir auch Unicode-Dateinamen erhalten ;)

Hierbei scheint es sich eventuell um eine Bilderserie handeln zu können, da es noch den Registry-Eintrag 'TranscodedImageCount' gibt.
Konnte es jedoch noch nicht testen.

Ist wohl dann für SlideShows...

[KodeZwerg]

Zitat:

Zitat von HolgerX (Beitrag 1415683)

Ist wohl dann für SlideShows...

Meine Vermutung wäre, das wenn man multi monitor hat mit verschiedenen wallpapers gesetzt das die dann alle da drinnen gespeichert werden und mit binär wert #00#00 getrennt werden.
Aber Slideshow wäre natürlich auch denkbar.
Mist das ich im Netz keine Information von Microsoft darüber finde.
Naja, test'n'try :-)
PWide.... SUPER!!!! Den Vorschlag nehme ich dankend an/übernehme ich so :thumb::thumb::thumb:

[HolgerX]

Hmm..

Angelehnt an
https://github.com/kujason/FindWallp...dWallpaper.vbs

scheint bei nur einem Monitor das Bild in 'TranscodedImageCache' abgespeichert zu sein.

Bei meheren Monitoren wird ein '_XXX' als Index an TranscodedImageCache angehängt (z.B. TranscodedImageCache_000 für Monitor idx 0)
Dort steht in den BIN Daten dann zusätzlich hinter dem Bildnamen noch (meiner Meinung nach) die Device ID des Monitores.

----- Debuggerauszug des WideChar Array -------------------
('?', #1, '?', #8, '?', '', '?', '', '?', '?', '?', 'a', 'C', ':', '\', 'W', 'i', 'n', 'd', 'o', 'w', 's', '\', 'W', 'e', 'b', '\', 'W', 'a', 'l', 'l', 'p', 'a', 'p', 'e', 'r', '\', 'W', 'i', 'n', 'd', 'o', 'w', 's', '\', 'i', 'm', 'g', '0', '.', 'j', 'p', 'g', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '\', '\', '?', '\', 'D', 'I', 'S', 'P', 'L', 'A', 'Y', '#', 'L', 'G', 'D', '0', '4', '6', 'C', '#', '5', '&', '2', '5', 'a', 'f', 'c', 'a', '1', '8', '&', '0', '&', 'U', 'I', 'D', '1', '0', '9', '0', '6', '0', '8', '#', '{', 'e', '6', 'f', '0', '7', 'b', '5', 'f', '-', 'e', 'e', '9', '7', '-', '4', 'a', '9', '0', '-', 'b', '0', '7', '6', '-', '3', '3', 'f', '5', '7', 'b', 'f', '4', 'e', 'a', 'a', '7', '}', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '')


Ach, noch ein Hinweis:
In TranscodedImageCache steht immer das 'letzte' Bild, welches verwendet wurde.
Wird der Hintergrund duch z.B. einfarbigen Hintergrund ersetzt, bleibt der Name in TranscodedImageCache stehen.

Deshalb erst SystemParametersInfo(SPI_GETDESKWALLPAPER.. und wenn dort '..\TranscodedWallpaper' drinnen steht, dann den Originalnamen über TranscodedImageCache auslesen ;)

[KodeZwerg]

so habe ich es nun. in der hoffnung das alles korrekt ist widme ich mich nun tests.

Delphi-Quellcode:

function GetTranscodedImageCache: WideString;
const
  CDataValue: string = 'TranscodedImageCache';
  CKeyName: string = 'Control Panel\Desktop\';
var
  regist: TRegistry;
  KeyExists: Boolean;
  vSize, i: Integer;
  tmpStr: WideString;
begin
  Result := '';
  regist := TRegistry.Create(KEY_READ);
  try
    regist.RootKey := HKEY_CURRENT_USER;
    try
      KeyExists := regist.OpenKey(CKeyName, false);
      if (KeyExists) then
      begin
        regist.Access := KEY_READ;
        vSize := regist.GetDataSize(CDataValue);
        if (vSize > 0) then
        begin
          tmpStr := '';
          SetLength(tmpStr, vSize div 2);
          regist.ReadBinaryData(CDataValue, tmpStr[1], vSize);
          Delete(tmpStr,1,12);
          for i := 1 to length(tmpStr)-1 do
            if ( (tmpStr[i]=Char(#0)) and (tmpStr[i+1]=Char(#0)) ) then
             begin
               Delete(tmpStr, i, Length(tmpStr));
               Break;
             end;
          Result := tmpStr;
        end;
        regist.CloseKey;
      end;
    except
      regist.CloseKey;
    end
  finally
    regist.Free;
  end;
end;

function GetWallpaperBitmap: String;
const
  SPI_GETDESKWALLPAPER = $0073;
var
  wpFName: array [0..MAX_PATH] of Char;
begin
  if SystemParametersInfo(SPI_GETDESKWALLPAPER, MAX_PATH, @wpFName, 0)
    then Result := String(wpFName)
    else Result := '';
end;

function GetWallpaperFilename: String;
var
  tmpStr: String;
begin
  tmpStr := GetWallpaperBitmap;
  if Pos('TranscodedWallpaper',tmpStr) > 0 then
  Result := GetTranscodedImageCache
  else Result := tmpStr;
end;

[HolgerX]

Hmm..

Hab mal noch nen bisschen recherchiert:

Ab Windows 8 gibt es IDesktopWallpaper, damit ist es möglich, nicht nur 'das' Wallpaper-File auszulesen, sondern je Monitor.

Anbei ein Testprogram.

Habe mir hierfür die benötigten Deklarationen zusammen geschrieben, so das nicht die ganze Win32 API für ShObjIdl eingebunden werden muss.

Zusätzlich habe ich deine Funktion für die Registry noch mal 'verschönert' ;)


(Quelle WindowsAPI : https://github.com/CMCHTPC/WindowsAPI )

(Das Testtool ist mit Delphi 6 erstellt und auf Windows 8.1 getestet worden)

[KodeZwerg]

ich bin baff!! super leistung holger, wie du nun den cache ausliest, als teil eines records, das finde ich echt genial!!!
plus dazu noch einen völlig neue methode mal so reingezaubert, echt toll recherchiert und bestens umgesetzt.
ich bin mehr als begeistert!!!
habe es noch nicht versucht selbst zu kompilieren, deine .exe zeigts mir ja bestens an =)

wobei beim lesen mir eine sache auffällt.

Delphi-Quellcode:

procedure TForm1.ButtonRegClick(Sender: TObject);
var
  s : string;
begin
  s := GetWallpaperName;

  if Pos('',s) > 0 then // <<<--- gehört da nicht TranscodedWallpaper noch rein? also
  if (Pos('transcodedwallpaper',LowerCase(s)) > 0) then

    Edit1.Text := GetWallpaperCache
  else
    Edit1.Text := s;
end;

edit
also um das was ich wollte zu erreichen muss diese änderung rein.
sonst kommt als Registry ergebnis

Delphi-Quellcode:

...\AppData\Roaming\Microsoft\Windows\Themes\TranscodedWallpaper

mit änderung erhalte ich wieder das gewünschte, IDesktopWallpaper funktioniert bestens, sowie als auch.

[HolgerX]

Zitat:

Zitat von KodeZwerg (Beitrag 1415729)

Delphi-Quellcode:

procedure TForm1.ButtonRegClick(Sender: TObject);
var
  s : string;
begin
  s := GetWallpaperName;

  if Pos('',s) > 0 then // <<<--- gehört da nicht TranscodedWallpaper noch rein? also
  if (Pos('transcodedwallpaper',LowerCase(s)) > 0) then

    Edit1.Text := GetWallpaperCache
  else
    Edit1.Text := s;
end;

Hast recht, ist leider ein Flüchtigkeitsfehler, da ich parallel nach IDesktopWallpaper am Suchen war ;)