1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComObj,
ActiveX, // IMalloc
ShellAPI, // SHGetSpecialFolderLocation() und SHGetPathFromIDList()
ShlObj; // CSIDL_-Konstanten

type
  TForm1 = class(TForm)
  Button1: TButton;
  Button2: TButton;
  Memo1: TMemo;
  procedure Button1Click(Sender: TObject);
  procedure Button2Click(Sender: TObject);
private

public

end;

var
Form1: TForm1;

implementation

{$R *.dfm}

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

procedure TForm1.Button1Click(Sender: TObject);
var
 FLibHandle: THandle;
 path:WideString;
 SHSetFolderPath: FUNCTION (csidl:integer;
 hToken:THANDLE;
 dwFlags: DWORD;
 pszPath: LPCTSTR):HRESULT;stdcall;
begin
  FLibHandle := LoadLibrary('Shell32.dll');
  SHSetFolderPath := GetProcAddress(FLibHandle, pchar(Ord(232)));
  path:='C:\PROG-1';  // DEIN PFAD -------------------------------------------------<<<

  if DirectoryExists(path) = false then mkdir(path);//------------------------------<<<

  if assigned(SHSetFolderPath)
  then try     //------------------- DEINE KONSTANTE--------------------------------<<<
    if not SUCCEEDED(SHSetFolderPath(CSIDL_FAVORITES, 0, 0, pchar(path)))then 
     Windows.beep(1000,100);
    finally
  end;
  if FLibHandle <> 0 then FreeLibrary(FLibHandle);
end;

procedure TForm1.Button2Click(Sender: TObject);
var i : Integer;
begin
for i := 0 to 63 do Memo1.Lines.add(IntToStr(i)+' : '+ GetSpecialFolder(Form1.Handle,i));
end;

end.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:

function DirectoryExists(const Directory: string): Boolean;
var
  Code: Integer;
begin
  Code := GetFileAttributes(PChar(Directory));
  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end; 

//Alternative - erweitert:

function DirectoryExists(const Directory: string; FollowLink: Boolean = True): Boolean;
var
  Code: Cardinal;
  Handle: THandle;
  LastError: Cardinal;
begin
  Result := False;
  Code := GetFileAttributes(PChar(Directory));

  if Code <> INVALID_FILE_ATTRIBUTES then
  begin
    if faSymLink and Code = 0 then
      Result := faDirectory and Code <> 0
    else
    begin
      if FollowLink then
      begin
        Handle := CreateFile(PChar(Directory), GENERIC_READ, FILE_SHARE_READ, nil,
          OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
        if Handle <> INVALID_HANDLE_VALUE then
        begin
          CloseHandle(Handle);
          Result := faDirectory and Code <> 0;
        end;
      end
      else if faDirectory and Code <> 0 then
        Result := True
      else
      begin
        Handle := CreateFile(PChar(Directory), GENERIC_READ, FILE_SHARE_READ, nil,
          OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
        if Handle <> INVALID_HANDLE_VALUE then
        begin
          CloseHandle(Handle);
          Result := False; //----------------------------------------------------------<<<
        end
        else
          Result := True;  //----------------------------------------------------------<<<
      end;
    end;
  end
  else
  begin
    LastError := GetLastError;
    Result := (LastError <> ERROR_FILE_NOT_FOUND) and
      (LastError <> ERROR_PATH_NOT_FOUND) and
      (LastError <> ERROR_INVALID_NAME) and
      (LastError <> ERROR_BAD_NETPATH);// <= Die entscheidende Zeile, die fehlte...
  end;
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:

function SetFolderPath(Csidl : Integer; Path : AnsiString) : boolean;

type TSHSetFolderPath = function (Csidl : Integer; hToken : THandle; dwFlags : Dword; pszPath : LPctstr) : HResult; stdcall;

var FLibHandle      : THandle;
    SHSetFolderPath : TSHSetFolderPath;
begin
  Result := false;
  FLibHandle := LoadLibrary('shell32.dll');
  SHSetFolderPath := TSHSetFolderPath(GetProcAddress(FLibHandle, pChar(Ord(232))));
  if assigned(SHSetFolderPath) then
  try
    if not SUCCEEDED(SHSetFolderPath(Csidl, 0, 0, pChar(Path))) then
      Result := false;
  finally
    Result := true;
  end;
  if (FLibHandle <> 0) then
    FreeLibrary(FLibHandle);
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:

function DirectoryExists2(const Directory: string): Boolean;
var
  Code: Cardinal;
begin
  Code := GetFileAttributes(PChar(Directory));
  Result := (Code <> INVALID_FILE_ATTRIBUTES) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;

function SetFolderPath(CSIDL : Integer; PATH : WideString) : boolean;
var
 FLibHandle: THandle;
 SHSetFolderPath: FUNCTION (csidl:integer; hToken:THANDLE; dwFlags: DWORD;
 pszPath: LPCTSTR):HRESULT;stdcall;
begin
  FLibHandle := LoadLibrary('Shell32.dll');
  SHSetFolderPath := GetProcAddress(FLibHandle, pchar(Ord(232)));
  if not DirectoryExists2(path) then mkdir(path);

  if assigned(SHSetFolderPath)
  then
  try
    if not SUCCEEDED(SHSetFolderPath(CSIDL, 0, 0, pchar(PATH)))then
    BEGIN
          Result := false;
          Windows.beep(1000,100);
    END else
        begin
          Result := true; //---------------------------------------------<<<
        end;
  finally
  end;
  if FLibHandle <> 0 then FreeLibrary(FLibHandle);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 SetFolderPath(CSIDL_PERSONAL, 'C:\HATHOR-5');
end;