SHGetFolderLocation

[Luckie]

Da ja die API-Funktion SHGetSpecialFolderLocation veraltet ist und man stattdessen SHgetFolderLocation benutzen sollte, versuche ich gerade meinen Code, um die Pfade zu Systemordner zu ermitteln zu überarbeiten:

Delphi-Quellcode:

uses
  Windows, SysUtils, shlobj, ActiveX;

function SHGetFolderLocation (hwndOwnder: THandle; nFolder: Integer; hToken: THandle; dwReserved: DWORD; ppidl:
  PItemIdList): HRESULT; stdcall; external 'shell32.dll' name 'SHGetFolderLocation';
function SHGetPathFromIDListW(Pidl: PItemIDList; pszPath: PWideChar): BOOL; stdcall; external 'shell32.dll'
  name 'SHGetPathFromIDListW';

function PathFromIDList(Pidl: PItemIdList): WideString;
begin
  SetLength(Result, MAX_PATH);
  if not SHGetPathFromIDListW(Pidl, PWideChar(Result)) then
    raise Exception.Create('Odner kann nicht ermittelt werden');
end;

function GetShellFolder(CSIDL: Integer): WideString;
var
  ppidl: PItemIdList;
begin
  ppidl := CoTaskMemAlloc(0);
  try
    case SHGetFolderLocation(0, CSIDL, 0, 0, ppidl) of
      S_OK: Result := PathFromIDList(ppidl);
      S_FALSE: raise Exception.Create('Ordner existiert nicht');
      E_INVALIDARG: raise Exception.Create('Argument ungültig');
    end;
  finally
    CoTaskMemFree(ppidl);
  end;
end;

begin
  try
    Writeln(GetShellFolder(CSIDL_LOCAL_APPDATA));
  except
    on E: Exception do
      Writeln(E.Message);
  end;
  Readln;
end.

Leider steigt er beim Aufruf von SHGetPathFromIDListW mit einer Access Violation in der shell32.dll aus, obwohl der Übergabeparamter gültig ist.

Was mache ich da noch falsch?

[Popov]

Das ist es nicht, aber sollte nicht immer MAX_PATH + 1 reserviert werden?

[Luckie]

Wahrscheinlich müsste es sogar (MAX_PATH * 2) + 2 heißen, da ich die Unicode Version nutze.

[Fridolin Walther]

Zitat:

Zitat von Luckie

Wahrscheinlich müsste es sogar (MAX_PATH * 2) + 2 heißen, da ich die Unicode Version nutze.

Nicht wirklich, weil SetLength einen WideString imho als array of WideChar interpretiert und ein WideChar 2 Byte groß ist ;).

Ansonsten hab ich den Fehler gefunden (http://msdn.microsoft.com/en-us/libr...80(VS.85).aspx):

Zitat:

[out] The address of a pointer to an item identifier list structure that specifies the folder's location relative to the root of the namespace (the desktop). The ppidl parameter is set to NULL on failure. The calling application is responsible for freeing this resource by calling ILFree.

Man setze also ein @ vor ppidl im SHGetFolderLocation Aufruf ;).

[Luckie]

Zitat:

Zitat von Fridolin Walther

Man setze also ein @ vor ppidl im SHGetFolderLocation Aufruf ;).

Ich werde den Zeigern noch mal den Krieg erklären: "Ab 5:40 wird zurrrrück gezeigt!".

[Fridolin Walther]

Wenn ich sage, daß wir selbst schuld sind, weil wir die Doku nicht aufmerksam gelesen haben, dann bekomm ich haue, oder? ;)

[Luckie]

Nur ein Problem bleibt noch: Wie bekomme ich die Fragezeichen (in der Konsole) weg?

C:\Dokumente und Einstellungen\Michael\Lokale Einstellungen\Anwendungsdaten'#0'몭몭몭몭몭몭몭몭 몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭 몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭 몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭몭 몭몭몭몭몭몭몭몭몭'

Mit trim funktioniert es nicht. Und die Funktion SHGetPathFromIDListW liefert wohl auch keine Informationen über die Länge des Ergebnisses.

Gelesen habe ich sie, nur dachte ich PItemIdList wäre schon der Zeiger wegen des "P"s.

[Fridolin Walther]

Delphi-Quellcode:

function PathFromIDList(Pidl: PItemIdList): WideString;
const
  NTFS_MAX_PATH = 32767;
var
  Path : PWideChar;
begin
  GetMem(Path, (NTFS_MAX_PATH + 1) * 2);
  if not SHGetPathFromIDListW(Pidl, Path) then
    begin
      FreeMem(Path);
      raise Exception.Create('Odner kann nicht ermittelt werden');
    end;
  Result := WideString(Path);
  FreeMem(Path);
end;

Wahrscheinlich wird beim SetLength nicht mit 0 initialisiert, was dafür sorgt, daß das abschließende 0-Byte fehlt. GetMem dagegen initialisiert mit 0.

Zitat:

Zitat von Luckie

Gelesen habe ich sie, nur dachte ich PItemIdList wäre schon der Zeiger wegen des "P"s.

Ist ja auch ein Zeiger. Nur wird halt kein Zeiger auf eine Variable erwartet, sondern ein Zeiger auf einen Zeiger der auf eine Variable zeigt ;).

[Luckie]

Jupp, so geht es:

Delphi-Quellcode:

function PathFromIDList(Pidl: PItemIdList): WideString;
const
  NTFS_MAX_PATH = 32767;
var
  Path: PWideChar;
begin
  GetMem(Path, (NTFS_MAX_PATH + 1) * 2);
  try
    if not SHGetPathFromIDListW(Pidl, Path) then
    begin
      FreeMem(Path);
      raise Exception.Create(rsE_GetPathFromIDList);
    end;
    Result := WideString(Path);
  finally
    FreeMem(Path);
  end;
end;

Ich habe noch den Ressourcenschutzblock ergänzt.

Zitat:

Zeiger auf einen Zeiger der auf eine Variable zeigt

Gehts noch? :evil:

[Fridolin Walther]

Zitat:

Zitat von Luckie

Ich habe noch den Ressourcenschutzblock ergänzt.

Der gute Robert C. Martin wird uns töten wenn er sieht wie wir hier try..except..finally mit dem Code mischen ;).

Zitat:

Zitat von Luckie

Gehts noch? :evil:

Wenn man genauer drüber nachdenkt machts sogar Sinn :).

Noch ein kleiner Hinweis:
Entfern das "ppidl := CoTaskMemAlloc(0);" noch aus dem Code. Ist nicht wirklich notwendig.

[Luckie]

Zitat:

Zitat von Fridolin Walther

Zitat:

Zitat von Luckie

Ich habe noch den Ressourcenschutzblock ergänzt.

Der gute Robert C. Martin wird uns töten wenn er sieht wie wir hier try..except..finally mit dem Code mischen ;).

Warum? Was ist daran so schlimm?

Zitat:

Zitat:

Zitat von Luckie

Gehts noch? :evil:

Wenn man genauer drüber nachdenkt machts sogar Sinn :).

Aber nicht mehr um viertel nach zwei nachts.

Zitat:

Noch ein kleiner Hinweis:
Entfern das "ppidl := CoTaskMemAlloc(0);" noch aus dem Code. Ist nicht wirklich notwendig.

Wird gemacht. Moment:

Zitat:

The calling application is responsible for freeing this resource by calling ILFree.

Und

Zitat:

When using Microsoft Windows 2000 or later, use CoTaskMemFree rather than ILFree.

[Fridolin Walther]

Zitat:

Zitat von Luckie

Wird gemacht. Moment:

Zitat:

The calling application is responsible for freeing this resource by calling ILFree.

Und

Zitat:

When using Microsoft Windows 2000 or later, use CoTaskMemFree rather than ILFree.

Du sollst ja auch nicht den Free Befehl rauswerfen, sondern den Alloc Befehl. Das Allozieren übernimmt die API für Dich ;).

[Luckie]

:duck:

Hm, im Fernsehe läuft gerade "Erwachsen auf Probe". Man sollte nur eine Sache gleichzeitig machen.

[Fridolin Walther]

Du schaust fern? Erstaunlich! :)

[Luckie]

Nun ja. Urlaub, nichts zu tun, ... Ich hätte auch noch ein paar DVDs zum gucken, nur habe ich jetzt keine Lust mir drei Stunden konzentriert "Der längetse Tag" anzugucken. ;)

[Fridolin Walther]

http://www.southparkstudios.com ... uneingeschränkt empfehlenswert. Immer und überall egal in welchem geistigen Zustand. Wobei ein möglichst desolater geistiger Zustand von Vorteil ist ;).

[Luckie]

Nein, das ist nicht so ganz mein Fall. Aber ich hätte da noch Monsieur "NEIN! DOCH! NEIN!" :mrgreen:

So, ich habe das ganze jetzt noch in einer Klasse verpackt, damit die beiden Funktionen nicht so lose darum fliegen:

Delphi-Quellcode:

// Project      : SHGetFolderLocation wrapper class
// Author       : Michael Puff [url]http://www.michael-puff.de[/url]
// Date         : 2009-06-25

unit SysFolderLocationCls;

interface

uses
  Windows,
  SysUtils,
  shlobj,
  ActiveX;

type
  TSysFolderLocation = class(TObject)
  private
    _CSIDL: Integer;
    function PathFromIDList(Pidl: PItemIdList): WideString;
  public
    property CSIDL: Integer read _CSIDL write _CSIDL;
    constructor Create(CSIDL: Integer);
    function GetShellFolder: WideString;
  end;

const
  CSIDL_PERSONAL = $0005; // My Documents
  CSIDL_MYMUSIC = $000D; // "My Music" folder
  CSIDL_APPDATA = $001A; // Application Data, new for NT4
  CSIDL_LOCAL_APPDATA = $001C; // non roaming, user\Local Settings\Application Data
  CSIDL_INTERNET_CACHE = $0020;
  CSIDL_COOKIES = $0021;
  CSIDL_HISTORY = $0022;
  CSIDL_COMMON_APPDATA = $0023; // All Users\Application Data
  CSIDL_WINDOWS = $0024; // GetWindowsDirectory()
  CSIDL_SYSTEM = $0025; // GetSystemDirectory()
  CSIDL_PROGRAM_FILES = $0026; // C:\Program Files
  CSIDL_MYPICTURES = $0027; // My Pictures, new for Win2K
  CSIDL_PROGRAM_FILES_COMMON = $002B; // C:\Program Files\Common
  CSIDL_COMMON_DOCUMENTS = $002E; // All Users\Documents
  CSIDL_RESOURCES = $0038; // %windir%\Resources\, For theme and other windows resources.
  CSIDL_RESOURCES_LOCALIZED = $0039; // %windir%\Resources\<LangID>, for theme and other windows specific resources.
  CSIDL_FLAG_CREATE = $8000; // new for Win2K, or this in to force creation of folder
  CSIDL_COMMON_ADMINTOOLS = $002F; // All Users\Start Menu\Programs\Administrative Tools
  CSIDL_ADMINTOOLS = $0030; // <user name>\Start Menu\Programs\Administrative Tools

implementation

{ SysFolderLocation }

function SHGetFolderLocation(hwndOwnder: THandle; nFolder: Integer; hToken: THandle; dwReserved: DWORD; ppidl:
  PItemIdList): HRESULT; stdcall; external 'shell32.dll' name 'SHGetFolderLocation';
function SHGetPathFromIDListW(Pidl: PItemIDList; pszPath: PWideChar): BOOL; stdcall; external 'shell32.dll'
name 'SHGetPathFromIDListW';

resourcestring
  rsE_GetPathFromIDList = 'Ordner kann nicht ermittelt werden';
  rsE_S_FALSE = 'Ordner existiert nicht';
  rsE_InvalidArgument = 'Argument ungültig';

constructor TSysFolderLocation.Create(CSIDL: Integer);
begin
  _CSIDL := CSIDL;
end;

function TSysFolderLocation.GetShellFolder: WideString;
var
  ppidl: PItemIdList;
begin
  try
    case SHGetFolderLocation(0, _CSIDL, 0, 0, @ppidl) of
      S_OK: Result := trim(PathFromIDList(ppidl));
      S_FALSE: raise Exception.Create(rsE_S_FALSE);
      E_INVALIDARG: raise Exception.Create(rsE_InvalidArgument);
    end;
  finally
    CoTaskMemFree(ppidl);
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// Procedure : PathFromIDList
// Comment   : Fridolin Walther
function TSysFolderLocation.PathFromIDList(Pidl: PItemIdList): WideString;
const
  NTFS_MAX_PATH = 32767;
var
  Path: PWideChar;
begin
  GetMem(Path, (NTFS_MAX_PATH + 1) * 2);
  try
    if not SHGetPathFromIDListW(Pidl, Path) then
    begin
      FreeMem(Path);
      raise Exception.Create(rsE_GetPathFromIDList);
    end;
    Result := WideString(Path);
  finally
    FreeMem(Path);
  end;
end;

end.

[Fridolin Walther]

Zitat:

Zitat von Luckie

Nein, das ist nicht so ganz mein Fall. Aber ich hätte da noch Monsieur "NEIN! DOCH! NEIN!" :mrgreen:

Louis de Funès?

Zitat:

Zitat von Luckie

So, ich habe das ganze jetzt noch in einer Klasse verpackt, damit die beiden Funktionen nicht so lose darum fliegen:

Ich mag ja Objekte so rein gar nicht. Aber ich kann mir ja ne prozedurale Lösung bauen ;).

[edit=Luckie]Zitat korrigiert. Mfg, Luckie[/edit]

[Luckie]

Zitat:

Zitat von Fridolin Walther

Zitat:

Zitat von Luckie

Nein, das ist nicht so ganz mein Fall. Aber ich hätte da noch Monsieur "NEIN! DOCH! NEIN!" :mrgreen:

Louis de Funès?

Jupp. Und zwar höätte ich da den "Querkopf"

Zitat:

Zitat:

Zitat von Luckie

So, ich habe das ganze jetzt noch in einer Klasse verpackt, damit die beiden Funktionen nicht so lose darum fliegen:

Ich mag ja Objekte so rein gar nicht. Aber ich kann mir ja ne prozedurale Lösung bauen ;).

Hm, was ist dagegen einzuwenden?

[Fridolin Walther]

Zitat:

Zitat von Luckie

Jupp. Und zwar höätte ich da den "Querkopf"

Der ist gar nicht mal so schlecht ;).

Zitat:

Zitat von Luckie

Hm, was ist dagegen einzuwenden?

Mir hat sich der Sinn für Objektorientierte Programmierung nie wirklich erschlossen. Ich bin quasi OO inkompatibel. Wahrscheinlich eine Charakterschwäche meinerseits ;).

[Luckie]

Spätestens bei umfangreicheren Programmen wirst du sie schätzen lernen.