Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Delphi - setting Full Control on Registry Key

I'm using the following code (found online) to set Full Control for a key in the Registry:

procedure TForm1.bnSetRegistryFCClick(Sender: TObject);
var
  SID: PSID;
  peUse, cchDomain, cchName, dwResult: DWORD;
  Name, Domain: array of Char;
  pDACL: PACL;
  pEA: PEXPLICIT_ACCESS_W;//
  sObject: String;
begin
  sObject := 'HKEY_LOCAL_MACHINE\SOFTWARE\Borland';
  SID := nil;
  Win32Check(ConvertStringSidToSidA(PChar('S-1-5-32-545'), SID));        //    S-1-5-32-545='users';  S-1-1-0='everyone'
  cchName := 0;
  cchDomain := 0;

  if (not LookupAccountSid(nil, SID, nil, cchName, nil, cchDomain, peUse)) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then
  begin
    SetLength(Name, cchName);
    SetLength(Domain, cchDomain);
    if LookupAccountSid(nil, SID, @Name[0], cchName, @Domain[0], cchDomain, peUse) then
    begin
      pEA := AllocMem(SizeOf(EXPLICIT_ACCESS));
      BuildExplicitAccessWithName(pEA, PChar(Name), GENERIC_ALL,GRANT_ACCESS, SUB_CONTAINERS_AND_OBJECTS_INHERIT);
      dwResult := SetEntriesInAcl(1, pEA, nil, pDACL);
      if dwResult = ERROR_SUCCESS then
      begin
        dwResult := SetNamedSecurityInfo(pChar(sObject), SE_REGISTRY_KEY, DACL_SECURITY_INFORMATION, nil, nil, pDACL, nil);
        if dwResult <> ERROR_SUCCESS then
          ShowMessage('SetNamedSecurityInfo failed: ' + SysErrorMessage(GetLastError));
        LocalFree(Cardinal(pDACL));
      end
      else
        ShowMessage('SetEntriesInAcl failed: ' + SysErrorMessage(dwResult));
    end;
  end;
end;

SetNamedSecurityInfo returns an error 87 and fails to set the permissions which I think means one of the parameters is wrong. If I use this same code but using SE_FILE_OBJECT instead of SE_REGISTRY_KEY, I can set permissions on given folders successfully. I get the same result whether I use SID S-1-5-32-545 = 'users' or S-1-1-0 = 'everyone'.

Any help much appreciated.

Chris

like image 449
user3387569 Avatar asked May 02 '14 09:05

user3387569


1 Answers

The format of your registry key is wrong. When making an API call that uses SE_OBJECT_TYPE you have to use a set of specific literals in place of the full HKEY_... format.

sObject := 'MACHINE\SOFTWARE\Borland';

For reference : MSDN - SE_OBJECT_TYPE enumeration

The names of registry keys must use the following literal strings to identify the predefined registry keys: "CLASSES_ROOT", "CURRENT_USER", "MACHINE", and "USERS".

like image 163
J... Avatar answered Sep 22 '22 04:09

J...