Wallpaper und Windows 8+

[KodeZwerg]

Zitat von API:

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

weil

Zitat von KodeZwerg:

auf dem fremdrechner bekomme ich per api als result ein verzeichnis \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 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
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 von HolgerX:

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

[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;