AW: Wallpaper und Windows 8+
Zitat:
Zitat:
also
Delphi-Quellcode:
scheidet wegen obigen fehler aus obwohl das die windows api ist und der beschreibung nach auch machen sollte.
function GetWallpaperBitmap: String;
|
AW: Wallpaper und Windows 8+
Code:
dieses .vbs script funktioniert auf fremdrechner.
' 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 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; |
AW: Wallpaper und Windows 8+
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.. |
AW: Wallpaper und Windows 8+
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. |
AW: Wallpaper und Windows 8+
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. |
AW: Wallpaper und Windows 8+
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. |
AW: Wallpaper und Windows 8+
Hmm..
Ich habe mir mal erlaubt, deine Routine zu korrigieren:
Delphi-Quellcode:
Die ReadBinaryData enthalten offensichtlich ab dem Byte 24 einen WideString.
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; 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... |
AW: Wallpaper und Windows 8+
Zitat:
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: |
AW: Wallpaper und Windows 8+
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 ;) |
AW: Wallpaper und Windows 8+
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; |
Alle Zeitangaben in WEZ +1. Es ist jetzt 02:02 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz