Wallpaper und Windows 8+

[p80286]

Zitat von KodeZwerg:

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)

Gruß
K-H

[KodeZwerg]

ich holte mir damals immer über 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 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 \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?
function GetWallpaperBitmap: String;

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