uses registry, filectrl; 
 
const 
  ID = '{00000000-FFFF-0000-0000-428956031850}'; 
  OK: boolean = false; 
 
function SpecialFolderReg(iconpfad: string): boolean; 
var 
  Reg: TRegistry; 
begin 
  result := false; 
  Reg := TRegistry.create; 
  try 
    Reg.RootKey := HKEY_CLASSES_ROOT; 
    if Reg.OpenKey('\CLSID\' + ID + '\DefaultIcon', True) 
      then begin 
      Reg.WriteString('', iconpfad); 
      result := true; 
    end; 
  finally 
    Reg.CloseKey; 
    Reg.Free; 
  end; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  OK := SpecialFolderReg('d:\icon2\erde.ico,0');  {Icon festlegen} 
end; 
 
function MakeSpecialFolder(ordnerpfad, ordnername: string): boolean; 
begin 
  result := OK; 
  if not result then exit; 
  if ansilastchar(ordnerpfad) <> '\' then 
    ordnerpfad := ordnerpfad + '\'; 
  ForceDirectories(ordnerpfad + ordnername + '.' + ID); 
end; 
 
{Ordner erzeugen} 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  if not MakeSpecialFolder('c:\', 'MySpecialFolder') 
    then showmessage('FEHLER'); 
end;

uses activex, comobj, registry, filectrl, shlobj; 
 
var 
  GUI, FolderName, IconLocation, FolderLocation: string; 
 
function mainkey: boolean; 
var 
  Reg: TRegistry; 
  aGui: TGuid; 
begin 
  result := false; 
  if not directoryexists(FolderLocation + FolderName) 
    then exit; 
  Reg := TRegistry.Create; 
  try 
    Reg.RootKey := HKEY_CLASSES_ROOT; 
    if Reg.OpenKey('\MySysFLR', true) then 
      if Reg.readstring(Foldername) = '' then begin 
        CoCreateGuid(aGui); 
        GUI := GuidToString(aGui); 
        result := Reg.OpenKey('\CLSID\' + GUI, True); 
        if result then begin 
          Reg.writestring('', FolderName); 
          Reg.CloseKey; 
          Reg.OpenKey('\MySysFLR', True); 
          Reg.writestring(FolderName, GUI); 
        end; 
      end; 
  finally 
    Reg.CloseKey; 
    Reg.Free; 
  end; 
end; 
 
function iconkey: boolean; 
var 
  Reg: TRegistry; 
begin 
  Reg := TRegistry.Create; 
  try 
    Reg.RootKey := HKEY_CLASSES_ROOT; 
    result := Reg.OpenKey('\CLSID\' + GUI + '\DefaultIcon', True); 
    if result then Reg.writestring('', IconLocation); 
  finally 
    Reg.CloseKey; 
    Reg.Free; 
  end; 
end; 
 
function shellkey: boolean; 
var 
  Reg: TRegistry; 
begin 
  Reg := TRegistry.Create; 
  try 
    Reg.RootKey := HKEY_CLASSES_ROOT; 
    result := Reg.OpenKey('\CLSID\' + GUI + '\InProcServer32', True); 
    if result then begin 
      Reg.writestring('', 'shell32.dll'); 
      Reg.writestring('ThreadingModel', 'Apartment'); 
    end; 
  finally 
    Reg.CloseKey; 
    Reg.Free; 
  end; 
end; 
 
function folderkey: boolean; 
const 
  buff: array[0..3] of byte = (0, 0, 0, 0); 
var 
  Reg: TRegistry; 
begin 
  Reg := TRegistry.Create; 
  try 
    Reg.RootKey := HKEY_CLASSES_ROOT; 
    result := Reg.OpenKey('\CLSID\' + GUI + '\ShellFolder', True); 
    if result then Reg.WriteBinaryData('', buff, sizeof(buff)); 
  finally 
    Reg.CloseKey; 
    Reg.Free; 
  end; 
end; 
 
function sheetkey: boolean; 
var 
  Reg: TRegistry; 
begin 
  Reg := TRegistry.Create; 
  try 
    Reg.RootKey := HKEY_CLASSES_ROOT; 
    result := Reg.OpenKey('\CLSID\' + GUI + 
      '\ShellEx\PropertySheetHandlers\' + GUI, True); 
  finally 
    Reg.CloseKey; 
    Reg.Free; 
  end; 
end; 
 
function openkey: boolean; 
var 
  Reg: TRegistry; 
begin 
  Reg := TRegistry.Create; 
  try 
    Reg.RootKey := HKEY_CLASSES_ROOT; 
    result := 
      Reg.OpenKey('\CLSID\' + GUI + '\Shell\Open\Command', True); 
    if result then 
      Reg.writestring('', 'explorer /root,' + FolderLocation + Foldername); 
  finally 
    Reg.CloseKey; 
    Reg.Free; 
  end; 
end; 
 
function deskkey: boolean; 
var 
  Reg: TRegistry; 
begin 
  Reg := TRegistry.Create; 
  try 
    Reg.RootKey := HKEY_LOCAL_MACHINE; 
    result := Reg.OpenKey 
      ('\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Desktop\NameSpace\' 
      + GUI, True); 
  finally 
    Reg.CloseKey; 
    Reg.Free; 
  end; 
end; 
 
function DesktopFolder: boolean; 
begin 
  result := false; 
  if ansilastchar(FolderLocation) <> '\' 
    then FolderLocation := FolderLocation + '\'; 
  Forcedirectories(FolderLocation + Foldername); 
  if mainkey then begin 
    if iconkey then begin 
      if shellkey then begin 
        if openkey then begin 
          if sheetkey then begin 
            if folderkey then begin 
              result := deskkey; 
              SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil); 
            end; 
          end; 
        end; 
      end; 
    end; 
  end; 
end; 
 
// Beispielaufruf 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  Foldername := 'DBR_FOLDER'; 
  IconLocation := 'D:\Icon2\desk.ico'; 
  // oder auch so: 
  // IconLocation := 'shell32.dll,19'; 
  FolderLocation := 'C:\Temp'; 
  if not DesktopFolder then showmessage('FEHLER'); 
end; 
 
//-------------------------------------------- 
 
// Der Systemordner wird entfernt, ohne den eigentlichen Folder zu löschen 

procedure removekey(flr: string); 
var 
  Reg: TRegistry; 
  sg: string; 
begin 
  Reg := TRegistry.Create; 
  try 
    Reg.RootKey := HKEY_CLASSES_ROOT; 
    if Reg.OpenKey('\MySysFLR', False) then begin 
      sg := Reg.readstring(flr); 
      Reg.deleteValue(flr); 
      if sg <> '' then 
        Reg.DeleteKey('\CLSID\' + sg); 
      Reg.CloseKey; 
      Reg.RootKey := HKEY_LOCAL_MACHINE; 
      Reg.DeleteKey 
        ('\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Desktop\NameSpace\' 
        + sg); 
    end; 
  finally 
    SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil); 
    Reg.CloseKey; 
    Reg.Free; 
  end; 
end; 
 
// Beispielaufruf 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  removekey('DBR_FOLDER'); 
end;