Mega Code Archive
Get the pathes of the windows special folders
<![CDATA[
Title: get the pathes of the windows special folders?
uses
ActiveX, ShlObj;
procedure TForm1.Button1Click(Sender: TObject);
// Replace CSIDL_HISTORY with the constants below
var
Allocator: IMalloc;
SpecialDir: PItemIdList;
FBuf: array[0..MAX_PATH] of Char;
PerDir: string;
begin
if SHGetMalloc(Allocator) = NOERROR then
begin
SHGetSpecialFolderLocation(Form1.Handle, CSIDL_HISTORY, SpecialDir);
SHGetPathFromIDList(SpecialDir, @FBuf[0]);
Allocator.Free(SpecialDir);
ShowMessage(string(FBuf));
end;
end;
// With Windows Me/2000, the SHGetSpecialFolderLocation function
// is superseded by ShGetFolderLocation.
// function to get the desktop folder location:
function GetDeskTopPath : string;
var
shellMalloc: IMalloc;
ppidl: PItemIdList;
PerDir: string;
begin
ppidl := nil;
try
if SHGetMalloc(shellMalloc) = NOERROR then
begin
SHGetSpecialFolderLocation(Form1.Handle, CSIDL_DESKTOP, ppidl);
SetLength(Result, MAX_PATH);
if not SHGetPathFromIDList(ppidl, PChar(Result)) then
raise exception.create('SHGetPathFromIDList failed : invalid pidl');
SetLength(Result, lStrLen(PChar(Result)));
end;
finally
if ppidl nil then
shellMalloc.free(ppidl);
end;
end;
{
Constants:
CSIDL_DESKTOP
CSIDL_INTERNET
CSIDL_PROGRAMS
CSIDL_CONTROLS
CSIDL_PRINTERS
CSIDL_PERSONAL
CSIDL_FAVORITES
CSIDL_STARTUP
CSIDL_RECENT
CSIDL_SENDTO
CSIDL_BITBUCKET
CSIDL_STARTMENU
CSIDL_DESKTOPDIRECTORY
CSIDL_DRIVES
CSIDL_NETWORK
CSIDL_NETHOOD
CSIDL_FONTS
CSIDL_TEMPLATES
CSIDL_COMMON_STARTMENU
CSIDL_COMMON_PROGRAMS
CSIDL_COMMON_STARTUP
CSIDL_COMMON_DESKTOPDIRECTORY
CSIDL_APPDATA
CSIDL_PRINTHOOD
CSIDL_ALTSTARTUP
CSIDL_COMMON_ALTSTARTUP
CSIDL_COMMON_FAVORITES
CSIDL_INTERNET_CACHE
CSIDL_COOKIES
CSIDL_HISTORY
}
{***********************************************************}
{ Read paths from registry. by LENIN INC }
uses
Windows, SysUtils, Registry;
type
TSystemPath = (Desktop, StartMenu,
Programs, Startup, Personal, AppData,
Fonts, SendTo, Recent, Favorites, Cache,
Cookies, History, NetHood, PrintHood,
Templates, LocADat, WindRoot, WindSys,
TempPath, RootDir, ProgFiles, ComFiles,
ConfigPath, DevicePath, MediaPath, WallPaper);
function GetSystemPath(SystemPath: TSystemPath): string;
var
ph: PChar;
begin
with TRegistry.Create do
try
RootKey := HKEY_CURRENT_USER;
OpenKey('\Software\Microsoft\Windows\CurrentVersion\' +
'Explorer\Shell Folders', True);
case SystemPath of
Desktop: Result := ReadString('Desktop');
StartMenu: Result := ReadString('Start Menu');
Programs: Result := ReadString('Programs');
Startup: Result := ReadString('Startup');
Personal: Result := ReadString('Personal');
AppData: Result := ReadString('AppData');
Fonts: Result := ReadString('Fonts');
SendTo: Result := ReadString('SendTo');
Recent: Result := ReadString('Recent');
Favorites: Result := ReadString('Favorites');
Cache: Result := ReadString('Cache');
Cookies: Result := ReadString('Cookies');
History: Result := ReadString('History');
NetHood: Result := ReadString('NetHood');
PrintHood: Result := ReadString('PrintHood');
Templates: Result := ReadString('Templates');
LocADat: Result := ReadString('Local AppData');
WindRoot:
begin
GetMem(ph, 255);
GetWindowsDirectory(ph, 254);
Result := Strpas(ph);
Freemem(ph);
end;
WindSys:
begin
GetMem(ph, 255);
GetSystemDirectory(ph, 254);
Result := Strpas(ph);
Freemem(ph);
end;
TempPath:
begin
GetMem(ph, 255);
GetTempPath(254, ph);
Result := Strpas(ph);
Freemem(ph);
end;
RootDir:
begin
GetMem(ph, 255);
GetSystemDirectory(ph, 254);
Result := (Copy(Strpas(ph), 1, 2));
Freemem(ph);
end;
end;
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion', True);
case SystemPath of
ProgFiles: Result := ReadString('ProgramFilesDir');
ComFiles: Result := ReadString('CommonFilesDir');
ConfigPath: Result := ReadString('ConfigPath');
DevicePath: Result := ReadString('DevicePath');
MediaPath: Result := ReadString('MediaPath');
WallPaper: Result := ReadString('WallPaperDir');
end;
finally
CloseKey;
Free;
end;
if (Result '') and (Result[Length(Result)] '\') then
Result := Result + '\';
end;
//Use
procedure TForm1.Button1Click(Sender: TObject);
begin
label1.Caption := GetSystemPath(DevicePath);
end;
]]>