GetSpecialFolder

[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 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 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 von Luckie:

Zitat:

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

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 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;