Wallpaper und Windows 8+

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

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