Type TSystemPath=(Desktop,StartMenu,Programs,Startup,Personal, winroot, winsys);
{©Drkb v.3(2007): <a href="http://www.drkb.ru" title="www.drkb.ru">www.drkb.ru</a>,
 ®Vit (Vitaly Nevzorov) - nevzorov@yahoo.com}
...
Function GetSystemPath(SystemPath:TSystemPath):string;
var p: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');
Winroot:begin
GetMem(p,255);
GetWindowsDirectory(p,254);
result:=Strpas(p);
Freemem(p);
end;
WinSys:begin
GetMem(p,255);
GetSystemDirectory(p,254);
result:=Strpas(p);
Freemem(p);
end;
end;
finally
CloseKey;
free;
end;
if (result<>'') and (result[length(result)]<>'\') then result:=result+'\';
end;

uses Registry;
procedure TForm1.Button1Click(Sender: TObject);
var
 reg : TRegistry;
 ts : TStrings;
 i : integer;
begin
 reg := TRegistry.Create;
 reg.RootKey := HKEY_CURRENT_USER;
 reg.LazyWrite := false;
 reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer\ShellFolders', false);
 ts := TStringList.Create;
 reg.GetValueNames(ts);
 for i := 0 to ts.Count -1 do
  Memo1.Lines.Add(ts.Strings[i] + ' = ' + reg.ReadString(ts.Strings[i]));
 ts.Free;
 reg.CloseKey;
 reg.free;
end;