GetSpecialFolder

[Mike_on_Tour]

Hallo,

ich möchte in einem Programm den Systempfad für "Dokumente für alle Benutzer ermitteln". Das mache ich mit der Funktion "GetSpecialFolder" und CSIDL_COMMON_DOCUMENTS als Parameter.

Delphi-Quellcode:

function GetSpecialFolder (CSIDL: Integer) : String;
var
  ItemIDList: PItemIDList;
  sFolderPath : String;
  iSystemFolder : Integer;
  pMalloc : IMalloc;
begin
  pMalloc := nil;
  sFolderPath := '';
  SHGetMalloc (pMalloc);
  if (pMalloc = nil)
    then begin
      Exit;
    end;
  try
    iSystemFolder := CSIDL;
    if (SUCCEEDED (SHGetSpecialFolderLocation (0, iSystemFolder, ItemIDList)))
      then begin
        SetLength (sFolderPath, MAX_PATH);
        if (SHGetPathFromIDList(ItemIDList, PChar(sFolderPath)))
          then begin
            SetLength (sFolderPath, Length(PChar(sFolderPath)));
          end;
      end;
  finally
    Result := sFolderPath;
    pMalloc.Free(ItemIDList);
  end;
end;

Prinzipiell funktioniert das auch ganz gut. Ich habe aber jetzt den Fall, daß das Ergebnis der Funktion ein leerer String ist. Meine Vermutung ist, daß "pMalloc = nil" ist und die Funktion beendet wird. Aber warum ?

Was könnte die Ursache sein und wie kann ich darauf reagieren ?

mfG

Mike

[RavenIV]

Da gibt es doch eine fertige API-Funktion dafür.
Der kannst Du mitgeben, welchen SpecialFolder Du suchst.
Leider hab ich grad den Namen vergessen und das Delphi momentan nicht gestartet.

[wido]

Ich hatte mal ein relativ ähnliches Problem. Allerdings konnte ich nie wirklich herausfinden wieso es zu dem Problem kommt. Ich hab stattdessen begonnen die entsprechenden APIs zu meiden und mir den Wert einfach selbst aus der Registry gefischt:

Delphi-Quellcode:

program Project1;

{$APPTYPE CONSOLE}

uses
  registry, windows;

//FIXME: Diese Funktion ist ANSI only, bedeutet UNICODE Pfade werden nicht
//       korrekt zurückgeliefert
function GetRegistryPath(valuename : string) : string;
begin
  result := '';
  with TRegistry.Create do
    begin
      RootKey := HKEY_LOCAL_MACHINE;
      OpenKeyReadOnly('\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer'+
                      '\Shell Folders');
      if ValueExists(valuename) then
        result := ReadString(valuename);
      CloseKey;
      Free;
    end;
end;

begin
  writeln(GetRegistryPath('Common Documents'));
  readln;
end.

Solltest Du also keine Lösung für Dein Problem finden, hast Du hier wenigstens eine Alternative :).

[jbg]

Zitat:

Zitat von wido

Ich hab stattdessen begonnen die entsprechenden APIs zu meiden und mir den Wert einfach selbst aus der Registry gefischt:

Und genau das soll man nicht machen. Denn Microsoft behält sich vor den Ort und Namen in er Registry zu ändern. Deswegen gibt es die entsprechenden Funktionen.

[Luckie]

Zitat:

Zitat von wido

Ich hatte mal ein relativ ähnliches Problem. Allerdings konnte ich nie wirklich herausfinden wieso es zu dem Problem kommt. Ich hab stattdessen begonnen die entsprechenden APIs zu meiden und mir den Wert einfach selbst aus der Registry gefischt:

Dann solltest du dir dies mal durchlesen: The long and sad story of the Shell Folders key

Zitat:

Zitat von Mike_on_Tour

Meine Vermutung ist, daß "pMalloc = nil" ist und die Funktion beendet wird. Aber warum ?

Dann debug deinen Code doch mal, dann weißt du es.

[RavenIV]

mit dem RootKey HKEY_LOCAL_MACHINE findest Du aber nur die Sachen für AllUsers.

Wenn Du die Sachen des aktuellen USers haben möchtest, musst Du HKey_CURRENT_USER verwenden.

[Mike_on_Tour]

Zitat:

Zitat von wido

Ich hatte mal ein relativ ähnliches Problem. Allerdings konnte ich nie wirklich herausfinden wieso es zu dem Problem kommt. Ich hab stattdessen begonnen die entsprechenden APIs zu meiden und mir den Wert einfach selbst aus der Registry gefischt: ... Solltest Du also keine Lösung für Dein Problem finden, hast Du hier wenigstens eine Alternative :).

Danke für den Beistand und die alternative Lösung. Ich werde mir das mal anschauen.

Zitat:

Zitat von wido

Da gibt es doch eine fertige API-Funktion dafür.

Kann es sein, daß ich die schon verwende ?

Mike

[Mike_on_Tour]

Zitat:

Zitat von Luckie

Dann debug deinen Code doch mal, dann weißt du es.

Das mache ich ja schon. Das Dumme ist nur, das es bei mir funktioniert. Oh, ich habe vergessen anzugeben, daß es auf einem Computer in 300 km Entfernung eben nicht geht.

[Luckie]

Hilfe lesen:

Zitat:

With Microsoft Windows 2000, this function is superseded by SHGetFolderLocation.

Zitat:

Zitat von Mike_on_Tour

Das mache ich ja schon. Das Dumme ist nur, das es bei mir funktioniert. Oh, ich habe vergessen anzugeben, daß es auf einem Computer in 300 km Entfernung eben nicht geht.

Dann ergänz deine if-abfragen um die entsprechenden else-Zweige und gibt dort eine Fehlermeldung aus. Ein Aufruf von GetLastError könnte auch nicht schaden.

[wido]

Zitat:

Zitat von Luckie

Dann solltest du dir dies mal durchlesen: The long and sad story of the Shell Folders key

Ich kenn den Blog Post bereits. Ändert nichts an folgenden Punkten:

1. SHGetSpecialFolderLocation ist von der Benutzung her extrem umständlich.
2. SHGetSpecialFolderLocation neigt dazu aus heiterem Himmel fehl zu schlagen.
3. SHGetSpecialFolderLocation hat einen gigantischen Overhead.

Die Limitierung, daß die Registry Keys erst nach der ersten Verwendung von SHGetSpecialFolderLocation erstellt werden, ist für die Werte, die hier abgefragt werden irrelevant, da sie auch bei einem frisch installiertem Windows bereits existieren.

Allerdings bin ich wahrscheinlich einfach nur zu ungebildet und pragmatisch veranlagt ...

[hathor]

Es existieren nicht auf jedem PC alle Specialfolder.
Mit der letzten Codezeile kannst Du alle vorhandenen darstellen.

Delphi-Quellcode:

uses
  { ... },
  ActiveX,  // IMalloc
  ShellAPI, // SHGetSpecialFolderLocation() und SHGetPathFromIDList()
  ShlObj;   // CSIDL_-Konstanten
//fehlende CSIDL_-Konstanten kann man nach folgendem Muster definieren:
const CSIDL_COMMON_APPDATA = $0023; 
      CSIDL_MYMUSIC = $0013;
      CSIDL_MYPICTURES = $0014;  //FONTS
      CSIDL_LOCAL = $0022;
      CSIDL_SYSTEM = $0025;
      CSIDL_WINDOWS = $0024;
      CSIDL_PROGRAM_FILES = $0026;
      CSIDL_LOCAL_APPDATA  = $001C;

function GetSpecialFolder(hWindow: HWND; Folder: Integer): String;
var
pMalloc: IMalloc;
pidl: PItemIDList;
Path: PChar;
begin
// get IMalloc interface pointer
if (SHGetMalloc(pMalloc) <> S_OK) then
begin
MessageBox(hWindow, 'Couldn''t get pointer to IMalloc interface.','SHGetMalloc(pMalloc)', 16);
Exit;
end;
// retrieve path
SHGetSpecialFolderLocation(hWindow, Folder, pidl);
GetMem(Path, MAX_PATH);
SHGetPathFromIDList(pidl, Path);
Result := Path;
FreeMem(Path);

// free memory allocated by SHGetSpecialFolderLocation
pMalloc.Free(pidl);
end;

function GetSpecialFolder2(FolderID : longint) : string;
var
Path : pchar;
idList : PItemIDList;
begin
GetMem(Path, MAX_PATH);
SHGetSpecialFolderLocation(0, FolderID, idList);
SHGetPathFromIDList(idList, Path);
Result := string(Path);
FreeMem(Path);
end;

function GetDrives: string;
begin
Result := IncludeTrailingBackslash(GetSpecialFolder2(CSIDL_Drives));
end;

function GetMyMusic: string;
begin
Result := IncludeTrailingBackslash(GetSpecialFolder2(13));
end;

function GetTmpInternetDir: string;
begin
Result := IncludeTrailingBackslash(GetSpecialFolder2(CSIDL_INTERNET_CACHE));
end;

function GetCookiesDir: string;
begin
Result := IncludeTrailingBackslash(GetSpecialFolder2(CSIDL_COOKIES));
end;

function GetHistoryDir: string;
begin
Result := IncludeTrailingBackslash(GetSpecialFolder2(CSIDL_HISTORY));
end;

function GetDesktop: string;
begin
Result := IncludeTrailingBackslash(GetSpecialFolder2(CSIDL_DESKTOP));
end;

function GetDesktopDir: string;
begin
Result := IncludeTrailingBackslash(GetSpecialFolder2(CSIDL_DESKTOPDIRECTORY));
end;

function GetProgDir: string;
begin
Result := IncludeTrailingBackslash(GetSpecialFolder2(CSIDL_PROGRAMS)); 
end;

function GetMyDocDir: string;
begin
Result := IncludeTrailingBackslash(GetSpecialFolder2(CSIDL_PERSONAL));
end;

function GetFavDir: string;
begin
Result := IncludeTrailingBackslash(GetSpecialFolder2(CSIDL_FAVORITES)); 
end;

function GetStartUpDir: string;
begin
Result := IncludeTrailingBackslash(GetSpecialFolder2(CSIDL_STARTUP));
end;

function GetRecentDir: string;
begin
Result := IncludeTrailingBackslash(GetSpecialFolder2(CSIDL_RECENT));
end;

function GetSendToDir: string;
begin
Result := IncludeTrailingBackslash(GetSpecialFolder2(CSIDL_SENDTO));
end;

function GetStartMenuDir: string;
begin
Result := IncludeTrailingBackslash(GetSpecialFolder2(CSIDL_STARTMENU));
end;

function GetNetHoodDir: string;
begin
Result := IncludeTrailingBackslash(GetSpecialFolder2(CSIDL_NETHOOD)); 
end;

function GetFontsDir: string;
begin
Result := IncludeTrailingBackslash(GetSpecialFolder2(CSIDL_FONTS)); 
end;

function GetTemplateDir: string;
begin
Result := IncludeTrailingBackslash(GetSpecialFolder2(CSIDL_TEMPLATES));
end;

function GetAppDataDir: string;
begin
Result := IncludeTrailingBackslash(GetSpecialFolder2(CSIDL_APPDATA));
end;

function GetPrintHoodDir: string;
begin
Result := IncludeTrailingBackslash(GetSpecialFolder2(CSIDL_PRINTHOOD));
end;

//damit kriegt man angezeigt, was auf dem eigenen PC möglich ist
//for i := 0 to 64 do  Memo1.Lines.add(IntToStr(i)+' : '+ GetSpecialFolder(Form1.Handle,i));

[Luckie]

Dann nimm: SHGetSpecialFolderPath oder wohl besser SHGetFolderPath.

[Mike_on_Tour]

Zitat:

Zitat von Luckie

Dann ergänz deine if-abfragen um die entsprechenden else-Zweige und gibt dort eine Fehlermeldung aus.

Eine kleine Anmerkung sei erlaubt: die o.g. Funktion scheint aus dem Beitrag HOMEDIR - Das unbekannte Verzeichnis zu stammen.

[Luckie]

Kann schon sein, dass sie von mir ist. Soll dich aber nicht daranhindern, die genannten Änderungen vorzunehmen um den Fehler zu finden.

[Mike_on_Tour]

Ist schon OK.

Ich habe das jetzt so gelöst, daß ich das Ergebnis der o.g. Funktion überprüfe. Ist das Ergebnis ein leerer String, versuche ich das Verzeichnis über die Registry zu ermitteln (Danke an wido). Erst wenn dieser Versuch auch kein Ergebnis bringt, gibt ich eine Fehlermeldung. Bleibt aber trotzdem die Frage offen, was die Ursache für das Problem sein könnte. Es muß ja auf den anderen Computern etwas anders sein als bei mir.

Mike

[Luckie]

Zitat:

Zitat von Mike_on_Tour

Bleibt aber trotzdem die Frage offen, was die Ursache für das Problem sein könnte. Es muß ja auf den anderen Computern etwas anders sein als bei mir.

Posting #9: http://www.delphipraxis.net/internal...=864389#864389 :?

[messie]

Zitat:

Zitat von Luckie

Zitat:

With Microsoft Windows 2000, this function is superseded by SHGetFolderLocation.

Zitat:

Zitat von MSDN

SHGetKnownFolderPath replaces SHGetFolderPath

Irgendwann hatten wir auch mal rausgefunden, dass es unter XP64 keine Antwort für diesen Pfad gab. Thread

Grüße, Messie

[Jaynder]

Zitat:

Zitat von Mike_on_Tour

Ist schon OK.

Ich habe das jetzt so gelöst, daß ich das Ergebnis der o.g. Funktion überprüfe. Ist das Ergebnis ein leerer String, versuche ich das Verzeichnis über die Registry zu ermitteln (Danke an wido). Erst wenn dieser Versuch auch kein Ergebnis bringt, gibt ich eine Fehlermeldung. Bleibt aber trotzdem die Frage offen, was die Ursache für das Problem sein könnte. Es muß ja auf den anderen Computern etwas anders sein als bei mir.

Mike

Kann dich beruhigen oder auch nicht. Hatte heute das Problem auf meinem Rechner. Hatte gegeüber gestern nur eine neue Software installiert (O&O Defrag), wollte dann ein paar Kleinigkeiten irgendwo in einem meiner Projekte ändern und schon spinnt der SHGetFolderPath (Fehler=$80070003). Aber nur beim Starten aus der Delphi Entwicklungsumgebung, beim Direktstart ist alles ok. In anderen Projekten keine Probleme, ist echt verhext.

Hab es jetzt erstmal wie du gelöst. Hat jemand eine Idee, wo ich den Pfad für CSIDL_PROGRAM_FILES herbekomme ?

(Vista Pro / D2007)

Delphi-Quellcode:

function GetFileFolderPathFromRegistry (RootKey: Cardinal; const CSIDLName : string): string;
  var Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  Reg.RootKey := RootKey;
  Reg.OpenKeyReadOnly('\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders');
  if Reg.ValueExists(CSIDLName) then begin
    Result := Reg.ReadString(CSIDLName);
  end else begin
    Result := '';
  end;
  Reg.CloseKey;
  Reg.Free;
end;

function GetFromRegistry (CSIDL: Integer): string;

  //  [HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\explorer\Shell Folders]
  //  "Common Start Menu"="C:\\ProgramData\\Microsoft\\Windows\\Start Menu"
  //  "CommonVideo"="C:\\Users\\Public\\Videos"
  //  "CommonPictures"="C:\\Users\\Public\\Pictures"
  //  "Common Programs"="C:\\ProgramData\\Microsoft\\Windows\\Start Menu\\Programs"
  //  "CommonMusic"="C:\\Users\\Public\\Music"
  //  "Common Administrative Tools"="C:\\ProgramData\\Microsoft\\Windows\\Start Menu\\Programs\\Administrative Tools"
  //  "Common Startup"="C:\\ProgramData\\Microsoft\\Windows\\Start Menu\\Programs\\Startup"
  //  "Common Desktop"="C:\\Users\\Public\\Desktop"
  //  "Common Documents"="C:\\Users\\Public\\Documents"
  //  "OEM Links"="C:\\ProgramData\\OEM Links"
  //  "Common Templates"="C:\\ProgramData\\Microsoft\\Windows\\Templates"
  //  "Common AppData"="C:\\ProgramData"


  //  [HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders]
  //  "!Do not use this registry key"="Use the SHGetFolderPath or SHGetKnownFolderPath function instead"
  //  "Local AppData"="C:\\Users\\...\\AppData\\Local"
  //  "My Video"="C:\\Users\\...\\Videos"
  //  "AppData"="C:\\Users\\...\\AppData\\Roaming"
  //  "My Pictures"="C:\\Users\\...\\Pictures"
  //  "Desktop"="C:\\Users\\...\\Desktop"
  //  "History"="C:\\Users\\...\\AppData\\Local\\Microsoft\\Windows\\History"
  //  "NetHood"="C:\\Users\\...\\AppData\\Roaming\\Microsoft\\Windows\\Network Shortcuts"
  //  "Cookies"="C:\\Users\\...\\AppData\\Roaming\\Microsoft\\Windows\\Cookies"
  //  "Favorites"="C:\\Users\\...\\Favorites"
  //  "SendTo"="C:\\Users\\...\\AppData\\Roaming\\Microsoft\\Windows\\SendTo"
  //  "Start Menu"="C:\\Users\\...\\AppData\\Roaming\\Microsoft\\Windows\\Start Menu"
  //  "My Music"="C:\\Users\\...\\Music"
  //  "Programs"="C:\\Users\\...\\AppData\\Roaming\\Microsoft\\Windows\\Start Menu\\Programs"
  //  "Recent"="C:\\Users\\...\\AppData\\Roaming\\Microsoft\\Windows\\Recent"
  //  "CD Burning"="C:\\Users\\...\\AppData\\Local\\Microsoft\\Windows\\Burn\\Burn"
  //  "PrintHood"="C:\\Users\\...\\AppData\\Roaming\\Microsoft\\Windows\\Printer Shortcuts"
  //  "Startup"="C:\\Users\\...\\AppData\\Roaming\\Microsoft\\Windows\\Start Menu\\Programs\\Startup"
  //  "Administrative Tools"="C:\\Users\\...\\AppData\\Roaming\\Microsoft\\Windows\\Start Menu\\Programs\\Administrative Tools"
  //  "Personal"="C:\\Users\\...\\Documents"
  //  "Cache"="C:\\Users\\...\\AppData\\Local\\Microsoft\\Windows\\Temporary Internet Files"
  //  "Templates"="C:\\Users\\...\\AppData\\Roaming\\Microsoft\\Windows\\Templates"
  //  "Fonts"="C:\\Windows\\Fonts"
begin
  case CSIDL of
    CSIDL_APPDATA: Result := GetFileFolderPathFromRegistry (HKEY_CURRENT_USER, 'APPDATA');
    CSIDL_COMMON_APPDATA: Result := GetFileFolderPathFromRegistry (HKEY_LOCAL_MACHINE, 'COMMON_APPDATA');
    // CSIDL_PROGRAM_FILES: Result := GetFileFolderPathFromRegistry ('PROGRAM_FILES');
    CSIDL_PERSONAL: Result := GetFileFolderPathFromRegistry (HKEY_CURRENT_USER, 'PERSONAL');
  else
    Fehlermeldung ('SHGetFolderPath-Ersatz für CSIDL=%d nicht definiert', [CSIDL]);
    Result := '';
  end;
end;