uses
  ActiveX;
 
function NameToSid(const AName: string;
  const Server: string = ''): PSID;
var
  cbSid, cbDomn, peUse: Cardinal;
  BufSid, BufDmn: array[0..255] of Char;
  pSrv: PChar;
  s: string;
begin
  Result:= nil;
  if AName = '' then
  begin
    cbSid:= sizeof(BufSid);
    if GetUserName(@BufSid[0], cbSid) then
      s:= BufSid else Exit;
  end else
    s:= AName;
  cbSid:= SizeOf(BufSid); cbDomn:= SizeOf(BufDmn);
  if '' = Server then pSrv:= nil else pSrv:= PChar(Server);
  if LookupAccountName(pSrv, PChar(s),
      @BufSid, cbSid, @BufDmn, cbDomn, peUse) then
  begin
    cbSid:= GetLengthSid(@BufSid);
    Result:= AllocMem(cbSid);
    if nil <> Result then Move(BufSid, Result^, cbSid)
    else SetLastError(ERROR_NOT_ENOUGH_MEMORY);
  end;
end;

function SidToName(Sid: PSID;
  out Domain: string; const Server: string = ''): string;
var
  cbUser, cbDomn, peUse: Cardinal;
  BufUser, BufDmn: array[0..255] of Char;
  pSrv: PChar;
begin
  cbUser:= SizeOf(BufUser); cbDomn:= SizeOf(BufDmn);
  Result:= ''; Domain:= '';
  if '' = Server then pSrv:= nil else pSrv:= PChar(Server);
  if LookupAccountSid(pSrv, Sid, @BufUser, cbUser, @BufDmn, cbDomn, peUse)
  then begin
    Result:= BufUser;
    Domain:= BufDmn;
  end;
end;

procedure CreateSecureFolder(const OwnerName, FolderName: string);
var
  SA: TSecurityAttributes;
  SD: TSecurityDescriptor;
  Acl: PACL;
  SidEveryone, SidUser: PSID;
  SzAcl: Cardinal;
begin
  Acl:= nil; SidEveryone:= nil; SidUser:= nil;

  try
    Win32Check(AllocateAndInitializeSid(SECURITY_WORLD_SID_AUTHORITY, 1,
      SECURITY_WORLD_RID, 0, 0, 0, 0, 0, 0, 0, SidEveryone));
    SidUser:= NameToSid(OwnerName);
    Win32Check(SidUser <> nil);

    SzAcl:= SizeOf(Acl^) + GetLengthSid(SidEveryone) +
      GetLengthSid(SidUser) + 2 * SizeOf(TAccessAllowedAce);
    GetMem(Acl, SzAcl);

    Win32Check(InitializeAcl(ACL^, SzAcl, ACL_REVISION));
    Win32Check(AddAccessAllowedAceEx(Acl^, ACL_REVISION,
      CONTAINER_INHERIT_ACE or OBJECT_INHERIT_ACE, GENERIC_ALL, SidUser));
    Win32Check(AddAccessAllowedAceEx(Acl^, ACL_REVISION,
      CONTAINER_INHERIT_ACE or OBJECT_INHERIT_ACE,
      GENERIC_READ or GENERIC_EXECUTE, SidEveryone));

    Win32Check(InitializeSecurityDescriptor(@SD, SECURITY_DESCRIPTOR_REVISION));
    Win32Check(SetSecurityDescriptorOwner(@SD, SidUser, true));
    Win32Check(SetSecurityDescriptorDacl(@SD, true, Acl, true));

    SA.nLength:= SizeOf(SA);
    SA.lpSecurityDescriptor:= @SD;
    SA.bInheritHandle:= false;

    Win32Check(CreateDirectory(PChar(FolderName), @SA));
   
  finally
    if nil <> Acl then FreeMem(Acl);
    FreeSid(SidEveryone);
    FreeMem(SidUser);
  end;
end;

procedure CreateUser(const UserName, Password, GroupName: WideString;
  PrivilegeLevel: cardinal);
var
  UserInfo: TUserInfo1;
  GroupInfo: TLocalGroupMembersInfo0;
  Rslt: Cardinal;
  ParamErr: Cardinal;
begin
  FillChar(UserInfo, SizeOf(UserInfo), 0);
  UserInfo.usri1_name:= PWideChar(UserName);
  UserInfo.usri1_password:= PWideChar(Password);
  UserInfo.usri1_priv:= PrivilegeLevel;
  Rslt:= NetUserAdd(nil, 1, @UserInfo, @ParamErr);
  if NERR_Success <> Rslt then
    if Rslt = ERROR_INVALID_PARAMETER then
      raise EOSError.CreateFmt('Invalid parameter: %d', [ParamErr])
    else raise EOSError.Create(SysErrorMessage(Rslt));

  GroupInfo.lgrmi0_sid:= NameToSid(UserName);
  Win32Check(GroupInfo.lgrmi0_sid <> nil);
  try
    Rslt:= NetLocalGroupAddMembers(nil, PWideChar(GroupName), 0, @GroupInfo, 1);
    if NERR_Success <> Rslt then
      raise EOSError.Create(SysErrorMessage(Rslt));
  finally
    FreeMem(GroupInfo.lgrmi0_sid);
  end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  User, Pswrd, Group, Domain: string;
  hUser: THandle;
  SidUsers: PSID;
begin
  Win32Check(AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2,
    SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_USERS, 0, 0, 0,
    0, 0, 0, SidUsers));
  try
    Group:= SidToName(SidUsers, Domain);
  finally
    FreeSid(SidUsers);
  end;
  User:= 'Pupkin';
  Pswrd:= 'PupkinPassword';
  CreateUser(User, Pswrd, Group, USER_PRIV_USER);

  Win32Check(LogonUser(PChar(User), nil, PChar(Pswrd),
    LOGON32_LOGON_INTERACTIVE, LOGON32_PROVIDER_DEFAULT, hUser));
  try
    if ImpersonateLoggedOnUser(hUser) then
    try
      CreateSecureFolder(User, Edit1.Text);
    finally
      RevertToSelf;
    end else
      RaiseLastOSError;
  finally
    CloseHandle(hUser);
  end;
end;

uses
  Windows;

const
  SECURITY_WORLD_SID_AUTHORITY:  TSidIdentifierAuthority =
                                      (Value: (0, 0, 0, 0, 0, 1));
  SECURITY_NT_AUTHORITY:          TSidIdentifierAuthority =
                                      (Value: (0, 0, 0, 0, 0, 5));

  SECURITY_WORLD_RID                = 0;
  SECURITY_BUILTIN_DOMAIN_RID      = 32;
  DOMAIN_ALIAS_RID_USERS            = 545;
  ACL_REVISION                      = 2;
  OBJECT_INHERIT_ACE                = $1;
  CONTAINER_INHERIT_ACE            = $2;
  USER_PRIV_USER                    = 1;
  NERR_Success                      = 0;

type
  TAceHeader = packed record
    AceType: Byte;
    AceFlags: Byte;
    AceSize: Word;
  end;

  TAccessAllowedAce = packed record
    Header: TAceHeader;
    Mask: ACCESS_MASK;
    SidStart: DWORD;
  end;

  TUserInfo1 = packed record
    usri1_name: PWideChar;
    usri1_password: PWideChar;
    usri1_password_age: DWORD;
    usri1_priv: DWORD;
    usri1_home_dir: PWideChar;
    usri1_comment: PWideChar;
    usri1_flags: DWORD;
    usri1_script_path: PWideChar;
  end;

  TLocalGroupMembersInfo0 = packed record
    lgrmi0_sid: PSID;
  end;
 
  NET_API_STATUS = DWORD;

function NetUserAdd(servername: PWideChar; level: DWORD; buf: Pointer;
  parm_err: PDWORD): NET_API_STATUS; stdcall; external 'netapi32.dll';

function NetLocalGroupAddMembers(servername: PWideChar; groupname: PWideChar;
  level: DWORD; buf: Pointer; totalentries: DWORD): NET_API_STATUS; stdcall;
  external 'netapi32.dll';

function NameToSid(const AName: string;
  const Server: string = ''): PSID;
var
  cbSid, cbDomn, peUse: Cardinal;
  BufSid, BufDmn: array[0..255] of Char;
  pSrv: PChar;
  s: string;
begin
  Result:= nil;
  if AName = '' then
  begin
    cbSid:= sizeof(BufSid);
    if GetUserName(@BufSid[0], cbSid) then
      s:= PChar(@BufSid[0]) else Exit;
  end else
    s:= AName;
  cbSid:= SizeOf(BufSid); cbDomn:= SizeOf(BufDmn);
  if '' = Server then pSrv:= nil else pSrv:= PChar(Server);
  if LookupAccountName(pSrv, PChar(s),
      @BufSid, cbSid, @BufDmn, cbDomn, peUse) then
  begin
    cbSid:= GetLengthSid(@BufSid);
    GetMem(Result, cbSid);
    Move(BufSid, Result^, cbSid);
  end;
end;

procedure CreateSecureFolder(const OwnerName, FolderName: string);
var
  SA: TSecurityAttributes;
  SD: TSecurityDescriptor;
  Acl: PACL;
  SidEveryone, SidUser: PSID;
  SzAcl: Cardinal;
begin
  Acl:= nil; SidEveryone:= nil; SidUser:= nil;

  try
    Win32Check(AllocateAndInitializeSid(SECURITY_WORLD_SID_AUTHORITY, 1,
      SECURITY_WORLD_RID, 0, 0, 0, 0, 0, 0, 0, SidEveryone));
    SidUser:= NameToSid(OwnerName);

    SzAcl:= SizeOf(Acl^) + GetLengthSid(SidEveryone) +
      GetLengthSid(SidUser) + 2 * SizeOf(TAccessAllowedAce);
    GetMem(Acl, SzAcl);

    Win32Check(InitializeAcl(ACL^, SzAcl, ACL_REVISION));
    Win32Check(AddAccessAllowedAceEx(Acl^, ACL_REVISION,
      CONTAINER_INHERIT_ACE or OBJECT_INHERIT_ACE, GENERIC_ALL, SidUser));
    Win32Check(AddAccessAllowedAceEx(Acl^, ACL_REVISION,
      CONTAINER_INHERIT_ACE or OBJECT_INHERIT_ACE,
      GENERIC_READ or GENERIC_EXECUTE, SidEveryone));

    Win32Check(InitializeSecurityDescriptor(@SD, SECURITY_DESCRIPTOR_REVISION));
    Win32Check(SetSecurityDescriptorOwner(@SD, SidUser, true));
    Win32Check(SetSecurityDescriptorDacl(@SD, true, Acl, true));

    SA.nLength:= SizeOf(SA);
    SA.lpSecurityDescriptor:= @SD;
    SA.bInheritHandle:= false;

    Win32Check(CreateDirectory(PChar(FolderName), @SA));
   
  finally
    if nil <> Acl then FreeMem(Acl);
    FreeSid(SidEveryone);
    FreeMem(SidUser);
  end;
end;

procedure CreateUser(const UserName, Password, GroupName: WideString);
var
  UserInfo: TUserInfo1;
  GroupInfo: TLocalGroupMembersInfo0;
  Rslt: Cardinal;
  ParamErr: Cardinal;
begin
  FillChar(UserInfo, SizeOf(UserInfo), 0);
  UserInfo.usri1_name:= PWideChar(UserName);
  UserInfo.usri1_password:= PWideChar(Password);
  UserInfo.usri1_priv:= USER_PRIV_USER;
  Rslt:= NetUserAdd(nil, 1, @UserInfo, @ParamErr);
  if NERR_Success <> Rslt then
    if Rslt = ERROR_INVALID_PARAMETER then
      raise EOSError.CreateFmt('Invalid parameter: %d', [ParamErr])
    else if Rslt < NERR_BASE then
      raise EOSError.Create(SysErrorMessage(Rslt))
  else
    raise EOSError.CreateFmt('Can''t Add user "%s". NetApi error: %d',
      [UserName, Rslt - NERR_BASE]);

  GroupInfo.lgrmi0_sid:= NameToSid('Pupkin');
  try
    Rslt:= NetLocalGroupAddMembers(nil, PWideChar(GroupName), 0, @GroupInfo, 1);
    if NERR_Success <> Rslt then
      if Rslt < NERR_BASE then
        raise EOSError.Create(SysErrorMessage(Rslt))
      else raise Exception.CreateFmt(
        'Can''t Add user "%s" to group "%s". NetApi error: %d',
        [UserName, GroupName, Rslt - NERR_BASE]);
  finally
    FreeMem(GroupInfo.lgrmi0_sid);
  end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  User, Pswrd, Group: string;
  hUser: THandle;
begin
  User:= 'Pupkin';
  Pswrd:= 'PupkinPassword';
  Group:= 'Пользователи';
  CreateUser(User, Pswrd, Group);

  Win32Check(LogonUser(PChar(User), nil, PChar(Pswrd),
    LOGON32_LOGON_INTERACTIVE, LOGON32_PROVIDER_DEFAULT, hUser));

  if ImpersonateLoggedOnUser(hUser) then
  try
    CreateSecureFolder(User, Edit1.Text);
  finally
    RevertToSelf;
  end else
    RaiseLastOSError;
end;